src/Gargantext/API/Search.hs

   1 {-|
   2 Module      : Gargantext.API.Count
   3 Description : Server API
   4 Copyright   : (c) CNRS, 2017-Present
   5 License     : AGPL + CECILL v3
   6 Maintainer  : team@gargantext.org
   7 Stability   : experimental
   8 Portability : POSIX
   9
  10 Count API part of Gargantext.
  11 -}
  12
  13 {-# LANGUAGE TemplateHaskell    #-}
  14 {-# LANGUAGE TypeOperators      #-}
  15 {-# LANGUAGE DeriveAnyClass     #-}
  16
  17 module Gargantext.API.Search
  18       where
  19
  20 import Data.Aeson hiding (defaultTaggedObject)
  21 -- import Data.List (concat)
  22 import Data.Swagger hiding (fieldLabelModifier, Contact)
  23 import Data.Text (Text)
  24 import GHC.Generics (Generic)
  25 import Gargantext.API.Prelude (GargServer)
  26 import Gargantext.Core.Types.Query (Limit, Offset)
  27 import Gargantext.Core.Types.Search
  28 import Gargantext.Core.Utils.Prefix (unPrefixSwagger)
  29 import Gargantext.Database.Action.Flow.Pairing (isPairedWith)
  30 import Gargantext.Database.Action.Search
  31 import Gargantext.Database.Admin.Types.Node
  32 import Gargantext.Database.Query.Facet
  33 import Gargantext.Prelude
  34 import Gargantext.Utils.Aeson (defaultTaggedObject)
  35 import Servant
  36 import Test.QuickCheck (elements)
  37 import Test.QuickCheck.Arbitrary
  38
  39 -----------------------------------------------------------------------
  40 -- TODO-ACCESS: CanSearch? or is it part of CanGetNode
  41 -- TODO-EVENTS: No event, this is a read-only query.
  42 type API results = Summary "Search endpoint"
  43                  :> ReqBody '[JSON] SearchQuery
  44                  :> QueryParam "offset" Offset
  45                  :> QueryParam "limit"  Limit
  46                  :> QueryParam "order"  OrderBy
  47                  :> Post '[JSON] results
  48 -----------------------------------------------------------------------
  49 -- | Api search function
  50 api :: NodeId -> GargServer (API SearchResult)
  51 api nId (SearchQuery q SearchDoc) o l order =
  52   SearchResult <$> SearchResultDoc
  53                <$> map (toRow nId)
  54                <$> searchInCorpus nId False q o l order
  55                -- <$> searchInCorpus nId False (concat q) o l order
  56 api nId (SearchQuery q SearchContact) o l order = do
  57   -- printDebug "isPairedWith" nId
  58   aIds <- isPairedWith nId NodeAnnuaire
  59   -- TODO if paired with several corpus
  60   case head aIds of
  61     Nothing  -> pure $ SearchResult
  62               $ SearchNoResult "[G.A.Search] pair corpus with an Annuaire"
  63     Just aId -> SearchResult
  64             <$> SearchResultContact
  65             <$> map (toRow aId)
  66             <$> searchInCorpusWithContacts nId aId q o l order
  67 api _nId (SearchQuery _q SearchDocWithNgrams) _o _l _order = undefined
  68
  69 -----------------------------------------------------------------------
  70 -----------------------------------------------------------------------
  71 -- | Main Types
  72 -----------------------------------------------------------------------
  73 data SearchType = SearchDoc | SearchContact | SearchDocWithNgrams
  74   deriving (Generic)
  75 instance FromJSON SearchType where
  76   parseJSON = genericParseJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
  77 instance ToJSON SearchType where
  78   toJSON = genericToJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
  79 instance ToSchema SearchType
  80 instance Arbitrary SearchType where
  81   arbitrary = elements [SearchDoc, SearchContact]
  82
  83 -----------------------------------------------------------------------
  84 data SearchQuery =
  85   SearchQuery { query    :: ![Text]
  86               , expected :: !SearchType
  87               }
  88     deriving (Generic)
  89 instance FromJSON SearchQuery where
  90   parseJSON = genericParseJSON defaultOptions
  91 instance ToJSON SearchQuery where
  92   toJSON = genericToJSON defaultOptions
  93 instance ToSchema SearchQuery
  94 {-
  95   where
  96     declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "")
  97 -}
  98
  99 instance Arbitrary SearchQuery where
 100   arbitrary = elements [SearchQuery ["electrodes"] SearchDoc]
 101   -- arbitrary = elements [SearchQuery "electrodes" 1 ] --SearchDoc]
 102 -----------------------------------------------------------------------
 103 data SearchResult =
 104   SearchResult { result :: !SearchResultTypes}
 105     deriving (Generic)
 106
 107 instance FromJSON SearchResult where
 108   parseJSON = genericParseJSON defaultOptions
 109
 110 instance ToJSON SearchResult where
 111   toJSON = genericToJSON defaultOptions
 112
 113 instance ToSchema SearchResult
 114 {-
 115   where
 116     declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "")
 117 -}
 118
 119 instance Arbitrary SearchResult where
 120   arbitrary = SearchResult <$> arbitrary
 121
 122
 123 data SearchResultTypes =
 124     SearchResultDoc { docs     :: ![Row] }
 125   | SearchResultContact  { contacts :: ![Row] }
 126   | SearchNoResult      { message  :: !Text }
 127   deriving (Generic)
 128 instance FromJSON SearchResultTypes where
 129   parseJSON = genericParseJSON (defaultOptions { sumEncoding = defaultTaggedObject })
 130 instance ToJSON SearchResultTypes where
 131   toJSON = genericToJSON (defaultOptions { sumEncoding = defaultTaggedObject })
 132
 133 instance Arbitrary SearchResultTypes where
 134   arbitrary = do
 135     srd <- SearchResultDoc     <$> arbitrary
 136     src <- SearchResultContact <$> arbitrary
 137     srn <- pure $ SearchNoResult "No result because.."
 138     elements [srd, src, srn]
 139
 140 instance ToSchema SearchResultTypes where
 141   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "")
 142
 143
 144 --------------------------------------------------------------------