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 #-}
23 -- {-# LANGUAGE DuplicateRecordFields #-}
25 module Gargantext.Database.Types.Node
28 import Prelude (Enum, Bounded, minBound, maxBound)
30 import GHC.Generics (Generic)
32 import Control.Lens hiding (elements, (&))
33 import Control.Applicative ((<*>))
34 import Control.Monad (mzero)
37 import Data.Aeson.Types (emptyObject)
38 import Data.Aeson (Object, toJSON)
39 import Data.Aeson.TH (deriveJSON)
40 import Data.ByteString.Lazy (ByteString)
43 import Data.Monoid (mempty)
44 import Data.Text (Text, unpack, pack)
45 import Data.Time (UTCTime)
46 import Data.Time.Segment (jour, timesAfter, Granularity(D))
49 import Text.Read (read)
50 import Text.Show (Show())
52 import Database.PostgreSQL.Simple.ToField (ToField, toField, toJSONField)
53 import Database.PostgreSQL.Simple.FromField (FromField, fromField)
56 import Test.QuickCheck.Arbitrary
57 import Test.QuickCheck (elements)
59 import Gargantext.Prelude
60 import Gargantext.Core.Utils.Prefix (unPrefix)
61 import Gargantext.Viz.Phylo (Phylo)
62 --import Gargantext.Database.Utils
63 ------------------------------------------------------------------------
64 newtype NodeId = NodeId Int
65 deriving (Show, Read, Generic, Num, Eq, Ord, Enum, ToJSONKey, FromJSONKey, ToJSON, FromJSON)
67 instance ToField NodeId where
68 toField (NodeId n) = toField n
71 instance FromField NodeId where
72 fromField field mdata = do
73 n <- fromField field mdata
75 then return $ NodeId n
78 instance ToSchema NodeId
84 ------------------------------------------------------------------------
85 data NodePoly id typename userId
87 hyperdata = Node { _node_id :: id
88 , _node_typename :: typename
90 , _node_userId :: userId
91 , _node_parentId :: parentId
96 , _node_hyperdata :: hyperdata
97 } deriving (Show, Generic)
98 $(deriveJSON (unPrefix "_node_") ''NodePoly)
99 $(makeLenses ''NodePoly)
101 -- | NodePoly indicates that Node has a Polymorphism Type
102 type Node json = NodePoly NodeId NodeTypeId UserId (Maybe ParentId) NodeName UTCTime json
106 ------------------------------------------------------------------------
109 instance FromHttpApiData NodeId where
110 parseUrlPiece n = pure $ NodeId $ (read . cs) n
112 instance ToParamSchema NodeId
113 instance Arbitrary NodeId where
114 arbitrary = NodeId <$> arbitrary
116 type ParentId = NodeId
117 type CorpusId = NodeId
119 type DocumentId = NodeId
122 type MasterCorpusId = CorpusId
123 type UserCorpusId = CorpusId
125 type GraphId = NodeId
126 type PhyloId = NodeId
127 type AnnuaireId = NodeId
128 type ContactId = NodeId
131 type MasterUserId = UserId
133 id2int :: NodeId -> Int
134 id2int (NodeId n) = n
137 type UTCTime' = UTCTime
139 instance Arbitrary UTCTime' where
140 arbitrary = elements $ timesAfter 100 D (jour 2000 01 01)
142 ------------------------------------------------------------------------
143 data Status = Status { status_failed :: !Int
144 , status_succeeded :: !Int
145 , status_remaining :: !Int
146 } deriving (Show, Generic)
147 $(deriveJSON (unPrefix "status_") ''Status)
149 instance Arbitrary Status where
150 arbitrary = Status <$> arbitrary <*> arbitrary <*> arbitrary
152 ------------------------------------------------------------------------
153 data StatusV3 = StatusV3 { statusV3_error :: !(Maybe Text)
154 , statusV3_action :: !(Maybe Text)
155 } deriving (Show, Generic)
156 $(deriveJSON (unPrefix "statusV3_") ''StatusV3)
157 ------------------------------------------------------------------------
159 -- Only Hyperdata types should be member of this type class.
161 ------------------------------------------------------------------------
162 data HyperdataDocumentV3 = HyperdataDocumentV3 { hyperdataDocumentV3_publication_day :: !(Maybe Int)
163 , hyperdataDocumentV3_language_iso2 :: !(Maybe Text)
164 , hyperdataDocumentV3_publication_second :: !(Maybe Int)
165 , hyperdataDocumentV3_publication_minute :: !(Maybe Int)
166 , hyperdataDocumentV3_publication_month :: !(Maybe Int)
167 , hyperdataDocumentV3_publication_hour :: !(Maybe Int)
168 , hyperdataDocumentV3_error :: !(Maybe Text)
169 , hyperdataDocumentV3_language_iso3 :: !(Maybe Text)
170 , hyperdataDocumentV3_authors :: !(Maybe Text)
171 , hyperdataDocumentV3_publication_year :: !(Maybe Int)
172 , hyperdataDocumentV3_publication_date :: !(Maybe Text)
173 , hyperdataDocumentV3_language_name :: !(Maybe Text)
174 , hyperdataDocumentV3_statuses :: !(Maybe [StatusV3])
175 , hyperdataDocumentV3_realdate_full_ :: !(Maybe Text)
176 , hyperdataDocumentV3_source :: !(Maybe Text)
177 , hyperdataDocumentV3_abstract :: !(Maybe Text)
178 , hyperdataDocumentV3_title :: !(Maybe Text)
179 } deriving (Show, Generic)
180 $(deriveJSON (unPrefix "hyperdataDocumentV3_") ''HyperdataDocumentV3)
183 instance Hyperdata HyperdataDocumentV3
185 ------------------------------------------------------------------------
186 data HyperdataDocument = HyperdataDocument { _hyperdataDocument_bdd :: !(Maybe Text)
187 , _hyperdataDocument_doi :: !(Maybe Text)
188 , _hyperdataDocument_url :: !(Maybe Text)
189 , _hyperdataDocument_uniqId :: !(Maybe Text)
190 , _hyperdataDocument_uniqIdBdd :: !(Maybe Text)
191 , _hyperdataDocument_page :: !(Maybe Int)
192 , _hyperdataDocument_title :: !(Maybe Text)
193 , _hyperdataDocument_authors :: !(Maybe Text)
194 , _hyperdataDocument_institutes :: !(Maybe Text)
195 , _hyperdataDocument_source :: !(Maybe Text)
196 , _hyperdataDocument_abstract :: !(Maybe Text)
197 , _hyperdataDocument_publication_date :: !(Maybe Text)
198 , _hyperdataDocument_publication_year :: !(Maybe Int)
199 , _hyperdataDocument_publication_month :: !(Maybe Int)
200 , _hyperdataDocument_publication_day :: !(Maybe Int)
201 , _hyperdataDocument_publication_hour :: !(Maybe Int)
202 , _hyperdataDocument_publication_minute :: !(Maybe Int)
203 , _hyperdataDocument_publication_second :: !(Maybe Int)
204 , _hyperdataDocument_language_iso2 :: !(Maybe Text)
205 } deriving (Show, Generic)
207 $(deriveJSON (unPrefix "_hyperdataDocument_") ''HyperdataDocument)
208 $(makeLenses ''HyperdataDocument)
210 class ToHyperdataDocument a where
211 toHyperdataDocument :: a -> HyperdataDocument
213 instance ToHyperdataDocument HyperdataDocument
215 toHyperdataDocument = identity
217 instance Eq HyperdataDocument where
218 (==) h1 h2 = (==) (_hyperdataDocument_uniqId h1) (_hyperdataDocument_uniqId h2)
220 instance Ord HyperdataDocument where
221 compare h1 h2 = compare (_hyperdataDocument_publication_date h1) (_hyperdataDocument_publication_date h2)
223 instance Hyperdata HyperdataDocument
225 instance ToField HyperdataDocument where
226 toField = toJSONField
228 instance Arbitrary HyperdataDocument where
229 arbitrary = elements arbitraryHyperdataDocuments
231 arbitraryHyperdataDocuments :: [HyperdataDocument]
232 arbitraryHyperdataDocuments =
233 map toHyperdataDocument' ([ ("AI is big but less than crypto", "Troll System journal")
234 , ("Crypto is big but less than AI", "System Troll review" )
235 , ("Science is magic" , "Closed Source review")
236 , ("Open science for all" , "No Time" )
237 , ("Closed science for me" , "No Space" )
240 toHyperdataDocument' (t1,t2) =
241 HyperdataDocument Nothing Nothing Nothing Nothing Nothing Nothing (Just t1)
242 Nothing Nothing (Just t2) Nothing Nothing Nothing Nothing Nothing
243 Nothing Nothing Nothing Nothing
245 ------------------------------------------------------------------------
246 data LanguageNodes = LanguageNodes { languageNodes___unknown__ :: [Int]}
247 deriving (Show, Generic)
248 $(deriveJSON (unPrefix "languageNodes_") ''LanguageNodes)
250 ------------------------------------------------------------------------
251 -- level: debug | dev (fatal = critical)
252 data EventLevel = CRITICAL | FATAL | ERROR | WARNING | INFO | DEBUG
253 deriving (Show, Generic, Enum, Bounded)
255 instance FromJSON EventLevel
256 instance ToJSON EventLevel
258 instance Arbitrary EventLevel where
259 arbitrary = elements [minBound..maxBound]
261 instance ToSchema EventLevel where
262 declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
264 ------------------------------------------------------------------------
266 data Event = Event { event_level :: !EventLevel
267 , event_message :: !Text
268 , event_date :: !UTCTime
269 } deriving (Show, Generic)
270 $(deriveJSON (unPrefix "event_") ''Event)
272 instance Arbitrary Event where
273 arbitrary = Event <$> arbitrary <*> arbitrary <*> arbitrary
275 instance ToSchema Event where
276 declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
278 ------------------------------------------------------------------------
279 instance Arbitrary Text where
280 arbitrary = elements $ map (\c -> pack [c]) ['a'..'z']
282 data Resource = Resource { resource_path :: !(Maybe Text)
283 , resource_scraper :: !(Maybe Text)
284 , resource_query :: !(Maybe Text)
285 , resource_events :: !([Event])
286 , resource_status :: !Status
287 , resource_date :: !UTCTime'
288 } deriving (Show, Generic)
289 $(deriveJSON (unPrefix "resource_") ''Resource)
291 instance Arbitrary Resource where
292 arbitrary = Resource <$> arbitrary
299 instance ToSchema Resource where
300 declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
302 ------------------------------------------------------------------------
303 data HyperdataUser = HyperdataUser { hyperdataUser_language :: Maybe Text
304 } deriving (Show, Generic)
305 $(deriveJSON (unPrefix "hyperdataUser_") ''HyperdataUser)
307 instance Hyperdata HyperdataUser
308 ------------------------------------------------------------------------
309 data HyperdataFolder = HyperdataFolder { hyperdataFolder_desc :: Maybe Text
310 } deriving (Show, Generic)
311 $(deriveJSON (unPrefix "hyperdataFolder_") ''HyperdataFolder)
313 instance Hyperdata HyperdataFolder
314 ------------------------------------------------------------------------
315 data HyperdataCorpus = HyperdataCorpus { hyperdataCorpus_title :: !(Maybe Text)
316 , hyperdataCorpus_desc :: !(Maybe Text)
317 , hyperdataCorpus_query :: !(Maybe Text)
318 , hyperdataCorpus_authors :: !(Maybe Text)
319 , hyperdataCorpus_resources :: !(Maybe [Resource])
320 } deriving (Show, Generic)
321 $(deriveJSON (unPrefix "hyperdataCorpus_") ''HyperdataCorpus)
323 instance Hyperdata HyperdataCorpus
325 corpusExample :: ByteString
326 corpusExample = "" -- TODO
328 defaultCorpus :: HyperdataCorpus
329 defaultCorpus = (HyperdataCorpus (Just "Title") (Just "Descr") (Just "Bool query") (Just "Authors") Nothing)
331 hyperdataCorpus :: HyperdataCorpus
332 hyperdataCorpus = case decode corpusExample of
334 Nothing -> defaultCorpus
336 instance Arbitrary HyperdataCorpus where
337 arbitrary = pure hyperdataCorpus -- TODO
339 ------------------------------------------------------------------------
341 data HyperdataList = HyperdataList {hd_list :: !(Maybe Text)
342 } deriving (Show, Generic)
343 $(deriveJSON (unPrefix "hd_") ''HyperdataList)
345 instance Hyperdata HyperdataList
347 ------------------------------------------------------------------------
348 data HyperdataAnnuaire = HyperdataAnnuaire { hyperdataAnnuaire_title :: !(Maybe Text)
349 , hyperdataAnnuaire_desc :: !(Maybe Text)
350 } deriving (Show, Generic)
351 $(deriveJSON (unPrefix "hyperdataAnnuaire_") ''HyperdataAnnuaire)
353 instance Hyperdata HyperdataAnnuaire
355 hyperdataAnnuaire :: HyperdataAnnuaire
356 hyperdataAnnuaire = HyperdataAnnuaire (Just "Annuaire Title") (Just "Annuaire Description")
358 instance Arbitrary HyperdataAnnuaire where
359 arbitrary = pure hyperdataAnnuaire -- TODO
361 ------------------------------------------------------------------------
362 newtype HyperdataAny = HyperdataAny Object
363 deriving (Show, Generic, ToJSON, FromJSON)
365 instance Hyperdata HyperdataAny
367 instance Arbitrary HyperdataAny where
368 arbitrary = pure $ HyperdataAny mempty -- TODO produce arbitrary objects
369 ------------------------------------------------------------------------
372 instance Arbitrary HyperdataList' where
373 arbitrary = elements [HyperdataList' (Just "from list A")]
377 data HyperdataListModel = HyperdataListModel { _hlm_params :: !(Int, Int)
379 , _hlm_score :: !(Maybe Double)
380 } deriving (Show, Generic)
382 instance Hyperdata HyperdataListModel
383 instance Arbitrary HyperdataListModel where
384 arbitrary = elements [HyperdataListModel (100,100) "models/example.model" Nothing]
386 $(deriveJSON (unPrefix "_hlm_") ''HyperdataListModel)
387 $(makeLenses ''HyperdataListModel)
389 ------------------------------------------------------------------------
390 data HyperdataScore = HyperdataScore { hyperdataScore_preferences :: !(Maybe Text)
391 } deriving (Show, Generic)
392 $(deriveJSON (unPrefix "hyperdataScore_") ''HyperdataScore)
394 instance Hyperdata HyperdataScore
396 ------------------------------------------------------------------------
398 data HyperdataResource = HyperdataResource { hyperdataResource_preferences :: !(Maybe Text)
399 } deriving (Show, Generic)
400 $(deriveJSON (unPrefix "hyperdataResource_") ''HyperdataResource)
402 instance Hyperdata HyperdataResource
404 ------------------------------------------------------------------------
405 data HyperdataDashboard = HyperdataDashboard { hyperdataDashboard_preferences :: !(Maybe Text)
406 } deriving (Show, Generic)
407 $(deriveJSON (unPrefix "hyperdataDashboard_") ''HyperdataDashboard)
409 instance Hyperdata HyperdataDashboard
411 -- TODO add the Graph Structure here
412 data HyperdataGraph = HyperdataGraph { hyperdataGraph_preferences :: !(Maybe Text)
413 } deriving (Show, Generic)
414 $(deriveJSON (unPrefix "hyperdataGraph_") ''HyperdataGraph)
416 instance Hyperdata HyperdataGraph
418 ------------------------------------------------------------------------
420 -- TODO add the Graph Structure here
421 data HyperdataPhylo = HyperdataPhylo { hyperdataPhylo_preferences :: !(Maybe Text)
422 , hyperdataPhylo_data :: !(Maybe Phylo)
423 } deriving (Show, Generic)
424 $(deriveJSON (unPrefix "hyperdataPhylo_") ''HyperdataPhylo)
426 instance Hyperdata HyperdataPhylo
428 ------------------------------------------------------------------------
429 -- | TODO FEATURE: Notebook saved in the node
430 data HyperdataNotebook = HyperdataNotebook { hyperdataNotebook_preferences :: !(Maybe Text)
431 } deriving (Show, Generic)
432 $(deriveJSON (unPrefix "hyperdataNotebook_") ''HyperdataNotebook)
434 instance Hyperdata HyperdataNotebook
438 data HyperData = HyperdataTexts { hd_preferences :: Maybe Text }
439 | HyperdataList' { hd_preferences :: Maybe Text}
440 deriving (Show, Generic)
442 $(deriveJSON (unPrefix "hd_") ''HyperData)
444 instance Hyperdata HyperData
447 ------------------------------------------------------------------------
448 -- | Then a Node can be either a Folder or a Corpus or a Document
449 data NodeType = NodeUser
451 | NodeCorpus | NodeCorpusV3 | NodeTexts | NodeDocument
452 | NodeAnnuaire | NodeContact
453 | NodeGraph | NodePhylo
454 | NodeDashboard | NodeChart | NodeNoteBook
455 | NodeList | NodeListModel
456 deriving (Show, Read, Eq, Generic, Bounded, Enum)
465 allNodeTypes :: [NodeType]
466 allNodeTypes = [minBound ..]
468 instance FromJSON NodeType
469 instance ToJSON NodeType
471 instance FromHttpApiData NodeType
473 parseUrlPiece = Right . read . unpack
475 instance ToParamSchema NodeType
476 instance ToSchema NodeType
479 data NodePolySearch id typename userId
481 hyperdata search = NodeSearch { _ns_id :: id
482 , _ns_typename :: typename
483 , _ns_userId :: userId
484 -- , nodeUniqId :: hashId
485 , _ns_parentId :: parentId
489 , _ns_hyperdata :: hyperdata
490 , _ns_search :: search
491 } deriving (Show, Generic)
492 $(deriveJSON (unPrefix "_ns_") ''NodePolySearch)
493 $(makeLenses ''NodePolySearch)
495 type NodeSearch json = NodePolySearch NodeId NodeTypeId UserId (Maybe ParentId) NodeName UTCTime json (Maybe TSVector)
496 ------------------------------------------------------------------------
499 instance (Arbitrary hyperdata
501 ,Arbitrary nodeTypeId
503 ,Arbitrary nodeParentId
504 ) => Arbitrary (NodePoly nodeId nodeTypeId userId nodeParentId
505 NodeName UTCTime hyperdata) where
506 --arbitrary = Node 1 1 (Just 1) 1 "name" (jour 2018 01 01) (arbitrary) (Just "")
507 arbitrary = Node <$> arbitrary <*> arbitrary <*> arbitrary
508 <*> arbitrary <*> arbitrary <*> arbitrary
511 instance (Arbitrary hyperdata
513 ,Arbitrary nodeTypeId
515 ,Arbitrary nodeParentId
516 ) => Arbitrary (NodePolySearch nodeId nodeTypeId userId nodeParentId
517 NodeName UTCTime hyperdata (Maybe TSVector)) where
518 --arbitrary = Node 1 1 (Just 1) 1 "name" (jour 2018 01 01) (arbitrary) (Just "")
519 arbitrary = NodeSearch <$> arbitrary <*> arbitrary <*> arbitrary
520 <*> arbitrary <*> arbitrary <*> arbitrary
521 <*> arbitrary <*> arbitrary
524 ------------------------------------------------------------------------
525 hyperdataDocument :: HyperdataDocument
526 hyperdataDocument = case decode docExample of
528 Nothing -> HyperdataDocument Nothing Nothing Nothing Nothing
529 Nothing Nothing Nothing Nothing
530 Nothing Nothing Nothing Nothing
531 Nothing Nothing Nothing Nothing
532 Nothing Nothing Nothing
533 docExample :: ByteString
534 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}"
536 instance ToSchema HyperdataCorpus where
537 declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
538 & mapped.schema.description ?~ "a corpus"
539 & mapped.schema.example ?~ toJSON hyperdataCorpus
541 instance ToSchema HyperdataAnnuaire where
542 declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
543 & mapped.schema.description ?~ "an annuaire"
544 & mapped.schema.example ?~ toJSON hyperdataAnnuaire
546 instance ToSchema HyperdataDocument where
547 declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
548 & mapped.schema.description ?~ "a document"
549 & mapped.schema.example ?~ toJSON hyperdataDocument
551 instance ToSchema HyperdataAny where
552 declareNamedSchema proxy =
553 pure $ genericNameSchema defaultSchemaOptions proxy mempty
554 & schema.description ?~ "a node"
555 & schema.example ?~ emptyObject -- TODO
558 instance ToSchema hyperdata =>
559 ToSchema (NodePoly NodeId NodeTypeId
565 instance ToSchema hyperdata =>
566 ToSchema (NodePoly NodeId NodeTypeId
568 (Maybe ParentId) NodeName
573 instance ToSchema hyperdata =>
574 ToSchema (NodePolySearch NodeId NodeTypeId
577 UTCTime hyperdata (Maybe TSVector)
580 instance ToSchema hyperdata =>
581 ToSchema (NodePolySearch NodeId NodeTypeId
583 (Maybe ParentId) NodeName
584 UTCTime hyperdata (Maybe TSVector)
588 instance ToSchema Status