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.Schema.NodeNode (selectDocsDates)
  28 import Gargantext.Database.Utils
  29 import Gargantext.Database.Types.Node (CorpusId)
  30 import Gargantext.Text.Metrics.Count (occurrencesWith)
  31 import Gargantext.Core.Types.Main
  32
  33 -- Pie Chart
  34 import Data.Maybe (catMaybes)
  35 import qualified Data.Map as Map
  36 import qualified Data.List as List
  37 import Gargantext.API.Ngrams.Tools
  38 import Gargantext.API.Ngrams.NTree
  39 import Gargantext.Database.Metrics.NgramsByNode
  40 import Gargantext.Database.Schema.Ngrams
  41 import Gargantext.Database.Schema.Node
  42 import Gargantext.Core.Types
  43 import Gargantext.Database.Flow
  44
  45 import Servant
  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 <- map (_node_id) <$> getListsWithParentId cId
  72   ts <- mapTermListRoot ls nt
  73   let
  74     dico = filterListWithRoot lt ts
  75     terms = catMaybes $ List.concat $ map (\(a,b) -> [Just a, b]) $ Map.toList dico
  76     group dico' x = case Map.lookup x dico' of
  77         Nothing -> x
  78         Just x' -> maybe x identity x'
  79
  80   (_total,mapTerms) <- countNodesByNgramsWith (group dico)
  81                     <$> getNodesByNgramsOnlyUser cId nt terms
  82   let (dates, count) = unzip $ map (\(t,(d,_)) -> (t, d)) $ Map.toList mapTerms
  83   pure (Histo dates (map round count))
  84
  85
  86
  87
  88 treeData :: FlowCmdM env err m
  89         => CorpusId -> NgramsType -> ListType
  90         -> m [MyTree]
  91 treeData cId nt lt = do
  92   ls <- map (_node_id) <$> getListsWithParentId cId
  93   ts <- mapTermListRoot ls nt
  94
  95   let
  96     dico = filterListWithRoot lt ts
  97     terms = catMaybes $ List.concat $ map (\(a,b) -> [Just a, b]) $ Map.toList dico
  98
  99   cs' <- getNodesByNgramsOnlyUser cId nt terms
 100
 101   m  <- getListNgrams ls nt
 102   pure $ toTree lt cs' m
 103
 104
 105 treeData' :: FlowCmdM env ServantErr m
 106         => CorpusId -> NgramsType -> ListType
 107         -> m [MyTree]
 108 treeData' cId nt lt = do
 109   ls <- map (_node_id) <$> getListsWithParentId cId
 110   ts <- mapTermListRoot ls nt
 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 nt terms
 117
 118   m  <- getListNgrams ls nt
 119   pure $ toTree lt cs' m
 120
 121
 122