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.Viz.Phylo (Phylo)
61 --import Gargantext.Database.Utils
62 ------------------------------------------------------------------------
63 newtype NodeId = NodeId Int
64 deriving (Show, Read, Generic, Num, Eq, Ord, Enum, ToJSONKey, FromJSONKey, ToJSON, FromJSON)
66 instance ToField NodeId where
67 toField (NodeId n) = toField n
70 instance FromField NodeId where
71 fromField field mdata = do
72 n <- fromField field mdata
74 then return $ NodeId n
77 instance ToSchema NodeId
79 instance FromHttpApiData NodeId where
80 parseUrlPiece n = pure $ NodeId $ (read . cs) n
82 instance ToParamSchema NodeId
83 instance Arbitrary NodeId where
84 arbitrary = NodeId <$> arbitrary
86 type ParentId = NodeId
87 type CorpusId = NodeId
89 type DocumentId = NodeId
90 type DocId = DocumentId -- todo: remove this
92 type MasterCorpusId = CorpusId
93 type UserCorpusId = CorpusId
97 type AnnuaireId = NodeId
98 type ContactId = NodeId
101 type MasterUserId = UserId
103 id2int :: NodeId -> Int
104 id2int (NodeId n) = n
107 type UTCTime' = UTCTime
109 instance Arbitrary UTCTime' where
110 arbitrary = elements $ timesAfter 100 D (jour 2000 01 01)
112 ------------------------------------------------------------------------
113 data Status = Status { status_failed :: !Int
114 , status_succeeded :: !Int
115 , status_remaining :: !Int
116 } deriving (Show, Generic)
117 $(deriveJSON (unPrefix "status_") ''Status)
119 instance Arbitrary Status where
120 arbitrary = Status <$> arbitrary <*> arbitrary <*> arbitrary
122 ------------------------------------------------------------------------
123 data StatusV3 = StatusV3 { statusV3_error :: !(Maybe Text)
124 , statusV3_action :: !(Maybe Text)
125 } deriving (Show, Generic)
126 $(deriveJSON (unPrefix "statusV3_") ''StatusV3)
127 ------------------------------------------------------------------------
129 -- Only Hyperdata types should be member of this type class.
132 ------------------------------------------------------------------------
133 data HyperdataDocumentV3 = HyperdataDocumentV3 { hyperdataDocumentV3_publication_day :: !(Maybe Int)
134 , hyperdataDocumentV3_language_iso2 :: !(Maybe Text)
135 , hyperdataDocumentV3_publication_second :: !(Maybe Int)
136 , hyperdataDocumentV3_publication_minute :: !(Maybe Int)
137 , hyperdataDocumentV3_publication_month :: !(Maybe Int)
138 , hyperdataDocumentV3_publication_hour :: !(Maybe Int)
139 , hyperdataDocumentV3_error :: !(Maybe Text)
140 , hyperdataDocumentV3_language_iso3 :: !(Maybe Text)
141 , hyperdataDocumentV3_authors :: !(Maybe Text)
142 , hyperdataDocumentV3_publication_year :: !(Maybe Int)
143 , hyperdataDocumentV3_publication_date :: !(Maybe Text)
144 , hyperdataDocumentV3_language_name :: !(Maybe Text)
145 , hyperdataDocumentV3_statuses :: !(Maybe [StatusV3])
146 , hyperdataDocumentV3_realdate_full_ :: !(Maybe Text)
147 , hyperdataDocumentV3_source :: !(Maybe Text)
148 , hyperdataDocumentV3_abstract :: !(Maybe Text)
149 , hyperdataDocumentV3_title :: !(Maybe Text)
150 } deriving (Show, Generic)
151 $(deriveJSON (unPrefix "hyperdataDocumentV3_") ''HyperdataDocumentV3)
153 instance Hyperdata HyperdataDocumentV3
155 ------------------------------------------------------------------------
156 data HyperdataDocument = HyperdataDocument { _hyperdataDocument_bdd :: !(Maybe Text)
157 , _hyperdataDocument_doi :: !(Maybe Text)
158 , _hyperdataDocument_url :: !(Maybe Text)
159 , _hyperdataDocument_uniqId :: !(Maybe Text)
160 , _hyperdataDocument_uniqIdBdd :: !(Maybe Text)
161 , _hyperdataDocument_page :: !(Maybe Int)
162 , _hyperdataDocument_title :: !(Maybe Text)
163 , _hyperdataDocument_authors :: !(Maybe Text)
164 , _hyperdataDocument_institutes :: !(Maybe Text)
165 , _hyperdataDocument_source :: !(Maybe Text)
166 , _hyperdataDocument_abstract :: !(Maybe Text)
167 , _hyperdataDocument_publication_date :: !(Maybe Text)
168 , _hyperdataDocument_publication_year :: !(Maybe Int)
169 , _hyperdataDocument_publication_month :: !(Maybe Int)
170 , _hyperdataDocument_publication_day :: !(Maybe Int)
171 , _hyperdataDocument_publication_hour :: !(Maybe Int)
172 , _hyperdataDocument_publication_minute :: !(Maybe Int)
173 , _hyperdataDocument_publication_second :: !(Maybe Int)
174 , _hyperdataDocument_language_iso2 :: !(Maybe Text)
175 } deriving (Show, Generic)
177 $(deriveJSON (unPrefix "_hyperdataDocument_") ''HyperdataDocument)
178 $(makeLenses ''HyperdataDocument)
180 class ToHyperdataDocument a where
181 toHyperdataDocument :: a -> HyperdataDocument
183 instance ToHyperdataDocument HyperdataDocument
185 toHyperdataDocument = identity
187 instance Eq HyperdataDocument where
188 (==) h1 h2 = (==) (_hyperdataDocument_uniqId h1) (_hyperdataDocument_uniqId h2)
190 instance Ord HyperdataDocument where
191 compare h1 h2 = compare (_hyperdataDocument_publication_date h1) (_hyperdataDocument_publication_date h2)
193 instance Hyperdata HyperdataDocument
195 instance ToField HyperdataDocument where
196 toField = toJSONField
198 instance Arbitrary HyperdataDocument where
199 arbitrary = elements arbitraryHyperdataDocuments
201 arbitraryHyperdataDocuments :: [HyperdataDocument]
202 arbitraryHyperdataDocuments =
203 map toHyperdataDocument' ([ ("AI is big but less than crypto", "Troll System journal")
204 , ("Crypto is big but less than AI", "System Troll review" )
205 , ("Science is magic" , "Closed Source review")
206 , ("Open science for all" , "No Time" )
207 , ("Closed science for me" , "No Space" )
210 toHyperdataDocument' (t1,t2) =
211 HyperdataDocument Nothing Nothing Nothing Nothing Nothing Nothing (Just t1)
212 Nothing Nothing (Just t2) Nothing Nothing Nothing Nothing Nothing
213 Nothing Nothing Nothing Nothing
215 ------------------------------------------------------------------------
216 data LanguageNodes = LanguageNodes { languageNodes___unknown__ :: [Int]}
217 deriving (Show, Generic)
218 $(deriveJSON (unPrefix "languageNodes_") ''LanguageNodes)
220 ------------------------------------------------------------------------
221 -- level: debug | dev (fatal = critical)
222 data EventLevel = CRITICAL | FATAL | ERROR | WARNING | INFO | DEBUG
223 deriving (Show, Generic, Enum, Bounded)
225 instance FromJSON EventLevel
226 instance ToJSON EventLevel
228 instance Arbitrary EventLevel where
229 arbitrary = elements [minBound..maxBound]
231 instance ToSchema EventLevel where
232 declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
234 ------------------------------------------------------------------------
236 data Event = Event { event_level :: !EventLevel
237 , event_message :: !Text
238 , event_date :: !UTCTime
239 } deriving (Show, Generic)
240 $(deriveJSON (unPrefix "event_") ''Event)
242 instance Arbitrary Event where
243 arbitrary = Event <$> arbitrary <*> arbitrary <*> arbitrary
245 instance ToSchema Event where
246 declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
248 ------------------------------------------------------------------------
249 instance Arbitrary Text where
250 arbitrary = elements $ map (\c -> pack [c]) ['a'..'z']
252 data Resource = Resource { resource_path :: !(Maybe Text)
253 , resource_scraper :: !(Maybe Text)
254 , resource_query :: !(Maybe Text)
255 , resource_events :: !([Event])
256 , resource_status :: !Status
257 , resource_date :: !UTCTime'
258 } deriving (Show, Generic)
259 $(deriveJSON (unPrefix "resource_") ''Resource)
261 instance Arbitrary Resource where
262 arbitrary = Resource <$> arbitrary
269 instance ToSchema Resource where
270 declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
272 ------------------------------------------------------------------------
273 data HyperdataUser = HyperdataUser { hyperdataUser_language :: Maybe Text
274 } deriving (Show, Generic)
275 $(deriveJSON (unPrefix "hyperdataUser_") ''HyperdataUser)
277 instance Hyperdata HyperdataUser
278 ------------------------------------------------------------------------
279 data HyperdataFolder = HyperdataFolder { hyperdataFolder_desc :: Maybe Text
280 } deriving (Show, Generic)
281 $(deriveJSON (unPrefix "hyperdataFolder_") ''HyperdataFolder)
283 instance Hyperdata HyperdataFolder
284 ------------------------------------------------------------------------
285 data HyperdataCorpus = HyperdataCorpus { hyperdataCorpus_title :: !(Maybe Text)
286 , hyperdataCorpus_desc :: !(Maybe Text)
287 , hyperdataCorpus_query :: !(Maybe Text)
288 , hyperdataCorpus_authors :: !(Maybe Text)
289 , hyperdataCorpus_resources :: !(Maybe [Resource])
290 } deriving (Show, Generic)
291 $(deriveJSON (unPrefix "hyperdataCorpus_") ''HyperdataCorpus)
293 instance Hyperdata HyperdataCorpus
295 corpusExample :: ByteString
296 corpusExample = "" -- TODO
298 defaultCorpus :: HyperdataCorpus
299 defaultCorpus = (HyperdataCorpus (Just "Title") (Just "Descr") (Just "Bool query") (Just "Authors") Nothing)
301 hyperdataCorpus :: HyperdataCorpus
302 hyperdataCorpus = case decode corpusExample of
304 Nothing -> defaultCorpus
306 instance Arbitrary HyperdataCorpus where
307 arbitrary = pure hyperdataCorpus -- TODO
309 ------------------------------------------------------------------------
310 data HyperdataAnnuaire = HyperdataAnnuaire { hyperdataAnnuaire_title :: !(Maybe Text)
311 , hyperdataAnnuaire_desc :: !(Maybe Text)
312 } deriving (Show, Generic)
313 $(deriveJSON (unPrefix "hyperdataAnnuaire_") ''HyperdataAnnuaire)
315 instance Hyperdata HyperdataAnnuaire
317 hyperdataAnnuaire :: HyperdataAnnuaire
318 hyperdataAnnuaire = HyperdataAnnuaire (Just "Annuaire Title") (Just "Annuaire Description")
320 instance Arbitrary HyperdataAnnuaire where
321 arbitrary = pure hyperdataAnnuaire -- TODO
323 ------------------------------------------------------------------------
324 newtype HyperdataAny = HyperdataAny Object
325 deriving (Show, Generic, ToJSON, FromJSON)
327 instance Hyperdata HyperdataAny
329 instance Arbitrary HyperdataAny where
330 arbitrary = pure $ HyperdataAny mempty -- TODO produce arbitrary objects
331 ------------------------------------------------------------------------
333 data HyperdataList = HyperdataList { hyperdataList_preferences :: !(Maybe Text)
334 } deriving (Show, Generic)
335 $(deriveJSON (unPrefix "hyperdataList_") ''HyperdataList)
337 instance Hyperdata HyperdataList
339 instance Arbitrary HyperdataList where
340 arbitrary = elements [HyperdataList (Just "from list A")]
343 data HyperdataListModel = HyperdataListModel { _hlm_params :: !(Int, Int)
345 , _hlm_score :: !(Maybe Double)
346 } deriving (Show, Generic)
348 instance Hyperdata HyperdataListModel
349 instance Arbitrary HyperdataListModel where
350 arbitrary = elements [HyperdataListModel (100,100) "models/example.model" Nothing]
352 $(deriveJSON (unPrefix "_hlm_") ''HyperdataListModel)
353 $(makeLenses ''HyperdataListModel)
355 ------------------------------------------------------------------------
356 data HyperdataScore = HyperdataScore { hyperdataScore_preferences :: !(Maybe Text)
357 } deriving (Show, Generic)
358 $(deriveJSON (unPrefix "hyperdataScore_") ''HyperdataScore)
360 instance Hyperdata HyperdataScore
362 ------------------------------------------------------------------------
364 data HyperdataResource = HyperdataResource { hyperdataResource_preferences :: !(Maybe Text)
365 } deriving (Show, Generic)
366 $(deriveJSON (unPrefix "hyperdataResource_") ''HyperdataResource)
368 instance Hyperdata HyperdataResource
370 ------------------------------------------------------------------------
371 data HyperdataDashboard = HyperdataDashboard { hyperdataDashboard_preferences :: !(Maybe Text)
372 } deriving (Show, Generic)
373 $(deriveJSON (unPrefix "hyperdataDashboard_") ''HyperdataDashboard)
375 instance Hyperdata HyperdataDashboard
377 -- TODO add the Graph Structure here
378 data HyperdataGraph = HyperdataGraph { hyperdataGraph_preferences :: !(Maybe Text)
379 } deriving (Show, Generic)
380 $(deriveJSON (unPrefix "hyperdataGraph_") ''HyperdataGraph)
382 instance Hyperdata HyperdataGraph
384 ------------------------------------------------------------------------
386 -- TODO add the Graph Structure here
387 data HyperdataPhylo = HyperdataPhylo { hyperdataPhylo_preferences :: !(Maybe Text)
388 , hyperdataPhylo_data :: !(Maybe Phylo)
389 } deriving (Show, Generic)
390 $(deriveJSON (unPrefix "hyperdataPhylo_") ''HyperdataPhylo)
392 instance Hyperdata HyperdataPhylo
394 ------------------------------------------------------------------------
395 -- | TODO FEATURE: Notebook saved in the node
396 data HyperdataNotebook = HyperdataNotebook { hyperdataNotebook_preferences :: !(Maybe Text)
397 } deriving (Show, Generic)
398 $(deriveJSON (unPrefix "hyperdataNotebook_") ''HyperdataNotebook)
400 instance Hyperdata HyperdataNotebook
403 -- | NodePoly indicates that Node has a Polymorphism Type
404 type Node json = NodePoly NodeId NodeTypeId UserId (Maybe ParentId) NodeName UTCTime json
406 -- type Node json = NodePoly NodeId NodeTypeId UserId ParentId NodeName UTCTime json
407 type NodeTypeId = Int
412 -- | Then a Node can be either a Folder or a Corpus or a Document
413 type NodeUser = Node HyperdataUser
414 type NodeFolder = Node HyperdataFolder
416 type NodeCorpus = Node HyperdataCorpus
417 type NodeCorpusV3 = Node HyperdataCorpus
418 type NodeDocument = Node HyperdataDocument
420 type NodeAnnuaire = Node HyperdataAnnuaire
422 -- | Any others nodes
423 type NodeAny = Node HyperdataAny
425 ---- | Then a Node can be either a Graph or a Phylo or a Notebook
426 type NodeList = Node HyperdataList
427 type NodeGraph = Node HyperdataGraph
428 type NodePhylo = Node HyperdataPhylo
429 type NodeNotebook = Node HyperdataNotebook
430 ------------------------------------------------------------------------
431 data NodeType = NodeUser
433 | NodeCorpus | NodeCorpusV3 | NodeDocument
434 | NodeAnnuaire | NodeContact
435 | NodeGraph | NodePhylo
436 | NodeDashboard | NodeChart
437 | NodeList | NodeListModel deriving (Show, Read, Eq, Generic, Bounded, Enum)
446 allNodeTypes :: [NodeType]
447 allNodeTypes = [minBound ..]
449 instance FromJSON NodeType
450 instance ToJSON NodeType
452 instance FromHttpApiData NodeType
454 parseUrlPiece = Right . read . unpack
456 instance ToParamSchema NodeType
457 instance ToSchema NodeType
459 ------------------------------------------------------------------------
460 data NodePoly id typename userId
462 hyperdata = Node { _node_id :: id
463 , _node_typename :: typename
465 , _node_userId :: userId
466 , _node_parentId :: parentId
471 , _node_hyperdata :: hyperdata
472 } deriving (Show, Generic)
473 $(deriveJSON (unPrefix "_node_") ''NodePoly)
474 $(makeLenses ''NodePoly)
477 data NodePolySearch id typename userId
479 hyperdata search = NodeSearch { _ns_id :: id
480 , _ns_typename :: typename
481 , _ns_userId :: userId
482 -- , nodeUniqId :: hashId
483 , _ns_parentId :: parentId
487 , _ns_hyperdata :: hyperdata
488 , _ns_search :: search
489 } deriving (Show, Generic)
490 $(deriveJSON (unPrefix "_ns_") ''NodePolySearch)
491 $(makeLenses ''NodePolySearch)
493 type NodeSearch json = NodePolySearch NodeId NodeTypeId UserId (Maybe ParentId) NodeName UTCTime json (Maybe TSVector)
494 ------------------------------------------------------------------------
497 instance (Arbitrary hyperdata
499 ,Arbitrary nodeTypeId
501 ,Arbitrary nodeParentId
502 ) => Arbitrary (NodePoly nodeId nodeTypeId userId nodeParentId
503 NodeName UTCTime hyperdata) where
504 --arbitrary = Node 1 1 (Just 1) 1 "name" (jour 2018 01 01) (arbitrary) (Just "")
505 arbitrary = Node <$> arbitrary <*> arbitrary <*> arbitrary
506 <*> arbitrary <*> arbitrary <*> arbitrary
509 instance (Arbitrary hyperdata
511 ,Arbitrary nodeTypeId
513 ,Arbitrary nodeParentId
514 ) => Arbitrary (NodePolySearch nodeId nodeTypeId userId nodeParentId
515 NodeName UTCTime hyperdata (Maybe TSVector)) where
516 --arbitrary = Node 1 1 (Just 1) 1 "name" (jour 2018 01 01) (arbitrary) (Just "")
517 arbitrary = NodeSearch <$> arbitrary <*> arbitrary <*> arbitrary
518 <*> arbitrary <*> arbitrary <*> arbitrary
519 <*> arbitrary <*> arbitrary
522 ------------------------------------------------------------------------
523 hyperdataDocument :: HyperdataDocument
524 hyperdataDocument = case decode docExample of
526 Nothing -> HyperdataDocument Nothing Nothing Nothing Nothing
527 Nothing Nothing Nothing Nothing
528 Nothing Nothing Nothing Nothing
529 Nothing Nothing Nothing Nothing
530 Nothing Nothing Nothing
531 docExample :: ByteString
532 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}"
534 instance ToSchema HyperdataCorpus where
535 declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
536 & mapped.schema.description ?~ "a corpus"
537 & mapped.schema.example ?~ toJSON hyperdataCorpus
539 instance ToSchema HyperdataAnnuaire where
540 declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
541 & mapped.schema.description ?~ "an annuaire"
542 & mapped.schema.example ?~ toJSON hyperdataAnnuaire
544 instance ToSchema HyperdataDocument where
545 declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
546 & mapped.schema.description ?~ "a document"
547 & mapped.schema.example ?~ toJSON hyperdataDocument
549 instance ToSchema HyperdataAny where
550 declareNamedSchema proxy =
551 pure $ genericNameSchema defaultSchemaOptions proxy mempty
552 & schema.description ?~ "a node"
553 & schema.example ?~ emptyObject -- TODO
556 instance ToSchema hyperdata =>
557 ToSchema (NodePoly NodeId NodeTypeId
563 instance ToSchema hyperdata =>
564 ToSchema (NodePoly NodeId NodeTypeId
566 (Maybe ParentId) NodeName
571 instance ToSchema hyperdata =>
572 ToSchema (NodePolySearch NodeId NodeTypeId
575 UTCTime hyperdata (Maybe TSVector)
578 instance ToSchema hyperdata =>
579 ToSchema (NodePolySearch NodeId NodeTypeId
581 (Maybe ParentId) NodeName
582 UTCTime hyperdata (Maybe TSVector)
586 instance ToSchema Status