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
Hide 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)
import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff)
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.Components.Forest.Tree.Node (nodeMainSpan)
import Gargantext.Components.Forest.Tree.Node.Tools.SubTree.Types (SubTreeOut(..))
...
...
@@ -31,10 +36,6 @@ import Gargantext.Sessions (OpenNodes, Session, mkNodeId, get)
import Gargantext.Types (ID, Reload)
import Gargantext.Types as GT
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 =
...
...
src/Gargantext/Components/Nodes/Corpus/Chart/Common.purs
View file @
704d818d
...
...
@@ -8,13 +8,14 @@ import Reactix as R
import Gargantext.Prelude
import Gargantext.Components.Nodes.Corpus.Chart.Types
import Gargantext.Hooks.Loader (
HashedResponse, useLoader, useLoaderWithCache
)
import Gargantext.Components.Nodes.Corpus.Chart.Types
(Reload, Path, Props, MetricsProps, ReloadPath)
import Gargantext.Hooks.Loader (
MD5, HashedResponse, useLoader, useLoaderWithCache, useLoaderWithCacheAPI
)
import Gargantext.Sessions (Session)
import Gargantext.Utils.CacheAPI as GUC
type MetricsLoadViewProps a = (
getMetrics :: Session ->
Tuple Reload (Record Path)
-> Aff a
, loaded ::
Session -> Record Path -> R.State Reload
-> a -> R.Element
getMetrics :: Session ->
ReloadPath
-> Aff a
, loaded ::
Record MetricsProps
-> a -> R.Element
| MetricsProps
)
...
...
@@ -29,25 +30,32 @@ metricsLoadViewCpt = R.hooksComponent "G.C.N.C.C.metricsLoadView" cpt
where
cpt { getMetrics, loaded, path, reload, session } _ = do
useLoader (fst reload /\ path) (getMetrics session) $ \l ->
loaded
session path reload
l
loaded
{ path, reload, session }
l
type MetricsWithCacheLoadViewProps
a
= (
keyFunc :: Tuple Reload (Record Path) -> String
,
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.Elemen
t
type MetricsWithCacheLoadViewProps
res ret
= (
getMetricsMD5 :: Session -> ReloadPath -> Aff MD5
,
handleResponse :: HashedResponse res -> ret
,
loaded :: Record MetricsProps -> ret -> R.Element
,
mkRequest :: ReloadPath -> GUC.Reques
t
| MetricsProps
)
metricsWithCacheLoadView :: forall
a. DecodeJson a => EncodeJson a
=>
Record (MetricsWithCacheLoadViewProps
a
) -> R.Element
metricsWithCacheLoadView :: forall
res ret. DecodeJson res
=>
Record (MetricsWithCacheLoadViewProps
res ret
) -> R.Element
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
where
cpt { getMetrics, getMetricsMD5, keyFunc, loaded, path, reload, session } _ = do
useLoaderWithCache (fst reload /\ path) (metricsKeyFunc keyFunc) (getMetricsMD5 session) (getMetrics session) $ \l ->
loaded session path reload l
metricsKeyFunc keyFunc st@(_ /\ { corpusId, listId, tabType }) =
"metrics-" <> (show tabType) <> "-" <> (show corpusId) <> "-" <> (show listId) <> "--" <> (keyFunc st)
cpt { getMetricsMD5, handleResponse, loaded, mkRequest, path, reload, session } _ = do
-- useLoaderWithCache (fst reload /\ path) (metricsKeyFunc keyFunc) (getMetricsMD5 session) (getMetrics session) $ \l ->
-- loaded session path reload l
-- metricsKeyFunc keyFunc st@(_ /\ { corpusId, listId, tabType }) =
-- "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(..))
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, get)
import Gargantext.Types (ChartType(..), TabType(..))
import Gargantext.Utils.CacheAPI as GUC
newtype ChartMetrics = ChartMetrics {
"data" :: HistoMetrics
...
...
@@ -61,30 +62,46 @@ chartOptions (HistoMetrics { dates: dates', count: count'}) = Options
, series : [seriesBarD1 {name: "Number of publication / year"} $
map (\n -> dataSerie {value: n, itemStyle : itemStyle {color:grey}}) count'] }
getMetrics :: Session -> Tuple Reload (Record Path) -> Aff (HashedResponse HistoMetrics)
getMetrics session (_ /\ { corpusId, limit, listId, tabType }) = do
HashedResponse { md5, value: ChartMetrics ms } <- get session chart
pure $ HashedResponse { md5, value: ms."data" }
where
chart = Chart {chartType: Histo, listId, tabType, limit} (Just corpusId)
--
getMetrics :: Session -> Tuple Reload (Record Path) -> Aff (HashedResponse HistoMetrics)
--
getMetrics session (_ /\ { corpusId, limit, listId, tabType }) = do
--
HashedResponse { md5, value: ChartMetrics ms } <- get session chart
--
pure $ HashedResponse { md5, value: ms."data" }
--
where
--
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)
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 props = R.createElement histoCpt props []
histoCpt :: R.Component Props
histoCpt = R.hooksComponent "G.C.N.C.C.H.histo" cpt
where
cpt {
path, session
} _ = do
cpt {
path, session
} _ = do
reload <- R.useState' 0
--pure $ metricsLoadView {getMetrics, loaded, path, reload, session}
pure $ metricsWithCacheLoadView { getMetrics, getMetricsMD5, keyFunc: const "histo", loaded, path, reload, session }
pure $ metricsWithCacheLoadView {
getMetricsMD5
, handleResponse
, loaded
, mkRequest: mkRequest session
, path
, reload
, session
}
loaded ::
Session -> Record Path -> R.State Reload
-> HistoMetrics -> R.Element
loaded
session path reload
loaded =
loaded ::
Record MetricsProps
-> HistoMetrics -> R.Element
loaded
{ path, reload, session }
loaded =
H.div {} [
U.reloadButton reload
, 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(..))
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, get)
import Gargantext.Types (ChartType(..), TabType, TermList(..))
import Gargantext.Utils.CacheAPI as GUC
newtype Metric = Metric
{ label :: String
...
...
@@ -97,17 +98,26 @@ scatterOptions metrics' = Options
}
--}
getMetrics :: Session -> Tuple Reload (Record Path) -> Aff (HashedResponse Loaded)
getMetrics session (_ /\ { corpusId, limit, listId, tabType }) = do
HashedResponse { md5, value: Metrics ms } <- get session metrics'
pure $ HashedResponse { md5, value: ms."data" }
where
metrics' = CorpusMetrics {limit, listId, tabType} (Just corpusId)
--
getMetrics :: Session -> Tuple Reload (Record Path) -> Aff (HashedResponse Loaded)
--
getMetrics session (_ /\ { corpusId, limit, listId, tabType }) = do
--
HashedResponse { md5, value: Metrics ms } <- get session metrics'
--
pure $ HashedResponse { md5, value: ms."data" }
--
where
--
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)
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 props = R.createElement metricsCpt props []
...
...
@@ -116,13 +126,19 @@ metricsCpt = R.hooksComponent "G.C.N.C.C.M.metrics" cpt
where
cpt {path, session} _ = do
reload <- R.useState' 0
--pure $ metricsLoadView {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 path reload loaded =
pure $ metricsWithCacheLoadView {
getMetricsMD5
, handleResponse
, loaded
, mkRequest: mkRequest session
, path
, reload
, session
}
loaded :: Record MetricsProps -> Loaded -> R.Element
loaded { path, reload, session } loaded =
H.div {} [
U.reloadButton reload
, 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(..))
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, get)
import Gargantext.Types (ChartType(..), TabType)
import Gargantext.Utils.CacheAPI as GUC
newtype ChartMetrics = ChartMetrics {
"data" :: HistoMetrics
...
...
@@ -81,29 +82,45 @@ chartOptionsPie (HistoMetrics { dates: dates', count: count'}) = Options
}
getMetrics :: Session -> Tuple Reload (Record Path) -> Aff (HashedResponse HistoMetrics)
getMetrics session (_ /\ { corpusId, limit, listId, tabType }) = do
HashedResponse { md5, value: ChartMetrics ms } <-
get session chart
pure $ HashedResponse { md5, value: ms."data" }
where chart = Chart {chartType: ChartPie, limit, listId, tabType} (Just corpusId)
--
getMetrics :: Session -> Tuple Reload (Record Path) -> Aff (HashedResponse HistoMetrics)
--
getMetrics session (_ /\ { corpusId, limit, listId, tabType }) = do
-- HashedResponse { md5, value: ChartMetrics ms } <- GUC.get session chart --
get session chart
--
pure $ HashedResponse { md5, value: ms."data" }
--
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)
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 props = R.createElement pieCpt props []
pieCpt :: R.Component Props
pieCpt = R.hooksComponent "G.C.N.C.C.P.pie" cpt
where
cpt {
path,session
} _ = do
cpt {
path, session
} _ = do
reload <- R.useState' 0
--pure $ metricsLoadView {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 path reload loaded =
pure $ metricsWithCacheLoadView {
getMetricsMD5
, handleResponse
, loaded: loadedPie
, mkRequest: mkRequest session
, path
, reload
, session
}
loadedPie :: Record MetricsProps -> HistoMetrics -> R.Element
loadedPie { path, reload, session } loaded =
H.div {} [
U.reloadButton reload
, U.chartUpdateButton { chartType: ChartPie, path, reload, session }
...
...
@@ -120,10 +137,18 @@ barCpt = R.hooksComponent "LoadedMetricsBar" cpt
cpt {path, session} _ = do
reload <- R.useState' 0
--pure $ metricsLoadView {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 path reload loaded =
pure $ metricsWithCacheLoadView {
getMetricsMD5
, handleResponse
, loaded: loadedPie
, mkRequest: mkRequest session
, path
, reload
, session
}
loadedBar :: Record MetricsProps -> Loaded -> R.Element
loadedBar { path, reload, session } loaded =
H.div {} [
U.reloadButton reload
, 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(..))
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, get)
import Gargantext.Types (ChartType(..), TabType)
import Gargantext.Utils.CacheAPI as GUC
newtype Metrics = Metrics {
"data" :: Array TreeNode
...
...
@@ -52,17 +53,26 @@ scatterOptions nodes = Options
}
getMetrics :: Session -> Tuple Reload (Record Path) -> Aff (HashedResponse Loaded)
getMetrics session (_ /\ { corpusId, limit, listId, tabType }) = do
HashedResponse { md5, value: Metrics ms } <-
get session chart
pure $ HashedResponse { md5, value: ms."data" }
where
chart = Chart {chartType : ChartTree, limit, listId, tabType} (Just corpusId)
--
getMetrics :: Session -> Tuple Reload (Record Path) -> Aff (HashedResponse Loaded)
--
getMetrics session (_ /\ { corpusId, limit, listId, tabType }) = do
-- HashedResponse { md5, value: Metrics ms } <- GUC.
get session chart
--
pure $ HashedResponse { md5, value: ms."data" }
--
where
--
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)
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 props = R.createElement treeCpt props []
...
...
@@ -71,11 +81,18 @@ treeCpt = R.hooksComponent "G.C.N.C.C.T.tree" cpt
where
cpt {path, session} _ = do
reload <- R.useState' 0
--pure $ metricsLoadView {getMetrics, loaded, path, reload, session}
pure $ metricsWithCacheLoadView { getMetrics, getMetricsMD5, keyFunc: const "tree", loaded, path, reload, session }
pure $ metricsWithCacheLoadView {
getMetricsMD5
, handleResponse
, loaded
, mkRequest: mkRequest session
, path
, reload
, session
}
loaded ::
Session -> Record Path -> R.State Reload
-> Loaded -> R.Element
loaded
session path reload
loaded =
loaded ::
Record MetricsProps
-> Loaded -> R.Element
loaded
{ path, reload, session }
loaded =
H.div {} [
U.reloadButton reload
, 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
import Data.Maybe (Maybe)
import Data.Tuple (Tuple)
import Reactix as R
import Gargantext.Sessions (Session)
...
...
@@ -24,3 +25,5 @@ type MetricsProps = (
reload :: R.State Int
| Props
)
type ReloadPath = Tuple Reload (Record Path)
src/Gargantext/Config/REST.purs
View file @
704d818d
...
...
@@ -22,7 +22,6 @@ import Unsafe.Coerce (unsafeCoerce)
import Web.XHR.FormData as XHRFormData
import Gargantext.Prelude
import Gargantext.Utils.CacheAPI as GUC
import Gargantext.Utils.Reactix as R2
type Token = String
...
...
@@ -44,14 +43,6 @@ send m mtoken url reqbody = do
, 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
case mtoken of
Nothing -> pure unit
...
...
@@ -148,3 +139,4 @@ postMultipartFormData mtoken url body = do
case decodeJson json of
Left err -> throwError $ error $ "decodeJson affResp.body: " <> err
Right b -> pure b
src/Gargantext/Ends.purs
View file @
704d818d
...
...
@@ -202,7 +202,7 @@ sessionPath (R.Chart {chartType, listId, limit, tabType} i) =
$ show chartType
<> "?ngramsType=" <> showTabType' tabType
<> "&listType=MapTerm" -- <> show listId
<> "&list
Id
=" <> show listId
<> "&list=" <> show listId
where
limitPath = case limit of
Just li -> "&limit=" <> show li
...
...
@@ -213,7 +213,7 @@ sessionPath (R.ChartMD5 { chartType, listId, tabType } i) =
$ show chartType
<> "/md5?ngramsType=" <> showTabType' tabType
<> "&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
------- misc routing stuff
...
...
src/Gargantext/Hooks/Loader.purs
View file @
704d818d
...
...
@@ -8,15 +8,19 @@ import Data.Maybe (Maybe(..), isJust, maybe)
import Data.Tuple (fst)
import Data.Tuple.Nested ((/\))
import DOM.Simple.Console (log2)
import Effect.Aff (Aff, launchAff_)
import Effect.Aff (Aff, launchAff_
, throwError
)
import Effect.Class (liftEffect)
import Effect.Exception (error)
import Milkis as M
import Reactix as R
import Web.Storage.Storage as WSS
import Gargantext.Prelude
import Gargantext.Components.LoadingSpinner (loadingSpinner)
import Gargantext.Ends (class ToUrl, toUrl)
import Gargantext.Utils as GU
import Gargantext.Utils.CacheAPI as GUC
import Gargantext.Utils.Reactix as R2
...
...
@@ -49,8 +53,11 @@ useLoaderEffect path state@(state' /\ setState) loader = do
liftEffect $ setState $ const $ Just l
type MD5 = String
newtype HashedResponse a = HashedResponse {
md5 ::
String
md5 ::
MD5
, value :: a
}
...
...
@@ -149,3 +156,70 @@ useCachedLoaderEffect { cacheEndpoint, keyFunc, loadRealData, path, state: state
where
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)
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
()
{
return
function
(
url
)
{
return
function
(
options
)
{
console
.
log
(
'[_makeRequest] url'
,
url
);
console
.
log
(
'[_makeRequest] options'
,
options
);
return
new
Request
(
url
,
options
);
}
...
...
@@ -15,36 +13,26 @@ exports._openCache = function(cacheName) {
}
}
exports
.
_
cached
=
function
(
cache
)
{
exports
.
_
delete
=
function
(
cache
)
{
return
function
(
req
)
{
return
function
(
onError
,
onSuccess
)
{
cache
.
match
(
req
).
then
(
function
(
res
)
{
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
()
{
cache
.
delete
(
req
);
}
}
}
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
()
{
cache
.
delete
(
req
);
return
cache
.
match
(
req
);
}
}
}
src/Gargantext/Utils/CacheAPI.purs
View file @
704d818d
module Gargantext.Utils.CacheAPI where
import Control.Monad.Except (runExcept)
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 DOM.Simple.Console (log2)
import Effect (Effect)
import Effect.Aff (Aff)
import Effect.Aff (Aff
, throwError
)
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 Type.Row (class Union)
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 Request :: Type
newtype CacheName = CacheName String
type Token = String
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
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 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 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 req = toAffE $ _delete cache req
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 _cached :: Cache -> Request -> EffectFnAff M.Response
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