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