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 data HyperdataDocument = HyperdataDocument { _hyperdataDocument_bdd                :: Maybe Text
 103                                            , _hyperdataDocument_doi                :: Maybe Text
 104                                            , _hyperdataDocument_url                :: Maybe Text
 105                                            , _hyperdataDocument_uniqId             :: Maybe Text
 106                                            , _hyperdataDocument_page               :: Maybe Int
 107                                            , _hyperdataDocument_title              :: Maybe Text
 108                                            , _hyperdataDocument_authors            :: Maybe Text
 109                                            , _hyperdataDocument_source             :: Maybe Text
 110                                            , _hyperdataDocument_abstract           :: Maybe Text
 111                                            , _hyperdataDocument_publication_date   :: Maybe Text
 112                                            , _hyperdataDocument_publication_year   :: Maybe Int
 113                                            , _hyperdataDocument_publication_month  :: Maybe Int
 114                                            , _hyperdataDocument_publication_day    :: Maybe Int
 115                                            , _hyperdataDocument_publication_hour   :: Maybe Int
 116                                            , _hyperdataDocument_publication_minute :: Maybe Int
 117                                            , _hyperdataDocument_publication_second :: Maybe Int
 118                                            , _hyperdataDocument_language_iso2      :: Maybe Text
 119                                            } deriving (Show, Generic)
 120 $(deriveJSON (unPrefix "_hyperdataDocument_") ''HyperdataDocument)
 121 $(makeLenses ''HyperdataDocument)
 122
 123 instance ToField HyperdataDocument where
 124   toField = toJSONField
 125
 126 toHyperdataDocuments :: [(Text, Text)] -> [HyperdataDocument]
 127 toHyperdataDocuments ts = map (\(t1,t2) -> HyperdataDocument Nothing Nothing Nothing Nothing Nothing (Just t1)
 128                                            Nothing (Just t2) Nothing Nothing Nothing
 129                                            Nothing Nothing Nothing Nothing Nothing Nothing
 130                                            ) ts
 131
 132 hyperdataDocuments :: [HyperdataDocument]
 133 hyperdataDocuments = toHyperdataDocuments [ ("AI is big but less than crypto", "Troll System journal")
 134                                           , ("Crypto is big but less than AI", "System Troll review" )
 135                                           , ("Science is magic"              , "Closed Source review")
 136                                           , ("Open science for all"          , "No Time"             )
 137                                           , ("Closed science for me"         , "No Space"            )
 138                                           ]
 139
 140
 141 instance Arbitrary HyperdataDocument where
 142     arbitrary = elements hyperdataDocuments
 143
 144 ------------------------------------------------------------------------
 145 data LanguageNodes = LanguageNodes { languageNodes___unknown__ :: [Int]}
 146     deriving (Show, Generic)
 147 $(deriveJSON (unPrefix "languageNodes_") ''LanguageNodes)
 148
 149 ------------------------------------------------------------------------
 150 -- level: debug | dev  (fatal = critical)
 151 data EventLevel = CRITICAL | FATAL | ERROR | WARNING | INFO | DEBUG
 152   deriving (Show, Generic, Enum, Bounded)
 153
 154 instance FromJSON EventLevel
 155 instance ToJSON EventLevel
 156
 157 instance Arbitrary EventLevel where
 158   arbitrary = elements [minBound..maxBound]
 159
 160 ------------------------------------------------------------------------
 161
 162 data Event = Event { event_level   :: EventLevel
 163                    , event_message :: Text
 164                    , event_date    :: UTCTime
 165             } deriving (Show, Generic)
 166 $(deriveJSON (unPrefix "event_") ''Event)
 167
 168 instance Arbitrary Event where
 169   arbitrary = Event <$> arbitrary <*> arbitrary <*> arbitrary
 170
 171 ------------------------------------------------------------------------
 172
 173 type Text' = Text
 174
 175 instance Arbitrary Text' where
 176   arbitrary = elements ["ici", "la"]
 177
 178 data Resource = Resource { resource_path    :: Maybe Text
 179                          , resource_scraper :: Maybe Text
 180                          , resource_query   :: Maybe Text
 181                          , resource_events  :: [Event]
 182                          , resource_status  :: Status
 183                          , resource_date    :: UTCTime'
 184                          } deriving (Show, Generic)
 185 $(deriveJSON (unPrefix "resource_") ''Resource)
 186
 187 instance Arbitrary Resource where
 188     arbitrary = Resource <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
 189
 190 ------------------------------------------------------------------------
 191
 192 data Hyperdata a = Hyperdata { unHyperdata :: a}
 193 $(deriveJSON (unPrefix "") ''Hyperdata)
 194
 195 data HyperdataUser = HyperdataUser { hyperdataUser_language       :: Maybe Text
 196                                        } deriving (Show, Generic)
 197 $(deriveJSON (unPrefix "hyperdataUser_") ''HyperdataUser)
 198
 199
 200 data HyperdataFolder = HyperdataFolder { hyperdataFolder_descr   :: Maybe Text
 201                                        } deriving (Show, Generic)
 202 $(deriveJSON (unPrefix "hyperdataFolder_") ''HyperdataFolder)
 203
 204
 205 data HyperdataCorpus = HyperdataCorpus { hyperdataCorpus_title        :: Maybe Text
 206                                        , hyperdataCorpus_descr        :: Maybe Text
 207                                        , hyperdataCorpus_query        :: Maybe Text
 208                                        , hyperdataCorpus_authors      :: Maybe Text
 209                                        , hyperdataCorpus_resources    :: Maybe [Resource]
 210                                        } deriving (Show, Generic)
 211 $(deriveJSON (unPrefix "hyperdataCorpus_") ''HyperdataCorpus)
 212
 213 ------------------------------------------------------------------------
 214 data HyperdataAnnuaire = HyperdataAnnuaire { hyperdataAnnuaire_title        :: Maybe Text
 215                                            , hyperdataAnnuaire_descr        :: Maybe Text
 216                                            } deriving (Show, Generic)
 217 $(deriveJSON (unPrefix "hyperdataAnnuaire_") ''HyperdataAnnuaire)
 218 ------------------------------------------------------------------------
 219 data HyperdataContact = HyperdataContact { hyperdataContact_name        :: Maybe Text
 220                                          , hyperdataContact_mail        :: Maybe Text
 221                                          } deriving (Show, Generic)
 222 $(deriveJSON (unPrefix "hyperdataContact_") ''HyperdataContact)
 223 ------------------------------------------------------------------------
 224
 225 data HyperdataList = HyperdataList { hyperdataList_preferences   :: Maybe Text
 226                                    } deriving (Show, Generic)
 227 $(deriveJSON (unPrefix "hyperdataList_") ''HyperdataList)
 228
 229 data HyperdataScore = HyperdataScore { hyperdataScore_preferences   :: Maybe Text
 230                                    } deriving (Show, Generic)
 231 $(deriveJSON (unPrefix "hyperdataScore_") ''HyperdataScore)
 232
 233
 234 data HyperdataResource = HyperdataResource { hyperdataResource_preferences   :: Maybe Text
 235                                    } deriving (Show, Generic)
 236 $(deriveJSON (unPrefix "hyperdataResource_") ''HyperdataResource)
 237
 238
 239
 240 -- TODO add the Graph Structure here
 241 data HyperdataGraph = HyperdataGraph { hyperdataGraph_preferences   :: Maybe Text
 242                                    } deriving (Show, Generic)
 243 $(deriveJSON (unPrefix "hyperdataGraph_") ''HyperdataGraph)
 244
 245
 246 -- TODO add the Graph Structure here
 247 data HyperdataPhylo = HyperdataPhylo { hyperdataPhylo_preferences   :: Maybe Text
 248                                    } deriving (Show, Generic)
 249 $(deriveJSON (unPrefix "hyperdataPhylo_") ''HyperdataPhylo)
 250
 251 -- | TODO FEATURE: Notebook saved in the node (to work with Python or Haskell)
 252 data HyperdataNotebook = HyperdataNotebook { hyperdataNotebook_preferences   :: Maybe Text
 253                                    } deriving (Show, Generic)
 254 $(deriveJSON (unPrefix "hyperdataNotebook_") ''HyperdataNotebook)
 255
 256
 257
 258 -- | NodePoly indicates that Node has a Polymorphism Type
 259 type Node json   = NodePoly NodeId NodeTypeId NodeUserId (Maybe NodeParentId) NodeName UTCTime json -- NodeVector
 260
 261 -- type Node json   = NodePoly NodeId NodeTypeId UserId ParentId NodeName UTCTime json
 262 type NodeTypeId   = Int
 263 type NodeId       = Int
 264 type NodeParentId = Int
 265 type NodeUserId   = Int
 266 type NodeName     = Text
 267 --type NodeVector   = Vector
 268
 269 --type NodeUser    = Node HyperdataUser
 270
 271 -- | Then a Node can be either a Folder or a Corpus or a Document
 272 type NodeUser     = Node HyperdataUser
 273 type NodeFolder   = Node HyperdataFolder
 274
 275 type NodeCorpus   = Node HyperdataCorpus
 276 type NodeCorpusV3 = Node HyperdataCorpus
 277 type NodeDocument = Node HyperdataDocument
 278
 279 type NodeAnnuaire = Node HyperdataAnnuaire
 280 type NodeContact  = Node HyperdataContact
 281
 282 ---- | Then a Node can be either a Graph or a Phylo or a Notebook
 283 type NodeGraph    = Node HyperdataGraph
 284 type NodePhylo    = Node HyperdataPhylo
 285 type NodeNotebook = Node HyperdataNotebook
 286
 287 ------------------------------------------------------------------------
 288 data NodeType = NodeUser
 289               | NodeFolder
 290               | NodeCorpus     | NodeCorpusV3 | NodeDocument
 291               | NodeAnnuaire   | NodeContact
 292               -- | NodeOccurrences
 293               | NodeGraph
 294               | NodeDashboard  | NodeChart
 295               -- | Classification
 296               -- | Lists
 297               -- | Metrics
 298               deriving (Show, Read, Eq, Generic, Bounded, Enum)
 299
 300 allNodeTypes :: [NodeType]
 301 allNodeTypes = [minBound ..]
 302
 303 instance FromJSON NodeType
 304 instance ToJSON NodeType
 305
 306 instance FromHttpApiData NodeType
 307   where
 308       parseUrlPiece = Right . read . unpack
 309
 310 instance ToParamSchema NodeType
 311 instance ToSchema      NodeType
 312
 313 ------------------------------------------------------------------------
 314 data NodePoly id typename userId parentId name date hyperdata = Node { _node_id        :: id
 315                                                                      , _node_typename  :: typename
 316                                                                      , _node_userId    :: userId
 317                                                                 --   , nodeUniqId    :: hashId
 318                                                                      , _node_parentId  :: parentId
 319                                                                      , _node_name      :: name
 320                                                                      , _node_date      :: date
 321                                                                      , _node_hyperdata :: hyperdata
 322                                                                      } deriving (Show, Generic)
 323 $(deriveJSON (unPrefix "_node_") ''NodePoly)
 324 $(makeLenses ''NodePoly)
 325
 326
 327
 328 instance Arbitrary (NodePoly NodeId NodeTypeId (Maybe NodeUserId) NodeParentId NodeName UTCTime Value) where
 329     arbitrary = elements [Node 1 1 (Just 1) 1 "name" (jour 2018 01 01) (Object mempty)]
 330
 331
 332 instance Arbitrary (NodePoly NodeId NodeTypeId NodeUserId (Maybe NodeParentId) NodeName UTCTime Value) where
 333     arbitrary = elements [Node 1 1 1 (Just 1) "name" (jour 2018 01 01) (Object mempty)]
 334
 335 instance Arbitrary (NodePoly NodeId NodeTypeId (Maybe NodeUserId) NodeParentId NodeName UTCTime HyperdataDocument) where
 336     arbitrary = elements [Node 1 1 (Just 1) 1 "name" (jour 2018 01 01) ((hyperdataDocument))]
 337
 338
 339 instance Arbitrary (NodePoly NodeId NodeTypeId NodeUserId (Maybe NodeParentId) NodeName UTCTime HyperdataDocument) where
 340     arbitrary = elements [Node 1 1 1 (Just 1) "name" (jour 2018 01 01) hyperdataDocument]
 341
 342
 343 ------------------------------------------------------------------------
 344 hyperdataDocument :: HyperdataDocument
 345 hyperdataDocument = case decode docExample of
 346                       Just hp -> hp
 347                       Nothing -> HyperdataDocument Nothing Nothing Nothing Nothing
 348                                                    Nothing Nothing Nothing Nothing
 349                                                    Nothing Nothing Nothing Nothing
 350                                                    Nothing Nothing Nothing Nothing
 351                                                    Nothing
 352 docExample :: ByteString
 353 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}"
 354
 355
 356 instance ToSchema HyperdataDocument where
 357   declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
 358     L.& mapped.schema.description ?~ "a document"
 359     L.& mapped.schema.example ?~ toJSON hyperdataDocument
 360
 361
 362 instance ToSchema Value where
 363   declareNamedSchema proxy = genericDeclareNamedSchemaUnrestricted defaultSchemaOptions proxy
 364     L.& mapped.schema.description ?~ "a document"
 365     L.& mapped.schema.example ?~ toJSON ("" :: Text) -- TODO
 366
 367
 368 instance ToSchema (NodePoly NodeId NodeTypeId NodeUserId
 369                             (Maybe NodeParentId) NodeName
 370                             UTCTime HyperdataDocument
 371                   )
 372
 373 instance ToSchema (NodePoly NodeId NodeTypeId
 374                             (Maybe NodeUserId)
 375                             NodeParentId NodeName
 376                             UTCTime HyperdataDocument
 377                   )
 378
 379 instance ToSchema (NodePoly NodeId NodeTypeId
 380                             (Maybe NodeUserId)
 381                             NodeParentId NodeName
 382                             UTCTime Value
 383                   )
 384
 385 instance ToSchema (NodePoly NodeId NodeTypeId
 386                             (NodeUserId)
 387                             (Maybe NodeParentId) NodeName
 388                             UTCTime Value
 389                   )
 390
 391
 392 instance ToSchema Status
 393
 394