Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
P
purescript-gargantext
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
0
Issues
0
List
Board
Labels
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
Grégoire Locqueville
purescript-gargantext
Commits
a361da8a
Commit
a361da8a
authored
Jun 27, 2020
by
Przemyslaw Kaminski
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[list] HashedResponse with md5 (list chart caching)
parent
df89d465
Changes
10
Hide whitespace changes
Inline
Side-by-side
Showing
10 changed files
with
156 additions
and
74 deletions
+156
-74
Series.purs
src/Gargantext/Components/Charts/Options/Series.purs
+8
-9
Common.purs
src/Gargantext/Components/Nodes/Corpus/Chart/Common.purs
+13
-9
Histo.purs
src/Gargantext/Components/Nodes/Corpus/Chart/Histo.purs
+13
-7
Metrics.purs
src/Gargantext/Components/Nodes/Corpus/Chart/Metrics.purs
+15
-8
Pie.purs
src/Gargantext/Components/Nodes/Corpus/Chart/Pie.purs
+14
-8
Predefined.purs
src/Gargantext/Components/Nodes/Corpus/Chart/Predefined.purs
+0
-2
Tree.purs
src/Gargantext/Components/Nodes/Corpus/Chart/Tree.purs
+11
-7
Ends.purs
src/Gargantext/Ends.purs
+11
-0
Loader.purs
src/Gargantext/Hooks/Loader.purs
+69
-24
Routes.purs
src/Gargantext/Routes.purs
+2
-0
No files found.
src/Gargantext/Components/Charts/Options/Series.purs
View file @
a361da8a
...
@@ -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
...
...
src/Gargantext/Components/Nodes/Corpus/Chart/Common.purs
View file @
a361da8a
...
@@ -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 (Metrics
WithCache
LoadViewProps 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 (Metrics
WithCache
LoadViewProps 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)
src/Gargantext/Components/Nodes/Corpus/Chart/Histo.purs
View file @
a361da8a
...
@@ -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 =
...
...
src/Gargantext/Components/Nodes/Corpus/Chart/Metrics.purs
View file @
a361da8a
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
...
...
src/Gargantext/Components/Nodes/Corpus/Chart/Pie.purs
View file @
a361da8a
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 =
...
...
src/Gargantext/Components/Nodes/Corpus/Chart/Predefined.purs
View file @
a361da8a
...
@@ -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 =
...
...
src/Gargantext/Components/Nodes/Corpus/Chart/Tree.purs
View file @
a361da8a
...
@@ -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 =
...
...
src/Gargantext/Ends.purs
View file @
a361da8a
...
@@ -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
...
...
src/Gargantext/Hooks/Loader.purs
View file @
a361da8a
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)
src/Gargantext/Routes.purs
View file @
a361da8a
...
@@ -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"
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment