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