{-----------------------------------------------------------------------------
    reactive-banana
------------------------------------------------------------------------------}
{-# LANGUAGE RecursiveDo, ScopedTypeVariables #-}
module Reactive.Banana.Prim.Mid.Combinators where

import Control.Monad
import Control.Monad.IO.Class

import Reactive.Banana.Prim.Low.Plumbing
    ( newPulse, newLatch, cachedLatch
    , dependOn, keepAlive, changeParent
    , getValueL
    , readPulseP, readLatchP, readLatchFutureP, liftBuildP,
    )
import qualified Reactive.Banana.Prim.Low.Plumbing (pureL)
import           Reactive.Banana.Prim.Low.Types    (Latch, Future, Pulse, Build, EvalP)

debug :: String -> a -> a
-- debug s = trace s
debug :: String -> a -> a
debug String
_ = a -> a
forall a. a -> a
id

{-----------------------------------------------------------------------------
    Combinators - basic
------------------------------------------------------------------------------}
mapP :: (a -> b) -> Pulse a -> Build (Pulse b)
mapP :: (a -> b) -> Pulse a -> Build (Pulse b)
mapP a -> b
f Pulse a
p1 = do
    Pulse b
p2 <- String -> EvalP (Maybe b) -> Build (Pulse b)
forall a. String -> EvalP (Maybe a) -> Build (Pulse a)
newPulse String
"mapP" ({-# SCC mapP #-} (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (Maybe a -> Maybe b)
-> RWSIOT BuildR (EvalPW, BuildW) Vault IO (Maybe a)
-> EvalP (Maybe b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pulse a -> RWSIOT BuildR (EvalPW, BuildW) Vault IO (Maybe a)
forall a. Pulse a -> EvalP (Maybe a)
readPulseP Pulse a
p1)
    Pulse b
p2 Pulse b -> Pulse a -> Build ()
forall child parent. Pulse child -> Pulse parent -> Build ()
`dependOn` Pulse a
p1
    Pulse b -> Build (Pulse b)
forall (m :: * -> *) a. Monad m => a -> m a
return Pulse b
p2

-- | Tag a 'Pulse' with future values of a 'Latch'.
--
-- This is in contrast to 'applyP' which applies the current value
-- of a 'Latch' to a pulse.
tagFuture :: Latch a -> Pulse b -> Build (Pulse (Future a))
tagFuture :: Latch a -> Pulse b -> Build (Pulse (Future a))
tagFuture Latch a
x Pulse b
p1 = do
    Pulse (Future a)
p2 <- String -> EvalP (Maybe (Future a)) -> Build (Pulse (Future a))
forall a. String -> EvalP (Maybe a) -> Build (Pulse a)
newPulse String
"tagFuture" (EvalP (Maybe (Future a)) -> Build (Pulse (Future a)))
-> EvalP (Maybe (Future a)) -> Build (Pulse (Future a))
forall a b. (a -> b) -> a -> b
$
        (b -> Future a) -> Maybe b -> Maybe (Future a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((b -> Future a) -> Maybe b -> Maybe (Future a))
-> (Future a -> b -> Future a)
-> Future a
-> Maybe b
-> Maybe (Future a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Future a -> b -> Future a
forall a b. a -> b -> a
const (Future a -> Maybe b -> Maybe (Future a))
-> RWSIOT BuildR (EvalPW, BuildW) Vault IO (Future a)
-> RWSIOT
     BuildR (EvalPW, BuildW) Vault IO (Maybe b -> Maybe (Future a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Latch a -> RWSIOT BuildR (EvalPW, BuildW) Vault IO (Future a)
forall a. Latch a -> EvalP (Future a)
readLatchFutureP Latch a
x RWSIOT
  BuildR (EvalPW, BuildW) Vault IO (Maybe b -> Maybe (Future a))
-> RWSIOT BuildR (EvalPW, BuildW) Vault IO (Maybe b)
-> EvalP (Maybe (Future a))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Pulse b -> RWSIOT BuildR (EvalPW, BuildW) Vault IO (Maybe b)
forall a. Pulse a -> EvalP (Maybe a)
readPulseP Pulse b
p1
    Pulse (Future a)
p2 Pulse (Future a) -> Pulse b -> Build ()
forall child parent. Pulse child -> Pulse parent -> Build ()
`dependOn` Pulse b
p1
    Pulse (Future a) -> Build (Pulse (Future a))
forall (m :: * -> *) a. Monad m => a -> m a
return Pulse (Future a)
p2

filterJustP :: Pulse (Maybe a) -> Build (Pulse a)
filterJustP :: Pulse (Maybe a) -> Build (Pulse a)
filterJustP Pulse (Maybe a)
p1 = do
    Pulse a
p2 <- String -> EvalP (Maybe a) -> Build (Pulse a)
forall a. String -> EvalP (Maybe a) -> Build (Pulse a)
newPulse String
"filterJustP" ({-# SCC filterJustP #-} Maybe (Maybe a) -> Maybe a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe a) -> Maybe a)
-> RWSIOT BuildR (EvalPW, BuildW) Vault IO (Maybe (Maybe a))
-> EvalP (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pulse (Maybe a)
-> RWSIOT BuildR (EvalPW, BuildW) Vault IO (Maybe (Maybe a))
forall a. Pulse a -> EvalP (Maybe a)
readPulseP Pulse (Maybe a)
p1)
    Pulse a
p2 Pulse a -> Pulse (Maybe a) -> Build ()
forall child parent. Pulse child -> Pulse parent -> Build ()
`dependOn` Pulse (Maybe a)
p1
    Pulse a -> Build (Pulse a)
forall (m :: * -> *) a. Monad m => a -> m a
return Pulse a
p2

unsafeMapIOP :: forall a b. (a -> IO b) -> Pulse a -> Build (Pulse b)
unsafeMapIOP :: (a -> IO b) -> Pulse a -> Build (Pulse b)
unsafeMapIOP a -> IO b
f Pulse a
p1 = do
        Pulse b
p2 <- String -> EvalP (Maybe b) -> Build (Pulse b)
forall a. String -> EvalP (Maybe a) -> Build (Pulse a)
newPulse String
"unsafeMapIOP"
            ({-# SCC unsafeMapIOP #-} Maybe a -> EvalP (Maybe b)
eval (Maybe a -> EvalP (Maybe b))
-> RWSIOT BuildR (EvalPW, BuildW) Vault IO (Maybe a)
-> EvalP (Maybe b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Pulse a -> RWSIOT BuildR (EvalPW, BuildW) Vault IO (Maybe a)
forall a. Pulse a -> EvalP (Maybe a)
readPulseP Pulse a
p1)
        Pulse b
p2 Pulse b -> Pulse a -> Build ()
forall child parent. Pulse child -> Pulse parent -> Build ()
`dependOn` Pulse a
p1
        Pulse b -> Build (Pulse b)
forall (m :: * -> *) a. Monad m => a -> m a
return Pulse b
p2
    where
    eval :: Maybe a -> EvalP (Maybe b)
    eval :: Maybe a -> EvalP (Maybe b)
eval (Just a
x) = b -> Maybe b
forall a. a -> Maybe a
Just (b -> Maybe b)
-> RWSIOT BuildR (EvalPW, BuildW) Vault IO b -> EvalP (Maybe b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO b -> RWSIOT BuildR (EvalPW, BuildW) Vault IO b
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (a -> IO b
f a
x)
    eval Maybe a
Nothing  = Maybe b -> EvalP (Maybe b)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe b
forall a. Maybe a
Nothing

mergeWithP
  :: (a -> Maybe c)
  -> (b -> Maybe c)
  -> (a -> b -> Maybe c)
  -> Pulse a
  -> Pulse b
  -> Build (Pulse c)
mergeWithP :: (a -> Maybe c)
-> (b -> Maybe c)
-> (a -> b -> Maybe c)
-> Pulse a
-> Pulse b
-> Build (Pulse c)
mergeWithP a -> Maybe c
f b -> Maybe c
g a -> b -> Maybe c
h Pulse a
px Pulse b
py = do
  Pulse c
p <- String -> EvalP (Maybe c) -> Build (Pulse c)
forall a. String -> EvalP (Maybe a) -> Build (Pulse a)
newPulse String
"mergeWithP"
       ({-# SCC mergeWithP #-} Maybe a -> Maybe b -> Maybe c
eval (Maybe a -> Maybe b -> Maybe c)
-> RWSIOT BuildR (EvalPW, BuildW) Vault IO (Maybe a)
-> RWSIOT BuildR (EvalPW, BuildW) Vault IO (Maybe b -> Maybe c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pulse a -> RWSIOT BuildR (EvalPW, BuildW) Vault IO (Maybe a)
forall a. Pulse a -> EvalP (Maybe a)
readPulseP Pulse a
px RWSIOT BuildR (EvalPW, BuildW) Vault IO (Maybe b -> Maybe c)
-> RWSIOT BuildR (EvalPW, BuildW) Vault IO (Maybe b)
-> EvalP (Maybe c)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Pulse b -> RWSIOT BuildR (EvalPW, BuildW) Vault IO (Maybe b)
forall a. Pulse a -> EvalP (Maybe a)
readPulseP Pulse b
py)
  Pulse c
p Pulse c -> Pulse a -> Build ()
forall child parent. Pulse child -> Pulse parent -> Build ()
`dependOn` Pulse a
px
  Pulse c
p Pulse c -> Pulse b -> Build ()
forall child parent. Pulse child -> Pulse parent -> Build ()
`dependOn` Pulse b
py
  Pulse c -> Build (Pulse c)
forall (m :: * -> *) a. Monad m => a -> m a
return Pulse c
p
  where
    eval :: Maybe a -> Maybe b -> Maybe c
eval Maybe a
Nothing  Maybe b
Nothing  = Maybe c
forall a. Maybe a
Nothing
    eval (Just a
x) Maybe b
Nothing  = a -> Maybe c
f a
x
    eval Maybe a
Nothing  (Just b
y) = b -> Maybe c
g b
y
    eval (Just a
x) (Just b
y) = a -> b -> Maybe c
h a
x b
y

-- See note [LatchRecursion]
applyP :: Latch (a -> b) -> Pulse a -> Build (Pulse b)
applyP :: Latch (a -> b) -> Pulse a -> Build (Pulse b)
applyP Latch (a -> b)
f Pulse a
x = do
    Pulse b
p <- String -> EvalP (Maybe b) -> Build (Pulse b)
forall a. String -> EvalP (Maybe a) -> Build (Pulse a)
newPulse String
"applyP"
        ({-# SCC applyP #-} (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> Maybe a -> Maybe b)
-> RWSIOT BuildR (EvalPW, BuildW) Vault IO (a -> b)
-> RWSIOT BuildR (EvalPW, BuildW) Vault IO (Maybe a -> Maybe b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Latch (a -> b) -> RWSIOT BuildR (EvalPW, BuildW) Vault IO (a -> b)
forall a. Latch a -> EvalP a
readLatchP Latch (a -> b)
f RWSIOT BuildR (EvalPW, BuildW) Vault IO (Maybe a -> Maybe b)
-> RWSIOT BuildR (EvalPW, BuildW) Vault IO (Maybe a)
-> EvalP (Maybe b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Pulse a -> RWSIOT BuildR (EvalPW, BuildW) Vault IO (Maybe a)
forall a. Pulse a -> EvalP (Maybe a)
readPulseP Pulse a
x)
    Pulse b
p Pulse b -> Pulse a -> Build ()
forall child parent. Pulse child -> Pulse parent -> Build ()
`dependOn` Pulse a
x
    Pulse b -> Build (Pulse b)
forall (m :: * -> *) a. Monad m => a -> m a
return Pulse b
p

pureL :: a -> Latch a
pureL :: a -> Latch a
pureL = a -> Latch a
forall a. a -> Latch a
Reactive.Banana.Prim.Low.Plumbing.pureL

-- specialization of   mapL f = applyL (pureL f)
mapL :: (a -> b) -> Latch a -> Latch b
mapL :: (a -> b) -> Latch a -> Latch b
mapL a -> b
f Latch a
lx = EvalL b -> Latch b
forall a. EvalL a -> Latch a
cachedLatch ({-# SCC mapL #-} a -> b
f (a -> b) -> ReaderWriterIOT () Time IO a -> EvalL b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Latch a -> ReaderWriterIOT () Time IO a
forall a. Latch a -> EvalL a
getValueL Latch a
lx)

applyL :: Latch (a -> b) -> Latch a -> Latch b
applyL :: Latch (a -> b) -> Latch a -> Latch b
applyL Latch (a -> b)
lf Latch a
lx = EvalL b -> Latch b
forall a. EvalL a -> Latch a
cachedLatch
    ({-# SCC applyL #-} Latch (a -> b) -> EvalL (a -> b)
forall a. Latch a -> EvalL a
getValueL Latch (a -> b)
lf EvalL (a -> b) -> ReaderWriterIOT () Time IO a -> EvalL b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Latch a -> ReaderWriterIOT () Time IO a
forall a. Latch a -> EvalL a
getValueL Latch a
lx)

accumL :: a -> Pulse (a -> a) -> Build (Latch a, Pulse a)
accumL :: a -> Pulse (a -> a) -> Build (Latch a, Pulse a)
accumL a
a Pulse (a -> a)
p1 = do
    (Pulse a -> Build ()
updateOn, Latch a
x) <- a -> Build (Pulse a -> Build (), Latch a)
forall a. a -> Build (Pulse a -> Build (), Latch a)
newLatch a
a
    Pulse a
p2 <- String -> EvalP (Maybe a) -> Build (Pulse a)
forall a. String -> EvalP (Maybe a) -> Build (Pulse a)
newPulse String
"accumL" (EvalP (Maybe a) -> Build (Pulse a))
-> EvalP (Maybe a) -> Build (Pulse a)
forall a b. (a -> b) -> a -> b
$ do
      a
a <- Latch a -> EvalP a
forall a. Latch a -> EvalP a
readLatchP Latch a
x
      Maybe (a -> a)
f <- Pulse (a -> a) -> EvalP (Maybe (a -> a))
forall a. Pulse a -> EvalP (Maybe a)
readPulseP Pulse (a -> a)
p1
      Maybe a -> EvalP (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> EvalP (Maybe a)) -> Maybe a -> EvalP (Maybe a)
forall a b. (a -> b) -> a -> b
$ ((a -> a) -> a) -> Maybe (a -> a) -> Maybe a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a -> a
g -> a -> a
g a
a) Maybe (a -> a)
f
    Pulse a
p2 Pulse a -> Pulse (a -> a) -> Build ()
forall child parent. Pulse child -> Pulse parent -> Build ()
`dependOn` Pulse (a -> a)
p1
    Pulse a -> Build ()
updateOn Pulse a
p2
    (Latch a, Pulse a) -> Build (Latch a, Pulse a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Latch a
x,Pulse a
p2)

-- specialization of accumL
stepperL :: a -> Pulse a -> Build (Latch a)
stepperL :: a -> Pulse a -> Build (Latch a)
stepperL a
a Pulse a
p = do
    (Pulse a -> Build ()
updateOn, Latch a
x) <- a -> Build (Pulse a -> Build (), Latch a)
forall a. a -> Build (Pulse a -> Build (), Latch a)
newLatch a
a
    Pulse a -> Build ()
updateOn Pulse a
p
    Latch a -> Build (Latch a)
forall (m :: * -> *) a. Monad m => a -> m a
return Latch a
x

{-----------------------------------------------------------------------------
    Combinators - dynamic event switching
------------------------------------------------------------------------------}
switchL :: Latch a -> Pulse (Latch a) -> Build (Latch a)
switchL :: Latch a -> Pulse (Latch a) -> Build (Latch a)
switchL Latch a
l Pulse (Latch a)
pl = mdo
    Latch (Latch a)
x <- Latch a -> Pulse (Latch a) -> Build (Latch (Latch a))
forall a. a -> Pulse a -> Build (Latch a)
stepperL Latch a
l Pulse (Latch a)
pl
    Latch a -> Build (Latch a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Latch a -> Build (Latch a)) -> Latch a -> Build (Latch a)
forall a b. (a -> b) -> a -> b
$ EvalL a -> Latch a
forall a. EvalL a -> Latch a
cachedLatch (EvalL a -> Latch a) -> EvalL a -> Latch a
forall a b. (a -> b) -> a -> b
$ Latch (Latch a) -> EvalL (Latch a)
forall a. Latch a -> EvalL a
getValueL Latch (Latch a)
x EvalL (Latch a) -> (Latch a -> EvalL a) -> EvalL a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Latch a -> EvalL a
forall a. Latch a -> EvalL a
getValueL

executeP :: forall a b. Pulse (b -> Build a) -> b -> Build (Pulse a)
executeP :: Pulse (b -> Build a) -> b -> Build (Pulse a)
executeP Pulse (b -> Build a)
p1 b
b = do
        Pulse a
p2 <- String -> EvalP (Maybe a) -> Build (Pulse a)
forall a. String -> EvalP (Maybe a) -> Build (Pulse a)
newPulse String
"executeP" ({-# SCC executeP #-} Maybe (b -> Build a) -> EvalP (Maybe a)
eval (Maybe (b -> Build a) -> EvalP (Maybe a))
-> RWSIOT BuildR (EvalPW, BuildW) Vault IO (Maybe (b -> Build a))
-> EvalP (Maybe a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Pulse (b -> Build a)
-> RWSIOT BuildR (EvalPW, BuildW) Vault IO (Maybe (b -> Build a))
forall a. Pulse a -> EvalP (Maybe a)
readPulseP Pulse (b -> Build a)
p1)
        Pulse a
p2 Pulse a -> Pulse (b -> Build a) -> Build ()
forall child parent. Pulse child -> Pulse parent -> Build ()
`dependOn` Pulse (b -> Build a)
p1
        Pulse a -> Build (Pulse a)
forall (m :: * -> *) a. Monad m => a -> m a
return Pulse a
p2
    where
    eval :: Maybe (b -> Build a) -> EvalP (Maybe a)
    eval :: Maybe (b -> Build a) -> EvalP (Maybe a)
eval (Just b -> Build a
x) = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a)
-> RWSIOT BuildR (EvalPW, BuildW) Vault IO a -> EvalP (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Build a -> RWSIOT BuildR (EvalPW, BuildW) Vault IO a
forall a. Build a -> EvalP a
liftBuildP (b -> Build a
x b
b)
    eval Maybe (b -> Build a)
Nothing  = Maybe a -> EvalP (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing

switchP :: Pulse a -> Pulse (Pulse a) -> Build (Pulse a)
switchP :: Pulse a -> Pulse (Pulse a) -> Build (Pulse a)
switchP Pulse a
p Pulse (Pulse a)
pp = mdo
    Latch (Pulse a)
lp <- Pulse a -> Pulse (Pulse a) -> Build (Latch (Pulse a))
forall a. a -> Pulse a -> Build (Latch a)
stepperL Pulse a
p Pulse (Pulse a)
pp
    let
        -- switch to a new parent
        switch :: RWSIOT BuildR (EvalPW, BuildW) Vault IO (Maybe a)
switch = do
            Maybe (Pulse a)
mnew <- Pulse (Pulse a) -> EvalP (Maybe (Pulse a))
forall a. Pulse a -> EvalP (Maybe a)
readPulseP Pulse (Pulse a)
pp
            case Maybe (Pulse a)
mnew of
                Maybe (Pulse a)
Nothing  -> () -> RWSIOT BuildR (EvalPW, BuildW) Vault IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                Just Pulse a
new -> Build () -> RWSIOT BuildR (EvalPW, BuildW) Vault IO ()
forall a. Build a -> EvalP a
liftBuildP (Build () -> RWSIOT BuildR (EvalPW, BuildW) Vault IO ())
-> Build () -> RWSIOT BuildR (EvalPW, BuildW) Vault IO ()
forall a b. (a -> b) -> a -> b
$ Pulse a
p2 Pulse a -> Pulse a -> Build ()
forall child parent. Pulse child -> Pulse parent -> Build ()
`changeParent` Pulse a
new
            Maybe a -> RWSIOT BuildR (EvalPW, BuildW) Vault IO (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
        -- fetch value from old parent
        eval :: RWSIOT BuildR (EvalPW, BuildW) Vault IO (Maybe a)
eval = Pulse a -> RWSIOT BuildR (EvalPW, BuildW) Vault IO (Maybe a)
forall a. Pulse a -> EvalP (Maybe a)
readPulseP (Pulse a -> RWSIOT BuildR (EvalPW, BuildW) Vault IO (Maybe a))
-> RWSIOT BuildR (EvalPW, BuildW) Vault IO (Pulse a)
-> RWSIOT BuildR (EvalPW, BuildW) Vault IO (Maybe a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Latch (Pulse a)
-> RWSIOT BuildR (EvalPW, BuildW) Vault IO (Pulse a)
forall a. Latch a -> EvalP a
readLatchP Latch (Pulse a)
lp

    Pulse ()
p1 <- String -> EvalP (Maybe ()) -> Build (Pulse ())
forall a. String -> EvalP (Maybe a) -> Build (Pulse a)
newPulse String
"switchP_in" EvalP (Maybe ())
forall a. RWSIOT BuildR (EvalPW, BuildW) Vault IO (Maybe a)
switch :: Build (Pulse ())
    Pulse ()
p1 Pulse () -> Pulse (Pulse a) -> Build ()
forall child parent. Pulse child -> Pulse parent -> Build ()
`dependOn` Pulse (Pulse a)
pp
    Pulse a
p2 <- String
-> RWSIOT BuildR (EvalPW, BuildW) Vault IO (Maybe a)
-> Build (Pulse a)
forall a. String -> EvalP (Maybe a) -> Build (Pulse a)
newPulse String
"switchP_out" RWSIOT BuildR (EvalPW, BuildW) Vault IO (Maybe a)
eval
    Pulse a
p2 Pulse a -> Pulse a -> Build ()
forall child parent. Pulse child -> Pulse parent -> Build ()
`dependOn` Pulse a
p
    Pulse a
p2 Pulse a -> Pulse () -> Build ()
forall child parent. Pulse child -> Pulse parent -> Build ()
`keepAlive` Pulse ()
p1
    Pulse a -> Build (Pulse a)
forall (m :: * -> *) a. Monad m => a -> m a
return Pulse a
p2