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