From: Mart Lubbers <mart@martlubbers.net>
Date: Mon, 19 Aug 2019 17:52:08 +0000 (+0200)
Subject: step as parallel
X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=41e5a26e596b24c0e77079a940d4458ad3a5cdc2;p=clean-tests.git

step as parallel
---

diff --git a/stepparallel/test.icl b/stepparallel/test.icl
index b5253ef..0004118 100644
--- a/stepparallel/test.icl
+++ b/stepparallel/test.icl
@@ -5,6 +5,7 @@ import iTasks
 import Data.Either
 import StdEnv
 import Data.Func
+import Data.Functor
 
 Start w = flip doTasks w $
 	updateInformation () [] 42
@@ -35,25 +36,25 @@ where
 		Value (Right r) s = Value r s
 	stepVal _ _ = abort "cannot happen"
 
-	stepCont :: (TaskCont a (Task b)) -> TaskCont
-		[(Int, TaskValue (Either (Maybe a) b))]
-		(ParallelTaskType, ParallelTask (Either (Maybe a) b))
 	stepCont (OnValue f) = OnValue (transform f)
 	stepCont (OnAction a f) = OnAction a (transform f)
+	stepCont (OnException f) = OnException \e->add (f e)
+	stepCont (OnAllExceptions f) = OnAllExceptions \e->add (f e)
 	
 	transform f v
 		# v = case v of
 			Value [(_, v)] _ = case v of
 				NoValue = NoValue
 				Value (Left (Just v)) s = Value v s
-				Value _ = NoValue
+				Value _ _ = NoValue
 			NoValue = NoValue
-		= case f v of
-			Nothing = Nothing
-			Just t = Just (Embedded, \stl->
-				get (sdsFocus {onlyIndex=Nothing,onlyTaskId=Nothing,onlySelf=False,includeValue=False,includeProgress=False,includeAttributes=False} stl)
-				removeTask taskId stl
-				>-| t @ Right)
+		= add <$> f v
+	
+	add t = (Embedded, \stl->
+		get (sdsFocus {onlyIndex=Nothing,onlyTaskId=Nothing,onlySelf=False,includeValue=False,includeProgress=False,includeAttributes=False} stl)
+		>>- \(_, pts)->case pts of
+			[tli:_] = removeTask tli.TaskListItem.taskId stl
+				>-| t @ Right
+			_ = abort "shouldn't happen"
+		)
 
-//	stepCont (OnException f) = OnException \e->(Embedded, \stl->e f @ Right)
-//	stepCont (OnAllExceptions b) = OnAllExceptions b