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 ------------------------------------------------------------------------
  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 ------------------------------------------------------------------------
  83 data HyperdataDocumentV3 = HyperdataDocumentV3 { hyperdataDocumentV3_publication_day    :: Maybe Int
  84                                                , hyperdataDocumentV3_language_iso2      :: Maybe Text
  85                                                , hyperdataDocumentV3_publication_minute :: Maybe Int
  86                                                , hyperdataDocumentV3_error              :: Maybe Text
  87                                                , hyperdataDocumentV3_publication_month  :: Maybe Int
  88                                                , hyperdataDocumentV3_language_iso3      :: Maybe Text
  89                                                , hyperdataDocumentV3_publication_second :: Maybe Int
  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                                                , hyperdataDocumentV3_publication_hour   :: Maybe Int
 100                                                } deriving (Show, Generic)
 101 $(deriveJSON (unPrefix "hyperdataDocumentV3_") ''HyperdataDocumentV3)
 102
 103
 104 ------------------------------------------------------------------------
 105
 106 data HyperdataDocument = HyperdataDocument { _hyperdataDocument_bdd                :: Maybe Text
 107                                            , _hyperdataDocument_doi                :: Maybe Int
 108                                            , _hyperdataDocument_url                :: Maybe Text
 109                                            , _hyperdataDocument_uniqId             :: Maybe Text
 110                                            , _hyperdataDocument_page               :: Maybe Int
 111                                            , _hyperdataDocument_title              :: Maybe Text
 112                                            , _hyperdataDocument_authors            :: Maybe Text
 113                                            , _hyperdataDocument_source             :: Maybe Text
 114                                            , _hyperdataDocument_abstract           :: Maybe Text
 115                                            , _hyperdataDocument_publication_date   :: Maybe Text
 116                                            , _hyperdataDocument_publication_year   :: Maybe Int
 117                                            , _hyperdataDocument_publication_month  :: Maybe Int
 118                                            , _hyperdataDocument_publication_hour   :: Maybe Int
 119                                            , _hyperdataDocument_publication_minute :: Maybe Int
 120                                            , _hyperdataDocument_publication_second :: Maybe Int
 121                                            , _hyperdataDocument_language_iso2       :: Maybe Text
 122                                            , _hyperdataDocument_language_iso3       :: Maybe Text
 123                                            } deriving (Show, Generic)
 124 $(deriveJSON (unPrefix "_hyperdataDocument_") ''HyperdataDocument)
 125 $(makeLenses ''HyperdataDocument)
 126
 127 instance ToField HyperdataDocument where
 128   toField = toJSONField
 129
 130 toHyperdataDocuments :: [(Text, Text)] -> [HyperdataDocument]
 131 toHyperdataDocuments ts = map (\(t1,t2) -> HyperdataDocument Nothing Nothing Nothing Nothing Nothing (Just t1)
 132                                            Nothing (Just t2) Nothing Nothing Nothing
 133                                            Nothing Nothing Nothing Nothing Nothing Nothing
 134                                            ) ts
 135
 136 hyperdataDocuments :: [HyperdataDocument]
 137 hyperdataDocuments = toHyperdataDocuments [ ("AI is big but less than crypto", "Troll System journal")
 138                                           , ("Crypto is big but less than AI", "System Troll review" )
 139                                           , ("Science is magic"              , "Closed Source review")
 140                                           , ("Open science for all"          , "No Time"             )
 141                                           , ("Closed science for me"         , "No Space"            )
 142                                           ]
 143
 144
 145 instance Arbitrary HyperdataDocument where
 146     arbitrary = elements hyperdataDocuments
 147
 148 ------------------------------------------------------------------------
 149 data LanguageNodes = LanguageNodes { languageNodes___unknown__ :: [Int]}
 150     deriving (Show, Generic)
 151 $(deriveJSON (unPrefix "languageNodes_") ''LanguageNodes)
 152
 153 ------------------------------------------------------------------------
 154 -- level: debug | dev  (fatal = critical)
 155 data EventLevel = CRITICAL | FATAL | ERROR | WARNING | INFO | DEBUG
 156   deriving (Show, Generic, Enum, Bounded)
 157
 158 instance FromJSON EventLevel
 159 instance ToJSON EventLevel
 160
 161 instance Arbitrary EventLevel where
 162   arbitrary = elements [minBound..maxBound]
 163
 164 ------------------------------------------------------------------------
 165
 166 data Event = Event { event_level   :: EventLevel
 167                    , event_message :: Text
 168                    , event_date    :: UTCTime
 169             } deriving (Show, Generic)
 170 $(deriveJSON (unPrefix "event_") ''Event)
 171
 172 instance Arbitrary Event where
 173   arbitrary = Event <$> arbitrary <*> arbitrary <*> arbitrary
 174
 175 ------------------------------------------------------------------------
 176
 177 type Text' = Text
 178
 179 instance Arbitrary Text' where
 180   arbitrary = elements ["ici", "la"]
 181
 182 data Resource = Resource { resource_path    :: Maybe Text
 183                          , resource_scraper :: Maybe Text
 184                          , resource_query   :: Maybe Text
 185                          , resource_events  :: [Event]
 186                          , resource_status  :: Status
 187                          , resource_date    :: UTCTime'
 188                          } deriving (Show, Generic)
 189 $(deriveJSON (unPrefix "resource_") ''Resource)
 190
 191 instance Arbitrary Resource where
 192     arbitrary = Resource <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
 193
 194 ------------------------------------------------------------------------
 195
 196 data HyperdataCorpus = HyperdataCorpus { hyperdataCorpus_resources    :: [Resource]
 197                                        } deriving (Show, Generic)
 198 $(deriveJSON (unPrefix "hyperdataCorpus_") ''HyperdataCorpus)
 199
 200
 201 data HyperdataUser = HyperdataUser { hyperdataUser_language       :: Maybe Text
 202                                        } deriving (Show, Generic)
 203 $(deriveJSON (unPrefix "hyperdataUser_") ''HyperdataUser)
 204
 205 -- Preferences ?
 206
 207 data HyperdataFolder = HyperdataFolder { hyperdataFolder_preferences   :: Maybe Text
 208                                        } deriving (Show, Generic)
 209 $(deriveJSON (unPrefix "hyperdataFolder_") ''HyperdataFolder)
 210
 211
 212 data HyperdataProject = HyperdataProject { hyperdataProject_preferences   :: Maybe Text
 213                                        } deriving (Show, Generic)
 214 $(deriveJSON (unPrefix "hyperdataProject_") ''HyperdataProject)
 215
 216
 217
 218 data HyperdataList = HyperdataList { hyperdataList_preferences   :: Maybe Text
 219                                    } deriving (Show, Generic)
 220 $(deriveJSON (unPrefix "hyperdataList_") ''HyperdataList)
 221
 222 data HyperdataScore = HyperdataScore { hyperdataScore_preferences   :: Maybe Text
 223                                    } deriving (Show, Generic)
 224 $(deriveJSON (unPrefix "hyperdataScore_") ''HyperdataScore)
 225
 226
 227
 228 data HyperdataFavorites = HyperdataFavorites { hyperdataFavorites_preferences   :: Maybe Text
 229                                    } deriving (Show, Generic)
 230 $(deriveJSON (unPrefix "hyperdataFavorites_") ''HyperdataFavorites)
 231
 232 data HyperdataResource = HyperdataResource { hyperdataResource_preferences   :: Maybe Text
 233                                    } deriving (Show, Generic)
 234 $(deriveJSON (unPrefix "hyperdataResource_") ''HyperdataResource)
 235
 236
 237
 238 -- TODO add the Graph Structure here
 239 data HyperdataGraph = HyperdataGraph { hyperdataGraph_preferences   :: Maybe Text
 240                                    } deriving (Show, Generic)
 241 $(deriveJSON (unPrefix "hyperdataGraph_") ''HyperdataGraph)
 242
 243
 244 -- TODO add the Graph Structure here
 245 data HyperdataPhylo = HyperdataPhylo { hyperdataPhylo_preferences   :: Maybe Text
 246                                    } deriving (Show, Generic)
 247 $(deriveJSON (unPrefix "hyperdataPhylo_") ''HyperdataPhylo)
 248
 249 -- | TODO FEATURE: Notebook saved in the node (to work with Python or Haskell)
 250 data HyperdataNotebook = HyperdataNotebook { hyperdataNotebook_preferences   :: Maybe Text
 251                                    } deriving (Show, Generic)
 252 $(deriveJSON (unPrefix "hyperdataNotebook_") ''HyperdataNotebook)
 253
 254
 255
 256 -- | NodePoly indicates that Node has a Polymorphism Type
 257 type Node json   = NodePoly NodeId NodeTypeId NodeUserId (Maybe NodeParentId) NodeName UTCTime json -- NodeVector
 258
 259 -- type Node json   = NodePoly NodeId NodeTypeId UserId ParentId NodeName UTCTime json
 260 type NodeTypeId   = Int
 261 type NodeId       = Int
 262 type NodeParentId = Int
 263 type NodeUserId   = Int
 264 type NodeName     = Text
 265 --type NodeVector   = Vector
 266
 267 --type NodeUser    = Node HyperdataUser
 268
 269 -- | Then a Node can be either a Folder or a Corpus or a Document
 270 type NodeUser   = Node HyperdataUser
 271 type Folder     = Node HyperdataFolder
 272 type Project    = Node HyperdataProject
 273 type NodeCorpus = Node HyperdataCorpus
 274 type Document   = Node HyperdataDocument
 275
 276 ------------------------------------------------------------------------
 277 data NodeType = NodeUser
 278               -- | Project
 279               | Folder
 280               | NodeCorpus | Annuaire
 281               | Document -- | Individu
 282               | UserPage | Favorites
 283               | Graph    | Dashboard | Chart
 284               -- | Classification
 285               -- | Lists
 286               -- | Metrics
 287               | Occurrences
 288               deriving (Show, Read, Eq, Generic, Bounded, Enum)
 289
 290 allNodeTypes :: [NodeType]
 291 allNodeTypes = [minBound ..]
 292
 293 instance FromJSON NodeType
 294 instance ToJSON NodeType
 295
 296 instance FromHttpApiData NodeType
 297   where
 298       parseUrlPiece = Right . read . unpack
 299
 300 instance ToParamSchema NodeType
 301 instance ToSchema      NodeType
 302
 303 ------------------------------------------------------------------------
 304 data NodePoly id typename userId parentId name date hyperdata = Node { node_id        :: id
 305                                                                      , node_typename  :: typename
 306                                                                      , node_userId    :: userId
 307                                                                 --   , nodeHashId    :: hashId
 308                                                                      , node_parentId  :: parentId
 309                                                                      , node_name      :: name
 310                                                                      , node_date      :: date
 311                                                                      , node_hyperdata :: hyperdata
 312                                                               --       , node_titleAbstract :: titleAbstract
 313                                                                      } deriving (Show, Generic)
 314 $(deriveJSON (unPrefix "node_") ''NodePoly)
 315
 316
 317
 318
 319 instance Arbitrary (NodePoly NodeId NodeTypeId (Maybe NodeUserId) NodeParentId NodeName UTCTime Value) where
 320     arbitrary = elements [Node 1 1 (Just 1) 1 "name" (jour 2018 01 01) (Object mempty)]
 321
 322
 323 instance Arbitrary (NodePoly NodeId NodeTypeId NodeUserId (Maybe NodeParentId) NodeName UTCTime Value) where
 324     arbitrary = elements [Node 1 1 1 (Just 1) "name" (jour 2018 01 01) (Object mempty)]
 325
 326 instance Arbitrary (NodePoly NodeId NodeTypeId (Maybe NodeUserId) NodeParentId NodeName UTCTime HyperdataDocument) where
 327     arbitrary = elements [Node 1 1 (Just 1) 1 "name" (jour 2018 01 01) ((hyperdataDocument))]
 328
 329
 330 instance Arbitrary (NodePoly NodeId NodeTypeId NodeUserId (Maybe NodeParentId) NodeName UTCTime HyperdataDocument) where
 331     arbitrary = elements [Node 1 1 1 (Just 1) "name" (jour 2018 01 01) hyperdataDocument]
 332
 333
 334 ------------------------------------------------------------------------
 335 hyperdataDocument :: HyperdataDocument
 336 hyperdataDocument = case decode docExample of
 337                       Just hp -> hp
 338                       Nothing -> HyperdataDocument Nothing Nothing Nothing Nothing
 339                                                    Nothing Nothing Nothing Nothing
 340                                                    Nothing Nothing Nothing Nothing
 341                                                    Nothing Nothing Nothing Nothing
 342                                                    Nothing
 343 docExample :: ByteString
 344 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}"
 345
 346
 347 instance ToSchema HyperdataDocument where
 348   declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
 349     L.& mapped.schema.description ?~ "a document"
 350     L.& mapped.schema.example ?~ toJSON hyperdataDocument
 351
 352
 353 instance ToSchema Value where
 354   declareNamedSchema proxy = genericDeclareNamedSchemaUnrestricted defaultSchemaOptions proxy
 355     L.& mapped.schema.description ?~ "a document"
 356     L.& mapped.schema.example ?~ toJSON ("" :: Text) -- TODO
 357
 358
 359 instance ToSchema (NodePoly NodeId NodeTypeId NodeUserId
 360                             (Maybe NodeParentId) NodeName
 361                             UTCTime HyperdataDocument
 362                   )
 363
 364 instance ToSchema (NodePoly NodeId NodeTypeId
 365                             (Maybe NodeUserId)
 366                             NodeParentId NodeName
 367                             UTCTime HyperdataDocument
 368                   )
 369
 370 instance ToSchema (NodePoly NodeId NodeTypeId
 371                             (Maybe NodeUserId)
 372                             NodeParentId NodeName
 373                             UTCTime Value
 374                   )
 375
 376 instance ToSchema (NodePoly NodeId NodeTypeId
 377                             (NodeUserId)
 378                             (Maybe NodeParentId) NodeName
 379                             UTCTime Value
 380                   )
 381
 382
 383 instance ToSchema Status
 384
 385