]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/Database/Types/Node.hs
[TSVector] added for full text queries.
[gargantext.git] / 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 BangPatterns #-}
15 {-# LANGUAGE DeriveGeneric #-}
16 {-# LANGUAGE FlexibleInstances #-}
17 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
18 {-# LANGUAGE NoImplicitPrelude #-}
19 {-# LANGUAGE OverloadedStrings #-}
20 {-# LANGUAGE TemplateHaskell #-}
21 -- {-# LANGUAGE DuplicateRecordFields #-}
22
23 module Gargantext.Database.Types.Node
24 where
25
26 import Prelude (Enum, Bounded, minBound, maxBound)
27
28 import GHC.Generics (Generic)
29
30 import Control.Lens hiding (elements)
31 import qualified Control.Lens as L
32 import Control.Applicative ((<*>))
33
34 import Data.Aeson
35 import Data.Aeson.Types (emptyObject)
36 import Data.Aeson (Object, toJSON)
37 import Data.Aeson.TH (deriveJSON)
38 import Data.ByteString.Lazy (ByteString)
39 import Data.Either
40 import Data.Eq (Eq)
41 import Data.Monoid (mempty)
42 import Data.Text (Text, unpack)
43 import Data.Time (UTCTime)
44 import Data.Time.Segment (jour, timesAfter, Granularity(D))
45 import Data.Swagger
46
47 import Text.Read (read)
48 import Text.Show (Show())
49
50 import Database.PostgreSQL.Simple.ToField (ToField, toField, toJSONField)
51 import Servant
52
53 import Test.QuickCheck.Arbitrary
54 import Test.QuickCheck (elements)
55
56 import Gargantext.Prelude
57 import Gargantext.Core.Utils.Prefix (unPrefix)
58 ------------------------------------------------------------------------
59 type NodeId = Int
60
61 type UTCTime' = UTCTime
62
63 instance Arbitrary UTCTime' where
64 arbitrary = elements $ timesAfter 100 D (jour 2000 01 01)
65
66 ------------------------------------------------------------------------
67 data Status = Status { status_failed :: Int
68 , status_succeeded :: Int
69 , status_remaining :: Int
70 } deriving (Show, Generic)
71 $(deriveJSON (unPrefix "status_") ''Status)
72
73 instance Arbitrary Status where
74 arbitrary = Status <$> arbitrary <*> arbitrary <*> arbitrary
75
76 ------------------------------------------------------------------------
77 data StatusV3 = StatusV3 { statusV3_error :: Maybe Text
78 , statusV3_action :: Maybe Text
79 } deriving (Show, Generic)
80 $(deriveJSON (unPrefix "statusV3_") ''StatusV3)
81 ------------------------------------------------------------------------
82
83 -- Only Hyperdata types should be member of this type class.
84 class Hyperdata a
85
86 ------------------------------------------------------------------------
87 data HyperdataDocumentV3 = HyperdataDocumentV3 { hyperdataDocumentV3_publication_day :: !(Maybe Int)
88 , hyperdataDocumentV3_language_iso2 :: !(Maybe Text)
89 , hyperdataDocumentV3_publication_second :: !(Maybe Int)
90 , hyperdataDocumentV3_publication_minute :: !(Maybe Int)
91 , hyperdataDocumentV3_publication_month :: !(Maybe Int)
92 , hyperdataDocumentV3_publication_hour :: !(Maybe Int)
93 , hyperdataDocumentV3_error :: !(Maybe Text)
94 , hyperdataDocumentV3_language_iso3 :: !(Maybe Text)
95 , hyperdataDocumentV3_authors :: !(Maybe Text)
96 , hyperdataDocumentV3_publication_year :: !(Maybe Int)
97 , hyperdataDocumentV3_publication_date :: !(Maybe Text)
98 , hyperdataDocumentV3_language_name :: !(Maybe Text)
99 , hyperdataDocumentV3_statuses :: !(Maybe [StatusV3])
100 , hyperdataDocumentV3_realdate_full_ :: !(Maybe Text)
101 , hyperdataDocumentV3_source :: !(Maybe Text)
102 , hyperdataDocumentV3_abstract :: !(Maybe Text)
103 , hyperdataDocumentV3_title :: !(Maybe Text)
104 } deriving (Show, Generic)
105 $(deriveJSON (unPrefix "hyperdataDocumentV3_") ''HyperdataDocumentV3)
106
107 instance Hyperdata HyperdataDocumentV3
108 ------------------------------------------------------------------------
109
110
111 data HyperdataDocument = HyperdataDocument { _hyperdataDocument_bdd :: Maybe Text
112 , _hyperdataDocument_doi :: Maybe Text
113 , _hyperdataDocument_url :: Maybe Text
114 , _hyperdataDocument_uniqId :: Maybe Text
115 , _hyperdataDocument_uniqIdBdd :: Maybe Text
116 , _hyperdataDocument_page :: Maybe Int
117 , _hyperdataDocument_title :: Maybe Text
118 , _hyperdataDocument_authors :: Maybe Text
119 , _hyperdataDocument_institutes :: Maybe Text
120 , _hyperdataDocument_source :: Maybe Text
121 , _hyperdataDocument_abstract :: Maybe Text
122 , _hyperdataDocument_publication_date :: Maybe Text
123 , _hyperdataDocument_publication_year :: Maybe Int
124 , _hyperdataDocument_publication_month :: Maybe Int
125 , _hyperdataDocument_publication_day :: Maybe Int
126 , _hyperdataDocument_publication_hour :: Maybe Int
127 , _hyperdataDocument_publication_minute :: Maybe Int
128 , _hyperdataDocument_publication_second :: Maybe Int
129 , _hyperdataDocument_language_iso2 :: Maybe Text
130 } deriving (Show, Generic)
131 $(deriveJSON (unPrefix "_hyperdataDocument_") ''HyperdataDocument)
132 $(makeLenses ''HyperdataDocument)
133
134 instance Hyperdata HyperdataDocument
135
136 instance ToField HyperdataDocument where
137 toField = toJSONField
138
139 toHyperdataDocuments :: [(Text, Text)] -> [HyperdataDocument]
140 toHyperdataDocuments ts = map (\(t1,t2) -> HyperdataDocument Nothing Nothing Nothing Nothing Nothing Nothing (Just t1)
141 Nothing Nothing (Just t2) Nothing Nothing Nothing Nothing Nothing
142 Nothing Nothing Nothing Nothing
143 ) ts
144
145 hyperdataDocuments :: [HyperdataDocument]
146 hyperdataDocuments = toHyperdataDocuments [ ("AI is big but less than crypto", "Troll System journal")
147 , ("Crypto is big but less than AI", "System Troll review" )
148 , ("Science is magic" , "Closed Source review")
149 , ("Open science for all" , "No Time" )
150 , ("Closed science for me" , "No Space" )
151 ]
152
153
154 instance Arbitrary HyperdataDocument where
155 arbitrary = elements hyperdataDocuments
156
157 ------------------------------------------------------------------------
158 data LanguageNodes = LanguageNodes { languageNodes___unknown__ :: [Int]}
159 deriving (Show, Generic)
160 $(deriveJSON (unPrefix "languageNodes_") ''LanguageNodes)
161
162 ------------------------------------------------------------------------
163 -- level: debug | dev (fatal = critical)
164 data EventLevel = CRITICAL | FATAL | ERROR | WARNING | INFO | DEBUG
165 deriving (Show, Generic, Enum, Bounded)
166
167 instance FromJSON EventLevel
168 instance ToJSON EventLevel
169
170 instance Arbitrary EventLevel where
171 arbitrary = elements [minBound..maxBound]
172
173 instance ToSchema EventLevel where
174 declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
175
176 ------------------------------------------------------------------------
177
178 data Event = Event { event_level :: EventLevel
179 , event_message :: Text
180 , event_date :: UTCTime
181 } deriving (Show, Generic)
182 $(deriveJSON (unPrefix "event_") ''Event)
183
184 instance Arbitrary Event where
185 arbitrary = Event <$> arbitrary <*> arbitrary <*> arbitrary
186
187 instance ToSchema Event where
188 declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
189
190 ------------------------------------------------------------------------
191
192 type Text' = Text
193
194 instance Arbitrary Text' where
195 arbitrary = elements ["ici", "la"]
196
197 data Resource = Resource { resource_path :: Maybe Text
198 , resource_scraper :: Maybe Text
199 , resource_query :: Maybe Text
200 , resource_events :: [Event]
201 , resource_status :: Status
202 , resource_date :: UTCTime'
203 } deriving (Show, Generic)
204 $(deriveJSON (unPrefix "resource_") ''Resource)
205
206 instance Arbitrary Resource where
207 arbitrary = Resource <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
208
209 instance ToSchema Resource where
210 declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
211
212 ------------------------------------------------------------------------
213 data HyperdataUser = HyperdataUser { hyperdataUser_language :: Maybe Text
214 } deriving (Show, Generic)
215 $(deriveJSON (unPrefix "hyperdataUser_") ''HyperdataUser)
216
217 instance Hyperdata HyperdataUser
218 ------------------------------------------------------------------------
219 data HyperdataFolder = HyperdataFolder { hyperdataFolder_desc :: Maybe Text
220 } deriving (Show, Generic)
221 $(deriveJSON (unPrefix "hyperdataFolder_") ''HyperdataFolder)
222
223 instance Hyperdata HyperdataFolder
224 ------------------------------------------------------------------------
225 data HyperdataCorpus = HyperdataCorpus { hyperdataCorpus_title :: Maybe Text
226 , hyperdataCorpus_desc :: Maybe Text
227 , hyperdataCorpus_query :: Maybe Text
228 , hyperdataCorpus_authors :: Maybe Text
229 , hyperdataCorpus_resources :: Maybe [Resource]
230 } deriving (Show, Generic)
231 $(deriveJSON (unPrefix "hyperdataCorpus_") ''HyperdataCorpus)
232
233 instance Hyperdata HyperdataCorpus
234
235 corpusExample :: ByteString
236 corpusExample = "" -- TODO
237
238 defaultCorpus :: HyperdataCorpus
239 defaultCorpus = (HyperdataCorpus (Just "Title") (Just "Descr") (Just "Bool query") (Just "Authors") Nothing)
240
241 hyperdataCorpus :: HyperdataCorpus
242 hyperdataCorpus = case decode corpusExample of
243 Just hp -> hp
244 Nothing -> defaultCorpus
245
246 instance Arbitrary HyperdataCorpus where
247 arbitrary = pure hyperdataCorpus -- TODO
248
249 ------------------------------------------------------------------------
250 data HyperdataAnnuaire = HyperdataAnnuaire { hyperdataAnnuaire_title :: Maybe Text
251 , hyperdataAnnuaire_desc :: Maybe Text
252 } deriving (Show, Generic)
253 $(deriveJSON (unPrefix "hyperdataAnnuaire_") ''HyperdataAnnuaire)
254
255 instance Hyperdata HyperdataAnnuaire
256
257 hyperdataAnnuaire :: HyperdataAnnuaire
258 hyperdataAnnuaire = HyperdataAnnuaire (Just "Annuaire Title") (Just "Annuaire Description")
259
260 instance Arbitrary HyperdataAnnuaire where
261 arbitrary = pure hyperdataAnnuaire -- TODO
262
263 ------------------------------------------------------------------------
264 newtype HyperdataAny = HyperdataAny Object
265 deriving (Show, Generic, ToJSON, FromJSON)
266
267 instance Hyperdata HyperdataAny
268
269 instance Arbitrary HyperdataAny where
270 arbitrary = pure $ HyperdataAny mempty -- TODO produce arbitrary objects
271 ------------------------------------------------------------------------
272
273 data HyperdataList = HyperdataList { hyperdataList_preferences :: Maybe Text
274 } deriving (Show, Generic)
275 $(deriveJSON (unPrefix "hyperdataList_") ''HyperdataList)
276
277 instance Hyperdata HyperdataList
278 ------------------------------------------------------------------------
279 data HyperdataScore = HyperdataScore { hyperdataScore_preferences :: Maybe Text
280 } deriving (Show, Generic)
281 $(deriveJSON (unPrefix "hyperdataScore_") ''HyperdataScore)
282
283 instance Hyperdata HyperdataScore
284
285 ------------------------------------------------------------------------
286
287 data HyperdataResource = HyperdataResource { hyperdataResource_preferences :: Maybe Text
288 } deriving (Show, Generic)
289 $(deriveJSON (unPrefix "hyperdataResource_") ''HyperdataResource)
290
291 instance Hyperdata HyperdataResource
292
293 ------------------------------------------------------------------------
294 data HyperdataDashboard = HyperdataDashboard { hyperdataDashboard_preferences :: Maybe Text
295 } deriving (Show, Generic)
296 $(deriveJSON (unPrefix "hyperdataDashboard_") ''HyperdataDashboard)
297
298 instance Hyperdata HyperdataDashboard
299
300 -- TODO add the Graph Structure here
301 data HyperdataGraph = HyperdataGraph { hyperdataGraph_preferences :: Maybe Text
302 } deriving (Show, Generic)
303 $(deriveJSON (unPrefix "hyperdataGraph_") ''HyperdataGraph)
304
305 instance Hyperdata HyperdataGraph
306 ------------------------------------------------------------------------
307
308 -- TODO add the Graph Structure here
309 data HyperdataPhylo = HyperdataPhylo { hyperdataPhylo_preferences :: Maybe Text
310 } deriving (Show, Generic)
311 $(deriveJSON (unPrefix "hyperdataPhylo_") ''HyperdataPhylo)
312
313 instance Hyperdata HyperdataPhylo
314
315 ------------------------------------------------------------------------
316 -- | TODO FEATURE: Notebook saved in the node
317 data HyperdataNotebook = HyperdataNotebook { hyperdataNotebook_preferences :: Maybe Text
318 } deriving (Show, Generic)
319 $(deriveJSON (unPrefix "hyperdataNotebook_") ''HyperdataNotebook)
320
321 instance Hyperdata HyperdataNotebook
322
323
324 -- | NodePoly indicates that Node has a Polymorphism Type
325 type Node json = NodePoly NodeId NodeTypeId NodeUserId (Maybe NodeParentId) NodeName UTCTime json (Maybe TSVector)
326
327 -- type Node json = NodePoly NodeId NodeTypeId UserId ParentId NodeName UTCTime json
328 type NodeTypeId = Int
329 type NodeParentId = Int
330 type NodeUserId = Int
331 type NodeName = Text
332 type TSVector = Text
333
334
335 -- | Then a Node can be either a Folder or a Corpus or a Document
336 type NodeUser = Node HyperdataUser
337 type NodeFolder = Node HyperdataFolder
338
339 type NodeCorpus = Node HyperdataCorpus
340 type NodeCorpusV3 = Node HyperdataCorpus
341 type NodeDocument = Node HyperdataDocument
342
343 type NodeAnnuaire = Node HyperdataAnnuaire
344
345 -- | Any others nodes
346 type NodeAny = Node HyperdataAny
347
348 ---- | Then a Node can be either a Graph or a Phylo or a Notebook
349 type NodeList = Node HyperdataList
350 type NodeGraph = Node HyperdataGraph
351 type NodePhylo = Node HyperdataPhylo
352 type NodeNotebook = Node HyperdataNotebook
353 ------------------------------------------------------------------------
354 data NodeType = NodeUser
355 | NodeFolder
356 | NodeCorpus | NodeCorpusV3 | NodeDocument
357 | NodeAnnuaire | NodeContact
358 -- | NodeOccurrences
359 | NodeGraph
360 | NodeDashboard | NodeChart
361 -- | Classification
362 | NodeList
363 -- | Metrics
364 deriving (Show, Read, Eq, Generic, Bounded, Enum)
365
366 allNodeTypes :: [NodeType]
367 allNodeTypes = [minBound ..]
368
369 instance FromJSON NodeType
370 instance ToJSON NodeType
371
372 instance FromHttpApiData NodeType
373 where
374 parseUrlPiece = Right . read . unpack
375
376 instance ToParamSchema NodeType
377 instance ToSchema NodeType
378
379 ------------------------------------------------------------------------
380 data NodePoly id typename userId
381 parentId name date
382 hyperdata search = Node { _node_id :: id
383 , _node_typename :: typename
384 , _node_userId :: userId
385 -- , nodeUniqId :: hashId
386 , _node_parentId :: parentId
387 , _node_name :: name
388 , _node_date :: date
389
390 , _node_hyperdata :: hyperdata
391 , _node_search :: search
392 } deriving (Show, Generic)
393 $(deriveJSON (unPrefix "_node_") ''NodePoly)
394 $(makeLenses ''NodePoly)
395
396
397 instance Arbitrary hyperdata => Arbitrary (NodePoly NodeId NodeTypeId
398 (Maybe NodeUserId) NodeParentId NodeName
399 UTCTime hyperdata (Maybe TSVector)) where
400 --arbitrary = Node 1 1 (Just 1) 1 "name" (jour 2018 01 01) (arbitrary) (Just "")
401 arbitrary = Node <$> arbitrary <*> arbitrary <*> arbitrary
402 <*> arbitrary <*> arbitrary <*> arbitrary
403 <*> arbitrary <*> arbitrary
404 ------------------------------------------------------------------------
405 hyperdataDocument :: HyperdataDocument
406 hyperdataDocument = case decode docExample of
407 Just hp -> hp
408 Nothing -> HyperdataDocument Nothing Nothing Nothing Nothing
409 Nothing Nothing Nothing Nothing
410 Nothing Nothing Nothing Nothing
411 Nothing Nothing Nothing Nothing
412 Nothing Nothing Nothing
413 docExample :: ByteString
414 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}"
415
416 instance ToSchema HyperdataCorpus where
417 declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
418 L.& mapped.schema.description ?~ "a corpus"
419 L.& mapped.schema.example ?~ toJSON hyperdataCorpus
420
421
422 instance ToSchema HyperdataAnnuaire where
423 declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
424 L.& mapped.schema.description ?~ "an annuaire"
425 L.& mapped.schema.example ?~ toJSON hyperdataAnnuaire
426
427
428 instance ToSchema HyperdataDocument where
429 declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
430 L.& mapped.schema.description ?~ "a document"
431 L.& mapped.schema.example ?~ toJSON hyperdataDocument
432
433
434 instance ToSchema HyperdataAny where
435 declareNamedSchema proxy =
436 pure $ genericNameSchema defaultSchemaOptions proxy mempty
437 L.& schema.description ?~ "a node"
438 L.& schema.example ?~ emptyObject -- TODO
439
440
441 instance ToSchema hyperdata =>
442 ToSchema (NodePoly NodeId NodeTypeId
443 (Maybe NodeUserId)
444 NodeParentId NodeName
445 UTCTime hyperdata TSVector
446 )
447
448 instance ToSchema hyperdata =>
449 ToSchema (NodePoly NodeId NodeTypeId
450 NodeUserId
451 (Maybe NodeParentId) NodeName
452 UTCTime hyperdata TSVector
453 )
454
455
456 instance ToSchema Status
457
458