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)
45 import Data.Time (UTCTime)
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)
57 import Test.QuickCheck.Instances.Time ()
58 import Test.QuickCheck.Instances.Text ()
60 import Gargantext.Prelude
61 import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
62 import Gargantext.Viz.Phylo (Phylo)
63 --import Gargantext.Database.Utils
64 ------------------------------------------------------------------------
66 newtype NodeId = NodeId Int
67 deriving (Show, Read, Generic, Num, Eq, Ord, Enum, ToJSONKey, FromJSONKey, ToJSON, FromJSON)
69 instance ToField NodeId where
70 toField (NodeId n) = toField n
72 instance FromField NodeId where
73 fromField field mdata = do
74 n <- fromField field mdata
76 then return $ NodeId n
79 instance ToSchema NodeId
86 ------------------------------------------------------------------------
87 data NodePoly id typename userId
89 hyperdata = Node { _node_id :: id
90 , _node_typename :: typename
92 , _node_userId :: userId
93 , _node_parentId :: parentId
98 , _node_hyperdata :: hyperdata
99 } deriving (Show, Generic)
100 $(deriveJSON (unPrefix "_node_") ''NodePoly)
101 $(makeLenses ''NodePoly)
103 -- | NodePoly indicates that Node has a Polymorphism Type
104 type Node json = NodePoly NodeId NodeTypeId UserId (Maybe ParentId) NodeName UTCTime json
107 ------------------------------------------------------------------------
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
136 ------------------------------------------------------------------------
137 data Status = Status { status_failed :: !Int
138 , status_succeeded :: !Int
139 , status_remaining :: !Int
140 } deriving (Show, Generic)
141 $(deriveJSON (unPrefix "status_") ''Status)
143 instance Arbitrary Status where
144 arbitrary = Status <$> arbitrary <*> arbitrary <*> arbitrary
146 ------------------------------------------------------------------------
147 data StatusV3 = StatusV3 { statusV3_error :: !(Maybe Text)
148 , statusV3_action :: !(Maybe Text)
149 } deriving (Show, Generic)
150 $(deriveJSON (unPrefix "statusV3_") ''StatusV3)
151 ------------------------------------------------------------------------
153 -- Only Hyperdata types should be member of this type class.
155 ------------------------------------------------------------------------
156 data HyperdataDocumentV3 = HyperdataDocumentV3 { hyperdataDocumentV3_publication_day :: !(Maybe Int)
157 , hyperdataDocumentV3_language_iso2 :: !(Maybe Text)
158 , hyperdataDocumentV3_publication_second :: !(Maybe Int)
159 , hyperdataDocumentV3_publication_minute :: !(Maybe Int)
160 , hyperdataDocumentV3_publication_month :: !(Maybe Int)
161 , hyperdataDocumentV3_publication_hour :: !(Maybe Int)
162 , hyperdataDocumentV3_error :: !(Maybe Text)
163 , hyperdataDocumentV3_language_iso3 :: !(Maybe Text)
164 , hyperdataDocumentV3_authors :: !(Maybe Text)
165 , hyperdataDocumentV3_publication_year :: !(Maybe Int)
166 , hyperdataDocumentV3_publication_date :: !(Maybe Text)
167 , hyperdataDocumentV3_language_name :: !(Maybe Text)
168 , hyperdataDocumentV3_statuses :: !(Maybe [StatusV3])
169 , hyperdataDocumentV3_realdate_full_ :: !(Maybe Text)
170 , hyperdataDocumentV3_source :: !(Maybe Text)
171 , hyperdataDocumentV3_abstract :: !(Maybe Text)
172 , hyperdataDocumentV3_title :: !(Maybe Text)
173 } deriving (Show, Generic)
174 $(deriveJSON (unPrefix "hyperdataDocumentV3_") ''HyperdataDocumentV3)
177 instance Hyperdata HyperdataDocumentV3
179 ------------------------------------------------------------------------
180 data HyperdataDocument = HyperdataDocument { _hyperdataDocument_bdd :: !(Maybe Text)
181 , _hyperdataDocument_doi :: !(Maybe Text)
182 , _hyperdataDocument_url :: !(Maybe Text)
183 , _hyperdataDocument_uniqId :: !(Maybe Text)
184 , _hyperdataDocument_uniqIdBdd :: !(Maybe Text)
185 , _hyperdataDocument_page :: !(Maybe Int)
186 , _hyperdataDocument_title :: !(Maybe Text)
187 , _hyperdataDocument_authors :: !(Maybe Text)
188 , _hyperdataDocument_institutes :: !(Maybe Text)
189 , _hyperdataDocument_source :: !(Maybe Text)
190 , _hyperdataDocument_abstract :: !(Maybe Text)
191 , _hyperdataDocument_publication_date :: !(Maybe Text)
192 , _hyperdataDocument_publication_year :: !(Maybe Int)
193 , _hyperdataDocument_publication_month :: !(Maybe Int)
194 , _hyperdataDocument_publication_day :: !(Maybe Int)
195 , _hyperdataDocument_publication_hour :: !(Maybe Int)
196 , _hyperdataDocument_publication_minute :: !(Maybe Int)
197 , _hyperdataDocument_publication_second :: !(Maybe Int)
198 , _hyperdataDocument_language_iso2 :: !(Maybe Text)
199 } deriving (Show, Generic)
201 $(deriveJSON (unPrefix "_hyperdataDocument_") ''HyperdataDocument)
202 $(makeLenses ''HyperdataDocument)
204 class ToHyperdataDocument a where
205 toHyperdataDocument :: a -> HyperdataDocument
207 instance ToHyperdataDocument HyperdataDocument
209 toHyperdataDocument = identity
211 instance Eq HyperdataDocument where
212 (==) h1 h2 = (==) (_hyperdataDocument_uniqId h1) (_hyperdataDocument_uniqId h2)
214 instance Ord HyperdataDocument where
215 compare h1 h2 = compare (_hyperdataDocument_publication_date h1) (_hyperdataDocument_publication_date h2)
217 instance Hyperdata HyperdataDocument
219 instance ToField HyperdataDocument where
220 toField = toJSONField
222 instance Arbitrary HyperdataDocument where
223 arbitrary = elements arbitraryHyperdataDocuments
225 arbitraryHyperdataDocuments :: [HyperdataDocument]
226 arbitraryHyperdataDocuments =
227 map toHyperdataDocument' ([ ("AI is big but less than crypto", "Troll System journal")
228 , ("Crypto is big but less than AI", "System Troll review" )
229 , ("Science is magic" , "Closed Source review")
230 , ("Open science for all" , "No Time" )
231 , ("Closed science for me" , "No Space" )
234 toHyperdataDocument' (t1,t2) =
235 HyperdataDocument Nothing Nothing Nothing Nothing Nothing Nothing (Just t1)
236 Nothing Nothing (Just t2) Nothing Nothing Nothing Nothing Nothing
237 Nothing Nothing Nothing Nothing
239 ------------------------------------------------------------------------
240 data LanguageNodes = LanguageNodes { languageNodes___unknown__ :: [Int]}
241 deriving (Show, Generic)
242 $(deriveJSON (unPrefix "languageNodes_") ''LanguageNodes)
244 ------------------------------------------------------------------------
245 -- level: debug | dev (fatal = critical)
246 data EventLevel = CRITICAL | FATAL | ERROR | WARNING | INFO | DEBUG
247 deriving (Show, Generic, Enum, Bounded)
249 instance FromJSON EventLevel
250 instance ToJSON EventLevel
252 instance Arbitrary EventLevel where
253 arbitrary = elements [minBound..maxBound]
255 instance ToSchema EventLevel where
256 declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
258 ------------------------------------------------------------------------
260 data Event = Event { event_level :: !EventLevel
261 , event_message :: !Text
262 , event_date :: !UTCTime
263 } deriving (Show, Generic)
264 $(deriveJSON (unPrefix "event_") ''Event)
266 instance Arbitrary Event where
267 arbitrary = Event <$> arbitrary <*> arbitrary <*> arbitrary
269 instance ToSchema Event where
270 declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "event_")
272 ------------------------------------------------------------------------
274 data Resource = Resource { resource_path :: !(Maybe Text)
275 , resource_scraper :: !(Maybe Text)
276 , resource_query :: !(Maybe Text)
277 , resource_events :: !([Event])
278 , resource_status :: !Status
279 , resource_date :: !UTCTime
280 } deriving (Show, Generic)
281 $(deriveJSON (unPrefix "resource_") ''Resource)
283 instance Arbitrary Resource where
284 arbitrary = Resource <$> arbitrary
291 instance ToSchema Resource where
292 declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "resource_")
294 ------------------------------------------------------------------------
295 ------------------------------------------------------------------------
301 deriving (Generic, Show, Eq)
302 instance ToJSON Chart
303 instance FromJSON Chart
304 instance ToSchema Chart
307 data CodeType = JSON | Markdown | Haskell
309 instance ToJSON CodeType
310 instance FromJSON CodeType
311 instance ToSchema CodeType
313 ------------------------------------------------------------------------
314 data CorpusField = MarkdownField { _cf_text :: !Text }
315 | JsonField { _cf_title :: !Text
318 , _cf_authors :: !Text
319 -- , _cf_resources :: ![Resource]
321 | HaskellField { _cf_haskell :: !Text }
324 $(deriveJSON (unPrefix "_cf_") ''CorpusField)
325 $(makeLenses ''CorpusField)
327 defaultCorpusField :: CorpusField
328 defaultCorpusField = MarkdownField "# title"
330 instance ToSchema CorpusField where
331 declareNamedSchema proxy =
332 genericDeclareNamedSchema (unPrefixSwagger "_cf_") proxy
333 & mapped.schema.description ?~ "CorpusField"
334 & mapped.schema.example ?~ toJSON defaultCorpusField
336 ------------------------------------------------------------------------
337 data HyperdataField a =
338 HyperdataField { _hf_type :: !CodeType
342 $(deriveJSON (unPrefix "_hf_") ''HyperdataField)
343 $(makeLenses ''HyperdataField)
345 defaultHyperdataField :: HyperdataField CorpusField
346 defaultHyperdataField = HyperdataField Markdown "name" defaultCorpusField
348 instance (ToSchema a) => ToSchema (HyperdataField a) where
350 genericDeclareNamedSchema (unPrefixSwagger "_hf_")
351 -- & mapped.schema.description ?~ "HyperdataField"
352 -- & mapped.schema.example ?~ toJSON defaultHyperdataField
354 ------------------------------------------------------------------------
355 data HyperdataCorpus =
356 HyperdataCorpus { _hc_fields :: ![HyperdataField CorpusField] }
358 $(deriveJSON (unPrefix "_hc_") ''HyperdataCorpus)
359 $(makeLenses ''HyperdataCorpus)
361 instance Hyperdata HyperdataCorpus
363 corpusExample :: ByteString
364 corpusExample = "" -- TODO
366 defaultCorpus :: HyperdataCorpus
367 defaultCorpus = HyperdataCorpus [
368 HyperdataField JSON "Mandatory fields" (JsonField "Title" "Descr" "Bool query" "Authors")
369 , HyperdataField Markdown "Optional Text" (MarkdownField "# title\n## subtitle")
372 hyperdataCorpus :: HyperdataCorpus
373 hyperdataCorpus = case decode corpusExample of
375 Nothing -> defaultCorpus
377 instance Arbitrary HyperdataCorpus where
378 arbitrary = pure hyperdataCorpus -- TODO
380 ------------------------------------------------------------------------
382 data HyperdataList = HyperdataList {hd_list :: !(Maybe Text)
383 } deriving (Show, Generic)
384 $(deriveJSON (unPrefix "hd_") ''HyperdataList)
386 instance Hyperdata HyperdataList
388 ------------------------------------------------------------------------
389 data HyperdataAnnuaire = HyperdataAnnuaire { hyperdataAnnuaire_title :: !(Maybe Text)
390 , hyperdataAnnuaire_desc :: !(Maybe Text)
391 } deriving (Show, Generic)
392 $(deriveJSON (unPrefix "hyperdataAnnuaire_") ''HyperdataAnnuaire)
394 instance Hyperdata HyperdataAnnuaire
396 hyperdataAnnuaire :: HyperdataAnnuaire
397 hyperdataAnnuaire = HyperdataAnnuaire (Just "Annuaire Title") (Just "Annuaire Description")
399 instance Arbitrary HyperdataAnnuaire where
400 arbitrary = pure hyperdataAnnuaire -- TODO
402 ------------------------------------------------------------------------
403 newtype HyperdataAny = HyperdataAny Object
404 deriving (Show, Generic, ToJSON, FromJSON)
406 instance Hyperdata HyperdataAny
408 instance Arbitrary HyperdataAny where
409 arbitrary = pure $ HyperdataAny mempty -- TODO produce arbitrary objects
410 ------------------------------------------------------------------------
413 instance Arbitrary HyperdataList' where
414 arbitrary = elements [HyperdataList' (Just "from list A")]
418 data HyperdataListModel = HyperdataListModel { _hlm_params :: !(Int, Int)
420 , _hlm_score :: !(Maybe Double)
421 } deriving (Show, Generic)
423 instance Hyperdata HyperdataListModel
424 instance Arbitrary HyperdataListModel where
425 arbitrary = elements [HyperdataListModel (100,100) "models/example.model" Nothing]
427 $(deriveJSON (unPrefix "_hlm_") ''HyperdataListModel)
428 $(makeLenses ''HyperdataListModel)
430 ------------------------------------------------------------------------
431 data HyperdataScore = HyperdataScore { hyperdataScore_preferences :: !(Maybe Text)
432 } deriving (Show, Generic)
433 $(deriveJSON (unPrefix "hyperdataScore_") ''HyperdataScore)
435 instance Hyperdata HyperdataScore
437 ------------------------------------------------------------------------
439 data HyperdataResource = HyperdataResource { hyperdataResource_preferences :: !(Maybe Text)
440 } deriving (Show, Generic)
441 $(deriveJSON (unPrefix "hyperdataResource_") ''HyperdataResource)
443 instance Hyperdata HyperdataResource
445 ------------------------------------------------------------------------
446 data HyperdataDashboard = HyperdataDashboard { hyperdataDashboard_preferences :: !(Maybe Text)
447 , hyperdataDashboard_charts :: ![Chart]
448 } deriving (Show, Generic)
449 $(deriveJSON (unPrefix "hyperdataDashboard_") ''HyperdataDashboard)
451 instance Hyperdata HyperdataDashboard
453 ------------------------------------------------------------------------
455 -- TODO add the Graph Structure here
456 data HyperdataPhylo = HyperdataPhylo { hyperdataPhylo_preferences :: !(Maybe Text)
457 , hyperdataPhylo_data :: !(Maybe Phylo)
458 } deriving (Show, Generic)
459 $(deriveJSON (unPrefix "hyperdataPhylo_") ''HyperdataPhylo)
461 instance Hyperdata HyperdataPhylo
463 ------------------------------------------------------------------------
464 -- | TODO FEATURE: Notebook saved in the node
465 data HyperdataNotebook = HyperdataNotebook { hyperdataNotebook_preferences :: !(Maybe Text)
466 } deriving (Show, Generic)
467 $(deriveJSON (unPrefix "hyperdataNotebook_") ''HyperdataNotebook)
469 instance Hyperdata HyperdataNotebook
473 data HyperData = HyperdataTexts { hd_preferences :: Maybe Text }
474 | HyperdataList' { hd_preferences :: Maybe Text}
475 deriving (Show, Generic)
477 $(deriveJSON (unPrefix "hd_") ''HyperData)
479 instance Hyperdata HyperData
483 ------------------------------------------------------------------------
484 -- | Then a Node can be either a Folder or a Corpus or a Document
485 data NodeType = NodeUser
487 | NodeFolderShared | NodeTeam
491 | NodeCorpus | NodeCorpusV3 | NodeTexts | NodeDocument
492 | NodeAnnuaire | NodeContact
493 | NodeGraph | NodePhylo
494 | NodeDashboard | NodeChart | NodeNoteBook
495 | NodeList | NodeListModel
497 deriving (Show, Read, Eq, Generic, Bounded, Enum)
506 allNodeTypes :: [NodeType]
507 allNodeTypes = [minBound ..]
509 instance FromJSON NodeType
510 instance ToJSON NodeType
512 instance FromHttpApiData NodeType
514 parseUrlPiece = Right . read . unpack
516 instance ToParamSchema NodeType
517 instance ToSchema NodeType
520 data NodePolySearch id typename userId
522 hyperdata search = NodeSearch { _ns_id :: id
523 , _ns_typename :: typename
524 , _ns_userId :: userId
525 -- , nodeUniqId :: shaId
526 , _ns_parentId :: parentId
530 , _ns_hyperdata :: hyperdata
531 , _ns_search :: search
532 } deriving (Show, Generic)
533 $(deriveJSON (unPrefix "_ns_") ''NodePolySearch)
534 $(makeLenses ''NodePolySearch)
536 type NodeSearch json = NodePolySearch NodeId NodeTypeId UserId (Maybe ParentId) NodeName UTCTime json (Maybe TSVector)
537 ------------------------------------------------------------------------
540 instance (Arbitrary hyperdata
542 ,Arbitrary nodeTypeId
544 ,Arbitrary nodeParentId
545 ) => Arbitrary (NodePoly nodeId nodeTypeId userId nodeParentId
546 NodeName UTCTime hyperdata) where
547 --arbitrary = Node 1 1 (Just 1) 1 "name" (jour 2018 01 01) (arbitrary) (Just "")
548 arbitrary = Node <$> arbitrary <*> arbitrary <*> arbitrary
549 <*> arbitrary <*> arbitrary <*> arbitrary
552 instance (Arbitrary hyperdata
554 ,Arbitrary nodeTypeId
556 ,Arbitrary nodeParentId
557 ) => Arbitrary (NodePolySearch nodeId nodeTypeId userId nodeParentId
558 NodeName UTCTime hyperdata (Maybe TSVector)) where
559 --arbitrary = Node 1 1 (Just 1) 1 "name" (jour 2018 01 01) (arbitrary) (Just "")
560 arbitrary = NodeSearch <$> arbitrary <*> arbitrary <*> arbitrary
561 <*> arbitrary <*> arbitrary <*> arbitrary
562 <*> arbitrary <*> arbitrary
565 ------------------------------------------------------------------------
566 hyperdataDocument :: HyperdataDocument
567 hyperdataDocument = case decode docExample of
569 Nothing -> HyperdataDocument Nothing Nothing Nothing Nothing
570 Nothing Nothing Nothing Nothing
571 Nothing Nothing Nothing Nothing
572 Nothing Nothing Nothing Nothing
573 Nothing Nothing Nothing
574 docExample :: ByteString
575 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}"
577 instance ToSchema HyperdataCorpus where
578 declareNamedSchema proxy =
579 genericDeclareNamedSchema (unPrefixSwagger "_hc_") proxy
580 & mapped.schema.description ?~ "Corpus"
581 & mapped.schema.example ?~ toJSON hyperdataCorpus
583 instance ToSchema HyperdataAnnuaire where
584 declareNamedSchema proxy =
585 genericDeclareNamedSchema (unPrefixSwagger "hyperdataAnnuaire_") proxy
586 & mapped.schema.description ?~ "an annuaire"
587 & mapped.schema.example ?~ toJSON hyperdataAnnuaire
589 instance ToSchema HyperdataDocument where
590 declareNamedSchema proxy =
591 genericDeclareNamedSchema (unPrefixSwagger "_hyperdataDocument_") proxy
592 & mapped.schema.description ?~ "a document"
593 & mapped.schema.example ?~ toJSON hyperdataDocument
595 instance ToSchema HyperdataAny where
596 declareNamedSchema proxy =
597 pure $ genericNameSchema defaultSchemaOptions proxy mempty
598 & schema.description ?~ "a node"
599 & schema.example ?~ emptyObject -- TODO
602 instance ToSchema hyperdata =>
603 ToSchema (NodePoly NodeId NodeTypeId
608 declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_node_")
610 instance ToSchema hyperdata =>
611 ToSchema (NodePoly NodeId NodeTypeId
613 (Maybe ParentId) NodeName
616 declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_node_")
619 instance ToSchema hyperdata =>
620 ToSchema (NodePolySearch NodeId NodeTypeId
623 UTCTime hyperdata (Maybe TSVector)
625 declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_ns_")
627 instance ToSchema hyperdata =>
628 ToSchema (NodePolySearch NodeId NodeTypeId
630 (Maybe ParentId) NodeName
631 UTCTime hyperdata (Maybe TSVector)
633 declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_ns_")
636 instance ToSchema Status where
637 declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "status_")