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