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