]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/API/Search.hs
[GRAPH] insert from tree
[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 Data.Aeson.TH (deriveJSON)
29 import Data.Swagger
30 import Data.Text (Text)
31 import Data.Time (UTCTime)
32 import GHC.Generics (Generic)
33 import Gargantext.API.Prelude (GargServer)
34 import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
35 import Gargantext.Database.Query.Facet
36 import Gargantext.Database.Action.Search
37 import Gargantext.Database.Admin.Types.Node
38 import Gargantext.Prelude
39 import Servant
40 import Test.QuickCheck (elements)
41 import Test.QuickCheck.Arbitrary
42
43 -----------------------------------------------------------------------
44 data SearchQuery = SearchQuery
45 { sq_query :: [Text]
46 } deriving (Generic)
47
48 $(deriveJSON (unPrefix "sq_") ''SearchQuery)
49
50 instance ToSchema SearchQuery where
51 declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "sq_")
52
53 instance Arbitrary SearchQuery where
54 arbitrary = elements [SearchQuery ["electrodes"]]
55
56 -----------------------------------------------------------------------
57 data SearchDocResults = SearchDocResults { sdr_results :: [FacetDoc]}
58 deriving (Generic)
59 $(deriveJSON (unPrefix "sdr_") ''SearchDocResults)
60
61 instance Arbitrary SearchDocResults where
62 arbitrary = SearchDocResults <$> arbitrary
63
64 instance ToSchema SearchDocResults where
65 declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "sdr_")
66
67 data SearchPairedResults =
68 SearchPairedResults { spr_results :: [FacetPaired Int UTCTime HyperdataDocument Int [Pair Int Text]] }
69 deriving (Generic)
70 $(deriveJSON (unPrefix "spr_") ''SearchPairedResults)
71
72 instance Arbitrary SearchPairedResults where
73 arbitrary = SearchPairedResults <$> arbitrary
74
75 instance ToSchema SearchPairedResults where
76 declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "spr_")
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 SearchAPI 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 type SearchDocsAPI = SearchAPI SearchDocResults
89 searchDocs :: NodeId -> GargServer SearchDocsAPI
90 searchDocs nId (SearchQuery q) o l order =
91 SearchDocResults <$> searchInCorpus nId False q o l order
92 --SearchResults <$> searchInCorpusWithContacts nId q o l order
93
94 -----------------------------------------------------------------------
95 type SearchPairsAPI = Summary ""
96 :> "list"
97 :> Capture "list" ListId
98 :> SearchAPI SearchPairedResults
99 searchPairs :: NodeId -> GargServer SearchPairsAPI
100
101 searchPairs pId lId (SearchQuery q) o l order =
102 SearchPairedResults <$> searchInCorpusWithContacts pId lId q o l order
103
104 -----------------------------------------------------------------------
105