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 Control.Monad.IO.Class (liftIO)
  28 import Data.Aeson hiding (Error, fieldLabelModifier)
  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.Database.TextSearch
  40
  41 -----------------------------------------------------------------------
  42 data SearchQuery = SearchQuery { sq_query :: [Text]
  43                                , sq_parent_id :: Int
  44                                } deriving (Generic)
  45 $(deriveJSON (unPrefix "sq_") ''SearchQuery)
  46 instance ToSchema SearchQuery where
  47   declareNamedSchema =
  48     genericDeclareNamedSchema
  49       defaultSchemaOptions {fieldLabelModifier = \fieldLabel -> drop 3 fieldLabel}
  50
  51 instance Arbitrary SearchQuery where
  52   arbitrary = elements [SearchQuery ["electrodes"] 472764]
  53
  54 -----------------------------------------------------------------------
  55 data Author = Author { _a_name :: Text
  56                      , _a_id   :: Int
  57          } deriving (Generic)
  58
  59 $(deriveJSON (unPrefix "_a_") ''Author)
  60
  61 instance ToSchema Author where
  62   declareNamedSchema =
  63     genericDeclareNamedSchema
  64       defaultSchemaOptions {fieldLabelModifier = \fieldLabel -> drop 3 fieldLabel}
  65
  66 arbitraryAuthor :: Author
  67 arbitraryAuthor = Author "Jezequel" 1011669
  68 instance Arbitrary Author where
  69   arbitrary = elements [arbitraryAuthor]
  70
  71 -----------------------------------------------------------------------
  72 data SearchResult = SearchResult { sr_id      :: Int
  73                                  , sr_title   :: Text
  74                                  , sr_authors :: [Author]
  75                                  } deriving (Generic)
  76 $(deriveJSON (unPrefix "sr_") ''SearchResult)
  77 instance Arbitrary SearchResult where
  78   arbitrary = elements [SearchResult 1 "Title" [arbitraryAuthor]]
  79
  80 instance ToSchema SearchResult where
  81   declareNamedSchema =
  82     genericDeclareNamedSchema
  83       defaultSchemaOptions {fieldLabelModifier = \fieldLabel -> drop 3 fieldLabel}
  84
  85 -----------------------------------------------------------------------
  86
  87 data SearchResults = SearchResults { srs_results :: [SearchResult]}
  88   deriving (Generic)
  89 $(deriveJSON (unPrefix "srs_") ''SearchResults)
  90
  91 instance Arbitrary SearchResults where
  92   arbitrary = SearchResults <$> arbitrary
  93
  94 instance ToSchema SearchResults where
  95   declareNamedSchema =
  96     genericDeclareNamedSchema
  97       defaultSchemaOptions {fieldLabelModifier = \fieldLabel -> drop 4 fieldLabel}
  98
  99
 100 -----------------------------------------------------------------------
 101 type SearchAPI = Post '[JSON] SearchResults
 102 -----------------------------------------------------------------------
 103
 104 search :: Connection -> SearchQuery -> Handler SearchResults
 105 search c (SearchQuery q pId) =
 106   liftIO $ SearchResults <$> map (\(i, _, t, _, _, _) -> SearchResult i (cs $ encode t) [arbitraryAuthor])
 107                          <$> textSearch c (toTSQuery q) pId 5 0 Desc
 108
 109