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

3 4
import Gargantext.Prelude

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 DOM.Simple.Console (log2)
10
import Effect (Effect)
11
import Reactix as R
12
import Simple.JSON as JSON
13 14
import Toestand as T
import Web.Storage.Storage as WSS
15

16 17 18 19 20 21
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

22 23 24
localStorageKey :: String
localStorageKey = "garg-async-tasks"

25

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

29 30 31 32
instance JSON.ReadForeign Storage where
  readImpl f = do
    m <- GUJ.readMapInt f
    pure $ Storage m
33

34
empty :: Storage
35
empty = Storage $ Map.empty
36

37
getAsyncTasks :: Effect Storage
38 39
getAsyncTasks = R2.getls >>= WSS.getItem localStorageKey >>= handleMaybe
  where
40
    handleMaybe (Just val) = handleEither (parse val)
41 42 43 44 45 46
    handleMaybe Nothing    = pure empty

    -- either parsing or decoding could fail, hence two errors
    handleEither (Left err) = err *> pure empty
    handleEither (Right ss) = pure ss

47
    parse  s = GU.mapLeft (log2 "Error parsing serialised sessions:") (JSON.readJSON s)
48

49
getTasks :: GT.NodeID -> Storage -> TaskList
50
getTasks nodeId (Storage storage) = fromMaybe [] $ Map.lookup nodeId storage
51

52
setTasks :: GT.NodeID -> TaskList -> Storage -> Storage
53
setTasks id tasks (Storage s) = Storage $ Map.insert id tasks s
54

55 56 57 58
focus :: GT.NodeID -> T.Box Storage -> R.Hooks (T.Box TaskList)
focus id tasks = T.useFocused (getTasks id) (setTasks id) tasks

removeTaskFromList :: TaskList -> GT.AsyncTaskWithType -> TaskList
59 60
removeTaskFromList ts (GT.AsyncTaskWithType { task: GT.AsyncTask { id: id' } }) =
  A.filter (\(GT.AsyncTaskWithType { task: GT.AsyncTask { id: id'' } }) -> id' /= id'') ts
61 62

type ReductorProps = (
63 64
    reloadForest :: T2.ReloadS
  , reloadRoot   :: T2.ReloadS
James Laver's avatar
James Laver committed
65
  , storage      :: Storage
66 67
  )

68 69 70
insert :: GT.NodeID -> GT.AsyncTaskWithType -> T.Box Storage -> Effect Unit
insert id task storage = T.modify_ newStorage storage
  where
71
    newStorage (Storage s) = Storage $ Map.alter (maybe (Just [task]) (\ts -> Just $ A.cons task ts)) id s
72 73 74

finish :: GT.NodeID -> GT.AsyncTaskWithType -> T.Box Storage -> Effect Unit
finish id task storage = remove id task storage
75

76 77
remove :: GT.NodeID -> GT.AsyncTaskWithType -> T.Box Storage -> Effect Unit
remove id task storage = T.modify_ newStorage storage
78
  where
79
    newStorage (Storage s) = Storage $ Map.alter (maybe Nothing $ (\ts -> Just $ removeTaskFromList ts task)) id s
80 81 82 83 84 85 86 87 88


-- When a task is finished: which tasks cause forest or app reload
asyncTaskTriggersAppReload :: GT.AsyncTaskType -> Boolean
asyncTaskTriggersAppReload _                     = false

asyncTaskTTriggersAppReload :: GT.AsyncTaskWithType -> Boolean
asyncTaskTTriggersAppReload (GT.AsyncTaskWithType { typ }) = asyncTaskTriggersAppReload typ

89 90 91 92 93 94 95
asyncTaskTriggersMainPageReload :: GT.AsyncTaskType -> Boolean
asyncTaskTriggersMainPageReload GT.UpdateNgramsCharts = true
asyncTaskTriggersMainPageReload _                     = false

asyncTaskTTriggersMainPageReload :: GT.AsyncTaskWithType -> Boolean
asyncTaskTTriggersMainPageReload (GT.AsyncTaskWithType { typ }) = asyncTaskTriggersMainPageReload typ

96
asyncTaskTriggersTreeReload :: GT.AsyncTaskType -> Boolean
97 98 99
asyncTaskTriggersTreeReload GT.CorpusFormUpload = true
asyncTaskTriggersTreeReload GT.UploadFile       = true
asyncTaskTriggersTreeReload _                   = false
100 101 102

asyncTaskTTriggersTreeReload :: GT.AsyncTaskWithType -> Boolean
asyncTaskTTriggersTreeReload (GT.AsyncTaskWithType { typ }) = asyncTaskTriggersTreeReload typ