Histo.purs 4.66 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.Components.Nodes.Corpus.Chart.Utils as U
16
import Gargantext.Config.REST (AffRESTError)
17
import Gargantext.Hooks.Loader (HashedResponse(..))
18
import Gargantext.Prelude (class Eq, bind, map, pure, ($), (==))
19
import Gargantext.Routes (SessionRoute(..))
20
import Gargantext.Sessions (Session, get)
21
import Gargantext.Types (ChartType(..))
22
import Gargantext.Utils.CacheAPI as GUC
23
import Gargantext.Utils.Reactix as R2
24
import Gargantext.Utils.Toestand as T2
25 26
import Reactix as R
import Reactix.DOM.HTML as H
27
import Record.Extra as RX
28 29
import Simple.JSON as JSON
import Toestand as T
30

31 32
here :: R2.Here
here = R2.here "Gargantext.Components.Nodes.Corpus.Chart.Histo"
33

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

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

49 50
type Loaded = HistoMetrics

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

chartOptions :: Record LoadedProps -> Options
chartOptions { onClick
             , onInit
             , metrics: HistoMetrics { dates: dates', count: count'} } = Options
59 60 61
  { mainTitle : "Histogram"
  , subTitle  : "Distribution of publications over time"
  , xAxis     : xAxis' dates'
62
  , yAxis     : yAxis' { position: "left", show: true, min:0}
63 64
  , addZoom   : true
  , tooltip   : mkTooltip { formatter: templateFormatter "{b0}" }
65 66 67 68 69 70 71 72 73 74 75
  , 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
76
        -- , select: { itemStyle: itemStyle { color: green }}
77 78 79 80 81 82
        }

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

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

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

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

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

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

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

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