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 ------------------------------------------------------------------------
 103
 104 data HyperdataDocument = HyperdataDocument { _hyperdataDocument_bdd                :: Maybe Text
 105                                            , _hyperdataDocument_doi                :: Maybe Int
 106                                            , _hyperdataDocument_url                :: Maybe Text
 107                                            , _hyperdataDocument_uniqId             :: 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_hour   :: Maybe Int
 117                                            , _hyperdataDocument_publication_minute :: Maybe Int
 118                                            , _hyperdataDocument_publication_second :: Maybe Int
 119                                            , _hyperdataDocument_language_iso2       :: Maybe Text
 120                                            , _hyperdataDocument_language_iso3       :: 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 (Just t1)
 130                                            Nothing (Just t2) Nothing Nothing Nothing
 131                                            Nothing Nothing 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 ------------------------------------------------------------------------
 163
 164 data Event = Event { event_level   :: EventLevel
 165                    , event_message :: Text
 166                    , event_date    :: UTCTime
 167             } deriving (Show, Generic)
 168 $(deriveJSON (unPrefix "event_") ''Event)
 169
 170 instance Arbitrary Event where
 171   arbitrary = Event <$> arbitrary <*> arbitrary <*> arbitrary
 172
 173 ------------------------------------------------------------------------
 174
 175 type Text' = Text
 176
 177 instance Arbitrary Text' where
 178   arbitrary = elements ["ici", "la"]
 179
 180 data Resource = Resource { resource_path    :: Maybe Text
 181                          , resource_scraper :: Maybe Text
 182                          , resource_query   :: Maybe Text
 183                          , resource_events  :: [Event]
 184                          , resource_status  :: Status
 185                          , resource_date    :: UTCTime'
 186                          } deriving (Show, Generic)
 187 $(deriveJSON (unPrefix "resource_") ''Resource)
 188
 189 instance Arbitrary Resource where
 190     arbitrary = Resource <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
 191
 192 ------------------------------------------------------------------------
 193
 194 data HyperdataCorpus = HyperdataCorpus { hyperdataCorpus_resources    :: [Resource]
 195                                        } deriving (Show, Generic)
 196 $(deriveJSON (unPrefix "hyperdataCorpus_") ''HyperdataCorpus)
 197
 198
 199 data HyperdataUser = HyperdataUser { hyperdataUser_language       :: Maybe Text
 200                                        } deriving (Show, Generic)
 201 $(deriveJSON (unPrefix "hyperdataUser_") ''HyperdataUser)
 202
 203 -- Preferences ?
 204
 205 data HyperdataFolder = HyperdataFolder { hyperdataFolder_preferences   :: Maybe Text
 206                                        } deriving (Show, Generic)
 207 $(deriveJSON (unPrefix "hyperdataFolder_") ''HyperdataFolder)
 208
 209
 210 data HyperdataProject = HyperdataProject { hyperdataProject_preferences   :: Maybe Text
 211                                        } deriving (Show, Generic)
 212 $(deriveJSON (unPrefix "hyperdataProject_") ''HyperdataProject)
 213
 214
 215
 216 data HyperdataList = HyperdataList { hyperdataList_preferences   :: Maybe Text
 217                                    } deriving (Show, Generic)
 218 $(deriveJSON (unPrefix "hyperdataList_") ''HyperdataList)
 219
 220 data HyperdataScore = HyperdataScore { hyperdataScore_preferences   :: Maybe Text
 221                                    } deriving (Show, Generic)
 222 $(deriveJSON (unPrefix "hyperdataScore_") ''HyperdataScore)
 223
 224
 225
 226 data HyperdataFavorites = HyperdataFavorites { hyperdataFavorites_preferences   :: Maybe Text
 227                                    } deriving (Show, Generic)
 228 $(deriveJSON (unPrefix "hyperdataFavorites_") ''HyperdataFavorites)
 229
 230 data HyperdataResource = HyperdataResource { hyperdataResource_preferences   :: Maybe Text
 231                                    } deriving (Show, Generic)
 232 $(deriveJSON (unPrefix "hyperdataResource_") ''HyperdataResource)
 233
 234
 235
 236 -- TODO add the Graph Structure here
 237 data HyperdataGraph = HyperdataGraph { hyperdataGraph_preferences   :: Maybe Text
 238                                    } deriving (Show, Generic)
 239 $(deriveJSON (unPrefix "hyperdataGraph_") ''HyperdataGraph)
 240
 241
 242 -- TODO add the Graph Structure here
 243 data HyperdataPhylo = HyperdataPhylo { hyperdataPhylo_preferences   :: Maybe Text
 244                                    } deriving (Show, Generic)
 245 $(deriveJSON (unPrefix "hyperdataPhylo_") ''HyperdataPhylo)
 246
 247 -- | TODO FEATURE: Notebook saved in the node (to work with Python or Haskell)
 248 data HyperdataNotebook = HyperdataNotebook { hyperdataNotebook_preferences   :: Maybe Text
 249                                    } deriving (Show, Generic)
 250 $(deriveJSON (unPrefix "hyperdataNotebook_") ''HyperdataNotebook)
 251
 252
 253
 254 -- | NodePoly indicates that Node has a Polymorphism Type
 255 type Node json   = NodePoly NodeId NodeTypeId NodeUserId (Maybe NodeParentId) NodeName UTCTime json -- NodeVector
 256
 257 -- type Node json   = NodePoly NodeId NodeTypeId UserId ParentId NodeName UTCTime json
 258 type NodeTypeId   = Int
 259 type NodeId       = Int
 260 type NodeParentId = Int
 261 type NodeUserId   = Int
 262 type NodeName     = Text
 263 --type NodeVector   = Vector
 264
 265 --type NodeUser    = Node HyperdataUser
 266
 267 -- | Then a Node can be either a Folder or a Corpus or a Document
 268 type NodeUser   = Node HyperdataUser
 269 type Folder     = Node HyperdataFolder
 270 type Project    = Node HyperdataProject
 271 type NodeCorpus = Node HyperdataCorpus
 272 type NodeCorpusV3 = Node HyperdataCorpus
 273 type Document   = Node HyperdataDocument
 274
 275 ------------------------------------------------------------------------
 276 data NodeType = NodeUser
 277               -- | Project
 278               | Folder
 279               | NodeCorpus | NodeCorpusV3 | Annuaire
 280               | Document -- | Individu
 281               | UserPage | Favorites
 282               | Graph    | Dashboard | Chart
 283               -- | Classification
 284               -- | Lists
 285               -- | Metrics
 286               | Occurrences
 287               deriving (Show, Read, Eq, Generic, Bounded, Enum)
 288
 289 allNodeTypes :: [NodeType]
 290 allNodeTypes = [minBound ..]
 291
 292 instance FromJSON NodeType
 293 instance ToJSON NodeType
 294
 295 instance FromHttpApiData NodeType
 296   where
 297       parseUrlPiece = Right . read . unpack
 298
 299 instance ToParamSchema NodeType
 300 instance ToSchema      NodeType
 301
 302 ------------------------------------------------------------------------
 303 data NodePoly id typename userId parentId name date hyperdata = Node { node_id        :: id
 304                                                                      , node_typename  :: typename
 305                                                                      , node_userId    :: userId
 306                                                                 --   , nodeHashId    :: hashId
 307                                                                      , node_parentId  :: parentId
 308                                                                      , node_name      :: name
 309                                                                      , node_date      :: date
 310                                                                      , node_hyperdata :: hyperdata
 311                                                               --       , node_titleAbstract :: titleAbstract
 312                                                                      } deriving (Show, Generic)
 313 $(deriveJSON (unPrefix "node_") ''NodePoly)
 314
 315
 316
 317
 318 instance Arbitrary (NodePoly NodeId NodeTypeId (Maybe NodeUserId) NodeParentId NodeName UTCTime Value) where
 319     arbitrary = elements [Node 1 1 (Just 1) 1 "name" (jour 2018 01 01) (Object mempty)]
 320
 321
 322 instance Arbitrary (NodePoly NodeId NodeTypeId NodeUserId (Maybe NodeParentId) NodeName UTCTime Value) where
 323     arbitrary = elements [Node 1 1 1 (Just 1) "name" (jour 2018 01 01) (Object mempty)]
 324
 325 instance Arbitrary (NodePoly NodeId NodeTypeId (Maybe NodeUserId) NodeParentId NodeName UTCTime HyperdataDocument) where
 326     arbitrary = elements [Node 1 1 (Just 1) 1 "name" (jour 2018 01 01) ((hyperdataDocument))]
 327
 328
 329 instance Arbitrary (NodePoly NodeId NodeTypeId NodeUserId (Maybe NodeParentId) NodeName UTCTime HyperdataDocument) where
 330     arbitrary = elements [Node 1 1 1 (Just 1) "name" (jour 2018 01 01) hyperdataDocument]
 331
 332
 333 ------------------------------------------------------------------------
 334 hyperdataDocument :: HyperdataDocument
 335 hyperdataDocument = case decode docExample of
 336                       Just hp -> hp
 337                       Nothing -> HyperdataDocument Nothing Nothing Nothing Nothing
 338                                                    Nothing Nothing Nothing Nothing
 339                                                    Nothing Nothing Nothing Nothing
 340                                                    Nothing Nothing Nothing Nothing
 341                                                    Nothing
 342 docExample :: ByteString
 343 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}"
 344
 345
 346 instance ToSchema HyperdataDocument where
 347   declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
 348     L.& mapped.schema.description ?~ "a document"
 349     L.& mapped.schema.example ?~ toJSON hyperdataDocument
 350
 351
 352 instance ToSchema Value where
 353   declareNamedSchema proxy = genericDeclareNamedSchemaUnrestricted defaultSchemaOptions proxy
 354     L.& mapped.schema.description ?~ "a document"
 355     L.& mapped.schema.example ?~ toJSON ("" :: Text) -- TODO
 356
 357
 358 instance ToSchema (NodePoly NodeId NodeTypeId NodeUserId
 359                             (Maybe NodeParentId) NodeName
 360                             UTCTime HyperdataDocument
 361                   )
 362
 363 instance ToSchema (NodePoly NodeId NodeTypeId
 364                             (Maybe NodeUserId)
 365                             NodeParentId NodeName
 366                             UTCTime HyperdataDocument
 367                   )
 368
 369 instance ToSchema (NodePoly NodeId NodeTypeId
 370                             (Maybe NodeUserId)
 371                             NodeParentId NodeName
 372                             UTCTime Value
 373                   )
 374
 375 instance ToSchema (NodePoly NodeId NodeTypeId
 376                             (NodeUserId)
 377                             (Maybe NodeParentId) NodeName
 378                             UTCTime Value
 379                   )
 380
 381
 382 instance ToSchema Status
 383
 384