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 import Prelude (Bounded, Enum, minBound, maxBound)
  31
  32
  33 import Data.Aeson hiding (Error, fieldLabelModifier)
  34 import Data.Aeson.TH (deriveJSON)
  35 import Data.Eq (Eq())
  36 import Data.Either
  37 import Data.List (repeat, permutations)
  38 import Data.Swagger
  39 import Data.Swagger.SchemaOptions
  40 import Data.Text (Text, pack)
  41 import Database.PostgreSQL.Simple (Connection)
  42
  43 import Servant
  44 import Test.QuickCheck.Arbitrary
  45 import Test.QuickCheck (elements)
  46 -- import Control.Applicative ((<*>))
  47
  48 import Gargantext.Prelude
  49 import Gargantext.Core.Utils.Prefix (unPrefix)
  50 import Gargantext.Database.TextSearch
  51
  52
  53
  54 -----------------------------------------------------------------------
  55 data SearchQuery = SearchQuery { sq_query :: [Text]
  56                                , sq_parent_id :: Int
  57                                } deriving (Generic)
  58 $(deriveJSON (unPrefix "sq_") ''SearchQuery)
  59 instance ToSchema SearchQuery where
  60   declareNamedSchema =
  61     genericDeclareNamedSchema
  62       defaultSchemaOptions {fieldLabelModifier = \fieldLabel -> drop 3 fieldLabel}
  63
  64
  65 instance Arbitrary SearchQuery where
  66   arbitrary = elements [SearchQuery ["query"] 1]
  67
  68 -----------------------------------------------------------------------
  69
  70 data SearchResult = SearchResult { sr_id :: Int
  71                                  , sr_name :: Text
  72                                  } deriving (Generic)
  73 $(deriveJSON (unPrefix "sr_") ''SearchResult)
  74 instance Arbitrary SearchResult where
  75   arbitrary = elements [SearchResult 1 "name"]
  76
  77 instance ToSchema SearchResult where
  78   declareNamedSchema =
  79     genericDeclareNamedSchema
  80       defaultSchemaOptions {fieldLabelModifier = \fieldLabel -> drop 3 fieldLabel}
  81
  82 -----------------------------------------------------------------------
  83
  84 data SearchResults = SearchResults { srs_results :: [SearchResult]}
  85   deriving (Generic)
  86 $(deriveJSON (unPrefix "srs_") ''SearchResults)
  87
  88 instance Arbitrary SearchResults where
  89   arbitrary = SearchResults <$> arbitrary
  90
  91 instance ToSchema SearchResults where
  92   declareNamedSchema =
  93     genericDeclareNamedSchema
  94       defaultSchemaOptions {fieldLabelModifier = \fieldLabel -> drop 4 fieldLabel}
  95
  96
  97
  98 -----------------------------------------------------------------------
  99 type SearchAPI = Post '[JSON] SearchResults
 100 -----------------------------------------------------------------------
 101
 102 search :: Connection -> SearchQuery -> Handler SearchResults
 103 search c (SearchQuery q pId) =
 104   liftIO $ SearchResults <$> map (\(i, y, t, s, _) -> SearchResult i (cs $ encode t))
 105                          <$> textSearch c (toTSQuery q) pId 5 0 Desc
 106
 107