stepparallel/test.icl

   1 module test
   2
   3 import StdMisc
   4 import iTasks
   5 import Data.Either
   6 import StdEnv
   7 import Data.Func
   8
   9 Start w = flip doTasks w $
  10         updateInformation () [] 42
  11         >>* [OnAction (Action "Continue") (always (return 43))]
  12
  13 (>>*) infixl 1// :: !(Task a) ![TaskCont a (Task b)] -> Task b | iTask a & iTask b
  14 (>>*) task steps :== step task (const Nothing) steps
  15
  16 step :: !(Task a) ((Maybe a) -> Maybe b) [TaskCont a (Task b)] -> Task b | iTask a & iTask b
  17 step lhs lhsValFun conts
  18         = parallel
  19                 [(Embedded, \stl->lhs @? \v->case v of
  20                         NoValue = Value (Left Nothing) False
  21                         (Value v s) = Value (Left (Just v)) s
  22                 )]
  23                 (map stepCont conts)
  24                 @? stepVal lhsValFun
  25 where
  26         stepVal :: ((Maybe a) -> Maybe b) (TaskValue [(Int, TaskValue (Either (Maybe a) b))]) -> TaskValue b
  27         stepVal tfun NoValue = NoValue
  28         stepVal tfun (Value [(_, x):_] _) = case x of
  29                 //Not yet stepped:
  30                 Value (Left l) s = case tfun l of
  31                         Nothing = NoValue
  32                         Just v = Value v False
  33                 //Stepped but no value
  34                 NoValue = NoValue
  35                 Value (Right r) s = Value r s
  36         stepVal _ _ = abort "cannot happen"
  37
  38         stepCont :: (TaskCont a (Task b)) -> TaskCont
  39                 [(Int, TaskValue (Either (Maybe a) b))]
  40                 (ParallelTaskType, ParallelTask (Either (Maybe a) b))
  41         stepCont (OnValue f) = OnValue (transform f)
  42         stepCont (OnAction a f) = OnAction a (transform f)
  43
  44         transform f v
  45                 # v = case v of
  46                         Value [(_, v)] _ = case v of
  47                                 NoValue = NoValue
  48                                 Value (Left (Just v)) s = Value v s
  49                                 Value _ = NoValue
  50                         NoValue = NoValue
  51                 = case f v of
  52                         Nothing = Nothing
  53                         Just t = Just (Embedded, \stl->
  54                                 get (sdsFocus {onlyIndex=Nothing,onlyTaskId=Nothing,onlySelf=False,includeValue=False,includeProgress=False,includeAttributes=False} stl)
  55                                 removeTask taskId stl
  56                                 >-| t @ Right)
  57
  58 //      stepCont (OnException f) = OnException \e->(Embedded, \stl->e f @ Right)
  59 //      stepCont (OnAllExceptions b) = OnAllExceptions b