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
68 instance FromField NodeId where
69 fromField field mdata = do
70 n <- fromField field mdata
72 then return $ NodeId n
75 instance ToSchema NodeId
77 instance FromHttpApiData NodeId where
78 parseUrlPiece n = pure $ NodeId $ (read . cs) n
80 instance ToParamSchema NodeId
81 instance Arbitrary NodeId where
82 arbitrary = NodeId <$> arbitrary
84 type ParentId = NodeId
85 type CorpusId = NodeId
87 type DocumentId = NodeId
88 type DocId = DocumentId -- todo: remove this
90 type MasterCorpusId = CorpusId
91 type UserCorpusId = CorpusId
95 type AnnuaireId = NodeId
96 type ContactId = NodeId
99 type MasterUserId = UserId
101 id2int :: NodeId -> Int
102 id2int (NodeId n) = n
105 type UTCTime' = UTCTime
107 instance Arbitrary UTCTime' where
108 arbitrary = elements $ timesAfter 100 D (jour 2000 01 01)
110 ------------------------------------------------------------------------
111 data Status = Status { status_failed :: !Int
112 , status_succeeded :: !Int
113 , status_remaining :: !Int
114 } deriving (Show, Generic)
115 $(deriveJSON (unPrefix "status_") ''Status)
117 instance Arbitrary Status where
118 arbitrary = Status <$> arbitrary <*> arbitrary <*> arbitrary
120 ------------------------------------------------------------------------
121 data StatusV3 = StatusV3 { statusV3_error :: !(Maybe Text)
122 , statusV3_action :: !(Maybe Text)
123 } deriving (Show, Generic)
124 $(deriveJSON (unPrefix "statusV3_") ''StatusV3)
125 ------------------------------------------------------------------------
127 -- Only Hyperdata types should be member of this type class.
130 ------------------------------------------------------------------------
131 data HyperdataDocumentV3 = HyperdataDocumentV3 { hyperdataDocumentV3_publication_day :: !(Maybe Int)
132 , hyperdataDocumentV3_language_iso2 :: !(Maybe Text)
133 , hyperdataDocumentV3_publication_second :: !(Maybe Int)
134 , hyperdataDocumentV3_publication_minute :: !(Maybe Int)
135 , hyperdataDocumentV3_publication_month :: !(Maybe Int)
136 , hyperdataDocumentV3_publication_hour :: !(Maybe Int)
137 , hyperdataDocumentV3_error :: !(Maybe Text)
138 , hyperdataDocumentV3_language_iso3 :: !(Maybe Text)
139 , hyperdataDocumentV3_authors :: !(Maybe Text)
140 , hyperdataDocumentV3_publication_year :: !(Maybe Int)
141 , hyperdataDocumentV3_publication_date :: !(Maybe Text)
142 , hyperdataDocumentV3_language_name :: !(Maybe Text)
143 , hyperdataDocumentV3_statuses :: !(Maybe [StatusV3])
144 , hyperdataDocumentV3_realdate_full_ :: !(Maybe Text)
145 , hyperdataDocumentV3_source :: !(Maybe Text)
146 , hyperdataDocumentV3_abstract :: !(Maybe Text)
147 , hyperdataDocumentV3_title :: !(Maybe Text)
148 } deriving (Show, Generic)
149 $(deriveJSON (unPrefix "hyperdataDocumentV3_") ''HyperdataDocumentV3)
151 instance Hyperdata HyperdataDocumentV3
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)
175 $(deriveJSON (unPrefix "_hyperdataDocument_") ''HyperdataDocument)
176 $(makeLenses ''HyperdataDocument)
178 class ToHyperdataDocument a where
179 toHyperdataDocument :: a -> HyperdataDocument
181 instance ToHyperdataDocument HyperdataDocument
183 toHyperdataDocument = identity
185 instance Eq HyperdataDocument where
186 (==) h1 h2 = (==) (_hyperdataDocument_uniqId h1) (_hyperdataDocument_uniqId h2)
188 instance Ord HyperdataDocument where
189 compare h1 h2 = compare (_hyperdataDocument_publication_date h1) (_hyperdataDocument_publication_date h2)
191 instance Hyperdata HyperdataDocument
193 instance ToField HyperdataDocument where
194 toField = toJSONField
196 instance Arbitrary HyperdataDocument where
197 arbitrary = elements arbitraryHyperdataDocuments
199 arbitraryHyperdataDocuments :: [HyperdataDocument]
200 arbitraryHyperdataDocuments =
201 map toHyperdataDocument' ([ ("AI is big but less than crypto", "Troll System journal")
202 , ("Crypto is big but less than AI", "System Troll review" )
203 , ("Science is magic" , "Closed Source review")
204 , ("Open science for all" , "No Time" )
205 , ("Closed science for me" , "No Space" )
208 toHyperdataDocument' (t1,t2) =
209 HyperdataDocument Nothing Nothing Nothing Nothing Nothing Nothing (Just t1)
210 Nothing Nothing (Just t2) Nothing Nothing Nothing Nothing Nothing
211 Nothing Nothing Nothing Nothing
213 ------------------------------------------------------------------------
214 data LanguageNodes = LanguageNodes { languageNodes___unknown__ :: [Int]}
215 deriving (Show, Generic)
216 $(deriveJSON (unPrefix "languageNodes_") ''LanguageNodes)
218 ------------------------------------------------------------------------
219 -- level: debug | dev (fatal = critical)
220 data EventLevel = CRITICAL | FATAL | ERROR | WARNING | INFO | DEBUG
221 deriving (Show, Generic, Enum, Bounded)
223 instance FromJSON EventLevel
224 instance ToJSON EventLevel
226 instance Arbitrary EventLevel where
227 arbitrary = elements [minBound..maxBound]
229 instance ToSchema EventLevel where
230 declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
232 ------------------------------------------------------------------------
234 data Event = Event { event_level :: !EventLevel
235 , event_message :: !Text
236 , event_date :: !UTCTime
237 } deriving (Show, Generic)
238 $(deriveJSON (unPrefix "event_") ''Event)
240 instance Arbitrary Event where
241 arbitrary = Event <$> arbitrary <*> arbitrary <*> arbitrary
243 instance ToSchema Event where
244 declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
246 ------------------------------------------------------------------------
247 instance Arbitrary Text where
248 arbitrary = elements $ map (\c -> pack [c]) ['a'..'z']
250 data Resource = Resource { resource_path :: !(Maybe Text)
251 , resource_scraper :: !(Maybe Text)
252 , resource_query :: !(Maybe Text)
253 , resource_events :: !([Event])
254 , resource_status :: !Status
255 , resource_date :: !UTCTime'
256 } deriving (Show, Generic)
257 $(deriveJSON (unPrefix "resource_") ''Resource)
259 instance Arbitrary Resource where
260 arbitrary = Resource <$> arbitrary
267 instance ToSchema Resource where
268 declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
270 ------------------------------------------------------------------------
271 data HyperdataUser = HyperdataUser { hyperdataUser_language :: Maybe Text
272 } deriving (Show, Generic)
273 $(deriveJSON (unPrefix "hyperdataUser_") ''HyperdataUser)
275 instance Hyperdata HyperdataUser
276 ------------------------------------------------------------------------
277 data HyperdataFolder = HyperdataFolder { hyperdataFolder_desc :: Maybe Text
278 } deriving (Show, Generic)
279 $(deriveJSON (unPrefix "hyperdataFolder_") ''HyperdataFolder)
281 instance Hyperdata HyperdataFolder
282 ------------------------------------------------------------------------
283 data HyperdataCorpus = HyperdataCorpus { hyperdataCorpus_title :: !(Maybe Text)
284 , hyperdataCorpus_desc :: !(Maybe Text)
285 , hyperdataCorpus_query :: !(Maybe Text)
286 , hyperdataCorpus_authors :: !(Maybe Text)
287 , hyperdataCorpus_resources :: !(Maybe [Resource])
288 } deriving (Show, Generic)
289 $(deriveJSON (unPrefix "hyperdataCorpus_") ''HyperdataCorpus)
291 instance Hyperdata HyperdataCorpus
293 corpusExample :: ByteString
294 corpusExample = "" -- TODO
296 defaultCorpus :: HyperdataCorpus
297 defaultCorpus = (HyperdataCorpus (Just "Title") (Just "Descr") (Just "Bool query") (Just "Authors") Nothing)
299 hyperdataCorpus :: HyperdataCorpus
300 hyperdataCorpus = case decode corpusExample of
302 Nothing -> defaultCorpus
304 instance Arbitrary HyperdataCorpus where
305 arbitrary = pure hyperdataCorpus -- TODO
307 ------------------------------------------------------------------------
308 data HyperdataAnnuaire = HyperdataAnnuaire { hyperdataAnnuaire_title :: !(Maybe Text)
309 , hyperdataAnnuaire_desc :: !(Maybe Text)
310 } deriving (Show, Generic)
311 $(deriveJSON (unPrefix "hyperdataAnnuaire_") ''HyperdataAnnuaire)
313 instance Hyperdata HyperdataAnnuaire
315 hyperdataAnnuaire :: HyperdataAnnuaire
316 hyperdataAnnuaire = HyperdataAnnuaire (Just "Annuaire Title") (Just "Annuaire Description")
318 instance Arbitrary HyperdataAnnuaire where
319 arbitrary = pure hyperdataAnnuaire -- TODO
321 ------------------------------------------------------------------------
322 newtype HyperdataAny = HyperdataAny Object
323 deriving (Show, Generic, ToJSON, FromJSON)
325 instance Hyperdata HyperdataAny
327 instance Arbitrary HyperdataAny where
328 arbitrary = pure $ HyperdataAny mempty -- TODO produce arbitrary objects
329 ------------------------------------------------------------------------
331 data HyperdataList = HyperdataList { hyperdataList_preferences :: !(Maybe Text)
332 } deriving (Show, Generic)
333 $(deriveJSON (unPrefix "hyperdataList_") ''HyperdataList)
335 instance Hyperdata HyperdataList
337 instance Arbitrary HyperdataList where
338 arbitrary = elements [HyperdataList (Just "from list A")]
341 data HyperdataListModel = HyperdataListModel { _hlm_params :: !(Int, Int)
343 , _hlm_score :: !(Maybe Double)
344 } deriving (Show, Generic)
346 instance Hyperdata HyperdataListModel
347 instance Arbitrary HyperdataListModel where
348 arbitrary = elements [HyperdataListModel (100,100) "models/example.model" Nothing]
350 $(deriveJSON (unPrefix "_hlm_") ''HyperdataListModel)
351 $(makeLenses ''HyperdataListModel)
353 ------------------------------------------------------------------------
354 data HyperdataScore = HyperdataScore { hyperdataScore_preferences :: !(Maybe Text)
355 } deriving (Show, Generic)
356 $(deriveJSON (unPrefix "hyperdataScore_") ''HyperdataScore)
358 instance Hyperdata HyperdataScore
360 ------------------------------------------------------------------------
362 data HyperdataResource = HyperdataResource { hyperdataResource_preferences :: !(Maybe Text)
363 } deriving (Show, Generic)
364 $(deriveJSON (unPrefix "hyperdataResource_") ''HyperdataResource)
366 instance Hyperdata HyperdataResource
368 ------------------------------------------------------------------------
369 data HyperdataDashboard = HyperdataDashboard { hyperdataDashboard_preferences :: !(Maybe Text)
370 } deriving (Show, Generic)
371 $(deriveJSON (unPrefix "hyperdataDashboard_") ''HyperdataDashboard)
373 instance Hyperdata HyperdataDashboard
375 -- TODO add the Graph Structure here
376 data HyperdataGraph = HyperdataGraph { hyperdataGraph_preferences :: !(Maybe Text)
377 } deriving (Show, Generic)
378 $(deriveJSON (unPrefix "hyperdataGraph_") ''HyperdataGraph)
380 instance Hyperdata HyperdataGraph
381 ------------------------------------------------------------------------
383 -- TODO add the Graph Structure here
384 data HyperdataPhylo = HyperdataPhylo { hyperdataPhylo_preferences :: !(Maybe Text)
385 } deriving (Show, Generic)
386 $(deriveJSON (unPrefix "hyperdataPhylo_") ''HyperdataPhylo)
388 instance Hyperdata HyperdataPhylo
390 ------------------------------------------------------------------------
391 -- | TODO FEATURE: Notebook saved in the node
392 data HyperdataNotebook = HyperdataNotebook { hyperdataNotebook_preferences :: !(Maybe Text)
393 } deriving (Show, Generic)
394 $(deriveJSON (unPrefix "hyperdataNotebook_") ''HyperdataNotebook)
396 instance Hyperdata HyperdataNotebook
399 -- | NodePoly indicates that Node has a Polymorphism Type
400 type Node json = NodePoly NodeId NodeTypeId UserId (Maybe ParentId) NodeName UTCTime json
402 -- type Node json = NodePoly NodeId NodeTypeId UserId ParentId NodeName UTCTime json
403 type NodeTypeId = Int
408 -- | Then a Node can be either a Folder or a Corpus or a Document
409 type NodeUser = Node HyperdataUser
410 type NodeFolder = Node HyperdataFolder
412 type NodeCorpus = Node HyperdataCorpus
413 type NodeCorpusV3 = Node HyperdataCorpus
414 type NodeDocument = Node HyperdataDocument
416 type NodeAnnuaire = Node HyperdataAnnuaire
418 -- | Any others nodes
419 type NodeAny = Node HyperdataAny
421 ---- | Then a Node can be either a Graph or a Phylo or a Notebook
422 type NodeList = Node HyperdataList
423 type NodeGraph = Node HyperdataGraph
424 type NodePhylo = Node HyperdataPhylo
425 type NodeNotebook = Node HyperdataNotebook
426 ------------------------------------------------------------------------
427 data NodeType = NodeUser
429 | NodeCorpus | NodeCorpusV3 | NodeDocument
430 | NodeAnnuaire | NodeContact
433 | NodeDashboard | NodeChart
435 | NodeList | NodeListModel
437 deriving (Show, Read, Eq, Generic, Bounded, Enum)
439 allNodeTypes :: [NodeType]
440 allNodeTypes = [minBound ..]
442 instance FromJSON NodeType
443 instance ToJSON NodeType
445 instance FromHttpApiData NodeType
447 parseUrlPiece = Right . read . unpack
449 instance ToParamSchema NodeType
450 instance ToSchema NodeType
452 ------------------------------------------------------------------------
453 data NodePoly id typename userId
455 hyperdata = Node { _node_id :: id
456 , _node_typename :: typename
458 , _node_userId :: userId
459 , _node_parentId :: parentId
464 , _node_hyperdata :: hyperdata
465 } deriving (Show, Generic)
466 $(deriveJSON (unPrefix "_node_") ''NodePoly)
467 $(makeLenses ''NodePoly)
470 data NodePolySearch id typename userId
472 hyperdata search = NodeSearch { _ns_id :: id
473 , _ns_typename :: typename
474 , _ns_userId :: userId
475 -- , nodeUniqId :: hashId
476 , _ns_parentId :: parentId
480 , _ns_hyperdata :: hyperdata
481 , _ns_search :: search
482 } deriving (Show, Generic)
483 $(deriveJSON (unPrefix "_ns_") ''NodePolySearch)
484 $(makeLenses ''NodePolySearch)
486 type NodeSearch json = NodePolySearch NodeId NodeTypeId UserId (Maybe ParentId) NodeName UTCTime json (Maybe TSVector)
487 ------------------------------------------------------------------------
490 instance (Arbitrary hyperdata
492 ,Arbitrary nodeTypeId
494 ,Arbitrary nodeParentId
495 ) => Arbitrary (NodePoly nodeId nodeTypeId userId nodeParentId
496 NodeName UTCTime hyperdata) where
497 --arbitrary = Node 1 1 (Just 1) 1 "name" (jour 2018 01 01) (arbitrary) (Just "")
498 arbitrary = Node <$> arbitrary <*> arbitrary <*> arbitrary
499 <*> arbitrary <*> arbitrary <*> arbitrary
502 instance (Arbitrary hyperdata
504 ,Arbitrary nodeTypeId
506 ,Arbitrary nodeParentId
507 ) => Arbitrary (NodePolySearch nodeId nodeTypeId userId nodeParentId
508 NodeName UTCTime hyperdata (Maybe TSVector)) where
509 --arbitrary = Node 1 1 (Just 1) 1 "name" (jour 2018 01 01) (arbitrary) (Just "")
510 arbitrary = NodeSearch <$> arbitrary <*> arbitrary <*> arbitrary
511 <*> arbitrary <*> arbitrary <*> arbitrary
512 <*> arbitrary <*> arbitrary
515 ------------------------------------------------------------------------
516 hyperdataDocument :: HyperdataDocument
517 hyperdataDocument = case decode docExample of
519 Nothing -> HyperdataDocument Nothing Nothing Nothing Nothing
520 Nothing Nothing Nothing Nothing
521 Nothing Nothing Nothing Nothing
522 Nothing Nothing Nothing Nothing
523 Nothing Nothing Nothing
524 docExample :: ByteString
525 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}"
527 instance ToSchema HyperdataCorpus where
528 declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
529 & mapped.schema.description ?~ "a corpus"
530 & mapped.schema.example ?~ toJSON hyperdataCorpus
532 instance ToSchema HyperdataAnnuaire where
533 declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
534 & mapped.schema.description ?~ "an annuaire"
535 & mapped.schema.example ?~ toJSON hyperdataAnnuaire
537 instance ToSchema HyperdataDocument where
538 declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
539 & mapped.schema.description ?~ "a document"
540 & mapped.schema.example ?~ toJSON hyperdataDocument
542 instance ToSchema HyperdataAny where
543 declareNamedSchema proxy =
544 pure $ genericNameSchema defaultSchemaOptions proxy mempty
545 & schema.description ?~ "a node"
546 & schema.example ?~ emptyObject -- TODO
549 instance ToSchema hyperdata =>
550 ToSchema (NodePoly NodeId NodeTypeId
556 instance ToSchema hyperdata =>
557 ToSchema (NodePoly NodeId NodeTypeId
559 (Maybe ParentId) NodeName
564 instance ToSchema hyperdata =>
565 ToSchema (NodePolySearch NodeId NodeTypeId
568 UTCTime hyperdata (Maybe TSVector)
571 instance ToSchema hyperdata =>
572 ToSchema (NodePolySearch NodeId NodeTypeId
574 (Maybe ParentId) NodeName
575 UTCTime hyperdata (Maybe TSVector)
579 instance ToSchema Status