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