[async tasks] save tasks in local storage

src/Gargantext/AsyncTasks.purs

+module Gargantext.AsyncTasks where
+
+import Data.Argonaut (decodeJson, class EncodeJson, encodeJson, (:=), (~>), (.:))
+import Data.Argonaut.Parser (jsonParser)
+import Data.Either (Either(..))
+import Data.Map as Map
+import Data.Maybe (Maybe(..))
+import DOM.Simple.Console (log2)
+import Effect (Effect)
+import Web.Storage.Storage as WSS
+
+import Gargantext.Prelude
+import Gargantext.Types as GT
+import Gargantext.Utils.Reactix as R2
+
+
+localStorageKey :: String
+localStorageKey = "garg-async-tasks"
+
+empty :: Map.Map Int (Array GT.AsyncTaskWithType)
+empty = Map.empty
+
+getAsyncTasks :: Effect (Map.Map Int (Array GT.AsyncTaskWithType))
+getAsyncTasks = R2.getls >>= WSS.getItem localStorageKey >>= handleMaybe
+  where
+    handleMaybe (Just val) = handleEither (parse val >>= decode)
+    handleMaybe Nothing    = pure empty
+
+    -- either parsing or decoding could fail, hence two errors
+    handleEither (Left err) = err *> pure empty
+    handleEither (Right ss) = pure ss
+
+    parse  s = mapLeft (log2 "Error parsing serialised sessions:") (jsonParser s)
+    decode j = mapLeft (log2 "Error decoding serialised sessions:") (decodeJson j)
+
+mapLeft :: forall l m r. (l -> m) -> Either l r -> Either m r
+mapLeft f (Left  l) = Left (f l)
+mapLeft _ (Right r) = Right r
+

src/Gargantext/Config.purs

@@ -11,7 +11,8 @@ defaultBackends = local :| [prod, partner, demo, dev]
     partner = backend V10 "/api/" "https://imtv4.gargantext.org" "institut-mines-telecom.imt"
     demo    = backend V10 "/api/" "https://demo.gargantext.org" "demo.inshs.cnrs"
     dev     = backend V10 "/api/" "https://dev.gargantext.org"  "devel.inshs.cnrs"
-    local   = backend V10 "/api/" "http://localhost:8008"       "local.cnrs"
+    -- local   = backend V10 "/api/" "http://localhost:8008"       "local.cnrs"
+    local   = backend V10 "/api/" "http://192.168.1.6:8008"       "local.cnrs"
 
 defaultApps :: NonEmpty Array Frontend
 defaultApps = relative :| [prod, dev, demo, haskell, caddy]
@@ -20,7 +21,8 @@ defaultApps = relative :| [prod, dev, demo, haskell, caddy]
     prod     = frontend "/#/" "https://v4.gargantext.org" "v4.gargantext.org"
     dev      = frontend "/#/" "https://dev.gargantext.org" "gargantext.org (dev)"
     demo     = frontend "/#/" "https://demo.gargantext.org" "gargantext.org (demo)"
-    haskell  = frontend "/#/" "http://localhost:8008" "localhost.gargantext"
+    -- haskell  = frontend "/#/" "http://localhost:8008" "localhost.gargantext"
+    haskell  = frontend "/#/" "http://192.168.1.6:8008" "localhost.gargantext"
     python   = frontend "/#/" "http://localhost:8000" "localhost.python"
     caddy    = frontend "/#/" "http://localhost:2015" "localhost.caddy"
 

src/Gargantext/Types.purs

@@ -469,6 +469,16 @@ modeFromString _ = Nothing
 data AsyncTaskType = Form | GraphT | Query | CreateNode
 derive instance genericAsyncTaskType :: Generic AsyncTaskType _
 
+instance decodeJsonAsyncTaskType :: DecodeJson AsyncTaskType where
+  decodeJson json = do
+    obj <- decodeJson json
+    case obj of
+      "Form"       -> pure Form
+      "GraphT"     -> pure GraphT
+      "Query"      -> pure Query
+      "CreateNode" -> pure CreateNode
+      s            -> Left ("Unknown string " <> s)
+
 asyncTaskTypePath :: AsyncTaskType -> String
 asyncTaskTypePath Form   = "add/form/async/"
 asyncTaskTypePath Query  = "query/"
@@ -506,13 +516,20 @@ instance decodeJsonAsyncTask :: DecodeJson AsyncTask where
     obj <- decodeJson json
     id <- obj .: "id"
     status <- obj .: "status"
-    pure $ AsyncTask {id, status}
+    pure $ AsyncTask { id, status }
 
 newtype AsyncTaskWithType = AsyncTaskWithType {
     task :: AsyncTask
   , typ  :: AsyncTaskType
   }
 
+instance decodeJsonAsyncTaskWithType :: DecodeJson AsyncTaskWithType where
+  decodeJson json = do
+    obj <- decodeJson json
+    task <- obj .: "task"
+    typ <- obj .: "typ"
+    pure $ AsyncTaskWithType { task, typ }
+
 newtype AsyncProgress = AsyncProgress {
     id :: AsyncTaskID
   , log :: Array AsyncTaskLog