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

    import Control.Monad
        ( join )
    import Control.Monad.IO.Class
        ( liftIO )

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

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

    {-----------------------------------------------------------------------------
        Combinators - basic
    ------------------------------------------------------------------------------}
    mapP :: (a -> b) -> Pulse a -> Build (Pulse b)
    mapP :: forall a b. (a -> b) -> Pulse a -> Build (Pulse b)
    mapP a -> b
    f Pulse a
    p1 = do
        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 a b. (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)
        p2 `dependOn` p1
        return 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 :: forall a b. Latch a -> Pulse b -> Build (Pulse (Future a))
    tagFuture Latch a
    x Pulse b
    p1 = do
        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 a b. (a -> b) -> Maybe a -> Maybe b
    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 a b.
    RWSIOT BuildR (EvalPW, BuildW) Vault IO (a -> b)
    -> RWSIOT BuildR (EvalPW, BuildW) Vault IO a
    -> RWSIOT BuildR (EvalPW, BuildW) Vault IO b
    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
        p2 `dependOn` p1
        return p2

    filterJustP :: Pulse (Maybe a) -> Build (Pulse a)
    filterJustP :: forall a. Pulse (Maybe a) -> Build (Pulse a)
    filterJustP Pulse (Maybe a)
    p1 = do
        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)
        p2 `dependOn` p1
        return p2

    unsafeMapIOP :: forall a b. (a -> IO b) -> Pulse a -> Build (Pulse b)
    unsafeMapIOP :: forall a b. (a -> IO b) -> Pulse a -> Build (Pulse b)
    unsafeMapIOP a -> IO b
    f Pulse a
    p1 = do
            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)
            p2 `dependOn` p1
            return 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 a. IO a -> RWSIOT BuildR (EvalPW, BuildW) Vault IO a
    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 a. a -> RWSIOT BuildR (EvalPW, BuildW) Vault IO a
    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 :: forall a c b.
    (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
      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 a b.
    RWSIOT BuildR (EvalPW, BuildW) Vault IO (a -> b)
    -> RWSIOT BuildR (EvalPW, BuildW) Vault IO a
    -> RWSIOT BuildR (EvalPW, BuildW) Vault IO b
    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)
      p `dependOn` px
      p `dependOn` py
      return 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 :: forall a b. Latch (a -> b) -> Pulse a -> Build (Pulse b)
    applyP Latch (a -> b)
    f Pulse a
    x = do
        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 a b. (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 a b.
    RWSIOT BuildR (EvalPW, BuildW) Vault IO (a -> b)
    -> RWSIOT BuildR (EvalPW, BuildW) Vault IO a
    -> RWSIOT BuildR (EvalPW, BuildW) Vault IO 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)
        p `dependOn` x
        return p

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

    -- specialization of   mapL f = applyL (pureL f)
    mapL :: (a -> b) -> Latch a -> Latch b
    mapL :: forall a b. (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 :: forall a b. 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 a b.
    ReaderWriterIOT () Time IO (a -> b)
    -> ReaderWriterIOT () Time IO a -> ReaderWriterIOT () Time IO 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 :: forall a. a -> Pulse (a -> a) -> Build (Latch a, Pulse a)
    accumL a
    a Pulse (a -> a)
    p1 = do
        (updateOn, x) <- a -> Build (Pulse a -> Build (), Latch a)
    forall a. a -> Build (Pulse a -> Build (), Latch a)
    newLatch a
    a
        p2 <- newPulse "accumL" $ do
          a <- readLatchP x
          f <- readPulseP p1
          return $ fmap (\a -> a
    g -> a -> a
    g a
    a) f
        p2 `dependOn` p1
        updateOn p2
        return (x,p2)

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

    {-----------------------------------------------------------------------------
        Combinators - dynamic event switching
    ------------------------------------------------------------------------------}
    switchL :: Latch a -> Pulse (Latch a) -> Build (Latch a)
    switchL :: forall a. Latch a -> Pulse (Latch a) -> Build (Latch a)
    switchL Latch a
    l Pulse (Latch a)
    pl = mdo
        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
        return $ cachedLatch $ getValueL x >>= getValueL

    executeP :: forall a b. Pulse (b -> Build a) -> b -> Build (Pulse a)
    executeP :: forall a b. Pulse (b -> Build a) -> b -> Build (Pulse a)
    executeP Pulse (b -> Build a)
    p1 b
    b = do
            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)
            p2 `dependOn` p1
            return 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 a. a -> RWSIOT BuildR (EvalPW, BuildW) Vault IO 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 :: forall a. Pulse a -> Pulse (Pulse a) -> Build (Pulse a)
    switchP Pulse a
    p Pulse (Pulse a)
    pp = do
        -- track the latest Pulse in a Latch
        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

        -- fetch the latest Pulse value
        pout <- newPulse "switchP_out" (readPulseP =<< readLatchP lp)

        let -- switch the Pulse `pout` to a new parent,
            -- keeping track of the new dependencies.
            switch = do
                mnew <- Pulse (Pulse a) -> EvalP (Maybe (Pulse a))
    forall a. Pulse a -> EvalP (Maybe a)
    readPulseP Pulse (Pulse a)
    pp
                case mnew of
                    Maybe (Pulse a)
    Nothing  -> () -> RWSIOT BuildR (EvalPW, BuildW) Vault IO ()
    forall a. a -> RWSIOT BuildR (EvalPW, BuildW) Vault IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
                    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
    pout Pulse a -> Pulse a -> Build ()
    forall child parent. Pulse child -> Pulse parent -> Build ()
    `changeParent` Pulse a
    new
                pure Nothing

        pin <- newPulse "switchP_in" switch :: Build (Pulse ())
        pin  `dependOn` pp

        pout `dependOn` p       -- initial dependency
        pout `keepAlive` pin    -- keep switches happening
        pure pout