{-# LANGUAGE Arrows #-}
module FRP.BearRiver.Hybrid where
import Control.Arrow (arr, returnA, (<<<))
import Data.MonadicStreamFunction (accumulateWith, feedback)
import FRP.BearRiver.Arrow (dup)
import FRP.BearRiver.Event (Event (..), event)
import FRP.BearRiver.InternalCore (SF)
hold :: Monad m => a -> SF m (Event a) a
hold :: forall (m :: * -> *) a. Monad m => a -> SF m (Event a) a
hold a
a = a
-> MSF (ClockInfo m) (Event a, a) (a, a)
-> MSF (ClockInfo m) (Event a) a
forall (m :: * -> *) c a b.
Monad m =>
c -> MSF m (a, c) (b, c) -> MSF m a b
feedback a
a (MSF (ClockInfo m) (Event a, a) (a, a)
-> MSF (ClockInfo m) (Event a) a)
-> MSF (ClockInfo m) (Event a, a) (a, a)
-> MSF (ClockInfo m) (Event a) a
forall a b. (a -> b) -> a -> b
$ ((Event a, a) -> (a, a)) -> MSF (ClockInfo m) (Event a, a) (a, a)
forall b c. (b -> c) -> MSF (ClockInfo m) b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (((Event a, a) -> (a, a)) -> MSF (ClockInfo m) (Event a, a) (a, a))
-> ((Event a, a) -> (a, a))
-> MSF (ClockInfo m) (Event a, a) (a, a)
forall a b. (a -> b) -> a -> b
$ \(Event a
e, a
a') ->
a -> (a, a)
forall a. a -> (a, a)
dup (a -> (a -> a) -> Event a -> a
forall a b. a -> (b -> a) -> Event b -> a
event a
a' a -> a
forall a. a -> a
id Event a
e)
accumBy :: Monad m => (b -> a -> b) -> b -> SF m (Event a) (Event b)
accumBy :: forall (m :: * -> *) b a.
Monad m =>
(b -> a -> b) -> b -> SF m (Event a) (Event b)
accumBy b -> a -> b
f b
b = SF m a b -> SF m (Event a) (Event b)
forall (m :: * -> *) a b.
Monad m =>
SF m a b -> SF m (Event a) (Event b)
mapEventS (SF m a b -> SF m (Event a) (Event b))
-> SF m a b -> SF m (Event a) (Event b)
forall a b. (a -> b) -> a -> b
$ (a -> b -> b) -> b -> SF m a b
forall (m :: * -> *) a s.
Monad m =>
(a -> s -> s) -> s -> MSF m a s
accumulateWith ((b -> a -> b) -> a -> b -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip b -> a -> b
f) b
b
accumHoldBy :: Monad m => (b -> a -> b) -> b -> SF m (Event a) b
accumHoldBy :: forall (m :: * -> *) b a.
Monad m =>
(b -> a -> b) -> b -> SF m (Event a) b
accumHoldBy b -> a -> b
f b
b = b
-> MSF (ClockInfo m) (Event a, b) (b, b)
-> MSF (ClockInfo m) (Event a) b
forall (m :: * -> *) c a b.
Monad m =>
c -> MSF m (a, c) (b, c) -> MSF m a b
feedback b
b (MSF (ClockInfo m) (Event a, b) (b, b)
-> MSF (ClockInfo m) (Event a) b)
-> MSF (ClockInfo m) (Event a, b) (b, b)
-> MSF (ClockInfo m) (Event a) b
forall a b. (a -> b) -> a -> b
$ ((Event a, b) -> (b, b)) -> MSF (ClockInfo m) (Event a, b) (b, b)
forall b c. (b -> c) -> MSF (ClockInfo m) b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (((Event a, b) -> (b, b)) -> MSF (ClockInfo m) (Event a, b) (b, b))
-> ((Event a, b) -> (b, b))
-> MSF (ClockInfo m) (Event a, b) (b, b)
forall a b. (a -> b) -> a -> b
$ \(Event a
a, b
b') ->
let b'' :: b
b'' = b -> (a -> b) -> Event a -> b
forall a b. a -> (b -> a) -> Event b -> a
event b
b' (b -> a -> b
f b
b') Event a
a
in (b
b'', b
b'')
mapEventS :: Monad m => SF m a b -> SF m (Event a) (Event b)
mapEventS :: forall (m :: * -> *) a b.
Monad m =>
SF m a b -> SF m (Event a) (Event b)
mapEventS SF m a b
msf = proc Event a
eventA -> case Event a
eventA of
Event a
a -> (b -> Event b) -> MSF (ClockInfo m) b (Event b)
forall b c. (b -> c) -> MSF (ClockInfo m) b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr b -> Event b
forall a. a -> Event a
Event MSF (ClockInfo m) b (Event b)
-> SF m a b -> MSF (ClockInfo m) a (Event b)
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< SF m a b
msf -< a
a
Event a
NoEvent -> MSF (ClockInfo m) (Event b) (Event b)
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< Event b
forall a. Event a
NoEvent