[rest] handleRESTError with here parameter

parent b1f1c84a
...@@ -174,7 +174,7 @@ docViewCpt = here.component "docView" cpt where ...@@ -174,7 +174,7 @@ docViewCpt = here.component "docView" cpt where
eTask <- DFC.create session nodeId fdata eTask <- DFC.create session nodeId fdata
handleRESTError boxes.errors eTask handleRESTError here boxes.errors eTask
\t -> liftEffect $ launchDocumentCreationProgress \t -> liftEffect $ launchDocumentCreationProgress
boxes boxes
session session
...@@ -264,7 +264,7 @@ scanDocumentCreationProgress boxes session nodeId currentTask cbk = do ...@@ -264,7 +264,7 @@ scanDocumentCreationProgress boxes session nodeId currentTask cbk = do
eTask <- DFC.createProgress session nodeId currentTask eTask <- DFC.createProgress session nodeId currentTask
handleRESTError boxes.errors eTask handleRESTError here boxes.errors eTask
\asyncProgress -> liftEffect do \asyncProgress -> liftEffect do
let let
GT.AsyncProgress { status } = asyncProgress GT.AsyncProgress { status } = asyncProgress
......
...@@ -381,18 +381,18 @@ performAction = performAction' where ...@@ -381,18 +381,18 @@ performAction = performAction' where
updateNode params { boxes: { errors, tasks }, nodeId: id, session } = do updateNode params { boxes: { errors, tasks }, nodeId: id, session } = do
eTask <- updateRequest params session id eTask <- updateRequest params session id
handleRESTError errors eTask $ \task -> liftEffect $ do handleRESTError here errors eTask $ \task -> liftEffect $ do
GAT.insert id task tasks GAT.insert id task tasks
here.log2 "[performAction] UpdateNode task:" task here.log2 "[performAction] UpdateNode task:" task
shareTeam username { boxes: { errors }, nodeId: id, session } = do shareTeam username { boxes: { errors }, nodeId: id, session } = do
eTask <- Share.shareReq session id $ Share.ShareTeamParams { username } eTask <- Share.shareReq session id $ Share.ShareTeamParams { username }
handleRESTError errors eTask $ \_task -> pure unit handleRESTError here errors eTask $ \_task -> pure unit
sharePublic params p@{ boxes: { errors }, session } = traverse_ f params where sharePublic params p@{ boxes: { errors }, session } = traverse_ f params where
f (SubTreeOut { in: inId, out }) = do f (SubTreeOut { in: inId, out }) = do
eTask <- Share.shareReq session inId $ Share.SharePublicParams { node_id: out } eTask <- Share.shareReq session inId $ Share.SharePublicParams { node_id: out }
handleRESTError errors eTask $ \_task -> pure unit handleRESTError here errors eTask $ \_task -> pure unit
refreshFolders p refreshFolders p
addContact params { nodeId: id, session } = addContact params { nodeId: id, session } =
...@@ -400,40 +400,40 @@ performAction = performAction' where ...@@ -400,40 +400,40 @@ performAction = performAction' where
uploadFile' nodeType fileType fileFormat lang mName contents { boxes: { errors, tasks }, nodeId: id, session } selection = do uploadFile' nodeType fileType fileFormat lang mName contents { boxes: { errors, tasks }, nodeId: id, session } selection = do
eTask <- uploadFile { contents, fileType, fileFormat, lang, id, nodeType, mName, selection, session } eTask <- uploadFile { contents, fileType, fileFormat, lang, id, nodeType, mName, selection, session }
handleRESTError errors eTask $ \task -> liftEffect $ do handleRESTError here errors eTask $ \task -> liftEffect $ do
GAT.insert id task tasks GAT.insert id task tasks
here.log2 "[performAction] UploadFile, uploaded, task:" task here.log2 "[performAction] UploadFile, uploaded, task:" task
uploadArbitraryFile' fileFormat mName blob { boxes: { errors, tasks }, nodeId: id, session } selection = do uploadArbitraryFile' fileFormat mName blob { boxes: { errors, tasks }, nodeId: id, session } selection = do
eTask <- uploadArbitraryFile session id { blob, fileFormat, mName } selection eTask <- uploadArbitraryFile session id { blob, fileFormat, mName } selection
handleRESTError errors eTask $ \task -> liftEffect $ do handleRESTError here errors eTask $ \task -> liftEffect $ do
GAT.insert id task tasks GAT.insert id task tasks
here.log2 "[performAction] UploadArbitraryFile, uploaded, task:" task here.log2 "[performAction] UploadArbitraryFile, uploaded, task:" task
moveNode params p@{ boxes: { errors }, session } = traverse_ f params where moveNode params p@{ boxes: { errors }, session } = traverse_ f params where
f (SubTreeOut { in: in', out }) = do f (SubTreeOut { in: in', out }) = do
eTask <- moveNodeReq session in' out eTask <- moveNodeReq session in' out
handleRESTError errors eTask $ \_task -> pure unit handleRESTError here errors eTask $ \_task -> pure unit
refreshFolders p refreshFolders p
mergeNode params p@{ boxes: { errors }, session } = traverse_ f params where mergeNode params p@{ boxes: { errors }, session } = traverse_ f params where
f (SubTreeOut { in: in', out }) = do f (SubTreeOut { in: in', out }) = do
eTask <- mergeNodeReq session in' out eTask <- mergeNodeReq session in' out
handleRESTError errors eTask $ \_task -> pure unit handleRESTError here errors eTask $ \_task -> pure unit
refreshFolders p refreshFolders p
linkNode nodeType params p@{ boxes: { errors }, session } = traverse_ f params where linkNode nodeType params p@{ boxes: { errors }, session } = traverse_ f params where
f (SubTreeOut { in: in', out }) = do f (SubTreeOut { in: in', out }) = do
eTask <- linkNodeReq session nodeType in' out eTask <- linkNodeReq session nodeType in' out
handleRESTError errors eTask $ \_task -> pure unit handleRESTError here errors eTask $ \_task -> pure unit
refreshFolders p refreshFolders p
renameNode name p@{ boxes: { errors }, nodeId: id, session } = do renameNode name p@{ boxes: { errors }, nodeId: id, session } = do
eTask <- rename session id $ RenameValue { text: name } eTask <- rename session id $ RenameValue { text: name }
handleRESTError errors eTask $ \_task -> pure unit handleRESTError here errors eTask $ \_task -> pure unit
refreshFolders p refreshFolders p
addNode' name nodeType p@{ boxes: { errors }, nodeId: id, session } = do addNode' name nodeType p@{ boxes: { errors }, nodeId: id, session } = do
eTask <- addNode session id $ AddNodeValue {name, nodeType} eTask <- addNode session id $ AddNodeValue {name, nodeType}
handleRESTError errors eTask $ \_task -> pure unit handleRESTError here errors eTask $ \_task -> pure unit
refreshFolders p refreshFolders p
...@@ -315,78 +315,78 @@ doSearch task { boxes: { tasks }, tree: NTree (LNode {id}) _ } = liftEffect $ do ...@@ -315,78 +315,78 @@ doSearch task { boxes: { tasks }, tree: NTree (LNode {id}) _ } = liftEffect $ do
updateNode params p@{ boxes: { errors, tasks }, session, tree: (NTree (LNode {id}) _) } = do updateNode params p@{ boxes: { errors, tasks }, session, tree: (NTree (LNode {id}) _) } = do
eTask <- updateRequest params session id eTask <- updateRequest params session id
handleRESTError errors eTask $ \task -> liftEffect $ do handleRESTError here errors eTask $ \task -> liftEffect $ do
GAT.insert id task tasks GAT.insert id task tasks
here.log2 "[updateNode] UpdateNode task:" task here.log2 "[updateNode] UpdateNode task:" task
closeBox p closeBox p
renameNode name p@{ boxes: { errors }, session, tree: (NTree (LNode {id}) _) } = do renameNode name p@{ boxes: { errors }, session, tree: (NTree (LNode {id}) _) } = do
eTask <- rename session id $ RenameValue { text: name } eTask <- rename session id $ RenameValue { text: name }
handleRESTError errors eTask $ \_task -> pure unit handleRESTError here errors eTask $ \_task -> pure unit
refreshTree p refreshTree p
shareTeam username { boxes: { errors }, session, tree: (NTree (LNode {id}) _)} = do shareTeam username { boxes: { errors }, session, tree: (NTree (LNode {id}) _)} = do
eTask <- Share.shareReq session id $ Share.ShareTeamParams { username } eTask <- Share.shareReq session id $ Share.ShareTeamParams { username }
handleRESTError errors eTask $ \_task -> pure unit handleRESTError here errors eTask $ \_task -> pure unit
sharePublic params p@{ boxes: { errors, forestOpen }, session } = traverse_ f params where sharePublic params p@{ boxes: { errors, forestOpen }, session } = traverse_ f params where
f (SubTreeOut { in: inId, out }) = do f (SubTreeOut { in: inId, out }) = do
eTask <- Share.shareReq session inId $ Share.SharePublicParams { node_id: out } eTask <- Share.shareReq session inId $ Share.SharePublicParams { node_id: out }
handleRESTError errors eTask $ \_task -> do handleRESTError here errors eTask $ \_task -> do
liftEffect $ T.modify_ (openNodesInsert (mkNodeId p.session out)) forestOpen liftEffect $ T.modify_ (openNodesInsert (mkNodeId p.session out)) forestOpen
refreshTree p refreshTree p
addContact params { boxes: { errors }, session, tree: (NTree (LNode {id}) _) } = do addContact params { boxes: { errors }, session, tree: (NTree (LNode {id}) _) } = do
eTask <- Contact.contactReq session id params eTask <- Contact.contactReq session id params
handleRESTError errors eTask $ \_task -> pure unit handleRESTError here errors eTask $ \_task -> pure unit
addNode' name nodeType p@{ boxes: { errors, forestOpen }, session, tree: (NTree (LNode { id }) _) } = do addNode' name nodeType p@{ boxes: { errors, forestOpen }, session, tree: (NTree (LNode { id }) _) } = do
eId <- addNode session id $ AddNodeValue { name, nodeType } eId <- addNode session id $ AddNodeValue { name, nodeType }
handleRESTError errors eId $ \_id -> liftEffect $ do handleRESTError here errors eId $ \_id -> liftEffect $ do
liftEffect $ T.modify_ (openNodesInsert (mkNodeId session id)) forestOpen liftEffect $ T.modify_ (openNodesInsert (mkNodeId session id)) forestOpen
refreshTree p refreshTree p
uploadFile' nodeType fileType fileFormat lang mName contents p@{ boxes: { errors, tasks }, session, tree: (NTree (LNode { id }) _) } selection = do uploadFile' nodeType fileType fileFormat lang mName contents p@{ boxes: { errors, tasks }, session, tree: (NTree (LNode { id }) _) } selection = do
eTask <- uploadFile { contents, fileFormat, fileType, id, lang, mName, nodeType, selection, session } eTask <- uploadFile { contents, fileFormat, fileType, id, lang, mName, nodeType, selection, session }
handleRESTError errors eTask $ \task -> liftEffect $ do handleRESTError here errors eTask $ \task -> liftEffect $ do
GAT.insert id task tasks GAT.insert id task tasks
here.log2 "[uploadFile'] UploadFile, uploaded, task:" task here.log2 "[uploadFile'] UploadFile, uploaded, task:" task
closeBox p closeBox p
uploadArbitraryFile' fileFormat mName blob p@{ boxes: { errors, tasks }, session, tree: (NTree (LNode { id }) _) } selection = do uploadArbitraryFile' fileFormat mName blob p@{ boxes: { errors, tasks }, session, tree: (NTree (LNode { id }) _) } selection = do
eTask <- uploadArbitraryFile session id { blob, fileFormat, mName } selection eTask <- uploadArbitraryFile session id { blob, fileFormat, mName } selection
handleRESTError errors eTask $ \task -> liftEffect $ do handleRESTError here errors eTask $ \task -> liftEffect $ do
GAT.insert id task tasks GAT.insert id task tasks
here.log2 "[uploadArbitraryFile'] UploadArbitraryFile, uploaded, task:" task here.log2 "[uploadArbitraryFile'] UploadArbitraryFile, uploaded, task:" task
uploadFrameCalc' lang p@{ boxes: { errors, tasks }, session, tree: (NTree (LNode { id }) _) } selection = do uploadFrameCalc' lang p@{ boxes: { errors, tasks }, session, tree: (NTree (LNode { id }) _) } selection = do
eTask <- uploadFrameCalc session id lang selection eTask <- uploadFrameCalc session id lang selection
handleRESTError errors eTask $ \task -> liftEffect $ do handleRESTError here errors eTask $ \task -> liftEffect $ do
GAT.insert id task tasks GAT.insert id task tasks
here.log2 "[performAction] UploadFrameCalc, uploaded, task:" task here.log2 "[performAction] UploadFrameCalc, uploaded, task:" task
moveNode params p@{ boxes: { errors, forestOpen }, session } = traverse_ f params where moveNode params p@{ boxes: { errors, forestOpen }, session } = traverse_ f params where
f (SubTreeOut { in: in', out }) = do f (SubTreeOut { in: in', out }) = do
eTask <- moveNodeReq session in' out eTask <- moveNodeReq session in' out
handleRESTError errors eTask $ \_task -> pure unit handleRESTError here errors eTask $ \_task -> pure unit
liftEffect $ T.modify_ (openNodesInsert (mkNodeId session out)) forestOpen liftEffect $ T.modify_ (openNodesInsert (mkNodeId session out)) forestOpen
refreshTree p refreshTree p
mergeNode params p@{ boxes: { errors }, session } = traverse_ f params where mergeNode params p@{ boxes: { errors }, session } = traverse_ f params where
f (SubTreeOut { in: in', out }) = do f (SubTreeOut { in: in', out }) = do
eTask <- mergeNodeReq session in' out eTask <- mergeNodeReq session in' out
handleRESTError errors eTask $ \_task -> pure unit handleRESTError here errors eTask $ \_task -> pure unit
refreshTree p refreshTree p
linkNode nodeType params p@{ boxes: { errors }, session } = traverse_ f params where linkNode nodeType params p@{ boxes: { errors }, session } = traverse_ f params where
f (SubTreeOut { in: in', out }) = do f (SubTreeOut { in: in', out }) = do
eTask <- linkNodeReq session nodeType in' out eTask <- linkNodeReq session nodeType in' out
handleRESTError errors eTask $ \_task -> pure unit handleRESTError here errors eTask $ \_task -> pure unit
refreshTree p refreshTree p
documentsFromWriteNodes params p@{ boxes: { errors, tasks }, session, tree: NTree (LNode { id }) _ } = do documentsFromWriteNodes params p@{ boxes: { errors, tasks }, session, tree: NTree (LNode { id }) _ } = do
eTask <- documentsFromWriteNodesReq session params eTask <- documentsFromWriteNodesReq session params
handleRESTError errors eTask $ \task -> liftEffect $ do handleRESTError here errors eTask $ \task -> liftEffect $ do
GAT.insert id task tasks GAT.insert id task tasks
pure unit pure unit
refreshTree p refreshTree p
......
...@@ -621,7 +621,7 @@ triggerSearch { onSearch, errors, session, selection, search } = ...@@ -621,7 +621,7 @@ triggerSearch { onSearch, errors, session, selection, search } =
Just id -> do Just id -> do
liftEffect $ here.log2 "[triggerSearch] searchQuery" $ searchQuery selection search liftEffect $ here.log2 "[triggerSearch] searchQuery" $ searchQuery selection search
eTask <- performSearch session id $ searchQuery selection search eTask <- performSearch session id $ searchQuery selection search
handleRESTError errors eTask $ \task -> liftEffect $ do handleRESTError here errors eTask $ \task -> liftEffect $ do
here.log2 "[triggerSearch] task" task here.log2 "[triggerSearch] task" task
onSearch task onSearch task
......
...@@ -54,7 +54,7 @@ asyncProgressBarCpt = here.component "asyncProgressBar" cpt ...@@ -54,7 +54,7 @@ asyncProgressBarCpt = here.component "asyncProgressBar" cpt
launchAff_ $ do launchAff_ $ do
let rdata = (RX.pick props :: Record QueryProgressData) let rdata = (RX.pick props :: Record QueryProgressData)
eAsyncProgress <- queryProgress rdata eAsyncProgress <- queryProgress rdata
handleRESTError errors eAsyncProgress $ \asyncProgress -> liftEffect $ do handleRESTError here errors eAsyncProgress $ \asyncProgress -> liftEffect $ do
let GT.AsyncProgress { status } = asyncProgress let GT.AsyncProgress { status } = asyncProgress
T.write_ (min 100.0 $ GT.progressPercent asyncProgress) progress T.write_ (min 100.0 $ GT.progressPercent asyncProgress) progress
if (status == GT.IsFinished) || (status == GT.IsKilled) || (status == GT.IsFailure) then do if (status == GT.IsFinished) || (status == GT.IsKilled) || (status == GT.IsFailure) then do
......
...@@ -130,7 +130,7 @@ userLayoutWithKeyCpt = here.component "userLayoutWithKey" cpt where ...@@ -130,7 +130,7 @@ userLayoutWithKeyCpt = here.component "userLayoutWithKey" cpt where
launchAff_ $ do launchAff_ $ do
let Session {userId} = session let Session {userId} = session
res <- saveUserInfo session userId ui res <- saveUserInfo session userId ui
handleRESTError errors res $ \_ -> handleRESTError here errors res $ \_ ->
liftEffect $ T2.reload reload liftEffect $ T2.reload reload
--saveContactHyperdata :: Session -> Int -> HyperdataUser -> AffRESTError Int --saveContactHyperdata :: Session -> Int -> HyperdataUser -> AffRESTError Int
......
...@@ -9,7 +9,7 @@ import Data.Maybe (fromMaybe) ...@@ -9,7 +9,7 @@ import Data.Maybe (fromMaybe)
import Effect (Effect) import Effect (Effect)
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import Gargantext.Config.REST (RESTError) import Gargantext.Config.REST (RESTError, logRESTError)
import Gargantext.Types (AsyncEvent(..), AsyncProgress(..), AsyncTaskLog(..), AsyncTaskStatus(..), FrontendError(..)) import Gargantext.Types (AsyncEvent(..), AsyncProgress(..), AsyncTaskLog(..), AsyncTaskStatus(..), FrontendError(..))
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Toestand as T import Toestand as T
...@@ -18,14 +18,16 @@ here :: R2.Here ...@@ -18,14 +18,16 @@ here :: R2.Here
here = R2.here "Gargantext.Config.Utils" here = R2.here "Gargantext.Config.Utils"
handleRESTError :: forall a. handleRESTError :: forall a.
T.Box (Array FrontendError) R2.Here
-> T.Box (Array FrontendError)
-> Either RESTError a -> Either RESTError a
-> (a -> Aff Unit) -> (a -> Aff Unit)
-> Aff Unit -> Aff Unit
handleRESTError errors (Left error) _ = liftEffect $ do handleRESTError here' errors (Left error) _ = liftEffect $ do
T.modify_ (A.cons $ FRESTError { error }) errors T.modify_ (A.cons $ FRESTError { error }) errors
here.warn2 "[handleTaskError] RESTError" error logRESTError here' "[handleTaskError]" error
handleRESTError _ (Right task) handler = handler task -- here.warn2 "[handleTaskError] RESTError" error
handleRESTError _ _ (Right task) handler = handler task
handleErrorInAsyncProgress :: T.Box (Array FrontendError) handleErrorInAsyncProgress :: T.Box (Array FrontendError)
-> AsyncProgress -> AsyncProgress
......
...@@ -31,6 +31,9 @@ type AsyncProps = ...@@ -31,6 +31,9 @@ type AsyncProps =
, session :: Session , session :: Session
) )
here :: R2.Here
here = R2.here "Gargantext.Context.Progress"
asyncProgress :: R2.Component AsyncProps asyncProgress :: R2.Component AsyncProps
asyncProgress = R2.component component asyncProgress = R2.component component
component :: R.Component AsyncProps component :: R.Component AsyncProps
...@@ -49,7 +52,7 @@ component = R.hooksComponent "asyncProgressContext" cpt where ...@@ -49,7 +52,7 @@ component = R.hooksComponent "asyncProgressContext" cpt where
let rdata = (RX.pick props :: Record QueryProgressData) let rdata = (RX.pick props :: Record QueryProgressData)
eAsyncProgress <- queryProgress rdata eAsyncProgress <- queryProgress rdata
handleRESTError errors eAsyncProgress onProgress handleRESTError here errors eAsyncProgress onProgress
onProgress :: AsyncProgress -> Aff Unit onProgress :: AsyncProgress -> Aff Unit
onProgress value = liftEffect do onProgress value = liftEffect do
......
...@@ -531,7 +531,7 @@ chartsAfterSync :: forall props discard. ...@@ -531,7 +531,7 @@ chartsAfterSync :: forall props discard.
-> Aff Unit -> Aff Unit
chartsAfterSync path'@{ nodeId } errors tasks _ = do chartsAfterSync path'@{ nodeId } errors tasks _ = do
eTask <- postNgramsChartsAsync path' eTask <- postNgramsChartsAsync path'
handleRESTError errors eTask $ \task -> liftEffect $ do handleRESTError here errors eTask $ \task -> liftEffect $ do
here.log2 "[chartsAfterSync] Synchronize task" task here.log2 "[chartsAfterSync] Synchronize task" task
GAT.insert nodeId task tasks GAT.insert nodeId task tasks
......
...@@ -181,7 +181,7 @@ useCachedAPILoaderEffect { boxes: { errors } ...@@ -181,7 +181,7 @@ useCachedAPILoaderEffect { boxes: { errors }
-- TODO Parallelize? -- TODO Parallelize?
hr@(HashedResponse { hash }) <- GUC.cachedJson cache req hr@(HashedResponse { hash }) <- GUC.cachedJson cache req
eCacheReal <- cacheEndpoint path eCacheReal <- cacheEndpoint path
handleRESTError errors eCacheReal $ \cacheReal -> do handleRESTError here errors eCacheReal $ \cacheReal -> do
val <- if hash == cacheReal then val <- if hash == cacheReal then
pure hr pure hr
else do else do
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment