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 TemplateHaskell    #-}
  16 {-# LANGUAGE TypeOperators      #-}
  17 {-# LANGUAGE DeriveAnyClass     #-}
  18
  19 module Gargantext.API.Search
  20       where
  21
  22 import Data.Aeson.TH (deriveJSON)
  23 import Data.Swagger
  24 import Data.Text (Text)
  25 import Data.Time (UTCTime)
  26 import GHC.Generics (Generic)
  27 import Gargantext.API.Prelude (GargServer)
  28 import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
  29 import Gargantext.Database.Query.Facet
  30 import Gargantext.Database.Action.Search
  31 import Gargantext.Database.Admin.Types.Hyperdata (HyperdataContact)
  32 import Gargantext.Database.Admin.Types.Node
  33 import Gargantext.Prelude
  34 import Servant
  35 import Test.QuickCheck (elements)
  36 import Test.QuickCheck.Arbitrary
  37
  38 -----------------------------------------------------------------------
  39 data SearchType = SearchDoc | SearchContact
  40   deriving (Generic)
  41
  42 $(deriveJSON (unPrefix "") ''SearchType)
  43 instance ToSchema SearchType
  44 instance Arbitrary SearchType where
  45   arbitrary = elements [SearchDoc, SearchContact]
  46
  47 -----------------------------------------------------------------------
  48 data SearchQuery = SearchQuery
  49   { sq_query :: [Text]
  50   , sq_type  :: SearchType
  51   } deriving (Generic)
  52
  53 $(deriveJSON (unPrefix "sq_") ''SearchQuery)
  54
  55 instance ToSchema SearchQuery where
  56   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "sq_")
  57
  58 instance Arbitrary SearchQuery where
  59   arbitrary = elements [SearchQuery ["electrodes"] SearchDoc]
  60 -----------------------------------------------------------------------
  61
  62 data SearchResult = SearchResultDoc     { sr_result :: [FacetDoc]}
  63                   | SearchResultContact { sr_results :: [FacetPaired Int UTCTime HyperdataContact Int] }             | SearchNoResult      { sr_message :: Text }
  64
  65   deriving (Generic)
  66 $(deriveJSON (unPrefix "sr_") ''SearchResult)
  67
  68 instance Arbitrary SearchResult where
  69   arbitrary = do
  70     srd <- SearchResultDoc     <$> arbitrary
  71     src <- SearchResultContact <$> arbitrary
  72     srn <- pure $ SearchNoResult "No result because.."
  73     elements [srd, src, srn]
  74
  75 instance ToSchema SearchResult where
  76   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "sr_")
  77
  78 -----------------------------------------------------------------------
  79 -- TODO-ACCESS: CanSearch? or is it part of CanGetNode
  80 -- TODO-EVENTS: No event, this is a read-only query.
  81 type API results = Summary "Search endpoint"
  82                  :> ReqBody '[JSON] SearchQuery
  83                  :> QueryParam "offset" Int
  84                  :> QueryParam "limit"  Int
  85                  :> QueryParam "order"  OrderBy
  86                  :> Post '[JSON] results
  87 -----------------------------------------------------------------------
  88 api :: NodeId -> GargServer (API SearchResult)
  89 api nId (SearchQuery q SearchDoc) o l order =
  90   SearchResultDoc <$> searchInCorpus nId False q o l order
  91 api nId (SearchQuery q SearchContact) o l order =
  92   -- SearchPairedResults <$> searchInCorpusWithContacts pId aId q o l order
  93   pure $ SearchNoResult "Need Implementation"
  94 -----------------------------------------------------------------------