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
  23 module Gargantext.API.Search
  24       where
  25
  26 import GHC.Generics (Generic)
  27 import Data.Time (UTCTime)
  28 import Control.Monad.IO.Class (liftIO)
  29 import Data.Aeson.TH (deriveJSON)
  30 import Data.Swagger
  31 import Data.Text (Text)
  32 import Database.PostgreSQL.Simple (Connection)
  33 import Servant
  34 import Test.QuickCheck.Arbitrary
  35 import Test.QuickCheck (elements)
  36 -- import Control.Applicative ((<*>))
  37 import Gargantext.Prelude
  38 import Gargantext.Core.Utils.Prefix (unPrefix)
  39 import Gargantext.Core.Types.Main (Offset, Limit)
  40 import Gargantext.Database.Types.Node
  41 import Gargantext.Database.TextSearch
  42 import Gargantext.Database.Facet
  43
  44 -----------------------------------------------------------------------
  45 -- | SearchIn [NodesId] if empty then global search
  46 -- TODO [Int]
  47 data SearchQuery = SearchQuery { sq_query :: [Text]
  48                                , sq_corpus_id :: Int
  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_results :: [FacetPaired Int UTCTime HyperdataDocument Int [Pair Int Text]]}
  76   deriving (Generic)
  77 $(deriveJSON (unPrefix "srs_") ''SearchResults)
  78
  79 instance Arbitrary SearchResults where
  80   arbitrary = SearchResults <$> arbitrary
  81
  82 instance ToSchema SearchResults where
  83   declareNamedSchema =
  84     genericDeclareNamedSchema
  85       defaultSchemaOptions {fieldLabelModifier = \fieldLabel -> drop 4 fieldLabel}
  86
  87 -----------------------------------------------------------------------
  88 type SearchAPI = Post '[JSON] SearchResults
  89 -----------------------------------------------------------------------
  90
  91 search :: Connection -> SearchQuery -> Maybe Offset -> Maybe Limit -> Maybe OrderBy -> Handler SearchResults
  92 search c (SearchQuery q pId) o l order =
  93   liftIO $ SearchResults <$> searchInCorpusWithContacts c pId q o l order
  94
  95 searchIn :: Connection -> NodeId -> SearchInQuery -> Maybe Offset -> Maybe Limit -> Maybe OrderBy -> Handler SearchResults
  96 searchIn c nId (SearchInQuery q ) o l order =
  97   liftIO $ SearchResults <$> searchInCorpusWithContacts c nId q o l order
  98
  99