1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
{-|
Module : Gargantext.Core.Viz.Phylo.API
Description :
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
-}
module Gargantext.Core.Viz.Phylo.API
where
import Data.Map (Map)
import Data.Maybe (catMaybes)
import Data.Text (Text, pack)
import Data.Set (Set)
import Data.Time.Calendar (fromGregorian, diffGregorianDurationClip, cdMonths, diffDays, showGregorian)
import Gargantext.API.Ngrams.Tools (getRepo')
import Gargantext.API.Node.Corpus.Export (getContextNgrams)
import Gargantext.API.Prelude (GargNoServer)
import Gargantext.Core.Types (Context)
import Gargantext.Core.Types.Main (ListType(MapTerm))
import Gargantext.Core.Viz.Phylo (TimeUnit(..), Date, Document(..))
import Gargantext.Database.Admin.Types.Hyperdata.Document (HyperdataDocument(..))
import Gargantext.Database.Admin.Types.Node (CorpusId, ContextId)
import Gargantext.Database.Query.Table.Node (defaultList)
import Gargantext.Database.Query.Table.NodeContext (selectDocNodes)
import Gargantext.Database.Schema.Context
import Gargantext.Database.Schema.Ngrams (NgramsType(..))
import Gargantext.Prelude
import Prelude as Prelude
import Gargantext.API.Ngrams.Types (NgramsTerm(..))
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.List as List
corpusIdtoDocuments :: TimeUnit -> CorpusId -> GargNoServer [Document]
corpusIdtoDocuments timeUnit corpusId = do
docs <- selectDocNodes corpusId
lId <- defaultList corpusId
repo <- getRepo' [lId]
ngs_terms <- getContextNgrams corpusId lId MapTerm NgramsTerms repo
ngs_sources <- getContextNgrams corpusId lId MapTerm Sources repo
pure $ catMaybes
$ List.map (\doc
-> context2phyloDocument timeUnit doc (ngs_terms, ngs_sources)
) docs
context2phyloDocument :: TimeUnit
-> Context HyperdataDocument
-> (Map ContextId (Set NgramsTerm), Map ContextId (Set NgramsTerm))
-> Maybe Document
context2phyloDocument timeUnit context (ngs_terms, ngs_sources) = do
let contextId = _context_id context
(date, date') <- context2date context timeUnit
text <- Map.lookup contextId ngs_terms
sources <- Map.lookup contextId ngs_sources
pure $ Document date date'
(toText text)
Nothing
(toText sources)
where
toText x = Set.toList $ Set.map unNgramsTerm x
context2date :: Context HyperdataDocument -> TimeUnit -> Maybe (Date, Text)
context2date context timeUnit = do
let hyperdata = _context_hyperdata context
year <- _hd_publication_year hyperdata
month <- _hd_publication_month hyperdata
day <- _hd_publication_day hyperdata
pure (toPhyloDate year month day timeUnit, toPhyloDate' year month day)
---------------
-- | Dates | --
---------------
toMonths :: Integer -> Int -> Int -> Date
toMonths y m d = fromIntegral $ cdMonths
$ diffGregorianDurationClip (fromGregorian y m d)
(fromGregorian 0000 0 0)
toDays :: Integer -> Int -> Int -> Date
toDays y m d = fromIntegral
$ diffDays (fromGregorian y m d) (fromGregorian 0000 0 0)
toPhyloDate :: Int -> Int -> Int -> TimeUnit -> Date
toPhyloDate y m d tu = case tu of
Year _ _ _ -> y
Month _ _ _ -> toMonths (Prelude.toInteger y) m d
Week _ _ _ -> div (toDays (Prelude.toInteger y) m d) 7
Day _ _ _ -> toDays (Prelude.toInteger y) m d
-- Function to use in Database export
toPhyloDate' :: Int -> Int -> Int -> Text
toPhyloDate' y m d = pack
$ showGregorian
$ fromGregorian (Prelude.toInteger y) m d