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