data Flow t m a = FlowPure a | Flow (m (Event t a)) runFlow :: PostBuild t m => Flow t m a -> m (Event t a) runFlow = \case FlowPure a -> (a <$) <$> getPostBuild Flow m -> m runFlowEither :: Applicative m => Flow t m a -> m (Either a (Event t a)) runFlowEither = \case FlowPure a -> pure $ Left a Flow ma -> Right <$> ma instance (Reflex t, Functor m) => Functor (Flow t m) where fmap f = \case FlowPure a -> FlowPure $ f a Flow ma -> Flow $ (fmap . fmap) f ma instance (Adjustable t m, MonadHold t m, MonadFix m) => Applicative (Flow t m) where pure = FlowPure FlowPure f <*> FlowPure a = FlowPure $ f a FlowPure f <*> Flow ma = Flow $ fmap f <$> ma Flow mf <*> FlowPure a = Flow $ fmap ($ a) <$> mf Flow mf <*> Flow ma = Flow $ do rec (f, b) <- runWithReplace (headE =<< mf) $ flip (fmap . fmap) ma <$> f headE =<< switchHold never b instance (Adjustable t m, MonadHold t m, MonadFix m) => Monad (Flow t m) where FlowPure a >>= f = f a Flow ma >>= f = Flow $ do rec (a, e) <- runWithReplace (headE =<< ma) $ runFlowEither . f <$> a let (b, nested) = fanEither e b' <- switchHold never nested headE $ leftmost [b, b']