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
12 {-# OPTIONS_GHC -fno-warn-orphans #-}
14 {-# LANGUAGE BangPatterns #-}
15 {-# LANGUAGE DeriveGeneric #-}
16 {-# LANGUAGE FlexibleInstances #-}
17 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
18 {-# LANGUAGE NoImplicitPrelude #-}
19 {-# LANGUAGE OverloadedStrings #-}
20 {-# LANGUAGE TemplateHaskell #-}
21 -- {-# LANGUAGE DuplicateRecordFields #-}
23 module Gargantext.Database.Types.Node
26 import Prelude (Enum, Bounded, minBound, maxBound)
28 import GHC.Generics (Generic)
30 import Control.Lens hiding (elements)
31 import qualified Control.Lens as L
32 import Control.Applicative ((<*>))
35 import Data.Aeson.Types (emptyObject)
36 import Data.Aeson (Object, toJSON)
37 import Data.Aeson.TH (deriveJSON)
38 import Data.ByteString.Lazy (ByteString)
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))
47 import Text.Read (read)
48 import Text.Show (Show())
50 import Database.PostgreSQL.Simple.ToField (ToField, toField, toJSONField)
53 import Test.QuickCheck.Arbitrary
54 import Test.QuickCheck (elements)
56 import Gargantext.Prelude
57 import Gargantext.Core.Utils.Prefix (unPrefix)
58 ------------------------------------------------------------------------
61 type UTCTime' = UTCTime
63 instance Arbitrary UTCTime' where
64 arbitrary = elements $ timesAfter 100 D (jour 2000 01 01)
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)
73 instance Arbitrary Status where
74 arbitrary = Status <$> arbitrary <*> arbitrary <*> arbitrary
76 ------------------------------------------------------------------------
77 data StatusV3 = StatusV3 { statusV3_error :: Maybe Text
78 , statusV3_action :: Maybe Text
79 } deriving (Show, Generic)
80 $(deriveJSON (unPrefix "statusV3_") ''StatusV3)
81 ------------------------------------------------------------------------
83 -- Only Hyperdata types should be member of this type class.
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)
107 instance Hyperdata HyperdataDocumentV3
108 ------------------------------------------------------------------------
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)
134 instance Eq HyperdataDocument where
135 (==) h1 h2 = (==) (_hyperdataDocument_uniqId h1) (_hyperdataDocument_uniqId h2)
137 instance Ord HyperdataDocument where
138 compare h1 h2 = compare (_hyperdataDocument_uniqId h1) (_hyperdataDocument_uniqId h2)
140 instance Hyperdata HyperdataDocument
142 instance ToField HyperdataDocument where
143 toField = toJSONField
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
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" )
160 instance Arbitrary HyperdataDocument where
161 arbitrary = elements hyperdataDocuments
163 ------------------------------------------------------------------------
164 data LanguageNodes = LanguageNodes { languageNodes___unknown__ :: [Int]}
165 deriving (Show, Generic)
166 $(deriveJSON (unPrefix "languageNodes_") ''LanguageNodes)
168 ------------------------------------------------------------------------
169 -- level: debug | dev (fatal = critical)
170 data EventLevel = CRITICAL | FATAL | ERROR | WARNING | INFO | DEBUG
171 deriving (Show, Generic, Enum, Bounded)
173 instance FromJSON EventLevel
174 instance ToJSON EventLevel
176 instance Arbitrary EventLevel where
177 arbitrary = elements [minBound..maxBound]
179 instance ToSchema EventLevel where
180 declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
182 ------------------------------------------------------------------------
184 data Event = Event { event_level :: EventLevel
185 , event_message :: Text
186 , event_date :: UTCTime
187 } deriving (Show, Generic)
188 $(deriveJSON (unPrefix "event_") ''Event)
190 instance Arbitrary Event where
191 arbitrary = Event <$> arbitrary <*> arbitrary <*> arbitrary
193 instance ToSchema Event where
194 declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
196 ------------------------------------------------------------------------
200 instance Arbitrary Text' where
201 arbitrary = elements ["ici", "la"]
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)
212 instance Arbitrary Resource where
213 arbitrary = Resource <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
215 instance ToSchema Resource where
216 declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
218 ------------------------------------------------------------------------
219 data HyperdataUser = HyperdataUser { hyperdataUser_language :: Maybe Text
220 } deriving (Show, Generic)
221 $(deriveJSON (unPrefix "hyperdataUser_") ''HyperdataUser)
223 instance Hyperdata HyperdataUser
224 ------------------------------------------------------------------------
225 data HyperdataFolder = HyperdataFolder { hyperdataFolder_desc :: Maybe Text
226 } deriving (Show, Generic)
227 $(deriveJSON (unPrefix "hyperdataFolder_") ''HyperdataFolder)
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)
239 instance Hyperdata HyperdataCorpus
241 corpusExample :: ByteString
242 corpusExample = "" -- TODO
244 defaultCorpus :: HyperdataCorpus
245 defaultCorpus = (HyperdataCorpus (Just "Title") (Just "Descr") (Just "Bool query") (Just "Authors") Nothing)
247 hyperdataCorpus :: HyperdataCorpus
248 hyperdataCorpus = case decode corpusExample of
250 Nothing -> defaultCorpus
252 instance Arbitrary HyperdataCorpus where
253 arbitrary = pure hyperdataCorpus -- TODO
255 ------------------------------------------------------------------------
256 data HyperdataAnnuaire = HyperdataAnnuaire { hyperdataAnnuaire_title :: Maybe Text
257 , hyperdataAnnuaire_desc :: Maybe Text
258 } deriving (Show, Generic)
259 $(deriveJSON (unPrefix "hyperdataAnnuaire_") ''HyperdataAnnuaire)
261 instance Hyperdata HyperdataAnnuaire
263 hyperdataAnnuaire :: HyperdataAnnuaire
264 hyperdataAnnuaire = HyperdataAnnuaire (Just "Annuaire Title") (Just "Annuaire Description")
266 instance Arbitrary HyperdataAnnuaire where
267 arbitrary = pure hyperdataAnnuaire -- TODO
269 ------------------------------------------------------------------------
270 newtype HyperdataAny = HyperdataAny Object
271 deriving (Show, Generic, ToJSON, FromJSON)
273 instance Hyperdata HyperdataAny
275 instance Arbitrary HyperdataAny where
276 arbitrary = pure $ HyperdataAny mempty -- TODO produce arbitrary objects
277 ------------------------------------------------------------------------
279 data HyperdataList = HyperdataList { hyperdataList_preferences :: Maybe Text
280 } deriving (Show, Generic)
281 $(deriveJSON (unPrefix "hyperdataList_") ''HyperdataList)
283 instance Hyperdata HyperdataList
284 ------------------------------------------------------------------------
285 data HyperdataScore = HyperdataScore { hyperdataScore_preferences :: Maybe Text
286 } deriving (Show, Generic)
287 $(deriveJSON (unPrefix "hyperdataScore_") ''HyperdataScore)
289 instance Hyperdata HyperdataScore
291 ------------------------------------------------------------------------
293 data HyperdataResource = HyperdataResource { hyperdataResource_preferences :: Maybe Text
294 } deriving (Show, Generic)
295 $(deriveJSON (unPrefix "hyperdataResource_") ''HyperdataResource)
297 instance Hyperdata HyperdataResource
299 ------------------------------------------------------------------------
300 data HyperdataDashboard = HyperdataDashboard { hyperdataDashboard_preferences :: Maybe Text
301 } deriving (Show, Generic)
302 $(deriveJSON (unPrefix "hyperdataDashboard_") ''HyperdataDashboard)
304 instance Hyperdata HyperdataDashboard
306 -- TODO add the Graph Structure here
307 data HyperdataGraph = HyperdataGraph { hyperdataGraph_preferences :: Maybe Text
308 } deriving (Show, Generic)
309 $(deriveJSON (unPrefix "hyperdataGraph_") ''HyperdataGraph)
311 instance Hyperdata HyperdataGraph
312 ------------------------------------------------------------------------
314 -- TODO add the Graph Structure here
315 data HyperdataPhylo = HyperdataPhylo { hyperdataPhylo_preferences :: Maybe Text
316 } deriving (Show, Generic)
317 $(deriveJSON (unPrefix "hyperdataPhylo_") ''HyperdataPhylo)
319 instance Hyperdata HyperdataPhylo
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)
327 instance Hyperdata HyperdataNotebook
330 -- | NodePoly indicates that Node has a Polymorphism Type
331 type Node json = NodePoly NodeId NodeTypeId NodeUserId (Maybe NodeParentId) NodeName UTCTime json
333 -- type Node json = NodePoly NodeId NodeTypeId UserId ParentId NodeName UTCTime json
334 type NodeTypeId = Int
335 type NodeParentId = Int
336 type NodeUserId = Int
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
345 type NodeCorpus = Node HyperdataCorpus
346 type NodeCorpusV3 = Node HyperdataCorpus
347 type NodeDocument = Node HyperdataDocument
349 type NodeAnnuaire = Node HyperdataAnnuaire
351 -- | Any others nodes
352 type NodeAny = Node HyperdataAny
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
362 | NodeCorpus | NodeCorpusV3 | NodeDocument
363 | NodeAnnuaire | NodeContact
366 | NodeDashboard | NodeChart
370 deriving (Show, Read, Eq, Generic, Bounded, Enum)
372 allNodeTypes :: [NodeType]
373 allNodeTypes = [minBound ..]
375 instance FromJSON NodeType
376 instance ToJSON NodeType
378 instance FromHttpApiData NodeType
380 parseUrlPiece = Right . read . unpack
382 instance ToParamSchema NodeType
383 instance ToSchema NodeType
385 ------------------------------------------------------------------------
386 data NodePoly id typename userId
388 hyperdata = Node { _node_id :: id
389 , _node_typename :: typename
391 , _node_userId :: userId
392 , _node_parentId :: parentId
397 , _node_hyperdata :: hyperdata
398 } deriving (Show, Generic)
399 $(deriveJSON (unPrefix "_node_") ''NodePoly)
400 $(makeLenses ''NodePoly)
403 data NodePolySearch id typename userId
405 hyperdata search = NodeSearch { _ns_id :: id
406 , _ns_typename :: typename
407 , _ns_userId :: userId
408 -- , nodeUniqId :: hashId
409 , _ns_parentId :: parentId
413 , _ns_hyperdata :: hyperdata
414 , _ns_search :: search
415 } deriving (Show, Generic)
416 $(deriveJSON (unPrefix "_ns_") ''NodePolySearch)
417 $(makeLenses ''NodePolySearch)
419 type NodeSearch json = NodePolySearch NodeId NodeTypeId NodeUserId (Maybe NodeParentId) NodeName UTCTime json (Maybe TSVector)
420 ------------------------------------------------------------------------
423 instance (Arbitrary hyperdata
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
435 instance (Arbitrary hyperdata
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
448 ------------------------------------------------------------------------
449 hyperdataDocument :: HyperdataDocument
450 hyperdataDocument = case decode docExample of
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}"
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
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
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
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
485 instance ToSchema hyperdata =>
486 ToSchema (NodePoly NodeId NodeTypeId
488 NodeParentId NodeName
492 instance ToSchema hyperdata =>
493 ToSchema (NodePoly NodeId NodeTypeId
495 (Maybe NodeParentId) NodeName
500 instance ToSchema hyperdata =>
501 ToSchema (NodePolySearch NodeId NodeTypeId
503 NodeParentId NodeName
504 UTCTime hyperdata (Maybe TSVector)
507 instance ToSchema hyperdata =>
508 ToSchema (NodePolySearch NodeId NodeTypeId
510 (Maybe NodeParentId) NodeName
511 UTCTime hyperdata (Maybe TSVector)
515 instance ToSchema Status