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