src/Gargantext/Types/Node.hs

   1 {-|
   2 Module      : Gargantext.Types.Nodes
   3 Description : Main Types of Nodes
   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 {-# LANGUAGE DeriveGeneric        #-}
  14 {-# LANGUAGE TemplateHaskell      #-}
  15 {-# LANGUAGE OverloadedStrings    #-}
  16 {-# LANGUAGE FlexibleInstances    #-}
  17 -- {-# LANGUAGE DuplicateRecordFields #-}
  18
  19 module Gargantext.Types.Node where
  20
  21 import Prelude (Enum, Bounded, minBound, maxBound)
  22
  23 import GHC.Generics (Generic)
  24
  25 import           Control.Lens hiding (elements)
  26 import qualified Control.Lens   as L
  27 import           Control.Applicative ((<*>))
  28
  29 import           Data.Aeson
  30 import           Data.Aeson (Value(),toJSON)
  31 import           Data.Aeson.TH (deriveJSON)
  32 import           Data.ByteString.Lazy (ByteString)
  33 import           Data.Either
  34 import           Data.Eq (Eq)
  35 import           Data.Text (Text, unpack)
  36 import           Data.Time (UTCTime)
  37 import           Data.Time.Segment (jour, timesAfter, Granularity(D))
  38 import           Data.Swagger
  39
  40 import           Text.Read (read)
  41 import           Text.Show (Show())
  42
  43 import           Servant
  44
  45 import           Test.QuickCheck.Arbitrary
  46 import           Test.QuickCheck (elements)
  47
  48 import           Gargantext.Prelude
  49 import           Gargantext.Utils.Prefix (unPrefix)
  50
  51 ------------------------------------------------------------------------
  52
  53 type UTCTime' = UTCTime
  54
  55 instance Arbitrary UTCTime' where
  56     arbitrary = elements $ timesAfter 100 D (jour 2000 01 01)
  57
  58
  59
  60 ------------------------------------------------------------------------
  61 data Status  = Status { status_failed    :: Int
  62                       , status_succeeded :: Int
  63                       , status_remaining :: Int
  64                       } deriving (Show, Generic)
  65 $(deriveJSON (unPrefix "status_") ''Status)
  66
  67 instance Arbitrary Status where
  68   arbitrary = Status <$> arbitrary <*> arbitrary <*> arbitrary
  69
  70 ------------------------------------------------------------------------
  71 data HyperdataDocument = HyperdataDocument { hyperdataDocument_bdd                :: Maybe Text
  72                                            , hyperdataDocument_doi                :: Maybe Text
  73                                            , hyperdataDocument_url                :: Maybe Text
  74                                            , hyperdataDocument_page               :: Maybe Int
  75                                            , hyperdataDocument_title              :: Maybe Text
  76                                            , hyperdataDocument_authors            :: Maybe Text
  77                                            , hyperdataDocument_source             :: Maybe Text
  78                                            , hyperdataDocument_abstract           :: Maybe Text
  79                                            , hyperdataDocument_statuses           :: Maybe [Status]
  80                                            , hyperdataDocument_publication_date   :: Maybe Text
  81                                            , hyperdataDocument_publication_year   :: Maybe Int
  82                                            , hyperdataDocument_publication_month  :: Maybe Int
  83                                            , hyperdataDocument_publication_hour   :: Maybe Int
  84                                            , hyperdataDocument_publication_minute :: Maybe Int
  85                                            , hyperdataDocument_publication_second :: Maybe Int
  86                                            , hyperdataDocument_languageIso2       :: Maybe Text
  87                                            } deriving (Show, Generic)
  88 $(deriveJSON (unPrefix "hyperdataDocument_") ''HyperdataDocument)
  89
  90 toHyperdataDocuments :: [(Text, Text)] -> [HyperdataDocument]
  91 toHyperdataDocuments ts = map (\(t1,t2) -> HyperdataDocument Nothing Nothing Nothing Nothing (Just t1)
  92                                            Nothing (Just t2) Nothing Nothing Nothing
  93                                            Nothing Nothing Nothing Nothing Nothing Nothing
  94                                            ) ts
  95
  96 hyperdataDocuments :: [HyperdataDocument]
  97 hyperdataDocuments = toHyperdataDocuments [ ("AI is big but less than crypto", "Troll System journal")
  98                                           , ("Crypto is big but less than AI", "System Troll review" )
  99                                           , ("Science is magic"              , "Closed Source review")
 100                                           , ("Open science for all"          , "No Time"             )
 101                                           , ("Closed science for me"         , "No Space"            )
 102                                           ]
 103
 104
 105 instance Arbitrary HyperdataDocument where
 106     arbitrary = elements hyperdataDocuments
 107
 108 ------------------------------------------------------------------------
 109 data LanguageNodes = LanguageNodes { languageNodes___unknown__ :: [Int]}
 110     deriving (Show, Generic)
 111 $(deriveJSON (unPrefix "languageNodes_") ''LanguageNodes)
 112
 113 ------------------------------------------------------------------------
 114 -- level: debug | dev  (fatal = critical)
 115 data EventLevel = CRITICAL | FATAL | ERROR | WARNING | INFO | DEBUG
 116   deriving (Show, Generic, Enum, Bounded)
 117
 118 instance FromJSON EventLevel
 119 instance ToJSON EventLevel
 120
 121 instance Arbitrary EventLevel where
 122   arbitrary = elements [minBound..maxBound]
 123
 124 ------------------------------------------------------------------------
 125
 126 data Event = Event { event_level   :: EventLevel
 127                    , event_message :: Text
 128                    , event_date    :: UTCTime
 129             } deriving (Show, Generic)
 130 $(deriveJSON (unPrefix "event_") ''Event)
 131
 132 instance Arbitrary Event where
 133   arbitrary = Event <$> arbitrary <*> arbitrary <*> arbitrary
 134
 135 ------------------------------------------------------------------------
 136
 137 type Text' = Text
 138
 139 instance Arbitrary Text' where
 140   arbitrary = elements ["ici", "la"]
 141
 142 data Resource = Resource { resource_path    :: Maybe Text
 143                          , resource_scraper :: Maybe Text
 144                          , resource_query   :: Maybe Text
 145                          , resource_events  :: [Event]
 146                          , resource_status  :: Status
 147                          , resource_date    :: UTCTime'
 148                          } deriving (Show, Generic)
 149 $(deriveJSON (unPrefix "resource_") ''Resource)
 150
 151 instance Arbitrary Resource where
 152     arbitrary = Resource <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
 153
 154 ------------------------------------------------------------------------
 155
 156 data HyperdataCorpus = HyperdataCorpus { hyperdataCorpus_resources    :: [Resource]
 157                                        } deriving (Show, Generic)
 158 $(deriveJSON (unPrefix "hyperdataCorpus_") ''HyperdataCorpus)
 159
 160
 161 data HyperdataUser = HyperdataUser { hyperdataUser_language       :: Maybe Text
 162                                        } deriving (Show, Generic)
 163 $(deriveJSON (unPrefix "hyperdataUser_") ''HyperdataUser)
 164
 165 -- Preferences ?
 166
 167 data HyperdataFolder = HyperdataFolder { hyperdataFolder_preferences   :: Maybe Text
 168                                        } deriving (Show, Generic)
 169 $(deriveJSON (unPrefix "hyperdataFolder_") ''HyperdataFolder)
 170
 171
 172 data HyperdataProject = HyperdataProject { hyperdataProject_preferences   :: Maybe Text
 173                                        } deriving (Show, Generic)
 174 $(deriveJSON (unPrefix "hyperdataProject_") ''HyperdataProject)
 175
 176
 177
 178 data HyperdataList = HyperdataList { hyperdataList_preferences   :: Maybe Text
 179                                    } deriving (Show, Generic)
 180 $(deriveJSON (unPrefix "hyperdataList_") ''HyperdataList)
 181
 182 data HyperdataScore = HyperdataScore { hyperdataScore_preferences   :: Maybe Text
 183                                    } deriving (Show, Generic)
 184 $(deriveJSON (unPrefix "hyperdataScore_") ''HyperdataScore)
 185
 186
 187
 188 data HyperdataFavorites = HyperdataFavorites { hyperdataFavorites_preferences   :: Maybe Text
 189                                    } deriving (Show, Generic)
 190 $(deriveJSON (unPrefix "hyperdataFavorites_") ''HyperdataFavorites)
 191
 192 data HyperdataResource = HyperdataResource { hyperdataResource_preferences   :: Maybe Text
 193                                    } deriving (Show, Generic)
 194 $(deriveJSON (unPrefix "hyperdataResource_") ''HyperdataResource)
 195
 196
 197
 198 -- TODO add the Graph Structure here
 199 data HyperdataGraph = HyperdataGraph { hyperdataGraph_preferences   :: Maybe Text
 200                                    } deriving (Show, Generic)
 201 $(deriveJSON (unPrefix "hyperdataGraph_") ''HyperdataGraph)
 202
 203
 204 -- TODO add the Graph Structure here
 205 data HyperdataPhylo = HyperdataPhylo { hyperdataPhylo_preferences   :: Maybe Text
 206                                    } deriving (Show, Generic)
 207 $(deriveJSON (unPrefix "hyperdataPhylo_") ''HyperdataPhylo)
 208
 209 -- | TODO FEATURE: Notebook saved in the node (to work with Python or Haskell)
 210 data HyperdataNotebook = HyperdataNotebook { hyperdataNotebook_preferences   :: Maybe Text
 211                                    } deriving (Show, Generic)
 212 $(deriveJSON (unPrefix "hyperdataNotebook_") ''HyperdataNotebook)
 213
 214
 215
 216 -- | NodePoly indicates that Node has a Polymorphism Type
 217 type Node json   = NodePoly NodeId NodeTypeId NodeUserId (Maybe NodeParentId) NodeName UTCTime json -- NodeVector
 218
 219 -- type Node json   = NodePoly NodeId NodeTypeId UserId ParentId NodeName UTCTime json
 220 type NodeTypeId   = Int
 221 type NodeId       = Int
 222 type NodeParentId = Int
 223 type NodeUserId   = Int
 224 type NodeName     = Text
 225 --type NodeVector   = Vector
 226
 227 --type NodeUser    = Node HyperdataUser
 228
 229 -- | Then a Node can be either a Folder or a Corpus or a Document
 230 type NodeUser = Node HyperdataUser
 231 type Folder   = Node HyperdataFolder
 232 type Project  = Folder -- NP Node HyperdataProject ?
 233 type Corpus   = Node HyperdataCorpus
 234 type Document = Node HyperdataDocument
 235
 236 ------------------------------------------------------------------------
 237 data NodeType = NodeUser | Project | Corpus | Document | DocumentCopy
 238               | Classification
 239               | Lists
 240               | Metrics | Occurrences
 241               deriving (Show, Read, Eq, Generic)
 242
 243 instance FromJSON NodeType
 244 instance ToJSON NodeType
 245
 246 instance FromHttpApiData NodeType
 247   where
 248       parseUrlPiece = Right . read . unpack
 249
 250 instance ToParamSchema NodeType
 251 instance ToSchema      NodeType
 252
 253 ------------------------------------------------------------------------
 254 data NodePoly id typename userId parentId name date hyperdata = Node { node_id        :: id
 255                                                                      , node_typename  :: typename
 256                                                                      , node_userId    :: userId
 257                                                                 --   , nodeHashId    :: hashId
 258                                                                      , node_parentId  :: parentId
 259                                                                      , node_name      :: name
 260                                                                      , node_date      :: date
 261                                                                      , node_hyperdata :: hyperdata
 262                                                               --       , node_titleAbstract :: titleAbstract
 263                                                                      } deriving (Show, Generic)
 264 $(deriveJSON (unPrefix "node_") ''NodePoly)
 265
 266 instance Arbitrary (NodePoly NodeId NodeTypeId (Maybe NodeUserId) NodeParentId NodeName UTCTime Value) where
 267     arbitrary = elements [Node 1 1 (Just 1) 1 "name" (jour 2018 01 01) (toJSON ("{}"::Text))]
 268
 269
 270 instance Arbitrary (NodePoly NodeId NodeTypeId NodeUserId (Maybe NodeParentId) NodeName UTCTime Value) where
 271     arbitrary = elements [Node 1 1 1 (Just 1) "name" (jour 2018 01 01) (toJSON ("{}"::Text))]
 272
 273 instance Arbitrary (NodePoly NodeId NodeTypeId (Maybe NodeUserId) NodeParentId NodeName UTCTime HyperdataDocument) where
 274     arbitrary = elements [Node 1 1 (Just 1) 1 "name" (jour 2018 01 01) ((hyperdataDocument))]
 275
 276
 277 instance Arbitrary (NodePoly NodeId NodeTypeId NodeUserId (Maybe NodeParentId) NodeName UTCTime HyperdataDocument) where
 278     arbitrary = elements [Node 1 1 1 (Just 1) "name" (jour 2018 01 01) hyperdataDocument]
 279
 280
 281 ------------------------------------------------------------------------
 282 hyperdataDocument :: HyperdataDocument
 283 hyperdataDocument = case decode docExample of
 284                       Just hp -> hp
 285                       Nothing -> HyperdataDocument Nothing Nothing Nothing Nothing
 286                                                    Nothing Nothing Nothing Nothing
 287                                                    Nothing Nothing Nothing Nothing
 288                                                    Nothing Nothing Nothing Nothing
 289 docExample :: ByteString
 290 docExample = "{\"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\",\"statuses\":[],\"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}"
 291
 292
 293 instance ToSchema HyperdataDocument where
 294   declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
 295     L.& mapped.schema.description ?~ "a document"
 296     L.& mapped.schema.example ?~ toJSON hyperdataDocument
 297
 298
 299 instance ToSchema (NodePoly NodeId NodeTypeId NodeUserId
 300                             (Maybe NodeParentId) NodeName
 301                             UTCTime HyperdataDocument
 302                   )
 303
 304 instance ToSchema (NodePoly NodeId NodeTypeId
 305                             (Maybe NodeUserId)
 306                             NodeParentId NodeName
 307                             UTCTime HyperdataDocument
 308                   )
 309
 310 instance ToSchema Status
 311
 312