1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
{-|
Module : Gargantext.API.Count
Description : Server API
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
Count API part of Gargantext.
-}
{-# OPTIONS_GHC -fno-warn-deprecations #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DeriveAnyClass #-}
module Gargantext.API.Search
where
import Data.Aeson hiding (defaultTaggedObject)
import Data.Swagger hiding (fieldLabelModifier, Contact)
import Data.Text qualified as T
import Gargantext.API.Prelude (GargServer)
import Gargantext.Core.Text.Corpus.Query (RawQuery (..), parseQuery)
import Gargantext.Core.Types.Query (Limit, Offset)
import Gargantext.Core.Types.Search
import Gargantext.Core.Utils.Prefix (unPrefixSwagger)
import Gargantext.Database.Action.Flow.Pairing (isPairedWith)
import Gargantext.Database.Action.Search
import Gargantext.Database.Admin.Types.Node hiding (DEBUG)
import Gargantext.Database.Query.Facet
import Gargantext.Prelude
import Gargantext.System.Logging
import Gargantext.Utils.Aeson (defaultTaggedObject)
import Servant
import Test.QuickCheck (elements)
import Test.QuickCheck.Arbitrary
-----------------------------------------------------------------------
-- TODO-ACCESS: CanSearch? or is it part of CanGetNode
-- TODO-EVENTS: No event, this is a read-only query.
type API results = Summary "Search endpoint"
:> ReqBody '[JSON] SearchQuery
:> QueryParam "offset" Offset
:> QueryParam "limit" Limit
:> QueryParam "order" OrderBy
:> Post '[JSON] results
-----------------------------------------------------------------------
-- | Api search function
api :: NodeId -> GargServer (API SearchResult)
api nId (SearchQuery rawQuery SearchDoc) o l order = do
case parseQuery rawQuery of
Left err -> pure $ SearchResult $ SearchNoResult (T.pack err)
Right q -> do
$(logLocM) DEBUG $ T.pack "New search started with query = " <> (getRawQuery rawQuery)
SearchResult <$> SearchResultDoc
<$> map (toRow nId)
<$> searchInCorpus nId False q o l order
api nId (SearchQuery rawQuery SearchContact) o l order = do
case parseQuery rawQuery of
Left err -> pure $ SearchResult $ SearchNoResult (T.pack err)
Right q -> do
-- printDebug "isPairedWith" nId
aIds <- isPairedWith nId NodeAnnuaire
-- TODO if paired with several corpus
case head aIds of
Nothing -> pure $ SearchResult
$ SearchNoResult "[G.A.Search] pair corpus with an Annuaire"
Just aId -> SearchResult
<$> SearchResultContact
<$> map (toRow aId)
<$> searchInCorpusWithContacts nId aId q o l order
api _nId (SearchQuery _q SearchDocWithNgrams) _o _l _order = undefined
-----------------------------------------------------------------------
-----------------------------------------------------------------------
-- | Main Types
-----------------------------------------------------------------------
data SearchType = SearchDoc | SearchContact | SearchDocWithNgrams
deriving (Generic)
instance FromJSON SearchType where
parseJSON = genericParseJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
instance ToJSON SearchType where
toJSON = genericToJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
instance ToSchema SearchType
instance Arbitrary SearchType where
arbitrary = elements [SearchDoc, SearchContact]
-----------------------------------------------------------------------
data SearchQuery =
SearchQuery { query :: !RawQuery
, expected :: !SearchType
}
deriving (Generic)
instance FromJSON SearchQuery where
parseJSON = genericParseJSON defaultOptions
instance ToJSON SearchQuery where
toJSON = genericToJSON defaultOptions
instance ToSchema SearchQuery
{-
where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "")
-}
instance Arbitrary SearchQuery where
arbitrary = elements [SearchQuery (RawQuery "electrodes") SearchDoc]
-- arbitrary = elements [SearchQuery "electrodes" 1 ] --SearchDoc]
-----------------------------------------------------------------------
data SearchResult =
SearchResult { result :: !SearchResultTypes}
deriving (Generic)
instance FromJSON SearchResult where
parseJSON = genericParseJSON defaultOptions
instance ToJSON SearchResult where
toJSON = genericToJSON defaultOptions
instance ToSchema SearchResult
{-
where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "")
-}
instance Arbitrary SearchResult where
arbitrary = SearchResult <$> arbitrary
data SearchResultTypes =
SearchResultDoc { docs :: ![Row] }
| SearchResultContact { contacts :: ![Row] }
| SearchNoResult { message :: !Text }
deriving (Generic)
instance FromJSON SearchResultTypes where
parseJSON = genericParseJSON (defaultOptions { sumEncoding = defaultTaggedObject })
instance ToJSON SearchResultTypes where
toJSON = genericToJSON (defaultOptions { sumEncoding = defaultTaggedObject })
instance Arbitrary SearchResultTypes where
arbitrary = do
srd <- SearchResultDoc <$> arbitrary
src <- SearchResultContact <$> arbitrary
srn <- pure $ SearchNoResult "No result because.."
elements [srd, src, srn]
instance ToSchema SearchResultTypes where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "")
--------------------------------------------------------------------