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.Prelude
  37 import Gargantext.Core.Utils.Prefix (unPrefix)
  38 import Gargantext.Core.Types.Main (Offset, Limit)
  39 import Gargantext.Database.Types.Node
  40 import Gargantext.Database.TextSearch
  41 import Gargantext.Database.Facet
  42 import Gargantext.Database.Utils (Cmd)
  43
  44 -----------------------------------------------------------------------
  45 -- | SearchIn [NodesId] if empty then global search
  46 -- TODO [Int]
  47 data SearchQuery = SearchQuery { sq_query :: [Text]
  48                                , sq_corpus_id :: NodeId
  49                                } deriving (Generic)
  50 $(deriveJSON (unPrefix "sq_") ''SearchQuery)
  51 instance ToSchema SearchQuery where
  52   declareNamedSchema =
  53     genericDeclareNamedSchema
  54       defaultSchemaOptions {fieldLabelModifier = \fieldLabel -> drop 3 fieldLabel}
  55
  56 instance Arbitrary SearchQuery where
  57   arbitrary = elements [SearchQuery ["electrodes"] 472764]
  58
  59 --
  60
  61 data SearchInQuery = SearchInQuery { siq_query :: [Text]
  62                                } deriving (Generic)
  63 $(deriveJSON (unPrefix "siq_") ''SearchInQuery)
  64 instance ToSchema SearchInQuery where
  65   declareNamedSchema =
  66     genericDeclareNamedSchema
  67       defaultSchemaOptions {fieldLabelModifier = \fieldLabel -> drop 4 fieldLabel}
  68
  69 instance Arbitrary SearchInQuery where
  70   arbitrary = SearchInQuery <$> arbitrary
  71
  72
  73 -----------------------------------------------------------------------
  74
  75 data SearchResults = SearchResults' { srs_resultsP :: [FacetDoc]}
  76                    | SearchResults  { srs_results :: [FacetPaired Int UTCTime HyperdataDocument Int [Pair Int Text]]}
  77   deriving (Generic)
  78 $(deriveJSON (unPrefix "srs_") ''SearchResults)
  79
  80 instance Arbitrary SearchResults where
  81   arbitrary = SearchResults <$> arbitrary
  82
  83 instance ToSchema SearchResults where
  84   declareNamedSchema =
  85     genericDeclareNamedSchema
  86       defaultSchemaOptions {fieldLabelModifier = \fieldLabel -> drop 4 fieldLabel}
  87
  88 -----------------------------------------------------------------------
  89 -- TODO-ACCESS: CanSearch? or is it part of CanGetNode
  90 -- TODO-EVENTS: No event, this is a read-only query.
  91 type SearchAPI = Post '[JSON] SearchResults
  92 -----------------------------------------------------------------------
  93
  94 search :: SearchQuery -> Maybe Offset -> Maybe Limit -> Maybe OrderBy -> Cmd err SearchResults
  95 search (SearchQuery q pId) o l order =
  96   SearchResults <$> searchInCorpusWithContacts pId q o l order
  97
  98 searchIn :: NodeId -> SearchInQuery -> Maybe Offset -> Maybe Limit -> Maybe OrderBy -> Cmd err SearchResults
  99 searchIn nId (SearchInQuery q ) o l order =
 100   SearchResults' <$> searchInCorpus nId q o l order
 101   --SearchResults <$> searchInCorpusWithContacts nId q o l order
 102
 103