1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
module Gargantext.AsyncTasks where
import Gargantext.Prelude
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 Effect (Effect)
import Reactix as R
import Simple.JSON as JSON
import Toestand as T
import Web.Storage.Storage as WSS
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"
type TaskList = Array GT.AsyncTaskWithType
newtype Storage = Storage (Map.Map GT.NodeID TaskList)
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)
getTasks :: GT.NodeID -> Storage -> TaskList
getTasks nodeId (Storage storage) = fromMaybe [] $ Map.lookup nodeId storage
setTasks :: GT.NodeID -> TaskList -> Storage -> Storage
setTasks id tasks (Storage s) = Storage $ Map.insert id tasks s
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
removeTaskFromList ts (GT.AsyncTaskWithType { task: GT.AsyncTask { id: id' } }) =
A.filter (\(GT.AsyncTaskWithType { task: GT.AsyncTask { id: id'' } }) -> id' /= id'') ts
type ReductorProps = (
reloadForest :: T2.ReloadS
, reloadRoot :: T2.ReloadS
, storage :: Storage
)
insert :: GT.NodeID -> GT.AsyncTaskWithType -> T.Box Storage -> Effect Unit
insert id task storage = T.modify_ newStorage storage
where
newStorage (Storage s) = Storage $ Map.alter (maybe (Just [task]) (\ts -> Just $ A.cons task ts)) id s
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
where
newStorage (Storage s) = Storage $ Map.alter (maybe Nothing $ (\ts -> Just $ removeTaskFromList ts task)) id s
-- 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
asyncTaskTriggersMainPageReload :: GT.AsyncTaskType -> Boolean
asyncTaskTriggersMainPageReload GT.UpdateNgramsCharts = true
asyncTaskTriggersMainPageReload _ = false
asyncTaskTTriggersMainPageReload :: GT.AsyncTaskWithType -> Boolean
asyncTaskTTriggersMainPageReload (GT.AsyncTaskWithType { typ }) = asyncTaskTriggersMainPageReload typ
asyncTaskTriggersTreeReload :: GT.AsyncTaskType -> Boolean
asyncTaskTriggersTreeReload GT.CorpusFormUpload = true
asyncTaskTriggersTreeReload GT.UploadFile = true
asyncTaskTriggersTreeReload _ = false
asyncTaskTTriggersTreeReload :: GT.AsyncTaskWithType -> Boolean
asyncTaskTTriggersTreeReload (GT.AsyncTaskWithType { typ }) = asyncTaskTriggersTreeReload typ