]> 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
[NewType] FromField fix.
[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 qualified Control.Lens as L
33 import Control.Applicative ((<*>))
34 import Control.Monad (mzero)
35
36 import Data.Aeson
37 import Data.Aeson.Types (emptyObject)
38 import Data.Aeson (Object, toJSON)
39 import Data.Aeson.TH (deriveJSON)
40 import Data.ByteString.Lazy (ByteString)
41 import Data.Either
42 import Data.Eq (Eq)
43 import Data.Monoid (mempty)
44 import Data.Text (Text, unpack)
45 import Data.Time (UTCTime)
46 import Data.Time.Segment (jour, timesAfter, Granularity(D))
47 import Data.Swagger
48
49 import Text.Read (read)
50 import Text.Show (Show())
51
52 import Database.PostgreSQL.Simple.ToField (ToField, toField, toJSONField)
53 import Database.PostgreSQL.Simple.FromField (FromField, fromField)
54 import Servant
55
56 import Test.QuickCheck.Arbitrary
57 import Test.QuickCheck (elements)
58
59 import Gargantext.Prelude
60 import Gargantext.Core.Utils.Prefix (unPrefix)
61 --import Gargantext.Database.Utils
62 ------------------------------------------------------------------------
63 newtype NodeId = NodeId Int
64 deriving (Show, Read, Generic, Num, Eq, Ord, Enum)
65
66 instance ToField NodeId where
67 toField (NodeId n) = toField n
68
69 instance FromField NodeId where
70 fromField field mdata = do
71 n <- fromField field mdata
72 if (n :: Int) > 0 then return $ NodeId n
73 else mzero
74
75 instance ToJSON NodeId
76 instance FromJSON 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
241 type Text' = Text
242
243 instance Arbitrary Text' where
244 arbitrary = elements ["ici", "la"]
245
246 data Resource = Resource { resource_path :: Maybe Text
247 , resource_scraper :: Maybe Text
248 , resource_query :: Maybe Text
249 , resource_events :: [Event]
250 , resource_status :: Status
251 , resource_date :: UTCTime'
252 } deriving (Show, Generic)
253 $(deriveJSON (unPrefix "resource_") ''Resource)
254
255 instance Arbitrary Resource where
256 arbitrary = Resource <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
257
258 instance ToSchema Resource where
259 declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
260
261 ------------------------------------------------------------------------
262 data HyperdataUser = HyperdataUser { hyperdataUser_language :: Maybe Text
263 } deriving (Show, Generic)
264 $(deriveJSON (unPrefix "hyperdataUser_") ''HyperdataUser)
265
266 instance Hyperdata HyperdataUser
267 ------------------------------------------------------------------------
268 data HyperdataFolder = HyperdataFolder { hyperdataFolder_desc :: Maybe Text
269 } deriving (Show, Generic)
270 $(deriveJSON (unPrefix "hyperdataFolder_") ''HyperdataFolder)
271
272 instance Hyperdata HyperdataFolder
273 ------------------------------------------------------------------------
274 data HyperdataCorpus = HyperdataCorpus { hyperdataCorpus_title :: Maybe Text
275 , hyperdataCorpus_desc :: Maybe Text
276 , hyperdataCorpus_query :: Maybe Text
277 , hyperdataCorpus_authors :: Maybe Text
278 , hyperdataCorpus_resources :: Maybe [Resource]
279 } deriving (Show, Generic)
280 $(deriveJSON (unPrefix "hyperdataCorpus_") ''HyperdataCorpus)
281
282 instance Hyperdata HyperdataCorpus
283
284 corpusExample :: ByteString
285 corpusExample = "" -- TODO
286
287 defaultCorpus :: HyperdataCorpus
288 defaultCorpus = (HyperdataCorpus (Just "Title") (Just "Descr") (Just "Bool query") (Just "Authors") Nothing)
289
290 hyperdataCorpus :: HyperdataCorpus
291 hyperdataCorpus = case decode corpusExample of
292 Just hp -> hp
293 Nothing -> defaultCorpus
294
295 instance Arbitrary HyperdataCorpus where
296 arbitrary = pure hyperdataCorpus -- TODO
297
298 ------------------------------------------------------------------------
299 data HyperdataAnnuaire = HyperdataAnnuaire { hyperdataAnnuaire_title :: Maybe Text
300 , hyperdataAnnuaire_desc :: Maybe Text
301 } deriving (Show, Generic)
302 $(deriveJSON (unPrefix "hyperdataAnnuaire_") ''HyperdataAnnuaire)
303
304 instance Hyperdata HyperdataAnnuaire
305
306 hyperdataAnnuaire :: HyperdataAnnuaire
307 hyperdataAnnuaire = HyperdataAnnuaire (Just "Annuaire Title") (Just "Annuaire Description")
308
309 instance Arbitrary HyperdataAnnuaire where
310 arbitrary = pure hyperdataAnnuaire -- TODO
311
312 ------------------------------------------------------------------------
313 newtype HyperdataAny = HyperdataAny Object
314 deriving (Show, Generic, ToJSON, FromJSON)
315
316 instance Hyperdata HyperdataAny
317
318 instance Arbitrary HyperdataAny where
319 arbitrary = pure $ HyperdataAny mempty -- TODO produce arbitrary objects
320 ------------------------------------------------------------------------
321
322 data HyperdataList = HyperdataList { hyperdataList_preferences :: Maybe Text
323 } deriving (Show, Generic)
324 $(deriveJSON (unPrefix "hyperdataList_") ''HyperdataList)
325
326 instance Hyperdata HyperdataList
327 ------------------------------------------------------------------------
328 data HyperdataScore = HyperdataScore { hyperdataScore_preferences :: Maybe Text
329 } deriving (Show, Generic)
330 $(deriveJSON (unPrefix "hyperdataScore_") ''HyperdataScore)
331
332 instance Hyperdata HyperdataScore
333
334 ------------------------------------------------------------------------
335
336 data HyperdataResource = HyperdataResource { hyperdataResource_preferences :: Maybe Text
337 } deriving (Show, Generic)
338 $(deriveJSON (unPrefix "hyperdataResource_") ''HyperdataResource)
339
340 instance Hyperdata HyperdataResource
341
342 ------------------------------------------------------------------------
343 data HyperdataDashboard = HyperdataDashboard { hyperdataDashboard_preferences :: Maybe Text
344 } deriving (Show, Generic)
345 $(deriveJSON (unPrefix "hyperdataDashboard_") ''HyperdataDashboard)
346
347 instance Hyperdata HyperdataDashboard
348
349 -- TODO add the Graph Structure here
350 data HyperdataGraph = HyperdataGraph { hyperdataGraph_preferences :: Maybe Text
351 } deriving (Show, Generic)
352 $(deriveJSON (unPrefix "hyperdataGraph_") ''HyperdataGraph)
353
354 instance Hyperdata HyperdataGraph
355 ------------------------------------------------------------------------
356
357 -- TODO add the Graph Structure here
358 data HyperdataPhylo = HyperdataPhylo { hyperdataPhylo_preferences :: Maybe Text
359 } deriving (Show, Generic)
360 $(deriveJSON (unPrefix "hyperdataPhylo_") ''HyperdataPhylo)
361
362 instance Hyperdata HyperdataPhylo
363
364 ------------------------------------------------------------------------
365 -- | TODO FEATURE: Notebook saved in the node
366 data HyperdataNotebook = HyperdataNotebook { hyperdataNotebook_preferences :: Maybe Text
367 } deriving (Show, Generic)
368 $(deriveJSON (unPrefix "hyperdataNotebook_") ''HyperdataNotebook)
369
370 instance Hyperdata HyperdataNotebook
371
372
373 -- | NodePoly indicates that Node has a Polymorphism Type
374 type Node json = NodePoly NodeId NodeTypeId UserId (Maybe ParentId) NodeName UTCTime json
375
376 -- type Node json = NodePoly NodeId NodeTypeId UserId ParentId NodeName UTCTime json
377 type NodeTypeId = Int
378 type NodeName = Text
379 type TSVector = Text
380
381
382 -- | Then a Node can be either a Folder or a Corpus or a Document
383 type NodeUser = Node HyperdataUser
384 type NodeFolder = Node HyperdataFolder
385
386 type NodeCorpus = Node HyperdataCorpus
387 type NodeCorpusV3 = Node HyperdataCorpus
388 type NodeDocument = Node HyperdataDocument
389
390 type NodeAnnuaire = Node HyperdataAnnuaire
391
392 -- | Any others nodes
393 type NodeAny = Node HyperdataAny
394
395 ---- | Then a Node can be either a Graph or a Phylo or a Notebook
396 type NodeList = Node HyperdataList
397 type NodeGraph = Node HyperdataGraph
398 type NodePhylo = Node HyperdataPhylo
399 type NodeNotebook = Node HyperdataNotebook
400 ------------------------------------------------------------------------
401 data NodeType = NodeUser
402 | NodeFolder
403 | NodeCorpus | NodeCorpusV3 | NodeDocument
404 | NodeAnnuaire | NodeContact
405 -- | NodeOccurrences
406 | NodeGraph
407 | NodeDashboard | NodeChart
408 -- | Classification
409 | NodeList
410 -- | Metrics
411 deriving (Show, Read, Eq, Generic, Bounded, Enum)
412
413 allNodeTypes :: [NodeType]
414 allNodeTypes = [minBound ..]
415
416 instance FromJSON NodeType
417 instance ToJSON NodeType
418
419 instance FromHttpApiData NodeType
420 where
421 parseUrlPiece = Right . read . unpack
422
423 instance ToParamSchema NodeType
424 instance ToSchema NodeType
425
426 ------------------------------------------------------------------------
427 data NodePoly id typename userId
428 parentId name date
429 hyperdata = Node { _node_id :: id
430 , _node_typename :: typename
431
432 , _node_userId :: userId
433 , _node_parentId :: parentId
434
435 , _node_name :: name
436 , _node_date :: date
437
438 , _node_hyperdata :: hyperdata
439 } deriving (Show, Generic)
440 $(deriveJSON (unPrefix "_node_") ''NodePoly)
441 $(makeLenses ''NodePoly)
442
443
444 data NodePolySearch id typename userId
445 parentId name date
446 hyperdata search = NodeSearch { _ns_id :: id
447 , _ns_typename :: typename
448 , _ns_userId :: userId
449 -- , nodeUniqId :: hashId
450 , _ns_parentId :: parentId
451 , _ns_name :: name
452 , _ns_date :: date
453
454 , _ns_hyperdata :: hyperdata
455 , _ns_search :: search
456 } deriving (Show, Generic)
457 $(deriveJSON (unPrefix "_ns_") ''NodePolySearch)
458 $(makeLenses ''NodePolySearch)
459
460 type NodeSearch json = NodePolySearch NodeId NodeTypeId UserId (Maybe ParentId) NodeName UTCTime json (Maybe TSVector)
461 ------------------------------------------------------------------------
462
463
464 instance (Arbitrary hyperdata
465 ,Arbitrary nodeId
466 ,Arbitrary nodeTypeId
467 ,Arbitrary userId
468 ,Arbitrary nodeParentId
469 ) => Arbitrary (NodePoly nodeId nodeTypeId userId nodeParentId
470 NodeName UTCTime hyperdata) where
471 --arbitrary = Node 1 1 (Just 1) 1 "name" (jour 2018 01 01) (arbitrary) (Just "")
472 arbitrary = Node <$> arbitrary <*> arbitrary <*> arbitrary
473 <*> arbitrary <*> arbitrary <*> arbitrary
474 <*> arbitrary
475
476 instance (Arbitrary hyperdata
477 ,Arbitrary nodeId
478 ,Arbitrary nodeTypeId
479 ,Arbitrary userId
480 ,Arbitrary nodeParentId
481 ) => Arbitrary (NodePolySearch nodeId nodeTypeId userId nodeParentId
482 NodeName UTCTime hyperdata (Maybe TSVector)) where
483 --arbitrary = Node 1 1 (Just 1) 1 "name" (jour 2018 01 01) (arbitrary) (Just "")
484 arbitrary = NodeSearch <$> arbitrary <*> arbitrary <*> arbitrary
485 <*> arbitrary <*> arbitrary <*> arbitrary
486 <*> arbitrary <*> arbitrary
487
488
489 ------------------------------------------------------------------------
490 hyperdataDocument :: HyperdataDocument
491 hyperdataDocument = case decode docExample of
492 Just hp -> hp
493 Nothing -> HyperdataDocument Nothing Nothing Nothing Nothing
494 Nothing Nothing Nothing Nothing
495 Nothing Nothing Nothing Nothing
496 Nothing Nothing Nothing Nothing
497 Nothing Nothing Nothing
498 docExample :: ByteString
499 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}"
500
501 instance ToSchema HyperdataCorpus where
502 declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
503 L.& mapped.schema.description ?~ "a corpus"
504 L.& mapped.schema.example ?~ toJSON hyperdataCorpus
505
506
507 instance ToSchema HyperdataAnnuaire where
508 declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
509 L.& mapped.schema.description ?~ "an annuaire"
510 L.& mapped.schema.example ?~ toJSON hyperdataAnnuaire
511
512
513 instance ToSchema HyperdataDocument where
514 declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
515 L.& mapped.schema.description ?~ "a document"
516 L.& mapped.schema.example ?~ toJSON hyperdataDocument
517
518
519 instance ToSchema HyperdataAny where
520 declareNamedSchema proxy =
521 pure $ genericNameSchema defaultSchemaOptions proxy mempty
522 L.& schema.description ?~ "a node"
523 L.& schema.example ?~ emptyObject -- TODO
524
525
526 instance ToSchema hyperdata =>
527 ToSchema (NodePoly NodeId NodeTypeId
528 (Maybe UserId)
529 ParentId NodeName
530 UTCTime hyperdata
531 )
532
533 instance ToSchema hyperdata =>
534 ToSchema (NodePoly NodeId NodeTypeId
535 UserId
536 (Maybe ParentId) NodeName
537 UTCTime hyperdata
538 )
539
540
541 instance ToSchema hyperdata =>
542 ToSchema (NodePolySearch NodeId NodeTypeId
543 (Maybe UserId)
544 ParentId NodeName
545 UTCTime hyperdata (Maybe TSVector)
546 )
547
548 instance ToSchema hyperdata =>
549 ToSchema (NodePolySearch NodeId NodeTypeId
550 UserId
551 (Maybe ParentId) NodeName
552 UTCTime hyperdata (Maybe TSVector)
553 )
554
555
556 instance ToSchema Status
557
558
Search, map, share