diff --git a/src/Reflex/Workflow.hs b/src/Reflex/Workflow.hs index 446b5954..a921619d 100644 --- a/src/Reflex/Workflow.hs +++ b/src/Reflex/Workflow.hs @@ -24,6 +24,8 @@ module Reflex.Workflow ( , stop , replay , roundRobin + , lead + , follow , breadthFirst , depthFirst @@ -102,6 +104,12 @@ braidFree = curry $ \case (Pure a, b) -> fmap (a,) b (a, Pure b) -> fmap (,b) a +interleaveF :: Functor f => Bool -> f () -> F f a -> F f a +interleaveF separatorAfter s = foldF $ \f -> + if separatorAfter + then liftF f <* liftF s + else liftF s *> liftF f + append :: (Adjustable t m, MonadHold t m, PostBuild t m) => Event t (Step t m a) -> m (Event t a) append ev = do (h,t) <- headTailE ev @@ -129,6 +137,9 @@ mkM = M . wrap . fmap pure . Compose braidM :: (Functor m, Reflex t) => M t m a -> M t m b -> M t m (a,b) braidM (M ma) (M mb) = M $ toF $ braidFree (fromF ma) (fromF mb) +interleaveM :: (Functor m, Reflex t) => Bool -> m (Event t ()) -> M t m a -> M t m a +interleaveM separatorAfter s = M . interleaveF separatorAfter (Compose s) . unM + bottomUp :: forall t m a. PostBuild t m => (forall x. Step t m (Step t m x) -> Step t m x) @@ -208,6 +219,10 @@ replay = callCC $ pure . fix roundRobin :: (Functor m, Reflex t) => Machine t m a -> Machine t m b -> Machine t m (a,b) roundRobin a b = Machine $ lift $ braidM (runMachine id a) (runMachine id b) +lead, follow :: (Functor m, Reflex t) => m (Event t ()) -> Machine t m a -> Machine t m a +lead s m = Machine $ lift $ interleaveM False s $ runMachine id m +follow s m = Machine $ lift $ interleaveM True s $ runMachine id m + -------------------------------------------------------------------------------- -- Runners --------------------------------------------------------------------------------