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
383 ------------------------------------------------------------------------
385 -- TODO add the Graph Structure here
386 data HyperdataPhylo = HyperdataPhylo { hyperdataPhylo_preferences :: !(Maybe Text)
387 } deriving (Show, Generic)
388 $(deriveJSON (unPrefix "hyperdataPhylo_") ''HyperdataPhylo)
390 instance Hyperdata HyperdataPhylo
392 ------------------------------------------------------------------------
393 -- | TODO FEATURE: Notebook saved in the node
394 data HyperdataNotebook = HyperdataNotebook { hyperdataNotebook_preferences :: !(Maybe Text)
395 } deriving (Show, Generic)
396 $(deriveJSON (unPrefix "hyperdataNotebook_") ''HyperdataNotebook)
398 instance Hyperdata HyperdataNotebook
401 -- | NodePoly indicates that Node has a Polymorphism Type
402 type Node json = NodePoly NodeId NodeTypeId UserId (Maybe ParentId) NodeName UTCTime json
404 -- type Node json = NodePoly NodeId NodeTypeId UserId ParentId NodeName UTCTime json
405 type NodeTypeId = Int
410 -- | Then a Node can be either a Folder or a Corpus or a Document
411 type NodeUser = Node HyperdataUser
412 type NodeFolder = Node HyperdataFolder
414 type NodeCorpus = Node HyperdataCorpus
415 type NodeCorpusV3 = Node HyperdataCorpus
416 type NodeDocument = Node HyperdataDocument
418 type NodeAnnuaire = Node HyperdataAnnuaire
420 -- | Any others nodes
421 type NodeAny = Node HyperdataAny
423 ---- | Then a Node can be either a Graph or a Phylo or a Notebook
424 type NodeList = Node HyperdataList
425 type NodeGraph = Node HyperdataGraph
426 type NodePhylo = Node HyperdataPhylo
427 type NodeNotebook = Node HyperdataNotebook
428 ------------------------------------------------------------------------
429 data NodeType = NodeUser
431 | NodeCorpus | NodeCorpusV3 | NodeDocument
432 | NodeAnnuaire | NodeContact
433 | NodeGraph | NodePhylo
434 | NodeDashboard | NodeChart
435 | NodeList | NodeListModel deriving (Show, Read, Eq, Generic, Bounded, Enum)
444 allNodeTypes :: [NodeType]
445 allNodeTypes = [minBound ..]
447 instance FromJSON NodeType
448 instance ToJSON NodeType
450 instance FromHttpApiData NodeType
452 parseUrlPiece = Right . read . unpack
454 instance ToParamSchema NodeType
455 instance ToSchema NodeType
457 ------------------------------------------------------------------------
458 data NodePoly id typename userId
460 hyperdata = Node { _node_id :: id
461 , _node_typename :: typename
463 , _node_userId :: userId
464 , _node_parentId :: parentId
469 , _node_hyperdata :: hyperdata
470 } deriving (Show, Generic)
471 $(deriveJSON (unPrefix "_node_") ''NodePoly)
472 $(makeLenses ''NodePoly)
475 data NodePolySearch id typename userId
477 hyperdata search = NodeSearch { _ns_id :: id
478 , _ns_typename :: typename
479 , _ns_userId :: userId
480 -- , nodeUniqId :: hashId
481 , _ns_parentId :: parentId
485 , _ns_hyperdata :: hyperdata
486 , _ns_search :: search
487 } deriving (Show, Generic)
488 $(deriveJSON (unPrefix "_ns_") ''NodePolySearch)
489 $(makeLenses ''NodePolySearch)
491 type NodeSearch json = NodePolySearch NodeId NodeTypeId UserId (Maybe ParentId) NodeName UTCTime json (Maybe TSVector)
492 ------------------------------------------------------------------------
495 instance (Arbitrary hyperdata
497 ,Arbitrary nodeTypeId
499 ,Arbitrary nodeParentId
500 ) => Arbitrary (NodePoly nodeId nodeTypeId userId nodeParentId
501 NodeName UTCTime hyperdata) where
502 --arbitrary = Node 1 1 (Just 1) 1 "name" (jour 2018 01 01) (arbitrary) (Just "")
503 arbitrary = Node <$> arbitrary <*> arbitrary <*> arbitrary
504 <*> arbitrary <*> arbitrary <*> arbitrary
507 instance (Arbitrary hyperdata
509 ,Arbitrary nodeTypeId
511 ,Arbitrary nodeParentId
512 ) => Arbitrary (NodePolySearch nodeId nodeTypeId userId nodeParentId
513 NodeName UTCTime hyperdata (Maybe TSVector)) where
514 --arbitrary = Node 1 1 (Just 1) 1 "name" (jour 2018 01 01) (arbitrary) (Just "")
515 arbitrary = NodeSearch <$> arbitrary <*> arbitrary <*> arbitrary
516 <*> arbitrary <*> arbitrary <*> arbitrary
517 <*> arbitrary <*> arbitrary
520 ------------------------------------------------------------------------
521 hyperdataDocument :: HyperdataDocument
522 hyperdataDocument = case decode docExample of
524 Nothing -> HyperdataDocument Nothing Nothing Nothing Nothing
525 Nothing Nothing Nothing Nothing
526 Nothing Nothing Nothing Nothing
527 Nothing Nothing Nothing Nothing
528 Nothing Nothing Nothing
529 docExample :: ByteString
530 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}"
532 instance ToSchema HyperdataCorpus where
533 declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
534 & mapped.schema.description ?~ "a corpus"
535 & mapped.schema.example ?~ toJSON hyperdataCorpus
537 instance ToSchema HyperdataAnnuaire where
538 declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
539 & mapped.schema.description ?~ "an annuaire"
540 & mapped.schema.example ?~ toJSON hyperdataAnnuaire
542 instance ToSchema HyperdataDocument where
543 declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
544 & mapped.schema.description ?~ "a document"
545 & mapped.schema.example ?~ toJSON hyperdataDocument
547 instance ToSchema HyperdataAny where
548 declareNamedSchema proxy =
549 pure $ genericNameSchema defaultSchemaOptions proxy mempty
550 & schema.description ?~ "a node"
551 & schema.example ?~ emptyObject -- TODO
554 instance ToSchema hyperdata =>
555 ToSchema (NodePoly NodeId NodeTypeId
561 instance ToSchema hyperdata =>
562 ToSchema (NodePoly NodeId NodeTypeId
564 (Maybe ParentId) NodeName
569 instance ToSchema hyperdata =>
570 ToSchema (NodePolySearch NodeId NodeTypeId
573 UTCTime hyperdata (Maybe TSVector)
576 instance ToSchema hyperdata =>
577 ToSchema (NodePolySearch NodeId NodeTypeId
579 (Maybe ParentId) NodeName
580 UTCTime hyperdata (Maybe TSVector)
584 instance ToSchema Status