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

3 4
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson, (.:), (~>), (:=))
import Data.Argonaut.Core (jsonEmptyObject)
5
import Data.Maybe (Maybe(..))
6 7
import Data.Tuple (Tuple(..))
import Data.Tuple.Nested ((/\))
8
import Effect.Aff (Aff)
9 10 11
import Reactix as R
import Reactix.DOM.HTML as H

12 13
import Gargantext.Components.Charts.Options.Color (grey)
import Gargantext.Components.Charts.Options.Data (dataSerie)
14 15 16
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)
17
import Gargantext.Components.Nodes.Corpus.Chart.Common (metricsLoadView, metricsWithCacheLoadView)
18
import Gargantext.Components.Nodes.Corpus.Chart.Types
19
import Gargantext.Components.Nodes.Corpus.Chart.Utils as U
20
import Gargantext.Hooks.Loader (HashedResponse(..))
21
import Gargantext.Prelude
22
import Gargantext.Routes (SessionRoute(..))
23
import Gargantext.Sessions (Session, get)
24
import Gargantext.Types (ChartType(..), TabType(..))
25
import Gargantext.Utils.CacheAPI as GUC
26 27 28
import Gargantext.Utils.Reactix as R2

thisModule = "Gargantext.Components.Nodes.Corpus.Chart.Histo"
29

30 31 32
newtype ChartMetrics = ChartMetrics {
    "data" :: HistoMetrics
   }
33 34 35 36

instance decodeChartMetrics :: DecodeJson ChartMetrics where
  decodeJson json = do
    obj <- decodeJson json
37
    d <- obj .: "data"
38 39
    pure $ ChartMetrics { "data": d }

40
newtype HistoMetrics = HistoMetrics { dates :: Array String, count :: Array Number }
41 42 43 44

instance decodeHistoMetrics :: DecodeJson HistoMetrics where
  decodeJson json = do
    obj   <- decodeJson json
45 46
    d <- obj .: "dates"
    c <- obj .: "count"
47
    pure $ HistoMetrics { dates : d , count: c}
48 49 50 51 52 53
instance encodeHistoMetrics :: EncodeJson HistoMetrics where
  encodeJson (HistoMetrics { dates, count }) =
       "count" := encodeJson count
    ~> "dates"    := encodeJson dates
    ~> jsonEmptyObject

54 55 56 57 58 59 60
type Loaded = HistoMetrics

chartOptions :: HistoMetrics -> Options
chartOptions (HistoMetrics { dates: dates', count: count'}) = Options
  { mainTitle : "Histogram"
  , subTitle  : "Distribution of publications over time"
  , xAxis     : xAxis' dates'
61
  , yAxis     : yAxis' { position: "left", show: true, min:0}
62 63
  , addZoom   : true
  , tooltip   : mkTooltip { formatter: templateFormatter "{b0}" }
64 65
  , series    : [seriesBarD1 {name: "Number of publication / year"} $
                 map (\n -> dataSerie {value: n, itemStyle : itemStyle {color:grey}}) count'] }
66

67 68
getMetricsHash :: Session -> Tuple Reload (Record Path) -> Aff String
getMetricsHash session (_ /\ { corpusId, limit, listId, tabType }) = do
69
  get session $ ChartHash { chartType: Histo, listId: mListId, tabType } (Just corpusId)
70 71
  where
    mListId = if listId == 0 then Nothing else (Just listId)
72

73
chartUrl :: Record Path -> SessionRoute
74 75 76
chartUrl { corpusId, limit, listId, tabType } = Chart {chartType: Histo, limit, listId: mListId, tabType} (Just corpusId)
  where
    mListId = if listId == 0 then Nothing else (Just listId)
77 78 79 80 81 82 83

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

mkRequest :: Session -> ReloadPath -> GUC.Request
mkRequest session (_ /\ path@{ corpusId, limit, listId, tabType }) = GUC.makeGetRequest session $ chartUrl path

84
histo :: Record Props -> R.Element
85
histo props = R.createElement histoCpt props []
86

87
histoCpt :: R.Component Props
88
histoCpt = R.hooksComponentWithModule thisModule "histo" cpt
89
  where
90
    cpt { path, session } _ = do
91
      reload <- R.useState' 0
92
      pure $ metricsWithCacheLoadView {
93
          getMetricsHash
94 95 96 97 98 99 100
        , handleResponse
        , loaded
        , mkRequest: mkRequest session
        , path
        , reload
        , session
        }
101

102 103
loaded :: Record MetricsProps -> HistoMetrics -> R.Element
loaded { path, reload, session } loaded =
104
  H.div {} [
105
  {-  U.reloadButton reload
106
  , U.chartUpdateButton { chartType: Histo, path, reload, session }
107
  , -} chart $ chartOptions loaded
108
  ]
109
  -- TODO: parametrize ngramsType above