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