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)
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
71 if (n :: Int) > 0 then return $ NodeId n
74 instance ToJSON NodeId
75 instance FromJSON NodeId
76 instance FromJSONKey NodeId
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
88 type CorpusId = NodeId
90 type DocumentId = NodeId
91 type DocId = DocumentId -- todo: remove this
93 type MasterCorpusId = NodeId
94 type AnnuaireId = NodeId
95 type ContactId = NodeId
98 type MasterUserId = UserId
100 id2int :: NodeId -> Int
101 id2int (NodeId n) = n
104 type UTCTime' = UTCTime
106 instance Arbitrary UTCTime' where
107 arbitrary = elements $ timesAfter 100 D (jour 2000 01 01)
109 ------------------------------------------------------------------------
110 data Status = Status { status_failed :: Int
111 , status_succeeded :: Int
112 , status_remaining :: Int
113 } deriving (Show, Generic)
114 $(deriveJSON (unPrefix "status_") ''Status)
116 instance Arbitrary Status where
117 arbitrary = Status <$> arbitrary <*> arbitrary <*> arbitrary
119 ------------------------------------------------------------------------
120 data StatusV3 = StatusV3 { statusV3_error :: Maybe Text
121 , statusV3_action :: Maybe Text
122 } deriving (Show, Generic)
123 $(deriveJSON (unPrefix "statusV3_") ''StatusV3)
124 ------------------------------------------------------------------------
126 -- Only Hyperdata types should be member of this type class.
129 ------------------------------------------------------------------------
130 data HyperdataDocumentV3 = HyperdataDocumentV3 { hyperdataDocumentV3_publication_day :: !(Maybe Int)
131 , hyperdataDocumentV3_language_iso2 :: !(Maybe Text)
132 , hyperdataDocumentV3_publication_second :: !(Maybe Int)
133 , hyperdataDocumentV3_publication_minute :: !(Maybe Int)
134 , hyperdataDocumentV3_publication_month :: !(Maybe Int)
135 , hyperdataDocumentV3_publication_hour :: !(Maybe Int)
136 , hyperdataDocumentV3_error :: !(Maybe Text)
137 , hyperdataDocumentV3_language_iso3 :: !(Maybe Text)
138 , hyperdataDocumentV3_authors :: !(Maybe Text)
139 , hyperdataDocumentV3_publication_year :: !(Maybe Int)
140 , hyperdataDocumentV3_publication_date :: !(Maybe Text)
141 , hyperdataDocumentV3_language_name :: !(Maybe Text)
142 , hyperdataDocumentV3_statuses :: !(Maybe [StatusV3])
143 , hyperdataDocumentV3_realdate_full_ :: !(Maybe Text)
144 , hyperdataDocumentV3_source :: !(Maybe Text)
145 , hyperdataDocumentV3_abstract :: !(Maybe Text)
146 , hyperdataDocumentV3_title :: !(Maybe Text)
147 } deriving (Show, Generic)
148 $(deriveJSON (unPrefix "hyperdataDocumentV3_") ''HyperdataDocumentV3)
150 instance Hyperdata HyperdataDocumentV3
151 ------------------------------------------------------------------------
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)
174 $(deriveJSON (unPrefix "_hyperdataDocument_") ''HyperdataDocument)
175 $(makeLenses ''HyperdataDocument)
177 instance Eq HyperdataDocument where
178 (==) h1 h2 = (==) (_hyperdataDocument_uniqId h1) (_hyperdataDocument_uniqId h2)
180 instance Ord HyperdataDocument where
181 compare h1 h2 = compare (_hyperdataDocument_uniqId h1) (_hyperdataDocument_uniqId h2)
183 instance Hyperdata HyperdataDocument
185 instance ToField HyperdataDocument where
186 toField = toJSONField
188 toHyperdataDocuments :: [(Text, Text)] -> [HyperdataDocument]
189 toHyperdataDocuments ts = map (\(t1,t2) -> HyperdataDocument Nothing Nothing Nothing Nothing Nothing Nothing (Just t1)
190 Nothing Nothing (Just t2) Nothing Nothing Nothing Nothing Nothing
191 Nothing Nothing Nothing Nothing
194 hyperdataDocuments :: [HyperdataDocument]
195 hyperdataDocuments = toHyperdataDocuments [ ("AI is big but less than crypto", "Troll System journal")
196 , ("Crypto is big but less than AI", "System Troll review" )
197 , ("Science is magic" , "Closed Source review")
198 , ("Open science for all" , "No Time" )
199 , ("Closed science for me" , "No Space" )
203 instance Arbitrary HyperdataDocument where
204 arbitrary = elements hyperdataDocuments
206 ------------------------------------------------------------------------
207 data LanguageNodes = LanguageNodes { languageNodes___unknown__ :: [Int]}
208 deriving (Show, Generic)
209 $(deriveJSON (unPrefix "languageNodes_") ''LanguageNodes)
211 ------------------------------------------------------------------------
212 -- level: debug | dev (fatal = critical)
213 data EventLevel = CRITICAL | FATAL | ERROR | WARNING | INFO | DEBUG
214 deriving (Show, Generic, Enum, Bounded)
216 instance FromJSON EventLevel
217 instance ToJSON EventLevel
219 instance Arbitrary EventLevel where
220 arbitrary = elements [minBound..maxBound]
222 instance ToSchema EventLevel where
223 declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
225 ------------------------------------------------------------------------
227 data Event = Event { event_level :: EventLevel
228 , event_message :: Text
229 , event_date :: UTCTime
230 } deriving (Show, Generic)
231 $(deriveJSON (unPrefix "event_") ''Event)
233 instance Arbitrary Event where
234 arbitrary = Event <$> arbitrary <*> arbitrary <*> arbitrary
236 instance ToSchema Event where
237 declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
239 ------------------------------------------------------------------------
240 instance Arbitrary Text where
241 arbitrary = elements $ map (\c -> pack [c]) ['a'..'z']
243 data Resource = Resource { resource_path :: Maybe Text
244 , resource_scraper :: Maybe Text
245 , resource_query :: Maybe Text
246 , resource_events :: [Event]
247 , resource_status :: Status
248 , resource_date :: UTCTime'
249 } deriving (Show, Generic)
250 $(deriveJSON (unPrefix "resource_") ''Resource)
252 instance Arbitrary Resource where
253 arbitrary = Resource <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
255 instance ToSchema Resource where
256 declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
258 ------------------------------------------------------------------------
259 data HyperdataUser = HyperdataUser { hyperdataUser_language :: Maybe Text
260 } deriving (Show, Generic)
261 $(deriveJSON (unPrefix "hyperdataUser_") ''HyperdataUser)
263 instance Hyperdata HyperdataUser
264 ------------------------------------------------------------------------
265 data HyperdataFolder = HyperdataFolder { hyperdataFolder_desc :: Maybe Text
266 } deriving (Show, Generic)
267 $(deriveJSON (unPrefix "hyperdataFolder_") ''HyperdataFolder)
269 instance Hyperdata HyperdataFolder
270 ------------------------------------------------------------------------
271 data HyperdataCorpus = HyperdataCorpus { hyperdataCorpus_title :: Maybe Text
272 , hyperdataCorpus_desc :: Maybe Text
273 , hyperdataCorpus_query :: Maybe Text
274 , hyperdataCorpus_authors :: Maybe Text
275 , hyperdataCorpus_resources :: Maybe [Resource]
276 } deriving (Show, Generic)
277 $(deriveJSON (unPrefix "hyperdataCorpus_") ''HyperdataCorpus)
279 instance Hyperdata HyperdataCorpus
281 corpusExample :: ByteString
282 corpusExample = "" -- TODO
284 defaultCorpus :: HyperdataCorpus
285 defaultCorpus = (HyperdataCorpus (Just "Title") (Just "Descr") (Just "Bool query") (Just "Authors") Nothing)
287 hyperdataCorpus :: HyperdataCorpus
288 hyperdataCorpus = case decode corpusExample of
290 Nothing -> defaultCorpus
292 instance Arbitrary HyperdataCorpus where
293 arbitrary = pure hyperdataCorpus -- TODO
295 ------------------------------------------------------------------------
296 data HyperdataAnnuaire = HyperdataAnnuaire { hyperdataAnnuaire_title :: Maybe Text
297 , hyperdataAnnuaire_desc :: Maybe Text
298 } deriving (Show, Generic)
299 $(deriveJSON (unPrefix "hyperdataAnnuaire_") ''HyperdataAnnuaire)
301 instance Hyperdata HyperdataAnnuaire
303 hyperdataAnnuaire :: HyperdataAnnuaire
304 hyperdataAnnuaire = HyperdataAnnuaire (Just "Annuaire Title") (Just "Annuaire Description")
306 instance Arbitrary HyperdataAnnuaire where
307 arbitrary = pure hyperdataAnnuaire -- TODO
309 ------------------------------------------------------------------------
310 newtype HyperdataAny = HyperdataAny Object
311 deriving (Show, Generic, ToJSON, FromJSON)
313 instance Hyperdata HyperdataAny
315 instance Arbitrary HyperdataAny where
316 arbitrary = pure $ HyperdataAny mempty -- TODO produce arbitrary objects
317 ------------------------------------------------------------------------
319 data HyperdataList = HyperdataList { hyperdataList_preferences :: Maybe Text
320 } deriving (Show, Generic)
321 $(deriveJSON (unPrefix "hyperdataList_") ''HyperdataList)
323 instance Hyperdata HyperdataList
324 ------------------------------------------------------------------------
325 data HyperdataScore = HyperdataScore { hyperdataScore_preferences :: Maybe Text
326 } deriving (Show, Generic)
327 $(deriveJSON (unPrefix "hyperdataScore_") ''HyperdataScore)
329 instance Hyperdata HyperdataScore
331 ------------------------------------------------------------------------
333 data HyperdataResource = HyperdataResource { hyperdataResource_preferences :: Maybe Text
334 } deriving (Show, Generic)
335 $(deriveJSON (unPrefix "hyperdataResource_") ''HyperdataResource)
337 instance Hyperdata HyperdataResource
339 ------------------------------------------------------------------------
340 data HyperdataDashboard = HyperdataDashboard { hyperdataDashboard_preferences :: Maybe Text
341 } deriving (Show, Generic)
342 $(deriveJSON (unPrefix "hyperdataDashboard_") ''HyperdataDashboard)
344 instance Hyperdata HyperdataDashboard
346 -- TODO add the Graph Structure here
347 data HyperdataGraph = HyperdataGraph { hyperdataGraph_preferences :: Maybe Text
348 } deriving (Show, Generic)
349 $(deriveJSON (unPrefix "hyperdataGraph_") ''HyperdataGraph)
351 instance Hyperdata HyperdataGraph
352 ------------------------------------------------------------------------
354 -- TODO add the Graph Structure here
355 data HyperdataPhylo = HyperdataPhylo { hyperdataPhylo_preferences :: Maybe Text
356 } deriving (Show, Generic)
357 $(deriveJSON (unPrefix "hyperdataPhylo_") ''HyperdataPhylo)
359 instance Hyperdata HyperdataPhylo
361 ------------------------------------------------------------------------
362 -- | TODO FEATURE: Notebook saved in the node
363 data HyperdataNotebook = HyperdataNotebook { hyperdataNotebook_preferences :: Maybe Text
364 } deriving (Show, Generic)
365 $(deriveJSON (unPrefix "hyperdataNotebook_") ''HyperdataNotebook)
367 instance Hyperdata HyperdataNotebook
370 -- | NodePoly indicates that Node has a Polymorphism Type
371 type Node json = NodePoly NodeId NodeTypeId UserId (Maybe ParentId) NodeName UTCTime json
373 -- type Node json = NodePoly NodeId NodeTypeId UserId ParentId NodeName UTCTime json
374 type NodeTypeId = Int
379 -- | Then a Node can be either a Folder or a Corpus or a Document
380 type NodeUser = Node HyperdataUser
381 type NodeFolder = Node HyperdataFolder
383 type NodeCorpus = Node HyperdataCorpus
384 type NodeCorpusV3 = Node HyperdataCorpus
385 type NodeDocument = Node HyperdataDocument
387 type NodeAnnuaire = Node HyperdataAnnuaire
389 -- | Any others nodes
390 type NodeAny = Node HyperdataAny
392 ---- | Then a Node can be either a Graph or a Phylo or a Notebook
393 type NodeList = Node HyperdataList
394 type NodeGraph = Node HyperdataGraph
395 type NodePhylo = Node HyperdataPhylo
396 type NodeNotebook = Node HyperdataNotebook
397 ------------------------------------------------------------------------
398 data NodeType = NodeUser
400 | NodeCorpus | NodeCorpusV3 | NodeDocument
401 | NodeAnnuaire | NodeContact
404 | NodeDashboard | NodeChart
408 deriving (Show, Read, Eq, Generic, Bounded, Enum)
410 allNodeTypes :: [NodeType]
411 allNodeTypes = [minBound ..]
413 instance FromJSON NodeType
414 instance ToJSON NodeType
416 instance FromHttpApiData NodeType
418 parseUrlPiece = Right . read . unpack
420 instance ToParamSchema NodeType
421 instance ToSchema NodeType
423 ------------------------------------------------------------------------
424 data NodePoly id typename userId
426 hyperdata = Node { _node_id :: id
427 , _node_typename :: typename
429 , _node_userId :: userId
430 , _node_parentId :: parentId
435 , _node_hyperdata :: hyperdata
436 } deriving (Show, Generic)
437 $(deriveJSON (unPrefix "_node_") ''NodePoly)
438 $(makeLenses ''NodePoly)
441 data NodePolySearch id typename userId
443 hyperdata search = NodeSearch { _ns_id :: id
444 , _ns_typename :: typename
445 , _ns_userId :: userId
446 -- , nodeUniqId :: hashId
447 , _ns_parentId :: parentId
451 , _ns_hyperdata :: hyperdata
452 , _ns_search :: search
453 } deriving (Show, Generic)
454 $(deriveJSON (unPrefix "_ns_") ''NodePolySearch)
455 $(makeLenses ''NodePolySearch)
457 type NodeSearch json = NodePolySearch NodeId NodeTypeId UserId (Maybe ParentId) NodeName UTCTime json (Maybe TSVector)
458 ------------------------------------------------------------------------
461 instance (Arbitrary hyperdata
463 ,Arbitrary nodeTypeId
465 ,Arbitrary nodeParentId
466 ) => Arbitrary (NodePoly nodeId nodeTypeId userId nodeParentId
467 NodeName UTCTime hyperdata) where
468 --arbitrary = Node 1 1 (Just 1) 1 "name" (jour 2018 01 01) (arbitrary) (Just "")
469 arbitrary = Node <$> arbitrary <*> arbitrary <*> arbitrary
470 <*> arbitrary <*> arbitrary <*> arbitrary
473 instance (Arbitrary hyperdata
475 ,Arbitrary nodeTypeId
477 ,Arbitrary nodeParentId
478 ) => Arbitrary (NodePolySearch nodeId nodeTypeId userId nodeParentId
479 NodeName UTCTime hyperdata (Maybe TSVector)) where
480 --arbitrary = Node 1 1 (Just 1) 1 "name" (jour 2018 01 01) (arbitrary) (Just "")
481 arbitrary = NodeSearch <$> arbitrary <*> arbitrary <*> arbitrary
482 <*> arbitrary <*> arbitrary <*> arbitrary
483 <*> arbitrary <*> arbitrary
486 ------------------------------------------------------------------------
487 hyperdataDocument :: HyperdataDocument
488 hyperdataDocument = case decode docExample of
490 Nothing -> HyperdataDocument Nothing Nothing Nothing Nothing
491 Nothing Nothing Nothing Nothing
492 Nothing Nothing Nothing Nothing
493 Nothing Nothing Nothing Nothing
494 Nothing Nothing Nothing
495 docExample :: ByteString
496 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}"
498 instance ToSchema HyperdataCorpus where
499 declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
500 & mapped.schema.description ?~ "a corpus"
501 & mapped.schema.example ?~ toJSON hyperdataCorpus
503 instance ToSchema HyperdataAnnuaire where
504 declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
505 & mapped.schema.description ?~ "an annuaire"
506 & mapped.schema.example ?~ toJSON hyperdataAnnuaire
508 instance ToSchema HyperdataDocument where
509 declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
510 & mapped.schema.description ?~ "a document"
511 & mapped.schema.example ?~ toJSON hyperdataDocument
513 instance ToSchema HyperdataAny where
514 declareNamedSchema proxy =
515 pure $ genericNameSchema defaultSchemaOptions proxy mempty
516 & schema.description ?~ "a node"
517 & schema.example ?~ emptyObject -- TODO
520 instance ToSchema hyperdata =>
521 ToSchema (NodePoly NodeId NodeTypeId
527 instance ToSchema hyperdata =>
528 ToSchema (NodePoly NodeId NodeTypeId
530 (Maybe ParentId) NodeName
535 instance ToSchema hyperdata =>
536 ToSchema (NodePolySearch NodeId NodeTypeId
539 UTCTime hyperdata (Maybe TSVector)
542 instance ToSchema hyperdata =>
543 ToSchema (NodePolySearch NodeId NodeTypeId
545 (Maybe ParentId) NodeName
546 UTCTime hyperdata (Maybe TSVector)
550 instance ToSchema Status