Merge branch 'dev-doc-table-optimization' into dev

.psc-package/local/.set/packages.json

@@ -3343,4 +3343,4 @@
     "repo": "https://github.com/paf31/purescript-yargs.git",
     "version": "v4.0.0"
   }
-}
+}
\ No newline at end of file

nix/easy-ps.nix

+{ pkgs ? import ./pinned.nix { } }:
+
+import
+  (
+    pkgs.fetchFromGitHub {
+      owner = "justinwoo";
+      repo = "easy-purescript-nix";
+      rev = "14e7d85431e9f9838d7107d18cb79c7fa534f54e";
+      sha256 = "0lmkppidmhnayv0919990ifdd61f9d23dzjzr8amz7hjgc74yxs0";
+    }
+  ) {
+  inherit pkgs;
+}

nix/generate-packages-json.nix

+#!/usr/bin/env nix-shell
+#!nix-shell ./generate-packages-json.nix --run 'exit'
+{ pkgs ? import ./pinned.nix { } }:
+let
+  easy-dhall = import (
+    pkgs.fetchFromGitHub {
+      owner = "justinwoo";
+      repo = "easy-dhall-nix";
+      rev = "288ee825c326f352a5db194a024bd3e1f2f735b2";
+      sha256 = "12v4ql1nm1famz8r80k1xkkdgj7285vy2vn16iili0qwvz3i98ah";
+    }
+  ) {
+    inherit pkgs;
+  };
+in
+pkgs.mkShell {
+  buildInputs = [ easy-dhall.dhall-simple easy-dhall.dhall-json-simple ];
+
+  shellHook = ''
+    dhall-to-json --file packages.dhall --output ./.psc-package/local/.set/packages.json
+    echo "generated packages.json"
+  '';
+}

nix/generate-purs-packages.nix

+#!/usr/bin/env nix-shell
+#!nix-shell ./generate-purs-packages.nix --run 'exit'
+{ pkgs ? import ./pinned.nix { } }:
+let
+  psc-package-nix = import ./psc-package-nix.nix { inherit pkgs; };
+  purs-project = import ./purs-project.nix { inherit pkgs; };
+  generatePursPackages = import "${psc-package-nix}/nix/generate-purs-packages.nix" {
+    inherit pkgs;
+    inherit (purs-project) packagesJson inputNames;
+  };
+in
+pkgs.mkShell {
+  buildInputs = [ generatePursPackages ];
+
+  shellHook = ''
+    generate-purs-packages > ./nix/purs-packages.nix
+    echo "generated purs-packages.nix"
+  '';
+}

nix/psc-package-nix.nix

+{ pkgs ? import ./pinned.nix { } }:
+
+pkgs.fetchFromGitHub {
+  owner = "justinwoo";
+  repo = "psc-package-nix";
+  rev = "0f1f001e2ea17ad461871a1873050f6aef5f1284";
+  sha256 = "0gbwcvw8rvxhlg9p6avd0812y263jzim1sra5frbdi0s6q0ngsgi";
+}

nix/purs-project.nix

+#!/usr/bin/env nix-shell
+{ pkgs ? import ./pinned.nix { } }:
+let
+  packagesJson = ../.psc-package/local/.set/packages.json;
+  inputNames = (pkgs.lib.importJSON ../psc-package.json).depends;
+  pursPackages = import ./purs-packages.nix { inherit pkgs; };
+  getUnquotedSourceGlob = x: ''${x.src}/src/**/*.purs'';
+  unquotedSourceGlobs = map getUnquotedSourceGlob (builtins.attrValues pursPackages);
+  quote = x: ''"${x}"'';
+  sourceGlobs = map quote unquotedSourceGlobs;
+in
+{
+  inherit packagesJson inputNames sourceGlobs unquotedSourceGlobs;
+}

psc-package.json

@@ -4,6 +4,7 @@
   "source": ".psc-package/local/.set/packages.json",
   "depends": [
     "affjax",
+    "aff-promise",
     "argonaut",
     "console",
     "css",
@@ -20,6 +21,7 @@
     "markdown-smolder",
     "math",
     "maybe",
+    "milkis",
     "nonempty",
     "numbers",
     "prelude",

shell.nix

-{ pkgs ? import ./pinned.nix {} }:
+{ pkgs ? import ./nix/pinned.nix {} }:
 let
-  easy-ps = import (
-    pkgs.fetchFromGitHub {
-      owner = "justinwoo";
-      repo = "easy-purescript-nix";
-      rev = "14e7d85431e9f9838d7107d18cb79c7fa534f54e";
-      sha256 = "0lmkppidmhnayv0919990ifdd61f9d23dzjzr8amz7hjgc74yxs0";
-    }
-  ) {
-    inherit pkgs;
-  };
-
-  soba = import (
-    pkgs.fetchFromGitHub {
-      owner = "justinwoo";
-      repo = "soba";
-      rev = "2add8804bce7e7c1ab5eb1c3d8f6783e938a04d3";
-      sha256 = "1qagyklcllr2sxdb315prw33af6g37762zgk2ahh3ifxpns6ifxx";
-    }
-  ) {
-    inherit pkgs;
-  };
+  easy-ps = import ./nix/easy-ps.nix { inherit pkgs; };
 
   purs-packages = import ./purs-packages.nix { inherit pkgs; };
 
-  cpPackage = pp:
-    let
-      target = ".psc-package/local/${pp.name}/${pp.version}";
-    in
-      ''
-        mkdir -p ${target}
-        cp --no-preserve=mode,ownership,timestamp -r ${pp.fetched.outPath}/* ${target}
-      '';
-
-  install-purs-packages = pkgs.writeShellScriptBin "install-purs-packages" ''
-    #!/usr/bin/env bash
-    ${builtins.toString (builtins.map cpPackage (builtins.attrValues purs-packages))}
-    echo done installing deps.
-  '';
+  purs-project = import ./nix/purs-project.nix { inherit pkgs; };
 
   build-purs = pkgs.writeShellScriptBin "build-purs" ''
     #!/usr/bin/env bash
-    purs compile "src/**/*.purs" ".psc-package/*/*/*/src/**/*.purs"
-  '';
-
-  storePath = x: ''"${x.fetched.outPath}/src/**/*.purs"'';
-
-  build-purs-from-store = pkgs.writeShellScriptBin "build-purs-from-store" ''
-    #!/usr/bin/env bash
-    purs compile "src/**/*.purs" \
-      ${builtins.toString (builtins.map storePath (builtins.attrValues purs-packages))}
+    purs compile ${toString purs-project.sourceGlobs} "src/**/*.purs" "test/**/*.purs"
   '';
 
   build = pkgs.writeShellScriptBin "build" ''
@@ -57,7 +16,7 @@ let
     set -e
 
     echo "Compiling"
-    build-purs-from-store
+    build-purs
     echo "Bundling"
     yarn pulp browserify --skip-compile -t dist/bundle.js --src-path output
   '';
@@ -72,28 +31,28 @@ pkgs.mkShell {
   buildInputs = [
     easy-ps.purs
     easy-ps.psc-package
-    soba
-    install-purs-packages
     build-purs
-    build-purs-from-store
     build
     repl
     pkgs.yarn
   ];
+
+  shellHook = ''
+    export PURS_IDE_SOURCES='${toString purs-project.unquotedSourceGlobs}'
+  '';
 }
 
 ## how to build the project with nix dependencies:
 #
 # 1. start a nix shell (e.g. `nix-shell -j 20`, this uses 20 jobs to fetch deps)
 # 2. run `yarn` to install npm deps
-# 3. run `install-purs-packages` if you want dependencies locally, available for psc-package and for inspection
-# 4. run `build-purs` to build from local sources. otherwise use `build-purs-from-store`.
+# 3a. run `build-purs` to build using nix store dependencies, and make sure to update your purescript ide tooling as necesssary
+# 3b. or simply use `psc-package` as you might want to anyway
 #
 # note that the purescript compiler uses filepaths and timestamps, so using the above two commands
 # interchangeably will lead to constant rebuilding of the entire project.
 #
 ## how to update purs-packages.nix
 #
-# 1. run `soba insdhall` to generate packages.json
-# 2. run `soba nix` to generate a nix derivation from packages.json
-
+# 1. run `nix/generate-packages-json.nix` to generate packages.json
+# 2. run `nix/generate-purs-packages.nix` to generate purs-packages.nix

src/Gargantext/Components/Forest/Tree.purs

@@ -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

@@ -8,16 +8,20 @@ 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
   )
 
+cacheName :: String
+cacheName = "metrics"
+
 metricsLoadView :: forall a. Record (MetricsLoadViewProps a) -> R.Element
 metricsLoadView p = R.createElement metricsLoadViewCpt p []
 
@@ -26,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 } }

src/Gargantext/Components/Nodes/Corpus/Chart/Histo.purs

@@ -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

@@ -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

@@ -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

@@ -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

 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

@@ -4,7 +4,7 @@ import Affjax (defaultRequest, printResponseFormatError, request)
 import Affjax.RequestBody (RequestBody(..), formData, formURLEncoded)
 import Affjax.RequestHeader as ARH
 import Affjax.ResponseFormat as ResponseFormat
-import DOM.Simple.Console (log)
+import DOM.Simple.Console (log, log2)
 import Data.Argonaut (class DecodeJson, decodeJson, class EncodeJson, encodeJson)
 import Data.Either (Either(..))
 import Data.Foldable (foldMap)
@@ -12,13 +12,17 @@ import Data.FormURLEncoded as FormURLEncoded
 import Data.HTTP.Method (Method(..))
 import Data.Maybe (Maybe(..))
 import Data.MediaType.Common (applicationFormURLEncoded, applicationJSON, multipartFormData)
-import Data.Tuple (Tuple)
+import Data.Tuple (Tuple(..))
+import DOM.Simple.Console (log2)
 import Effect.Aff (Aff, throwError)
 import Effect.Class (liftEffect)
 import Effect.Exception (error)
+import Milkis as Milkis
+import Unsafe.Coerce (unsafeCoerce)
+import Web.XHR.FormData as XHRFormData
+
 import Gargantext.Prelude
 import Gargantext.Utils.Reactix as R2
-import Web.XHR.FormData as XHRFormData
 
 type Token = String
 
@@ -26,7 +30,7 @@ type Token = String
 send :: forall a b. EncodeJson a => DecodeJson b =>
         Method -> Maybe Token -> String -> Maybe a -> Aff b
 send m mtoken url reqbody = do
-  affResp <- request $ defaultRequest
+  let req = defaultRequest
          { url = url
          , responseFormat = ResponseFormat.json
          , method = Left m
@@ -38,6 +42,8 @@ send m mtoken url reqbody = do
                       ) mtoken
          , content  = (Json <<< encodeJson) <$> reqbody
          }
+
+  affResp <- request req
   case mtoken of
     Nothing -> pure unit
     Just token -> liftEffect $ do
@@ -133,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

@@ -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

src/Gargantext/Hooks/Loader.purs

 module Gargantext.Hooks.Loader where
 
-import Gargantext.Prelude
 import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson, (.:), (:=), (~>), jsonEmptyObject)
 import Data.Argonaut.Core (stringify)
 import Data.Argonaut.Parser (jsonParser)
@@ -9,13 +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
 
 
@@ -48,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
   }
 
@@ -148,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

+exports._makeRequest = function() {
+    return function(url) {
+        return function(options) {
+            return new Request(url, options);
+
+        }
+    }
+}
+
+exports._openCache = function(cacheName) {
+    return function() {
+        return caches.open(cacheName);
+    }
+}
+
+exports._delete = function(cache) {
+    return function(req) {
+        return function() {
+            cache.delete(req);
+        }
+    }
+}
+
+exports._add = function(cache) {
+    return function(req) {
+        return function() {
+            return cache.add(req);
+        }
+    }
+}
+
+exports._match = function(cache) {
+    return function(req) {
+        return function() {
+            return cache.match(req);
+        }
+    }
+}

src/Gargantext/Utils/CacheAPI.purs

+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, 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, 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 = 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, headers :: M.Headers | options } -> Request
+foreign import _openCache :: String -> Effect (Promise Cache)
+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)