Flow.hs

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']