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