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