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)
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 =
......
......@@ -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.Element
type MetricsWithCacheLoadViewProps res ret = (
getMetricsMD5 :: Session -> ReloadPath -> Aff MD5
, handleResponse :: HashedResponse res -> ret
, loaded :: Record MetricsProps -> ret -> R.Element
, mkRequest :: ReloadPath -> GUC.Request
| 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 } }
......@@ -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 }
......
......@@ -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 }
......
......@@ -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 }
......
......@@ -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 }
......
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)
......@@ -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
......@@ -202,7 +202,7 @@ sessionPath (R.Chart {chartType, listId, limit, tabType} i) =
$ show chartType
<> "?ngramsType=" <> showTabType' tabType
<> "&listType=MapTerm" -- <> show listId
<> "&listId=" <> 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
<> "&listId=" <> show listId
<> "&list=" <> show listId
-- sessionPath (R.NodeAPI (NodeContact s a i) i) = sessionPath $ "annuaire/" <> show a <> "/contact/" <> show i
------- misc routing stuff
......
......@@ -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
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);
}
}
}
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)
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