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 type NodeId = Int
  60
  61 type UTCTime' = UTCTime
  62
  63 instance Arbitrary UTCTime' where
  64     arbitrary = elements $ timesAfter 100 D (jour 2000 01 01)
  65
  66
  67
  68 ------------------------------------------------------------------------
  69 data Status  = Status { status_failed    :: Int
  70                       , status_succeeded :: Int
  71                       , status_remaining :: Int
  72                       } deriving (Show, Generic)
  73 $(deriveJSON (unPrefix "status_") ''Status)
  74
  75 instance Arbitrary Status where
  76   arbitrary = Status <$> arbitrary <*> arbitrary <*> arbitrary
  77
  78 ------------------------------------------------------------------------
  79 data StatusV3  = StatusV3 { statusV3_error  :: Maybe Text
  80                           , statusV3_action :: Maybe Text
  81                       } deriving (Show, Generic)
  82 $(deriveJSON (unPrefix "statusV3_") ''StatusV3)
  83 ------------------------------------------------------------------------
  84
  85 -- Only Hyperdata types should be member of this type class.
  86 class Hyperdata a
  87
  88 ------------------------------------------------------------------------
  89 data HyperdataDocumentV3 = HyperdataDocumentV3 { hyperdataDocumentV3_publication_day    :: !(Maybe Int)
  90                                                , hyperdataDocumentV3_language_iso2      :: !(Maybe Text)
  91                                                , hyperdataDocumentV3_publication_second :: !(Maybe Int)
  92                                                , hyperdataDocumentV3_publication_minute :: !(Maybe Int)
  93                                                , hyperdataDocumentV3_publication_month  :: !(Maybe Int)
  94                                                , hyperdataDocumentV3_publication_hour   :: !(Maybe Int)
  95                                                , hyperdataDocumentV3_error              :: !(Maybe Text)
  96                                                , hyperdataDocumentV3_language_iso3      :: !(Maybe Text)
  97                                                , hyperdataDocumentV3_authors            :: !(Maybe Text)
  98                                                , hyperdataDocumentV3_publication_year   :: !(Maybe Int)
  99                                                , hyperdataDocumentV3_publication_date   :: !(Maybe Text)
 100                                                , hyperdataDocumentV3_language_name      :: !(Maybe Text)
 101                                                , hyperdataDocumentV3_statuses           :: !(Maybe [StatusV3])
 102                                                , hyperdataDocumentV3_realdate_full_     :: !(Maybe Text)
 103                                                , hyperdataDocumentV3_source             :: !(Maybe Text)
 104                                                , hyperdataDocumentV3_abstract           :: !(Maybe Text)
 105                                                , hyperdataDocumentV3_title              :: !(Maybe Text)
 106                                                } deriving (Show, Generic)
 107 $(deriveJSON (unPrefix "hyperdataDocumentV3_") ''HyperdataDocumentV3)
 108
 109 instance Hyperdata HyperdataDocumentV3
 110 ------------------------------------------------------------------------
 111
 112
 113 data HyperdataDocument = HyperdataDocument { _hyperdataDocument_bdd                :: Maybe Text
 114                                            , _hyperdataDocument_doi                :: Maybe Text
 115                                            , _hyperdataDocument_url                :: Maybe Text
 116                                            , _hyperdataDocument_uniqId             :: Maybe Text
 117                                            , _hyperdataDocument_uniqIdBdd          :: Maybe Text
 118                                            , _hyperdataDocument_page               :: Maybe Int
 119                                            , _hyperdataDocument_title              :: Maybe Text
 120                                            , _hyperdataDocument_authors            :: Maybe Text
 121                                            , _hyperdataDocument_institutes         :: Maybe Text
 122                                            , _hyperdataDocument_source             :: Maybe Text
 123                                            , _hyperdataDocument_abstract           :: Maybe Text
 124                                            , _hyperdataDocument_publication_date   :: Maybe Text
 125                                            , _hyperdataDocument_publication_year   :: Maybe Int
 126                                            , _hyperdataDocument_publication_month  :: Maybe Int
 127                                            , _hyperdataDocument_publication_day    :: Maybe Int
 128                                            , _hyperdataDocument_publication_hour   :: Maybe Int
 129                                            , _hyperdataDocument_publication_minute :: Maybe Int
 130                                            , _hyperdataDocument_publication_second :: Maybe Int
 131                                            , _hyperdataDocument_language_iso2      :: Maybe Text
 132                                            } deriving (Show, Generic)
 133 $(deriveJSON (unPrefix "_hyperdataDocument_") ''HyperdataDocument)
 134 $(makeLenses ''HyperdataDocument)
 135
 136 instance Hyperdata HyperdataDocument
 137
 138 instance ToField HyperdataDocument where
 139   toField = toJSONField
 140
 141 toHyperdataDocuments :: [(Text, Text)] -> [HyperdataDocument]
 142 toHyperdataDocuments ts = map (\(t1,t2) -> HyperdataDocument Nothing Nothing Nothing Nothing Nothing Nothing (Just t1)
 143                                            Nothing Nothing (Just t2) Nothing Nothing Nothing Nothing Nothing
 144                                            Nothing Nothing Nothing   Nothing
 145                                            ) ts
 146
 147 hyperdataDocuments :: [HyperdataDocument]
 148 hyperdataDocuments = toHyperdataDocuments [ ("AI is big but less than crypto", "Troll System journal")
 149                                           , ("Crypto is big but less than AI", "System Troll review" )
 150                                           , ("Science is magic"              , "Closed Source review")
 151                                           , ("Open science for all"          , "No Time"             )
 152                                           , ("Closed science for me"         , "No Space"            )
 153                                           ]
 154
 155
 156 instance Arbitrary HyperdataDocument where
 157     arbitrary = elements hyperdataDocuments
 158
 159 ------------------------------------------------------------------------
 160 data LanguageNodes = LanguageNodes { languageNodes___unknown__ :: [Int]}
 161     deriving (Show, Generic)
 162 $(deriveJSON (unPrefix "languageNodes_") ''LanguageNodes)
 163
 164 ------------------------------------------------------------------------
 165 -- level: debug | dev  (fatal = critical)
 166 data EventLevel = CRITICAL | FATAL | ERROR | WARNING | INFO | DEBUG
 167   deriving (Show, Generic, Enum, Bounded)
 168
 169 instance FromJSON EventLevel
 170 instance ToJSON EventLevel
 171
 172 instance Arbitrary EventLevel where
 173   arbitrary = elements [minBound..maxBound]
 174
 175 instance ToSchema EventLevel where
 176   declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
 177
 178 ------------------------------------------------------------------------
 179
 180 data Event = Event { event_level   :: EventLevel
 181                    , event_message :: Text
 182                    , event_date    :: UTCTime
 183             } deriving (Show, Generic)
 184 $(deriveJSON (unPrefix "event_") ''Event)
 185
 186 instance Arbitrary Event where
 187   arbitrary = Event <$> arbitrary <*> arbitrary <*> arbitrary
 188
 189 instance ToSchema Event where
 190   declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
 191
 192 ------------------------------------------------------------------------
 193
 194 type Text' = Text
 195
 196 instance Arbitrary Text' where
 197   arbitrary = elements ["ici", "la"]
 198
 199 data Resource = Resource { resource_path    :: Maybe Text
 200                          , resource_scraper :: Maybe Text
 201                          , resource_query   :: Maybe Text
 202                          , resource_events  :: [Event]
 203                          , resource_status  :: Status
 204                          , resource_date    :: UTCTime'
 205                          } deriving (Show, Generic)
 206 $(deriveJSON (unPrefix "resource_") ''Resource)
 207
 208 instance Arbitrary Resource where
 209     arbitrary = Resource <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
 210
 211 instance ToSchema Resource where
 212   declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
 213
 214 ------------------------------------------------------------------------
 215 data HyperdataUser = HyperdataUser { hyperdataUser_language       :: Maybe Text
 216                                        } deriving (Show, Generic)
 217 $(deriveJSON (unPrefix "hyperdataUser_") ''HyperdataUser)
 218
 219 instance Hyperdata HyperdataUser
 220 ------------------------------------------------------------------------
 221 data HyperdataFolder = HyperdataFolder { hyperdataFolder_desc    :: Maybe Text
 222                                        } deriving (Show, Generic)
 223 $(deriveJSON (unPrefix "hyperdataFolder_") ''HyperdataFolder)
 224
 225 instance Hyperdata HyperdataFolder
 226 ------------------------------------------------------------------------
 227 data HyperdataCorpus = HyperdataCorpus { hyperdataCorpus_title        :: Maybe Text
 228                                        , hyperdataCorpus_desc         :: Maybe Text
 229                                        , hyperdataCorpus_query        :: Maybe Text
 230                                        , hyperdataCorpus_authors      :: Maybe Text
 231                                        , hyperdataCorpus_resources    :: Maybe [Resource]
 232                                        } deriving (Show, Generic)
 233 $(deriveJSON (unPrefix "hyperdataCorpus_") ''HyperdataCorpus)
 234
 235 instance Hyperdata HyperdataCorpus
 236
 237 corpusExample :: ByteString
 238 corpusExample = "" -- TODO
 239
 240 defaultCorpus :: HyperdataCorpus
 241 defaultCorpus = (HyperdataCorpus (Just "Title") (Just "Descr") (Just "Bool query") (Just "Authors") Nothing)
 242
 243 hyperdataCorpus :: HyperdataCorpus
 244 hyperdataCorpus = case decode corpusExample of
 245   Just hp -> hp
 246   Nothing -> defaultCorpus
 247
 248 instance Arbitrary HyperdataCorpus where
 249     arbitrary = pure hyperdataCorpus -- TODO
 250
 251 ------------------------------------------------------------------------
 252 data HyperdataAnnuaire = HyperdataAnnuaire { hyperdataAnnuaire_title        :: Maybe Text
 253                                            , hyperdataAnnuaire_desc         :: Maybe Text
 254                                            } deriving (Show, Generic)
 255 $(deriveJSON (unPrefix "hyperdataAnnuaire_") ''HyperdataAnnuaire)
 256
 257 instance Hyperdata HyperdataAnnuaire
 258
 259 hyperdataAnnuaire :: HyperdataAnnuaire
 260 hyperdataAnnuaire = HyperdataAnnuaire (Just "Annuaire Title") (Just "Annuaire Description")
 261
 262 instance Arbitrary HyperdataAnnuaire where
 263     arbitrary = pure hyperdataAnnuaire -- TODO
 264
 265 ------------------------------------------------------------------------
 266 newtype HyperdataAny = HyperdataAny Object
 267   deriving (Show, Generic, ToJSON, FromJSON)
 268
 269 instance Hyperdata HyperdataAny
 270
 271 instance Arbitrary HyperdataAny where
 272     arbitrary = pure $ HyperdataAny mempty -- TODO produce arbitrary objects
 273 ------------------------------------------------------------------------
 274
 275 data HyperdataList = HyperdataList { hyperdataList_preferences   :: Maybe Text
 276                                    } deriving (Show, Generic)
 277 $(deriveJSON (unPrefix "hyperdataList_") ''HyperdataList)
 278
 279 instance Hyperdata HyperdataList
 280 ------------------------------------------------------------------------
 281 data HyperdataScore = HyperdataScore { hyperdataScore_preferences   :: Maybe Text
 282                                    } deriving (Show, Generic)
 283 $(deriveJSON (unPrefix "hyperdataScore_") ''HyperdataScore)
 284
 285 instance Hyperdata HyperdataScore
 286
 287 ------------------------------------------------------------------------
 288
 289 data HyperdataResource = HyperdataResource { hyperdataResource_preferences   :: Maybe Text
 290                                    } deriving (Show, Generic)
 291 $(deriveJSON (unPrefix "hyperdataResource_") ''HyperdataResource)
 292
 293 instance Hyperdata HyperdataResource
 294
 295 ------------------------------------------------------------------------
 296 data HyperdataDashboard = HyperdataDashboard { hyperdataDashboard_preferences   :: Maybe Text
 297                                    } deriving (Show, Generic)
 298 $(deriveJSON (unPrefix "hyperdataDashboard_") ''HyperdataDashboard)
 299
 300 instance Hyperdata HyperdataDashboard
 301
 302 -- TODO add the Graph Structure here
 303 data HyperdataGraph = HyperdataGraph { hyperdataGraph_preferences   :: Maybe Text
 304                                    } deriving (Show, Generic)
 305 $(deriveJSON (unPrefix "hyperdataGraph_") ''HyperdataGraph)
 306
 307 instance Hyperdata HyperdataGraph
 308 ------------------------------------------------------------------------
 309
 310 -- TODO add the Graph Structure here
 311 data HyperdataPhylo = HyperdataPhylo { hyperdataPhylo_preferences   :: Maybe Text
 312                                    } deriving (Show, Generic)
 313 $(deriveJSON (unPrefix "hyperdataPhylo_") ''HyperdataPhylo)
 314
 315 instance Hyperdata HyperdataPhylo
 316
 317 ------------------------------------------------------------------------
 318 -- | TODO FEATURE: Notebook saved in the node
 319 data HyperdataNotebook = HyperdataNotebook { hyperdataNotebook_preferences   :: Maybe Text
 320                                    } deriving (Show, Generic)
 321 $(deriveJSON (unPrefix "hyperdataNotebook_") ''HyperdataNotebook)
 322
 323 instance Hyperdata HyperdataNotebook
 324
 325
 326 -- | NodePoly indicates that Node has a Polymorphism Type
 327 type Node json   = NodePoly NodeId NodeTypeId NodeUserId (Maybe NodeParentId) NodeName UTCTime json -- NodeVector
 328
 329 -- type Node json   = NodePoly NodeId NodeTypeId UserId ParentId NodeName UTCTime json
 330 type NodeTypeId   = 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