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
  16 {-# LANGUAGE NoImplicitPrelude  #-}
  17 {-# LANGUAGE DataKinds          #-}
  18 {-# LANGUAGE TemplateHaskell    #-}
  19 {-# LANGUAGE TypeOperators      #-}
  20 {-# LANGUAGE DeriveGeneric      #-}
  21 {-# LANGUAGE DeriveAnyClass     #-}
  22 {-# LANGUAGE OverloadedStrings  #-}
  23
  24 module Gargantext.API.Search
  25       where
  26
  27
  28 import GHC.Generics (Generic)
  29 import Control.Monad.IO.Class (liftIO)
  30
  31
  32 import Data.Aeson hiding (Error, fieldLabelModifier)
  33 import Data.Aeson.TH (deriveJSON)
  34 import Data.Swagger
  35 import Data.Text (Text)
  36 import Database.PostgreSQL.Simple (Connection)
  37
  38 import Servant
  39 import Test.QuickCheck.Arbitrary
  40 import Test.QuickCheck (elements)
  41 -- import Control.Applicative ((<*>))
  42
  43 import Gargantext.Prelude
  44 import Gargantext.Core.Utils.Prefix (unPrefix)
  45 import Gargantext.Database.TextSearch
  46
  47
  48
  49 -----------------------------------------------------------------------
  50 data SearchQuery = SearchQuery { sq_query :: [Text]
  51                                , sq_parent_id :: Int
  52                                } deriving (Generic)
  53 $(deriveJSON (unPrefix "sq_") ''SearchQuery)
  54 instance ToSchema SearchQuery where
  55   declareNamedSchema =
  56     genericDeclareNamedSchema
  57       defaultSchemaOptions {fieldLabelModifier = \fieldLabel -> drop 3 fieldLabel}
  58
  59
  60 instance Arbitrary SearchQuery where
  61   arbitrary = elements [SearchQuery ["electrodes"] 472764]
  62
  63 -----------------------------------------------------------------------
  64
  65 data SearchResult = SearchResult { sr_id      :: Int
  66                                  , sr_title   :: Text
  67                                  , sr_authors :: Text
  68                                  } deriving (Generic)
  69 $(deriveJSON (unPrefix "sr_") ''SearchResult)
  70 instance Arbitrary SearchResult where
  71   arbitrary = elements [SearchResult 1 "Title" "Authors"]
  72
  73 instance ToSchema SearchResult where
  74   declareNamedSchema =
  75     genericDeclareNamedSchema
  76       defaultSchemaOptions {fieldLabelModifier = \fieldLabel -> drop 3 fieldLabel}
  77
  78 -----------------------------------------------------------------------
  79
  80 data SearchResults = SearchResults { srs_results :: [SearchResult]}
  81   deriving (Generic)
  82 $(deriveJSON (unPrefix "srs_") ''SearchResults)
  83
  84 instance Arbitrary SearchResults where
  85   arbitrary = SearchResults <$> arbitrary
  86
  87 instance ToSchema SearchResults where
  88   declareNamedSchema =
  89     genericDeclareNamedSchema
  90       defaultSchemaOptions {fieldLabelModifier = \fieldLabel -> drop 4 fieldLabel}
  91
  92
  93
  94 -----------------------------------------------------------------------
  95 type SearchAPI = Post '[JSON] SearchResults
  96 -----------------------------------------------------------------------
  97
  98 search :: Connection -> SearchQuery -> Handler SearchResults
  99 search c (SearchQuery q pId) =
 100   liftIO $ SearchResults <$> map (\(i, _, t, _, a, _) -> SearchResult i (cs $ encode t) (cs $ encode a))
 101                          <$> textSearch c (toTSQuery q) pId 5 0 Desc
 102
 103