[asyncTasks] store tasks in localStorage properly

src/Gargantext/AsyncTasks.purs

-module Gargantext.AsyncTasks where
+module Gargantext.AsyncTasks (
+    TaskList
+  , Storage(..)
+  , readAsyncTasks
+  , insert
+  , finish
+  , focus
+  , asyncTaskTTriggersAppReload
+  , asyncTaskTTriggersTreeReload
+  , asyncTaskTTriggersMainPageReload )
+where
 
 import Gargantext.Prelude
 
+import DOM.Simple.Console (log2)
 import Data.Array as A
 import Data.Either (Either(..))
 import Data.Map as Map
 import Data.Maybe (Maybe(..), maybe, fromMaybe)
-import DOM.Simple.Console (log2)
+import Data.Monoid (class Monoid) 
+import Data.Semigroup (class Semigroup)
+import Data.Tuple (Tuple(..))
 import Effect (Effect)
-import Reactix as R
-import Simple.JSON as JSON
-import Toestand as T
-import Web.Storage.Storage as WSS
-
+import Foreign.Object as FO
 import Gargantext.Types as GT
 import Gargantext.Utils as GU
 import Gargantext.Utils.JSON as GUJ
 import Gargantext.Utils.Reactix as R2
 import Gargantext.Utils.Toestand as T2
-
-localStorageKey :: String
-localStorageKey = "garg-async-tasks"
+import Reactix as R
+import Simple.JSON as JSON
+import Toestand as T
+import Web.Storage.Storage as WSS
 
 
 type TaskList = Array GT.AsyncTaskWithType
 newtype Storage = Storage (Map.Map GT.NodeID TaskList)
-
+derive newtype instance Semigroup Storage
+derive newtype instance Monoid Storage
 instance JSON.ReadForeign Storage where
   readImpl f = do
     m <- GUJ.readMapInt f
     pure $ Storage m
-
-empty :: Storage
-empty = Storage $ Map.empty
-
-getAsyncTasks :: Effect Storage
-getAsyncTasks = R2.getls >>= WSS.getItem localStorageKey >>= handleMaybe
-  where
-    handleMaybe (Just val) = handleEither (parse val)
-    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 = GU.mapLeft (log2 "Error parsing serialised sessions:") (JSON.readJSON s)
+instance JSON.WriteForeign Storage where
+  writeImpl (Storage s) = JSON.writeImpl $ FO.fromFoldable arr
+    where
+      arr :: Array (Tuple String TaskList)
+      arr = (\(Tuple k v) -> Tuple (show k) v) <$> (Map.toUnfoldable s)
+
+readAsyncTasks :: Effect Storage
+readAsyncTasks = R2.loadLocalStorageState' R2.asyncTasksKey mempty
+-- readAsyncTasks = R2.getls >>= WSS.getItem R2.asyncTasksKey >>= handleMaybe
+  -- where
+  --   handleMaybe (Just val) = handleEither (parse val)
+  --   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 = GU.mapLeft (log2 "Error parsing serialised sessions:") (JSON.readJSON s)
+
+writeAsyncTasks :: Storage -> Effect Unit
+writeAsyncTasks = R2.setLocalStorageState R2.asyncTasksKey
+-- writeAsyncTasks storage = R2.getls >>= WSS.setItem R2.asyncTasksKey storage
+
+modifyAsyncTasks :: (Storage -> Storage) -> Effect Unit
+modifyAsyncTasks f = readAsyncTasks >>= writeAsyncTasks <<< f
+
+modifyTaskBox :: (Storage -> Storage) -> T.Box Storage -> Effect Unit
+modifyTaskBox f box = do
+  s <- T.read box
+  let newS = f s
+  T.write_ newS box
+  modifyAsyncTasks (const newS)
 
 getTasks :: GT.NodeID -> Storage -> TaskList
 getTasks nodeId (Storage storage) = fromMaybe [] $ Map.lookup nodeId storage
@@ -66,7 +94,7 @@ type ReductorProps = (
   )
 
 insert :: GT.NodeID -> GT.AsyncTaskWithType -> T.Box Storage -> Effect Unit
-insert id task storage = T.modify_ newStorage storage
+insert id task storageBox = modifyTaskBox newStorage storageBox
   where
     newStorage (Storage s) = Storage $ Map.alter (maybe (Just [task]) (\ts -> Just $ A.cons task ts)) id s
 
@@ -74,7 +102,7 @@ finish :: GT.NodeID -> GT.AsyncTaskWithType -> T.Box Storage -> Effect Unit
 finish id task storage = remove id task storage
 
 remove :: GT.NodeID -> GT.AsyncTaskWithType -> T.Box Storage -> Effect Unit
-remove id task storage = T.modify_ newStorage storage
+remove id task storageBox = modifyTaskBox newStorage storageBox
   where
     newStorage (Storage s) = Storage $ Map.alter (maybe Nothing $ (\ts -> Just $ removeTaskFromList ts task)) id s
 

src/Gargantext/Components/App/App.purs

@@ -97,7 +97,7 @@ mainAppCpt = here.component "main" cpt where
       void $ Sessions.load boxes.sessions
     -- tasks <- GAT.useTasks boxes.reloadRoot boxes.reloadForest
     R.useEffectOnce' $ do
-      tasksStorage <- GAT.getAsyncTasks
+      tasksStorage <- GAT.readAsyncTasks
       T.write_ tasksStorage boxes.tasks
     -- R.useEffectOnce' $ do
     --   T.write (Just tasksReductor) tasks

src/Gargantext/Components/App/Store.purs

@@ -126,7 +126,7 @@ options wsNotification =
   , sidePanelLists      : ListsSP.initialSidePanel
   , sidePanelTexts      : TextsT.initialSidePanel
   , sidePanelState      : InitialClosed
-  , tasks               : GAT.empty
+  , tasks               : mempty
   , theme               : Themes.defaultTheme
   , tileAxisXList       : mempty
   , tileAxisYList       : mempty

src/Gargantext/Components/Forest/Tree/Node.purs

@@ -80,11 +80,11 @@ nodeSpanCpt = here.component "nodeSpan" cpt
               , folderOpen
               , frontends
               , id
+              , isBoxVisible
               , isLeaf
               , nodeType
               , reload
               , session
-              , isBoxVisible
               } _ = do
     -- States
       boxes <- AppStore.use

src/Gargantext/Components/Forest/Tree/Node/Tools/ProgressBar.purs

@@ -24,88 +24,88 @@ here :: R2.Here
 here = R2.here "Gargantext.Components.Forest.Tree.Node.Tools.ProgressBar"
 
 
-data BarType = Bar | Pie
-
-type Props = (
-    asyncTask :: GT.AsyncTaskWithType
-  , barType   :: BarType
-  , nodeId    :: GT.ID
-  , onFinish  :: Unit -> Effect Unit
-  , session   :: Session
-  )
-
-
-asyncProgressBar :: R2.Component Props
-asyncProgressBar = R.createElement asyncProgressBarCpt
-asyncProgressBarCpt :: R.Component Props
-asyncProgressBarCpt = R2.hereComponent here "asyncProgressBar" hCpt where
-  hCpt hp props@{ asyncTask: (GT.AsyncTaskWithType {task: GT.AsyncTask {id}})
-                , barType
-                , onFinish
-                } _ = do
-    { errors } <- AppStore.use
+-- data BarType = Bar | Pie
+
+-- type Props = (
+--     asyncTask :: GT.AsyncTaskWithType
+--   , barType   :: BarType
+--   , nodeId    :: GT.ID
+--   , onFinish  :: Unit -> Effect Unit
+--   , session   :: Session
+--   )
+
+
+-- asyncProgressBar :: R2.Component Props
+-- asyncProgressBar = R.createElement asyncProgressBarCpt
+-- asyncProgressBarCpt :: R.Component Props
+-- asyncProgressBarCpt = R2.hereComponent here "asyncProgressBar" hCpt where
+--   hCpt hp props@{ asyncTask: (GT.AsyncTaskWithType {task: GT.AsyncTask {id}})
+--                 , barType
+--                 , onFinish
+--                 } _ = do
+--     { errors } <- AppStore.use
     
-    progress <- T.useBox 0.0
-    intervalIdRef <- R.useRef Nothing
-
-    R.useEffectOnce' $ do
-      intervalId <- setInterval 1000 $ do
-        launchAff_ $ do
-          let rdata = (RX.pick props :: Record QueryProgressData)
-          eAsyncProgress <- queryProgress rdata
-          handleRESTError hp errors eAsyncProgress $
-            \asyncProgress -> liftEffect $ do
-              let GT.AsyncProgress { status } = asyncProgress
-              T.write_ (min 100.0 $ GT.progressPercent asyncProgress) progress
-              if (status == GT.IsFinished) || (status == GT.IsKilled) || (status == GT.IsFailure) then do
-                _ <- case R.readRef intervalIdRef of
-                  Nothing -> pure unit
-                  Just iid -> clearInterval iid
-                handleErrorInAsyncProgress errors asyncProgress
-                onFinish unit
-              else
-                pure unit
-
-      R.setRef intervalIdRef $ Just intervalId
-
-      pure unit
-
-
-    pure $ progressIndicator { barType, label: id, progress }
+--     progress <- T.useBox 0.0
+--     intervalIdRef <- R.useRef Nothing
+
+--     R.useEffectOnce' $ do
+--       intervalId <- setInterval 1000 $ do
+--         launchAff_ $ do
+--           let rdata = (RX.pick props :: Record QueryProgressData)
+--           eAsyncProgress <- queryProgress rdata
+--           handleRESTError hp errors eAsyncProgress $
+--             \asyncProgress -> liftEffect $ do
+--               let GT.AsyncProgress { status } = asyncProgress
+--               T.write_ (min 100.0 $ GT.progressPercent asyncProgress) progress
+--               if (status == GT.IsFinished) || (status == GT.IsKilled) || (status == GT.IsFailure) then do
+--                 _ <- case R.readRef intervalIdRef of
+--                   Nothing -> pure unit
+--                   Just iid -> clearInterval iid
+--                 handleErrorInAsyncProgress errors asyncProgress
+--                 onFinish unit
+--               else
+--                 pure unit
+
+--       R.setRef intervalIdRef $ Just intervalId
+
+--       pure unit
+
+
+--     pure $ progressIndicator { barType, label: id, progress }
 
 --------------------------------------------------------------
 
 
-type ProgressIndicatorProps =
-  ( barType  :: BarType
-  , label    :: String
-  , progress :: T.Box Number
-  )
-
-progressIndicator :: Record ProgressIndicatorProps -> R.Element
-progressIndicator p = R.createElement progressIndicatorCpt p []
-progressIndicatorCpt :: R.Component ProgressIndicatorProps
-progressIndicatorCpt = here.component "progressIndicator" cpt
-  where
-    cpt { barType, progress } _ = do
-      progress' <- T.useLive T.unequal progress
-      let progressInt = floor progress'
-
-      case barType of
-        Bar -> pure $
-                H.div { className: "progress" }
-                  [ H.div { className: "progress-bar"
-                        , role: "progressbar"
-                        , style: { width: (show $ progressInt) <> "%" }
-                        } [ ]
-                  ]
-        Pie -> pure $
-                H.div { className: "progress-pie" }
-                  [ H.div { className: "progress-pie-segment"
-                          , style: { "--over50": if progressInt < 50 then "0" else "1"
-                                   , "--value": show $ progressInt } } [
-                    ]
-                  ]
+-- type ProgressIndicatorProps =
+--   ( barType  :: BarType
+--   , label    :: String
+--   , progress :: T.Box Number
+--   )
+
+-- progressIndicator :: Record ProgressIndicatorProps -> R.Element
+-- progressIndicator p = R.createElement progressIndicatorCpt p []
+-- progressIndicatorCpt :: R.Component ProgressIndicatorProps
+-- progressIndicatorCpt = here.component "progressIndicator" cpt
+--   where
+--     cpt { barType, progress } _ = do
+--       progress' <- T.useLive T.unequal progress
+--       let progressInt = floor progress'
+
+--       case barType of
+--         Bar -> pure $
+--                 H.div { className: "progress" }
+--                   [ H.div { className: "progress-bar"
+--                         , role: "progressbar"
+--                         , style: { width: (show $ progressInt) <> "%" }
+--                         } [ ]
+--                   ]
+--         Pie -> pure $
+--                 H.div { className: "progress-pie" }
+--                   [ H.div { className: "progress-pie-segment"
+--                           , style: { "--over50": if progressInt < 50 then "0" else "1"
+--                                    , "--value": show $ progressInt } } [
+--                     ]
+--                   ]
 
 
 --------------------------------------------------------------

src/Gargantext/Types.purs

@@ -728,6 +728,8 @@ data AsyncTaskType = AddNode
 derive instance Generic AsyncTaskType _
 instance JSON.ReadForeign AsyncTaskType where
   readImpl = JSONG.enumSumRep
+instance JSON.WriteForeign AsyncTaskType where
+  writeImpl = JSON.writeImpl <<< show
 instance Eq AsyncTaskType where
   eq = genericEq
 instance Show AsyncTaskType where
@@ -759,6 +761,8 @@ data AsyncTaskStatus = IsRunning
 derive instance Generic AsyncTaskStatus _
 instance JSON.ReadForeign AsyncTaskStatus where
   readImpl = JSONG.enumSumRep
+instance JSON.WriteForeign AsyncTaskStatus where
+  writeImpl = JSON.writeImpl <<< show
 instance Show AsyncTaskStatus where
   show = genericShow
 derive instance Eq AsyncTaskStatus
@@ -780,6 +784,7 @@ newtype AsyncTask =
 derive instance Generic AsyncTask _
 derive instance Newtype AsyncTask _
 derive newtype instance JSON.ReadForeign AsyncTask
+derive newtype instance JSON.WriteForeign AsyncTask
 instance Eq AsyncTask where eq = genericEq
 
 newtype AsyncTaskWithType = AsyncTaskWithType
@@ -789,6 +794,7 @@ newtype AsyncTaskWithType = AsyncTaskWithType
 derive instance Generic AsyncTaskWithType _
 derive instance Newtype AsyncTaskWithType _
 derive newtype instance JSON.ReadForeign AsyncTaskWithType
+derive newtype instance JSON.WriteForeign AsyncTaskWithType
 instance Eq AsyncTaskWithType where eq = genericEq
 
 newtype AsyncProgress = AsyncProgress

src/Gargantext/Utils/JSON.purs

@@ -39,6 +39,7 @@ readList f = do
 writeList :: forall a. JSON.WriteForeign a => List.List a -> Foreign
 writeList xs = unsafeToForeign $ JSON.writeImpl <$> (List.toUnfoldable xs :: Array a)
 
+-- | Read a map with 'Int' keys
 readMapInt :: forall v. JSON.ReadForeign v => Foreign -> F (Map.Map Int v)
 readMapInt f = do
   (inst :: Object.Object Foreign) <- readObject' f

src/Gargantext/Utils/Reactix.purs

@@ -412,6 +412,8 @@ foreign import _stringify :: forall a. Fn2 a Int String
 getls :: Effect Storage
 getls = window >>= localStorage
 
+type LocalStorageKey = String
+
 openNodesKey :: LocalStorageKey
 openNodesKey = "garg-open-nodes"
 
@@ -424,7 +426,8 @@ graphParamsKey = "garg-graph-params"
 phyloParamsKey :: LocalStorageKey
 phyloParamsKey = "garg-phylo-params"
 
-type LocalStorageKey = String
+asyncTasksKey :: String
+asyncTasksKey = "garg-async-tasks"
 
 loadLocalStorageState :: forall s. JSON.ReadForeign s => LocalStorageKey -> T.Box s -> Effect Unit
 loadLocalStorageState key cell = do
@@ -463,6 +466,7 @@ setLocalStorageState key s =
   let json = JSON.writeJSON s
   in getls >>= setItem key json
 
+
 getMessageDataStr :: DE.MessageEvent -> String
 getMessageDataStr = getMessageData