Commit a31ae2bc authored by Bas Lijnse's avatar Bas Lijnse

Extended task instance filtering to prevent startup tasks to show up in the worklist ui

parent f6e5f4a1
Pipeline #21060 passed with stage
in 4 minutes and 48 seconds
......@@ -43,7 +43,7 @@ myWork :: SDSLens () [(TaskId,WorklistRow)] ()
myWork = workList taskInstancesForCurrentUser
allWork :: SDSLens () [(TaskId,WorklistRow)] ()
allWork = workList allTaskInstances
allWork = workList detachedTaskInstances
workList instances = mapRead projection (instances |*| currentTopTask)
where
......
......@@ -29,11 +29,13 @@ where
NoChange
(TCInit taskId ts)
, iworld)
eval event evalOpts tree=:(TCDestroy _) iworld
= (DestroyedResult, iworld)
//When we run the built-in HTTP server we need to do active garbage collection of instances that were created for sessions
removeOutdatedSessions :: Task ()
removeOutdatedSessions = everyTick \iworld=:{IWorld|options}->
case read (sdsFocus {InstanceFilter|defaultValue & onlySession=Just True} filteredInstanceIndex) EmptyContext iworld of
case read (sdsFocus {InstanceFilter|defaultValue & includeSessions=True} filteredInstanceIndex) EmptyContext iworld of
(Ok (ReadingDone index), iworld) = checkAll (removeIfOutdated options) index iworld
(Error e, iworld) = (Error e, iworld)
where
......@@ -86,6 +88,8 @@ stopOnStable = everyTick \iworld=:{IWorld|shutdown}->case read (sdsFocus {Instan
Nothing = if (allStable index) (Just (if (exceptionOccurred index) 1 0)) Nothing
_ = shutdown
= (Ok (), {IWorld|iworld & shutdown = shutdown})
(Ok _,iworld)
= (Error (exception "Unexpeced SDS state"),iworld)
(Error e, iworld) = (Error e, iworld)
where
allStable instances = all (\v -> v =: Stable || v =: (Exception _)) (values instances)
......
......@@ -20,7 +20,9 @@ from System.Time import :: Timestamp
{ //'Vertical' filters
onlyInstanceNo :: !Maybe [InstanceNo]
, notInstanceNo :: !Maybe [InstanceNo]
, onlySession :: !Maybe Bool
, includeSessions :: !Bool
, includeDetached :: !Bool
, includeStartup :: !Bool
, matchAttribute :: !Maybe (!String,!String)
//'Horizontal' filters
, includeConstants :: !Bool
......
......@@ -162,7 +162,9 @@ createStartupTaskInstance task attributes iworld=:{options={appVersion,autoLayou
= 'SDS'.write (instanceNo, Just constants,Just progress,Just attributes) (sdsFocus instanceNo taskInstance) 'SDS'.EmptyContext iworld
`b` \iworld -> 'SDS'.write (createReduct defaultTonicOpts instanceNo task taskTime) (sdsFocus instanceNo taskInstanceReduct) 'SDS'.EmptyContext iworld
`b` \iworld -> 'SDS'.write (TIValue NoValue) (sdsFocus instanceNo taskInstanceValue) 'SDS'.EmptyContext iworld
`b` \iworld -> (Ok instanceNo, iworld)
`b` \iworld -> (Ok instanceNo, queueEvent instanceNo ResetEvent iworld)
import StdDebug
(`b`) infixl 1 :: *(MaybeError e r, *st) (*st -> *(MaybeError e r`, *st)) -> *(MaybeError e r`, *st)
(`b`) (Ok _, st) f = f st
......@@ -239,7 +241,8 @@ deleteTaskInstance instanceNo iworld=:{IWorld|options={EngineOptions|persistTask
//Filtered interface to the instance index. This interface should always be used to access instance data
filteredInstanceIndex :: SDSLens InstanceFilter [InstanceData] [InstanceData]
filteredInstanceIndex = sdsLens "filteredInstanceIndex" param (SDSRead read) (SDSWrite write) (SDSNotify notify) (Just \filter metas -> read filter metas) taskInstanceIndex
filteredInstanceIndex = sdsLens "filteredInstanceIndex" param (SDSRead read) (SDSWrite write) (SDSNotify notify)
(Just \filter metas -> read filter metas) taskInstanceIndex
where
param tfilter = ()
......@@ -303,10 +306,13 @@ where
instanceType {instanceType} _ _ = instanceType
filterPredicate {InstanceFilter|onlyInstanceNo,notInstanceNo,onlySession,matchAttribute} i
filterPredicate {InstanceFilter|onlyInstanceNo,notInstanceNo,includeSessions,includeDetached,includeStartup,matchAttribute} i
= (maybe True (\m -> isMember i.TIMeta.instanceNo m) onlyInstanceNo)
&& (maybe True (\m -> not (isMember i.TIMeta.instanceNo m)) notInstanceNo)
&& (maybe True (\m -> (i.instanceType =: (TISession _)) == m ) onlySession)
&& ((includeSessions && i.instanceType =: (TISession _)) ||
(includeDetached && i.instanceType =: (TIPersistent _ _)) ||
(includeStartup && i.instanceType =: (TIStartup))
)
&& (maybe True (\(mk,mv) -> (maybe False ((==) mv) ('DM'.get mk i.TIMeta.attributes))) matchAttribute)
notifyFun _ ws qfilter = any (filterPredicate qfilter) ws
......@@ -315,7 +321,7 @@ where
taskInstance :: SDSLens InstanceNo InstanceData InstanceData
taskInstance = sdsLens "taskInstance" param (SDSRead read) (SDSWriteConst write) (SDSNotifyConst notify) (Just \p ws -> read p ws) filteredInstanceIndex
where
param no = {InstanceFilter|onlyInstanceNo=Just [no],notInstanceNo=Nothing,onlySession=Nothing,matchAttribute=Nothing
param no = {InstanceFilter|onlyInstanceNo=Just [no],notInstanceNo=Nothing,includeSessions=True,includeDetached=True,includeStartup=True,matchAttribute=Nothing
,includeConstants=True,includeProgress=True,includeAttributes=True}
read no [data] = Ok data
read no _ = Error (exception ("Could not find task instance "<+++ no))
......@@ -325,7 +331,7 @@ where
taskInstanceConstants :: SDSLens InstanceNo InstanceConstants ()
taskInstanceConstants = sdsLens "taskInstanceConstants" param (SDSRead read) (SDSWrite write) (SDSNotifyConst notify) (Just \p ws -> Ok ()) filteredInstanceIndex
where
param no = {InstanceFilter|onlyInstanceNo=Just [no],notInstanceNo=Nothing,onlySession=Nothing,matchAttribute=Nothing
param no = {InstanceFilter|onlyInstanceNo=Just [no],notInstanceNo=Nothing,includeSessions=True,includeDetached=True,includeStartup=True,matchAttribute=Nothing
,includeConstants=True,includeProgress=False,includeAttributes=False}
read no [(_,Just c,_,_)] = Ok c
read no _ = Error (exception ("Could not find constants for task instance "<+++ no))
......@@ -335,7 +341,7 @@ where
taskInstanceProgress :: SDSLens InstanceNo InstanceProgress InstanceProgress
taskInstanceProgress = sdsLens "taskInstanceProgress" param (SDSRead read) (SDSWrite write) (SDSNotifyConst notify) (Just \p ws -> read p ws) filteredInstanceIndex
where
param no = {InstanceFilter|onlyInstanceNo=Just [no],notInstanceNo=Nothing,onlySession=Nothing,matchAttribute=Nothing
param no = {InstanceFilter|onlyInstanceNo=Just [no],notInstanceNo=Nothing,includeSessions=True,includeDetached=True,includeStartup=True,matchAttribute=Nothing
,includeConstants=False,includeProgress=True,includeAttributes=False}
read no [(_,_,Just p,_)] = Ok p
read no _ = Error (exception ("Could not find progress for task instance "<+++ no))
......@@ -346,7 +352,7 @@ where
taskInstanceAttributes :: SDSLens InstanceNo TaskAttributes TaskAttributes
taskInstanceAttributes = sdsLens "taskInstanceAttributes" param (SDSRead read) (SDSWrite write) (SDSNotifyConst notify) (Just \p ws -> read p ws) filteredInstanceIndex
where
param no = {InstanceFilter|onlyInstanceNo=Just [no],notInstanceNo=Nothing,onlySession=Nothing,matchAttribute=Nothing
param no = {InstanceFilter|onlyInstanceNo=Just [no],notInstanceNo=Nothing,includeSessions=True,includeDetached=True,includeStartup=True,matchAttribute=Nothing
,includeConstants=False,includeProgress=False,includeAttributes=True}
read no [(_,_,_,Just a)] = Ok a
read no _ = Error (exception ("Could not find attributes for task instance "<+++ no))
......@@ -360,8 +366,8 @@ topLevelTaskList = sdsLens "topLevelTaskList" param (SDSRead read) (SDSWrite wri
((sdsFocus filter filteredInstanceIndex) >*| currentInstanceShare)
where
param _ = ()
filter = {InstanceFilter|onlyInstanceNo=Nothing,notInstanceNo=Nothing,onlySession=Just False,matchAttribute=Nothing
,includeConstants=True,includeProgress=True,includeAttributes=True}
filter = {InstanceFilter|onlyInstanceNo=Nothing,notInstanceNo=Nothing,includeSessions=False,includeDetached=True,includeStartup=False
,matchAttribute=Nothing,includeConstants=True,includeProgress=True,includeAttributes=True}
read _ (instances,curInstance) = Ok (TaskId 0 0, items)
where
items = [{TaskListItem|taskId = TaskId instanceNo 0, listId = listId
......@@ -504,7 +510,7 @@ where
= (Ok ([(taskId, attributes) \\ {ParallelTaskState|taskId,detached,attributes,value,change} <- ws | change =!= Just RemoveParallelTask]))
param2 _ (listId,items) = {InstanceFilter|onlyInstanceNo=Just [instanceNo \\ {TaskListItem|taskId=(TaskId instanceNo _),detached} <- items | detached],notInstanceNo=Nothing
,onlySession=Nothing, matchAttribute=Nothing, includeConstants = False, includeAttributes = True,includeProgress = True}
,includeSessions=True,includeDetached=True,includeStartup=True,matchAttribute=Nothing, includeConstants = False, includeAttributes = True,includeProgress = True}
read ((listId,items),detachedInstances)
# detachedProgress = 'DM'.fromList [(TaskId instanceNo 0,progress) \\ (instanceNo,_,Just progress,_) <- detachedInstances]
......
......@@ -50,14 +50,14 @@ currentSessions :: SDSLens () [TaskListItem ()] ()
currentSessions
= mapRead (map toTaskListItem) (toReadOnly (sdsFocus filter filteredInstanceIndex))
where
filter = {InstanceFilter|onlyInstanceNo=Nothing,notInstanceNo=Nothing,onlySession=Just True,matchAttribute=Nothing
filter = {InstanceFilter|onlyInstanceNo=Nothing,notInstanceNo=Nothing,includeSessions=True,includeDetached=False,includeStartup=False,matchAttribute=Nothing
,includeConstants=True,includeProgress=True,includeAttributes=True}
currentProcesses :: SDSLens () [TaskListItem ()] ()
currentProcesses
= mapRead (map toTaskListItem) (toReadOnly (sdsFocus filter filteredInstanceIndex))
where
filter = {InstanceFilter|onlyInstanceNo=Nothing,notInstanceNo=Nothing,onlySession=Just False,matchAttribute=Nothing
filter = {InstanceFilter|onlyInstanceNo=Nothing,notInstanceNo=Nothing,includeSessions=False,includeDetached=True,includeStartup=False,matchAttribute=Nothing
,includeConstants=True,includeProgress=True,includeAttributes=True}
toTaskListItem :: !InstanceData -> TaskListItem a
......@@ -93,14 +93,14 @@ currentTaskInstanceAttributes
allTaskInstances :: SDSLens () [TaskInstance] ()
allTaskInstances
= (sdsProject (SDSLensRead readInstances) (SDSBlindWrite \_. Ok Nothing) Nothing
(sdsFocus {InstanceFilter|onlyInstanceNo=Nothing,notInstanceNo=Nothing,onlySession=Nothing,matchAttribute=Nothing,includeConstants=True,includeProgress=True,includeAttributes=True} filteredInstanceIndex))
(sdsFocus {InstanceFilter|onlyInstanceNo=Nothing,notInstanceNo=Nothing,includeSessions=True,includeDetached=True,includeStartup=True,matchAttribute=Nothing,includeConstants=True,includeProgress=True,includeAttributes=True} filteredInstanceIndex))
where
readInstances is = Ok (map taskInstanceFromInstanceData is)
detachedTaskInstances :: SDSLens () [TaskInstance] ()
detachedTaskInstances
= (sdsProject (SDSLensRead readInstances) (SDSBlindWrite \_. Ok Nothing) Nothing
(sdsFocus {InstanceFilter|onlyInstanceNo=Nothing,notInstanceNo=Nothing,onlySession=Just False,matchAttribute=Nothing,includeConstants=True,includeProgress=True,includeAttributes=True} filteredInstanceIndex))
(sdsFocus {InstanceFilter|onlyInstanceNo=Nothing,notInstanceNo=Nothing,includeSessions=False,includeDetached=True,includeStartup=False,matchAttribute=Nothing,includeConstants=True,includeProgress=True,includeAttributes=True} filteredInstanceIndex))
where
readInstances is = Ok (map taskInstanceFromInstanceData is)
......@@ -109,7 +109,7 @@ taskInstanceByNo
= sdsProject (SDSLensRead readItem) (SDSLensWrite writeItem) Nothing
(sdsTranslate "taskInstanceByNo" filter filteredInstanceIndex)
where
filter no = {InstanceFilter|onlyInstanceNo=Just [no],notInstanceNo=Nothing,onlySession=Nothing,matchAttribute=Nothing,includeConstants=True,includeProgress=True,includeAttributes=True}
filter no = {InstanceFilter|onlyInstanceNo=Just [no],notInstanceNo=Nothing,includeSessions=True,includeDetached=True,includeStartup=True,matchAttribute=Nothing,includeConstants=True,includeProgress=True,includeAttributes=True}
readItem [i] = Ok (taskInstanceFromInstanceData i)
readItem _ = Error (exception "Task instance not found")
......@@ -122,7 +122,7 @@ taskInstanceAttributesByNo
= sdsProject (SDSLensRead readItem) (SDSLensWrite writeItem) Nothing
(sdsTranslate "taskInstanceAttributesByNo" filter filteredInstanceIndex)
where
filter no = {InstanceFilter|onlyInstanceNo=Just [no],notInstanceNo=Nothing,onlySession=Nothing,matchAttribute=Nothing,includeConstants=False,includeProgress=False,includeAttributes=True}
filter no = {InstanceFilter|onlyInstanceNo=Just [no],notInstanceNo=Nothing,includeSessions=True,includeDetached=True,includeStartup=True,matchAttribute=Nothing,includeConstants=False,includeProgress=False,includeAttributes=True}
readItem [(_,_,_,Just a)] = Ok a
readItem _ = Error (exception "Task instance not found")
......@@ -134,7 +134,7 @@ taskInstancesByAttribute :: SDSLens (!String,!String) [TaskInstance] ()
taskInstancesByAttribute
=
(sdsProject (SDSLensRead readInstances) (SDSBlindWrite \_. Ok Nothing) Nothing
(sdsTranslate "taskInstancesByAttribute" (\p -> {InstanceFilter|onlyInstanceNo=Nothing,notInstanceNo=Nothing,onlySession=Nothing,matchAttribute=Just p,includeConstants=True,includeProgress=True,includeAttributes=True}) filteredInstanceIndex))
(sdsTranslate "taskInstancesByAttribute" (\p -> {InstanceFilter|onlyInstanceNo=Nothing,notInstanceNo=Nothing,includeSessions=True,includeDetached=True,includeStartup=True,matchAttribute=Just p,includeConstants=True,includeProgress=True,includeAttributes=True}) filteredInstanceIndex))
where
readInstances is = Ok (map taskInstanceFromInstanceData is)
......
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