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
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
module Gargantext.AsyncTasks
( Task
, TaskList
, Storage(..)
, insert
, hasTask
, 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 Data.Monoid (class Monoid)
import Data.Semigroup (class Semigroup)
import Data.Tuple (Tuple(..))
import Effect (Effect)
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
import Reactix as R
import Simple.JSON as JSON
import Toestand as T
import Web.Storage.Storage as WSS
type Task = GT.WorkerTask
type TaskList = Array Task
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
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)
modifyTaskBox :: (Storage -> Storage) -> T.Box Storage -> Effect Unit
modifyTaskBox f box = T.modify_ f box
-- modifyAsyncTasks (const newS)
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 -> Task -> TaskList
removeTaskFromList ts (GT.WorkerTask { message_id }) =
A.filter (\(GT.WorkerTask { message_id: message_id' }) -> message_id /= message_id') ts
type ReductorProps =
( reloadForest :: T2.ReloadS
, reloadRoot :: T2.ReloadS
, storage :: Storage
)
insert :: GT.NodeID -> Task -> T.Box Storage -> Effect Unit
insert id task storageBox = modifyTaskBox newStorage storageBox
where
newStorage (Storage s) = Storage $ Map.alter (maybe (Just [ task ]) (\ts -> Just $ A.nub $ A.cons task ts)) id s
hasTask :: GT.NodeID -> Task -> T.Box Storage -> Effect Boolean
hasTask id (GT.WorkerTask { message_id }) storage = do
Storage storage' <- T.read storage
case Map.lookup id storage' of
Nothing -> pure false
Just taskList ->
pure $ A.any (\(GT.WorkerTask { message_id: mId }) -> mId == message_id) taskList
finish :: GT.NodeID -> Task -> T.Box Storage -> Effect Unit
finish id task storage = remove id task storage
remove :: GT.NodeID -> Task -> T.Box Storage -> Effect Unit
remove id task storageBox = modifyTaskBox newStorage storageBox
where
newStorage (Storage s) = Storage $ Map.alter (maybe Nothing $ (\ts -> Just $ removeTaskFromList ts task)) id s
-- AsyncTaskWithType is deprecated, but we leave these functions here,
-- becuase they're a useful reference
-- 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.Query = true
-- asyncTaskTriggersTreeReload GT.UploadFile = true
-- asyncTaskTriggersTreeReload _ = false
-- asyncTaskTTriggersTreeReload :: GT.AsyncTaskWithType -> Boolean
-- asyncTaskTTriggersTreeReload (GT.AsyncTaskWithType { typ }) = asyncTaskTriggersTreeReload typ
-- With push-based notifications, it doesn't make sense to store jobs in localStorage
-- readAsyncTasks :: Effect Storage
-- readAsyncTasks = R2.loadLocalStorageState' R2.asyncTasksKey mempty
-- writeAsyncTasks :: Storage -> Effect Unit
-- writeAsyncTasks = R2.setLocalStorageState R2.asyncTasksKey
-- modifyAsyncTasks :: (Storage -> Storage) -> Effect Unit
-- modifyAsyncTasks f = readAsyncTasks >>= writeAsyncTasks <<< f
-- 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