]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/API/Search.hs
Unfinished refactoring
[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
83 = Summary "Search endpoint"
84 :> ReqBody '[JSON] SearchQuery
85 :> QueryParam "offset" Int
86 :> QueryParam "limit" Int
87 :> QueryParam "order" OrderBy
88 :> Post '[JSON] results
89
90 type SearchDocsAPI = SearchAPI SearchDocResults
91 type SearchPairsAPI =
92 Summary "" :> "list" :> Capture "list" ListId
93 :> SearchAPI SearchPairedResults
94 -----------------------------------------------------------------------
95
96 searchPairs :: NodeId -> GargServer SearchPairsAPI
97 searchPairs pId lId (SearchQuery q) o l order =
98 SearchPairedResults <$> searchInCorpusWithContacts pId lId q o l order
99
100 searchDocs :: NodeId -> GargServer SearchDocsAPI
101 searchDocs nId (SearchQuery q) o l order =
102 SearchDocResults <$> searchInCorpus nId False q o l order
103 --SearchResults <$> searchInCorpusWithContacts nId q o l order
104
105