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 NoImplicitPrelude  #-}
  16 {-# LANGUAGE DataKinds          #-}
  17 {-# LANGUAGE TemplateHaskell    #-}
  18 {-# LANGUAGE TypeOperators      #-}
  19 {-# LANGUAGE DeriveGeneric      #-}
  20 {-# LANGUAGE DeriveAnyClass     #-}
  21 {-# LANGUAGE OverloadedStrings  #-}
  22 {-# LANGUAGE RankNTypes         #-}
  23
  24 module Gargantext.API.Search
  25       where
  26
  27 import GHC.Generics (Generic)
  28 import Data.Time (UTCTime)
  29 import Data.Aeson.TH (deriveJSON)
  30 import Data.Swagger
  31 import Data.Text (Text)
  32 import Servant
  33 import Test.QuickCheck.Arbitrary
  34 import Test.QuickCheck (elements)
  35 -- import Control.Applicative ((<*>))
  36 import Gargantext.API.Types (GargServer)
  37 import Gargantext.Prelude
  38 import Gargantext.Core.Utils.Prefix (unPrefix)
  39 import Gargantext.Database.Types.Node
  40 import Gargantext.Database.TextSearch
  41 import Gargantext.Database.Facet
  42
  43 -----------------------------------------------------------------------
  44 data SearchQuery = SearchQuery
  45   { sq_query :: [Text]
  46   } deriving (Generic)
  47
  48 $(deriveJSON (unPrefix "sq_") ''SearchQuery)
  49
  50 instance ToSchema SearchQuery where
  51   declareNamedSchema =
  52     genericDeclareNamedSchema
  53       defaultSchemaOptions {fieldLabelModifier = drop 3}
  54
  55 instance Arbitrary SearchQuery where
  56   arbitrary = elements [SearchQuery ["electrodes"]]
  57
  58 -----------------------------------------------------------------------
  59
  60 data SearchDocResults = SearchDocResults { sdr_results :: [FacetDoc]}
  61   deriving (Generic)
  62 $(deriveJSON (unPrefix "sdr_") ''SearchDocResults)
  63
  64 instance Arbitrary SearchDocResults where
  65   arbitrary = SearchDocResults <$> arbitrary
  66
  67 instance ToSchema SearchDocResults where
  68   declareNamedSchema =
  69     genericDeclareNamedSchema
  70       defaultSchemaOptions {fieldLabelModifier = drop 4}
  71
  72 data SearchPairedResults = SearchPairedResults { spr_results :: [FacetPaired Int UTCTime HyperdataDocument Int [Pair Int Text]] }
  73   deriving (Generic)
  74 $(deriveJSON (unPrefix "spr_") ''SearchPairedResults)
  75
  76 instance Arbitrary SearchPairedResults where
  77   arbitrary = SearchPairedResults <$> arbitrary
  78
  79 instance ToSchema SearchPairedResults where
  80   declareNamedSchema =
  81     genericDeclareNamedSchema
  82       defaultSchemaOptions {fieldLabelModifier = \fieldLabel -> drop 4 fieldLabel}
  83
  84 -----------------------------------------------------------------------
  85 -- TODO-ACCESS: CanSearch? or is it part of CanGetNode
  86 -- TODO-EVENTS: No event, this is a read-only query.
  87 type SearchAPI results
  88   = Summary "Search endpoint"
  89  :> ReqBody '[JSON] SearchQuery
  90  :> QueryParam "offset" Int
  91  :> QueryParam "limit"  Int
  92  :> QueryParam "order"  OrderBy
  93  :> Post '[JSON] results
  94
  95 type SearchDocsAPI  = SearchAPI SearchDocResults
  96 type SearchPairsAPI = SearchAPI SearchPairedResults
  97 -----------------------------------------------------------------------
  98
  99 searchPairs :: NodeId -> GargServer SearchPairsAPI
 100 searchPairs pId (SearchQuery q) o l order =
 101   SearchPairedResults <$> searchInCorpusWithContacts pId q o l order
 102
 103 searchDocs :: NodeId -> GargServer SearchDocsAPI
 104 searchDocs nId (SearchQuery q) o l order =
 105   SearchDocResults <$> searchInCorpus nId q o l order
 106   --SearchResults <$> searchInCorpusWithContacts nId q o l order
 107
 108