[worker] migrate to new-style jobs, remove old-style asynctaskwithtype

src/Gargantext/AsyncTasks.purs

@@ -2,13 +2,13 @@ module Gargantext.AsyncTasks (
     Task
   , TaskList
   , Storage(..)
-  -- , readAsyncTasks
   , insert
   , finish
   , focus
-  , asyncTaskTTriggersAppReload
-  , asyncTaskTTriggersTreeReload
-  , asyncTaskTTriggersMainPageReload )
+  -- , asyncTaskTTriggersAppReload
+  -- , asyncTaskTTriggersTreeReload
+  -- , asyncTaskTTriggersMainPageReload
+  )
 where
 
 import Gargantext.Prelude
@@ -34,7 +34,6 @@ import Toestand as T
 import Web.Storage.Storage as WSS
 
 
--- type TaskList = Array GT.AsyncTaskWithType
 type Task = GT.WorkerTask
 type TaskList = Array Task
 newtype Storage = Storage (Map.Map GT.NodeID TaskList)
@@ -50,20 +49,8 @@ instance JSON.WriteForeign Storage where
       arr :: Array (Tuple String TaskList)
       arr = (\(Tuple k v) -> Tuple (show k) v) <$> (Map.toUnfoldable s)
 
--- 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
-
 modifyTaskBox :: (Storage -> Storage) -> T.Box Storage -> Effect Unit
 modifyTaskBox f box = T.modify_ f box
-  -- s <- T.read box
-  -- let newS = f s
-  -- T.write_ newS box
   -- modifyAsyncTasks (const newS)
 
 getTasks :: GT.NodeID -> Storage -> TaskList
@@ -75,10 +62,6 @@ 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
-
 removeTaskFromList :: TaskList -> Task -> TaskList
 removeTaskFromList ts (GT.WorkerTask { message_id }) =
   A.filter (\(GT.WorkerTask { message_id: message_id' }) -> message_id /= message_id') ts
@@ -103,25 +86,43 @@ remove id task storageBox = modifyTaskBox newStorage storageBox
     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
+-- asyncTaskTriggersAppReload :: GT.AsyncTaskType -> Boolean
+-- asyncTaskTriggersAppReload _                     = false
 
-asyncTaskTTriggersAppReload :: GT.AsyncTaskWithType -> Boolean
-asyncTaskTTriggersAppReload (GT.AsyncTaskWithType { typ }) = asyncTaskTriggersAppReload typ
+-- asyncTaskTTriggersAppReload :: GT.AsyncTaskWithType -> Boolean
+-- asyncTaskTTriggersAppReload (GT.AsyncTaskWithType { typ }) = asyncTaskTriggersAppReload typ
 
-asyncTaskTriggersMainPageReload :: GT.AsyncTaskType -> Boolean
-asyncTaskTriggersMainPageReload GT.UpdateNgramsCharts = true
-asyncTaskTriggersMainPageReload _                     = false
+-- asyncTaskTriggersMainPageReload :: GT.AsyncTaskType -> Boolean
+-- asyncTaskTriggersMainPageReload GT.UpdateNgramsCharts = true
+-- asyncTaskTriggersMainPageReload _                     = false
 
-asyncTaskTTriggersMainPageReload :: GT.AsyncTaskWithType -> Boolean
-asyncTaskTTriggersMainPageReload (GT.AsyncTaskWithType { typ }) = asyncTaskTriggersMainPageReload typ
+-- 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
+-- 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
+-- 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

src/Gargantext/Components/Forest/Tree/Node/Action/Upload.purs

@@ -556,16 +556,6 @@ uploadFile :: { contents  :: String
               , selection :: ListSelection.Selection
               , session   :: Session }
            -> AffRESTError GAT.Task
-{-
-uploadFile session NodeList id JSON { mName, contents } = do
-  let url = GR.NodeAPI NodeList (Just id) $ GT.asyncTaskTypePath GT.ListUpload
-    -- { input: { data: ..., filetype: "JSON", name: "..." } }
-  let body = { input: { data: contents
-                      , filetype: "JSON"
-                      , name: fromMaybe "" mName } }
-  task <- post session url body
-  pure $ GT.AsyncTaskWithType { task, typ: GT.Form }
-  -}
 uploadFile { contents, fileFormat, lang, fileType, id, nodeType, mName, selection, session } = do
   -- contents <- readAsText blob
   postWwwUrlencoded session p body

src/Gargantext/Components/GraphQL/Task.purs

-module Gargantext.Components.GraphQL.Task where
-
-import Gargantext.Types (AsyncTaskID)
-
-type AsyncTaskStatus = String
-type AsyncTaskType = String
-
-type AsyncTask =
-  { id     :: AsyncTaskID
-  , status :: AsyncTaskStatus}
-
-type AsyncTaskWithType =
-  { task :: AsyncTask
-  , typ  :: AsyncTaskType }

src/Gargantext/Components/Notifications/Types.purs

@@ -37,8 +37,7 @@ type NodeId = Int
 type UUID = String
 
 data Topic =
-    UpdateJobProgress GT.AsyncTaskID
-  | UpdateWorkerProgress GT.WorkerTask
+    UpdateWorkerProgress GT.WorkerTask
   | UpdateTree NodeId
 derive instance Generic Topic _
 instance Eq Topic where eq = genericEq
@@ -49,9 +48,6 @@ instance JSON.ReadForeign Topic where
   readImpl f = do
     { type: type_ } <- JSON.readImpl f :: F.F { type :: String }
     case type_ of
-      "update_job_progress" -> do
-        { j_id } <- JSON.readImpl f :: F.F { j_id :: GT.AsyncTaskID }
-        pure $ UpdateJobProgress j_id
       "update_worker_progress" -> do
         { ji } <- JSON.readImpl f :: F.F { ji :: GT.WorkerTask }
         pure $ UpdateWorkerProgress ji
@@ -60,8 +56,6 @@ instance JSON.ReadForeign Topic where
         pure $ UpdateTree node_id
       s -> F.fail $ F.ErrorAtProperty "type" $ F.ForeignError $ "unknown Topic type: " <> s
 instance JSON.WriteForeign Topic where
-  writeImpl (UpdateJobProgress j_id) = JSON.writeImpl { "type": "update_job_progress"
-                                                      , j_id }
   writeImpl (UpdateWorkerProgress ji) = JSON.writeImpl { "type": "update_worker_progress"
                                                        , ji }
   writeImpl (UpdateTree node_id) = JSON.writeImpl { "type": "update_tree"
@@ -85,17 +79,13 @@ instance JSON.WriteForeign WSRequest where
 
 
 data Notification =
-    NUpdateJobProgress GT.AsyncTaskID GT.AsyncProgress
-  | NUpdateWorkerProgress GT.WorkerTask GT.AsyncTaskLog
+    NUpdateWorkerProgress GT.WorkerTask GT.AsyncTaskLog
   | NUpdateTree NodeId
 derive instance Generic Notification _
 instance JSON.ReadForeign Notification where
   readImpl f = do
     { type: type_ } <- JSON.readImpl f :: F.F { type :: String }
     case type_ of
-      "update_job_progress" -> do
-        { j_id, job_status } <- JSON.readImpl f :: F.F { j_id :: GT.AsyncTaskID, job_status :: GT.AsyncProgress }
-        pure $ NUpdateJobProgress j_id job_status
       "update_worker_progress" -> do
         { job_info, job_log } <- JSON.readImpl f :: F.F { job_info :: GT.WorkerTask, job_log :: GT.AsyncTaskLog }
         pure $ NUpdateWorkerProgress job_info job_log
@@ -105,7 +95,6 @@ instance JSON.ReadForeign Notification where
       s -> F.fail $ F.ErrorAtProperty "type" $ F.ForeignError $ "unkown type: " <> s
 
 notificationTopics :: Notification -> Array Topic
-notificationTopics (NUpdateJobProgress taskId _) = [ UpdateJobProgress taskId ]
 notificationTopics (NUpdateWorkerProgress workerTask@(GT.WorkerTask { node_id }) _) =
   [ UpdateWorkerProgress workerTask ] <> updateTree
   where

src/Gargantext/Config/Utils.purs

@@ -10,7 +10,7 @@ import Effect (Effect)
 import Effect.Aff (Aff)
 import Effect.Class (liftEffect)
 import Gargantext.Config.REST (RESTError, logRESTError)
-import Gargantext.Types (AsyncEvent(..), AsyncProgress(..), AsyncTaskLog(..), AsyncTaskStatus(..), FrontendError(..), asyncTaskLogEventsErrorMessage)
+import Gargantext.Types (AsyncEvent(..), AsyncTaskLog(..), FrontendError(..), asyncTaskLogEventsErrorMessage)
 import Gargantext.Utils.Reactix as R2
 import Toestand as T
 

src/Gargantext/Context/Progress.purs

@@ -20,7 +20,6 @@ import Gargantext.Config.Utils (handleErrorInAsyncTaskLog, handleRESTError)
 import Gargantext.Hooks.FirstEffect (useFirstEffect')
 import Gargantext.Prelude
 import Gargantext.Sessions (Session)
-import Gargantext.Types (AsyncProgress)
 import Gargantext.Types as GT
 import Gargantext.Utils.Reactix as R2
 import Reactix as R
@@ -92,7 +91,6 @@ asyncProgressCpt = R2.hereComponent here "asyncProgress" hCpt where
         --   R.nothing
 
     useFirstEffect' $ do
-      -- let (GT.AsyncTaskWithType { task: GT.AsyncTask { id: taskId } }) = props.asyncTask
       let (GT.WorkerTask { message_id }) = props.asyncTask
       let cb n = do
             -- here.log2 "callback! for job update" taskId

src/Gargantext/Types.purs

@@ -750,64 +750,6 @@ asyncTaskTypePath UploadFile         = "async/file/add/"
 asyncTaskTypePath UploadFrameCalc    = "add/framecalc/async/"
 
 
-type AsyncTaskID = String
-
-data AsyncTaskStatus = IsRunning
-                     | IsPending
-                     | IsReceived
-                     | IsStarted
-                     | IsFailure
-                     | IsFinished
-                     | IsKilled
-derive instance Generic AsyncTaskStatus _
-instance JSON.ReadForeign AsyncTaskStatus where
-  readImpl = JSONG.enumSumRep
-instance JSON.WriteForeign AsyncTaskStatus where
-  writeImpl = JSON.writeImpl <<< show
-instance Show AsyncTaskStatus where
-  show = genericShow
-derive instance Eq AsyncTaskStatus
--- instance Read AsyncTaskStatus where
---   read "IsFailure"  = Just Failed
---   read "IsFinished" = Just Finished
---   read "IsKilled"   = Just Killed
---   read "IsPending"  = Just Pending
---   read "IsReceived" = Just Received
---   read "IsRunning"  = Just Running
---   read "IsStarted"  = Just Started
---   read _            = Nothing
-
-newtype AsyncTask =
-  AsyncTask { id     :: AsyncTaskID
-            , status :: AsyncTaskStatus
-            }
-
-derive instance Generic AsyncTask _
-derive instance Newtype AsyncTask _
-derive newtype instance JSON.ReadForeign AsyncTask
-derive newtype instance JSON.WriteForeign AsyncTask
-instance Eq AsyncTask where eq = genericEq
-
-newtype AsyncTaskWithType = AsyncTaskWithType
-  { task :: AsyncTask
-  , typ  :: AsyncTaskType
-  }
-derive instance Generic AsyncTaskWithType _
-derive instance Newtype AsyncTaskWithType _
-derive newtype instance JSON.ReadForeign AsyncTaskWithType
-derive newtype instance JSON.WriteForeign AsyncTaskWithType
-instance Eq AsyncTaskWithType where eq = genericEq
-
-newtype AsyncProgress = AsyncProgress
-  { id     :: AsyncTaskID
-  , error  :: Maybe String
-  , log    :: Array AsyncTaskLog
-  , status :: AsyncTaskStatus
-  }
-derive instance Generic AsyncProgress _
-derive instance Newtype AsyncProgress _
-derive newtype instance JSON.ReadForeign AsyncProgress
-
 newtype AsyncEvent = AsyncEvent
   { level :: String
   , message :: String
@@ -855,13 +797,6 @@ asyncTaskLogIsError atl@(AsyncTaskLog { events }) =
   asyncTaskLogIsFinished atl &&
   (A.length $ A.filter (\(AsyncEvent { level }) -> level == "ERROR") events) > 0
 
-progressPercent :: AsyncProgress -> Number
-progressPercent (AsyncProgress { log }) = perc
-  where
-    perc = case A.head log of
-      Nothing -> 0.0
-      Just atl -> asyncTaskLogPercent atl
-
 
 -- New type tasks (async workers)
 newtype WorkerTask = WorkerTask { message_id :: Number
@@ -923,3 +858,76 @@ defaultCacheParams = CacheParams
   { expandTableEdition    : false
   , showTree              : true
   }
+
+
+
+
+
+--- Old-style tasks
+
+
+-- type AsyncTaskID = String
+
+-- data AsyncTaskStatus = IsRunning
+--                      | IsPending
+--                      | IsReceived
+--                      | IsStarted
+--                      | IsFailure
+--                      | IsFinished
+--                      | IsKilled
+-- derive instance Generic AsyncTaskStatus _
+-- instance JSON.ReadForeign AsyncTaskStatus where
+--   readImpl = JSONG.enumSumRep
+-- instance JSON.WriteForeign AsyncTaskStatus where
+--   writeImpl = JSON.writeImpl <<< show
+-- instance Show AsyncTaskStatus where
+--   show = genericShow
+-- derive instance Eq AsyncTaskStatus
+-- instance Read AsyncTaskStatus where
+--   read "IsFailure"  = Just Failed
+--   read "IsFinished" = Just Finished
+--   read "IsKilled"   = Just Killed
+--   read "IsPending"  = Just Pending
+--   read "IsReceived" = Just Received
+--   read "IsRunning"  = Just Running
+--   read "IsStarted"  = Just Started
+--   read _            = Nothing
+
+-- newtype AsyncTask =
+--   AsyncTask { id     :: AsyncTaskID
+--             , status :: AsyncTaskStatus
+--             }
+
+-- derive instance Generic AsyncTask _
+-- derive instance Newtype AsyncTask _
+-- derive newtype instance JSON.ReadForeign AsyncTask
+-- derive newtype instance JSON.WriteForeign AsyncTask
+-- instance Eq AsyncTask where eq = genericEq
+
+-- newtype AsyncTaskWithType = AsyncTaskWithType
+--   { task :: AsyncTask
+--   , typ  :: AsyncTaskType
+--   }
+-- derive instance Generic AsyncTaskWithType _
+-- derive instance Newtype AsyncTaskWithType _
+-- derive newtype instance JSON.ReadForeign AsyncTaskWithType
+-- derive newtype instance JSON.WriteForeign AsyncTaskWithType
+-- instance Eq AsyncTaskWithType where eq = genericEq
+
+-- newtype AsyncProgress = AsyncProgress
+--   { id     :: AsyncTaskID
+--   , error  :: Maybe String
+--   , log    :: Array AsyncTaskLog
+--   , status :: AsyncTaskStatus
+--   }
+-- derive instance Generic AsyncProgress _
+-- derive instance Newtype AsyncProgress _
+-- derive newtype instance JSON.ReadForeign AsyncProgress
+
+
+-- progressPercent :: AsyncProgress -> Number
+-- progressPercent (AsyncProgress { log }) = perc
+--   where
+--     perc = case A.head log of
+--       Nothing -> 0.0
+--       Just atl -> asyncTaskLogPercent atl