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 NoImplicitPrelude    #-}
  18 {-# LANGUAGE OverloadedStrings    #-}
  19 {-# LANGUAGE TemplateHaskell      #-}
  20 -- {-# LANGUAGE DuplicateRecordFields #-}
  21
  22 module Gargantext.Database.Types.Node where
  23
  24 import Prelude (Enum, Bounded, minBound, maxBound, mempty)
  25
  26 import GHC.Generics (Generic)
  27
  28 import           Control.Lens hiding (elements)
  29 import qualified Control.Lens   as L
  30 import           Control.Applicative ((<*>))
  31
  32 import           Data.Aeson
  33 import           Data.Aeson (Value(),toJSON)
  34 import           Data.Aeson.TH (deriveJSON)
  35 import           Data.ByteString.Lazy (ByteString)
  36 import           Data.Either
  37 import           Data.Eq (Eq)
  38 import           Data.Text (Text, unpack)
  39 import           Data.Time (UTCTime)
  40 import           Data.Time.Segment (jour, timesAfter, Granularity(D))
  41 import           Data.Swagger
  42
  43 import           Text.Read (read)
  44 import           Text.Show (Show())
  45
  46 import Database.PostgreSQL.Simple.ToField (ToField, toField, toJSONField)
  47 import           Servant
  48
  49 import           Test.QuickCheck.Arbitrary
  50 import           Test.QuickCheck (elements)
  51
  52 import           Gargantext.Prelude
  53 import           Gargantext.Core.Utils.Prefix (unPrefix)
  54
  55 ------------------------------------------------------------------------
  56
  57 type UTCTime' = UTCTime
  58
  59 instance Arbitrary UTCTime' where
  60     arbitrary = elements $ timesAfter 100 D (jour 2000 01 01)
  61
  62
  63
  64 ------------------------------------------------------------------------
  65 data Status  = Status { status_failed    :: Int
  66                       , status_succeeded :: Int
  67                       , status_remaining :: Int
  68                       } deriving (Show, Generic)
  69 $(deriveJSON (unPrefix "status_") ''Status)
  70
  71 instance Arbitrary Status where
  72   arbitrary = Status <$> arbitrary <*> arbitrary <*> arbitrary
  73
  74 ------------------------------------------------------------------------
  75 data StatusV3  = StatusV3 { statusV3_error  :: Maybe Text
  76                           , statusV3_action :: Maybe Text
  77                       } deriving (Show, Generic)
  78 $(deriveJSON (unPrefix "statusV3_") ''StatusV3)
  79
  80 ------------------------------------------------------------------------
  81 ------------------------------------------------------------------------
  82 data HyperdataDocumentV3 = HyperdataDocumentV3 { hyperdataDocumentV3_publication_day    :: !(Maybe Int)
  83                                                , hyperdataDocumentV3_language_iso2      :: !(Maybe Text)
  84                                                , hyperdataDocumentV3_publication_second :: !(Maybe Int)
  85                                                , hyperdataDocumentV3_publication_minute :: !(Maybe Int)
  86                                                , hyperdataDocumentV3_publication_month  :: !(Maybe Int)
  87                                                , hyperdataDocumentV3_publication_hour   :: !(Maybe Int)
  88                                                , hyperdataDocumentV3_error              :: !(Maybe Text)
  89                                                , hyperdataDocumentV3_language_iso3      :: !(Maybe Text)
  90                                                , hyperdataDocumentV3_authors            :: !(Maybe Text)
  91                                                , hyperdataDocumentV3_publication_year   :: !(Maybe Int)
  92                                                , hyperdataDocumentV3_publication_date   :: !(Maybe Text)
  93                                                , hyperdataDocumentV3_language_name      :: !(Maybe Text)
  94                                                , hyperdataDocumentV3_statuses           :: !(Maybe [StatusV3])
  95                                                , hyperdataDocumentV3_realdate_full_     :: !(Maybe Text)
  96                                                , hyperdataDocumentV3_source             :: !(Maybe Text)
  97                                                , hyperdataDocumentV3_abstract           :: !(Maybe Text)
  98                                                , hyperdataDocumentV3_title              :: !(Maybe Text)
  99                                                } deriving (Show, Generic)
 100 $(deriveJSON (unPrefix "hyperdataDocumentV3_") ''HyperdataDocumentV3)
 101 ------------------------------------------------------------------------
 102
 103 data HyperdataDocument = HyperdataDocument { _hyperdataDocument_bdd                :: Maybe Text
 104                                            , _hyperdataDocument_doi                :: Maybe Text
 105                                            , _hyperdataDocument_url                :: Maybe Text
 106                                            , _hyperdataDocument_uniqId             :: Maybe Text
 107                                            , _hyperdataDocument_uniqIdBdd          :: Maybe Text
 108                                            , _hyperdataDocument_page               :: Maybe Int
 109                                            , _hyperdataDocument_title              :: Maybe Text
 110                                            , _hyperdataDocument_authors            :: Maybe Text
 111                                            , _hyperdataDocument_source             :: Maybe Text
 112                                            , _hyperdataDocument_abstract           :: Maybe Text
 113                                            , _hyperdataDocument_publication_date   :: Maybe Text
 114                                            , _hyperdataDocument_publication_year   :: Maybe Int
 115                                            , _hyperdataDocument_publication_month  :: Maybe Int
 116                                            , _hyperdataDocument_publication_day    :: Maybe Int
 117                                            , _hyperdataDocument_publication_hour   :: Maybe Int
 118                                            , _hyperdataDocument_publication_minute :: Maybe Int
 119                                            , _hyperdataDocument_publication_second :: Maybe Int
 120                                            , _hyperdataDocument_language_iso2      :: Maybe Text
 121                                            } deriving (Show, Generic)
 122 $(deriveJSON (unPrefix "_hyperdataDocument_") ''HyperdataDocument)
 123 $(makeLenses ''HyperdataDocument)
 124
 125 instance ToField HyperdataDocument where
 126   toField = toJSONField
 127
 128 toHyperdataDocuments :: [(Text, Text)] -> [HyperdataDocument]
 129 toHyperdataDocuments ts = map (\(t1,t2) -> HyperdataDocument Nothing Nothing Nothing Nothing Nothing Nothing (Just t1)
 130                                            Nothing (Just t2) Nothing Nothing Nothing Nothing Nothing
 131                                            Nothing Nothing Nothing   Nothing
 132                                            ) ts
 133
 134 hyperdataDocuments :: [HyperdataDocument]
 135 hyperdataDocuments = toHyperdataDocuments [ ("AI is big but less than crypto", "Troll System journal")
 136                                           , ("Crypto is big but less than AI", "System Troll review" )
 137                                           , ("Science is magic"              , "Closed Source review")
 138                                           , ("Open science for all"          , "No Time"             )
 139                                           , ("Closed science for me"         , "No Space"            )
 140                                           ]
 141
 142
 143 instance Arbitrary HyperdataDocument where
 144     arbitrary = elements hyperdataDocuments
 145
 146 ------------------------------------------------------------------------
 147 data LanguageNodes = LanguageNodes { languageNodes___unknown__ :: [Int]}
 148     deriving (Show, Generic)
 149 $(deriveJSON (unPrefix "languageNodes_") ''LanguageNodes)
 150
 151 ------------------------------------------------------------------------
 152 -- level: debug | dev  (fatal = critical)
 153 data EventLevel = CRITICAL | FATAL | ERROR | WARNING | INFO | DEBUG
 154   deriving (Show, Generic, Enum, Bounded)
 155
 156 instance FromJSON EventLevel
 157 instance ToJSON EventLevel
 158
 159 instance Arbitrary EventLevel where
 160   arbitrary = elements [minBound..maxBound]
 161
 162 instance ToSchema EventLevel where
 163   declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
 164
 165 ------------------------------------------------------------------------
 166
 167 data Event = Event { event_level   :: EventLevel
 168                    , event_message :: Text
 169                    , event_date    :: UTCTime
 170             } deriving (Show, Generic)
 171 $(deriveJSON (unPrefix "event_") ''Event)
 172
 173 instance Arbitrary Event where
 174   arbitrary = Event <$> arbitrary <*> arbitrary <*> arbitrary
 175
 176 instance ToSchema Event where
 177   declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
 178
 179 ------------------------------------------------------------------------
 180
 181 type Text' = Text
 182
 183 instance Arbitrary Text' where
 184   arbitrary = elements ["ici", "la"]
 185
 186 data Resource = Resource { resource_path    :: Maybe Text
 187                          , resource_scraper :: Maybe Text
 188                          , resource_query   :: Maybe Text
 189                          , resource_events  :: [Event]
 190                          , resource_status  :: Status
 191                          , resource_date    :: UTCTime'
 192                          } deriving (Show, Generic)
 193 $(deriveJSON (unPrefix "resource_") ''Resource)
 194
 195 instance Arbitrary Resource where
 196     arbitrary = Resource <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
 197
 198 instance ToSchema Resource where
 199   declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
 200
 201 ------------------------------------------------------------------------
 202
 203 data Hyperdata a = Hyperdata { unHyperdata :: a}
 204 $(deriveJSON (unPrefix "") ''Hyperdata)
 205
 206 data HyperdataUser = HyperdataUser { hyperdataUser_language       :: Maybe Text
 207                                        } deriving (Show, Generic)
 208 $(deriveJSON (unPrefix "hyperdataUser_") ''HyperdataUser)
 209
 210
 211 data HyperdataFolder = HyperdataFolder { hyperdataFolder_desc    :: Maybe Text
 212                                        } deriving (Show, Generic)
 213 $(deriveJSON (unPrefix "hyperdataFolder_") ''HyperdataFolder)
 214
 215
 216 data HyperdataCorpus = HyperdataCorpus { hyperdataCorpus_title        :: Maybe Text
 217                                        , hyperdataCorpus_desc         :: Maybe Text
 218                                        , hyperdataCorpus_query        :: Maybe Text
 219                                        , hyperdataCorpus_authors      :: Maybe Text
 220                                        , hyperdataCorpus_resources    :: Maybe [Resource]
 221                                        } deriving (Show, Generic)
 222 $(deriveJSON (unPrefix "hyperdataCorpus_") ''HyperdataCorpus)
 223
 224 ------------------------------------------------------------------------
 225 data HyperdataAnnuaire = HyperdataAnnuaire { hyperdataAnnuaire_title        :: Maybe Text
 226                                            , hyperdataAnnuaire_desc         :: Maybe Text
 227                                            } deriving (Show, Generic)
 228 $(deriveJSON (unPrefix "hyperdataAnnuaire_") ''HyperdataAnnuaire)
 229 ------------------------------------------------------------------------
 230 data HyperdataContact = HyperdataContact { hyperdataContact_name        :: Maybe Text
 231                                          , hyperdataContact_mail        :: Maybe Text
 232                                          } deriving (Show, Generic)
 233 $(deriveJSON (unPrefix "hyperdataContact_") ''HyperdataContact)
 234 ------------------------------------------------------------------------
 235
 236 data HyperdataList = HyperdataList { hyperdataList_preferences   :: Maybe Text
 237                                    } deriving (Show, Generic)
 238 $(deriveJSON (unPrefix "hyperdataList_") ''HyperdataList)
 239
 240 data HyperdataScore = HyperdataScore { hyperdataScore_preferences   :: Maybe Text
 241                                    } deriving (Show, Generic)
 242 $(deriveJSON (unPrefix "hyperdataScore_") ''HyperdataScore)
 243
 244
 245 data HyperdataResource = HyperdataResource { hyperdataResource_preferences   :: Maybe Text
 246                                    } deriving (Show, Generic)
 247 $(deriveJSON (unPrefix "hyperdataResource_") ''HyperdataResource)
 248
 249
 250
 251 -- TODO add the Graph Structure here
 252 data HyperdataGraph = HyperdataGraph { hyperdataGraph_preferences   :: Maybe Text
 253                                    } deriving (Show, Generic)
 254 $(deriveJSON (unPrefix "hyperdataGraph_") ''HyperdataGraph)
 255
 256
 257 -- TODO add the Graph Structure here
 258 data HyperdataPhylo = HyperdataPhylo { hyperdataPhylo_preferences   :: Maybe Text
 259                                    } deriving (Show, Generic)
 260 $(deriveJSON (unPrefix "hyperdataPhylo_") ''HyperdataPhylo)
 261
 262 -- | TODO FEATURE: Notebook saved in the node (to work with Python or Haskell)
 263 data HyperdataNotebook = HyperdataNotebook { hyperdataNotebook_preferences   :: Maybe Text
 264                                    } deriving (Show, Generic)
 265 $(deriveJSON (unPrefix "hyperdataNotebook_") ''HyperdataNotebook)
 266
 267
 268
 269 -- | NodePoly indicates that Node has a Polymorphism Type
 270 type Node json   = NodePoly NodeId NodeTypeId NodeUserId (Maybe NodeParentId) NodeName UTCTime json -- NodeVector
 271
 272 -- type Node json   = NodePoly NodeId NodeTypeId UserId ParentId NodeName UTCTime json
 273 type NodeTypeId   = Int
 274 type NodeId       = Int
 275 type NodeParentId = Int
 276 type NodeUserId   = Int
 277 type NodeName     = Text
 278 --type NodeVector   = Vector
 279
 280 --type NodeUser    = Node HyperdataUser
 281
 282 -- | Then a Node can be either a Folder or a Corpus or a Document
 283 type NodeUser     = Node HyperdataUser
 284 type NodeFolder   = Node HyperdataFolder
 285
 286 type NodeCorpus   = Node HyperdataCorpus
 287 type NodeCorpusV3 = Node HyperdataCorpus
 288 type NodeDocument = Node HyperdataDocument
 289
 290 type NodeAnnuaire = Node HyperdataAnnuaire
 291 type NodeContact  = Node HyperdataContact
 292
 293 ---- | Then a Node can be either a Graph or a Phylo or a Notebook
 294 type NodeGraph    = Node HyperdataGraph
 295 type NodePhylo    = Node HyperdataPhylo
 296 type NodeNotebook = Node HyperdataNotebook
 297
 298 ------------------------------------------------------------------------
 299 data NodeType = NodeUser
 300               | NodeFolder
 301               | NodeCorpus     | NodeCorpusV3 | NodeDocument
 302               | NodeAnnuaire   | NodeContact
 303               -- | NodeOccurrences
 304               | NodeGraph
 305               | NodeDashboard  | NodeChart
 306               -- | Classification
 307               -- | Lists
 308               -- | Metrics
 309               deriving (Show, Read, Eq, Generic, Bounded, Enum)
 310
 311 allNodeTypes :: [NodeType]
 312 allNodeTypes = [minBound ..]
 313
 314 instance FromJSON NodeType
 315 instance ToJSON NodeType
 316
 317 instance FromHttpApiData NodeType
 318   where
 319       parseUrlPiece = Right . read . unpack
 320
 321 instance ToParamSchema NodeType
 322 instance ToSchema      NodeType
 323
 324 ------------------------------------------------------------------------
 325 data NodePoly id typename userId parentId name date hyperdata = Node { _node_id        :: id
 326                                                                      , _node_typename  :: typename
 327                                                                      , _node_userId    :: userId
 328                                                                 --   , nodeUniqId    :: hashId
 329                                                                      , _node_parentId  :: parentId
 330                                                                      , _node_name      :: name
 331                                                                      , _node_date      :: date
 332                                                                      , _node_hyperdata :: hyperdata
 333                                                                      } deriving (Show, Generic)
 334 $(deriveJSON (unPrefix "_node_") ''NodePoly)
 335 $(makeLenses ''NodePoly)
 336
 337
 338
 339 instance Arbitrary (NodePoly NodeId NodeTypeId (Maybe NodeUserId) NodeParentId NodeName UTCTime Value) where
 340     arbitrary = elements [Node 1 1 (Just 1) 1 "name" (jour 2018 01 01) (Object mempty)]
 341
 342
 343 instance Arbitrary (NodePoly NodeId NodeTypeId NodeUserId (Maybe NodeParentId) NodeName UTCTime Value) where
 344     arbitrary = elements [Node 1 1 1 (Just 1) "name" (jour 2018 01 01) (Object mempty)]
 345
 346 instance Arbitrary (NodePoly NodeId NodeTypeId (Maybe NodeUserId) NodeParentId NodeName UTCTime HyperdataDocument) where
 347     arbitrary = elements [Node 1 1 (Just 1) 1 "name" (jour 2018 01 01) ((hyperdataDocument))]
 348
 349 instance Arbitrary (NodePoly NodeId NodeTypeId NodeUserId (Maybe NodeParentId) NodeName UTCTime HyperdataDocument) where
 350     arbitrary = elements [Node 1 1 1 (Just 1) "name" (jour 2018 01 01) hyperdataDocument]
 351
 352 instance Arbitrary (NodePoly NodeId NodeTypeId NodeUserId (Maybe NodeParentId) NodeName UTCTime HyperdataCorpus) where
 353     arbitrary = elements [Node 1 1 1 (Just 1) "name" (jour 2018 01 01) hyperdataCorpus]
 354
 355 ------------------------------------------------------------------------
 356 hyperdataDocument :: HyperdataDocument
 357 hyperdataDocument = case decode docExample of
 358                       Just hp -> hp
 359                       Nothing -> HyperdataDocument Nothing Nothing Nothing Nothing
 360                                                    Nothing Nothing Nothing Nothing
 361                                                    Nothing Nothing Nothing Nothing
 362                                                    Nothing Nothing Nothing Nothing
 363                                                    Nothing Nothing
 364 docExample :: ByteString
 365 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}"
 366
 367 corpusExample :: ByteString
 368 corpusExample = "" -- TODO
 369
 370 defaultCorpus :: HyperdataCorpus
 371 defaultCorpus = (HyperdataCorpus (Just "Title") (Just "Descr") (Just "Bool query") (Just "Authors") Nothing)
 372
 373 hyperdataCorpus :: HyperdataCorpus
 374 hyperdataCorpus = case decode corpusExample of
 375   Just hp -> hp
 376   Nothing -> defaultCorpus
 377
 378 instance ToSchema HyperdataCorpus where
 379   declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
 380     L.& mapped.schema.description ?~ "a corpus"
 381     L.& mapped.schema.example ?~ toJSON hyperdataCorpus
 382
 383
 384 instance ToSchema HyperdataDocument where
 385   declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
 386     L.& mapped.schema.description ?~ "a document"
 387     L.& mapped.schema.example ?~ toJSON hyperdataDocument
 388
 389
 390 instance ToSchema Value where
 391   declareNamedSchema proxy = genericDeclareNamedSchemaUnrestricted defaultSchemaOptions proxy
 392     L.& mapped.schema.description ?~ "a document"
 393     L.& mapped.schema.example ?~ toJSON ("" :: Text) -- TODO
 394
 395
 396 instance ToSchema (NodePoly NodeId NodeTypeId NodeUserId
 397                             (Maybe NodeParentId) NodeName
 398                             UTCTime HyperdataDocument
 399                   )
 400
 401 instance ToSchema (NodePoly NodeId NodeTypeId
 402                             (Maybe NodeUserId)
 403                             NodeParentId NodeName
 404                             UTCTime HyperdataDocument
 405                   )
 406
 407 instance ToSchema (NodePoly NodeId NodeTypeId
 408                             (Maybe NodeUserId)
 409                             NodeParentId NodeName
 410                             UTCTime HyperdataCorpus
 411                   )
 412
 413 instance ToSchema (NodePoly NodeId NodeTypeId
 414                             (NodeUserId)
 415                             (Maybe NodeParentId) NodeName
 416                             UTCTime HyperdataCorpus
 417                   )
 418
 419 instance ToSchema (NodePoly NodeId NodeTypeId
 420                             (Maybe NodeUserId)
 421                             NodeParentId NodeName
 422                             UTCTime Value
 423                   )
 424
 425 instance ToSchema (NodePoly NodeId NodeTypeId
 426                             (NodeUserId)
 427                             (Maybe NodeParentId) NodeName
 428                             UTCTime Value
 429                   )
 430
 431
 432 instance ToSchema Status
 433
 434