Histo.purs 4.56 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 31
here :: R2.Here
here = R2.here "Gargantext.Components.Nodes.Corpus.Chart.Histo"
32

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

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

48 49
type Loaded = HistoMetrics

50 51 52 53 54 55 56 57
type LoadedProps =
  ( metrics :: HistoMetrics
  | MetricsProps )

chartOptions :: Record LoadedProps -> Options
chartOptions { onClick
             , onInit
             , metrics: HistoMetrics { dates: dates', count: count'} } = Options
58 59 60
  { 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 66 67 68 69 70 71 72 73 74
  , 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
75
        -- , select: { itemStyle: itemStyle { color: green }}
76 77 78 79 80 81
        }

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

83
getMetricsHash :: Session -> ReloadPath -> AffRESTError String
84
getMetricsHash session (_ /\ { corpusId, listId, tabType }) = do
85
  get session $ ChartHash { chartType: Histo, listId: mListId, tabType } (Just corpusId)
86 87
  where
    mListId = if listId == 0 then Nothing else (Just listId)
88

89
chartUrl :: Record Path -> SessionRoute
90 91 92
chartUrl { corpusId, limit, listId, tabType } = Chart {chartType: Histo, limit, listId: mListId, tabType} (Just corpusId)
  where
    mListId = if listId == 0 then Nothing else (Just listId)
93 94 95 96 97

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

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

100
histo :: Record Props -> R.Element
101
histo props = R.createElement histoCpt props []
102
histoCpt :: R.Component Props
103
histoCpt = here.component "histo" cpt
104
  where
105
    cpt { path, session, onClick, onInit } _ = do
106 107
      reload <- T.useBox T2.newReload

108
      pure $ metricsWithCacheLoadView
109
        { getMetricsHash
110 111 112 113 114 115
        , handleResponse
        , loaded
        , mkRequest: mkRequest session
        , path
        , reload
        , session
116 117
        , onClick
        , onInit
118
        }
119

120 121 122 123
loaded :: R2.Leaf LoadedProps
loaded = R2.leaf loadedCpt
loadedCpt :: R.Component LoadedProps
loadedCpt = here.component "loaded" cpt where
124
  cpt p _ = do
125 126 127 128 129
    pure $ H.div {} [ 
                    -- U.reloadButton { reload }
                    -- , U.chartUpdateButton { chartType: Histo, path, reload, session }
                    -- , 
                    chart $ chartOptions p
130
                    ]
131
  -- TODO: parametrize ngramsType above