src/Gargantext/Database/Types/Node.hs

   1 {-|
   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
   8 Portability : POSIX
   9
  10 -}
  11
  12 {-# OPTIONS_GHC -fno-warn-orphans #-}
  13
  14 {-# LANGUAGE BangPatterns               #-}
  15 {-# LANGUAGE DeriveGeneric              #-}
  16 {-# LANGUAGE FlexibleInstances          #-}
  17 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
  18 {-# LANGUAGE NoImplicitPrelude          #-}
  19 {-# LANGUAGE OverloadedStrings          #-}
  20 {-# LANGUAGE TemplateHaskell            #-}
  21 -- {-# LANGUAGE DuplicateRecordFields #-}
  22
  23 module Gargantext.Database.Types.Node
  24   where
  25
  26 import Prelude (Enum, Bounded, minBound, maxBound)
  27
  28 import GHC.Generics (Generic)
  29
  30 import           Control.Lens hiding (elements)
  31 import qualified Control.Lens   as L
  32 import           Control.Applicative ((<*>))
  33
  34 import           Data.Aeson
  35 import           Data.Aeson.Types (emptyObject)
  36 import           Data.Aeson (Object, toJSON)
  37 import           Data.Aeson.TH (deriveJSON)
  38 import           Data.ByteString.Lazy (ByteString)
  39 import           Data.Either
  40 import           Data.Eq (Eq)
  41 import           Data.Monoid (mempty)
  42 import           Data.Text (Text, unpack)
  43 import           Data.Time (UTCTime)
  44 import           Data.Time.Segment (jour, timesAfter, Granularity(D))
  45 import           Data.Swagger
  46
  47 import           Text.Read (read)
  48 import           Text.Show (Show())
  49
  50 import Database.PostgreSQL.Simple.ToField (ToField, toField, toJSONField)
  51 import           Servant
  52
  53 import           Test.QuickCheck.Arbitrary
  54 import           Test.QuickCheck (elements)
  55
  56 import           Gargantext.Prelude
  57 import           Gargantext.Core.Utils.Prefix (unPrefix)
  58 ------------------------------------------------------------------------
  59
  60 type UTCTime' = UTCTime
  61
  62 instance Arbitrary UTCTime' where
  63     arbitrary = elements $ timesAfter 100 D (jour 2000 01 01)
  64
  65
  66
  67 ------------------------------------------------------------------------
  68 data Status  = Status { status_failed    :: Int
  69                       , status_succeeded :: Int
  70                       , status_remaining :: Int
  71                       } deriving (Show, Generic)
  72 $(deriveJSON (unPrefix "status_") ''Status)
  73
  74 instance Arbitrary Status where
  75   arbitrary = Status <$> arbitrary <*> arbitrary <*> arbitrary
  76
  77 ------------------------------------------------------------------------
  78 data StatusV3  = StatusV3 { statusV3_error  :: Maybe Text
  79                           , statusV3_action :: Maybe Text
  80                       } deriving (Show, Generic)
  81 $(deriveJSON (unPrefix "statusV3_") ''StatusV3)
  82 ------------------------------------------------------------------------
  83
  84 -- Only Hyperdata types should be member of this type class.
  85 class Hyperdata a
  86
  87 ------------------------------------------------------------------------
  88 data HyperdataDocumentV3 = HyperdataDocumentV3 { hyperdataDocumentV3_publication_day    :: !(Maybe Int)
  89                                                , hyperdataDocumentV3_language_iso2      :: !(Maybe Text)
  90                                                , hyperdataDocumentV3_publication_second :: !(Maybe Int)
  91                                                , hyperdataDocumentV3_publication_minute :: !(Maybe Int)
  92                                                , hyperdataDocumentV3_publication_month  :: !(Maybe Int)
  93                                                , hyperdataDocumentV3_publication_hour   :: !(Maybe Int)
  94                                                , hyperdataDocumentV3_error              :: !(Maybe Text)
  95                                                , hyperdataDocumentV3_language_iso3      :: !(Maybe Text)
  96                                                , hyperdataDocumentV3_authors            :: !(Maybe Text)
  97                                                , hyperdataDocumentV3_publication_year   :: !(Maybe Int)
  98                                                , hyperdataDocumentV3_publication_date   :: !(Maybe Text)
  99                                                , hyperdataDocumentV3_language_name      :: !(Maybe Text)
 100                                                , hyperdataDocumentV3_statuses           :: !(Maybe [StatusV3])
 101                                                , hyperdataDocumentV3_realdate_full_     :: !(Maybe Text)
 102                                                , hyperdataDocumentV3_source             :: !(Maybe Text)
 103                                                , hyperdataDocumentV3_abstract           :: !(Maybe Text)
 104                                                , hyperdataDocumentV3_title              :: !(Maybe Text)
 105                                                } deriving (Show, Generic)
 106 $(deriveJSON (unPrefix "hyperdataDocumentV3_") ''HyperdataDocumentV3)
 107
 108 instance Hyperdata HyperdataDocumentV3
 109 ------------------------------------------------------------------------
 110
 111
 112 data HyperdataDocument = HyperdataDocument { _hyperdataDocument_bdd                :: Maybe Text
 113                                            , _hyperdataDocument_doi                :: Maybe Text
 114                                            , _hyperdataDocument_url                :: Maybe Text
 115                                            , _hyperdataDocument_uniqId             :: Maybe Text
 116                                            , _hyperdataDocument_uniqIdBdd          :: Maybe Text
 117                                            , _hyperdataDocument_page               :: Maybe Int
 118                                            , _hyperdataDocument_title              :: Maybe Text
 119                                            , _hyperdataDocument_authors            :: Maybe Text
 120                                            , _hyperdataDocument_institutes         :: Maybe Text
 121                                            , _hyperdataDocument_source             :: Maybe Text
 122                                            , _hyperdataDocument_abstract           :: Maybe Text
 123                                            , _hyperdataDocument_publication_date   :: Maybe Text
 124                                            , _hyperdataDocument_publication_year   :: Maybe Int
 125                                            , _hyperdataDocument_publication_month  :: Maybe Int
 126                                            , _hyperdataDocument_publication_day    :: Maybe Int
 127                                            , _hyperdataDocument_publication_hour   :: Maybe Int
 128                                            , _hyperdataDocument_publication_minute :: Maybe Int
 129                                            , _hyperdataDocument_publication_second :: Maybe Int
 130                                            , _hyperdataDocument_language_iso2      :: Maybe Text
 131                                            } deriving (Show, Generic)
 132 $(deriveJSON (unPrefix "_hyperdataDocument_") ''HyperdataDocument)
 133 $(makeLenses ''HyperdataDocument)
 134
 135 instance Hyperdata HyperdataDocument
 136
 137 instance ToField HyperdataDocument where
 138   toField = toJSONField
 139
 140 toHyperdataDocuments :: [(Text, Text)] -> [HyperdataDocument]
 141 toHyperdataDocuments ts = map (\(t1,t2) -> HyperdataDocument Nothing Nothing Nothing Nothing Nothing Nothing (Just t1)
 142                                            Nothing Nothing (Just t2) Nothing Nothing Nothing Nothing Nothing
 143                                            Nothing Nothing Nothing   Nothing
 144                                            ) ts
 145
 146 hyperdataDocuments :: [HyperdataDocument]
 147 hyperdataDocuments = toHyperdataDocuments [ ("AI is big but less than crypto", "Troll System journal")
 148                                           , ("Crypto is big but less than AI", "System Troll review" )
 149                                           , ("Science is magic"              , "Closed Source review")
 150                                           , ("Open science for all"          , "No Time"             )
 151                                           , ("Closed science for me"         , "No Space"            )
 152                                           ]
 153
 154
 155 instance Arbitrary HyperdataDocument where
 156     arbitrary = elements hyperdataDocuments
 157
 158 ------------------------------------------------------------------------
 159 data LanguageNodes = LanguageNodes { languageNodes___unknown__ :: [Int]}
 160     deriving (Show, Generic)
 161 $(deriveJSON (unPrefix "languageNodes_") ''LanguageNodes)
 162
 163 ------------------------------------------------------------------------
 164 -- level: debug | dev  (fatal = critical)
 165 data EventLevel = CRITICAL | FATAL | ERROR | WARNING | INFO | DEBUG
 166   deriving (Show, Generic, Enum, Bounded)
 167
 168 instance FromJSON EventLevel
 169 instance ToJSON EventLevel
 170
 171 instance Arbitrary EventLevel where
 172   arbitrary = elements [minBound..maxBound]
 173
 174 instance ToSchema EventLevel where
 175   declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
 176
 177 ------------------------------------------------------------------------
 178
 179 data Event = Event { event_level   :: EventLevel
 180                    , event_message :: Text
 181                    , event_date    :: UTCTime
 182             } deriving (Show, Generic)
 183 $(deriveJSON (unPrefix "event_") ''Event)
 184
 185 instance Arbitrary Event where
 186   arbitrary = Event <$> arbitrary <*> arbitrary <*> arbitrary
 187
 188 instance ToSchema Event where
 189   declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
 190
 191 ------------------------------------------------------------------------
 192
 193 type Text' = Text
 194
 195 instance Arbitrary Text' where
 196   arbitrary = elements ["ici", "la"]
 197
 198 data Resource = Resource { resource_path    :: Maybe Text
 199                          , resource_scraper :: Maybe Text
 200                          , resource_query   :: Maybe Text
 201                          , resource_events  :: [Event]
 202                          , resource_status  :: Status
 203                          , resource_date    :: UTCTime'
 204                          } deriving (Show, Generic)
 205 $(deriveJSON (unPrefix "resource_") ''Resource)
 206
 207 instance Arbitrary Resource where
 208     arbitrary = Resource <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
 209
 210 instance ToSchema Resource where
 211   declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
 212
 213 ------------------------------------------------------------------------
 214 data HyperdataUser = HyperdataUser { hyperdataUser_language       :: Maybe Text
 215                                        } deriving (Show, Generic)
 216 $(deriveJSON (unPrefix "hyperdataUser_") ''HyperdataUser)
 217
 218 instance Hyperdata HyperdataUser
 219 ------------------------------------------------------------------------
 220 data HyperdataFolder = HyperdataFolder { hyperdataFolder_desc    :: Maybe Text
 221                                        } deriving (Show, Generic)
 222 $(deriveJSON (unPrefix "hyperdataFolder_") ''HyperdataFolder)
 223
 224 instance Hyperdata HyperdataFolder
 225 ------------------------------------------------------------------------
 226 data HyperdataCorpus = HyperdataCorpus { hyperdataCorpus_title        :: Maybe Text
 227                                        , hyperdataCorpus_desc         :: Maybe Text
 228                                        , hyperdataCorpus_query        :: Maybe Text
 229                                        , hyperdataCorpus_authors      :: Maybe Text
 230                                        , hyperdataCorpus_resources    :: Maybe [Resource]
 231                                        } deriving (Show, Generic)
 232 $(deriveJSON (unPrefix "hyperdataCorpus_") ''HyperdataCorpus)
 233
 234 instance Hyperdata HyperdataCorpus
 235
 236 corpusExample :: ByteString
 237 corpusExample = "" -- TODO
 238
 239 defaultCorpus :: HyperdataCorpus
 240 defaultCorpus = (HyperdataCorpus (Just "Title") (Just "Descr") (Just "Bool query") (Just "Authors") Nothing)
 241
 242 hyperdataCorpus :: HyperdataCorpus
 243 hyperdataCorpus = case decode corpusExample of
 244   Just hp -> hp
 245   Nothing -> defaultCorpus
 246
 247 instance Arbitrary HyperdataCorpus where
 248     arbitrary = pure hyperdataCorpus -- TODO
 249
 250 ------------------------------------------------------------------------
 251 data HyperdataAnnuaire = HyperdataAnnuaire { hyperdataAnnuaire_title        :: Maybe Text
 252                                            , hyperdataAnnuaire_desc         :: Maybe Text
 253                                            } deriving (Show, Generic)
 254 $(deriveJSON (unPrefix "hyperdataAnnuaire_") ''HyperdataAnnuaire)
 255
 256 instance Hyperdata HyperdataAnnuaire
 257
 258 hyperdataAnnuaire :: HyperdataAnnuaire
 259 hyperdataAnnuaire = HyperdataAnnuaire (Just "Annuaire Title") (Just "Annuaire Description")
 260
 261 instance Arbitrary HyperdataAnnuaire where
 262     arbitrary = pure hyperdataAnnuaire -- TODO
 263
 264 ------------------------------------------------------------------------
 265 newtype HyperdataAny = HyperdataAny Object
 266   deriving (Show, Generic, ToJSON, FromJSON)
 267
 268 instance Hyperdata HyperdataAny
 269
 270 instance Arbitrary HyperdataAny where
 271     arbitrary = pure $ HyperdataAny mempty -- TODO produce arbitrary objects
 272 ------------------------------------------------------------------------
 273
 274 data HyperdataList = HyperdataList { hyperdataList_preferences   :: Maybe Text
 275                                    } deriving (Show, Generic)
 276 $(deriveJSON (unPrefix "hyperdataList_") ''HyperdataList)
 277
 278 instance Hyperdata HyperdataList
 279 ------------------------------------------------------------------------
 280 data HyperdataScore = HyperdataScore { hyperdataScore_preferences   :: Maybe Text
 281                                    } deriving (Show, Generic)
 282 $(deriveJSON (unPrefix "hyperdataScore_") ''HyperdataScore)
 283
 284 instance Hyperdata HyperdataScore
 285
 286 ------------------------------------------------------------------------
 287
 288 data HyperdataResource = HyperdataResource { hyperdataResource_preferences   :: Maybe Text
 289                                    } deriving (Show, Generic)
 290 $(deriveJSON (unPrefix "hyperdataResource_") ''HyperdataResource)
 291
 292 instance Hyperdata HyperdataResource
 293
 294 ------------------------------------------------------------------------
 295 data HyperdataDashboard = HyperdataDashboard { hyperdataDashboard_preferences   :: Maybe Text
 296                                    } deriving (Show, Generic)
 297 $(deriveJSON (unPrefix "hyperdataDashboard_") ''HyperdataDashboard)
 298
 299 instance Hyperdata HyperdataDashboard
 300
 301 -- TODO add the Graph Structure here
 302 data HyperdataGraph = HyperdataGraph { hyperdataGraph_preferences   :: Maybe Text
 303                                    } deriving (Show, Generic)
 304 $(deriveJSON (unPrefix "hyperdataGraph_") ''HyperdataGraph)
 305
 306 instance Hyperdata HyperdataGraph
 307 ------------------------------------------------------------------------
 308
 309 -- TODO add the Graph Structure here
 310 data HyperdataPhylo = HyperdataPhylo { hyperdataPhylo_preferences   :: Maybe Text
 311                                    } deriving (Show, Generic)
 312 $(deriveJSON (unPrefix "hyperdataPhylo_") ''HyperdataPhylo)
 313
 314 instance Hyperdata HyperdataPhylo
 315
 316 ------------------------------------------------------------------------
 317 -- | TODO FEATURE: Notebook saved in the node
 318 data HyperdataNotebook = HyperdataNotebook { hyperdataNotebook_preferences   :: Maybe Text
 319                                    } deriving (Show, Generic)
 320 $(deriveJSON (unPrefix "hyperdataNotebook_") ''HyperdataNotebook)
 321
 322 instance Hyperdata HyperdataNotebook
 323
 324
 325 -- | NodePoly indicates that Node has a Polymorphism Type
 326 type Node json   = NodePoly NodeId NodeTypeId NodeUserId (Maybe NodeParentId) NodeName UTCTime json -- NodeVector
 327
 328 -- type Node json   = NodePoly NodeId NodeTypeId UserId ParentId NodeName UTCTime json
 329 type NodeTypeId   = Int
 330 type NodeId       = Int
 331 type NodeParentId = Int
 332 type NodeUserId   = Int
 333 type NodeName     = Text
 334 --type NodeVector   = Vector
 335
 336 --type NodeUser    = Node HyperdataUser
 337
 338 type NodeAny      = Node HyperdataAny
 339
 340 -- | Then a Node can be either a Folder or a Corpus or a Document
 341 type NodeUser     = Node HyperdataUser
 342 type NodeFolder   = Node HyperdataFolder
 343
 344 type NodeCorpus   = Node HyperdataCorpus
 345 type NodeCorpusV3 = Node HyperdataCorpus
 346 type NodeDocument = Node HyperdataDocument
 347
 348 type NodeAnnuaire = Node HyperdataAnnuaire
 349
 350 ---- | Then a Node can be either a Graph or a Phylo or a Notebook
 351 type NodeList     = Node HyperdataList
 352 type NodeGraph    = Node HyperdataGraph
 353 type NodePhylo    = Node HyperdataPhylo
 354 type NodeNotebook = Node HyperdataNotebook
 355 ------------------------------------------------------------------------
 356 data NodeType = NodeUser
 357               | NodeFolder
 358               | NodeCorpus     | NodeCorpusV3 | NodeDocument
 359               | NodeAnnuaire   | NodeContact
 360               -- | NodeOccurrences
 361               | NodeGraph
 362               | NodeDashboard  | NodeChart
 363               -- | Classification
 364               | NodeList
 365               -- | Metrics
 366               deriving (Show, Read, Eq, Generic, Bounded, Enum)
 367
 368 allNodeTypes :: [NodeType]
 369 allNodeTypes = [minBound ..]
 370
 371 instance FromJSON NodeType
 372 instance ToJSON NodeType
 373
 374 instance FromHttpApiData NodeType
 375   where
 376       parseUrlPiece = Right . read . unpack
 377
 378 instance ToParamSchema NodeType
 379 instance ToSchema      NodeType
 380
 381 ------------------------------------------------------------------------
 382 data NodePoly id typename userId parentId name date hyperdata = Node { _node_id        :: id
 383                                                                      , _node_typename  :: typename
 384                                                                      , _node_userId    :: userId
 385                                                                 --   , nodeUniqId    :: hashId
 386                                                                      , _node_parentId  :: parentId
 387                                                                      , _node_name      :: name
 388                                                                      , _node_date      :: date
 389                                                                      , _node_hyperdata :: hyperdata
 390                                                                      } deriving (Show, Generic)
 391 $(deriveJSON (unPrefix "_node_") ''NodePoly)
 392 $(makeLenses ''NodePoly)
 393
 394 instance Arbitrary hyperdata => Arbitrary (NodePoly NodeId NodeTypeId (Maybe NodeUserId) NodeParentId NodeName UTCTime hyperdata) where
 395     arbitrary = Node 1 1 (Just 1) 1 "name" (jour 2018 01 01) <$> arbitrary
 396
 397 instance Arbitrary hyperdata => Arbitrary (NodePoly NodeId NodeTypeId NodeUserId (Maybe NodeParentId) NodeName UTCTime hyperdata) where
 398     arbitrary = Node 1 1 1 (Just 1) "name" (jour 2018 01 01) <$> arbitrary
 399
 400 ------------------------------------------------------------------------
 401 hyperdataDocument :: HyperdataDocument
 402 hyperdataDocument = case decode docExample of
 403                       Just hp -> hp
 404                       Nothing -> HyperdataDocument Nothing Nothing Nothing Nothing
 405                                                    Nothing Nothing Nothing Nothing
 406                                                    Nothing Nothing Nothing Nothing
 407                                                    Nothing Nothing Nothing Nothing
 408                                                    Nothing Nothing Nothing
 409 docExample :: ByteString
 410 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}"
 411
 412 instance ToSchema HyperdataCorpus where
 413   declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
 414     L.& mapped.schema.description ?~ "a corpus"
 415     L.& mapped.schema.example ?~ toJSON hyperdataCorpus
 416
 417
 418 instance ToSchema HyperdataAnnuaire where
 419   declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
 420     L.& mapped.schema.description ?~ "an annuaire"
 421     L.& mapped.schema.example ?~ toJSON hyperdataAnnuaire
 422
 423
 424 instance ToSchema HyperdataDocument where
 425   declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
 426     L.& mapped.schema.description ?~ "a document"
 427     L.& mapped.schema.example ?~ toJSON hyperdataDocument
 428
 429
 430 instance ToSchema HyperdataAny where
 431   declareNamedSchema proxy =
 432     pure $ genericNameSchema defaultSchemaOptions proxy mempty
 433              L.& schema.description ?~ "a node"
 434              L.& schema.example ?~ emptyObject -- TODO
 435
 436
 437 instance ToSchema hyperdata =>
 438          ToSchema (NodePoly NodeId NodeTypeId
 439                             (Maybe NodeUserId)
 440                             NodeParentId NodeName
 441                             UTCTime hyperdata
 442                   )
 443
 444 instance ToSchema hyperdata =>
 445          ToSchema (NodePoly NodeId NodeTypeId
 446                             NodeUserId
 447                             (Maybe NodeParentId) NodeName
 448                             UTCTime hyperdata
 449                   )
 450
 451
 452
 453 instance ToSchema Status
 454
 455