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