]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/Database/Types/Node.hs
[HANDLING] Errors, catchNodeError removed.
[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 Eq HyperdataDocument where
135 (==) h1 h2 = (==) (_hyperdataDocument_uniqId h1) (_hyperdataDocument_uniqId h2)
136
137 instance Ord HyperdataDocument where
138 compare h1 h2 = compare (_hyperdataDocument_uniqId h1) (_hyperdataDocument_uniqId h2)
139
140 instance Hyperdata HyperdataDocument
141
142 instance ToField HyperdataDocument where
143 toField = toJSONField
144
145 toHyperdataDocuments :: [(Text, Text)] -> [HyperdataDocument]
146 toHyperdataDocuments ts = map (\(t1,t2) -> HyperdataDocument Nothing Nothing Nothing Nothing Nothing Nothing (Just t1)
147 Nothing Nothing (Just t2) Nothing Nothing Nothing Nothing Nothing
148 Nothing Nothing Nothing Nothing
149 ) ts
150
151 hyperdataDocuments :: [HyperdataDocument]
152 hyperdataDocuments = toHyperdataDocuments [ ("AI is big but less than crypto", "Troll System journal")
153 , ("Crypto is big but less than AI", "System Troll review" )
154 , ("Science is magic" , "Closed Source review")
155 , ("Open science for all" , "No Time" )
156 , ("Closed science for me" , "No Space" )
157 ]
158
159
160 instance Arbitrary HyperdataDocument where
161 arbitrary = elements hyperdataDocuments
162
163 ------------------------------------------------------------------------
164 data LanguageNodes = LanguageNodes { languageNodes___unknown__ :: [Int]}
165 deriving (Show, Generic)
166 $(deriveJSON (unPrefix "languageNodes_") ''LanguageNodes)
167
168 ------------------------------------------------------------------------
169 -- level: debug | dev (fatal = critical)
170 data EventLevel = CRITICAL | FATAL | ERROR | WARNING | INFO | DEBUG
171 deriving (Show, Generic, Enum, Bounded)
172
173 instance FromJSON EventLevel
174 instance ToJSON EventLevel
175
176 instance Arbitrary EventLevel where
177 arbitrary = elements [minBound..maxBound]
178
179 instance ToSchema EventLevel where
180 declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
181
182 ------------------------------------------------------------------------
183
184 data Event = Event { event_level :: EventLevel
185 , event_message :: Text
186 , event_date :: UTCTime
187 } deriving (Show, Generic)
188 $(deriveJSON (unPrefix "event_") ''Event)
189
190 instance Arbitrary Event where
191 arbitrary = Event <$> arbitrary <*> arbitrary <*> arbitrary
192
193 instance ToSchema Event where
194 declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
195
196 ------------------------------------------------------------------------
197
198 type Text' = Text
199
200 instance Arbitrary Text' where
201 arbitrary = elements ["ici", "la"]
202
203 data Resource = Resource { resource_path :: Maybe Text
204 , resource_scraper :: Maybe Text
205 , resource_query :: Maybe Text
206 , resource_events :: [Event]
207 , resource_status :: Status
208 , resource_date :: UTCTime'
209 } deriving (Show, Generic)
210 $(deriveJSON (unPrefix "resource_") ''Resource)
211
212 instance Arbitrary Resource where
213 arbitrary = Resource <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
214
215 instance ToSchema Resource where
216 declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
217
218 ------------------------------------------------------------------------
219 data HyperdataUser = HyperdataUser { hyperdataUser_language :: Maybe Text
220 } deriving (Show, Generic)
221 $(deriveJSON (unPrefix "hyperdataUser_") ''HyperdataUser)
222
223 instance Hyperdata HyperdataUser
224 ------------------------------------------------------------------------
225 data HyperdataFolder = HyperdataFolder { hyperdataFolder_desc :: Maybe Text
226 } deriving (Show, Generic)
227 $(deriveJSON (unPrefix "hyperdataFolder_") ''HyperdataFolder)
228
229 instance Hyperdata HyperdataFolder
230 ------------------------------------------------------------------------
231 data HyperdataCorpus = HyperdataCorpus { hyperdataCorpus_title :: Maybe Text
232 , hyperdataCorpus_desc :: Maybe Text
233 , hyperdataCorpus_query :: Maybe Text
234 , hyperdataCorpus_authors :: Maybe Text
235 , hyperdataCorpus_resources :: Maybe [Resource]
236 } deriving (Show, Generic)
237 $(deriveJSON (unPrefix "hyperdataCorpus_") ''HyperdataCorpus)
238
239 instance Hyperdata HyperdataCorpus
240
241 corpusExample :: ByteString
242 corpusExample = "" -- TODO
243
244 defaultCorpus :: HyperdataCorpus
245 defaultCorpus = (HyperdataCorpus (Just "Title") (Just "Descr") (Just "Bool query") (Just "Authors") Nothing)
246
247 hyperdataCorpus :: HyperdataCorpus
248 hyperdataCorpus = case decode corpusExample of
249 Just hp -> hp
250 Nothing -> defaultCorpus
251
252 instance Arbitrary HyperdataCorpus where
253 arbitrary = pure hyperdataCorpus -- TODO
254
255 ------------------------------------------------------------------------
256 data HyperdataAnnuaire = HyperdataAnnuaire { hyperdataAnnuaire_title :: Maybe Text
257 , hyperdataAnnuaire_desc :: Maybe Text
258 } deriving (Show, Generic)
259 $(deriveJSON (unPrefix "hyperdataAnnuaire_") ''HyperdataAnnuaire)
260
261 instance Hyperdata HyperdataAnnuaire
262
263 hyperdataAnnuaire :: HyperdataAnnuaire
264 hyperdataAnnuaire = HyperdataAnnuaire (Just "Annuaire Title") (Just "Annuaire Description")
265
266 instance Arbitrary HyperdataAnnuaire where
267 arbitrary = pure hyperdataAnnuaire -- TODO
268
269 ------------------------------------------------------------------------
270 newtype HyperdataAny = HyperdataAny Object
271 deriving (Show, Generic, ToJSON, FromJSON)
272
273 instance Hyperdata HyperdataAny
274
275 instance Arbitrary HyperdataAny where
276 arbitrary = pure $ HyperdataAny mempty -- TODO produce arbitrary objects
277 ------------------------------------------------------------------------
278
279 data HyperdataList = HyperdataList { hyperdataList_preferences :: Maybe Text
280 } deriving (Show, Generic)
281 $(deriveJSON (unPrefix "hyperdataList_") ''HyperdataList)
282
283 instance Hyperdata HyperdataList
284 ------------------------------------------------------------------------
285 data HyperdataScore = HyperdataScore { hyperdataScore_preferences :: Maybe Text
286 } deriving (Show, Generic)
287 $(deriveJSON (unPrefix "hyperdataScore_") ''HyperdataScore)
288
289 instance Hyperdata HyperdataScore
290
291 ------------------------------------------------------------------------
292
293 data HyperdataResource = HyperdataResource { hyperdataResource_preferences :: Maybe Text
294 } deriving (Show, Generic)
295 $(deriveJSON (unPrefix "hyperdataResource_") ''HyperdataResource)
296
297 instance Hyperdata HyperdataResource
298
299 ------------------------------------------------------------------------
300 data HyperdataDashboard = HyperdataDashboard { hyperdataDashboard_preferences :: Maybe Text
301 } deriving (Show, Generic)
302 $(deriveJSON (unPrefix "hyperdataDashboard_") ''HyperdataDashboard)
303
304 instance Hyperdata HyperdataDashboard
305
306 -- TODO add the Graph Structure here
307 data HyperdataGraph = HyperdataGraph { hyperdataGraph_preferences :: Maybe Text
308 } deriving (Show, Generic)
309 $(deriveJSON (unPrefix "hyperdataGraph_") ''HyperdataGraph)
310
311 instance Hyperdata HyperdataGraph
312 ------------------------------------------------------------------------
313
314 -- TODO add the Graph Structure here
315 data HyperdataPhylo = HyperdataPhylo { hyperdataPhylo_preferences :: Maybe Text
316 } deriving (Show, Generic)
317 $(deriveJSON (unPrefix "hyperdataPhylo_") ''HyperdataPhylo)
318
319 instance Hyperdata HyperdataPhylo
320
321 ------------------------------------------------------------------------
322 -- | TODO FEATURE: Notebook saved in the node
323 data HyperdataNotebook = HyperdataNotebook { hyperdataNotebook_preferences :: Maybe Text
324 } deriving (Show, Generic)
325 $(deriveJSON (unPrefix "hyperdataNotebook_") ''HyperdataNotebook)
326
327 instance Hyperdata HyperdataNotebook
328
329
330 -- | NodePoly indicates that Node has a Polymorphism Type
331 type Node json = NodePoly NodeId NodeTypeId NodeUserId (Maybe NodeParentId) NodeName UTCTime json
332
333 -- type Node json = NodePoly NodeId NodeTypeId UserId ParentId NodeName UTCTime json
334 type NodeTypeId = Int
335 type NodeParentId = Int
336 type NodeUserId = Int
337 type NodeName = Text
338 type TSVector = Text
339
340
341 -- | Then a Node can be either a Folder or a Corpus or a Document
342 type NodeUser = Node HyperdataUser
343 type NodeFolder = Node HyperdataFolder
344
345 type NodeCorpus = Node HyperdataCorpus
346 type NodeCorpusV3 = Node HyperdataCorpus
347 type NodeDocument = Node HyperdataDocument
348
349 type NodeAnnuaire = Node HyperdataAnnuaire
350
351 -- | Any others nodes
352 type NodeAny = Node HyperdataAny
353
354 ---- | Then a Node can be either a Graph or a Phylo or a Notebook
355 type NodeList = Node HyperdataList
356 type NodeGraph = Node HyperdataGraph
357 type NodePhylo = Node HyperdataPhylo
358 type NodeNotebook = Node HyperdataNotebook
359 ------------------------------------------------------------------------
360 data NodeType = NodeUser
361 | NodeFolder
362 | NodeCorpus | NodeCorpusV3 | NodeDocument
363 | NodeAnnuaire | NodeContact
364 -- | NodeOccurrences
365 | NodeGraph
366 | NodeDashboard | NodeChart
367 -- | Classification
368 | NodeList
369 -- | Metrics
370 deriving (Show, Read, Eq, Generic, Bounded, Enum)
371
372 allNodeTypes :: [NodeType]
373 allNodeTypes = [minBound ..]
374
375 instance FromJSON NodeType
376 instance ToJSON NodeType
377
378 instance FromHttpApiData NodeType
379 where
380 parseUrlPiece = Right . read . unpack
381
382 instance ToParamSchema NodeType
383 instance ToSchema NodeType
384
385 ------------------------------------------------------------------------
386 data NodePoly id typename userId
387 parentId name date
388 hyperdata = Node { _node_id :: id
389 , _node_typename :: typename
390
391 , _node_userId :: userId
392 , _node_parentId :: parentId
393
394 , _node_name :: name
395 , _node_date :: date
396
397 , _node_hyperdata :: hyperdata
398 } deriving (Show, Generic)
399 $(deriveJSON (unPrefix "_node_") ''NodePoly)
400 $(makeLenses ''NodePoly)
401
402
403 data NodePolySearch id typename userId
404 parentId name date
405 hyperdata search = NodeSearch { _ns_id :: id
406 , _ns_typename :: typename
407 , _ns_userId :: userId
408 -- , nodeUniqId :: hashId
409 , _ns_parentId :: parentId
410 , _ns_name :: name
411 , _ns_date :: date
412
413 , _ns_hyperdata :: hyperdata
414 , _ns_search :: search
415 } deriving (Show, Generic)
416 $(deriveJSON (unPrefix "_ns_") ''NodePolySearch)
417 $(makeLenses ''NodePolySearch)
418
419 type NodeSearch json = NodePolySearch NodeId NodeTypeId NodeUserId (Maybe NodeParentId) NodeName UTCTime json (Maybe TSVector)
420 ------------------------------------------------------------------------
421
422
423 instance (Arbitrary hyperdata
424 ,Arbitrary nodeId
425 ,Arbitrary nodeTypeId
426 ,Arbitrary nodeUserId
427 ,Arbitrary nodeParentId
428 ) => Arbitrary (NodePoly nodeId nodeTypeId nodeUserId nodeParentId
429 NodeName UTCTime hyperdata) where
430 --arbitrary = Node 1 1 (Just 1) 1 "name" (jour 2018 01 01) (arbitrary) (Just "")
431 arbitrary = Node <$> arbitrary <*> arbitrary <*> arbitrary
432 <*> arbitrary <*> arbitrary <*> arbitrary
433 <*> arbitrary
434
435 instance (Arbitrary hyperdata
436 ,Arbitrary nodeId
437 ,Arbitrary nodeTypeId
438 ,Arbitrary nodeUserId
439 ,Arbitrary nodeParentId
440 ) => Arbitrary (NodePolySearch nodeId nodeTypeId nodeUserId nodeParentId
441 NodeName UTCTime hyperdata (Maybe TSVector)) where
442 --arbitrary = Node 1 1 (Just 1) 1 "name" (jour 2018 01 01) (arbitrary) (Just "")
443 arbitrary = NodeSearch <$> arbitrary <*> arbitrary <*> arbitrary
444 <*> arbitrary <*> arbitrary <*> arbitrary
445 <*> arbitrary <*> arbitrary
446
447
448 ------------------------------------------------------------------------
449 hyperdataDocument :: HyperdataDocument
450 hyperdataDocument = case decode docExample of
451 Just hp -> hp
452 Nothing -> HyperdataDocument Nothing Nothing Nothing Nothing
453 Nothing Nothing Nothing Nothing
454 Nothing Nothing Nothing Nothing
455 Nothing Nothing Nothing Nothing
456 Nothing Nothing Nothing
457 docExample :: ByteString
458 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}"
459
460 instance ToSchema HyperdataCorpus where
461 declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
462 L.& mapped.schema.description ?~ "a corpus"
463 L.& mapped.schema.example ?~ toJSON hyperdataCorpus
464
465
466 instance ToSchema HyperdataAnnuaire where
467 declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
468 L.& mapped.schema.description ?~ "an annuaire"
469 L.& mapped.schema.example ?~ toJSON hyperdataAnnuaire
470
471
472 instance ToSchema HyperdataDocument where
473 declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
474 L.& mapped.schema.description ?~ "a document"
475 L.& mapped.schema.example ?~ toJSON hyperdataDocument
476
477
478 instance ToSchema HyperdataAny where
479 declareNamedSchema proxy =
480 pure $ genericNameSchema defaultSchemaOptions proxy mempty
481 L.& schema.description ?~ "a node"
482 L.& schema.example ?~ emptyObject -- TODO
483
484
485 instance ToSchema hyperdata =>
486 ToSchema (NodePoly NodeId NodeTypeId
487 (Maybe NodeUserId)
488 NodeParentId NodeName
489 UTCTime hyperdata
490 )
491
492 instance ToSchema hyperdata =>
493 ToSchema (NodePoly NodeId NodeTypeId
494 NodeUserId
495 (Maybe NodeParentId) NodeName
496 UTCTime hyperdata
497 )
498
499
500 instance ToSchema hyperdata =>
501 ToSchema (NodePolySearch NodeId NodeTypeId
502 (Maybe NodeUserId)
503 NodeParentId NodeName
504 UTCTime hyperdata (Maybe TSVector)
505 )
506
507 instance ToSchema hyperdata =>
508 ToSchema (NodePolySearch NodeId NodeTypeId
509 NodeUserId
510 (Maybe NodeParentId) NodeName
511 UTCTime hyperdata (Maybe TSVector)
512 )
513
514
515 instance ToSchema Status
516
517