AsyncTasks.purs 3.03 KB
Newer Older
1 2
module Gargantext.AsyncTasks where

3
import Data.Argonaut (decodeJson)
4
import Data.Argonaut.Parser (jsonParser)
5
import Data.Array as A
6 7
import Data.Either (Either(..))
import Data.Map as Map
8
import Data.Maybe (Maybe(..), maybe, fromMaybe)
9
import Data.Tuple (snd)
10 11
import DOM.Simple.Console (log2)
import Effect (Effect)
12
import Reactix as R
13 14 15 16
import Web.Storage.Storage as WSS

import Gargantext.Prelude
import Gargantext.Types as GT
17
import Gargantext.Utils as GU
18
import Gargantext.Utils.Reactix as R2
19
import Gargantext.Utils.Reload as GUR
20 21 22 23 24


localStorageKey :: String
localStorageKey = "garg-async-tasks"

25

26
type Storage = Map.Map GT.NodeID (Array GT.AsyncTaskWithType)
27 28

empty :: Storage
29 30
empty = Map.empty

31
getAsyncTasks :: Effect Storage
32 33 34 35 36 37 38 39 40
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

41 42
    parse  s = GU.mapLeft (log2 "Error parsing serialised sessions:") (jsonParser s)
    decode j = GU.mapLeft (log2 "Error decoding serialised sessions:") (decodeJson j)
43

44
getTasks :: Record ReductorProps -> GT.NodeID -> Array GT.AsyncTaskWithType
45 46
getTasks { storage } nodeId = fromMaybe [] $ Map.lookup nodeId storage

47 48 49
removeTaskFromList :: Array GT.AsyncTaskWithType -> GT.AsyncTaskWithType -> Array GT.AsyncTaskWithType
removeTaskFromList ts (GT.AsyncTaskWithType { task: GT.AsyncTask { id: id' } }) =
  A.filter (\(GT.AsyncTaskWithType { task: GT.AsyncTask { id: id'' } }) -> id' /= id'') ts
50 51

type ReductorProps = (
52 53
    appReload  :: GUR.ReloadS
  , treeReload :: GUR.ReloadS
54
  , storage    :: Storage
55 56
  )

57
type Reductor = R2.Reductor (Record ReductorProps) Action
58
type ReductorAction = Action -> Effect Unit
59

60
useTasks :: GUR.ReloadS -> GUR.ReloadS -> R.Hooks Reductor
61
useTasks appReload treeReload = R2.useReductor act initializer unit
62 63 64
  where
    act :: R2.Actor (Record ReductorProps) Action
    act a s = action s a
65 66
    initializer _ = do
      storage <- getAsyncTasks
67
      pure { appReload, treeReload, storage }
68 69

data Action =
70 71 72
    Insert GT.NodeID GT.AsyncTaskWithType
  | Finish GT.NodeID GT.AsyncTaskWithType
  | Remove GT.NodeID GT.AsyncTaskWithType
73

74
action :: Record ReductorProps -> Action -> Effect (Record ReductorProps)
75
action p@{ treeReload, storage } (Insert nodeId t) = do
76
  _ <- GUR.bump treeReload
77
  let newStorage = Map.alter (maybe (Just [t]) (\ts -> Just $ A.cons t ts)) nodeId storage
78 79 80
  pure $ p { storage = newStorage }
action p (Finish nodeId t) = do
  action p (Remove nodeId t)
81 82
action p@{ appReload, treeReload, storage } (Remove nodeId t@(GT.AsyncTaskWithType { typ })) = do
  _ <- if GT.asyncTaskTriggersAppReload typ then
83
    GUR.bump appReload
84 85 86
  else
    pure unit
  _ <- if GT.asyncTaskTriggersTreeReload typ then
87
    GUR.bump treeReload
88 89
  else
    pure unit
90
  let newStorage = Map.alter (maybe Nothing $ (\ts -> Just $ removeTaskFromList ts t)) nodeId storage
91
  pure $ p { storage = newStorage }