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 data HyperdataUser = HyperdataUser { hyperdataUser_language :: !(Maybe Text)
296 } deriving (Show, Generic)
297 $(deriveJSON (unPrefix "hyperdataUser_") ''HyperdataUser)
299 instance Hyperdata HyperdataUser
300 ------------------------------------------------------------------------
301 ------------------------------------------------------------------------
302 ------------------------------------------------------------------------
303 ------------------------------------------------------------------------
310 deriving (Generic, Show, Eq)
311 instance ToJSON Chart
312 instance FromJSON Chart
313 instance ToSchema Chart
316 data CodeType = JSON | Markdown | Haskell
318 instance ToJSON CodeType
319 instance FromJSON CodeType
320 instance ToSchema CodeType
322 ------------------------------------------------------------------------
323 data CorpusField = MarkdownField { _cf_text :: !Text }
324 | JsonField { _cf_title :: !Text
327 , _cf_authors :: !Text
328 -- , _cf_resources :: ![Resource]
330 | HaskellField { _cf_haskell :: !Text }
333 $(deriveJSON (unPrefix "_cf_") ''CorpusField)
334 $(makeLenses ''CorpusField)
336 defaultCorpusField :: CorpusField
337 defaultCorpusField = MarkdownField "# title"
339 instance ToSchema CorpusField where
340 declareNamedSchema proxy =
341 genericDeclareNamedSchema (unPrefixSwagger "_cf_") proxy
342 & mapped.schema.description ?~ "CorpusField"
343 & mapped.schema.example ?~ toJSON defaultCorpusField
345 ------------------------------------------------------------------------
346 data HyperdataField a =
347 HyperdataField { _hf_type :: !CodeType
351 $(deriveJSON (unPrefix "_hf_") ''HyperdataField)
352 $(makeLenses ''HyperdataField)
354 defaultHyperdataField :: HyperdataField CorpusField
355 defaultHyperdataField = HyperdataField Markdown "name" defaultCorpusField
357 instance (ToSchema a) => ToSchema (HyperdataField a) where
359 genericDeclareNamedSchema (unPrefixSwagger "_hf_")
360 -- & mapped.schema.description ?~ "HyperdataField"
361 -- & mapped.schema.example ?~ toJSON defaultHyperdataField
363 ------------------------------------------------------------------------
364 data HyperdataCorpus =
365 HyperdataCorpus { _hc_fields :: ![HyperdataField CorpusField] }
367 $(deriveJSON (unPrefix "_hc_") ''HyperdataCorpus)
368 $(makeLenses ''HyperdataCorpus)
370 instance Hyperdata HyperdataCorpus
372 corpusExample :: ByteString
373 corpusExample = "" -- TODO
375 defaultCorpus :: HyperdataCorpus
376 defaultCorpus = HyperdataCorpus [
377 HyperdataField JSON "Mandatory fields" (JsonField "Title" "Descr" "Bool query" "Authors")
378 , HyperdataField Markdown "Optional Text" (MarkdownField "# title\n## subtitle")
381 hyperdataCorpus :: HyperdataCorpus
382 hyperdataCorpus = case decode corpusExample of
384 Nothing -> defaultCorpus
386 instance Arbitrary HyperdataCorpus where
387 arbitrary = pure hyperdataCorpus -- TODO
389 ------------------------------------------------------------------------
391 data HyperdataList = HyperdataList {hd_list :: !(Maybe Text)
392 } deriving (Show, Generic)
393 $(deriveJSON (unPrefix "hd_") ''HyperdataList)
395 instance Hyperdata HyperdataList
397 ------------------------------------------------------------------------
398 data HyperdataAnnuaire = HyperdataAnnuaire { hyperdataAnnuaire_title :: !(Maybe Text)
399 , hyperdataAnnuaire_desc :: !(Maybe Text)
400 } deriving (Show, Generic)
401 $(deriveJSON (unPrefix "hyperdataAnnuaire_") ''HyperdataAnnuaire)
403 instance Hyperdata HyperdataAnnuaire
405 hyperdataAnnuaire :: HyperdataAnnuaire
406 hyperdataAnnuaire = HyperdataAnnuaire (Just "Annuaire Title") (Just "Annuaire Description")
408 instance Arbitrary HyperdataAnnuaire where
409 arbitrary = pure hyperdataAnnuaire -- TODO
411 ------------------------------------------------------------------------
412 newtype HyperdataAny = HyperdataAny Object
413 deriving (Show, Generic, ToJSON, FromJSON)
415 instance Hyperdata HyperdataAny
417 instance Arbitrary HyperdataAny where
418 arbitrary = pure $ HyperdataAny mempty -- TODO produce arbitrary objects
419 ------------------------------------------------------------------------
422 instance Arbitrary HyperdataList' where
423 arbitrary = elements [HyperdataList' (Just "from list A")]
427 data HyperdataListModel = HyperdataListModel { _hlm_params :: !(Int, Int)
429 , _hlm_score :: !(Maybe Double)
430 } deriving (Show, Generic)
432 instance Hyperdata HyperdataListModel
433 instance Arbitrary HyperdataListModel where
434 arbitrary = elements [HyperdataListModel (100,100) "models/example.model" Nothing]
436 $(deriveJSON (unPrefix "_hlm_") ''HyperdataListModel)
437 $(makeLenses ''HyperdataListModel)
439 ------------------------------------------------------------------------
440 data HyperdataScore = HyperdataScore { hyperdataScore_preferences :: !(Maybe Text)
441 } deriving (Show, Generic)
442 $(deriveJSON (unPrefix "hyperdataScore_") ''HyperdataScore)
444 instance Hyperdata HyperdataScore
446 ------------------------------------------------------------------------
448 data HyperdataResource = HyperdataResource { hyperdataResource_preferences :: !(Maybe Text)
449 } deriving (Show, Generic)
450 $(deriveJSON (unPrefix "hyperdataResource_") ''HyperdataResource)
452 instance Hyperdata HyperdataResource
454 ------------------------------------------------------------------------
455 data HyperdataDashboard = HyperdataDashboard { hyperdataDashboard_preferences :: !(Maybe Text)
456 , hyperdataDashboard_charts :: ![Chart]
457 } deriving (Show, Generic)
458 $(deriveJSON (unPrefix "hyperdataDashboard_") ''HyperdataDashboard)
460 instance Hyperdata HyperdataDashboard
462 ------------------------------------------------------------------------
464 -- TODO add the Graph Structure here
465 data HyperdataPhylo = HyperdataPhylo { hyperdataPhylo_preferences :: !(Maybe Text)
466 , hyperdataPhylo_data :: !(Maybe Phylo)
467 } deriving (Show, Generic)
468 $(deriveJSON (unPrefix "hyperdataPhylo_") ''HyperdataPhylo)
470 instance Hyperdata HyperdataPhylo
472 ------------------------------------------------------------------------
473 -- | TODO FEATURE: Notebook saved in the node
474 data HyperdataNotebook = HyperdataNotebook { hyperdataNotebook_preferences :: !(Maybe Text)
475 } deriving (Show, Generic)
476 $(deriveJSON (unPrefix "hyperdataNotebook_") ''HyperdataNotebook)
478 instance Hyperdata HyperdataNotebook
482 data HyperData = HyperdataTexts { hd_preferences :: Maybe Text }
483 | HyperdataList' { hd_preferences :: Maybe Text}
484 deriving (Show, Generic)
486 $(deriveJSON (unPrefix "hd_") ''HyperData)
488 instance Hyperdata HyperData
492 ------------------------------------------------------------------------
493 -- | Then a Node can be either a Folder or a Corpus or a Document
494 data NodeType = NodeUser
496 | NodeFolderShared | NodeTeam
500 | NodeCorpus | NodeCorpusV3 | NodeTexts | NodeDocument
501 | NodeAnnuaire | NodeContact
502 | NodeGraph | NodePhylo
503 | NodeDashboard | NodeChart | NodeNoteBook
504 | NodeList | NodeListModel
506 deriving (Show, Read, Eq, Generic, Bounded, Enum)
515 allNodeTypes :: [NodeType]
516 allNodeTypes = [minBound ..]
518 instance FromJSON NodeType
519 instance ToJSON NodeType
521 instance FromHttpApiData NodeType
523 parseUrlPiece = Right . read . unpack
525 instance ToParamSchema NodeType
526 instance ToSchema NodeType
529 data NodePolySearch id typename userId
531 hyperdata search = NodeSearch { _ns_id :: id
532 , _ns_typename :: typename
533 , _ns_userId :: userId
534 -- , nodeUniqId :: shaId
535 , _ns_parentId :: parentId
539 , _ns_hyperdata :: hyperdata
540 , _ns_search :: search
541 } deriving (Show, Generic)
542 $(deriveJSON (unPrefix "_ns_") ''NodePolySearch)
543 $(makeLenses ''NodePolySearch)
545 type NodeSearch json = NodePolySearch NodeId NodeTypeId UserId (Maybe ParentId) NodeName UTCTime json (Maybe TSVector)
546 ------------------------------------------------------------------------
549 instance (Arbitrary hyperdata
551 ,Arbitrary nodeTypeId
553 ,Arbitrary nodeParentId
554 ) => Arbitrary (NodePoly nodeId nodeTypeId userId nodeParentId
555 NodeName UTCTime hyperdata) where
556 --arbitrary = Node 1 1 (Just 1) 1 "name" (jour 2018 01 01) (arbitrary) (Just "")
557 arbitrary = Node <$> arbitrary <*> arbitrary <*> arbitrary
558 <*> arbitrary <*> arbitrary <*> arbitrary
561 instance (Arbitrary hyperdata
563 ,Arbitrary nodeTypeId
565 ,Arbitrary nodeParentId
566 ) => Arbitrary (NodePolySearch nodeId nodeTypeId userId nodeParentId
567 NodeName UTCTime hyperdata (Maybe TSVector)) where
568 --arbitrary = Node 1 1 (Just 1) 1 "name" (jour 2018 01 01) (arbitrary) (Just "")
569 arbitrary = NodeSearch <$> arbitrary <*> arbitrary <*> arbitrary
570 <*> arbitrary <*> arbitrary <*> arbitrary
571 <*> arbitrary <*> arbitrary
574 ------------------------------------------------------------------------
575 hyperdataDocument :: HyperdataDocument
576 hyperdataDocument = case decode docExample of
578 Nothing -> HyperdataDocument Nothing Nothing Nothing Nothing
579 Nothing Nothing Nothing Nothing
580 Nothing Nothing Nothing Nothing
581 Nothing Nothing Nothing Nothing
582 Nothing Nothing Nothing
583 docExample :: ByteString
584 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}"
586 instance ToSchema HyperdataCorpus where
587 declareNamedSchema proxy =
588 genericDeclareNamedSchema (unPrefixSwagger "_hc_") proxy
589 & mapped.schema.description ?~ "Corpus"
590 & mapped.schema.example ?~ toJSON hyperdataCorpus
592 instance ToSchema HyperdataAnnuaire where
593 declareNamedSchema proxy =
594 genericDeclareNamedSchema (unPrefixSwagger "hyperdataAnnuaire_") proxy
595 & mapped.schema.description ?~ "an annuaire"
596 & mapped.schema.example ?~ toJSON hyperdataAnnuaire
598 instance ToSchema HyperdataDocument where
599 declareNamedSchema proxy =
600 genericDeclareNamedSchema (unPrefixSwagger "_hyperdataDocument_") proxy
601 & mapped.schema.description ?~ "a document"
602 & mapped.schema.example ?~ toJSON hyperdataDocument
604 instance ToSchema HyperdataAny where
605 declareNamedSchema proxy =
606 pure $ genericNameSchema defaultSchemaOptions proxy mempty
607 & schema.description ?~ "a node"
608 & schema.example ?~ emptyObject -- TODO
611 instance ToSchema hyperdata =>
612 ToSchema (NodePoly NodeId NodeTypeId
617 declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_node_")
619 instance ToSchema hyperdata =>
620 ToSchema (NodePoly NodeId NodeTypeId
622 (Maybe ParentId) NodeName
625 declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_node_")
628 instance ToSchema hyperdata =>
629 ToSchema (NodePolySearch NodeId NodeTypeId
632 UTCTime hyperdata (Maybe TSVector)
634 declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_ns_")
636 instance ToSchema hyperdata =>
637 ToSchema (NodePolySearch NodeId NodeTypeId
639 (Maybe ParentId) NodeName
640 UTCTime hyperdata (Maybe TSVector)
642 declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_ns_")
645 instance ToSchema Status where
646 declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "status_")