Commit a361da8a authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

[list] HashedResponse with md5 (list chart caching)

parent df89d465
...@@ -185,24 +185,23 @@ toJsTree maybeSurname (TreeNode x) = ...@@ -185,24 +185,23 @@ toJsTree maybeSurname (TreeNode x) =
where where
name = maybe "" (\x' -> x' <> ">") maybeSurname <> x.name name = maybe "" (\x' -> x' <> ">") maybeSurname <> x.name
data TreeNode = TreeNode { name :: String data TreeNode = TreeNode {
, value :: Int name :: String
, children :: Array TreeNode , value :: Int
} , children :: Array TreeNode
}
instance decodeTreeNode :: DecodeJson TreeNode where instance decodeTreeNode :: DecodeJson TreeNode where
decodeJson json = do decodeJson json = do
obj <- decodeJson json obj <- decodeJson json
children <- obj .: "children"
name <- obj .: "label" name <- obj .: "label"
value <- obj .: "value" value <- obj .: "value"
children <- obj .: "children" pure $ TreeNode { children, name, value }
pure $ TreeNode {name, value, children}
instance encodeTreeNode :: EncodeJson TreeNode where instance encodeTreeNode :: EncodeJson TreeNode where
encodeJson (TreeNode { children, name, value }) = encodeJson (TreeNode { children, name, value }) =
"children" := encodeJson children "children" := encodeJson children
~> "name" := encodeJson name ~> "label" := encodeJson name
~> "value" := encodeJson value ~> "value" := encodeJson value
~> jsonEmptyObject ~> jsonEmptyObject
......
...@@ -9,7 +9,7 @@ import Reactix as R ...@@ -9,7 +9,7 @@ import Reactix as R
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Components.Nodes.Corpus.Chart.Types import Gargantext.Components.Nodes.Corpus.Chart.Types
import Gargantext.Hooks.Loader (useLoader, useLoaderWithCache) import Gargantext.Hooks.Loader (HashedResponse, useLoader, useLoaderWithCache)
import Gargantext.Sessions (Session) import Gargantext.Sessions (Session)
type MetricsLoadViewProps a = ( type MetricsLoadViewProps a = (
...@@ -24,23 +24,27 @@ metricsLoadView p = R.createElement metricsLoadViewCpt p [] ...@@ -24,23 +24,27 @@ metricsLoadView p = R.createElement metricsLoadViewCpt p []
metricsLoadViewCpt :: forall a. R.Component (MetricsLoadViewProps a) metricsLoadViewCpt :: forall a. R.Component (MetricsLoadViewProps a)
metricsLoadViewCpt = R.hooksComponent "G.C.N.C.C.metricsLoadView" cpt metricsLoadViewCpt = R.hooksComponent "G.C.N.C.C.metricsLoadView" cpt
where where
cpt {getMetrics, loaded, path, reload, session} _ = do cpt { getMetrics, loaded, path, reload, session } _ = do
useLoader (fst reload /\ path) (getMetrics session) $ \l -> useLoader (fst reload /\ path) (getMetrics session) $ \l ->
loaded session path reload l loaded session path reload l
type MetricsWithCacheLoadViewProps a = ( type MetricsWithCacheLoadViewProps a = (
--keyFunc :: Record Path -> String keyFunc :: Tuple Reload (Record Path) -> String
| MetricsLoadViewProps a , getMetrics :: Session -> Tuple Reload (Record Path) -> Aff (HashedResponse a)
, getMetricsMD5 :: Session -> Tuple Reload (Record Path) -> Aff String
, loaded :: Session -> Record Path -> R.State Reload -> a -> R.Element
| MetricsProps
) )
metricsWithCacheLoadView :: forall a. DecodeJson a => EncodeJson a => metricsWithCacheLoadView :: forall a. DecodeJson a => EncodeJson a =>
Record (MetricsLoadViewProps a) -> R.Element Record (MetricsWithCacheLoadViewProps a) -> R.Element
metricsWithCacheLoadView p = R.createElement metricsWithCacheLoadViewCpt p [] metricsWithCacheLoadView p = R.createElement metricsWithCacheLoadViewCpt p []
metricsWithCacheLoadViewCpt :: forall a. DecodeJson a => EncodeJson a => R.Component (MetricsLoadViewProps a) metricsWithCacheLoadViewCpt :: forall a. DecodeJson a => EncodeJson a => R.Component (MetricsWithCacheLoadViewProps a)
metricsWithCacheLoadViewCpt = R.hooksComponent "G.C.N.C.C.metricsWithCacheLoadView" cpt metricsWithCacheLoadViewCpt = R.hooksComponent "G.C.N.C.C.metricsWithCacheLoadView" cpt
where where
cpt {getMetrics, loaded, path, reload, session} _ = do cpt { getMetrics, getMetricsMD5, keyFunc, loaded, path, reload, session } _ = do
useLoaderWithCache (fst reload /\ path) keyFunc (getMetrics session) $ \l -> useLoaderWithCache (fst reload /\ path) (metricsKeyFunc keyFunc) (getMetricsMD5 session) (getMetrics session) $ \l ->
loaded session path reload l loaded session path reload l
keyFunc (_ /\ { corpusId, listId, tabType }) = "metrics-" <> (show tabType) <> "-" <> (show corpusId) <> "-" <> (show listId) metricsKeyFunc keyFunc st@(_ /\ { corpusId, listId, tabType }) =
"metrics-" <> (show tabType) <> "-" <> (show corpusId) <> "-" <> (show listId) <> "--" <> (keyFunc st)
...@@ -19,16 +19,19 @@ import Gargantext.Components.Charts.Options.Data (dataSerie) ...@@ -19,16 +19,19 @@ import Gargantext.Components.Charts.Options.Data (dataSerie)
import Gargantext.Components.Nodes.Corpus.Chart.Common (metricsLoadView, metricsWithCacheLoadView) import Gargantext.Components.Nodes.Corpus.Chart.Common (metricsLoadView, metricsWithCacheLoadView)
import Gargantext.Components.Nodes.Corpus.Chart.Types import Gargantext.Components.Nodes.Corpus.Chart.Types
import Gargantext.Components.Nodes.Corpus.Chart.Utils as U import Gargantext.Components.Nodes.Corpus.Chart.Utils as U
import Gargantext.Hooks.Loader (HashedResponse(..))
import Gargantext.Routes (SessionRoute(..)) import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, get) import Gargantext.Sessions (Session, get)
import Gargantext.Types (ChartType(..), TabType(..)) import Gargantext.Types (ChartType(..), TabType(..))
newtype ChartMetrics = ChartMetrics { "data" :: HistoMetrics } newtype ChartMetrics = ChartMetrics {
"data" :: HistoMetrics
}
instance decodeChartMetrics :: DecodeJson ChartMetrics where instance decodeChartMetrics :: DecodeJson ChartMetrics where
decodeJson json = do decodeJson json = do
obj <- decodeJson json obj <- decodeJson json
d <- obj .: "data" d <- obj .: "data"
pure $ ChartMetrics { "data": d } pure $ ChartMetrics { "data": d }
newtype HistoMetrics = HistoMetrics { dates :: Array String, count :: Array Number } newtype HistoMetrics = HistoMetrics { dates :: Array String, count :: Array Number }
...@@ -39,7 +42,6 @@ instance decodeHistoMetrics :: DecodeJson HistoMetrics where ...@@ -39,7 +42,6 @@ instance decodeHistoMetrics :: DecodeJson HistoMetrics where
d <- obj .: "dates" d <- obj .: "dates"
c <- obj .: "count" c <- obj .: "count"
pure $ HistoMetrics { dates : d , count: c} pure $ HistoMetrics { dates : d , count: c}
instance encodeHistoMetrics :: EncodeJson HistoMetrics where instance encodeHistoMetrics :: EncodeJson HistoMetrics where
encodeJson (HistoMetrics { dates, count }) = encodeJson (HistoMetrics { dates, count }) =
"count" := encodeJson count "count" := encodeJson count
...@@ -59,13 +61,17 @@ chartOptions (HistoMetrics { dates: dates', count: count'}) = Options ...@@ -59,13 +61,17 @@ chartOptions (HistoMetrics { dates: dates', count: count'}) = Options
, series : [seriesBarD1 {name: "Number of publication / year"} $ , series : [seriesBarD1 {name: "Number of publication / year"} $
map (\n -> dataSerie {value: n, itemStyle : itemStyle {color:grey}}) count'] } map (\n -> dataSerie {value: n, itemStyle : itemStyle {color:grey}}) count'] }
getMetrics :: Session -> Tuple Reload (Record Path) -> Aff HistoMetrics getMetrics :: Session -> Tuple Reload (Record Path) -> Aff (HashedResponse HistoMetrics)
getMetrics session (_ /\ { corpusId, limit, listId, tabType }) = do getMetrics session (_ /\ { corpusId, limit, listId, tabType }) = do
ChartMetrics ms <- get session chart HashedResponse { md5, value: ChartMetrics ms } <- get session chart
pure ms."data" pure $ HashedResponse { md5, value: ms."data" }
where where
chart = Chart {chartType: Histo, listId, tabType, limit} (Just corpusId) chart = Chart {chartType: Histo, listId, tabType, limit} (Just corpusId)
getMetricsMD5 :: Session -> Tuple Reload (Record Path) -> Aff String
getMetricsMD5 session (_ /\ { corpusId, limit, listId, tabType }) = do
get session $ ChartMD5 { chartType: Histo, listId, tabType } (Just corpusId)
histo :: Record Props -> R.Element histo :: Record Props -> R.Element
histo props = R.createElement histoCpt props [] histo props = R.createElement histoCpt props []
...@@ -75,7 +81,7 @@ histoCpt = R.hooksComponent "G.C.N.C.C.H.histo" cpt ...@@ -75,7 +81,7 @@ histoCpt = R.hooksComponent "G.C.N.C.C.H.histo" cpt
cpt {path, session} _ = do cpt {path, session} _ = do
reload <- R.useState' 0 reload <- R.useState' 0
--pure $ metricsLoadView {getMetrics, loaded, path, reload, session} --pure $ metricsLoadView {getMetrics, loaded, path, reload, session}
pure $ metricsWithCacheLoadView {getMetrics, loaded, path, reload, session} pure $ metricsWithCacheLoadView { getMetrics, getMetricsMD5, keyFunc: const "histo", loaded, path, reload, session }
loaded :: Session -> Record Path -> R.State Reload -> HistoMetrics -> R.Element loaded :: Session -> Record Path -> R.State Reload -> HistoMetrics -> R.Element
loaded session path reload loaded = loaded session path reload loaded =
......
module Gargantext.Components.Nodes.Corpus.Chart.Metrics where module Gargantext.Components.Nodes.Corpus.Chart.Metrics where
import Prelude (bind, negate, pure, ($), (<$>), (<>))
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson, (.:), (~>), (:=)) import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson, (.:), (~>), (:=))
import Data.Argonaut.Core (jsonEmptyObject) import Data.Argonaut.Core (jsonEmptyObject)
import Data.Map as Map import Data.Map as Map
...@@ -8,10 +7,12 @@ import Data.Map (Map) ...@@ -8,10 +7,12 @@ import Data.Map (Map)
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Tuple (Tuple(..)) import Data.Tuple (Tuple(..))
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff) import Effect.Aff (Aff, launchAff_)
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Gargantext.Prelude
import Gargantext.Components.Charts.Options.ECharts (Options(..), chart, yAxis') import Gargantext.Components.Charts.Options.ECharts (Options(..), chart, yAxis')
import Gargantext.Components.Charts.Options.Type (xAxis) import Gargantext.Components.Charts.Options.Type (xAxis)
import Gargantext.Components.Charts.Options.Series (Series, seriesScatterD2) import Gargantext.Components.Charts.Options.Series (Series, seriesScatterD2)
...@@ -21,6 +22,7 @@ import Gargantext.Components.Charts.Options.Data (dataSerie) ...@@ -21,6 +22,7 @@ import Gargantext.Components.Charts.Options.Data (dataSerie)
import Gargantext.Components.Nodes.Corpus.Chart.Common (metricsLoadView, metricsWithCacheLoadView) import Gargantext.Components.Nodes.Corpus.Chart.Common (metricsLoadView, metricsWithCacheLoadView)
import Gargantext.Components.Nodes.Corpus.Chart.Types import Gargantext.Components.Nodes.Corpus.Chart.Types
import Gargantext.Components.Nodes.Corpus.Chart.Utils as U import Gargantext.Components.Nodes.Corpus.Chart.Utils as U
import Gargantext.Hooks.Loader (HashedResponse(..))
import Gargantext.Routes (SessionRoute(..)) import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, get) import Gargantext.Sessions (Session, get)
import Gargantext.Types (ChartType(..), TabType, TermList(..)) import Gargantext.Types (ChartType(..), TabType, TermList(..))
...@@ -49,8 +51,8 @@ instance encodeMetric :: EncodeJson Metric where ...@@ -49,8 +51,8 @@ instance encodeMetric :: EncodeJson Metric where
~> "cat" := encodeJson cat ~> "cat" := encodeJson cat
~> jsonEmptyObject ~> jsonEmptyObject
newtype Metrics = Metrics newtype Metrics = Metrics {
{ "data" :: Array Metric "data" :: Array Metric
} }
instance decodeMetrics :: DecodeJson Metrics where instance decodeMetrics :: DecodeJson Metrics where
...@@ -95,13 +97,17 @@ scatterOptions metrics' = Options ...@@ -95,13 +97,17 @@ scatterOptions metrics' = Options
} }
--} --}
getMetrics :: Session -> Tuple Reload (Record Path) -> Aff Loaded getMetrics :: Session -> Tuple Reload (Record Path) -> Aff (HashedResponse Loaded)
getMetrics session (_ /\ { corpusId, limit, listId, tabType }) = do getMetrics session (_ /\ { corpusId, limit, listId, tabType }) = do
Metrics ms <- get session metrics' HashedResponse { md5, value: Metrics ms } <- get session metrics'
pure ms."data" pure $ HashedResponse { md5, value: ms."data" }
where where
metrics' = CorpusMetrics {limit, listId, tabType} (Just corpusId) metrics' = CorpusMetrics {limit, listId, tabType} (Just corpusId)
getMetricsMD5 :: Session -> Tuple Reload (Record Path) -> Aff String
getMetricsMD5 session (_ /\ { corpusId, listId, tabType }) =
get session $ CorpusMetricsMD5 { listId, tabType } (Just corpusId)
metrics :: Record Props -> R.Element metrics :: Record Props -> R.Element
metrics props = R.createElement metricsCpt props [] metrics props = R.createElement metricsCpt props []
...@@ -111,7 +117,8 @@ metricsCpt = R.hooksComponent "G.C.N.C.C.M.metrics" cpt ...@@ -111,7 +117,8 @@ metricsCpt = R.hooksComponent "G.C.N.C.C.M.metrics" cpt
cpt {path, session} _ = do cpt {path, session} _ = do
reload <- R.useState' 0 reload <- R.useState' 0
--pure $ metricsLoadView {getMetrics, loaded, path, reload, session} --pure $ metricsLoadView {getMetrics, loaded, path, reload, session}
pure $ metricsWithCacheLoadView {getMetrics, loaded, path, reload, session}
pure $ metricsWithCacheLoadView { getMetrics, getMetricsMD5, keyFunc: const "metrics", loaded, path, reload, session }
loaded :: Session -> Record Path -> R.State Reload -> Loaded -> R.Element loaded :: Session -> Record Path -> R.State Reload -> Loaded -> R.Element
......
module Gargantext.Components.Nodes.Corpus.Chart.Pie where module Gargantext.Components.Nodes.Corpus.Chart.Pie where
import Prelude (bind, map, pure, ($), (>))
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson, (.:), (~>), (:=)) import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson, (.:), (~>), (:=))
import Data.Argonaut.Core (jsonEmptyObject) import Data.Argonaut.Core (jsonEmptyObject)
import Data.Array (zip, filter) import Data.Array (zip, filter)
...@@ -13,6 +12,8 @@ import Effect.Aff (Aff) ...@@ -13,6 +12,8 @@ import Effect.Aff (Aff)
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Gargantext.Prelude
import Gargantext.Components.Charts.Options.ECharts (Options(..), chart, xAxis', yAxis') import Gargantext.Components.Charts.Options.ECharts (Options(..), chart, xAxis', yAxis')
import Gargantext.Components.Charts.Options.Series (seriesBarD1, seriesPieD1) import Gargantext.Components.Charts.Options.Series (seriesBarD1, seriesPieD1)
import Gargantext.Components.Charts.Options.Color (blue) import Gargantext.Components.Charts.Options.Color (blue)
...@@ -21,12 +22,13 @@ import Gargantext.Components.Charts.Options.Data (dataSerie) ...@@ -21,12 +22,13 @@ import Gargantext.Components.Charts.Options.Data (dataSerie)
import Gargantext.Components.Nodes.Corpus.Chart.Common (metricsLoadView, metricsWithCacheLoadView) import Gargantext.Components.Nodes.Corpus.Chart.Common (metricsLoadView, metricsWithCacheLoadView)
import Gargantext.Components.Nodes.Corpus.Chart.Types import Gargantext.Components.Nodes.Corpus.Chart.Types
import Gargantext.Components.Nodes.Corpus.Chart.Utils as U import Gargantext.Components.Nodes.Corpus.Chart.Utils as U
import Gargantext.Hooks.Loader (HashedResponse(..))
import Gargantext.Routes (SessionRoute(..)) import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, get) import Gargantext.Sessions (Session, get)
import Gargantext.Types (ChartType(..), TabType) import Gargantext.Types (ChartType(..), TabType)
newtype ChartMetrics = ChartMetrics newtype ChartMetrics = ChartMetrics {
{ "data" :: HistoMetrics "data" :: HistoMetrics
} }
instance decodeChartMetrics :: DecodeJson ChartMetrics where instance decodeChartMetrics :: DecodeJson ChartMetrics where
...@@ -79,12 +81,16 @@ chartOptionsPie (HistoMetrics { dates: dates', count: count'}) = Options ...@@ -79,12 +81,16 @@ chartOptionsPie (HistoMetrics { dates: dates', count: count'}) = Options
} }
getMetrics :: Session -> Tuple Reload (Record Path) -> Aff HistoMetrics getMetrics :: Session -> Tuple Reload (Record Path) -> Aff (HashedResponse HistoMetrics)
getMetrics session (_ /\ { corpusId, limit, listId, tabType }) = do getMetrics session (_ /\ { corpusId, limit, listId, tabType }) = do
ChartMetrics ms <- get session chart HashedResponse { md5, value: ChartMetrics ms } <- get session chart
pure ms."data" pure $ HashedResponse { md5, value: ms."data" }
where chart = Chart {chartType: ChartPie, limit, listId, tabType} (Just corpusId) where chart = Chart {chartType: ChartPie, limit, listId, tabType} (Just corpusId)
getMetricsMD5 :: Session -> Tuple Reload (Record Path) -> Aff String
getMetricsMD5 session (_ /\ { corpusId, limit, listId, tabType }) = do
get session $ ChartMD5 { chartType: ChartPie, listId, tabType } (Just corpusId)
pie :: Record Props -> R.Element pie :: Record Props -> R.Element
pie props = R.createElement pieCpt props [] pie props = R.createElement pieCpt props []
...@@ -94,7 +100,7 @@ pieCpt = R.hooksComponent "G.C.N.C.C.P.pie" cpt ...@@ -94,7 +100,7 @@ pieCpt = R.hooksComponent "G.C.N.C.C.P.pie" cpt
cpt {path,session} _ = do cpt {path,session} _ = do
reload <- R.useState' 0 reload <- R.useState' 0
--pure $ metricsLoadView {getMetrics, loaded: loadedPie, path, reload, session} --pure $ metricsLoadView {getMetrics, loaded: loadedPie, path, reload, session}
pure $ metricsWithCacheLoadView {getMetrics, loaded: loadedPie, path, reload, session} pure $ metricsWithCacheLoadView { getMetrics, getMetricsMD5, keyFunc: const "pie", loaded: loadedPie, path, reload, session }
loadedPie :: Session -> Record Path -> R.State Reload -> HistoMetrics -> R.Element loadedPie :: Session -> Record Path -> R.State Reload -> HistoMetrics -> R.Element
loadedPie session path reload loaded = loadedPie session path reload loaded =
...@@ -114,7 +120,7 @@ barCpt = R.hooksComponent "LoadedMetricsBar" cpt ...@@ -114,7 +120,7 @@ barCpt = R.hooksComponent "LoadedMetricsBar" cpt
cpt {path, session} _ = do cpt {path, session} _ = do
reload <- R.useState' 0 reload <- R.useState' 0
--pure $ metricsLoadView {getMetrics, loaded: loadedBar, path, reload, session} --pure $ metricsLoadView {getMetrics, loaded: loadedBar, path, reload, session}
pure $ metricsWithCacheLoadView {getMetrics, loaded: loadedBar, path, reload, session} pure $ metricsWithCacheLoadView { getMetrics, getMetricsMD5, keyFunc: const "bar", loaded: loadedBar, path, reload, session }
loadedBar :: Session -> Record Path -> R.State Reload -> Loaded -> R.Element loadedBar :: Session -> Record Path -> R.State Reload -> Loaded -> R.Element
loadedBar session path reload loaded = loadedBar session path reload loaded =
......
...@@ -12,10 +12,8 @@ import Gargantext.Components.Nodes.Corpus.Chart.Histo (histo) ...@@ -12,10 +12,8 @@ import Gargantext.Components.Nodes.Corpus.Chart.Histo (histo)
import Gargantext.Components.Nodes.Corpus.Chart.Metrics (metrics) import Gargantext.Components.Nodes.Corpus.Chart.Metrics (metrics)
import Gargantext.Components.Nodes.Corpus.Chart.Pie (pie) import Gargantext.Components.Nodes.Corpus.Chart.Pie (pie)
import Gargantext.Components.Nodes.Corpus.Chart.Tree (tree) import Gargantext.Components.Nodes.Corpus.Chart.Tree (tree)
import Gargantext.Prelude
import Gargantext.Sessions (Session) import Gargantext.Sessions (Session)
import Gargantext.Types (NodeID, Mode(..), TabSubType(..), TabType(..), modeTabType) import Gargantext.Types (NodeID, Mode(..), TabSubType(..), TabType(..), modeTabType)
import Reactix as R
data PredefinedChart = data PredefinedChart =
......
...@@ -17,12 +17,13 @@ import Gargantext.Components.Charts.Options.Font (mkTooltip, templateFormatter) ...@@ -17,12 +17,13 @@ import Gargantext.Components.Charts.Options.Font (mkTooltip, templateFormatter)
import Gargantext.Components.Nodes.Corpus.Chart.Utils as U import Gargantext.Components.Nodes.Corpus.Chart.Utils as U
import Gargantext.Components.Nodes.Corpus.Chart.Common (metricsLoadView, metricsWithCacheLoadView) import Gargantext.Components.Nodes.Corpus.Chart.Common (metricsLoadView, metricsWithCacheLoadView)
import Gargantext.Components.Nodes.Corpus.Chart.Types import Gargantext.Components.Nodes.Corpus.Chart.Types
import Gargantext.Hooks.Loader (HashedResponse(..))
import Gargantext.Routes (SessionRoute(..)) import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, get) import Gargantext.Sessions (Session, get)
import Gargantext.Types (ChartType(..), TabType) import Gargantext.Types (ChartType(..), TabType)
newtype Metrics = Metrics newtype Metrics = Metrics {
{ "data" :: Array TreeNode "data" :: Array TreeNode
} }
instance decodeMetrics :: DecodeJson Metrics where instance decodeMetrics :: DecodeJson Metrics where
...@@ -30,7 +31,6 @@ instance decodeMetrics :: DecodeJson Metrics where ...@@ -30,7 +31,6 @@ instance decodeMetrics :: DecodeJson Metrics where
obj <- decodeJson json obj <- decodeJson json
d <- obj .: "data" d <- obj .: "data"
pure $ Metrics { "data": d } pure $ Metrics { "data": d }
instance encodeMetrics :: EncodeJson Metrics where instance encodeMetrics :: EncodeJson Metrics where
encodeJson (Metrics { "data": d }) = encodeJson (Metrics { "data": d }) =
"data" := encodeJson d "data" := encodeJson d
...@@ -52,13 +52,17 @@ scatterOptions nodes = Options ...@@ -52,13 +52,17 @@ scatterOptions nodes = Options
} }
getMetrics :: Session -> Tuple Reload (Record Path) -> Aff Loaded getMetrics :: Session -> Tuple Reload (Record Path) -> Aff (HashedResponse Loaded)
getMetrics session (_ /\ { corpusId, limit, listId, tabType }) = do getMetrics session (_ /\ { corpusId, limit, listId, tabType }) = do
Metrics ms <- get session chart HashedResponse { md5, value: Metrics ms } <- get session chart
pure ms."data" pure $ HashedResponse { md5, value: ms."data" }
where where
chart = Chart {chartType : ChartTree, limit, listId, tabType} (Just corpusId) chart = Chart {chartType : ChartTree, limit, listId, tabType} (Just corpusId)
getMetricsMD5 :: Session -> Tuple Reload (Record Path) -> Aff String
getMetricsMD5 session (_ /\ { corpusId, limit, listId, tabType }) = do
get session $ ChartMD5 { chartType: ChartTree, listId, tabType } (Just corpusId)
tree :: Record Props -> R.Element tree :: Record Props -> R.Element
tree props = R.createElement treeCpt props [] tree props = R.createElement treeCpt props []
...@@ -68,7 +72,7 @@ treeCpt = R.hooksComponent "G.C.N.C.C.T.tree" cpt ...@@ -68,7 +72,7 @@ treeCpt = R.hooksComponent "G.C.N.C.C.T.tree" cpt
cpt {path, session} _ = do cpt {path, session} _ = do
reload <- R.useState' 0 reload <- R.useState' 0
--pure $ metricsLoadView {getMetrics, loaded, path, reload, session} --pure $ metricsLoadView {getMetrics, loaded, path, reload, session}
pure $ metricsWithCacheLoadView {getMetrics, loaded, path, reload, session} pure $ metricsWithCacheLoadView { getMetrics, getMetricsMD5, keyFunc: const "tree", loaded, path, reload, session }
loaded :: Session -> Record Path -> R.State Reload -> Loaded -> R.Element loaded :: Session -> Record Path -> R.State Reload -> Loaded -> R.Element
loaded session path reload loaded = loaded session path reload loaded =
......
...@@ -185,6 +185,11 @@ sessionPath (R.CorpusMetrics { listId, limit, tabType} i) = ...@@ -185,6 +185,11 @@ sessionPath (R.CorpusMetrics { listId, limit, tabType} i) =
<> "?ngrams=" <> show listId <> "?ngrams=" <> show listId
<> "&ngramsType=" <> showTabType' tabType <> "&ngramsType=" <> showTabType' tabType
<> maybe "" limitUrl limit <> maybe "" limitUrl limit
sessionPath (R.CorpusMetricsMD5 { listId, tabType} i) =
sessionPath $ R.NodeAPI Corpus i
$ "metrics/md5"
<> "?ngrams=" <> show listId
<> "&ngramsType=" <> showTabType' tabType
-- TODO fix this url path -- TODO fix this url path
sessionPath (R.Chart {chartType, listId, limit, tabType} i) = sessionPath (R.Chart {chartType, listId, limit, tabType} i) =
sessionPath $ R.NodeAPI Corpus i sessionPath $ R.NodeAPI Corpus i
...@@ -197,6 +202,12 @@ sessionPath (R.Chart {chartType, listId, limit, tabType} i) = ...@@ -197,6 +202,12 @@ sessionPath (R.Chart {chartType, listId, limit, tabType} i) =
Just li -> "&limit=" <> show li Just li -> "&limit=" <> show li
Nothing -> "" Nothing -> ""
-- <> maybe "" limitUrl limit -- <> maybe "" limitUrl limit
sessionPath (R.ChartMD5 { chartType, listId, tabType } i) =
sessionPath $ R.NodeAPI Corpus i
$ show chartType
<> "/md5?ngramsType=" <> showTabType' tabType
<> "&listType=GraphTerm" -- <> show listId
<> "&listId=" <> show listId
-- sessionPath (R.NodeAPI (NodeContact s a i) i) = sessionPath $ "annuaire/" <> show a <> "/contact/" <> show i -- sessionPath (R.NodeAPI (NodeContact s a i) i) = sessionPath $ "annuaire/" <> show a <> "/contact/" <> show i
------- misc routing stuff ------- misc routing stuff
......
module Gargantext.Hooks.Loader where module Gargantext.Hooks.Loader where
import Gargantext.Prelude import Gargantext.Prelude
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson) import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson, (.:), (:=), (~>), jsonEmptyObject)
import Data.Argonaut.Core (stringify) import Data.Argonaut.Core (stringify)
import Data.Argonaut.Parser (jsonParser) import Data.Argonaut.Parser (jsonParser)
import Data.Either (Either(..)) import Data.Either (Either(..))
...@@ -9,7 +9,7 @@ import Data.Maybe (Maybe(..), isJust, maybe) ...@@ -9,7 +9,7 @@ import Data.Maybe (Maybe(..), isJust, maybe)
import Data.Tuple (fst) import Data.Tuple (fst)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import DOM.Simple.Console (log2) import DOM.Simple.Console (log2)
import Effect.Aff (Aff) import Effect.Aff (Aff, launchAff_)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import Reactix as R import Reactix as R
import Web.Storage.Storage as WSS import Web.Storage.Storage as WSS
...@@ -44,48 +44,93 @@ useLoaderEffect path state@(state' /\ setState) loader = do ...@@ -44,48 +44,93 @@ useLoaderEffect path state@(state' /\ setState) loader = do
liftEffect $ setState $ const $ Just l liftEffect $ setState $ const $ Just l
newtype HashedResponse a = HashedResponse {
md5 :: String
, value :: a
}
instance decodeHashedResponse :: DecodeJson a => DecodeJson (HashedResponse a) where
decodeJson json = do
obj <- decodeJson json
md5 <- obj .: "md5"
value <- obj .: "value"
pure $ HashedResponse { md5, value }
instance encodeHashedResponse :: EncodeJson a => EncodeJson (HashedResponse a) where
encodeJson (HashedResponse { md5, value }) = do
"md5" := encodeJson md5
~> "value" := encodeJson value
~> jsonEmptyObject
useLoaderWithCache :: forall path st. Eq path => DecodeJson st => EncodeJson st => useLoaderWithCache :: forall path st. Eq path => DecodeJson st => EncodeJson st =>
path path
-> (path -> String) -> (path -> String)
-> (path -> Aff st) -> (path -> Aff String)
-> (path -> Aff (HashedResponse st))
-> (st -> R.Element) -> R.Hooks R.Element -> (st -> R.Element) -> R.Hooks R.Element
useLoaderWithCache path keyFunc loader render = do useLoaderWithCache path keyFunc md5Endpoint loader render = do
state <- R.useState' Nothing state <- R.useState' Nothing
useCachedLoaderEffect path keyFunc state loader useCachedLoaderEffect path keyFunc md5Endpoint state loader
pure $ maybe (loadingSpinner {}) render (fst state) pure $ maybe (loadingSpinner {}) render (fst state)
useCachedLoaderEffect :: forall path st. Eq path => DecodeJson st => EncodeJson st => useCachedLoaderEffect :: forall path st. Eq path => DecodeJson st => EncodeJson st =>
path path
-> (path -> String) -> (path -> String)
-> (path -> Aff String)
-> R.State (Maybe st) -> R.State (Maybe st)
-> (path -> Aff st) -> (path -> Aff (HashedResponse st))
-> R.Hooks Unit -> R.Hooks Unit
useCachedLoaderEffect path keyFunc state@(state' /\ setState) loader = do useCachedLoaderEffect path keyFunc md5Endpoint state@(state' /\ setState) loader = do
oPath <- R.useRef path oPath <- R.useRef path
R.useEffect' $ do R.useEffect' $ do
if (R.readRef oPath == path) && (isJust state') then if (R.readRef oPath == path) && (isJust state') then
pure $ pure unit pure unit
else do else do
R.setRef oPath path R.setRef oPath path
let key = keyFunc path let key = "loader--" <> (keyFunc path)
-- log2 "[useCachedLoader] key" key
let keyMD5 = key <> "-md5"
localStorage <- R2.getls localStorage <- R2.getls
mState <- WSS.getItem key localStorage mState <- WSS.getItem key localStorage
case mState of mMD5 <- WSS.getItem keyMD5 localStorage
Nothing -> pure unit -- log2 "[useCachedLoader] mState" mState
Just stStr -> launchAff_ $ do
case (parse stStr >>= decode) of case mState of
Left err -> pure unit Nothing -> loadRealData key keyMD5 localStorage
Right st -> setState $ const $ Just st Just stStr -> do
let parsed = parse stStr >>= decode
R2.affEffect "G.H.Loader.useCachedLoaderEffect" $ do case parsed of
l <- loader path Left err -> do
liftEffect $ do -- liftEffect $ log2 "[useCachedLoader] err" err
let value = stringify $ encodeJson l loadRealData key keyMD5 localStorage
WSS.setItem key value localStorage Right (st :: st) -> do
setState $ const $ Just l md5Real <- md5Endpoint path
-- liftEffect $ log2 "[useCachedLoader] md5Real" md5Real
case mMD5 of
Nothing -> do
-- liftEffect $ log2 "[useCachedLoader] no stored md5" Nothing
loadRealData key keyMD5 localStorage
Just md5 -> do
-- liftEffect $ log2 "[useCachedLoader] stored md5" md5
if md5 == md5Real then
-- yay! cache hit!
liftEffect $ setState $ const $ Just st
else
loadRealData key keyMD5 localStorage
where where
parse s = GU.mapLeft (log2 "Error parsing serialised sessions:") (jsonParser s) loadRealData :: String -> String -> WSS.Storage -> Aff Unit
decode j = GU.mapLeft (log2 "Error decoding serialised sessions:") (decodeJson j) loadRealData key keyMD5 localStorage = do
--R2.affEffect "G.H.Loader.useCachedLoaderEffect" $ do
HashedResponse { md5, value: l } <- loader path
liftEffect $ do
let value = stringify $ encodeJson l
WSS.setItem key value localStorage
WSS.setItem keyMD5 md5 localStorage
setState $ const $ Just l
pure unit
parse s = GU.mapLeft (\err -> "Error parsing serialised sessions:" <> show err) (jsonParser s)
decode j = GU.mapLeft (\err -> "Error decoding serialised sessions:" <> show err) (decodeJson j)
...@@ -44,7 +44,9 @@ data SessionRoute ...@@ -44,7 +44,9 @@ data SessionRoute
| ListDocument (Maybe ListId) (Maybe Id) | ListDocument (Maybe ListId) (Maybe Id)
| Search SearchOpts (Maybe Id) | Search SearchOpts (Maybe Id)
| CorpusMetrics CorpusMetricOpts (Maybe Id) | CorpusMetrics CorpusMetricOpts (Maybe Id)
| CorpusMetricsMD5 { listId :: ListId, tabType :: TabType } (Maybe Id)
| Chart ChartOpts (Maybe Id) | Chart ChartOpts (Maybe Id)
| ChartMD5 { chartType :: ChartType, listId :: ListId, tabType :: TabType } (Maybe Id)
instance showAppRoute :: Show AppRoute where instance showAppRoute :: Show AppRoute where
show Home = "Home" show Home = "Home"
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment