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