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 GeneralizedNewtypeDeriving #-}
22 -- {-# LANGUAGE DuplicateRecordFields #-}
24 module Gargantext.Database.Types.Node
27 import Prelude (Enum, Bounded, minBound, maxBound)
29 import GHC.Generics (Generic)
31 import Control.Lens hiding (elements, (&))
32 import Control.Applicative ((<*>))
33 import Control.Monad (mzero)
36 import Data.Aeson.Types (emptyObject)
37 import Data.Aeson (Object, toJSON)
38 import Data.Aeson.TH (deriveJSON)
39 import Data.ByteString.Lazy (ByteString)
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))
48 import Text.Read (read)
49 import Text.Show (Show())
51 import Database.PostgreSQL.Simple.ToField (ToField, toField, toJSONField)
52 import Database.PostgreSQL.Simple.FromField (FromField, fromField)
55 import Test.QuickCheck.Arbitrary
56 import Test.QuickCheck (elements)
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)
65 instance ToField NodeId where
66 toField (NodeId n) = toField n
69 instance FromField NodeId where
70 fromField field mdata = do
71 n <- fromField field mdata
73 then return $ NodeId n
76 instance ToSchema NodeId
78 instance FromHttpApiData NodeId where
79 parseUrlPiece n = pure $ NodeId $ (read . cs) n
81 instance ToParamSchema NodeId
82 instance Arbitrary NodeId where
83 arbitrary = NodeId <$> arbitrary
85 type ParentId = NodeId
86 type CorpusId = NodeId
88 type DocumentId = NodeId
89 type DocId = DocumentId -- todo: remove this
91 type MasterCorpusId = CorpusId
92 type UserCorpusId = CorpusId
96 type AnnuaireId = NodeId
97 type ContactId = NodeId
100 type MasterUserId = UserId
102 id2int :: NodeId -> Int
103 id2int (NodeId n) = n
106 type UTCTime' = UTCTime
108 instance Arbitrary UTCTime' where
109 arbitrary = elements $ timesAfter 100 D (jour 2000 01 01)
111 ------------------------------------------------------------------------
112 data Status = Status { status_failed :: !Int
113 , status_succeeded :: !Int
114 , status_remaining :: !Int
115 } deriving (Show, Generic)
116 $(deriveJSON (unPrefix "status_") ''Status)
118 instance Arbitrary Status where
119 arbitrary = Status <$> arbitrary <*> arbitrary <*> arbitrary
121 ------------------------------------------------------------------------
122 data StatusV3 = StatusV3 { statusV3_error :: !(Maybe Text)
123 , statusV3_action :: !(Maybe Text)
124 } deriving (Show, Generic)
125 $(deriveJSON (unPrefix "statusV3_") ''StatusV3)
126 ------------------------------------------------------------------------
128 -- Only Hyperdata types should be member of this type class.
131 ------------------------------------------------------------------------
132 data HyperdataDocumentV3 = HyperdataDocumentV3 { hyperdataDocumentV3_publication_day :: !(Maybe Int)
133 , hyperdataDocumentV3_language_iso2 :: !(Maybe Text)
134 , hyperdataDocumentV3_publication_second :: !(Maybe Int)
135 , hyperdataDocumentV3_publication_minute :: !(Maybe Int)
136 , hyperdataDocumentV3_publication_month :: !(Maybe Int)
137 , hyperdataDocumentV3_publication_hour :: !(Maybe Int)
138 , hyperdataDocumentV3_error :: !(Maybe Text)
139 , hyperdataDocumentV3_language_iso3 :: !(Maybe Text)
140 , hyperdataDocumentV3_authors :: !(Maybe Text)
141 , hyperdataDocumentV3_publication_year :: !(Maybe Int)
142 , hyperdataDocumentV3_publication_date :: !(Maybe Text)
143 , hyperdataDocumentV3_language_name :: !(Maybe Text)
144 , hyperdataDocumentV3_statuses :: !(Maybe [StatusV3])
145 , hyperdataDocumentV3_realdate_full_ :: !(Maybe Text)
146 , hyperdataDocumentV3_source :: !(Maybe Text)
147 , hyperdataDocumentV3_abstract :: !(Maybe Text)
148 , hyperdataDocumentV3_title :: !(Maybe Text)
149 } deriving (Show, Generic)
150 $(deriveJSON (unPrefix "hyperdataDocumentV3_") ''HyperdataDocumentV3)
152 instance Hyperdata HyperdataDocumentV3
154 ------------------------------------------------------------------------
155 data HyperdataDocument = HyperdataDocument { _hyperdataDocument_bdd :: !(Maybe Text)
156 , _hyperdataDocument_doi :: !(Maybe Text)
157 , _hyperdataDocument_url :: !(Maybe Text)
158 , _hyperdataDocument_uniqId :: !(Maybe Text)
159 , _hyperdataDocument_uniqIdBdd :: !(Maybe Text)
160 , _hyperdataDocument_page :: !(Maybe Int)
161 , _hyperdataDocument_title :: !(Maybe Text)
162 , _hyperdataDocument_authors :: !(Maybe Text)
163 , _hyperdataDocument_institutes :: !(Maybe Text)
164 , _hyperdataDocument_source :: !(Maybe Text)
165 , _hyperdataDocument_abstract :: !(Maybe Text)
166 , _hyperdataDocument_publication_date :: !(Maybe Text)
167 , _hyperdataDocument_publication_year :: !(Maybe Int)
168 , _hyperdataDocument_publication_month :: !(Maybe Int)
169 , _hyperdataDocument_publication_day :: !(Maybe Int)
170 , _hyperdataDocument_publication_hour :: !(Maybe Int)
171 , _hyperdataDocument_publication_minute :: !(Maybe Int)
172 , _hyperdataDocument_publication_second :: !(Maybe Int)
173 , _hyperdataDocument_language_iso2 :: !(Maybe Text)
174 } deriving (Show, Generic)
176 $(deriveJSON (unPrefix "_hyperdataDocument_") ''HyperdataDocument)
177 $(makeLenses ''HyperdataDocument)
179 class ToHyperdataDocument a where
180 toHyperdataDocument :: a -> HyperdataDocument
182 instance ToHyperdataDocument HyperdataDocument
184 toHyperdataDocument = identity
186 instance Eq HyperdataDocument where
187 (==) h1 h2 = (==) (_hyperdataDocument_uniqId h1) (_hyperdataDocument_uniqId h2)
189 instance Ord HyperdataDocument where
190 compare h1 h2 = compare (_hyperdataDocument_publication_date h1) (_hyperdataDocument_publication_date h2)
192 instance Hyperdata HyperdataDocument
194 instance ToField HyperdataDocument where
195 toField = toJSONField
197 instance Arbitrary HyperdataDocument where
198 arbitrary = elements arbitraryHyperdataDocuments
200 arbitraryHyperdataDocuments :: [HyperdataDocument]
201 arbitraryHyperdataDocuments =
202 map toHyperdataDocument' ([ ("AI is big but less than crypto", "Troll System journal")
203 , ("Crypto is big but less than AI", "System Troll review" )
204 , ("Science is magic" , "Closed Source review")
205 , ("Open science for all" , "No Time" )
206 , ("Closed science for me" , "No Space" )
209 toHyperdataDocument' (t1,t2) =
210 HyperdataDocument Nothing Nothing Nothing Nothing Nothing Nothing (Just t1)
211 Nothing Nothing (Just t2) Nothing Nothing Nothing Nothing Nothing
212 Nothing Nothing Nothing Nothing
214 ------------------------------------------------------------------------
215 data LanguageNodes = LanguageNodes { languageNodes___unknown__ :: [Int]}
216 deriving (Show, Generic)
217 $(deriveJSON (unPrefix "languageNodes_") ''LanguageNodes)
219 ------------------------------------------------------------------------
220 -- level: debug | dev (fatal = critical)
221 data EventLevel = CRITICAL | FATAL | ERROR | WARNING | INFO | DEBUG
222 deriving (Show, Generic, Enum, Bounded)
224 instance FromJSON EventLevel
225 instance ToJSON EventLevel
227 instance Arbitrary EventLevel where
228 arbitrary = elements [minBound..maxBound]
230 instance ToSchema EventLevel where
231 declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
233 ------------------------------------------------------------------------
235 data Event = Event { event_level :: !EventLevel
236 , event_message :: !Text
237 , event_date :: !UTCTime
238 } deriving (Show, Generic)
239 $(deriveJSON (unPrefix "event_") ''Event)
241 instance Arbitrary Event where
242 arbitrary = Event <$> arbitrary <*> arbitrary <*> arbitrary
244 instance ToSchema Event where
245 declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
247 ------------------------------------------------------------------------
248 instance Arbitrary Text where
249 arbitrary = elements $ map (\c -> pack [c]) ['a'..'z']
251 data Resource = Resource { resource_path :: !(Maybe Text)
252 , resource_scraper :: !(Maybe Text)
253 , resource_query :: !(Maybe Text)
254 , resource_events :: !([Event])
255 , resource_status :: !Status
256 , resource_date :: !UTCTime'
257 } deriving (Show, Generic)
258 $(deriveJSON (unPrefix "resource_") ''Resource)
260 instance Arbitrary Resource where
261 arbitrary = Resource <$> arbitrary
268 instance ToSchema Resource where
269 declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
271 ------------------------------------------------------------------------
272 data HyperdataUser = HyperdataUser { hyperdataUser_language :: Maybe Text
273 } deriving (Show, Generic)
274 $(deriveJSON (unPrefix "hyperdataUser_") ''HyperdataUser)
276 instance Hyperdata HyperdataUser
277 ------------------------------------------------------------------------
278 data HyperdataFolder = HyperdataFolder { hyperdataFolder_desc :: Maybe Text
279 } deriving (Show, Generic)
280 $(deriveJSON (unPrefix "hyperdataFolder_") ''HyperdataFolder)
282 instance Hyperdata HyperdataFolder
283 ------------------------------------------------------------------------
284 data HyperdataCorpus = HyperdataCorpus { hyperdataCorpus_title :: !(Maybe Text)
285 , hyperdataCorpus_desc :: !(Maybe Text)
286 , hyperdataCorpus_query :: !(Maybe Text)
287 , hyperdataCorpus_authors :: !(Maybe Text)
288 , hyperdataCorpus_resources :: !(Maybe [Resource])
289 } deriving (Show, Generic)
290 $(deriveJSON (unPrefix "hyperdataCorpus_") ''HyperdataCorpus)
292 instance Hyperdata HyperdataCorpus
294 corpusExample :: ByteString
295 corpusExample = "" -- TODO
297 defaultCorpus :: HyperdataCorpus
298 defaultCorpus = (HyperdataCorpus (Just "Title") (Just "Descr") (Just "Bool query") (Just "Authors") Nothing)
300 hyperdataCorpus :: HyperdataCorpus
301 hyperdataCorpus = case decode corpusExample of
303 Nothing -> defaultCorpus
305 instance Arbitrary HyperdataCorpus where
306 arbitrary = pure hyperdataCorpus -- TODO
308 ------------------------------------------------------------------------
309 data HyperdataAnnuaire = HyperdataAnnuaire { hyperdataAnnuaire_title :: !(Maybe Text)
310 , hyperdataAnnuaire_desc :: !(Maybe Text)
311 } deriving (Show, Generic)
312 $(deriveJSON (unPrefix "hyperdataAnnuaire_") ''HyperdataAnnuaire)
314 instance Hyperdata HyperdataAnnuaire
316 hyperdataAnnuaire :: HyperdataAnnuaire
317 hyperdataAnnuaire = HyperdataAnnuaire (Just "Annuaire Title") (Just "Annuaire Description")
319 instance Arbitrary HyperdataAnnuaire where
320 arbitrary = pure hyperdataAnnuaire -- TODO
322 ------------------------------------------------------------------------
323 newtype HyperdataAny = HyperdataAny Object
324 deriving (Show, Generic, ToJSON, FromJSON)
326 instance Hyperdata HyperdataAny
328 instance Arbitrary HyperdataAny where
329 arbitrary = pure $ HyperdataAny mempty -- TODO produce arbitrary objects
330 ------------------------------------------------------------------------
332 data HyperdataList = HyperdataList { hyperdataList_preferences :: !(Maybe Text)
333 } deriving (Show, Generic)
334 $(deriveJSON (unPrefix "hyperdataList_") ''HyperdataList)
336 instance Hyperdata HyperdataList
338 instance Arbitrary HyperdataList where
339 arbitrary = elements [HyperdataList (Just "from list A")]
342 data HyperdataListModel = HyperdataListModel { _hlm_params :: !(Int, Int)
344 , _hlm_score :: !(Maybe Double)
345 } deriving (Show, Generic)
347 instance Hyperdata HyperdataListModel
348 instance Arbitrary HyperdataListModel where
349 arbitrary = elements [HyperdataListModel (100,100) "models/example.model" Nothing]
351 $(deriveJSON (unPrefix "_hlm_") ''HyperdataListModel)
352 $(makeLenses ''HyperdataListModel)
354 ------------------------------------------------------------------------
355 data HyperdataScore = HyperdataScore { hyperdataScore_preferences :: !(Maybe Text)
356 } deriving (Show, Generic)
357 $(deriveJSON (unPrefix "hyperdataScore_") ''HyperdataScore)
359 instance Hyperdata HyperdataScore
361 ------------------------------------------------------------------------
363 data HyperdataResource = HyperdataResource { hyperdataResource_preferences :: !(Maybe Text)
364 } deriving (Show, Generic)
365 $(deriveJSON (unPrefix "hyperdataResource_") ''HyperdataResource)
367 instance Hyperdata HyperdataResource
369 ------------------------------------------------------------------------
370 data HyperdataDashboard = HyperdataDashboard { hyperdataDashboard_preferences :: !(Maybe Text)
371 } deriving (Show, Generic)
372 $(deriveJSON (unPrefix "hyperdataDashboard_") ''HyperdataDashboard)
374 instance Hyperdata HyperdataDashboard
376 -- TODO add the Graph Structure here
377 data HyperdataGraph = HyperdataGraph { hyperdataGraph_preferences :: !(Maybe Text)
378 } deriving (Show, Generic)
379 $(deriveJSON (unPrefix "hyperdataGraph_") ''HyperdataGraph)
381 instance Hyperdata HyperdataGraph
382 ------------------------------------------------------------------------
384 -- TODO add the Graph Structure here
385 data HyperdataPhylo = HyperdataPhylo { hyperdataPhylo_preferences :: !(Maybe Text)
386 } deriving (Show, Generic)
387 $(deriveJSON (unPrefix "hyperdataPhylo_") ''HyperdataPhylo)
389 instance Hyperdata HyperdataPhylo
391 ------------------------------------------------------------------------
392 -- | TODO FEATURE: Notebook saved in the node
393 data HyperdataNotebook = HyperdataNotebook { hyperdataNotebook_preferences :: !(Maybe Text)
394 } deriving (Show, Generic)
395 $(deriveJSON (unPrefix "hyperdataNotebook_") ''HyperdataNotebook)
397 instance Hyperdata HyperdataNotebook
400 -- | NodePoly indicates that Node has a Polymorphism Type
401 type Node json = NodePoly NodeId NodeTypeId UserId (Maybe ParentId) NodeName UTCTime json
403 -- type Node json = NodePoly NodeId NodeTypeId UserId ParentId NodeName UTCTime json
404 type NodeTypeId = Int
409 -- | Then a Node can be either a Folder or a Corpus or a Document
410 type NodeUser = Node HyperdataUser
411 type NodeFolder = Node HyperdataFolder
413 type NodeCorpus = Node HyperdataCorpus
414 type NodeCorpusV3 = Node HyperdataCorpus
415 type NodeDocument = Node HyperdataDocument
417 type NodeAnnuaire = Node HyperdataAnnuaire
419 -- | Any others nodes
420 type NodeAny = Node HyperdataAny
422 ---- | Then a Node can be either a Graph or a Phylo or a Notebook
423 type NodeList = Node HyperdataList
424 type NodeGraph = Node HyperdataGraph
425 type NodePhylo = Node HyperdataPhylo
426 type NodeNotebook = Node HyperdataNotebook
427 ------------------------------------------------------------------------
428 data NodeType = NodeUser
430 | NodeCorpus | NodeCorpusV3 | NodeDocument
431 | NodeAnnuaire | NodeContact
433 | NodeDashboard | NodeChart
434 | NodeList | NodeListModel deriving (Show, Read, Eq, Generic, Bounded, Enum)
443 allNodeTypes :: [NodeType]
444 allNodeTypes = [minBound ..]
446 instance FromJSON NodeType
447 instance ToJSON NodeType
449 instance FromHttpApiData NodeType
451 parseUrlPiece = Right . read . unpack
453 instance ToParamSchema NodeType
454 instance ToSchema NodeType
456 ------------------------------------------------------------------------
457 data NodePoly id typename userId
459 hyperdata = Node { _node_id :: id
460 , _node_typename :: typename
462 , _node_userId :: userId
463 , _node_parentId :: parentId
468 , _node_hyperdata :: hyperdata
469 } deriving (Show, Generic)
470 $(deriveJSON (unPrefix "_node_") ''NodePoly)
471 $(makeLenses ''NodePoly)
474 data NodePolySearch id typename userId
476 hyperdata search = NodeSearch { _ns_id :: id
477 , _ns_typename :: typename
478 , _ns_userId :: userId
479 -- , nodeUniqId :: hashId
480 , _ns_parentId :: parentId
484 , _ns_hyperdata :: hyperdata
485 , _ns_search :: search
486 } deriving (Show, Generic)
487 $(deriveJSON (unPrefix "_ns_") ''NodePolySearch)
488 $(makeLenses ''NodePolySearch)
490 type NodeSearch json = NodePolySearch NodeId NodeTypeId UserId (Maybe ParentId) NodeName UTCTime json (Maybe TSVector)
491 ------------------------------------------------------------------------
494 instance (Arbitrary hyperdata
496 ,Arbitrary nodeTypeId
498 ,Arbitrary nodeParentId
499 ) => Arbitrary (NodePoly nodeId nodeTypeId userId nodeParentId
500 NodeName UTCTime hyperdata) where
501 --arbitrary = Node 1 1 (Just 1) 1 "name" (jour 2018 01 01) (arbitrary) (Just "")
502 arbitrary = Node <$> arbitrary <*> arbitrary <*> arbitrary
503 <*> arbitrary <*> arbitrary <*> arbitrary
506 instance (Arbitrary hyperdata
508 ,Arbitrary nodeTypeId
510 ,Arbitrary nodeParentId
511 ) => Arbitrary (NodePolySearch nodeId nodeTypeId userId nodeParentId
512 NodeName UTCTime hyperdata (Maybe TSVector)) where
513 --arbitrary = Node 1 1 (Just 1) 1 "name" (jour 2018 01 01) (arbitrary) (Just "")
514 arbitrary = NodeSearch <$> arbitrary <*> arbitrary <*> arbitrary
515 <*> arbitrary <*> arbitrary <*> arbitrary
516 <*> arbitrary <*> arbitrary
519 ------------------------------------------------------------------------
520 hyperdataDocument :: HyperdataDocument
521 hyperdataDocument = case decode docExample of
523 Nothing -> HyperdataDocument Nothing Nothing Nothing Nothing
524 Nothing Nothing Nothing Nothing
525 Nothing Nothing Nothing Nothing
526 Nothing Nothing Nothing Nothing
527 Nothing Nothing Nothing
528 docExample :: ByteString
529 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}"
531 instance ToSchema HyperdataCorpus where
532 declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
533 & mapped.schema.description ?~ "a corpus"
534 & mapped.schema.example ?~ toJSON hyperdataCorpus
536 instance ToSchema HyperdataAnnuaire where
537 declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
538 & mapped.schema.description ?~ "an annuaire"
539 & mapped.schema.example ?~ toJSON hyperdataAnnuaire
541 instance ToSchema HyperdataDocument where
542 declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
543 & mapped.schema.description ?~ "a document"
544 & mapped.schema.example ?~ toJSON hyperdataDocument
546 instance ToSchema HyperdataAny where
547 declareNamedSchema proxy =
548 pure $ genericNameSchema defaultSchemaOptions proxy mempty
549 & schema.description ?~ "a node"
550 & schema.example ?~ emptyObject -- TODO
553 instance ToSchema hyperdata =>
554 ToSchema (NodePoly NodeId NodeTypeId
560 instance ToSchema hyperdata =>
561 ToSchema (NodePoly NodeId NodeTypeId
563 (Maybe ParentId) NodeName
568 instance ToSchema hyperdata =>
569 ToSchema (NodePolySearch NodeId NodeTypeId
572 UTCTime hyperdata (Maybe TSVector)
575 instance ToSchema hyperdata =>
576 ToSchema (NodePolySearch NodeId NodeTypeId
578 (Maybe ParentId) NodeName
579 UTCTime hyperdata (Maybe TSVector)
583 instance ToSchema Status