keid-frp-banana-0.1.2.1: src/Engine/ReactiveBanana/Utils.hs

module Engine.ReactiveBanana.Utils where

import RIO

import Reactive.Banana qualified as RB
import Reactive.Banana.Frameworks qualified as RBF

{-# INLINE (<@@>) #-}
(<@@>) :: RB.Event a -> RB.Behavior (a -> b) -> RB.Event b
(<@@>) = flip (RB.<@>)

{-# INLINE ($>>) #-}
($>>) :: {- forall {a} {b} .  -}RB.Event a -> RB.Event b -> RB.Event ()
a $>> b =
  RB.mergeWith
    (const ())
    (const ())
    (\_ _ -> ())
    a
    b

delay :: RB.Event a -> RBF.MomentIO (RB.Event a)
delay e = do
  (delayed, fire) <- RBF.newEvent
  RBF.reactimate $ fmap fire e
  pure delayed

delayOnce :: RB.Event a -> RBF.MomentIO (RB.Event a)
delayOnce e = delay e >>= RB.once

lockstep :: a -> RB.Event a -> RBF.MomentIO (RB.Event a, RB.Behavior a)
lockstep initial e = do
  b <- RB.stepper initial e
  e' <- delay e
  pure (e', b)

accumE_ :: RB.MonadMoment m => [RB.Event a] -> m (RB.Event a)
accumE_ = RB.accumE undefined . unionsConst

unionsConst :: [RB.Event a] -> RB.Event (a -> a)
unionsConst = RB.unions . map (fmap const)

-- | Only pass events when their value changes.
--
-- The event is delayed for behavior value to match current value.
filterChange
  :: Eq a
  => a
  -> RB.Event a
  -> RBF.MomentIO (RB.Event (a, a), RB.Behavior a)
filterChange initial e = do
  b <- RB.stepper initial e
  let
    changeE = RB.filterJust $
      e <@@> do
        old <- b
        pure \new ->
          if old == new then
            Nothing
          else
            Just (old, new)
  syncE <- delay changeE
  pure (syncE, b)