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 Text
 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_day    :: Maybe Int
 117                                            , _hyperdataDocument_publication_hour   :: Maybe Int
 118                                            , _hyperdataDocument_publication_minute :: Maybe Int
 119                                            , _hyperdataDocument_publication_second :: Maybe Int
 120                                            , _hyperdataDocument_language_iso2      :: 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 Hyperdata a = Hyperdata { unHyperdata :: a}
 195 $(deriveJSON (unPrefix "") ''Hyperdata)
 196
 197 data HyperdataCorpus = HyperdataCorpus { hyperdataCorpus_title        :: Maybe Text
 198                                        , hyperdataCorpus_descr        :: Maybe Text
 199                                        , hyperdataCorpus_query        :: Maybe Text
 200                                        , hyperdataCorpus_authors      :: Maybe Text
 201                                        , hyperdataCorpus_resources    :: Maybe [Resource]
 202                                        } deriving (Show, Generic)
 203 $(deriveJSON (unPrefix "hyperdataCorpus_") ''HyperdataCorpus)
 204
 205
 206 data HyperdataUser = HyperdataUser { hyperdataUser_language       :: Maybe Text
 207                                        } deriving (Show, Generic)
 208 $(deriveJSON (unPrefix "hyperdataUser_") ''HyperdataUser)
 209
 210 -- Preferences ?
 211
 212 data HyperdataFolder = HyperdataFolder { hyperdataFolder_descr   :: Maybe Text
 213                                        } deriving (Show, Generic)
 214 $(deriveJSON (unPrefix "hyperdataFolder_") ''HyperdataFolder)
 215
 216
 217 data HyperdataList = HyperdataList { hyperdataList_preferences   :: Maybe Text
 218                                    } deriving (Show, Generic)
 219 $(deriveJSON (unPrefix "hyperdataList_") ''HyperdataList)
 220
 221 data HyperdataScore = HyperdataScore { hyperdataScore_preferences   :: Maybe Text
 222                                    } deriving (Show, Generic)
 223 $(deriveJSON (unPrefix "hyperdataScore_") ''HyperdataScore)
 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 NodeFolder   = Node HyperdataFolder
 270 type NodeCorpus   = Node HyperdataCorpus
 271 type NodeCorpusV3 = Node HyperdataCorpus
 272 type NodeDocument = Node HyperdataDocument
 273
 274 ------------------------------------------------------------------------
 275 data NodeType = NodeUser
 276               | NodeFolder
 277               | NodeCorpus     | NodeCorpusV3 | NodeDocument
 278               | NodeAnnuaire   | NodeContact
 279               | NodeOccurrences
 280               | NodeGraph
 281               | NodeDashboard  | NodeChart
 282               -- | Classification
 283               -- | Lists
 284               -- | Metrics
 285               deriving (Show, Read, Eq, Generic, Bounded, Enum)
 286
 287 allNodeTypes :: [NodeType]
 288 allNodeTypes = [minBound ..]
 289
 290 instance FromJSON NodeType
 291 instance ToJSON NodeType
 292
 293 instance FromHttpApiData NodeType
 294   where
 295       parseUrlPiece = Right . read . unpack
 296
 297 instance ToParamSchema NodeType
 298 instance ToSchema      NodeType
 299
 300 ------------------------------------------------------------------------
 301 data NodePoly id typename userId parentId name date hyperdata = Node { node_id        :: id
 302                                                                      , node_typename  :: typename
 303                                                                      , node_userId    :: userId
 304                                                                 --   , nodeHashId    :: hashId
 305                                                                      , node_parentId  :: parentId
 306                                                                      , node_name      :: name
 307                                                                      , node_date      :: date
 308                                                                      , node_hyperdata :: hyperdata
 309                                                               --       , node_titleAbstract :: titleAbstract
 310                                                                      } deriving (Show, Generic)
 311 $(deriveJSON (unPrefix "node_") ''NodePoly)
 312
 313
 314
 315
 316 instance Arbitrary (NodePoly NodeId NodeTypeId (Maybe NodeUserId) NodeParentId NodeName UTCTime Value) where
 317     arbitrary = elements [Node 1 1 (Just 1) 1 "name" (jour 2018 01 01) (Object mempty)]
 318
 319
 320 instance Arbitrary (NodePoly NodeId NodeTypeId NodeUserId (Maybe NodeParentId) NodeName UTCTime Value) where
 321     arbitrary = elements [Node 1 1 1 (Just 1) "name" (jour 2018 01 01) (Object mempty)]
 322
 323 instance Arbitrary (NodePoly NodeId NodeTypeId (Maybe NodeUserId) NodeParentId NodeName UTCTime HyperdataDocument) where
 324     arbitrary = elements [Node 1 1 (Just 1) 1 "name" (jour 2018 01 01) ((hyperdataDocument))]
 325
 326
 327 instance Arbitrary (NodePoly NodeId NodeTypeId NodeUserId (Maybe NodeParentId) NodeName UTCTime HyperdataDocument) where
 328     arbitrary = elements [Node 1 1 1 (Just 1) "name" (jour 2018 01 01) hyperdataDocument]
 329
 330
 331 ------------------------------------------------------------------------
 332 hyperdataDocument :: HyperdataDocument
 333 hyperdataDocument = case decode docExample of
 334                       Just hp -> hp
 335                       Nothing -> HyperdataDocument Nothing Nothing Nothing Nothing
 336                                                    Nothing Nothing Nothing Nothing
 337                                                    Nothing Nothing Nothing Nothing
 338                                                    Nothing Nothing Nothing Nothing
 339                                                    Nothing
 340 docExample :: ByteString
 341 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}"
 342
 343
 344 instance ToSchema HyperdataDocument where
 345   declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
 346     L.& mapped.schema.description ?~ "a document"
 347     L.& mapped.schema.example ?~ toJSON hyperdataDocument
 348
 349
 350 instance ToSchema Value where
 351   declareNamedSchema proxy = genericDeclareNamedSchemaUnrestricted defaultSchemaOptions proxy
 352     L.& mapped.schema.description ?~ "a document"
 353     L.& mapped.schema.example ?~ toJSON ("" :: Text) -- TODO
 354
 355
 356 instance ToSchema (NodePoly NodeId NodeTypeId NodeUserId
 357                             (Maybe NodeParentId) NodeName
 358                             UTCTime HyperdataDocument
 359                   )
 360
 361 instance ToSchema (NodePoly NodeId NodeTypeId
 362                             (Maybe NodeUserId)
 363                             NodeParentId NodeName
 364                             UTCTime HyperdataDocument
 365                   )
 366
 367 instance ToSchema (NodePoly NodeId NodeTypeId
 368                             (Maybe NodeUserId)
 369                             NodeParentId NodeName
 370                             UTCTime Value
 371                   )
 372
 373 instance ToSchema (NodePoly NodeId NodeTypeId
 374                             (NodeUserId)
 375                             (Maybe NodeParentId) NodeName
 376                             UTCTime Value
 377                   )
 378
 379
 380 instance ToSchema Status
 381
 382