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