Commit 704d818d authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

[cache] CacheAPI functional now, used in list charts

parent e9ebfbad
...@@ -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 =
......
...@@ -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.Element , mkRequest :: ReloadPath -> GUC.Request
| 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 } }
...@@ -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 }
......
...@@ -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
loaded :: Session -> Record Path -> R.State Reload -> Loaded -> R.Element , path
loaded session path reload loaded = , reload
, session
}
loaded :: Record MetricsProps -> Loaded -> R.Element
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 }
......
...@@ -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
loadedPie :: Session -> Record Path -> R.State Reload -> HistoMetrics -> R.Element , loaded: loadedPie
loadedPie session path reload loaded = , mkRequest: mkRequest session
, path
, reload
, session
}
loadedPie :: Record MetricsProps -> HistoMetrics -> R.Element
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
loadedBar :: Session -> Record Path -> R.State Reload -> Loaded -> R.Element , handleResponse
loadedBar session path reload loaded = , loaded: loadedPie
, mkRequest: mkRequest session
, path
, reload
, session
}
loadedBar :: Record MetricsProps -> Loaded -> R.Element
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 }
......
...@@ -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 }
......
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)
...@@ -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
...@@ -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
<> "&listId=" <> 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
<> "&listId=" <> 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
......
...@@ -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
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) { exports._add = function(cache) {
onCancelerSuccess(); 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);
} }
} }
} }
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)
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