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