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