]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/Database/Types/Node.hs
sourcephile / git / gargantext.git / blob
? search:
summary | shortlog | log | commit | commitdiff | tree
history | raw | HEAD
[Database][Query] search for doc 2 authors
[gargantext.git] / src / Gargantext / Database / Types / Node.hs
1 {-|
2 Module : Gargantext.Database.Types.Nodes
3 Description : Main Types of Nodes in Database
4 Copyright : (c) CNRS, 2017-Present
5 License : AGPL + CECILL v3
6 Maintainer : team@gargantext.org
7 Stability : experimental
8 Portability : POSIX
9
10 -}
11
12 {-# OPTIONS_GHC -fno-warn-orphans #-}
13
14 {-# LANGUAGE BangPatterns #-}
15 {-# LANGUAGE DeriveGeneric #-}
16 {-# LANGUAGE FlexibleInstances #-}
17 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
18 {-# LANGUAGE NoImplicitPrelude #-}
19 {-# LANGUAGE OverloadedStrings #-}
20 {-# LANGUAGE TemplateHaskell #-}
21 -- {-# LANGUAGE DuplicateRecordFields #-}
22
23 module Gargantext.Database.Types.Node
24 where
25
26 import Prelude (Enum, Bounded, minBound, maxBound)
27
28 import GHC.Generics (Generic)
29
30 import Control.Lens hiding (elements)
31 import qualified Control.Lens as L
32 import Control.Applicative ((<*>))
33
34 import Data.Aeson
35 import Data.Aeson.Types (emptyObject)
36 import Data.Aeson (Object, toJSON)
37 import Data.Aeson.TH (deriveJSON)
38 import Data.ByteString.Lazy (ByteString)
39 import Data.Either
40 import Data.Eq (Eq)
41 import Data.Monoid (mempty)
42 import Data.Text (Text, unpack)
43 import Data.Time (UTCTime)
44 import Data.Time.Segment (jour, timesAfter, Granularity(D))
45 import Data.Swagger
46
47 import Text.Read (read)
48 import Text.Show (Show())
49
50 import Database.PostgreSQL.Simple.ToField (ToField, toField, toJSONField)
51 import Servant
52
53 import Test.QuickCheck.Arbitrary
54 import Test.QuickCheck (elements)
55
56 import Gargantext.Prelude
57 import Gargantext.Core.Utils.Prefix (unPrefix)
58 ------------------------------------------------------------------------
59 type NodeId = Int
60
61 type UTCTime' = UTCTime
62
63 instance Arbitrary UTCTime' where
64 arbitrary = elements $ timesAfter 100 D (jour 2000 01 01)
65
66 ------------------------------------------------------------------------
67 data Status = Status { status_failed :: Int
68 , status_succeeded :: Int
69 , status_remaining :: Int
70 } deriving (Show, Generic)
71 $(deriveJSON (unPrefix "status_") ''Status)
72
73 instance Arbitrary Status where
74 arbitrary = Status <$> arbitrary <*> arbitrary <*> arbitrary
75
76 ------------------------------------------------------------------------
77 data StatusV3 = StatusV3 { statusV3_error :: Maybe Text
78 , statusV3_action :: Maybe Text
79 } deriving (Show, Generic)
80 $(deriveJSON (unPrefix "statusV3_") ''StatusV3)
81 ------------------------------------------------------------------------
82
83 -- Only Hyperdata types should be member of this type class.
84 class Hyperdata a
85
86 ------------------------------------------------------------------------
87 data HyperdataDocumentV3 = HyperdataDocumentV3 { hyperdataDocumentV3_publication_day :: !(Maybe Int)
88 , hyperdataDocumentV3_language_iso2 :: !(Maybe Text)
89 , hyperdataDocumentV3_publication_second :: !(Maybe Int)
90 , hyperdataDocumentV3_publication_minute :: !(Maybe Int)
91 , hyperdataDocumentV3_publication_month :: !(Maybe Int)
92 , hyperdataDocumentV3_publication_hour :: !(Maybe Int)
93 , hyperdataDocumentV3_error :: !(Maybe Text)
94 , hyperdataDocumentV3_language_iso3 :: !(Maybe Text)
95 , hyperdataDocumentV3_authors :: !(Maybe Text)
96 , hyperdataDocumentV3_publication_year :: !(Maybe Int)
97 , hyperdataDocumentV3_publication_date :: !(Maybe Text)
98 , hyperdataDocumentV3_language_name :: !(Maybe Text)
99 , hyperdataDocumentV3_statuses :: !(Maybe [StatusV3])
100 , hyperdataDocumentV3_realdate_full_ :: !(Maybe Text)
101 , hyperdataDocumentV3_source :: !(Maybe Text)
102 , hyperdataDocumentV3_abstract :: !(Maybe Text)
103 , hyperdataDocumentV3_title :: !(Maybe Text)
104 } deriving (Show, Generic)
105 $(deriveJSON (unPrefix "hyperdataDocumentV3_") ''HyperdataDocumentV3)
106
107 instance Hyperdata HyperdataDocumentV3
108 ------------------------------------------------------------------------
109
110
111 data HyperdataDocument = HyperdataDocument { _hyperdataDocument_bdd :: Maybe Text
112 , _hyperdataDocument_doi :: Maybe Text
113 , _hyperdataDocument_url :: Maybe Text
114 , _hyperdataDocument_uniqId :: Maybe Text
115 , _hyperdataDocument_uniqIdBdd :: Maybe Text
116 , _hyperdataDocument_page :: Maybe Int
117 , _hyperdataDocument_title :: Maybe Text
118 , _hyperdataDocument_authors :: Maybe Text
119 , _hyperdataDocument_institutes :: Maybe Text
120 , _hyperdataDocument_source :: Maybe Text
121 , _hyperdataDocument_abstract :: Maybe Text
122 , _hyperdataDocument_publication_date :: Maybe Text
123 , _hyperdataDocument_publication_year :: Maybe Int
124 , _hyperdataDocument_publication_month :: Maybe Int
125 , _hyperdataDocument_publication_day :: Maybe Int
126 , _hyperdataDocument_publication_hour :: Maybe Int
127 , _hyperdataDocument_publication_minute :: Maybe Int
128 , _hyperdataDocument_publication_second :: Maybe Int
129 , _hyperdataDocument_language_iso2 :: Maybe Text
130 } deriving (Show, Generic)
131 $(deriveJSON (unPrefix "_hyperdataDocument_") ''HyperdataDocument)
132 $(makeLenses ''HyperdataDocument)
133
134 instance Hyperdata HyperdataDocument
135
136 instance ToField HyperdataDocument where
137 toField = toJSONField
138
139 toHyperdataDocuments :: [(Text, Text)] -> [HyperdataDocument]
140 toHyperdataDocuments ts = map (\(t1,t2) -> HyperdataDocument Nothing Nothing Nothing Nothing Nothing Nothing (Just t1)
141 Nothing Nothing (Just t2) Nothing Nothing Nothing Nothing Nothing
142 Nothing Nothing Nothing Nothing
143 ) ts
144
145 hyperdataDocuments :: [HyperdataDocument]
146 hyperdataDocuments = toHyperdataDocuments [ ("AI is big but less than crypto", "Troll System journal")
147 , ("Crypto is big but less than AI", "System Troll review" )
148 , ("Science is magic" , "Closed Source review")
149 , ("Open science for all" , "No Time" )
150 , ("Closed science for me" , "No Space" )
151 ]
152
153
154 instance Arbitrary HyperdataDocument where
155 arbitrary = elements hyperdataDocuments
156
157 ------------------------------------------------------------------------
158 data LanguageNodes = LanguageNodes { languageNodes___unknown__ :: [Int]}
159 deriving (Show, Generic)
160 $(deriveJSON (unPrefix "languageNodes_") ''LanguageNodes)
161
162 ------------------------------------------------------------------------
163 -- level: debug | dev (fatal = critical)
164 data EventLevel = CRITICAL | FATAL | ERROR | WARNING | INFO | DEBUG
165 deriving (Show, Generic, Enum, Bounded)
166
167 instance FromJSON EventLevel
168 instance ToJSON EventLevel
169
170 instance Arbitrary EventLevel where
171 arbitrary = elements [minBound..maxBound]
172
173 instance ToSchema EventLevel where
174 declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
175
176 ------------------------------------------------------------------------
177
178 data Event = Event { event_level :: EventLevel
179 , event_message :: Text
180 , event_date :: UTCTime
181 } deriving (Show, Generic)
182 $(deriveJSON (unPrefix "event_") ''Event)
183
184 instance Arbitrary Event where
185 arbitrary = Event <$> arbitrary <*> arbitrary <*> arbitrary
186
187 instance ToSchema Event where
188 declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
189
190 ------------------------------------------------------------------------
191
192 type Text' = Text
193
194 instance Arbitrary Text' where
195 arbitrary = elements ["ici", "la"]
196
197 data Resource = Resource { resource_path :: Maybe Text
198 , resource_scraper :: Maybe Text
199 , resource_query :: Maybe Text
200 , resource_events :: [Event]
201 , resource_status :: Status
202 , resource_date :: UTCTime'
203 } deriving (Show, Generic)
204 $(deriveJSON (unPrefix "resource_") ''Resource)
205
206 instance Arbitrary Resource where
207 arbitrary = Resource <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
208
209 instance ToSchema Resource where
210 declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
211
212 ------------------------------------------------------------------------
213 data HyperdataUser = HyperdataUser { hyperdataUser_language :: Maybe Text
214 } deriving (Show, Generic)
215 $(deriveJSON (unPrefix "hyperdataUser_") ''HyperdataUser)
216
217 instance Hyperdata HyperdataUser
218 ------------------------------------------------------------------------
219 data HyperdataFolder = HyperdataFolder { hyperdataFolder_desc :: Maybe Text
220 } deriving (Show, Generic)
221 $(deriveJSON (unPrefix "hyperdataFolder_") ''HyperdataFolder)
222
223 instance Hyperdata HyperdataFolder
224 ------------------------------------------------------------------------
225 data HyperdataCorpus = HyperdataCorpus { hyperdataCorpus_title :: Maybe Text
226 , hyperdataCorpus_desc :: Maybe Text
227 , hyperdataCorpus_query :: Maybe Text
228 , hyperdataCorpus_authors :: Maybe Text
229 , hyperdataCorpus_resources :: Maybe [Resource]
230 } deriving (Show, Generic)
231 $(deriveJSON (unPrefix "hyperdataCorpus_") ''HyperdataCorpus)
232
233 instance Hyperdata HyperdataCorpus
234
235 corpusExample :: ByteString
236 corpusExample = "" -- TODO
237
238 defaultCorpus :: HyperdataCorpus
239 defaultCorpus = (HyperdataCorpus (Just "Title") (Just "Descr") (Just "Bool query") (Just "Authors") Nothing)
240
241 hyperdataCorpus :: HyperdataCorpus
242 hyperdataCorpus = case decode corpusExample of
243 Just hp -> hp
244 Nothing -> defaultCorpus
245
246 instance Arbitrary HyperdataCorpus where
247 arbitrary = pure hyperdataCorpus -- TODO
248
249 ------------------------------------------------------------------------
250 data HyperdataAnnuaire = HyperdataAnnuaire { hyperdataAnnuaire_title :: Maybe Text
251 , hyperdataAnnuaire_desc :: Maybe Text
252 } deriving (Show, Generic)
253 $(deriveJSON (unPrefix "hyperdataAnnuaire_") ''HyperdataAnnuaire)
254
255 instance Hyperdata HyperdataAnnuaire
256
257 hyperdataAnnuaire :: HyperdataAnnuaire
258 hyperdataAnnuaire = HyperdataAnnuaire (Just "Annuaire Title") (Just "Annuaire Description")
259
260 instance Arbitrary HyperdataAnnuaire where
261 arbitrary = pure hyperdataAnnuaire -- TODO
262
263 ------------------------------------------------------------------------
264 newtype HyperdataAny = HyperdataAny Object
265 deriving (Show, Generic, ToJSON, FromJSON)
266
267 instance Hyperdata HyperdataAny
268
269 instance Arbitrary HyperdataAny where
270 arbitrary = pure $ HyperdataAny mempty -- TODO produce arbitrary objects
271 ------------------------------------------------------------------------
272
273 data HyperdataList = HyperdataList { hyperdataList_preferences :: Maybe Text
274 } deriving (Show, Generic)
275 $(deriveJSON (unPrefix "hyperdataList_") ''HyperdataList)
276
277 instance Hyperdata HyperdataList
278 ------------------------------------------------------------------------
279 data HyperdataScore = HyperdataScore { hyperdataScore_preferences :: Maybe Text
280 } deriving (Show, Generic)
281 $(deriveJSON (unPrefix "hyperdataScore_") ''HyperdataScore)
282
283 instance Hyperdata HyperdataScore
284
285 ------------------------------------------------------------------------
286
287 data HyperdataResource = HyperdataResource { hyperdataResource_preferences :: Maybe Text
288 } deriving (Show, Generic)
289 $(deriveJSON (unPrefix "hyperdataResource_") ''HyperdataResource)
290
291 instance Hyperdata HyperdataResource
292
293 ------------------------------------------------------------------------
294 data HyperdataDashboard = HyperdataDashboard { hyperdataDashboard_preferences :: Maybe Text
295 } deriving (Show, Generic)
296 $(deriveJSON (unPrefix "hyperdataDashboard_") ''HyperdataDashboard)
297
298 instance Hyperdata HyperdataDashboard
299
300 -- TODO add the Graph Structure here
301 data HyperdataGraph = HyperdataGraph { hyperdataGraph_preferences :: Maybe Text
302 } deriving (Show, Generic)
303 $(deriveJSON (unPrefix "hyperdataGraph_") ''HyperdataGraph)
304
305 instance Hyperdata HyperdataGraph
306 ------------------------------------------------------------------------
307
308 -- TODO add the Graph Structure here
309 data HyperdataPhylo = HyperdataPhylo { hyperdataPhylo_preferences :: Maybe Text
310 } deriving (Show, Generic)
311 $(deriveJSON (unPrefix "hyperdataPhylo_") ''HyperdataPhylo)
312
313 instance Hyperdata HyperdataPhylo
314
315 ------------------------------------------------------------------------
316 -- | TODO FEATURE: Notebook saved in the node
317 data HyperdataNotebook = HyperdataNotebook { hyperdataNotebook_preferences :: Maybe Text
318 } deriving (Show, Generic)
319 $(deriveJSON (unPrefix "hyperdataNotebook_") ''HyperdataNotebook)
320
321 instance Hyperdata HyperdataNotebook
322
323
324 -- | NodePoly indicates that Node has a Polymorphism Type
325 type Node json = NodePoly NodeId NodeTypeId NodeUserId (Maybe NodeParentId) NodeName UTCTime json
326
327 -- type Node json = NodePoly NodeId NodeTypeId UserId ParentId NodeName UTCTime json
328 type NodeTypeId = Int
329 type NodeParentId = Int
330 type NodeUserId = Int
331 type NodeName = Text
332 type TSVector = Text
333
334
335 -- | Then a Node can be either a Folder or a Corpus or a Document
336 type NodeUser = Node HyperdataUser
337 type NodeFolder = Node HyperdataFolder
338
339 type NodeCorpus = Node HyperdataCorpus
340 type NodeCorpusV3 = Node HyperdataCorpus
341 type NodeDocument = Node HyperdataDocument
342
343 type NodeAnnuaire = Node HyperdataAnnuaire
344
345 -- | Any others nodes
346 type NodeAny = Node HyperdataAny
347
348 ---- | Then a Node can be either a Graph or a Phylo or a Notebook
349 type NodeList = Node HyperdataList
350 type NodeGraph = Node HyperdataGraph
351 type NodePhylo = Node HyperdataPhylo
352 type NodeNotebook = Node HyperdataNotebook
353 ------------------------------------------------------------------------
354 data NodeType = NodeUser
355 | NodeFolder
356 | NodeCorpus | NodeCorpusV3 | NodeDocument
357 | NodeAnnuaire | NodeContact
358 -- | NodeOccurrences
359 | NodeGraph
360 | NodeDashboard | NodeChart
361 -- | Classification
362 | NodeList
363 -- | Metrics
364 deriving (Show, Read, Eq, Generic, Bounded, Enum)
365
366 allNodeTypes :: [NodeType]
367 allNodeTypes = [minBound ..]
368
369 instance FromJSON NodeType
370 instance ToJSON NodeType
371
372 instance FromHttpApiData NodeType
373 where
374 parseUrlPiece = Right . read . unpack
375
376 instance ToParamSchema NodeType
377 instance ToSchema NodeType
378
379 ------------------------------------------------------------------------
380 data NodePoly id typename userId
381 parentId name date
382 hyperdata = Node { _node_id :: id
383 , _node_typename :: typename
384
385 , _node_userId :: userId
386 , _node_parentId :: parentId
387
388 , _node_name :: name
389 , _node_date :: date
390
391 , _node_hyperdata :: hyperdata
392 } deriving (Show, Generic)
393 $(deriveJSON (unPrefix "_node_") ''NodePoly)
394 $(makeLenses ''NodePoly)
395
396
397 data NodePolySearch id typename userId
398 parentId name date
399 hyperdata search = NodeSearch { _ns_id :: id
400 , _ns_typename :: typename
401 , _ns_userId :: userId
402 -- , nodeUniqId :: hashId
403 , _ns_parentId :: parentId
404 , _ns_name :: name
405 , _ns_date :: date
406
407 , _ns_hyperdata :: hyperdata
408 , _ns_search :: search
409 } deriving (Show, Generic)
410 $(deriveJSON (unPrefix "_ns_") ''NodePolySearch)
411 $(makeLenses ''NodePolySearch)
412
413 type NodeSearch json = NodePolySearch NodeId NodeTypeId NodeUserId (Maybe NodeParentId) NodeName UTCTime json (Maybe TSVector)
414 ------------------------------------------------------------------------
415
416
417 instance (Arbitrary hyperdata
418 ,Arbitrary nodeId
419 ,Arbitrary nodeTypeId
420 ,Arbitrary nodeUserId
421 ,Arbitrary nodeParentId
422 ) => Arbitrary (NodePoly nodeId nodeTypeId nodeUserId nodeParentId
423 NodeName UTCTime hyperdata) where
424 --arbitrary = Node 1 1 (Just 1) 1 "name" (jour 2018 01 01) (arbitrary) (Just "")
425 arbitrary = Node <$> arbitrary <*> arbitrary <*> arbitrary
426 <*> arbitrary <*> arbitrary <*> arbitrary
427 <*> arbitrary
428
429 instance (Arbitrary hyperdata
430 ,Arbitrary nodeId
431 ,Arbitrary nodeTypeId
432 ,Arbitrary nodeUserId
433 ,Arbitrary nodeParentId
434 ) => Arbitrary (NodePolySearch nodeId nodeTypeId nodeUserId nodeParentId
435 NodeName UTCTime hyperdata (Maybe TSVector)) where
436 --arbitrary = Node 1 1 (Just 1) 1 "name" (jour 2018 01 01) (arbitrary) (Just "")
437 arbitrary = NodeSearch <$> arbitrary <*> arbitrary <*> arbitrary
438 <*> arbitrary <*> arbitrary <*> arbitrary
439 <*> arbitrary <*> arbitrary
440
441
442 ------------------------------------------------------------------------
443 hyperdataDocument :: HyperdataDocument
444 hyperdataDocument = case decode docExample of
445 Just hp -> hp
446 Nothing -> HyperdataDocument Nothing Nothing Nothing Nothing
447 Nothing Nothing Nothing Nothing
448 Nothing Nothing Nothing Nothing
449 Nothing Nothing Nothing Nothing
450 Nothing Nothing Nothing
451 docExample :: ByteString
452 docExample = "{\"doi\":\"sdfds\",\"publication_day\":6,\"language_iso2\":\"en\",\"publication_minute\":0,\"publication_month\":7,\"language_iso3\":\"eng\",\"publication_second\":0,\"authors\":\"Nils Hovdenak, Kjell Haram\",\"publication_year\":2012,\"publication_date\":\"2012-07-06 00:00:00+00:00\",\"language_name\":\"English\",\"realdate_full_\":\"2012 01 12\",\"source\":\"European journal of obstetrics, gynecology, and reproductive biology\",\"abstract\":\"The literature was searched for publications on minerals and vitamins during pregnancy and the possible influence of supplements on pregnancy outcome.\",\"title\":\"Influence of mineral and vitamin supplements on pregnancy outcome.\",\"publication_hour\":0}"
453
454 instance ToSchema HyperdataCorpus where
455 declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
456 L.& mapped.schema.description ?~ "a corpus"
457 L.& mapped.schema.example ?~ toJSON hyperdataCorpus
458
459
460 instance ToSchema HyperdataAnnuaire where
461 declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
462 L.& mapped.schema.description ?~ "an annuaire"
463 L.& mapped.schema.example ?~ toJSON hyperdataAnnuaire
464
465
466 instance ToSchema HyperdataDocument where
467 declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
468 L.& mapped.schema.description ?~ "a document"
469 L.& mapped.schema.example ?~ toJSON hyperdataDocument
470
471
472 instance ToSchema HyperdataAny where
473 declareNamedSchema proxy =
474 pure $ genericNameSchema defaultSchemaOptions proxy mempty
475 L.& schema.description ?~ "a node"
476 L.& schema.example ?~ emptyObject -- TODO
477
478
479 instance ToSchema hyperdata =>
480 ToSchema (NodePoly NodeId NodeTypeId
481 (Maybe NodeUserId)
482 NodeParentId NodeName
483 UTCTime hyperdata
484 )
485
486 instance ToSchema hyperdata =>
487 ToSchema (NodePoly NodeId NodeTypeId
488 NodeUserId
489 (Maybe NodeParentId) NodeName
490 UTCTime hyperdata
491 )
492
493
494 instance ToSchema hyperdata =>
495 ToSchema (NodePolySearch NodeId NodeTypeId
496 (Maybe NodeUserId)
497 NodeParentId NodeName
498 UTCTime hyperdata (Maybe TSVector)
499 )
500
501 instance ToSchema hyperdata =>
502 ToSchema (NodePolySearch NodeId NodeTypeId
503 NodeUserId
504 (Maybe NodeParentId) NodeName
505 UTCTime hyperdata (Maybe TSVector)
506 )
507
508
509 instance ToSchema Status
510
511
Search, map, share