]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/Viz/Chart.hs
Merge branch 'dev' into dev-doc-annotation-issue
[gargantext.git] / src / Gargantext / Viz / Chart.hs
1 {-|
2 Module : Gargantext.Viz.Chart
3 Description : Graph utils
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 {-# LANGUAGE TemplateHaskell #-}
13
14 module Gargantext.Viz.Chart
15 where
16
17 import Data.List (unzip, sortOn)
18 import Data.Map (toList)
19 import qualified Data.List as List
20 import qualified Data.Map as Map
21 import Data.Maybe (catMaybes)
22 import Servant
23
24 import Gargantext.Core.Types.Main
25 import Gargantext.Database.Admin.Config
26 import Gargantext.Database.Admin.Types.Node (CorpusId)
27 import Gargantext.Database.Prelude
28 import Gargantext.Database.Query.Table.Node
29 import Gargantext.Database.Query.Table.Node.Select
30 import Gargantext.Database.Query.Table.NodeNode (selectDocsDates)
31 import Gargantext.Database.Schema.Node
32 import Gargantext.Prelude
33 import Gargantext.Text.Metrics.Count (occurrencesWith)
34
35 -- Pie Chart
36 import Gargantext.API.Ngrams.NTree
37 import Gargantext.API.Ngrams.Tools
38 import Gargantext.Core.Types
39 import Gargantext.Database.Action.Flow
40 import Gargantext.Database.Action.Metrics.NgramsByNode
41 import Gargantext.Database.Schema.Ngrams
42 import Gargantext.Viz.Types
43
44 histoData :: CorpusId -> Cmd err Histo
45 histoData cId = do
46 dates <- selectDocsDates cId
47 let (ls, css) = unzip
48 $ sortOn fst
49 $ toList
50 $ occurrencesWith identity dates
51 pure (Histo ls css)
52
53
54 pieData :: FlowCmdM env err m
55 => CorpusId -> NgramsType -> ListType
56 -> m Histo
57 pieData cId nt lt = do
58 ls' <- selectNodesWithUsername NodeList userMaster
59 ls <- map (_node_id) <$> getListsWithParentId cId
60 ts <- mapTermListRoot ls nt <$> getRepo
61 let
62 dico = filterListWithRoot lt ts
63 terms = catMaybes $ List.concat $ map (\(a,b) -> [Just a, b]) $ Map.toList dico
64 group dico' x = case Map.lookup x dico' of
65 Nothing -> x
66 Just x' -> maybe x identity x'
67
68 (_total,mapTerms) <- countNodesByNgramsWith (group dico)
69 <$> getNodesByNgramsOnlyUser cId (ls' <> ls) nt terms
70 let (dates, count) = unzip $ map (\(t,(d,_)) -> (t, d)) $ Map.toList mapTerms
71 pure (Histo dates (map round count))
72
73
74
75
76 treeData :: FlowCmdM env err m
77 => CorpusId -> NgramsType -> ListType
78 -> m [MyTree]
79 treeData cId nt lt = do
80 ls' <- selectNodesWithUsername NodeList userMaster
81 ls <- map (_node_id) <$> getListsWithParentId cId
82 ts <- mapTermListRoot ls nt <$> getRepo
83
84 let
85 dico = filterListWithRoot lt ts
86 terms = catMaybes $ List.concat $ map (\(a,b) -> [Just a, b]) $ Map.toList dico
87
88 cs' <- getNodesByNgramsOnlyUser cId (ls' <> ls) nt terms
89
90 m <- getListNgrams ls nt
91 pure $ toTree lt cs' m
92
93
94 treeData' :: FlowCmdM env ServerError m
95 => CorpusId -> NgramsType -> ListType
96 -> m [MyTree]
97 treeData' cId nt lt = do
98 ls' <- selectNodesWithUsername NodeList userMaster
99 ls <- map (_node_id) <$> getListsWithParentId cId
100 ts <- mapTermListRoot ls nt <$> getRepo
101
102 let
103 dico = filterListWithRoot lt ts
104 terms = catMaybes $ List.concat $ map (\(a,b) -> [Just a, b]) $ Map.toList dico
105
106 cs' <- getNodesByNgramsOnlyUser cId (ls' <> ls) nt terms
107
108 m <- getListNgrams ls nt
109 pure $ toTree lt cs' m
110
111