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