Histo.purs 4.31 KB
Newer Older
1
module Gargantext.Components.Nodes.Corpus.Chart.Histo where
2

3
import Data.Eq.Generic (genericEq)
4
import Data.Generic.Rep (class Generic)
5
import Data.Maybe (Maybe(..))
6
import Data.Newtype (class Newtype)
7
import Data.Tuple.Nested ((/\))
8
import Gargantext.Components.Charts.Options.Color (grey, blue)
9
import Gargantext.Components.Charts.Options.Data (dataSerie)
10 11 12
import Gargantext.Components.Charts.Options.ECharts (Options(..), chart, xAxis', yAxis')
import Gargantext.Components.Charts.Options.Font (itemStyle, mkTooltip, templateFormatter)
import Gargantext.Components.Charts.Options.Series (seriesBarD1)
13 14
import Gargantext.Components.Nodes.Corpus.Chart.Common (metricsWithCacheLoadView)
import Gargantext.Components.Nodes.Corpus.Chart.Types (MetricsProps, Path, Props, ReloadPath)
15
import Gargantext.Config.REST (AffRESTError)
16
import Gargantext.Hooks.Loader (HashedResponse(..))
17
import Gargantext.Prelude (class Eq, bind, map, pure, ($), (==))
18
import Gargantext.Routes (SessionRoute(..))
19
import Gargantext.Sessions (Session, get)
20
import Gargantext.Types (ChartType(..))
21
import Gargantext.Utils.CacheAPI as GUC
22
import Gargantext.Utils.Reactix as R2
23
import Gargantext.Utils.Toestand as T2
24 25 26 27
import Reactix as R
import Reactix.DOM.HTML as H
import Simple.JSON as JSON
import Toestand as T
28

29 30
here :: R2.Here
here = R2.here "Gargantext.Components.Nodes.Corpus.Chart.Histo"
31

32 33 34
newtype ChartMetrics = ChartMetrics {
    "data" :: HistoMetrics
   }
35
derive instance Generic ChartMetrics _
36 37 38
derive instance Newtype ChartMetrics _
instance Eq ChartMetrics where eq = genericEq
derive newtype instance JSON.ReadForeign ChartMetrics
39

40
newtype HistoMetrics = HistoMetrics { dates :: Array String, count :: Array Number }
41
derive instance Generic HistoMetrics _
42 43 44 45
derive instance Newtype HistoMetrics _
instance Eq HistoMetrics where eq = genericEq
derive newtype instance JSON.ReadForeign HistoMetrics
derive newtype instance JSON.WriteForeign HistoMetrics
46

47 48
type Loaded = HistoMetrics

49 50
chartOptions :: Record MetricsProps -> HistoMetrics -> Options
chartOptions { onClick, onInit } (HistoMetrics { dates: dates', count: count'}) = Options
51 52 53
  { mainTitle : "Histogram"
  , subTitle  : "Distribution of publications over time"
  , xAxis     : xAxis' dates'
54
  , yAxis     : yAxis' { position: "left", show: true, min:0}
55 56
  , addZoom   : true
  , tooltip   : mkTooltip { formatter: templateFormatter "{b0}" }
57 58 59 60 61 62 63 64 65 66 67
  , series
  , onClick
  , onInit
  }
    where
      mapSeriesBar n = dataSerie
        { value: n
        , itemStyle: itemStyle { color: grey }
        , emphasis: { itemStyle: itemStyle { color: blue } }
        -- @XXX "select" action not working
        -- , selectedMode: selectedMode Single
arturo's avatar
arturo committed
68
        -- , select: { itemStyle: itemStyle { color: green }}
69 70 71 72 73 74
        }

      series =
        [ seriesBarD1 {name: "Number of publication / year"} $
          map mapSeriesBar count'
        ]
75

76
getMetricsHash :: Session -> ReloadPath -> AffRESTError String
77
getMetricsHash session (_ /\ { corpusId, listId, tabType }) = do
78
  get session $ ChartHash { chartType: Histo, listId: mListId, tabType } (Just corpusId)
79 80
  where
    mListId = if listId == 0 then Nothing else (Just listId)
81

82
chartUrl :: Record Path -> SessionRoute
83 84 85
chartUrl { corpusId, limit, listId, tabType } = Chart {chartType: Histo, limit, listId: mListId, tabType} (Just corpusId)
  where
    mListId = if listId == 0 then Nothing else (Just listId)
86 87 88 89 90

handleResponse :: HashedResponse ChartMetrics -> HistoMetrics
handleResponse (HashedResponse { value: ChartMetrics ms }) = ms."data"

mkRequest :: Session -> ReloadPath -> GUC.Request
91
mkRequest session (_ /\ path) = GUC.makeGetRequest session $ chartUrl path
92

93
histo :: Record Props -> R.Element
94
histo props = R.createElement histoCpt props []
95
histoCpt :: R.Component Props
96
histoCpt = here.component "histo" cpt
97
  where
98
    cpt { boxes, path, session, onClick, onInit } _ = do
99 100
      reload <- T.useBox T2.newReload

101 102
      pure $ metricsWithCacheLoadView
        { boxes
103
        , getMetricsHash
104 105 106 107 108 109
        , handleResponse
        , loaded
        , mkRequest: mkRequest session
        , path
        , reload
        , session
110 111
        , onClick
        , onInit
112
        }
113

114
loaded :: Record MetricsProps -> HistoMetrics -> R.Element
115
loaded p l =
116
  H.div {} [
117
  {-  U.reloadButton reload
118
  , U.chartUpdateButton { chartType: Histo, path, reload, session }
119
  , -} chart $ chartOptions p l
120
  ]
121
  -- TODO: parametrize ngramsType above