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
 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 data HyperdataResource = HyperdataResource { hyperdataResource_preferences   :: Maybe Text
 294                                    } deriving (Show, Generic)
 295 $(deriveJSON (unPrefix "hyperdataResource_") ''HyperdataResource)
 296
 297 instance Hyperdata HyperdataResource
 298
 299
 300 -- TODO add the Graph Structure here
 301 data HyperdataGraph = HyperdataGraph { hyperdataGraph_preferences   :: Maybe Text
 302                                    } deriving (Show, Generic)
 303 $(deriveJSON (unPrefix "hyperdataGraph_") ''HyperdataGraph)
 304
 305 instance Hyperdata HyperdataGraph
 306
 307 -- TODO add the Graph Structure here
 308 data HyperdataPhylo = HyperdataPhylo { hyperdataPhylo_preferences   :: Maybe Text
 309                                    } deriving (Show, Generic)
 310 $(deriveJSON (unPrefix "hyperdataPhylo_") ''HyperdataPhylo)
 311
 312 instance Hyperdata HyperdataPhylo
 313
 314 -- | TODO FEATURE: Notebook saved in the node (to work with Python or Haskell)
 315 data HyperdataNotebook = HyperdataNotebook { hyperdataNotebook_preferences   :: Maybe Text
 316                                    } deriving (Show, Generic)
 317 $(deriveJSON (unPrefix "hyperdataNotebook_") ''HyperdataNotebook)
 318
 319 instance Hyperdata HyperdataNotebook
 320
 321
 322
 323 -- | NodePoly indicates that Node has a Polymorphism Type
 324 type Node json   = NodePoly NodeId NodeTypeId NodeUserId (Maybe NodeParentId) NodeName UTCTime json -- NodeVector
 325
 326 -- type Node json   = NodePoly NodeId NodeTypeId UserId ParentId NodeName UTCTime json
 327 type NodeTypeId   = Int
 328 type NodeId       = Int
 329 type NodeParentId = Int
 330 type NodeUserId   = Int
 331 type NodeName     = Text
 332 --type NodeVector   = Vector
 333
 334 --type NodeUser    = Node HyperdataUser
 335
 336 type NodeAny      = Node HyperdataAny
 337
 338 -- | Then a Node can be either a Folder or a Corpus or a Document
 339 type NodeUser     = Node HyperdataUser
 340 type NodeFolder   = Node HyperdataFolder
 341
 342 type NodeCorpus   = Node HyperdataCorpus
 343 type NodeCorpusV3 = Node HyperdataCorpus
 344 type NodeDocument = Node HyperdataDocument
 345
 346 type NodeAnnuaire = Node HyperdataAnnuaire
 347 type NodeContact  = Node HyperdataContact
 348
 349 ---- | Then a Node can be either a Graph or a Phylo or a Notebook
 350 type NodeGraph    = Node HyperdataGraph
 351 type NodePhylo    = Node HyperdataPhylo
 352 type NodeNotebook = Node HyperdataNotebook
 353
 354 ------------------------------------------------------------------------
 355 data NodeType = NodeUser
 356               | NodeFolder
 357               | NodeCorpus     | NodeCorpusV3 | NodeDocument
 358               | NodeAnnuaire   | NodeContact
 359               -- | NodeOccurrences
 360               | NodeGraph
 361               | NodeDashboard  | NodeChart
 362               -- | Classification
 363               -- | Lists
 364               -- | Metrics
 365               deriving (Show, Read, Eq, Generic, Bounded, Enum)
 366
 367 allNodeTypes :: [NodeType]
 368 allNodeTypes = [minBound ..]
 369
 370 instance FromJSON NodeType
 371 instance ToJSON NodeType
 372
 373 instance FromHttpApiData NodeType
 374   where
 375       parseUrlPiece = Right . read . unpack
 376
 377 instance ToParamSchema NodeType
 378 instance ToSchema      NodeType
 379
 380 ------------------------------------------------------------------------
 381 data NodePoly id typename userId parentId name date hyperdata = Node { _node_id        :: id
 382                                                                      , _node_typename  :: typename
 383                                                                      , _node_userId    :: userId
 384                                                                 --   , nodeUniqId    :: hashId
 385                                                                      , _node_parentId  :: parentId
 386                                                                      , _node_name      :: name
 387                                                                      , _node_date      :: date
 388                                                                      , _node_hyperdata :: hyperdata
 389                                                                      } deriving (Show, Generic)
 390 $(deriveJSON (unPrefix "_node_") ''NodePoly)
 391 $(makeLenses ''NodePoly)
 392
 393 instance Arbitrary hyperdata => Arbitrary (NodePoly NodeId NodeTypeId (Maybe NodeUserId) NodeParentId NodeName UTCTime hyperdata) where
 394     arbitrary = Node 1 1 (Just 1) 1 "name" (jour 2018 01 01) <$> arbitrary
 395
 396 instance Arbitrary hyperdata => Arbitrary (NodePoly NodeId NodeTypeId NodeUserId (Maybe NodeParentId) NodeName UTCTime hyperdata) where
 397     arbitrary = Node 1 1 1 (Just 1) "name" (jour 2018 01 01) <$> arbitrary
 398
 399 ------------------------------------------------------------------------
 400 hyperdataDocument :: HyperdataDocument
 401 hyperdataDocument = case decode docExample of
 402                       Just hp -> hp
 403                       Nothing -> HyperdataDocument Nothing Nothing Nothing Nothing
 404                                                    Nothing Nothing Nothing Nothing
 405                                                    Nothing Nothing Nothing Nothing
 406                                                    Nothing Nothing Nothing Nothing
 407                                                    Nothing Nothing
 408 docExample :: ByteString
 409 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}"
 410
 411 instance ToSchema HyperdataCorpus where
 412   declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
 413     L.& mapped.schema.description ?~ "a corpus"
 414     L.& mapped.schema.example ?~ toJSON hyperdataCorpus
 415
 416
 417 instance ToSchema HyperdataAnnuaire where
 418   declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
 419     L.& mapped.schema.description ?~ "an annuaire"
 420     L.& mapped.schema.example ?~ toJSON hyperdataAnnuaire
 421
 422
 423 instance ToSchema HyperdataDocument where
 424   declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
 425     L.& mapped.schema.description ?~ "a document"
 426     L.& mapped.schema.example ?~ toJSON hyperdataDocument
 427
 428
 429 instance ToSchema HyperdataAny where
 430   declareNamedSchema proxy =
 431     pure $ genericNameSchema defaultSchemaOptions proxy mempty
 432              L.& schema.description ?~ "a node"
 433              L.& schema.example ?~ emptyObject -- TODO
 434
 435
 436 instance ToSchema hyperdata =>
 437          ToSchema (NodePoly NodeId NodeTypeId
 438                             (Maybe NodeUserId)
 439                             NodeParentId NodeName
 440                             UTCTime hyperdata
 441                   )
 442
 443 instance ToSchema hyperdata =>
 444          ToSchema (NodePoly NodeId NodeTypeId
 445                             NodeUserId
 446                             (Maybe NodeParentId) NodeName
 447                             UTCTime hyperdata
 448                   )
 449
 450
 451
 452 instance ToSchema Status
 453
 454