]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/API/Search.hs
Merge branch 'dev-phylo' of ssh://gitlab.iscpif.fr:20022/gargantext/haskell-gargantex...
[gargantext.git] / 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 FlexibleContexts #-}
16 {-# LANGUAGE NoImplicitPrelude #-}
17 {-# LANGUAGE DataKinds #-}
18 {-# LANGUAGE TemplateHaskell #-}
19 {-# LANGUAGE TypeOperators #-}
20 {-# LANGUAGE DeriveGeneric #-}
21 {-# LANGUAGE DeriveAnyClass #-}
22 {-# LANGUAGE OverloadedStrings #-}
23 {-# LANGUAGE RankNTypes #-}
24
25 module Gargantext.API.Search
26 where
27
28 import GHC.Generics (Generic)
29 import Data.Time (UTCTime)
30 import Data.Aeson.TH (deriveJSON)
31 import Data.Swagger
32 import Data.Text (Text)
33 import Servant
34 import Test.QuickCheck.Arbitrary
35 import Test.QuickCheck (elements)
36 -- import Control.Applicative ((<*>))
37 import Gargantext.API.Types (GargServer)
38 import Gargantext.Prelude
39 import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
40 import Gargantext.Database.Types.Node
41 import Gargantext.Database.TextSearch
42 import Gargantext.Database.Facet
43
44 -----------------------------------------------------------------------
45 data SearchQuery = SearchQuery
46 { sq_query :: [Text]
47 } deriving (Generic)
48
49 $(deriveJSON (unPrefix "sq_") ''SearchQuery)
50
51 instance ToSchema SearchQuery where
52 declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "sq_")
53
54 instance Arbitrary SearchQuery where
55 arbitrary = elements [SearchQuery ["electrodes"]]
56
57 -----------------------------------------------------------------------
58 data SearchDocResults = SearchDocResults { sdr_results :: [FacetDoc]}
59 deriving (Generic)
60 $(deriveJSON (unPrefix "sdr_") ''SearchDocResults)
61
62 instance Arbitrary SearchDocResults where
63 arbitrary = SearchDocResults <$> arbitrary
64
65 instance ToSchema SearchDocResults where
66 declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "sdr_")
67
68 data SearchPairedResults =
69 SearchPairedResults { spr_results :: [FacetPaired Int UTCTime HyperdataDocument Int [Pair Int Text]] }
70 deriving (Generic)
71 $(deriveJSON (unPrefix "spr_") ''SearchPairedResults)
72
73 instance Arbitrary SearchPairedResults where
74 arbitrary = SearchPairedResults <$> arbitrary
75
76 instance ToSchema SearchPairedResults where
77 declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "spr_")
78
79 -----------------------------------------------------------------------
80 -- TODO-ACCESS: CanSearch? or is it part of CanGetNode
81 -- TODO-EVENTS: No event, this is a read-only query.
82 type SearchAPI results = Summary "Search endpoint"
83 :> ReqBody '[JSON] SearchQuery
84 :> QueryParam "offset" Int
85 :> QueryParam "limit" Int
86 :> QueryParam "order" OrderBy
87 :> Post '[JSON] results
88
89 type SearchDocsAPI = SearchAPI SearchDocResults
90 searchDocs :: NodeId -> GargServer SearchDocsAPI
91 searchDocs nId (SearchQuery q) o l order =
92 SearchDocResults <$> searchInCorpus nId False q o l order
93 --SearchResults <$> searchInCorpusWithContacts nId q o l order
94
95 -----------------------------------------------------------------------
96 type SearchPairsAPI = Summary ""
97 :> "list"
98 :> Capture "list" ListId
99 :> SearchAPI SearchPairedResults
100 searchPairs :: NodeId -> GargServer SearchPairsAPI
101
102 searchPairs pId lId (SearchQuery q) o l order =
103 SearchPairedResults <$> searchInCorpusWithContacts pId lId q o l order
104
105 -----------------------------------------------------------------------
106