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
704d818d
Commit
704d818d
authored
Jul 07, 2020
by
Przemyslaw Kaminski
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[cache] CacheAPI functional now, used in list charts
parent
e9ebfbad
Changes
12
Show whitespace changes
Inline
Side-by-side
Showing
12 changed files
with
329 additions
and
113 deletions
+329
-113
Tree.purs
src/Gargantext/Components/Forest/Tree.purs
+5
-4
Common.purs
src/Gargantext/Components/Nodes/Corpus/Chart/Common.purs
+26
-18
Histo.purs
src/Gargantext/Components/Nodes/Corpus/Chart/Histo.purs
+28
-11
Metrics.purs
src/Gargantext/Components/Nodes/Corpus/Chart/Metrics.purs
+29
-13
Pie.purs
src/Gargantext/Components/Nodes/Corpus/Chart/Pie.purs
+40
-15
Tree.purs
src/Gargantext/Components/Nodes/Corpus/Chart/Tree.purs
+27
-10
Types.purs
src/Gargantext/Components/Nodes/Corpus/Chart/Types.purs
+3
-0
REST.purs
src/Gargantext/Config/REST.purs
+1
-9
Ends.purs
src/Gargantext/Ends.purs
+2
-2
Loader.purs
src/Gargantext/Hooks/Loader.purs
+76
-2
CacheAPI.js
src/Gargantext/Utils/CacheAPI.js
+12
-24
CacheAPI.purs
src/Gargantext/Utils/CacheAPI.purs
+80
-5
No files found.
src/Gargantext/Components/Forest/Tree.purs
View file @
704d818d
...
@@ -8,6 +8,11 @@ import Data.Tuple (Tuple(..), fst, snd)
...
@@ -8,6 +8,11 @@ import Data.Tuple (Tuple(..), fst, snd)
import Data.Tuple.Nested ((/\))
import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff)
import Effect.Aff (Aff)
import Effect.Class (liftEffect)
import Effect.Class (liftEffect)
import Reactix as R
import Reactix.DOM.HTML as H
import Record as Record
import Record.Extra as RecordE
import Gargantext.AsyncTasks as GAT
import Gargantext.AsyncTasks as GAT
import Gargantext.Components.Forest.Tree.Node (nodeMainSpan)
import Gargantext.Components.Forest.Tree.Node (nodeMainSpan)
import Gargantext.Components.Forest.Tree.Node.Tools.SubTree.Types (SubTreeOut(..))
import Gargantext.Components.Forest.Tree.Node.Tools.SubTree.Types (SubTreeOut(..))
...
@@ -31,10 +36,6 @@ import Gargantext.Sessions (OpenNodes, Session, mkNodeId, get)
...
@@ -31,10 +36,6 @@ import Gargantext.Sessions (OpenNodes, Session, mkNodeId, get)
import Gargantext.Types (ID, Reload)
import Gargantext.Types (ID, Reload)
import Gargantext.Types as GT
import Gargantext.Types as GT
import Gargantext.Routes as GR
import Gargantext.Routes as GR
import Reactix as R
import Reactix.DOM.HTML as H
import Record as Record
import Record.Extra as RecordE
------------------------------------------------------------------------
------------------------------------------------------------------------
type CommonProps =
type CommonProps =
...
...
src/Gargantext/Components/Nodes/Corpus/Chart/Common.purs
View file @
704d818d
...
@@ -8,13 +8,14 @@ import Reactix as R
...
@@ -8,13 +8,14 @@ import Reactix as R
import Gargantext.Prelude
import Gargantext.Prelude
import Gargantext.Components.Nodes.Corpus.Chart.Types
import Gargantext.Components.Nodes.Corpus.Chart.Types
(Reload, Path, Props, MetricsProps, ReloadPath)
import Gargantext.Hooks.Loader (
HashedResponse, useLoader, useLoaderWithCache
)
import Gargantext.Hooks.Loader (
MD5, HashedResponse, useLoader, useLoaderWithCache, useLoaderWithCacheAPI
)
import Gargantext.Sessions (Session)
import Gargantext.Sessions (Session)
import Gargantext.Utils.CacheAPI as GUC
type MetricsLoadViewProps a = (
type MetricsLoadViewProps a = (
getMetrics :: Session ->
Tuple Reload (Record Path)
-> Aff a
getMetrics :: Session ->
ReloadPath
-> Aff a
, loaded ::
Session -> Record Path -> R.State Reload
-> a -> R.Element
, loaded ::
Record MetricsProps
-> a -> R.Element
| MetricsProps
| MetricsProps
)
)
...
@@ -29,25 +30,32 @@ metricsLoadViewCpt = R.hooksComponent "G.C.N.C.C.metricsLoadView" cpt
...
@@ -29,25 +30,32 @@ 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
{ path, reload, session }
l
type MetricsWithCacheLoadViewProps
a
= (
type MetricsWithCacheLoadViewProps
res ret
= (
keyFunc :: Tuple Reload (Record Path) -> String
getMetricsMD5 :: Session -> ReloadPath -> Aff MD5
,
getMetrics :: Session -> Tuple Reload (Record Path) -> Aff (HashedResponse a)
,
handleResponse :: HashedResponse res -> ret
,
getMetricsMD5 :: Session -> Tuple Reload (Record Path) -> Aff String
,
loaded :: Record MetricsProps -> ret -> R.Element
,
loaded :: Session -> Record Path -> R.State Reload -> a -> R.Elemen
t
,
mkRequest :: ReloadPath -> GUC.Reques
t
| MetricsProps
| MetricsProps
)
)
metricsWithCacheLoadView :: forall
a. DecodeJson a => EncodeJson a
=>
metricsWithCacheLoadView :: forall
res ret. DecodeJson res
=>
Record (MetricsWithCacheLoadViewProps
a
) -> R.Element
Record (MetricsWithCacheLoadViewProps
res ret
) -> R.Element
metricsWithCacheLoadView p = R.createElement metricsWithCacheLoadViewCpt p []
metricsWithCacheLoadView p = R.createElement metricsWithCacheLoadViewCpt p []
metricsWithCacheLoadViewCpt :: forall a. DecodeJson a => EncodeJson a => R.Component (MetricsWithCacheLoadViewProps a)
metricsWithCacheLoadViewCpt :: forall res ret. DecodeJson res =>
R.Component (MetricsWithCacheLoadViewProps res ret)
metricsWithCacheLoadViewCpt = R.hooksComponent "G.C.N.C.C.metricsWithCacheLoadView" cpt
metricsWithCacheLoadViewCpt = R.hooksComponent "G.C.N.C.C.metricsWithCacheLoadView" cpt
where
where
cpt { getMetrics, getMetricsMD5, keyFunc, loaded, path, reload, session } _ = do
cpt { getMetricsMD5, handleResponse, loaded, mkRequest, path, reload, session } _ = do
useLoaderWithCache (fst reload /\ path) (metricsKeyFunc keyFunc) (getMetricsMD5 session) (getMetrics session) $ \l ->
-- useLoaderWithCache (fst reload /\ path) (metricsKeyFunc keyFunc) (getMetricsMD5 session) (getMetrics session) $ \l ->
loaded session path reload l
-- loaded session path reload l
metricsKeyFunc keyFunc st@(_ /\ { corpusId, listId, tabType }) =
-- metricsKeyFunc keyFunc st@(_ /\ { corpusId, listId, tabType }) =
"metrics-" <> (show tabType) <> "-" <> (show corpusId) <> "-" <> (show listId) <> "--" <> (keyFunc st)
-- "metrics-" <> (show tabType) <> "-" <> (show corpusId) <> "-" <> (show listId) <> "--" <> (keyFunc st)
useLoaderWithCacheAPI { cacheEndpoint: (getMetricsMD5 session)
, handleResponse
, mkRequest
, path: (fst reload /\ path)
, renderer: loaded { path, reload, session } }
src/Gargantext/Components/Nodes/Corpus/Chart/Histo.purs
View file @
704d818d
...
@@ -23,6 +23,7 @@ import Gargantext.Hooks.Loader (HashedResponse(..))
...
@@ -23,6 +23,7 @@ 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(..))
import Gargantext.Utils.CacheAPI as GUC
newtype ChartMetrics = ChartMetrics {
newtype ChartMetrics = ChartMetrics {
"data" :: HistoMetrics
"data" :: HistoMetrics
...
@@ -61,30 +62,46 @@ chartOptions (HistoMetrics { dates: dates', count: count'}) = Options
...
@@ -61,30 +62,46 @@ 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 (HashedResponse HistoMetrics)
--
getMetrics :: Session -> Tuple Reload (Record Path) -> Aff (HashedResponse HistoMetrics)
getMetrics session (_ /\ { corpusId, limit, listId, tabType }) = do
--
getMetrics session (_ /\ { corpusId, limit, listId, tabType }) = do
HashedResponse { md5, value: ChartMetrics ms } <- get session chart
--
HashedResponse { md5, value: ChartMetrics ms } <- get session chart
pure $ HashedResponse { md5, value: 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 -> Tuple Reload (Record Path) -> Aff String
getMetricsMD5 session (_ /\ { corpusId, limit, listId, tabType }) = do
getMetricsMD5 session (_ /\ { corpusId, limit, listId, tabType }) = do
get session $ ChartMD5 { chartType: Histo, listId, tabType } (Just corpusId)
get session $ ChartMD5 { chartType: Histo, listId, tabType } (Just corpusId)
chartUrl :: Record Path -> SessionRoute
chartUrl { corpusId, limit, listId, tabType } = Chart {chartType: Histo, limit, listId, tabType} (Just corpusId)
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
histo :: Record Props -> R.Element
histo :: Record Props -> R.Element
histo props = R.createElement histoCpt props []
histo props = R.createElement histoCpt props []
histoCpt :: R.Component Props
histoCpt :: R.Component Props
histoCpt = R.hooksComponent "G.C.N.C.C.H.histo" cpt
histoCpt = R.hooksComponent "G.C.N.C.C.H.histo" cpt
where
where
cpt {
path, session
} _ = do
cpt {
path, session
} _ = do
reload <- R.useState' 0
reload <- R.useState' 0
--pure $ metricsLoadView {getMetrics, loaded, path, reload, session}
pure $ metricsWithCacheLoadView {
pure $ metricsWithCacheLoadView { getMetrics, getMetricsMD5, keyFunc: const "histo", loaded, path, reload, session }
getMetricsMD5
, handleResponse
, loaded
, mkRequest: mkRequest session
, path
, reload
, session
}
loaded ::
Session -> Record Path -> R.State Reload
-> HistoMetrics -> R.Element
loaded ::
Record MetricsProps
-> HistoMetrics -> R.Element
loaded
session path reload
loaded =
loaded
{ path, reload, session }
loaded =
H.div {} [
H.div {} [
U.reloadButton reload
U.reloadButton reload
, U.chartUpdateButton { chartType: Histo, path, reload, session }
, U.chartUpdateButton { chartType: Histo, path, reload, session }
...
...
src/Gargantext/Components/Nodes/Corpus/Chart/Metrics.purs
View file @
704d818d
...
@@ -26,6 +26,7 @@ import Gargantext.Hooks.Loader (HashedResponse(..))
...
@@ -26,6 +26,7 @@ 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(..))
import Gargantext.Utils.CacheAPI as GUC
newtype Metric = Metric
newtype Metric = Metric
{ label :: String
{ label :: String
...
@@ -97,17 +98,26 @@ scatterOptions metrics' = Options
...
@@ -97,17 +98,26 @@ scatterOptions metrics' = Options
}
}
--}
--}
getMetrics :: Session -> Tuple Reload (Record Path) -> Aff (HashedResponse Loaded)
--
getMetrics :: Session -> Tuple Reload (Record Path) -> Aff (HashedResponse Loaded)
getMetrics session (_ /\ { corpusId, limit, listId, tabType }) = do
--
getMetrics session (_ /\ { corpusId, limit, listId, tabType }) = do
HashedResponse { md5, value: Metrics ms } <- get session metrics'
--
HashedResponse { md5, value: Metrics ms } <- get session metrics'
pure $ HashedResponse { md5, value: 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 -> Tuple Reload (Record Path) -> Aff String
getMetricsMD5 session (_ /\ { corpusId, listId, tabType }) =
getMetricsMD5 session (_ /\ { corpusId, listId, tabType }) =
get session $ CorpusMetricsMD5 { listId, tabType } (Just corpusId)
get session $ CorpusMetricsMD5 { listId, tabType } (Just corpusId)
chartUrl :: Record Path -> SessionRoute
chartUrl { corpusId, limit, listId, tabType } = CorpusMetrics { limit, listId, tabType } (Just corpusId)
handleResponse :: HashedResponse Metrics -> Loaded
handleResponse (HashedResponse { value: Metrics ms }) = ms."data"
mkRequest :: Session -> ReloadPath -> GUC.Request
mkRequest session (_ /\ path@{ corpusId, limit, listId, tabType }) = GUC.makeGetRequest session $ chartUrl path
metrics :: Record Props -> R.Element
metrics :: Record Props -> R.Element
metrics props = R.createElement metricsCpt props []
metrics props = R.createElement metricsCpt props []
...
@@ -116,13 +126,19 @@ metricsCpt = R.hooksComponent "G.C.N.C.C.M.metrics" cpt
...
@@ -116,13 +126,19 @@ metricsCpt = R.hooksComponent "G.C.N.C.C.M.metrics" cpt
where
where
cpt {path, session} _ = do
cpt {path, session} _ = do
reload <- R.useState' 0
reload <- R.useState' 0
--pure $ metricsLoadView {getMetrics, loaded, path, reload, session}
pure $ metricsWithCacheLoadView {
getMetricsMD5
pure $ metricsWithCacheLoadView { getMetrics, getMetricsMD5, keyFunc: const "metrics", loaded, path, reload, session }
, handleResponse
, loaded
, mkRequest: mkRequest session
, path
, reload
, session
}
loaded ::
Session -> Record Path -> R.State Reload
-> Loaded -> R.Element
loaded ::
Record MetricsProps
-> Loaded -> R.Element
loaded
session path reload
loaded =
loaded
{ path, reload, session }
loaded =
H.div {} [
H.div {} [
U.reloadButton reload
U.reloadButton reload
, U.chartUpdateButton { chartType: Scatter, path, reload, session }
, U.chartUpdateButton { chartType: Scatter, path, reload, session }
...
...
src/Gargantext/Components/Nodes/Corpus/Chart/Pie.purs
View file @
704d818d
...
@@ -26,6 +26,7 @@ import Gargantext.Hooks.Loader (HashedResponse(..))
...
@@ -26,6 +26,7 @@ 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)
import Gargantext.Utils.CacheAPI as GUC
newtype ChartMetrics = ChartMetrics {
newtype ChartMetrics = ChartMetrics {
"data" :: HistoMetrics
"data" :: HistoMetrics
...
@@ -81,29 +82,45 @@ chartOptionsPie (HistoMetrics { dates: dates', count: count'}) = Options
...
@@ -81,29 +82,45 @@ chartOptionsPie (HistoMetrics { dates: dates', count: count'}) = Options
}
}
getMetrics :: Session -> Tuple Reload (Record Path) -> Aff (HashedResponse HistoMetrics)
--
getMetrics :: Session -> Tuple Reload (Record Path) -> Aff (HashedResponse HistoMetrics)
getMetrics session (_ /\ { corpusId, limit, listId, tabType }) = do
--
getMetrics session (_ /\ { corpusId, limit, listId, tabType }) = do
HashedResponse { md5, value: ChartMetrics ms } <-
get session chart
-- HashedResponse { md5, value: ChartMetrics ms } <- GUC.get session chart --
get session chart
pure $ HashedResponse { md5, value: 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 -> Tuple Reload (Record Path) -> Aff String
getMetricsMD5 session (_ /\ { corpusId, limit, listId, tabType }) = do
getMetricsMD5 session (_ /\ { corpusId, limit, listId, tabType }) = do
get session $ ChartMD5 { chartType: ChartPie, listId, tabType } (Just corpusId)
get session $ ChartMD5 { chartType: ChartPie, listId, tabType } (Just corpusId)
chartUrl :: Record Path -> SessionRoute
chartUrl { corpusId, limit, listId, tabType } = Chart {chartType: ChartPie, limit, listId, tabType} (Just corpusId)
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
pie :: Record Props -> R.Element
pie :: Record Props -> R.Element
pie props = R.createElement pieCpt props []
pie props = R.createElement pieCpt props []
pieCpt :: R.Component Props
pieCpt :: R.Component Props
pieCpt = R.hooksComponent "G.C.N.C.C.P.pie" cpt
pieCpt = R.hooksComponent "G.C.N.C.C.P.pie" cpt
where
where
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 $ metricsWithCacheLoadView {
pure $ metricsWithCacheLoadView { getMetrics, getMetricsMD5, keyFunc: const "pie", loaded: loadedPie, path, reload, session }
getMetricsMD5
, handleResponse
, loaded: loadedPie
, mkRequest: mkRequest session
, path
, reload
, session
}
loadedPie ::
Session -> Record Path -> R.State Reload
-> HistoMetrics -> R.Element
loadedPie ::
Record MetricsProps
-> HistoMetrics -> R.Element
loadedPie
session path reload
loaded =
loadedPie
{ path, reload, session }
loaded =
H.div {} [
H.div {} [
U.reloadButton reload
U.reloadButton reload
, U.chartUpdateButton { chartType: ChartPie, path, reload, session }
, U.chartUpdateButton { chartType: ChartPie, path, reload, session }
...
@@ -120,10 +137,18 @@ barCpt = R.hooksComponent "LoadedMetricsBar" cpt
...
@@ -120,10 +137,18 @@ 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, getMetricsMD5, keyFunc: const "bar", loaded: loadedBar, path, reload, session }
pure $ metricsWithCacheLoadView {
getMetricsMD5
, handleResponse
, loaded: loadedPie
, mkRequest: mkRequest session
, path
, reload
, session
}
loadedBar ::
Session -> Record Path -> R.State Reload
-> Loaded -> R.Element
loadedBar ::
Record MetricsProps
-> Loaded -> R.Element
loadedBar
session path reload
loaded =
loadedBar
{ path, reload, session }
loaded =
H.div {} [
H.div {} [
U.reloadButton reload
U.reloadButton reload
, U.chartUpdateButton { chartType: ChartBar, path, reload, session }
, U.chartUpdateButton { chartType: ChartBar, path, reload, session }
...
...
src/Gargantext/Components/Nodes/Corpus/Chart/Tree.purs
View file @
704d818d
...
@@ -21,6 +21,7 @@ import Gargantext.Hooks.Loader (HashedResponse(..))
...
@@ -21,6 +21,7 @@ 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)
import Gargantext.Utils.CacheAPI as GUC
newtype Metrics = Metrics {
newtype Metrics = Metrics {
"data" :: Array TreeNode
"data" :: Array TreeNode
...
@@ -52,17 +53,26 @@ scatterOptions nodes = Options
...
@@ -52,17 +53,26 @@ scatterOptions nodes = Options
}
}
getMetrics :: Session -> Tuple Reload (Record Path) -> Aff (HashedResponse Loaded)
--
getMetrics :: Session -> Tuple Reload (Record Path) -> Aff (HashedResponse Loaded)
getMetrics session (_ /\ { corpusId, limit, listId, tabType }) = do
--
getMetrics session (_ /\ { corpusId, limit, listId, tabType }) = do
HashedResponse { md5, value: Metrics ms } <-
get session chart
-- HashedResponse { md5, value: Metrics ms } <- GUC.
get session chart
pure $ HashedResponse { md5, value: 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 -> Tuple Reload (Record Path) -> Aff String
getMetricsMD5 session (_ /\ { corpusId, limit, listId, tabType }) = do
getMetricsMD5 session (_ /\ { corpusId, limit, listId, tabType }) = do
get session $ ChartMD5 { chartType: ChartTree, listId, tabType } (Just corpusId)
get session $ ChartMD5 { chartType: ChartTree, listId, tabType } (Just corpusId)
chartUrl :: Record Path -> SessionRoute
chartUrl { corpusId, limit, listId, tabType } = Chart {chartType: ChartTree, limit, listId, tabType} (Just corpusId)
handleResponse :: HashedResponse Metrics -> Loaded
handleResponse (HashedResponse { value: Metrics ms }) = ms."data"
mkRequest :: Session -> ReloadPath -> GUC.Request
mkRequest session (_ /\ path@{ corpusId, limit, listId, tabType }) = GUC.makeGetRequest session $ chartUrl path
tree :: Record Props -> R.Element
tree :: Record Props -> R.Element
tree props = R.createElement treeCpt props []
tree props = R.createElement treeCpt props []
...
@@ -71,11 +81,18 @@ treeCpt = R.hooksComponent "G.C.N.C.C.T.tree" cpt
...
@@ -71,11 +81,18 @@ treeCpt = R.hooksComponent "G.C.N.C.C.T.tree" cpt
where
where
cpt {path, session} _ = do
cpt {path, session} _ = do
reload <- R.useState' 0
reload <- R.useState' 0
--pure $ metricsLoadView {getMetrics, loaded, path, reload, session}
pure $ metricsWithCacheLoadView {
pure $ metricsWithCacheLoadView { getMetrics, getMetricsMD5, keyFunc: const "tree", loaded, path, reload, session }
getMetricsMD5
, handleResponse
, loaded
, mkRequest: mkRequest session
, path
, reload
, session
}
loaded ::
Session -> Record Path -> R.State Reload
-> Loaded -> R.Element
loaded ::
Record MetricsProps
-> Loaded -> R.Element
loaded
session path reload
loaded =
loaded
{ path, reload, session }
loaded =
H.div {} [
H.div {} [
U.reloadButton reload
U.reloadButton reload
, U.chartUpdateButton { chartType: ChartTree, path, reload, session }
, U.chartUpdateButton { chartType: ChartTree, path, reload, session }
...
...
src/Gargantext/Components/Nodes/Corpus/Chart/Types.purs
View file @
704d818d
module Gargantext.Components.Nodes.Corpus.Chart.Types where
module Gargantext.Components.Nodes.Corpus.Chart.Types where
import Data.Maybe (Maybe)
import Data.Maybe (Maybe)
import Data.Tuple (Tuple)
import Reactix as R
import Reactix as R
import Gargantext.Sessions (Session)
import Gargantext.Sessions (Session)
...
@@ -24,3 +25,5 @@ type MetricsProps = (
...
@@ -24,3 +25,5 @@ type MetricsProps = (
reload :: R.State Int
reload :: R.State Int
| Props
| Props
)
)
type ReloadPath = Tuple Reload (Record Path)
src/Gargantext/Config/REST.purs
View file @
704d818d
...
@@ -22,7 +22,6 @@ import Unsafe.Coerce (unsafeCoerce)
...
@@ -22,7 +22,6 @@ import Unsafe.Coerce (unsafeCoerce)
import Web.XHR.FormData as XHRFormData
import Web.XHR.FormData as XHRFormData
import Gargantext.Prelude
import Gargantext.Prelude
import Gargantext.Utils.CacheAPI as GUC
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Reactix as R2
type Token = String
type Token = String
...
@@ -44,14 +43,6 @@ send m mtoken url reqbody = do
...
@@ -44,14 +43,6 @@ send m mtoken url reqbody = do
, content = (Json <<< encodeJson) <$> reqbody
, content = (Json <<< encodeJson) <$> reqbody
}
}
cache <- GUC.openCache $ GUC.CacheName "test"
let method = unsafeCoerce (show m) :: Milkis.Method
let options = { method, headers: Milkis.makeHeaders {"content-type": "application/json"} }
let req' = GUC.makeRequest (Milkis.URL url) options
res <- GUC.cached cache req'
liftEffect $ log2 "[send] cache res" res
liftEffect $ log2 "[send] res json" $ Milkis.json res
affResp <- request req
affResp <- request req
case mtoken of
case mtoken of
Nothing -> pure unit
Nothing -> pure unit
...
@@ -148,3 +139,4 @@ postMultipartFormData mtoken url body = do
...
@@ -148,3 +139,4 @@ postMultipartFormData mtoken url body = do
case decodeJson json of
case decodeJson json of
Left err -> throwError $ error $ "decodeJson affResp.body: " <> err
Left err -> throwError $ error $ "decodeJson affResp.body: " <> err
Right b -> pure b
Right b -> pure b
src/Gargantext/Ends.purs
View file @
704d818d
...
@@ -202,7 +202,7 @@ sessionPath (R.Chart {chartType, listId, limit, tabType} i) =
...
@@ -202,7 +202,7 @@ sessionPath (R.Chart {chartType, listId, limit, tabType} i) =
$ show chartType
$ show chartType
<> "?ngramsType=" <> showTabType' tabType
<> "?ngramsType=" <> showTabType' tabType
<> "&listType=MapTerm" -- <> show listId
<> "&listType=MapTerm" -- <> show listId
<> "&list
Id
=" <> show listId
<> "&list=" <> show listId
where
where
limitPath = case limit of
limitPath = case limit of
Just li -> "&limit=" <> show li
Just li -> "&limit=" <> show li
...
@@ -213,7 +213,7 @@ sessionPath (R.ChartMD5 { chartType, listId, tabType } i) =
...
@@ -213,7 +213,7 @@ sessionPath (R.ChartMD5 { chartType, listId, tabType } i) =
$ show chartType
$ show chartType
<> "/md5?ngramsType=" <> showTabType' tabType
<> "/md5?ngramsType=" <> showTabType' tabType
<> "&listType=GraphTerm" -- <> show listId
<> "&listType=GraphTerm" -- <> show listId
<> "&list
Id
=" <> show listId
<> "&list=" <> 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 @
704d818d
...
@@ -8,15 +8,19 @@ import Data.Maybe (Maybe(..), isJust, maybe)
...
@@ -8,15 +8,19 @@ 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, launchAff_)
import Effect.Aff (Aff, launchAff_
, throwError
)
import Effect.Class (liftEffect)
import Effect.Class (liftEffect)
import Effect.Exception (error)
import Milkis as M
import Reactix as R
import Reactix as R
import Web.Storage.Storage as WSS
import Web.Storage.Storage as WSS
import Gargantext.Prelude
import Gargantext.Prelude
import Gargantext.Components.LoadingSpinner (loadingSpinner)
import Gargantext.Components.LoadingSpinner (loadingSpinner)
import Gargantext.Ends (class ToUrl, toUrl)
import Gargantext.Utils as GU
import Gargantext.Utils as GU
import Gargantext.Utils.CacheAPI as GUC
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Reactix as R2
...
@@ -49,8 +53,11 @@ useLoaderEffect path state@(state' /\ setState) loader = do
...
@@ -49,8 +53,11 @@ useLoaderEffect path state@(state' /\ setState) loader = do
liftEffect $ setState $ const $ Just l
liftEffect $ setState $ const $ Just l
type MD5 = String
newtype HashedResponse a = HashedResponse {
newtype HashedResponse a = HashedResponse {
md5 ::
String
md5 ::
MD5
, value :: a
, value :: a
}
}
...
@@ -149,3 +156,70 @@ useCachedLoaderEffect { cacheEndpoint, keyFunc, loadRealData, path, state: state
...
@@ -149,3 +156,70 @@ useCachedLoaderEffect { cacheEndpoint, keyFunc, loadRealData, path, state: state
where
where
parse s = GU.mapLeft (\err -> "Error parsing serialised sessions:" <> show err) (jsonParser s)
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)
decode j = GU.mapLeft (\err -> "Error decoding serialised sessions:" <> show err) (decodeJson j)
type LoaderWithCacheAPIProps path res ret = (
cacheEndpoint :: path -> Aff MD5
, handleResponse :: HashedResponse res -> ret
, mkRequest :: path -> GUC.Request
, path :: path
, renderer :: ret -> R.Element
)
useLoaderWithCacheAPI :: forall path res ret. Eq path => Show path => DecodeJson res =>
Record (LoaderWithCacheAPIProps path res ret)
-> R.Hooks R.Element
useLoaderWithCacheAPI { cacheEndpoint, handleResponse, mkRequest, path, renderer } = do
state <- R.useState' Nothing
useCachedAPILoaderEffect { cacheEndpoint
, handleResponse
, mkRequest
, path
, state }
pure $ maybe (loadingSpinner {}) renderer (fst state)
type LoaderWithCacheAPIEffectProps path res ret = (
cacheEndpoint :: path -> Aff MD5
, handleResponse :: HashedResponse res -> ret
, mkRequest :: path -> GUC.Request
, path :: path
, state :: R.State (Maybe ret)
)
useCachedAPILoaderEffect :: forall path res ret. Eq path => Show path => DecodeJson res =>
Record (LoaderWithCacheAPIEffectProps path res ret)
-> R.Hooks Unit
useCachedAPILoaderEffect { cacheEndpoint
, handleResponse
, mkRequest
, path
, state: state@(state' /\ setState) } = do
oPath <- R.useRef path
R.useEffect' $ do
if (R.readRef oPath == path) && (isJust state') then
pure unit
else do
R.setRef oPath path
let cacheName = "cache-api-loader"
let req = mkRequest path
let keyCache = "cached-api-md5-" <> (show path)
-- log2 "[useCachedLoader] mState" mState
launchAff_ $ do
cache <- GUC.openCache $ GUC.CacheName cacheName
-- TODO Parallelize?
hr@(HashedResponse { md5, value }) <- GUC.cachedJson cache req
cacheReal <- cacheEndpoint path
val <- if md5 == cacheReal then
pure hr
else do
_ <- GUC.delete cache req
hr@(HashedResponse { md5, value }) <- GUC.cachedJson cache req
if md5 == cacheReal then
pure hr
else
throwError $ error $ "Fetched clean cache but hashes don't match"
liftEffect $ do
setState $ const $ Just $ handleResponse hr
src/Gargantext/Utils/CacheAPI.js
View file @
704d818d
exports
.
_makeRequest
=
function
()
{
exports
.
_makeRequest
=
function
()
{
return
function
(
url
)
{
return
function
(
url
)
{
return
function
(
options
)
{
return
function
(
options
)
{
console
.
log
(
'[_makeRequest] url'
,
url
);
console
.
log
(
'[_makeRequest] options'
,
options
);
return
new
Request
(
url
,
options
);
return
new
Request
(
url
,
options
);
}
}
...
@@ -15,36 +13,26 @@ exports._openCache = function(cacheName) {
...
@@ -15,36 +13,26 @@ exports._openCache = function(cacheName) {
}
}
}
}
exports
.
_
cached
=
function
(
cache
)
{
exports
.
_
delete
=
function
(
cache
)
{
return
function
(
req
)
{
return
function
(
req
)
{
return
function
(
onError
,
onSuccess
)
{
return
function
()
{
cache
.
match
(
req
).
then
(
function
(
res
)
{
cache
.
delete
(
req
);
if
(
res
)
{
console
.
log
(
'[_getC] cache hit with'
,
req
);
onSuccess
(
res
)
}
else
{
cache
.
add
(
req
).
then
(
function
(
res
)
{
console
.
log
(
'[_getC] cache miss with'
,
req
);
onSuccess
(
res
);
},
function
(
err
)
{
onError
(
err
);
})
}
},
function
(
err
)
{
onError
(
err
);
})
return
function
(
cancelError
,
onCancelerError
,
onCancelerSuccess
)
{
onCancelerSuccess
();
}
}
}
}
}
exports
.
_add
=
function
(
cache
)
{
return
function
(
req
)
{
return
function
()
{
return
cache
.
add
(
req
);
}
}
}
}
}
exports
.
_
delete
=
function
(
cache
)
{
exports
.
_
match
=
function
(
cache
)
{
return
function
(
req
)
{
return
function
(
req
)
{
return
function
()
{
return
function
()
{
cache
.
delete
(
req
);
return
cache
.
match
(
req
);
}
}
}
}
}
}
src/Gargantext/Utils/CacheAPI.purs
View file @
704d818d
module Gargantext.Utils.CacheAPI where
module Gargantext.Utils.CacheAPI where
import Control.Monad.Except (runExcept)
import Control.Promise (Promise, toAffE)
import Control.Promise (Promise, toAffE)
import Data.Argonaut (class DecodeJson, decodeJson, class EncodeJson, encodeJson, (:=), (~>), (.:), fromString)
import Data.Either (Either(..))
import Data.Function.Uncurried (Fn3)
import Data.Maybe (Maybe(..))
import Data.Tuple (Tuple(..))
import Data.Tuple (Tuple(..))
import DOM.Simple.Console (log2)
import Effect (Effect)
import Effect (Effect)
import Effect.Aff (Aff)
import Effect.Aff (Aff
, throwError
)
import Effect.Aff.Compat (EffectFnAff, fromEffectFnAff)
import Effect.Aff.Compat (EffectFnAff, fromEffectFnAff)
import Effect.Class (liftEffect)
import Effect.Exception (error)
import Foreign as F
import Foreign.Object as O
import Milkis as M
import Milkis as M
import Type.Row (class Union)
import Type.Row (class Union)
import Gargantext.Prelude
import Gargantext.Prelude
import Gargantext.Ends (class ToUrl, toUrl)
import Gargantext.Sessions (Session(..))
get :: forall a p. DecodeJson a => ToUrl Session p => Cache -> Session -> p -> Aff a
get cache session p = do
let req = makeGetRequest session p
res <- cached cache req
j <- M.json res
case decodeJson (F.unsafeFromForeign j) of
Left err -> throwError $ error $ "decodeJson affResp.body: " <> err
Right b -> pure b
foreign import data Cache :: Type
foreign import data Cache :: Type
foreign import data Request :: Type
foreign import data Request :: Type
newtype CacheName = CacheName String
newtype CacheName = CacheName String
type Token = String
makeRequest :: forall options trash. Union options trash M.Options =>
makeRequest :: forall options trash. Union options trash M.Options =>
M.URL -> { method :: M.Method | options } -> Request
M.URL -> { method :: M.Method
, headers :: M.Headers
| options } -> Request
makeRequest url options = _makeRequest url options
makeRequest url options = _makeRequest url options
makeTokenRequest :: forall options trash. Union options trash M.Options =>
M.URL -> Maybe Token -> { method :: M.Method, headers :: M.Headers | options } -> Request
makeTokenRequest url mToken options = case mToken of
Nothing -> makeRequest url $ options { headers = mkHeaders O.empty }
Just t -> makeRequest url $ options { headers = mkHeaders $ O.singleton "Authorization" $ "Bearer " <> t }
where
defaultOptions = O.fromFoldable [ Tuple "Accept" "application/json"
, Tuple "Content-Type" "application/json" ]
mkHeaders t = O.unions [ options.headers, defaultOptions, t ]
makeGetRequest :: forall p. ToUrl Session p => Session -> p -> Request
makeGetRequest session@(Session { token }) p = makeTokenRequest url (Just token) { method, headers: O.empty }
where
method = M.getMethod
url = M.URL $ toUrl session p
openCache :: CacheName -> Aff Cache
openCache :: CacheName -> Aff Cache
openCache (CacheName cacheName) = toAffE $ _openCache cacheName
openCache (CacheName cacheName) = toAffE $ _openCache cacheName
add :: Cache -> Request -> Aff Unit
add cache req = toAffE $ _add cache req
match :: Cache -> Request -> Aff (Maybe M.Response)
match cache req = do
res <- toAffE $ _match cache req
case runExcept $ F.readNullOrUndefined res of
Left err -> throwError $ error $ show err
Right v -> pure $ F.unsafeFromForeign <$> v
cached :: Cache -> Request -> Aff M.Response
cached :: Cache -> Request -> Aff M.Response
cached cache req = fromEffectFnAff $ _cached cache req
cached cache req = do
mRes <- match cache req
case mRes of
Just res -> do
liftEffect $ log2 "[cached] cache hit" req
pure res
Nothing -> do
liftEffect $ log2 "[cached] cache miss" req
_ <- add cache req
mResFresh <- match cache req
case mResFresh of
Just res -> pure res
Nothing -> throwError $ error $ "Cannot add to cache"
cachedJson :: forall a. DecodeJson a => Cache -> Request -> Aff a
cachedJson cache req = do
res <- cached cache req
liftEffect $ do
log2 "[cachedJson] res" res
j <- M.json res
case decodeJson (F.unsafeFromForeign j) of
Left err -> throwError $ error $ "decodeJson affResp.body: " <> err
Right b -> pure b
delete :: Cache -> Request -> Aff Unit
delete :: Cache -> Request -> Aff Unit
delete cache req = toAffE $ _delete cache req
delete cache req = toAffE $ _delete cache req
foreign import _makeRequest :: forall options trash. Union options trash M.Options =>
foreign import _makeRequest :: forall options trash. Union options trash M.Options =>
M.URL -> { method :: M.Method | options } -> Request
M.URL -> { method :: M.Method
, headers :: M.Headers
| options } -> Request
foreign import _openCache :: String -> Effect (Promise Cache)
foreign import _openCache :: String -> Effect (Promise Cache)
foreign import _cached :: Cache -> Request -> EffectFnAff M.Response
foreign import _delete :: Cache -> Request -> Effect (Promise Unit)
foreign import _delete :: Cache -> Request -> Effect (Promise Unit)
foreign import _add :: Cache -> Request -> Effect (Promise Unit)
foreign import _match :: Cache -> Request -> Effect (Promise F.Foreign)
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