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 data SearchDocResults = SearchDocResults { sdr_results :: [FacetDoc]}
  60   deriving (Generic)
  61 $(deriveJSON (unPrefix "sdr_") ''SearchDocResults)
  62
  63 instance Arbitrary SearchDocResults where
  64   arbitrary = SearchDocResults <$> arbitrary
  65
  66 instance ToSchema SearchDocResults where
  67   declareNamedSchema =
  68     genericDeclareNamedSchema
  69       defaultSchemaOptions {fieldLabelModifier = drop 4}
  70
  71 data SearchPairedResults = SearchPairedResults { spr_results :: [FacetPaired Int UTCTime HyperdataDocument Int [Pair Int Text]] }
  72   deriving (Generic)
  73 $(deriveJSON (unPrefix "spr_") ''SearchPairedResults)
  74
  75 instance Arbitrary SearchPairedResults where
  76   arbitrary = SearchPairedResults <$> arbitrary
  77
  78 instance ToSchema SearchPairedResults where
  79   declareNamedSchema =
  80     genericDeclareNamedSchema
  81       defaultSchemaOptions {fieldLabelModifier = \fieldLabel -> drop 4 fieldLabel}
  82
  83 -----------------------------------------------------------------------
  84 -- TODO-ACCESS: CanSearch? or is it part of CanGetNode
  85 -- TODO-EVENTS: No event, this is a read-only query.
  86 type SearchAPI results
  87   = Summary "Search endpoint"
  88  :> ReqBody '[JSON] SearchQuery
  89  :> QueryParam "offset" Int
  90  :> QueryParam "limit"  Int
  91  :> QueryParam "order"  OrderBy
  92  :> Post '[JSON] results
  93
  94 type SearchDocsAPI  = SearchAPI SearchDocResults
  95 type SearchPairsAPI = SearchAPI SearchPairedResults
  96 -----------------------------------------------------------------------
  97
  98 searchPairs :: NodeId -> GargServer SearchPairsAPI
  99 searchPairs pId (SearchQuery q) o l order =
 100   SearchPairedResults <$> searchInCorpusWithContacts pId q o l order
 101
 102 searchDocs :: NodeId -> GargServer SearchDocsAPI
 103 searchDocs nId (SearchQuery q) o l order =
 104   SearchDocResults <$> searchInCorpus nId q o l order
 105   --SearchResults <$> searchInCorpusWithContacts nId q o l order
 106
 107