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 -----------------------------------------------------------------------
  41 -- TODO-ACCESS: CanSearch? or is it part of CanGetNode
  42 -- TODO-EVENTS: No event, this is a read-only query.
  43 type API results = Summary "Search endpoint"
  44                  :> ReqBody '[JSON] SearchQuery
  45                  :> QueryParam "offset" Int
  46                  :> QueryParam "limit"  Int
  47                  :> QueryParam "order"  OrderBy
  48                  :> Post '[JSON] results
  49 -----------------------------------------------------------------------
  50 api :: NodeId -> GargServer (API SearchResult)
  51 api nId (SearchQuery q SearchDoc) o l order =
  52   SearchResultDoc <$> searchInCorpus nId False q o l order
  53 api nId (SearchQuery q SearchContact) o l order = do
  54   aIds <- isPairedWith NodeAnnuaire nId
  55   -- TODO if paired with several corpus
  56   case head aIds of
  57     Nothing  -> pure $ SearchNoResult "[G.A.Search] pair corpus with an Annuaire"
  58     Just aId -> SearchResultContact <$> searchInCorpusWithContacts nId aId q o l order
  59 -----------------------------------------------------------------------
  60 -----------------------------------------------------------------------
  61 -- | Main Types
  62 -----------------------------------------------------------------------
  63 data SearchType = SearchDoc | SearchContact
  64   deriving (Generic)
  65
  66 instance FromJSON  SearchType
  67 {-
  68   where
  69     parseJSON = genericParseJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
  70 -}
  71
  72 instance ToJSON  SearchType
  73 {-
  74   where
  75     toJSON = genericToJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
  76 -}
  77
  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               } deriving (Generic)
  87
  88 instance FromJSON  SearchQuery
  89 {-
  90   where
  91     parseJSON = genericParseJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
  92 -}
  93
  94 instance ToJSON  SearchQuery
  95 {-
  96   where
  97     toJSON = genericToJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
  98 -}
  99
 100 instance ToSchema SearchQuery
 101 {-
 102   where
 103     declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "")
 104 -}
 105
 106 instance Arbitrary SearchQuery where
 107   arbitrary = elements [SearchQuery ["electrodes"] SearchDoc]
 108 -----------------------------------------------------------------------
 109
 110 data SearchResult = SearchResultDoc     { docs     :: ![FacetDoc]}
 111                   | SearchResultContact { contacts :: ![FacetPaired Int UTCTime HyperdataContact Int] }
 112                   | SearchNoResult      { message  :: !Text }
 113
 114   deriving (Generic)
 115
 116 instance FromJSON  SearchResult
 117 {-
 118   where
 119     parseJSON = genericParseJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
 120 -}
 121
 122 instance ToJSON  SearchResult
 123 {-
 124   where
 125     toJSON = genericToJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
 126 -}
 127
 128 instance Arbitrary SearchResult where
 129   arbitrary = do
 130     srd <- SearchResultDoc     <$> arbitrary
 131     src <- SearchResultContact <$> arbitrary
 132     srn <- pure $ SearchNoResult "No result because.."
 133     elements [srd, src, srn]
 134
 135 instance ToSchema SearchResult where
 136   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "sr_")
 137
 138