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 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
  14
  15 {-# LANGUAGE TemplateHaskell    #-}
  16 {-# LANGUAGE TypeOperators      #-}
  17 {-# LANGUAGE DeriveAnyClass     #-}
  18
  19 module Gargantext.API.Search
  20       where
  21
  22 import Data.Aeson
  23 import Data.Swagger
  24 import Data.Text (Text)
  25 import Data.Time (UTCTime)
  26 import GHC.Generics (Generic)
  27 import Gargantext.API.Prelude (GargServer)
  28 import Gargantext.Core.Utils.Prefix (unPrefixSwagger)
  29 import Gargantext.Database.Query.Facet
  30 import Gargantext.Database.Action.Search
  31 import Gargantext.Database.Action.Flow.Pairing (isPairedWith)
  32 import Gargantext.Database.Admin.Types.Hyperdata (HyperdataContact)
  33 import Gargantext.Database.Admin.Types.Node
  34 import Gargantext.Prelude
  35 import Servant
  36 import Test.QuickCheck (elements)
  37 import Test.QuickCheck.Arbitrary
  38
  39 -----------------------------------------------------------------------
  40 data SearchType = SearchDoc | SearchContact
  41   deriving (Generic)
  42
  43
  44 instance FromJSON  SearchType where
  45   parseJSON = genericParseJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
  46
  47 instance ToJSON  SearchType where
  48   toJSON = genericToJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
  49
  50 instance ToSchema SearchType
  51 instance Arbitrary SearchType where
  52   arbitrary = elements [SearchDoc, SearchContact]
  53
  54 -----------------------------------------------------------------------
  55 data SearchQuery =
  56   SearchQuery { query    :: ![Text]
  57               , expected :: !SearchType
  58               } deriving (Generic)
  59
  60 instance FromJSON  SearchQuery where
  61   parseJSON = genericParseJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
  62
  63 instance ToJSON  SearchQuery where
  64   toJSON = genericToJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
  65
  66 instance ToSchema SearchQuery where
  67   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "")
  68
  69 instance Arbitrary SearchQuery where
  70   arbitrary = elements [SearchQuery ["electrodes"] SearchDoc]
  71 -----------------------------------------------------------------------
  72
  73 data SearchResult = SearchResultDoc     { docs     :: ![FacetDoc]}
  74                   | SearchResultContact { contacts :: ![FacetPaired Int UTCTime HyperdataContact Int] }
  75                   | SearchNoResult      { message  :: !Text }
  76
  77   deriving (Generic)
  78
  79 instance FromJSON  SearchResult where
  80   parseJSON = genericParseJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
  81
  82 instance ToJSON  SearchResult where
  83   toJSON = genericToJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
  84
  85 instance Arbitrary SearchResult where
  86   arbitrary = do
  87     srd <- SearchResultDoc     <$> arbitrary
  88     src <- SearchResultContact <$> arbitrary
  89     srn <- pure $ SearchNoResult "No result because.."
  90     elements [srd, src, srn]
  91
  92 instance ToSchema SearchResult where
  93   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "sr_")
  94
  95 -----------------------------------------------------------------------
  96 -- TODO-ACCESS: CanSearch? or is it part of CanGetNode
  97 -- TODO-EVENTS: No event, this is a read-only query.
  98 type API results = Summary "Search endpoint"
  99                  :> ReqBody '[JSON] SearchQuery
 100                  :> QueryParam "offset" Int
 101                  :> QueryParam "limit"  Int
 102                  :> QueryParam "order"  OrderBy
 103                  :> Post '[JSON] results
 104 -----------------------------------------------------------------------
 105 api :: NodeId -> GargServer (API SearchResult)
 106 api nId (SearchQuery q SearchDoc) o l order =
 107   SearchResultDoc <$> searchInCorpus nId False q o l order
 108 api nId (SearchQuery q SearchContact) o l order = do
 109   aIds <- isPairedWith NodeAnnuaire nId
 110   -- TODO if paired with several corpus
 111   case head aIds of
 112     Nothing  -> pure $ SearchNoResult "[G.A.Search] pair corpus with an Annuaire"
 113     Just aId -> SearchResultContact <$> searchInCorpusWithContacts nId aId q o l order
 114 -----------------------------------------------------------------------