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