Commit 6608960c authored by Mart Lubbers's avatar Mart Lubbers

cleanup traces, adhere to autoLayout in appendTopLevelTask

parent 22ad9d13
Pipeline #28254 passed with stage
in 4 minutes and 32 seconds
......@@ -77,6 +77,7 @@ instance Startable (a,b) | Startable a & Startable b
, tempDirPath :: FilePath // Location for temporary files used in tasks
, byteCodePath :: FilePath // Location of the application's bytecode
}
derive class iTask EngineOptions
/**
* Executes the task framework with a collection of startable task definitions.
......
......@@ -400,5 +400,3 @@ isAllowedWorkflow _ {Workflow|roles=[]} = True //Allow workflows without
isAllowedWorkflow (AuthenticatedUser _ hasRoles _) {Workflow|roles=needsRoles} //Allow workflows for which the user has permission
= or [isMember r hasRoles \\ r <- needsRoles]
isAllowedWorkflow _ _ = False //Don't allow workflows in other cases
import StdDebug
......@@ -452,5 +452,3 @@ isRefreshForTask ResetEvent _ = True
isRefreshForTask _ _ = False
tei ts = {TaskEvalInfo|lastEvent=ts,removedTasks=[],attributes='DM'.newMap}
import StdDebug
......@@ -134,6 +134,3 @@ where
rep ResetEvent = ReplaceUI (ui UIEmpty)
rep _ = NoChange
import StdDebug
derive gText Event, Set, TaskId
......@@ -600,5 +600,3 @@ updateClock iworld=:{IWorld|clock,world}
//Write SDS if necessary
# (mbe,iworld) = write timespec (sdsFocus {start=zero,interval=zero} iworldTimespec) EmptyContext iworld
= (() <$ mbe, iworld)
import StdDebug
......@@ -65,4 +65,3 @@ applicationName :: SDSSource () String () // Application name
applicationVersion :: SDSSource () String () // Application build identifier
applicationDirectory :: SDSSource () FilePath () // Directory in which the applicaton resides
applicationOptions :: SDSSource () EngineOptions () //Full engine options
......@@ -905,7 +905,7 @@ where
Just (ESToBeUpdated _ _) = True
Just (ESToBeRemoved _) = True
_ = False
import StdDebug
//Undo the effects of a previously applied rule for a single node
undoEffects_ :: !LUINo !(!LUI, !LUIMoves) -> (!LUI, !LUIMoves)
// optimisation to prevent a new LUINode to be allocated if no change is required
......
......@@ -16,6 +16,7 @@ from iTasks.Extensions.DateTime import waitForTimer
from iTasks.UI.Definition import :: UIType(UILoader)
import iTasks.Internal.SDS
import iTasks.Engine
import iTasks.WF.Derives
import iTasks.WF.Tasks.Core
import iTasks.WF.Tasks.SDS
......@@ -27,6 +28,7 @@ import iTasks.UI.Editor.Controls
import iTasks.UI.Prompt
import iTasks.UI.Layout
import iTasks.UI.Layout.Common, iTasks.UI.Layout.Default
import iTasks.SDS.Sources.System
(>>*) infixl 1 :: !(Task a) ![TaskCont a (Task b)] -> Task b | iTask a & iTask b
(>>*) task steps = step task (const Nothing) steps
......@@ -228,7 +230,10 @@ withSelection :: (Task c) (a -> Task b) (sds () (Maybe a) ()) -> Task b | iTask
withSelection def tfun s = whileUnchanged s (maybe (def @? const NoValue) tfun)
appendTopLevelTask :: !TaskAttributes !Bool !(Task a) -> Task TaskId | iTask a
appendTopLevelTask attr evalDirect task = appendTask (Detached attr evalDirect) (\_ -> task <<@ ApplyLayout defaultSessionLayout @! ()) topLevelTasks
appendTopLevelTask attr evalDirect task = get applicationOptions
>>- \eo->appendTask (Detached attr evalDirect) (\_->mtune eo task @! ()) topLevelTasks
where
mtune eo = if eo.autoLayout (tune (ApplyLayout defaultSessionLayout)) id
compute :: !String a -> Task a | iTask a
compute s a = enterInformation s [EnterUsing id ed] >>~ \_->return a
......@@ -301,5 +306,3 @@ tvFromMaybe _ = NoValue
tvToMaybe :: (TaskValue a) -> TaskValue (Maybe a)
tvToMaybe (Value a s) = Value (Just a) s
tvToMaybe NoValue = Value Nothing False
import StdDebug
......@@ -114,16 +114,13 @@ where
//Destroyed when executing the lhs
//evalleft :: (Task a) [String] TaskId Event TaskEvalOpts !*IWorld -> *(TaskResult a, IWorld)
evalleft (Task lhs) prevEnabledActions leftTaskId DestroyEvent evalOpts iworld
// | not (trace_tn ("destroy step")) = undef
= 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)
//Execute lhs
evalleft (Task lhs) prevEnabledActions leftTaskId event evalOpts=:{TaskEvalOpts|ts,taskId} iworld
// | not (trace_tn (toSingleLineText ("step: ", event))) = undef
# mbAction = matchAction taskId event
// | not (trace_tn (toSingleLineText ("mbAction: ", mbAction))) = undef
# (res, iworld) = lhs event {TaskEvalOpts|evalOpts&taskId=leftTaskId} iworld
// Right is a step
# (mbCont, iworld) = case res of
......@@ -278,12 +275,10 @@ where
err = (liftError err, iworld)
eval _ _ DestroyEvent {TaskEvalOpts|taskId} iworld
// | not (trace_tn (toSingleLineText ("parallel destroy: ", taskId))) = undef
= destroyParallelTasks taskId iworld
//Evaluate the task list
eval prevNumBranches prevEnabledActions event evalOpts=:{TaskEvalOpts|taskId} iworld
// | not (trace_tn (toSingleLineText ("parallel: ", taskId, " event: ", event))) = undef
//Evaluate all branches of the parallel set
= case evalParallelTasks event evalOpts conts [] [] iworld of
(Ok results, iworld)
......@@ -294,11 +289,8 @@ where
# actions = contActions taskId value conts
# rep = genParallelRep evalOpts event actions prevEnabledActions results prevNumBranches
# curEnabledActions = [actionId action \\ action <- actions | isEnabled action]
| not (trace_tn (toSingleLineText ("length results: ", length results))) = undef
| not (trace_tn (toSingleLineText ("prevEnabledActions: ", prevEnabledActions))) = undef
| not (trace_tn (toSingleLineText ("curEnabledActions: ", curEnabledActions))) = undef
| not (trace_tn (toSingleLineText ("actions: ", actions))) = undef
= (ValueResult value evalInfo rep (Task (eval (length results) curEnabledActions)), iworld)
# curNumBranches = length [()\\(ValueResult _ _ _ _)<-results]
= (ValueResult value evalInfo rep (Task (eval curNumBranches curEnabledActions)), iworld)
//Stopped because of an unhandled exception
(Error e, iworld)
//Clean up before returning the exception
......@@ -572,7 +564,6 @@ where
destroyEmbeddedParallelTask :: TaskId TaskId *IWorld -> *(MaybeError [TaskException] (TaskResult a), *IWorld) | iTask a
destroyEmbeddedParallelTask listId=:(TaskId instanceNo _) taskId iworld=:{current={taskTime}}
| not (trace_tn (toSingleLineText ("destroy: ", listId, taskId))) = undef
# (errs,destroyResult,iworld) = case read (sdsFocus taskId taskInstanceEmbeddedTask) EmptyContext iworld of
(Error e,iworld) = ([e], DestroyedResult,iworld)
(Ok (ReadingDone (Task eval)),iworld)
......@@ -815,6 +806,3 @@ where
= (ValueResult val tei ui (Task (eval tosignal newtask)), iworld)
(ExceptionResult e, iworld) = (ExceptionResult e, iworld)
(DestroyedResult, iworld) = (DestroyedResult, iworld)
import StdDebug
derive gText Event, Set
......@@ -68,7 +68,6 @@ evalInteractInit prompt sds handlers editor writefun r event evalOpts=:{TaskEval
Enter = Nothing
Update x = Just x
View x = Just x
// | not (trace_tn (toSingleLineText ("initial value: ", v))) = undef
= case initEditorState taskId mode editor iworld of
(Ok st, iworld)
= evalInteract l v st (mode=:View _) prompt sds handlers editor writefun event evalOpts iworld
......@@ -108,7 +107,6 @@ evalInteract ::
evalInteract _ _ _ _ _ _ _ _ _ DestroyEvent {TaskEvalOpts|taskId} iworld
= (DestroyedResult, 'SDS'.clearTaskSDSRegistrations ('DS'.singleton taskId) iworld)
evalInteract l v st mode prompt sds handlers editor writefun event=:(EditEvent eTaskId name edit) evalOpts=:{TaskEvalOpts|taskId,ts} iworld
// | not (trace_tn (toSingleLineText (taskId, ": ", "interact edit: ", event, " v: ", v))) = undef
| eTaskId == taskId
# (res, iworld) = withVSt taskId (editor.Editor.onEdit [] (s2dp name,edit) st) iworld
= case res of
......@@ -117,7 +115,6 @@ evalInteract l v st mode prompt sds handlers editor writefun event=:(EditEvent e
= case editor.Editor.valueFromState st of
Just nv
# (l, v, mbf) = handlers.InteractionHandlers.onEdit nv l v
// | not (trace_tn (toSingleLineText ("onedit: ", v))) = undef
= case mbf of
//We have an update function
Just f = writefun f sds NoValue (\_->change)
......@@ -149,7 +146,6 @@ evalInteract l v st mode prompt sds handlers editor writefun event=:(EditEvent e
, iworld)
Error e = (ExceptionResult (exception e), iworld)
evalInteract l v st mode prompt sds handlers editor writefun ResetEvent evalOpts=:{TaskEvalOpts|taskId,ts} iworld
// | not (trace_tn (toSingleLineText (taskId, ": ", "interact reset v: ", v))) = undef
# resetMode = case (mode, v) of
(True, Just v) = View v
(True, _) = abort "view mode without value"
......@@ -160,7 +156,6 @@ evalInteract l v st mode prompt sds handlers editor writefun ResetEvent evalOpts
(Ok (ui, st), iworld)
# mbv = editor.Editor.valueFromState st
# v = maybe v Just mbv
// | not (trace_tn (toSingleLineText ("valueFromState v: ", v))) = undef
= (ValueResult
(maybe NoValue (\v->Value (l, v) False) v)
{TaskEvalInfo|lastEvent=ts,attributes='DM'.newMap,removedTasks=[]}
......@@ -168,12 +163,9 @@ evalInteract l v st mode prompt sds handlers editor writefun ResetEvent evalOpts
(Task (evalInteract l v st mode prompt sds handlers editor writefun))
, iworld)
evalInteract l v st mode prompt sds handlers editor writefun event=:(RefreshEvent taskIds _) evalOpts=:{TaskEvalOpts|taskId,ts} iworld
// | not (trace_tn (toSingleLineText (taskId, ": ", toPrompt prompt, " l: ", l, " st: ", st, " interact refresh v: ", v))) = undef
// | not (trace_tn (toSingleLineText (taskId, " : interact refresh v: ", v))) = undef
| 'DS'.member taskId taskIds
= readRegisterCompletely sds (maybe NoValue (\v->Value (l, v) False) v) (\e->case event of ResetEvent = asyncSDSLoadUI Read; e = NoChange)
(\r event evalOpts iworld
// | not (trace_tn (toSingleLineText ("r: ", r, " v: ", v, " st: ", st))) = undef
# (l, v, mbf) = handlers.InteractionHandlers.onRefresh r l v
= case withVSt taskId (editor.Editor.onRefresh [] v st) iworld of
(Error e, iworld) = (ExceptionResult (exception e), iworld)
......@@ -206,6 +198,3 @@ uniqueMode mode = case mode of
Enter = Enter
Update x = Update x
View x = View x
import StdDebug
derive gText Event, Set, EditState, LeafState, (,,,,,,,,)
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