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 where
  24
  25 import Prelude (Enum, Bounded, minBound, maxBound)
  26
  27 import GHC.Generics (Generic)
  28
  29 import           Control.Lens hiding (elements)
  30 import qualified Control.Lens   as L
  31 import           Control.Applicative ((<*>))
  32
  33 import           Data.Aeson
  34 import           Data.Aeson.Types (emptyObject)
  35 import           Data.Aeson (Object, toJSON)
  36 import           Data.Aeson.TH (deriveJSON)
  37 import           Data.ByteString.Lazy (ByteString)
  38 import           Data.Either
  39 import           Data.Eq (Eq)
  40 import           Data.Monoid (mempty)
  41 import           Data.Text (Text, unpack)
  42 import           Data.Time (UTCTime)
  43 import           Data.Time.Segment (jour, timesAfter, Granularity(D))
  44 import           Data.Swagger
  45
  46 import           Text.Read (read)
  47 import           Text.Show (Show())
  48
  49 import Database.PostgreSQL.Simple.ToField (ToField, toField, toJSONField)
  50 import           Servant
  51
  52 import           Test.QuickCheck.Arbitrary
  53 import           Test.QuickCheck (elements)
  54
  55 import           Gargantext.Prelude
  56 import           Gargantext.Core.Utils.Prefix (unPrefix)
  57
  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 data HyperdataDocument = HyperdataDocument { _hyperdataDocument_bdd                :: Maybe Text
 112                                            , _hyperdataDocument_doi                :: Maybe Text
 113                                            , _hyperdataDocument_url                :: Maybe Text
 114                                            , _hyperdataDocument_uniqId             :: Maybe Text
 115                                            , _hyperdataDocument_uniqIdBdd          :: Maybe Text
 116                                            , _hyperdataDocument_page               :: Maybe Int
 117                                            , _hyperdataDocument_title              :: Maybe Text
 118                                            , _hyperdataDocument_authors            :: Maybe Text
 119                                            , _hyperdataDocument_source             :: Maybe Text
 120                                            , _hyperdataDocument_abstract           :: Maybe Text
 121                                            , _hyperdataDocument_publication_date   :: Maybe Text
 122                                            , _hyperdataDocument_publication_year   :: Maybe Int
 123                                            , _hyperdataDocument_publication_month  :: Maybe Int
 124                                            , _hyperdataDocument_publication_day    :: Maybe Int
 125                                            , _hyperdataDocument_publication_hour   :: Maybe Int
 126                                            , _hyperdataDocument_publication_minute :: Maybe Int
 127                                            , _hyperdataDocument_publication_second :: Maybe Int
 128                                            , _hyperdataDocument_language_iso2      :: Maybe Text
 129                                            } deriving (Show, Generic)
 130 $(deriveJSON (unPrefix "_hyperdataDocument_") ''HyperdataDocument)
 131 $(makeLenses ''HyperdataDocument)
 132
 133 instance Hyperdata HyperdataDocument
 134
 135 instance ToField HyperdataDocument where
 136   toField = toJSONField
 137
 138 toHyperdataDocuments :: [(Text, Text)] -> [HyperdataDocument]
 139 toHyperdataDocuments ts = map (\(t1,t2) -> HyperdataDocument Nothing Nothing Nothing Nothing Nothing Nothing (Just t1)
 140                                            Nothing (Just t2) Nothing Nothing Nothing Nothing Nothing
 141                                            Nothing Nothing Nothing   Nothing
 142                                            ) ts
 143
 144 hyperdataDocuments :: [HyperdataDocument]
 145 hyperdataDocuments = toHyperdataDocuments [ ("AI is big but less than crypto", "Troll System journal")
 146                                           , ("Crypto is big but less than AI", "System Troll review" )
 147                                           , ("Science is magic"              , "Closed Source review")
 148                                           , ("Open science for all"          , "No Time"             )
 149                                           , ("Closed science for me"         , "No Space"            )
 150                                           ]
 151
 152
 153 instance Arbitrary HyperdataDocument where
 154     arbitrary = elements hyperdataDocuments
 155
 156 ------------------------------------------------------------------------
 157 data LanguageNodes = LanguageNodes { languageNodes___unknown__ :: [Int]}
 158     deriving (Show, Generic)
 159 $(deriveJSON (unPrefix "languageNodes_") ''LanguageNodes)
 160
 161 ------------------------------------------------------------------------
 162 -- level: debug | dev  (fatal = critical)
 163 data EventLevel = CRITICAL | FATAL | ERROR | WARNING | INFO | DEBUG
 164   deriving (Show, Generic, Enum, Bounded)
 165
 166 instance FromJSON EventLevel
 167 instance ToJSON EventLevel
 168
 169 instance Arbitrary EventLevel where
 170   arbitrary = elements [minBound..maxBound]
 171
 172 instance ToSchema EventLevel where
 173   declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
 174
 175 ------------------------------------------------------------------------
 176
 177 data Event = Event { event_level   :: EventLevel
 178                    , event_message :: Text
 179                    , event_date    :: UTCTime
 180             } deriving (Show, Generic)
 181 $(deriveJSON (unPrefix "event_") ''Event)
 182
 183 instance Arbitrary Event where
 184   arbitrary = Event <$> arbitrary <*> arbitrary <*> arbitrary
 185
 186 instance ToSchema Event where
 187   declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
 188
 189 ------------------------------------------------------------------------
 190
 191 type Text' = Text
 192
 193 instance Arbitrary Text' where
 194   arbitrary = elements ["ici", "la"]
 195
 196 data Resource = Resource { resource_path    :: Maybe Text
 197                          , resource_scraper :: Maybe Text
 198                          , resource_query   :: Maybe Text
 199                          , resource_events  :: [Event]
 200                          , resource_status  :: Status
 201                          , resource_date    :: UTCTime'
 202                          } deriving (Show, Generic)
 203 $(deriveJSON (unPrefix "resource_") ''Resource)
 204
 205 instance Arbitrary Resource where
 206     arbitrary = Resource <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
 207
 208 instance ToSchema Resource where
 209   declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
 210
 211 ------------------------------------------------------------------------
 212 data HyperdataUser = HyperdataUser { hyperdataUser_language       :: Maybe Text
 213                                        } deriving (Show, Generic)
 214 $(deriveJSON (unPrefix "hyperdataUser_") ''HyperdataUser)
 215
 216 instance Hyperdata HyperdataUser
 217 ------------------------------------------------------------------------
 218 data HyperdataFolder = HyperdataFolder { hyperdataFolder_desc    :: Maybe Text
 219                                        } deriving (Show, Generic)
 220 $(deriveJSON (unPrefix "hyperdataFolder_") ''HyperdataFolder)
 221
 222 instance Hyperdata HyperdataFolder
 223 ------------------------------------------------------------------------
 224 data HyperdataCorpus = HyperdataCorpus { hyperdataCorpus_title        :: Maybe Text
 225                                        , hyperdataCorpus_desc         :: Maybe Text
 226                                        , hyperdataCorpus_query        :: Maybe Text
 227                                        , hyperdataCorpus_authors      :: Maybe Text
 228                                        , hyperdataCorpus_resources    :: Maybe [Resource]
 229                                        } deriving (Show, Generic)
 230 $(deriveJSON (unPrefix "hyperdataCorpus_") ''HyperdataCorpus)
 231
 232 instance Hyperdata HyperdataCorpus
 233
 234 corpusExample :: ByteString
 235 corpusExample = "" -- TODO
 236
 237 defaultCorpus :: HyperdataCorpus
 238 defaultCorpus = (HyperdataCorpus (Just "Title") (Just "Descr") (Just "Bool query") (Just "Authors") Nothing)
 239
 240 hyperdataCorpus :: HyperdataCorpus
 241 hyperdataCorpus = case decode corpusExample of
 242   Just hp -> hp
 243   Nothing -> defaultCorpus
 244
 245 instance Arbitrary HyperdataCorpus where
 246     arbitrary = pure hyperdataCorpus -- TODO
 247
 248 ------------------------------------------------------------------------
 249 data HyperdataAnnuaire = HyperdataAnnuaire { hyperdataAnnuaire_title        :: Maybe Text
 250                                            , hyperdataAnnuaire_desc         :: Maybe Text
 251                                            } deriving (Show, Generic)
 252 $(deriveJSON (unPrefix "hyperdataAnnuaire_") ''HyperdataAnnuaire)
 253
 254 instance Hyperdata HyperdataAnnuaire
 255
 256 hyperdataAnnuaire :: HyperdataAnnuaire
 257 hyperdataAnnuaire = HyperdataAnnuaire (Just "Annuaire Title") (Just "Annuaire Description")
 258
 259 instance Arbitrary HyperdataAnnuaire where
 260     arbitrary = pure hyperdataAnnuaire -- TODO
 261
 262 ------------------------------------------------------------------------
 263 data HyperdataContact = HyperdataContact { hyperdataContact_name        :: Maybe Text
 264                                          , hyperdataContact_mail        :: Maybe Text
 265                                          } deriving (Show, Generic)
 266 $(deriveJSON (unPrefix "hyperdataContact_") ''HyperdataContact)
 267
 268 instance Hyperdata HyperdataContact
 269 ------------------------------------------------------------------------
 270 newtype HyperdataAny = HyperdataAny Object
 271   deriving (Show, Generic, ToJSON, FromJSON)
 272
 273 instance Hyperdata HyperdataAny
 274
 275 instance Arbitrary HyperdataAny where
 276     arbitrary = pure $ HyperdataAny mempty -- TODO produce arbitrary objects
 277 ------------------------------------------------------------------------
 278
 279 data HyperdataList = HyperdataList { hyperdataList_preferences   :: Maybe Text
 280                                    } deriving (Show, Generic)
 281 $(deriveJSON (unPrefix "hyperdataList_") ''HyperdataList)
 282
 283 instance Hyperdata HyperdataList
 284 ------------------------------------------------------------------------
 285 data HyperdataScore = HyperdataScore { hyperdataScore_preferences   :: Maybe Text
 286                                    } deriving (Show, Generic)
 287 $(deriveJSON (unPrefix "hyperdataScore_") ''HyperdataScore)
 288
 289 instance Hyperdata HyperdataScore
 290
 291 ------------------------------------------------------------------------
 292
 293 data HyperdataResource = HyperdataResource { hyperdataResource_preferences   :: Maybe Text
 294                                    } deriving (Show, Generic)
 295 $(deriveJSON (unPrefix "hyperdataResource_") ''HyperdataResource)
 296
 297 instance Hyperdata HyperdataResource
 298
 299 ------------------------------------------------------------------------
 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 type NodeContact  = Node HyperdataContact
 350
 351 ---- | Then a Node can be either a Graph or a Phylo or a Notebook
 352 type NodeList     = Node HyperdataList
 353 type NodeGraph    = Node HyperdataGraph
 354 type NodePhylo    = Node HyperdataPhylo
 355 type NodeNotebook = Node HyperdataNotebook
 356 ------------------------------------------------------------------------
 357 data NodeType = NodeUser
 358               | NodeFolder
 359               | NodeCorpus     | NodeCorpusV3 | NodeDocument
 360               | NodeAnnuaire   | NodeContact
 361               -- | NodeOccurrences
 362               | NodeGraph
 363               | NodeDashboard  | NodeChart
 364               -- | Classification
 365               | NodeList
 366               -- | Metrics
 367               deriving (Show, Read, Eq, Generic, Bounded, Enum)
 368
 369 allNodeTypes :: [NodeType]
 370 allNodeTypes = [minBound ..]
 371
 372 instance FromJSON NodeType
 373 instance ToJSON NodeType
 374
 375 instance FromHttpApiData NodeType
 376   where
 377       parseUrlPiece = Right . read . unpack
 378
 379 instance ToParamSchema NodeType
 380 instance ToSchema      NodeType
 381
 382 ------------------------------------------------------------------------
 383 data NodePoly id typename userId parentId name date hyperdata = Node { _node_id        :: id
 384                                                                      , _node_typename  :: typename
 385                                                                      , _node_userId    :: userId
 386                                                                 --   , nodeUniqId    :: hashId
 387                                                                      , _node_parentId  :: parentId
 388                                                                      , _node_name      :: name
 389                                                                      , _node_date      :: date
 390                                                                      , _node_hyperdata :: hyperdata
 391                                                                      } deriving (Show, Generic)
 392 $(deriveJSON (unPrefix "_node_") ''NodePoly)
 393 $(makeLenses ''NodePoly)
 394
 395 instance Arbitrary hyperdata => Arbitrary (NodePoly NodeId NodeTypeId (Maybe NodeUserId) NodeParentId NodeName UTCTime hyperdata) where
 396     arbitrary = Node 1 1 (Just 1) 1 "name" (jour 2018 01 01) <$> arbitrary
 397
 398 instance Arbitrary hyperdata => Arbitrary (NodePoly NodeId NodeTypeId NodeUserId (Maybe NodeParentId) NodeName UTCTime hyperdata) where
 399     arbitrary = Node 1 1 1 (Just 1) "name" (jour 2018 01 01) <$> arbitrary
 400
 401 ------------------------------------------------------------------------
 402 hyperdataDocument :: HyperdataDocument
 403 hyperdataDocument = case decode docExample of
 404                       Just hp -> hp
 405                       Nothing -> HyperdataDocument Nothing Nothing Nothing Nothing
 406                                                    Nothing Nothing Nothing Nothing
 407                                                    Nothing Nothing Nothing Nothing
 408                                                    Nothing Nothing Nothing Nothing
 409                                                    Nothing Nothing
 410 docExample :: ByteString
 411 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}"
 412
 413 instance ToSchema HyperdataCorpus where
 414   declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
 415     L.& mapped.schema.description ?~ "a corpus"
 416     L.& mapped.schema.example ?~ toJSON hyperdataCorpus
 417
 418
 419 instance ToSchema HyperdataAnnuaire where
 420   declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
 421     L.& mapped.schema.description ?~ "an annuaire"
 422     L.& mapped.schema.example ?~ toJSON hyperdataAnnuaire
 423
 424
 425 instance ToSchema HyperdataDocument where
 426   declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
 427     L.& mapped.schema.description ?~ "a document"
 428     L.& mapped.schema.example ?~ toJSON hyperdataDocument
 429
 430
 431 instance ToSchema HyperdataAny where
 432   declareNamedSchema proxy =
 433     pure $ genericNameSchema defaultSchemaOptions proxy mempty
 434              L.& schema.description ?~ "a node"
 435              L.& schema.example ?~ emptyObject -- TODO
 436
 437
 438 instance ToSchema hyperdata =>
 439          ToSchema (NodePoly NodeId NodeTypeId
 440                             (Maybe NodeUserId)
 441                             NodeParentId NodeName
 442                             UTCTime hyperdata
 443                   )
 444
 445 instance ToSchema hyperdata =>
 446          ToSchema (NodePoly NodeId NodeTypeId
 447                             NodeUserId
 448                             (Maybe NodeParentId) NodeName
 449                             UTCTime hyperdata
 450                   )
 451
 452
 453
 454 instance ToSchema Status
 455
 456