Commit 172c15a2 authored by Steffen Michels's avatar Steffen Michels

cleanup share of withShared on destroy

parent 9f0969f8
Pipeline #36877 passed with stage
in 6 minutes and 56 seconds
......@@ -150,7 +150,7 @@ taskInstanceShares :: SDSLens InstanceNo (Maybe (Map TaskId DeferredJSON))
parallelTaskList :: SDSLens (!TaskId,!TaskId,!TaskListFilter) (!TaskId,![TaskListItem a]) [(TaskId,TaskAttributes)] | iTask a
topLevelTaskList :: SDSLens TaskListFilter (!TaskId,![TaskListItem a]) [(TaskId,TaskAttributes)] | iTask a
localShare :: SDSLens TaskId a a | iTask a
localShare :: SDSLens TaskId a (Maybe a) | iTask a
//Conversion to task lists
toTaskListItem :: !TaskId !TaskMeta -> TaskListItem a
......
......@@ -474,7 +474,7 @@ where
reducer p ws = read p ws
//Evaluation state of instances
localShare :: SDSLens TaskId a a | iTask a
localShare :: SDSLens TaskId a (Maybe a) | iTask a
localShare = sdsLens "localShare" param (SDSRead read) (SDSWrite write) (SDSNotifyConst notify) (Just reducer) (removeMaybe (Just 'DM'.newMap) taskInstanceShares)
where
param (TaskId instanceNo _) = instanceNo
......@@ -484,7 +484,10 @@ where
Nothing = Error (exception ("Failed to decode json of local share " <+++ taskId))
Nothing
= Error (exception ("Could not find local share " <+++ taskId))
write taskId shares w = Ok (Just ('DM'.put taskId (DeferredJSON w) shares))
write taskId shares Nothing = Ok $ Just $ 'DM'.del taskId shares
write taskId shares (Just w) = Ok $ Just $ 'DM'.put taskId (DeferredJSON w) shares
notify taskId _ = const ((==) taskId)
reducer taskId shares = read taskId shares
......
......@@ -3,7 +3,7 @@ implementation module iTasks.WF.Combinators.SDS
import iTasks.WF.Derives
import iTasks.WF.Definition
import iTasks.SDS.Definition
from iTasks.SDS.Combinators.Common import sdsFocus
from iTasks.SDS.Combinators.Common import sdsFocus, mapWrite
import iTasks.Engine
import iTasks.Internal.IWorld
......@@ -13,7 +13,7 @@ import iTasks.Internal.TaskEval
import iTasks.Internal.Util
from iTasks.Internal.SDS import write, read, readRegister
from Data.Func import mapSt
from Data.Func import mapSt, $
import StdTuple, StdArray, StdList, StdString
import Text, Text.GenJSON
......@@ -29,13 +29,23 @@ where
evalinit event evalOpts=:{TaskEvalOpts|taskId} iworld
# (taskIda, iworld) = getNextTaskId iworld
# (e, iworld) = write initial (sdsFocus taskId localShare) EmptyContext iworld
# (e, iworld) = write (Just initial) (sdsFocus taskId localShare) EmptyContext iworld
| isError e
= (ExceptionResult (fromError e),iworld)
= eval taskIda (stask (sdsFocus taskId localShare)) event evalOpts iworld
= eval
taskIda
(stask $ mapWrite (\w _ -> Just $ Just w) Nothing $ sdsFocus taskId localShare)
event
evalOpts
iworld
//Running
eval innerTaskId (Task inner) DestroyEvent opts iworld
// free memory of share
# (e, iworld) =
write (nothingWithSameTypeAs initial) (sdsFocus opts.TaskEvalOpts.taskId localShare) EmptyContext iworld
| isError e
= (ExceptionResult (fromError e),iworld)
= case inner DestroyEvent {TaskEvalOpts|opts&taskId=innerTaskId} iworld of
(ValueResult _ _ _ _, iworld)
= (ExceptionResult (exception "Failed to destroy withShared child"), iworld)
......@@ -48,6 +58,9 @@ where
= (ValueResult val info rep (Task (eval innerTaskId newinner)), iworld)
e = e
nothingWithSameTypeAs :: a -> Maybe a
nothingWithSameTypeAs _ = Nothing
withTaskId :: (Task a) -> Task (a, TaskId)
withTaskId (Task task) = Task eval
where
......
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