Commit 659fe381 authored by Mart Lubbers's avatar Mart Lubbers

add serverinterruptevent

parent 01a94085
Pipeline #41342 passed with stage
in 7 minutes and 30 seconds
......@@ -263,8 +263,8 @@ waitWithoutUI datetime =
Task (eval param) >>*
[OnValue (ifValue ((<=) timespec) \_ -> get currentDateTime)]
where
eval _ DestroyEvent _ iworld
= (DestroyedResult, iworld)
eval _ event _ iworld
| isDestroyOrInterrupt event = (DestroyedResult, iworld)
eval param event {taskId,lastEval} iworld
# (Ok (ReadingDone now),iworld) = readRegister taskId (sdsFocus param iworldTimespec) iworld
= (ValueResult (Value now False) (mkTaskEvalInfo lastEval) (mkUIIfReset event (ui UIEmpty)) (Task (eval param)), iworld)
......
......@@ -30,8 +30,8 @@ where
proxyTask :: (Shared sds (TaskValue a)) (*IWorld -> *IWorld) -> (Task a) | iTask a & RWShared sds
proxyTask value_share onDestroy = Task eval
where
eval DestroyEvent evalOpts iworld
= (DestroyedResult, onDestroy iworld)
eval event evalOpts iworld
| isDestroyOrInterrupt event = (DestroyedResult, onDestroy iworld)
eval event {taskId,lastEval} iworld
# (val,iworld) = readRegister taskId value_share iworld
= case val of
......
......@@ -395,8 +395,8 @@ asyncSDSLoaderUI Modify = uia UIProgressBar (textAttr "Modifying data")
readCompletely :: (sds () r w) (TaskValue a) (r Event TaskEvalOpts *IWorld -> *(TaskResult a, *IWorld)) Event TaskEvalOpts !*IWorld
-> *(TaskResult a, *IWorld) | Readable sds & TC r & TC w
readCompletely _ _ _ DestroyEvent _ iworld
= (DestroyedResult, iworld)
readCompletely _ _ _ event _ iworld
| isDestroyOrInterrupt event = (DestroyedResult, iworld)
readCompletely sds tv cont event evalOpts=:{TaskEvalOpts|taskId,lastEval} iworld
= case read sds (TaskContext taskId) iworld of
(Error e, iworld) = (ExceptionResult e, iworld)
......@@ -407,8 +407,8 @@ readCompletely sds tv cont event evalOpts=:{TaskEvalOpts|taskId,lastEval} iworld
writeCompletely :: w (sds () r w) (TaskValue a) (Event TaskEvalOpts *IWorld -> *(TaskResult a, *IWorld)) Event TaskEvalOpts !*IWorld
-> *(TaskResult a, *IWorld) | Writeable sds & TC r & TC w
writeCompletely _ _ _ cont DestroyEvent evalOpts iworld
= (DestroyedResult, iworld)
writeCompletely _ _ _ cont event evalOpts iworld
| isDestroyOrInterrupt event = (DestroyedResult, iworld)
writeCompletely w sds tv cont event evalOpts=:{taskId,lastEval} iworld
= case write w sds (TaskContext taskId) iworld of
(Error e, iworld) = (ExceptionResult e, iworld)
......@@ -419,8 +419,8 @@ writeCompletely w sds tv cont event evalOpts=:{taskId,lastEval} iworld
modifyCompletely :: (r -> w) (sds () r w) (TaskValue a) (Event -> UIChange) (w Event TaskEvalOpts *IWorld -> *(TaskResult a, *IWorld)) Event TaskEvalOpts !*IWorld
-> *(TaskResult a, *IWorld) | TC r & TC w & Modifiable sds
modifyCompletely _ _ _ _ cont DestroyEvent evalOpts iworld
= (DestroyedResult, iworld)
modifyCompletely _ _ _ _ cont event evalOpts iworld
| isDestroyOrInterrupt event = (DestroyedResult, iworld)
modifyCompletely modfun sds tv ui cont event evalOpts=:{taskId,lastEval} iworld
= case modify modfun sds (TaskContext taskId) iworld of
(Error e, iworld) = (ExceptionResult e, iworld)
......@@ -431,8 +431,8 @@ modifyCompletely modfun sds tv ui cont event evalOpts=:{taskId,lastEval} iworld
readRegisterCompletely :: (sds () r w) (TaskValue a) (Event -> UIChange) (r Event TaskEvalOpts *IWorld -> *(TaskResult a, *IWorld)) Event TaskEvalOpts !*IWorld
-> *(TaskResult a, *IWorld) | TC r & TC w & Registrable sds
readRegisterCompletely _ _ _ cont DestroyEvent evalOpts iworld
= (DestroyedResult, iworld)
readRegisterCompletely _ _ _ cont event evalOpts iworld
| isDestroyOrInterrupt event = (DestroyedResult, iworld)
readRegisterCompletely sds tv ui cont event evalOpts=:{taskId,lastEval} iworld
| not (isRefreshForTask event taskId)
= (ValueResult tv (mkTaskEvalInfo lastEval) (ui event) (Task (readRegisterCompletely sds tv ui cont)), iworld)
......
......@@ -24,8 +24,8 @@ derive gDefault TaskId, TaskListFilter
everyTick :: (*IWorld -> *(MaybeError TaskException (), *IWorld)) -> Task ()
everyTick f = Task eval
where
eval DestroyEvent evalOpts iworld
= (DestroyedResult, iworld)
eval event evalOpts iworld
| isDestroyOrInterrupt event = (DestroyedResult, iworld)
eval event {taskId,lastEval} iworld
# (merr, iworld) = f iworld
| isError merr = (ExceptionResult (fromError merr), iworld)
......
......@@ -34,8 +34,8 @@ import Text
sdsServiceTask :: Int -> Task ()
sdsServiceTask port = withShared 'Map'.newMap \sds->withSymbols \symbols->Task (evalinit sds symbols)
where
evalinit _ _ DestroyEvent _ iworld
= (DestroyedResult, iworld)
evalinit _ _ event _ iworld
| isDestroyOrInterrupt event = (DestroyedResult, iworld)
evalinit sds symbols event {taskId,lastEval} iworld
# (mbError, iworld) = addListener taskId port True (wrapIWorldConnectionTask handlers sds) iworld
| mbError=:(Error _) = showException "initialization" (fromError mbError) iworld
......@@ -51,11 +51,12 @@ where
# iworld = iShowErr ["SDSService exception during " +++ base +++ ": " +++ str] iworld
= (ExceptionResult taskException, iworld)
eval DestroyEvent evalOpts iworld=:{ioStates}
# ioStates = case 'Map'.get taskId ioStates of
Just (IOActive values) = 'Map'.put taskId (IODestroyed values) ioStates
_ = ioStates
= (DestroyedResult, {iworld & ioStates = ioStates})
eval event evalOpts iworld=:{ioStates}
| isDestroyOrInterrupt event
# ioStates = case 'Map'.get taskId ioStates of
Just (IOActive values) = 'Map'.put taskId (IODestroyed values) ioStates
_ = ioStates
= (DestroyedResult, {iworld & ioStates = ioStates})
eval (RefreshEvent taskIds) {lastEval} iworld
| not ('Set'.member taskId taskIds)
= (ValueResult
......
......@@ -118,7 +118,8 @@ where
mkInstantTask :: (TaskId *IWorld -> (MaybeError TaskException a,*IWorld)) -> Task a
mkInstantTask iworldfun = Task eval
where
eval DestroyEvent _ iworld = (DestroyedResult, iworld)
eval event _ iworld
| isDestroyOrInterrupt event = (DestroyedResult, iworld)
eval event {taskId,lastEval} iworld
= case iworldfun taskId iworld of
(Ok a,iworld) = (ValueResult (Value a True) (mkTaskEvalInfo lastEval) (mkUIIfReset event (ui UIEmpty)) (treturn a), iworld)
......@@ -127,6 +128,7 @@ where
nopTask :: Task a | iTask a
nopTask = Task eval
where
eval DestroyEvent _ iworld = (DestroyedResult, iworld)
eval event _ iworld
| isDestroyOrInterrupt event = (DestroyedResult, iworld)
eval event {lastEval} iworld
= (ValueResult NoValue (mkTaskEvalInfo lastEval) (mkUIIfReset event (ui UIEmpty)) (Task eval), iworld)
......@@ -40,6 +40,8 @@ generateRandomString :: !Int !*IWorld -> (!String, !*IWorld)
isRefreshForTask :: !Event !TaskId -> Bool
isDestroyOrInterrupt :: !Event -> Bool
mkTaskEvalInfo :: !TaskTime -> TaskEvalInfo
mkUIIfReset :: !Event !UI -> UIChange
......
......@@ -90,6 +90,11 @@ isRefreshForTask (RefreshEvent taskIds) taskId = 'DS'.member taskId taskIds
isRefreshForTask ResetEvent _ = True
isRefreshForTask _ _ = False
isDestroyOrInterrupt :: !Event -> Bool
isDestroyOrInterrupt DestroyEvent = True
isDestroyOrInterrupt ServerInterruptedEvent = True
isDestroyOrInterrupt _ = False
mkTaskEvalInfo :: !TaskTime -> TaskEvalInfo
mkTaskEvalInfo ts = {TaskEvalInfo|lastEvent=ts,removedTasks=[]}
......
......@@ -8,6 +8,7 @@ import iTasks.UI.Layout
import iTasks.Internal.TaskState
import iTasks.Internal.TaskEval
import iTasks.Internal.Task
import iTasks.Internal.Util
import Data.Maybe, Data.Error, Data.Functor, Text.GenJSON, StdString
import qualified Data.Set as DS
import qualified Data.Map as DM
......@@ -87,8 +88,8 @@ where
evalinit event = eval (initLUI (ui UIEmpty), initLUIMoves) task ResetEvent
//Cleanup duty simply passed to inner task
eval _ (Task inner) DestroyEvent evalOpts iworld
= inner DestroyEvent evalOpts iworld
eval _ (Task inner) event evalOpts iworld
| isDestroyOrInterrupt event = inner event evalOpts iworld
//On Reset events, we (re-)apply the layout
eval state (Task inner) ResetEvent evalOpts iworld
= case inner ResetEvent evalOpts iworld of
......
......@@ -65,8 +65,8 @@ where
//Initial setup:
//Destroyed before first evaluation
//evalinit :: !Event !TaskEvalOpts !*IWorld -> *(TaskResult a, !*IWorld)
evalinit DestroyEvent evalOpts iworld
= (DestroyedResult,iworld)
evalinit event evalOpts iworld
| isDestroyOrInterrupt event = (DestroyedResult,iworld)
//Check for duplicates
evalinit event evalOpts iworld
# iworld = if (length (removeDupBy actionEq conts) == length conts)
......@@ -81,11 +81,12 @@ where
//Evaluating the lhs
//Destroyed when executing the lhs
//evalleft :: (Task a) [String] TaskId Event TaskEvalOpts !*IWorld -> *(TaskResult a, IWorld)
evalleft (Task lhs) prevEnabledActions leftTaskId DestroyEvent evalOpts iworld
= case lhs DestroyEvent {TaskEvalOpts|evalOpts&taskId=leftTaskId} iworld of
(DestroyedResult, iworld) = (DestroyedResult, iworld)
(ExceptionResult e, iworld) = (ExceptionResult e, iworld)
(ValueResult _ _ _ _,iworld) = (ExceptionResult (exception "Failed destroying lhs in step"), iworld)
evalleft (Task lhs) prevEnabledActions leftTaskId event evalOpts iworld
| isDestroyOrInterrupt event
= case lhs event {TaskEvalOpts|evalOpts&taskId=leftTaskId} iworld of
(DestroyedResult, iworld) = (DestroyedResult, iworld)
(ExceptionResult e, iworld) = (ExceptionResult e, iworld)
(ValueResult _ _ _ _,iworld) = (ExceptionResult (exception "Failed destroying lhs in step"), iworld)
//Execute lhs
evalleft (Task lhs) prevEnabledActions leftTaskId event evalOpts=:{lastEval,taskId} iworld
# mbAction = matchAction taskId event
......@@ -210,8 +211,9 @@ parallel :: ![(ParallelTaskType,ParallelTask a)] [TaskCont [(Int,TaskValue a)] (
parallel initTasks conts = Task evalinit
where
//Destroyed before initial execution
evalinit DestroyEvent _ iworld
= (DestroyedResult, iworld)
evalinit event _ iworld
| isDestroyOrInterrupt event
= (DestroyedResult, iworld)
//Initialize the task list
evalinit event evalOpts=:{TaskEvalOpts|taskId} iworld
//Create the states for the initial tasks
......@@ -240,6 +242,8 @@ where
err = (err, iworld)
err = (liftError err, iworld)
eval _ _ ServerInterruptedEvent _ iworld
= (DestroyedResult, iworld)
eval _ _ DestroyEvent {TaskEvalOpts|taskId} iworld
= destroyParallelTasks taskId iworld
......
......@@ -25,7 +25,8 @@ withShared :: !b !((SimpleSDSLens b) -> Task a) -> Task a | iTask a & iTask b
withShared initial stask = Task evalinit
where
//Initialization
evalinit DestroyEvent _ iworld = (DestroyedResult,iworld)
evalinit event _ iworld
| isDestroyOrInterrupt event = (DestroyedResult,iworld)
evalinit event evalOpts=:{TaskEvalOpts|taskId} iworld
# (taskIda, iworld) = getNextTaskId iworld
......@@ -40,6 +41,8 @@ where
iworld
//Running
eval innerTaskId (Task inner) ServerInterruptedEvent opts iworld
= inner ServerInterruptedEvent {TaskEvalOpts|opts&taskId=innerTaskId} iworld
eval innerTaskId (Task inner) DestroyEvent opts iworld
// free memory of share
# (e, iworld) =
......@@ -75,8 +78,8 @@ withTemporaryDirectory :: (FilePath -> Task a) -> Task a | iTask a
withTemporaryDirectory taskfun = Task evalinit
where
//Initialization
evalinit DestroyEvent _ iworld
= (DestroyedResult, iworld)
evalinit event _ iworld
| isDestroyOrInterrupt event = (DestroyedResult, iworld)
evalinit event eo=:{TaskEvalOpts|taskId} iworld=:{options={appVersion,tempDirPath}}
# tmpDir = tempDirPath </> (appVersion +++ "-" +++ toString taskId +++ "-tmpdir")
# (taskIda,iworld=:{world}) = getNextTaskId iworld
......@@ -87,6 +90,8 @@ where
Error e = (ExceptionResult (exception ("Could not create temporary directory: " +++ tmpDir +++ " (" +++ toString e +++ ")")) , iworld)
//Actual task execution
//First destroy the inner task, then delete the tmp dir
eval tmpDir innerTaskId (Task inner) ServerInterruptedEvent evalOpts iworld
= inner ServerInterruptedEvent {TaskEvalOpts|evalOpts&taskId=innerTaskId} iworld
eval tmpDir innerTaskId (Task inner) DestroyEvent evalOpts iworld
# (resa,iworld) = inner DestroyEvent {TaskEvalOpts|evalOpts&taskId=innerTaskId} iworld
# (merr, world) = recursiveDelete tmpDir iworld.world
......
......@@ -109,6 +109,8 @@ evalInteract ::
*IWorld
-> *(TaskResult (r,v),*IWorld)
| iTask r & iTask v & TC r & TC w & Registrable sds
evalInteract _ _ _ _ _ _ _ ServerInterruptedEvent _ iworld
= (DestroyedResult, iworld)
evalInteract _ _ _ _ _ _ _ DestroyEvent {TaskEvalOpts|taskId} iworld
= (DestroyedResult, 'SDS'.clearTaskSDSRegistrations ('DS'.singleton taskId) iworld)
evalInteract r mst mode sds handlers editor writefun event=:(EditEvent eTaskId name edit) evalOpts=:{taskId,lastEval} iworld
......
......@@ -43,19 +43,20 @@ liftOSErr f iw = case (liftIWorld f) iw of
externalProcess :: !Timespec !FilePath ![String] !(Maybe FilePath) !Int !(Maybe ProcessPtyOptions) !(Shared sds1 [String]) !(Shared sds2 ([String], [String])) -> Task Int | RWShared sds1 & RWShared sds2
externalProcess poll cmd args dir exitCode mopts sdsin sdsout = Task evalinit
where
evalinit DestroyEvent _ iworld
= (DestroyedResult, iworld)
evalinit event _ iworld
| isDestroyOrInterrupt event = (DestroyedResult, iworld)
evalinit event evalOpts=:{TaskEvalOpts|taskId} iworld
= case liftOSErr (maybe (runProcessIO cmd args dir) (runProcessPty cmd args dir) mopts) iworld of
(Error e, iworld) = (ExceptionResult e, iworld)
(Ok phpio, iworld) = eval phpio event evalOpts iworld
eval (ph, pio) DestroyEvent {TaskEvalOpts|taskId} iworld
# iworld = clearTaskSDSRegistrations ('DS'.singleton taskId) iworld
= apIWTransformer iworld
$ liftOSErr (terminateProcessCode ph exitCode)
>-= \_->liftOSErr (closeProcessIO pio)
>-= \_->tuple (Ok DestroyedResult)
eval (ph, pio) event {TaskEvalOpts|taskId} iworld
| isDestroyOrInterrupt event
# iworld = clearTaskSDSRegistrations ('DS'.singleton taskId) iworld
= apIWTransformer iworld
$ liftOSErr (terminateProcessCode ph exitCode)
>-= \_->liftOSErr (closeProcessIO pio)
>-= \_->tuple (Ok DestroyedResult)
//TODO: Support async sdss
eval (ph, pio) event {taskId,lastEval} iworld
| not (isRefreshForTask event taskId)
......@@ -98,17 +99,19 @@ where
tcplisten :: !Int !Bool !(sds () r w) (ConnectionHandlers l r w) -> Task [l] | iTask l & iTask r & iTask w & RWShared sds
tcplisten port removeClosed sds handlers = Task evalinit
where
evalinit DestroyEvent _ iworld = (DestroyedResult, iworld)
evalinit event _ iworld
| isDestroyOrInterrupt event = (DestroyedResult, iworld)
evalinit event evalOpts=:{TaskEvalOpts|taskId} iworld
= case addListener taskId port removeClosed (wrapConnectionTask handlers sds) iworld of
(Error e, iworld) = (ExceptionResult e, iworld)
(Ok _, iworld) = eval event evalOpts iworld
eval DestroyEvent {TaskEvalOpts|taskId} iworld=:{ioStates}
# ioStates = case 'DM'.get taskId ioStates of
Just (IOActive values) = 'DM'.put taskId (IODestroyed values) ioStates
_ = ioStates
= (DestroyedResult,{iworld & ioStates = ioStates})
eval event {TaskEvalOpts|taskId} iworld=:{ioStates}
| isDestroyOrInterrupt event
# ioStates = case 'DM'.get taskId ioStates of
Just (IOActive values) = 'DM'.put taskId (IODestroyed values) ioStates
_ = ioStates
= (DestroyedResult,{iworld & ioStates = ioStates})
eval event evalOpts=:{TaskEvalOpts|taskId,lastEval} iworld=:{ioStates}
= case 'DM'.get taskId ioStates of
Just (IOException e) = (ExceptionResult (exception e), iworld)
......@@ -123,18 +126,20 @@ tcpconnect :: !String !Int !(Maybe Timeout) !(sds () r w) (ConnectionHandlers l
tcpconnect host port timeout sds handlers = Task evalinit
where
//We cannot make ioStates local since the engine uses it
evalinit DestroyEvent _ iworld
= (DestroyedResult, iworld)
evalinit event _ iworld
| isDestroyOrInterrupt event
= (DestroyedResult, iworld)
evalinit event eo=:{TaskEvalOpts|taskId} iworld
= case addConnection taskId host port timeout (wrapConnectionTask handlers sds) iworld of
(Error e,iworld) = (ExceptionResult e, iworld)
(Ok _,iworld) = eval event eo iworld
eval DestroyEvent evalOpts=:{TaskEvalOpts|taskId} iworld=:{ioStates}
# ioStates = case 'DM'.get taskId ioStates of
Just (IOActive values) = 'DM'.put taskId (IODestroyed values) ioStates
_ = ioStates
= (DestroyedResult, {iworld & ioStates = ioStates})
eval event evalOpts=:{TaskEvalOpts|taskId} iworld=:{ioStates}
| isDestroyOrInterrupt event
# ioStates = case 'DM'.get taskId ioStates of
Just (IOActive values) = 'DM'.put taskId (IODestroyed values) ioStates
_ = ioStates
= (DestroyedResult, {iworld & ioStates = ioStates})
eval event evalOpts=:{TaskEvalOpts|taskId,lastEval} iworld=:{ioStates}
= case 'DM'.get taskId ioStates of
......
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