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 data Status  = Status { status_failed    :: Int
  68                       , status_succeeded :: Int
  69                       , status_remaining :: Int
  70                       } deriving (Show, Generic)
  71 $(deriveJSON (unPrefix "status_") ''Status)
  72
  73 instance Arbitrary Status where
  74   arbitrary = Status <$> arbitrary <*> arbitrary <*> arbitrary
  75
  76 ------------------------------------------------------------------------
  77 data StatusV3  = StatusV3 { statusV3_error  :: Maybe Text
  78                           , statusV3_action :: Maybe Text
  79                       } deriving (Show, Generic)
  80 $(deriveJSON (unPrefix "statusV3_") ''StatusV3)
  81 ------------------------------------------------------------------------
  82
  83 -- Only Hyperdata types should be member of this type class.
  84 class Hyperdata a
  85
  86 ------------------------------------------------------------------------
  87 data HyperdataDocumentV3 = HyperdataDocumentV3 { hyperdataDocumentV3_publication_day    :: !(Maybe Int)
  88                                                , hyperdataDocumentV3_language_iso2      :: !(Maybe Text)
  89                                                , hyperdataDocumentV3_publication_second :: !(Maybe Int)
  90                                                , hyperdataDocumentV3_publication_minute :: !(Maybe Int)
  91                                                , hyperdataDocumentV3_publication_month  :: !(Maybe Int)
  92                                                , hyperdataDocumentV3_publication_hour   :: !(Maybe Int)
  93                                                , hyperdataDocumentV3_error              :: !(Maybe Text)
  94                                                , hyperdataDocumentV3_language_iso3      :: !(Maybe Text)
  95                                                , hyperdataDocumentV3_authors            :: !(Maybe Text)
  96                                                , hyperdataDocumentV3_publication_year   :: !(Maybe Int)
  97                                                , hyperdataDocumentV3_publication_date   :: !(Maybe Text)
  98                                                , hyperdataDocumentV3_language_name      :: !(Maybe Text)
  99                                                , hyperdataDocumentV3_statuses           :: !(Maybe [StatusV3])
 100                                                , hyperdataDocumentV3_realdate_full_     :: !(Maybe Text)
 101                                                , hyperdataDocumentV3_source             :: !(Maybe Text)
 102                                                , hyperdataDocumentV3_abstract           :: !(Maybe Text)
 103                                                , hyperdataDocumentV3_title              :: !(Maybe Text)
 104                                                } deriving (Show, Generic)
 105 $(deriveJSON (unPrefix "hyperdataDocumentV3_") ''HyperdataDocumentV3)
 106
 107 instance Hyperdata HyperdataDocumentV3
 108 ------------------------------------------------------------------------
 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 newtype HyperdataAny = HyperdataAny Object
 265   deriving (Show, Generic, ToJSON, FromJSON)
 266
 267 instance Hyperdata HyperdataAny
 268
 269 instance Arbitrary HyperdataAny where
 270     arbitrary = pure $ HyperdataAny mempty -- TODO produce arbitrary objects
 271 ------------------------------------------------------------------------
 272
 273 data HyperdataList = HyperdataList { hyperdataList_preferences   :: Maybe Text
 274                                    } deriving (Show, Generic)
 275 $(deriveJSON (unPrefix "hyperdataList_") ''HyperdataList)
 276
 277 instance Hyperdata HyperdataList
 278 ------------------------------------------------------------------------
 279 data HyperdataScore = HyperdataScore { hyperdataScore_preferences   :: Maybe Text
 280                                    } deriving (Show, Generic)
 281 $(deriveJSON (unPrefix "hyperdataScore_") ''HyperdataScore)
 282
 283 instance Hyperdata HyperdataScore
 284
 285 ------------------------------------------------------------------------
 286
 287 data HyperdataResource = HyperdataResource { hyperdataResource_preferences   :: Maybe Text
 288                                    } deriving (Show, Generic)
 289 $(deriveJSON (unPrefix "hyperdataResource_") ''HyperdataResource)
 290
 291 instance Hyperdata HyperdataResource
 292
 293 ------------------------------------------------------------------------
 294 data HyperdataDashboard = HyperdataDashboard { hyperdataDashboard_preferences   :: Maybe Text
 295                                    } deriving (Show, Generic)
 296 $(deriveJSON (unPrefix "hyperdataDashboard_") ''HyperdataDashboard)
 297
 298 instance Hyperdata HyperdataDashboard
 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
 308 -- TODO add the Graph Structure here
 309 data HyperdataPhylo = HyperdataPhylo { hyperdataPhylo_preferences   :: Maybe Text
 310                                    } deriving (Show, Generic)
 311 $(deriveJSON (unPrefix "hyperdataPhylo_") ''HyperdataPhylo)
 312
 313 instance Hyperdata HyperdataPhylo
 314
 315 ------------------------------------------------------------------------
 316 -- | TODO FEATURE: Notebook saved in the node
 317 data HyperdataNotebook = HyperdataNotebook { hyperdataNotebook_preferences   :: Maybe Text
 318                                    } deriving (Show, Generic)
 319 $(deriveJSON (unPrefix "hyperdataNotebook_") ''HyperdataNotebook)
 320
 321 instance Hyperdata HyperdataNotebook
 322
 323
 324 -- | NodePoly indicates that Node has a Polymorphism Type
 325 type Node json   = NodePoly NodeId NodeTypeId NodeUserId (Maybe NodeParentId) NodeName UTCTime json (Maybe TSVector)
 326
 327 -- type Node json   = NodePoly NodeId NodeTypeId UserId ParentId NodeName UTCTime json
 328 type NodeTypeId   = Int
 329 type NodeParentId = Int
 330 type NodeUserId   = Int
 331 type NodeName     = Text
 332 type TSVector     = Text
 333
 334
 335 -- | Then a Node can be either a Folder or a Corpus or a Document
 336 type NodeUser     = Node HyperdataUser
 337 type NodeFolder   = Node HyperdataFolder
 338
 339 type NodeCorpus   = Node HyperdataCorpus
 340 type NodeCorpusV3 = Node HyperdataCorpus
 341 type NodeDocument = Node HyperdataDocument
 342
 343 type NodeAnnuaire = Node HyperdataAnnuaire
 344
 345 -- | Any others nodes
 346 type NodeAny      = Node HyperdataAny
 347
 348 ---- | Then a Node can be either a Graph or a Phylo or a Notebook
 349 type NodeList     = Node HyperdataList
 350 type NodeGraph    = Node HyperdataGraph
 351 type NodePhylo    = Node HyperdataPhylo
 352 type NodeNotebook = Node HyperdataNotebook
 353 ------------------------------------------------------------------------
 354 data NodeType = NodeUser
 355               | NodeFolder
 356               | NodeCorpus     | NodeCorpusV3 | NodeDocument
 357               | NodeAnnuaire   | NodeContact
 358               -- | NodeOccurrences
 359               | NodeGraph
 360               | NodeDashboard  | NodeChart
 361               -- | Classification
 362               | NodeList
 363               -- | Metrics
 364               deriving (Show, Read, Eq, Generic, Bounded, Enum)
 365
 366 allNodeTypes :: [NodeType]
 367 allNodeTypes = [minBound ..]
 368
 369 instance FromJSON NodeType
 370 instance ToJSON NodeType
 371
 372 instance FromHttpApiData NodeType
 373   where
 374       parseUrlPiece = Right . read . unpack
 375
 376 instance ToParamSchema NodeType
 377 instance ToSchema      NodeType
 378
 379 ------------------------------------------------------------------------
 380 data NodePoly id        typename userId
 381               parentId  name     date
 382               hyperdata search = 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
 390                                       , _node_hyperdata :: hyperdata
 391                                       , _node_search    :: search
 392                                       } deriving (Show, Generic)
 393 $(deriveJSON (unPrefix "_node_") ''NodePoly)
 394 $(makeLenses ''NodePoly)
 395
 396
 397 instance (Arbitrary hyperdata
 398          ,Arbitrary nodeId
 399          ,Arbitrary nodeTypeId
 400          ,Arbitrary nodeUserId
 401          ,Arbitrary nodeParentId
 402          ) => Arbitrary (NodePoly nodeId nodeTypeId nodeUserId nodeParentId
 403                                   NodeName UTCTime hyperdata (Maybe TSVector)) where
 404     --arbitrary = Node 1 1 (Just 1) 1 "name" (jour 2018 01 01) (arbitrary) (Just "")
 405     arbitrary = Node <$> arbitrary <*> arbitrary <*> arbitrary
 406                      <*> arbitrary <*> arbitrary <*> arbitrary
 407                      <*> arbitrary <*> arbitrary
 408 ------------------------------------------------------------------------
 409 hyperdataDocument :: HyperdataDocument
 410 hyperdataDocument = case decode docExample of
 411                       Just hp -> hp
 412                       Nothing -> HyperdataDocument Nothing Nothing Nothing Nothing
 413                                                    Nothing Nothing Nothing Nothing
 414                                                    Nothing Nothing Nothing Nothing
 415                                                    Nothing Nothing Nothing Nothing
 416                                                    Nothing Nothing Nothing
 417 docExample :: ByteString
 418 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}"
 419
 420 instance ToSchema HyperdataCorpus where
 421   declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
 422     L.& mapped.schema.description ?~ "a corpus"
 423     L.& mapped.schema.example ?~ toJSON hyperdataCorpus
 424
 425
 426 instance ToSchema HyperdataAnnuaire where
 427   declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
 428     L.& mapped.schema.description ?~ "an annuaire"
 429     L.& mapped.schema.example ?~ toJSON hyperdataAnnuaire
 430
 431
 432 instance ToSchema HyperdataDocument where
 433   declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
 434     L.& mapped.schema.description ?~ "a document"
 435     L.& mapped.schema.example ?~ toJSON hyperdataDocument
 436
 437
 438 instance ToSchema HyperdataAny where
 439   declareNamedSchema proxy =
 440     pure $ genericNameSchema defaultSchemaOptions proxy mempty
 441              L.& schema.description ?~ "a node"
 442              L.& schema.example ?~ emptyObject -- TODO
 443
 444
 445 instance ToSchema hyperdata =>
 446          ToSchema (NodePoly NodeId NodeTypeId
 447                             (Maybe NodeUserId)
 448                             NodeParentId NodeName
 449                             UTCTime hyperdata (Maybe TSVector)
 450                   )
 451
 452 instance ToSchema hyperdata =>
 453          ToSchema (NodePoly NodeId NodeTypeId
 454                             NodeUserId
 455                             (Maybe NodeParentId) NodeName
 456                             UTCTime hyperdata (Maybe TSVector)
 457                   )
 458
 459
 460 instance ToSchema Status
 461
 462