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
10 Count API part of Gargantext.
13 {-# LANGUAGE TemplateHaskell #-}
14 {-# LANGUAGE TypeOperators #-}
15 {-# LANGUAGE DeriveAnyClass #-}
17 module Gargantext.API.Search
20 import Data.Aeson hiding (defaultTaggedObject)
21 import Data.List (concat)
22 import Data.Maybe (fromMaybe)
23 import Data.Swagger hiding (fieldLabelModifier, Contact)
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 (unPrefixSwagger, unCapitalize, dropPrefix)
29 import Gargantext.Database.Action.Flow.Pairing (isPairedWith)
30 import Gargantext.Database.Action.Search
31 import Gargantext.Database.Admin.Types.Hyperdata (HyperdataContact(..), HyperdataDocument(..), ContactWho(..))
32 import Gargantext.Database.Admin.Types.Hyperdata.Contact (_cw_organization)
33 import Gargantext.Database.Admin.Types.Node
34 import Gargantext.Database.Query.Facet
35 import qualified Gargantext.Defaults as Defaults
36 import Gargantext.Prelude
37 import Gargantext.Utils.Aeson (defaultTaggedObject)
39 import Test.QuickCheck (elements)
40 import Test.QuickCheck.Arbitrary
41 import qualified Data.Text as Text
43 -----------------------------------------------------------------------
44 -- TODO-ACCESS: CanSearch? or is it part of CanGetNode
45 -- TODO-EVENTS: No event, this is a read-only query.
46 type API results = Summary "Search endpoint"
47 :> ReqBody '[JSON] SearchQuery
48 :> QueryParam "offset" Int
49 :> QueryParam "limit" Int
50 :> QueryParam "order" OrderBy
51 :> Post '[JSON] results
52 -----------------------------------------------------------------------
53 -- | Api search function
54 api :: NodeId -> GargServer (API SearchResult)
56 api nId (SearchQuery q SearchDoc) o l order =
57 SearchResult <$> SearchResultDoc
59 <$> searchInCorpus nId False (concat q) o l order
61 api nId (SearchQuery q SearchContact) o l order = do
62 printDebug "isPairedWith" nId
63 aIds <- isPairedWith nId NodeAnnuaire
64 -- TODO if paired with several corpus
66 Nothing -> pure $ SearchResult
67 $ SearchNoResult "[G.A.Search] pair corpus with an Annuaire"
68 Just aId -> SearchResult
69 <$> SearchResultContact
71 <$> searchInCorpusWithContacts nId aId (concat q) o l order
73 api _nId (SearchQuery _q SearchDocWithNgrams) _o _l _order = undefined
75 -----------------------------------------------------------------------
76 -----------------------------------------------------------------------
78 -----------------------------------------------------------------------
79 data SearchType = SearchDoc | SearchContact | SearchDocWithNgrams
81 instance FromJSON SearchType where
82 parseJSON = genericParseJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
83 instance ToJSON SearchType where
84 toJSON = genericToJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
85 instance ToSchema SearchType
86 instance Arbitrary SearchType where
87 arbitrary = elements [SearchDoc, SearchContact]
89 -----------------------------------------------------------------------
91 SearchQuery { query :: ![[Text]]
92 , expected :: !SearchType
95 instance FromJSON SearchQuery where
96 parseJSON = genericParseJSON defaultOptions
97 instance ToJSON SearchQuery where
98 toJSON = genericToJSON defaultOptions
99 instance ToSchema SearchQuery
102 declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "")
105 instance Arbitrary SearchQuery where
106 arbitrary = elements [SearchQuery [["electrodes"]] SearchDoc]
107 -- arbitrary = elements [SearchQuery "electrodes" 1 ] --SearchDoc]
108 -----------------------------------------------------------------------
110 SearchResult { result :: !SearchResultTypes}
113 instance FromJSON SearchResult where
114 parseJSON = genericParseJSON defaultOptions
116 instance ToJSON SearchResult where
117 toJSON = genericToJSON defaultOptions
119 instance ToSchema SearchResult
122 declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "")
125 instance Arbitrary SearchResult where
126 arbitrary = SearchResult <$> arbitrary
129 data SearchResultTypes =
130 SearchResultDoc { docs :: ![Row] }
131 | SearchResultContact { contacts :: ![Row] }
132 | SearchNoResult { message :: !Text }
134 instance FromJSON SearchResultTypes where
135 parseJSON = genericParseJSON (defaultOptions { sumEncoding = defaultTaggedObject })
136 instance ToJSON SearchResultTypes where
137 toJSON = genericToJSON (defaultOptions { sumEncoding = defaultTaggedObject })
139 instance Arbitrary SearchResultTypes where
141 srd <- SearchResultDoc <$> arbitrary
142 src <- SearchResultContact <$> arbitrary
143 srn <- pure $ SearchNoResult "No result because.."
144 elements [srd, src, srn]
146 instance ToSchema SearchResultTypes where
147 declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "")
150 --------------------------------------------------------------------
153 Document { id :: !NodeId
154 , created :: !UTCTime
156 , hyperdata :: !HyperdataRow
160 | Contact { c_id :: !Int
161 , c_created :: !UTCTime
162 , c_hyperdata :: !HyperdataRow
164 , c_annuaireId :: !NodeId
167 instance FromJSON Row
169 parseJSON = genericParseJSON
170 ( defaultOptions { sumEncoding = defaultTaggedObject } )
173 toJSON = genericToJSON (defaultOptions { sumEncoding = defaultTaggedObject })
174 instance Arbitrary Row where
175 arbitrary = arbitrary
177 instance ToSchema Row where
178 declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "")
181 toRow :: NodeId -> a -> Row
183 instance ToRow FacetDoc where
184 toRow _ (FacetDoc { .. }) =
185 Document { id = facetDoc_id
186 , created = facetDoc_created
187 , title = facetDoc_title
188 , hyperdata = toHyperdataRow facetDoc_hyperdata
189 , category = fromMaybe 0 facetDoc_category
190 , score = round $ fromMaybe 0 facetDoc_score }
192 -- | TODO rename FacetPaired
193 type FacetContact = FacetPaired Int UTCTime HyperdataContact Int
195 instance ToRow FacetContact where
196 toRow annuaireId (FacetPaired nId utc h s) = Contact nId utc (toHyperdataRow h) s annuaireId
199 --------------------------------------------------------------------
201 HyperdataRowDocument { _hr_abstract :: !Text
202 , _hr_authors :: !Text
205 , _hr_institutes :: !Text
206 , _hr_language_iso2 :: !Text
208 , _hr_publication_date :: !Text
209 , _hr_publication_day :: !Int
210 , _hr_publication_hour :: !Int
211 , _hr_publication_minute :: !Int
212 , _hr_publication_month :: !Int
213 , _hr_publication_second :: !Int
214 , _hr_publication_year :: !Int
215 , _hr_source :: !Text
218 , _hr_uniqId :: !Text
219 , _hr_uniqIdBdd :: !Text
221 | HyperdataRowContact { _hr_firstname :: !Text
222 , _hr_lastname :: !Text
226 instance FromJSON HyperdataRow
228 parseJSON = genericParseJSON
230 { sumEncoding = defaultTaggedObject
231 , fieldLabelModifier = unCapitalize . dropPrefix "_hr_"
232 , omitNothingFields = False
235 instance ToJSON HyperdataRow
237 toJSON = genericToJSON
239 { sumEncoding = defaultTaggedObject
240 , fieldLabelModifier = unCapitalize . dropPrefix "_hr_"
241 , omitNothingFields = False
245 instance Arbitrary HyperdataRow where
246 arbitrary = arbitrary
248 instance ToSchema HyperdataRow where
249 declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_hr_")
251 class ToHyperdataRow a where
252 toHyperdataRow :: a -> HyperdataRow
254 instance ToHyperdataRow HyperdataDocument where
255 toHyperdataRow (HyperdataDocument { .. }) =
257 { _hr_abstract = fromMaybe "" _hd_abstract
258 , _hr_authors = fromMaybe "" _hd_authors
259 , _hr_bdd = fromMaybe "" _hd_bdd
260 , _hr_doi = fromMaybe "" _hd_doi
261 , _hr_institutes = fromMaybe "" _hd_institutes
262 , _hr_language_iso2 = fromMaybe "EN" _hd_language_iso2
263 , _hr_page = fromMaybe 0 _hd_page
264 , _hr_publication_date = fromMaybe "" _hd_publication_date
265 , _hr_publication_year = fromMaybe (fromIntegral Defaults.year) _hd_publication_year
266 , _hr_publication_month = fromMaybe Defaults.month _hd_publication_month
267 , _hr_publication_day = fromMaybe Defaults.day _hd_publication_day
268 , _hr_publication_hour = fromMaybe 0 _hd_publication_hour
269 , _hr_publication_minute = fromMaybe 0 _hd_publication_minute
270 , _hr_publication_second = fromMaybe 0 _hd_publication_second
271 , _hr_source = fromMaybe "" _hd_source
272 , _hr_title = fromMaybe "Title" _hd_title
273 , _hr_url = fromMaybe "" _hd_url
274 , _hr_uniqId = fromMaybe "" _hd_uniqId
275 , _hr_uniqIdBdd = fromMaybe "" _hd_uniqIdBdd }
277 instance ToHyperdataRow HyperdataContact where
278 toHyperdataRow (HyperdataContact { _hc_who = Just (ContactWho _ fn ln _ _ _), _hc_where = ou} ) =
279 HyperdataRowContact (fromMaybe "FirstName" fn) (fromMaybe "LastName" ln) ou'
281 ou' = maybe "CNRS" (Text.intercalate " " . _cw_organization) (head ou)
282 toHyperdataRow (HyperdataContact {}) =
283 HyperdataRowContact "FirstName" "LastName" "Labs"