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 | Folder
 279               | NodeCorpus | Annuaire
 280               | Document | Individu
 281               | UserPage | Favorites
 282               | Graph    | Dashboard | Chart
 283               | Classification
 284               | Lists
 285               | Metrics    | Occurrences
 286               deriving (Show, Read, Eq, Generic)
 287
 288 instance FromJSON NodeType
 289 instance ToJSON NodeType
 290
 291 instance FromHttpApiData NodeType
 292   where
 293       parseUrlPiece = Right . read . unpack
 294
 295 instance ToParamSchema NodeType
 296 instance ToSchema      NodeType
 297
 298 ------------------------------------------------------------------------
 299 data NodePoly id typename userId parentId name date hyperdata = Node { node_id        :: id
 300                                                                      , node_typename  :: typename
 301                                                                      , node_userId    :: userId
 302                                                                 --   , nodeHashId    :: hashId
 303                                                                      , node_parentId  :: parentId
 304                                                                      , node_name      :: name
 305                                                                      , node_date      :: date
 306                                                                      , node_hyperdata :: hyperdata
 307                                                               --       , node_titleAbstract :: titleAbstract
 308                                                                      } deriving (Show, Generic)
 309 $(deriveJSON (unPrefix "node_") ''NodePoly)
 310
 311
 312
 313
 314 instance Arbitrary (NodePoly NodeId NodeTypeId (Maybe NodeUserId) NodeParentId NodeName UTCTime Value) where
 315     arbitrary = elements [Node 1 1 (Just 1) 1 "name" (jour 2018 01 01) (Object mempty)]
 316
 317
 318 instance Arbitrary (NodePoly NodeId NodeTypeId NodeUserId (Maybe NodeParentId) NodeName UTCTime Value) where
 319     arbitrary = elements [Node 1 1 1 (Just 1) "name" (jour 2018 01 01) (Object mempty)]
 320
 321 instance Arbitrary (NodePoly NodeId NodeTypeId (Maybe NodeUserId) NodeParentId NodeName UTCTime HyperdataDocument) where
 322     arbitrary = elements [Node 1 1 (Just 1) 1 "name" (jour 2018 01 01) ((hyperdataDocument))]
 323
 324
 325 instance Arbitrary (NodePoly NodeId NodeTypeId NodeUserId (Maybe NodeParentId) NodeName UTCTime HyperdataDocument) where
 326     arbitrary = elements [Node 1 1 1 (Just 1) "name" (jour 2018 01 01) hyperdataDocument]
 327
 328
 329 ------------------------------------------------------------------------
 330 hyperdataDocument :: HyperdataDocument
 331 hyperdataDocument = case decode docExample of
 332                       Just hp -> hp
 333                       Nothing -> HyperdataDocument Nothing Nothing Nothing Nothing
 334                                                    Nothing Nothing Nothing Nothing
 335                                                    Nothing Nothing Nothing Nothing
 336                                                    Nothing Nothing Nothing Nothing
 337                                                    Nothing
 338 docExample :: ByteString
 339 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}"
 340
 341
 342 instance ToSchema HyperdataDocument where
 343   declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
 344     L.& mapped.schema.description ?~ "a document"
 345     L.& mapped.schema.example ?~ toJSON hyperdataDocument
 346
 347
 348 instance ToSchema Value where
 349   declareNamedSchema proxy = genericDeclareNamedSchemaUnrestricted defaultSchemaOptions proxy
 350     L.& mapped.schema.description ?~ "a document"
 351     L.& mapped.schema.example ?~ toJSON ("" :: Text) -- TODO
 352
 353
 354 instance ToSchema (NodePoly NodeId NodeTypeId NodeUserId
 355                             (Maybe NodeParentId) NodeName
 356                             UTCTime HyperdataDocument
 357                   )
 358
 359 instance ToSchema (NodePoly NodeId NodeTypeId
 360                             (Maybe NodeUserId)
 361                             NodeParentId NodeName
 362                             UTCTime HyperdataDocument
 363                   )
 364
 365 instance ToSchema (NodePoly NodeId NodeTypeId
 366                             (Maybe NodeUserId)
 367                             NodeParentId NodeName
 368                             UTCTime Value
 369                   )
 370
 371 instance ToSchema (NodePoly NodeId NodeTypeId
 372                             (NodeUserId)
 373                             (Maybe NodeParentId) NodeName
 374                             UTCTime Value
 375                   )
 376
 377
 378 instance ToSchema Status
 379
 380