{-# LANGUAGE Arrows #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE RankNTypes #-}
#if __GLASGOW_HASKELL__ < 800
{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}
#else
{-# OPTIONS_GHC -Wno-deprecations #-}
#endif
{-# OPTIONS_HADDOCK ignore-exports #-}
module FRP.BearRiver
(module FRP.BearRiver, module X)
where
import Control.Applicative
import Control.Arrow as X
import qualified Control.Category as Category
import Control.DeepSeq (NFData (..))
import Control.Monad (mapM)
import qualified Control.Monad.Fail as Fail
import Control.Monad.Random
import Control.Monad.Trans.Maybe
import Data.Functor.Identity
import Data.Maybe
import Data.Traversable as T
import Data.VectorSpace as X
import Control.Monad.Trans.MSF hiding (dSwitch,
switch)
import qualified Control.Monad.Trans.MSF as MSF
import Control.Monad.Trans.MSF.Except as MSF hiding (dSwitch,
switch)
import Control.Monad.Trans.MSF.List (sequenceS, widthFirst)
import Control.Monad.Trans.MSF.Random
import Data.MonadicStreamFunction as X hiding (dSwitch,
reactimate,
repeatedly, sum,
switch, trace)
import qualified Data.MonadicStreamFunction as MSF
import Data.MonadicStreamFunction.InternalCore
import Data.MonadicStreamFunction.Instances.ArrowLoop
infixr 0 -->, -:>, >--, >=-
type Time = Double
type DTime = Double
type SF m = MSF (ClockInfo m)
type ClockInfo m = ReaderT DTime m
data Event a = Event a | NoEvent
deriving (Event a -> Event a -> Bool
forall a. Eq a => Event a -> Event a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Event a -> Event a -> Bool
$c/= :: forall a. Eq a => Event a -> Event a -> Bool
== :: Event a -> Event a -> Bool
$c== :: forall a. Eq a => Event a -> Event a -> Bool
Eq, Event a -> Event a -> Bool
Event a -> Event a -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (Event a)
forall a. Ord a => Event a -> Event a -> Bool
forall a. Ord a => Event a -> Event a -> Ordering
forall a. Ord a => Event a -> Event a -> Event a
min :: Event a -> Event a -> Event a
$cmin :: forall a. Ord a => Event a -> Event a -> Event a
max :: Event a -> Event a -> Event a
$cmax :: forall a. Ord a => Event a -> Event a -> Event a
>= :: Event a -> Event a -> Bool
$c>= :: forall a. Ord a => Event a -> Event a -> Bool
> :: Event a -> Event a -> Bool
$c> :: forall a. Ord a => Event a -> Event a -> Bool
<= :: Event a -> Event a -> Bool
$c<= :: forall a. Ord a => Event a -> Event a -> Bool
< :: Event a -> Event a -> Bool
$c< :: forall a. Ord a => Event a -> Event a -> Bool
compare :: Event a -> Event a -> Ordering
$ccompare :: forall a. Ord a => Event a -> Event a -> Ordering
Ord, Int -> Event a -> ShowS
forall a. Show a => Int -> Event a -> ShowS
forall a. Show a => [Event a] -> ShowS
forall a. Show a => Event a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Event a] -> ShowS
$cshowList :: forall a. Show a => [Event a] -> ShowS
show :: Event a -> String
$cshow :: forall a. Show a => Event a -> String
showsPrec :: Int -> Event a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Event a -> ShowS
Show)
instance Functor Event where
fmap :: forall a b. (a -> b) -> Event a -> Event b
fmap a -> b
_ Event a
NoEvent = forall a. Event a
NoEvent
fmap a -> b
f (Event a
c) = forall a. a -> Event a
Event (a -> b
f a
c)
instance Applicative Event where
pure :: forall a. a -> Event a
pure = forall a. a -> Event a
Event
Event a -> b
f <*> :: forall a b. Event (a -> b) -> Event a -> Event b
<*> Event a
x = forall a. a -> Event a
Event (a -> b
f a
x)
Event (a -> b)
_ <*> Event a
_ = forall a. Event a
NoEvent
instance Monad Event where
return :: forall a. a -> Event a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
Event a
x >>= :: forall a b. Event a -> (a -> Event b) -> Event b
>>= a -> Event b
f = a -> Event b
f a
x
Event a
NoEvent >>= a -> Event b
_ = forall a. Event a
NoEvent
instance Fail.MonadFail Event where
fail :: forall a. String -> Event a
fail String
_ = forall a. Event a
NoEvent
instance Alternative Event where
empty :: forall a. Event a
empty = forall a. Event a
NoEvent
Event a
NoEvent <|> :: forall a. Event a -> Event a -> Event a
<|> Event a
r = Event a
r
Event a
l <|> Event a
_ = Event a
l
instance NFData a => NFData (Event a) where
rnf :: Event a -> ()
rnf Event a
NoEvent = ()
rnf (Event a
a) = forall a. NFData a => a -> ()
rnf a
a seq :: forall a b. a -> b -> b
`seq` ()
arrPrim :: Monad m => (a -> b) -> SF m a b
arrPrim :: forall (m :: * -> *) a b. Monad m => (a -> b) -> SF m a b
arrPrim = forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr
arrEPrim :: Monad m => (Event a -> b) -> SF m (Event a) b
arrEPrim :: forall (m :: * -> *) a b.
Monad m =>
(Event a -> b) -> SF m (Event a) b
arrEPrim = forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr
identity :: Monad m => SF m a a
identity :: forall (m :: * -> *) a. Monad m => SF m a a
identity = forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
Category.id
constant :: Monad m => b -> SF m a b
constant :: forall (m :: * -> *) b a. Monad m => b -> SF m a b
constant = forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const
localTime :: Monad m => SF m a Time
localTime :: forall (m :: * -> *) a. Monad m => SF m a Time
localTime = forall (m :: * -> *) b a. Monad m => b -> SF m a b
constant Time
1.0 forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (m :: * -> *) s a.
(Monad m, Fractional s, VectorSpace a s) =>
SF m a a
integral
time :: Monad m => SF m a Time
time :: forall (m :: * -> *) a. Monad m => SF m a Time
time = forall (m :: * -> *) a. Monad m => SF m a Time
localTime
(-->) :: Monad m => b -> SF m a b -> SF m a b
b
b0 --> :: forall (m :: * -> *) b a. Monad m => b -> SF m a b -> SF m a b
--> SF m a b
sf = SF m a b
sf forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (m :: * -> *) a. Monad m => a -> SF m a a
replaceOnce b
b0
(-:>) :: Monad m => b -> SF m a b -> SF m a b
b
b -:> :: forall (m :: * -> *) b a. Monad m => b -> SF m a b -> SF m a b
-:> SF m a b
sf = forall (m :: * -> *) b a. Monad m => b -> MSF m a b -> MSF m a b
iPost b
b SF m a b
sf
(>--) :: Monad m => a -> SF m a b -> SF m a b
a
a0 >-- :: forall (m :: * -> *) a b. Monad m => a -> SF m a b -> SF m a b
>-- SF m a b
sf = forall (m :: * -> *) a. Monad m => a -> SF m a a
replaceOnce a
a0 forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> SF m a b
sf
(>=-) :: Monad m => (a -> a) -> SF m a b -> SF m a b
a -> a
f >=- :: forall (m :: * -> *) a b.
Monad m =>
(a -> a) -> SF m a b -> SF m a b
>=- SF m a b
sf = forall (m :: * -> *) a b. (a -> m (b, MSF m a b)) -> MSF m a b
MSF forall a b. (a -> b) -> a -> b
$ \a
a -> do
(b
b, SF m a b
sf') <- forall (m :: * -> *) a b. MSF m a b -> a -> m (b, MSF m a b)
unMSF SF m a b
sf (a -> a
f a
a)
forall (m :: * -> *) a. Monad m => a -> m a
return (b
b, SF m a b
sf')
initially :: Monad m => a -> SF m a a
initially :: forall (m :: * -> *) a. Monad m => a -> SF m a a
initially = (forall (m :: * -> *) b a. Monad m => b -> SF m a b -> SF m a b
--> forall (m :: * -> *) a. Monad m => SF m a a
identity)
sscan :: Monad m => (b -> a -> b) -> b -> SF m a b
sscan :: forall (m :: * -> *) b a. Monad m => (b -> a -> b) -> b -> SF m a b
sscan b -> a -> b
f b
b_init = forall (m :: * -> *) c a b.
Monad m =>
c -> MSF m (a, c) (b, c) -> MSF m a b
feedback b
b_init forall {a}. a
u
where u :: a
u = forall a. HasCallStack => a
undefined
sscanPrim :: Monad m => (c -> a -> Maybe (c, b)) -> c -> b -> SF m a b
sscanPrim :: forall (m :: * -> *) c a b.
Monad m =>
(c -> a -> Maybe (c, b)) -> c -> b -> SF m a b
sscanPrim c -> a -> Maybe (c, b)
f c
c_init b
b_init = forall (m :: * -> *) a b. (a -> m (b, MSF m a b)) -> MSF m a b
MSF forall a b. (a -> b) -> a -> b
$ \a
a -> do
let o :: Maybe (c, b)
o = c -> a -> Maybe (c, b)
f c
c_init a
a
case Maybe (c, b)
o of
Maybe (c, b)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return (b
b_init, forall (m :: * -> *) c a b.
Monad m =>
(c -> a -> Maybe (c, b)) -> c -> b -> SF m a b
sscanPrim c -> a -> Maybe (c, b)
f c
c_init b
b_init)
Just (c
c', b
b') -> forall (m :: * -> *) a. Monad m => a -> m a
return (b
b', forall (m :: * -> *) c a b.
Monad m =>
(c -> a -> Maybe (c, b)) -> c -> b -> SF m a b
sscanPrim c -> a -> Maybe (c, b)
f c
c' b
b')
never :: Monad m => SF m a (Event b)
never :: forall (m :: * -> *) a b. Monad m => SF m a (Event b)
never = forall (m :: * -> *) b a. Monad m => b -> SF m a b
constant forall a. Event a
NoEvent
now :: Monad m => b -> SF m a (Event b)
now :: forall (m :: * -> *) b a. Monad m => b -> SF m a (Event b)
now b
b0 = forall a. a -> Event a
Event b
b0 forall (m :: * -> *) b a. Monad m => b -> SF m a b -> SF m a b
--> forall (m :: * -> *) a b. Monad m => SF m a (Event b)
never
after :: Monad m
=> Time
-> b
-> SF m a (Event b)
after :: forall (m :: * -> *) b a. Monad m => Time -> b -> SF m a (Event b)
after Time
q b
x = forall (m :: * -> *) c a b.
Monad m =>
c -> MSF m (a, c) (b, c) -> MSF m a b
feedback Time
q forall {a}. MSF (ClockInfo m) (a, Time) (Event b, Time)
go
where go :: MSF (ClockInfo m) (a, Time) (Event b, Time)
go = forall (m :: * -> *) a b. (a -> m (b, MSF m a b)) -> MSF m a b
MSF forall a b. (a -> b) -> a -> b
$ \(a
_, Time
t) -> do
Time
dt <- forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
let t' :: Time
t' = Time
t forall a. Num a => a -> a -> a
- Time
dt
e :: Event b
e = if Time
t forall a. Ord a => a -> a -> Bool
> Time
0 Bool -> Bool -> Bool
&& Time
t' forall a. Ord a => a -> a -> Bool
< Time
0 then forall a. a -> Event a
Event b
x else forall a. Event a
NoEvent
ct :: MSF (ClockInfo m) (a, Time) (Event b, Time)
ct = if Time
t' forall a. Ord a => a -> a -> Bool
< Time
0 then forall (m :: * -> *) b a. Monad m => b -> SF m a b
constant (forall a. Event a
NoEvent, Time
t') else MSF (ClockInfo m) (a, Time) (Event b, Time)
go
forall (m :: * -> *) a. Monad m => a -> m a
return ((Event b
e, Time
t'), MSF (ClockInfo m) (a, Time) (Event b, Time)
ct)
repeatedly :: Monad m => Time -> b -> SF m a (Event b)
repeatedly :: forall (m :: * -> *) b a. Monad m => Time -> b -> SF m a (Event b)
repeatedly Time
q b
x
| Time
q forall a. Ord a => a -> a -> Bool
> Time
0 = forall (m :: * -> *) b a.
Monad m =>
[(Time, b)] -> SF m a (Event b)
afterEach [(Time, b)]
qxs
| Bool
otherwise = forall a. HasCallStack => String -> a
error String
"bearriver: repeatedly: Non-positive period."
where
qxs :: [(Time, b)]
qxs = (Time
q,b
x)forall a. a -> [a] -> [a]
:[(Time, b)]
qxs
afterEach :: Monad m => [(Time,b)] -> SF m a (Event b)
afterEach :: forall (m :: * -> *) b a.
Monad m =>
[(Time, b)] -> SF m a (Event b)
afterEach [(Time, b)]
qxs = forall (m :: * -> *) b a.
Monad m =>
[(Time, b)] -> SF m a (Event [b])
afterEachCat [(Time, b)]
qxs forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. [a] -> a
head)
afterEachCat :: Monad m => [(Time,b)] -> SF m a (Event [b])
afterEachCat :: forall (m :: * -> *) b a.
Monad m =>
[(Time, b)] -> SF m a (Event [b])
afterEachCat = forall (m :: * -> *) b a.
Monad m =>
Time -> [(Time, b)] -> SF m a (Event [b])
afterEachCat' Time
0
where
afterEachCat' :: Monad m => Time -> [(Time,b)] -> SF m a (Event [b])
afterEachCat' :: forall (m :: * -> *) b a.
Monad m =>
Time -> [(Time, b)] -> SF m a (Event [b])
afterEachCat' Time
_ [] = forall (m :: * -> *) a b. Monad m => SF m a (Event b)
never
afterEachCat' Time
t [(Time, b)]
qxs = forall (m :: * -> *) a b. (a -> m (b, MSF m a b)) -> MSF m a b
MSF forall a b. (a -> b) -> a -> b
$ \a
_ -> do
Time
dt <- forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
let ([b]
ev, Time
t', [(Time, b)]
qxs') = forall b. [b] -> Time -> [(Time, b)] -> ([b], Time, [(Time, b)])
fireEvents [] (Time
t forall a. Num a => a -> a -> a
+ Time
dt) [(Time, b)]
qxs
ev' :: Event [b]
ev' = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [b]
ev
then forall a. Event a
NoEvent
else forall a. a -> Event a
Event (forall a. [a] -> [a]
reverse [b]
ev)
forall (m :: * -> *) a. Monad m => a -> m a
return (Event [b]
ev', forall (m :: * -> *) b a.
Monad m =>
Time -> [(Time, b)] -> SF m a (Event [b])
afterEachCat' Time
t' [(Time, b)]
qxs')
fireEvents :: [b] -> Time -> [(Time,b)] -> ([b], Time, [(Time,b)])
fireEvents :: forall b. [b] -> Time -> [(Time, b)] -> ([b], Time, [(Time, b)])
fireEvents [b]
ev Time
t [] = ([b]
ev, Time
t, [])
fireEvents [b]
ev Time
t ((Time, b)
qx:[(Time, b)]
qxs)
| forall a b. (a, b) -> a
fst (Time, b)
qx forall a. Ord a => a -> a -> Bool
< Time
0 = forall a. HasCallStack => String -> a
error String
"bearriver: afterEachCat: Non-positive period."
| Bool
otherwise =
let overdue :: Time
overdue = Time
t forall a. Num a => a -> a -> a
- forall a b. (a, b) -> a
fst (Time, b)
qx in
if Time
overdue forall a. Ord a => a -> a -> Bool
>= Time
0
then forall b. [b] -> Time -> [(Time, b)] -> ([b], Time, [(Time, b)])
fireEvents (forall a b. (a, b) -> b
snd (Time, b)
qxforall a. a -> [a] -> [a]
:[b]
ev) Time
overdue [(Time, b)]
qxs
else ([b]
ev, Time
t, (Time, b)
qxforall a. a -> [a] -> [a]
:[(Time, b)]
qxs)
mapEventS :: Monad m => MSF m a b -> MSF m (Event a) (Event b)
mapEventS :: forall (m :: * -> *) a b.
Monad m =>
MSF m a b -> MSF m (Event a) (Event b)
mapEventS MSF m a b
msf = proc Event a
eventA -> case Event a
eventA of
Event a
a -> forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr forall a. a -> Event a
Event forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< MSF m a b
msf -< a
a
Event a
NoEvent -> forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< forall a. Event a
NoEvent
eventToMaybe :: Event a -> Maybe a
eventToMaybe = forall a b. a -> (b -> a) -> Event b -> a
event forall a. Maybe a
Nothing forall a. a -> Maybe a
Just
boolToEvent :: Bool -> Event ()
boolToEvent :: Bool -> Event ()
boolToEvent Bool
True = forall a. a -> Event a
Event ()
boolToEvent Bool
False = forall a. Event a
NoEvent
edge :: Monad m => SF m Bool (Event ())
edge :: forall (m :: * -> *). Monad m => SF m Bool (Event ())
edge = forall (m :: * -> *). Monad m => Bool -> SF m Bool (Event ())
edgeFrom Bool
True
iEdge :: Monad m => Bool -> SF m Bool (Event ())
iEdge :: forall (m :: * -> *). Monad m => Bool -> SF m Bool (Event ())
iEdge = forall (m :: * -> *). Monad m => Bool -> SF m Bool (Event ())
edgeFrom
edgeTag :: Monad m => a -> SF m Bool (Event a)
edgeTag :: forall (m :: * -> *) a. Monad m => a -> SF m Bool (Event a)
edgeTag a
a = forall (m :: * -> *). Monad m => SF m Bool (Event ())
edge forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (forall a b. Event a -> b -> Event b
`tag` a
a)
edgeJust :: Monad m => SF m (Maybe a) (Event a)
edgeJust :: forall (m :: * -> *) a. Monad m => SF m (Maybe a) (Event a)
edgeJust = forall (m :: * -> *) a b.
Monad m =>
(a -> a -> Maybe b) -> a -> SF m a (Event b)
edgeBy forall {a} {a}. Maybe a -> Maybe a -> Maybe a
isJustEdge (forall a. a -> Maybe a
Just forall a. HasCallStack => a
undefined)
where
isJustEdge :: Maybe a -> Maybe a -> Maybe a
isJustEdge Maybe a
Nothing Maybe a
Nothing = forall a. Maybe a
Nothing
isJustEdge Maybe a
Nothing ma :: Maybe a
ma@(Just a
_) = Maybe a
ma
isJustEdge (Just a
_) (Just a
_) = forall a. Maybe a
Nothing
isJustEdge (Just a
_) Maybe a
Nothing = forall a. Maybe a
Nothing
edgeBy :: Monad m => (a -> a -> Maybe b) -> a -> SF m a (Event b)
edgeBy :: forall (m :: * -> *) a b.
Monad m =>
(a -> a -> Maybe b) -> a -> SF m a (Event b)
edgeBy a -> a -> Maybe b
isEdge a
a_prev = forall (m :: * -> *) a b. (a -> m (b, MSF m a b)) -> MSF m a b
MSF forall a b. (a -> b) -> a -> b
$ \a
a ->
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Maybe a -> Event a
maybeToEvent (a -> a -> Maybe b
isEdge a
a_prev a
a), forall (m :: * -> *) a b.
Monad m =>
(a -> a -> Maybe b) -> a -> SF m a (Event b)
edgeBy a -> a -> Maybe b
isEdge a
a)
maybeToEvent :: Maybe a -> Event a
maybeToEvent :: forall a. Maybe a -> Event a
maybeToEvent = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Event a
NoEvent forall a. a -> Event a
Event
edgeFrom :: Monad m => Bool -> SF m Bool (Event())
edgeFrom :: forall (m :: * -> *). Monad m => Bool -> SF m Bool (Event ())
edgeFrom Bool
prev = forall (m :: * -> *) a b. (a -> m (b, MSF m a b)) -> MSF m a b
MSF forall a b. (a -> b) -> a -> b
$ \Bool
a -> do
let res :: Event ()
res | Bool
prev = forall a. Event a
NoEvent
| Bool
a = forall a. a -> Event a
Event ()
| Bool
otherwise = forall a. Event a
NoEvent
ct :: MSF (ReaderT Time m) Bool (Event ())
ct = forall (m :: * -> *). Monad m => Bool -> SF m Bool (Event ())
edgeFrom Bool
a
forall (m :: * -> *) a. Monad m => a -> m a
return (Event ()
res, MSF (ReaderT Time m) Bool (Event ())
ct)
notYet :: Monad m => SF m (Event a) (Event a)
notYet :: forall (m :: * -> *) a. Monad m => SF m (Event a) (Event a)
notYet = forall (m :: * -> *) c a b.
Monad m =>
c -> MSF m (a, c) (b, c) -> MSF m a b
feedback Bool
False forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (\(Event a
e,Bool
c) ->
if Bool
c then (Event a
e, Bool
True) else (forall a. Event a
NoEvent, Bool
True))
once :: Monad m => SF m (Event a) (Event a)
once :: forall (m :: * -> *) a. Monad m => SF m (Event a) (Event a)
once = forall (m :: * -> *) a. Monad m => Int -> SF m (Event a) (Event a)
takeEvents Int
1
takeEvents :: Monad m => Int -> SF m (Event a) (Event a)
takeEvents :: forall (m :: * -> *) a. Monad m => Int -> SF m (Event a) (Event a)
takeEvents Int
n | Int
n forall a. Ord a => a -> a -> Bool
<= Int
0 = forall (m :: * -> *) a b. Monad m => SF m a (Event b)
never
takeEvents Int
n = forall (m :: * -> *) a b c.
Monad m =>
SF m a (b, Event c) -> (c -> SF m a b) -> SF m a b
dSwitch (forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr forall {b}. b -> (b, b)
dup) (forall a b. a -> b -> a
const (forall a. Event a
NoEvent forall (m :: * -> *) a b. Monad m => a -> SF m a b -> SF m a b
>-- forall (m :: * -> *) a. Monad m => Int -> SF m (Event a) (Event a)
takeEvents (Int
n forall a. Num a => a -> a -> a
- Int
1)))
dropEvents :: Monad m => Int -> SF m (Event a) (Event a)
dropEvents :: forall (m :: * -> *) a. Monad m => Int -> SF m (Event a) (Event a)
dropEvents Int
n | Int
n forall a. Ord a => a -> a -> Bool
<= Int
0 = forall (m :: * -> *) a. Monad m => SF m a a
identity
dropEvents Int
n = forall (m :: * -> *) a b c.
Monad m =>
SF m a (b, Event c) -> (c -> SF m a b) -> SF m a b
dSwitch (forall (m :: * -> *) a b. Monad m => SF m a (Event b)
never forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& forall (m :: * -> *) a. Monad m => SF m a a
identity)
(forall a b. a -> b -> a
const (forall a. Event a
NoEvent forall (m :: * -> *) a b. Monad m => a -> SF m a b -> SF m a b
>-- forall (m :: * -> *) a. Monad m => Int -> SF m (Event a) (Event a)
dropEvents (Int
n forall a. Num a => a -> a -> a
- Int
1)))
noEvent :: Event a
noEvent :: forall a. Event a
noEvent = forall a. Event a
NoEvent
noEventFst :: (Event a, b) -> (Event c, b)
noEventFst :: forall a b c. (Event a, b) -> (Event c, b)
noEventFst (Event a
_, b
b) = (forall a. Event a
NoEvent, b
b)
noEventSnd :: (a, Event b) -> (a, Event c)
noEventSnd :: forall a b c. (a, Event b) -> (a, Event c)
noEventSnd (a
a, Event b
_) = (a
a, forall a. Event a
NoEvent)
event :: a -> (b -> a) -> Event b -> a
event :: forall a b. a -> (b -> a) -> Event b -> a
event a
_ b -> a
f (Event b
x) = b -> a
f b
x
event a
x b -> a
_ Event b
NoEvent = a
x
fromEvent :: Event a -> a
fromEvent (Event a
x) = a
x
fromEvent Event a
_ = forall a. HasCallStack => String -> a
error String
"fromEvent NoEvent"
isEvent :: Event a -> Bool
isEvent (Event a
_) = Bool
True
isEvent Event a
_ = Bool
False
isNoEvent :: Event a -> Bool
isNoEvent (Event a
_) = Bool
False
isNoEvent Event a
_ = Bool
True
tag :: Event a -> b -> Event b
tag :: forall a b. Event a -> b -> Event b
tag Event a
NoEvent b
_ = forall a. Event a
NoEvent
tag (Event a
_) b
b = forall a. a -> Event a
Event b
b
tagWith :: b -> Event a -> Event b
tagWith :: forall a b. a -> Event b -> Event a
tagWith = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. Event a -> b -> Event b
tag
attach :: Event a -> b -> Event (a, b)
Event a
e attach :: forall a b. Event a -> b -> Event (a, b)
`attach` b
b = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
a -> (a
a, b
b)) Event a
e
lMerge :: Event a -> Event a -> Event a
lMerge :: forall a. Event a -> Event a -> Event a
lMerge = forall a. (a -> a -> a) -> Event a -> Event a -> Event a
mergeBy (\a
e1 a
_ -> a
e1)
rMerge :: Event a -> Event a -> Event a
rMerge :: forall a. Event a -> Event a -> Event a
rMerge = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Event a -> Event a -> Event a
lMerge
merge :: Event a -> Event a -> Event a
merge :: forall a. Event a -> Event a -> Event a
merge = forall a. (a -> a -> a) -> Event a -> Event a -> Event a
mergeBy forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => String -> a
error String
"Bearriver: merge: Simultaneous event occurrence."
mergeBy :: (a -> a -> a) -> Event a -> Event a -> Event a
mergeBy :: forall a. (a -> a -> a) -> Event a -> Event a -> Event a
mergeBy a -> a -> a
_ Event a
NoEvent Event a
NoEvent = forall a. Event a
NoEvent
mergeBy a -> a -> a
_ le :: Event a
le@(Event a
_) Event a
NoEvent = Event a
le
mergeBy a -> a -> a
_ Event a
NoEvent re :: Event a
re@(Event a
_) = Event a
re
mergeBy a -> a -> a
resolve (Event a
l) (Event a
r) = forall a. a -> Event a
Event (a -> a -> a
resolve a
l a
r)
mapMerge :: (a -> c) -> (b -> c) -> (a -> b -> c)
-> Event a -> Event b -> Event c
mapMerge :: forall a c b.
(a -> c)
-> (b -> c) -> (a -> b -> c) -> Event a -> Event b -> Event c
mapMerge a -> c
_ b -> c
_ a -> b -> c
_ Event a
NoEvent Event b
NoEvent = forall a. Event a
NoEvent
mapMerge a -> c
lf b -> c
_ a -> b -> c
_ (Event a
l) Event b
NoEvent = forall a. a -> Event a
Event (a -> c
lf a
l)
mapMerge a -> c
_ b -> c
rf a -> b -> c
_ Event a
NoEvent (Event b
r) = forall a. a -> Event a
Event (b -> c
rf b
r)
mapMerge a -> c
_ b -> c
_ a -> b -> c
lrf (Event a
l) (Event b
r) = forall a. a -> Event a
Event (a -> b -> c
lrf a
l b
r)
mergeEvents :: [Event a] -> Event a
mergeEvents :: forall a. [Event a] -> Event a
mergeEvents = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall a. Event a -> Event a -> Event a
lMerge forall a. Event a
NoEvent
catEvents :: [Event a] -> Event [a]
catEvents :: forall a. [Event a] -> Event [a]
catEvents [Event a]
eas = case [ a
a | Event a
a <- [Event a]
eas ] of
[] -> forall a. Event a
NoEvent
[a]
as -> forall a. a -> Event a
Event [a]
as
joinE :: Event a -> Event b -> Event (a,b)
joinE :: forall a b. Event a -> Event b -> Event (a, b)
joinE Event a
NoEvent Event b
_ = forall a. Event a
NoEvent
joinE Event a
_ Event b
NoEvent = forall a. Event a
NoEvent
joinE (Event a
l) (Event b
r) = forall a. a -> Event a
Event (a
l,b
r)
splitE :: Event (a,b) -> (Event a, Event b)
splitE :: forall a b. Event (a, b) -> (Event a, Event b)
splitE Event (a, b)
NoEvent = (forall a. Event a
NoEvent, forall a. Event a
NoEvent)
splitE (Event (a
a,b
b)) = (forall a. a -> Event a
Event a
a, forall a. a -> Event a
Event b
b)
filterE :: (a -> Bool) -> Event a -> Event a
filterE :: forall a. (a -> Bool) -> Event a -> Event a
filterE a -> Bool
p e :: Event a
e@(Event a
a) = if a -> Bool
p a
a then Event a
e else forall a. Event a
NoEvent
filterE a -> Bool
_ Event a
NoEvent = forall a. Event a
NoEvent
mapFilterE :: (a -> Maybe b) -> Event a -> Event b
mapFilterE :: forall a b. (a -> Maybe b) -> Event a -> Event b
mapFilterE a -> Maybe b
_ Event a
NoEvent = forall a. Event a
NoEvent
mapFilterE a -> Maybe b
f (Event a
a) = case a -> Maybe b
f a
a of
Maybe b
Nothing -> forall a. Event a
NoEvent
Just b
b -> forall a. a -> Event a
Event b
b
gate :: Event a -> Bool -> Event a
Event a
_ gate :: forall a. Event a -> Bool -> Event a
`gate` Bool
False = forall a. Event a
NoEvent
Event a
e `gate` Bool
True = Event a
e
switch :: Monad m => SF m a (b, Event c) -> (c -> SF m a b) -> SF m a b
switch :: forall (m :: * -> *) a b c.
Monad m =>
SF m a (b, Event c) -> (c -> SF m a b) -> SF m a b
switch SF m a (b, Event c)
sf c -> SF m a b
sfC = forall (m :: * -> *) a b. (a -> m (b, MSF m a b)) -> MSF m a b
MSF forall a b. (a -> b) -> a -> b
$ \a
a -> do
((b, Event c)
o, SF m a (b, Event c)
ct) <- forall (m :: * -> *) a b. MSF m a b -> a -> m (b, MSF m a b)
unMSF SF m a (b, Event c)
sf a
a
case (b, Event c)
o of
(b
_, Event c
c) -> forall r (m :: * -> *) a.
(r -> r) -> ReaderT r m a -> ReaderT r m a
local (forall a b. a -> b -> a
const Time
0) (forall (m :: * -> *) a b. MSF m a b -> a -> m (b, MSF m a b)
unMSF (c -> SF m a b
sfC c
c) a
a)
(b
b, Event c
NoEvent) -> forall (m :: * -> *) a. Monad m => a -> m a
return (b
b, forall (m :: * -> *) a b c.
Monad m =>
SF m a (b, Event c) -> (c -> SF m a b) -> SF m a b
switch SF m a (b, Event c)
ct c -> SF m a b
sfC)
dSwitch :: Monad m => SF m a (b, Event c) -> (c -> SF m a b) -> SF m a b
dSwitch :: forall (m :: * -> *) a b c.
Monad m =>
SF m a (b, Event c) -> (c -> SF m a b) -> SF m a b
dSwitch SF m a (b, Event c)
sf c -> SF m a b
sfC = forall (m :: * -> *) a b. (a -> m (b, MSF m a b)) -> MSF m a b
MSF forall a b. (a -> b) -> a -> b
$ \a
a -> do
((b, Event c)
o, SF m a (b, Event c)
ct) <- forall (m :: * -> *) a b. MSF m a b -> a -> m (b, MSF m a b)
unMSF SF m a (b, Event c)
sf a
a
case (b, Event c)
o of
(b
b, Event c
c) -> do (b
_,SF m a b
ct') <- forall r (m :: * -> *) a.
(r -> r) -> ReaderT r m a -> ReaderT r m a
local (forall a b. a -> b -> a
const Time
0) (forall (m :: * -> *) a b. MSF m a b -> a -> m (b, MSF m a b)
unMSF (c -> SF m a b
sfC c
c) a
a)
forall (m :: * -> *) a. Monad m => a -> m a
return (b
b, SF m a b
ct')
(b
b, Event c
NoEvent) -> forall (m :: * -> *) a. Monad m => a -> m a
return (b
b, forall (m :: * -> *) a b c.
Monad m =>
SF m a (b, Event c) -> (c -> SF m a b) -> SF m a b
dSwitch SF m a (b, Event c)
ct c -> SF m a b
sfC)
#if MIN_VERSION_base(4,8,0)
parB :: (Monad m) => [SF m a b] -> SF m a [b]
#else
parB :: (Functor m, Monad m) => [SF m a b] -> SF m a [b]
#endif
parB :: forall (m :: * -> *) a b. Monad m => [SF m a b] -> SF m a [b]
parB = forall (m :: * -> *) a b.
(Functor m, Monad m) =>
MSF (ListT m) a b -> MSF m a [b]
widthFirst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a b.
Monad m =>
[MSF m a b] -> MSF (ListT m) a b
sequenceS
dpSwitchB :: (Functor m, Monad m , Traversable col)
=> col (SF m a b) -> SF m (a, col b) (Event c) -> (col (SF m a b) -> c -> SF m a (col b))
-> SF m a (col b)
dpSwitchB :: forall (m :: * -> *) (col :: * -> *) a b c.
(Functor m, Monad m, Traversable col) =>
col (SF m a b)
-> SF m (a, col b) (Event c)
-> (col (SF m a b) -> c -> SF m a (col b))
-> SF m a (col b)
dpSwitchB col (SF m a b)
sfs SF m (a, col b) (Event c)
sfF col (SF m a b) -> c -> SF m a (col b)
sfCs = forall (m :: * -> *) a b. (a -> m (b, MSF m a b)) -> MSF m a b
MSF forall a b. (a -> b) -> a -> b
$ \a
a -> do
col (b, SF m a b)
res <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
T.mapM (forall (m :: * -> *) a b. MSF m a b -> a -> m (b, MSF m a b)
`unMSF` a
a) col (SF m a b)
sfs
let bs :: col b
bs = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst col (b, SF m a b)
res
sfs' :: col (SF m a b)
sfs' = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd col (b, SF m a b)
res
(Event c
e,SF m (a, col b) (Event c)
sfF') <- forall (m :: * -> *) a b. MSF m a b -> a -> m (b, MSF m a b)
unMSF SF m (a, col b) (Event c)
sfF (a
a, col b
bs)
SF m a (col b)
ct <- case Event c
e of
Event c
c -> forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a b. MSF m a b -> a -> m (b, MSF m a b)
unMSF (col (SF m a b) -> c -> SF m a (col b)
sfCs col (SF m a b)
sfs c
c) a
a
Event c
NoEvent -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall (m :: * -> *) (col :: * -> *) a b c.
(Functor m, Monad m, Traversable col) =>
col (SF m a b)
-> SF m (a, col b) (Event c)
-> (col (SF m a b) -> c -> SF m a (col b))
-> SF m a (col b)
dpSwitchB col (SF m a b)
sfs' SF m (a, col b) (Event c)
sfF' col (SF m a b) -> c -> SF m a (col b)
sfCs)
forall (m :: * -> *) a. Monad m => a -> m a
return (col b
bs, SF m a (col b)
ct)
parC :: Monad m => SF m a b -> SF m [a] [b]
parC :: forall (m :: * -> *) a b. Monad m => SF m a b -> SF m [a] [b]
parC SF m a b
sf = forall (m :: * -> *) a b. Monad m => SF m a b -> SF m [a] [b]
parC0 SF m a b
sf
where
parC0 :: Monad m => SF m a b -> SF m [a] [b]
parC0 :: forall (m :: * -> *) a b. Monad m => SF m a b -> SF m [a] [b]
parC0 SF m a b
sf0 = forall (m :: * -> *) a b. (a -> m (b, MSF m a b)) -> MSF m a b
MSF forall a b. (a -> b) -> a -> b
$ \[a]
as -> do
[(b, SF m a b)]
os <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
T.mapM (\(a
a,SF m a b
sf) -> forall (m :: * -> *) a b. MSF m a b -> a -> m (b, MSF m a b)
unMSF SF m a b
sf a
a) forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [a]
as (forall a. Int -> a -> [a]
replicate (forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
as) SF m a b
sf0)
let bs :: [b]
bs = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst [(b, SF m a b)]
os
cts :: [SF m a b]
cts = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd [(b, SF m a b)]
os
forall (m :: * -> *) a. Monad m => a -> m a
return ([b]
bs, forall (m :: * -> *) a b. Monad m => [SF m a b] -> SF m [a] [b]
parC' [SF m a b]
cts)
parC' :: Monad m => [SF m a b] -> SF m [a] [b]
parC' :: forall (m :: * -> *) a b. Monad m => [SF m a b] -> SF m [a] [b]
parC' [SF m a b]
sfs = forall (m :: * -> *) a b. (a -> m (b, MSF m a b)) -> MSF m a b
MSF forall a b. (a -> b) -> a -> b
$ \[a]
as -> do
[(b, SF m a b)]
os <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
T.mapM (\(a
a,SF m a b
sf) -> forall (m :: * -> *) a b. MSF m a b -> a -> m (b, MSF m a b)
unMSF SF m a b
sf a
a) forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [a]
as [SF m a b]
sfs
let bs :: [b]
bs = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst [(b, SF m a b)]
os
cts :: [SF m a b]
cts = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd [(b, SF m a b)]
os
forall (m :: * -> *) a. Monad m => a -> m a
return ([b]
bs, forall (m :: * -> *) a b. Monad m => [SF m a b] -> SF m [a] [b]
parC' [SF m a b]
cts)
hold :: Monad m => a -> SF m (Event a) a
hold :: forall (m :: * -> *) a. Monad m => a -> SF m (Event a) a
hold a
a = forall (m :: * -> *) c a b.
Monad m =>
c -> MSF m (a, c) (b, c) -> MSF m a b
feedback a
a forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr forall a b. (a -> b) -> a -> b
$ \(Event a
e,a
a') ->
forall {b}. b -> (b, b)
dup (forall a b. a -> (b -> a) -> Event b -> a
event 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 = forall (m :: * -> *) a b.
Monad m =>
MSF m a b -> MSF m (Event a) (Event b)
mapEventS forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a s.
Monad m =>
(a -> s -> s) -> s -> MSF m a s
accumulateWith (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 = forall (m :: * -> *) c a b.
Monad m =>
c -> MSF m (a, c) (b, c) -> MSF m a b
feedback b
b forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr forall a b. (a -> b) -> a -> b
$ \(Event a
a, b
b') ->
let b'' :: b
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'')
loopPre :: Monad m => c -> SF m (a, c) (b, c) -> SF m a b
loopPre :: forall (m :: * -> *) c a b.
Monad m =>
c -> SF m (a, c) (b, c) -> SF m a b
loopPre = forall (m :: * -> *) c a b.
Monad m =>
c -> MSF m (a, c) (b, c) -> MSF m a b
feedback
integral :: (Monad m, Fractional s, VectorSpace a s) => SF m a a
integral :: forall (m :: * -> *) s a.
(Monad m, Fractional s, VectorSpace a s) =>
SF m a a
integral = forall (m :: * -> *) s a.
(Monad m, Fractional s, VectorSpace a s) =>
a -> SF m a a
integralFrom forall v a. VectorSpace v a => v
zeroVector
integralFrom :: (Monad m, Fractional s, VectorSpace a s) => a -> SF m a a
integralFrom :: forall (m :: * -> *) s a.
(Monad m, Fractional s, VectorSpace a s) =>
a -> SF m a a
integralFrom a
a0 = proc a
a -> do
Time
dt <- forall (m :: * -> *) b a. Monad m => m b -> MSF m a b
constM forall (m :: * -> *) r. Monad m => ReaderT r m r
ask -< ()
forall (m :: * -> *) a s.
Monad m =>
(a -> s -> s) -> s -> MSF m a s
accumulateWith forall v a. VectorSpace v a => v -> v -> v
(^+^) a
a0 -< forall a b. (Real a, Fractional b) => a -> b
realToFrac Time
dt forall v a. VectorSpace v a => a -> v -> v
*^ a
a
derivative :: (Monad m, Fractional s, VectorSpace a s) => SF m a a
derivative :: forall (m :: * -> *) s a.
(Monad m, Fractional s, VectorSpace a s) =>
SF m a a
derivative = forall (m :: * -> *) s a.
(Monad m, Fractional s, VectorSpace a s) =>
a -> SF m a a
derivativeFrom forall v a. VectorSpace v a => v
zeroVector
derivativeFrom :: (Monad m, Fractional s, VectorSpace a s) => a -> SF m a a
derivativeFrom :: forall (m :: * -> *) s a.
(Monad m, Fractional s, VectorSpace a s) =>
a -> SF m a a
derivativeFrom a
a0 = proc a
a -> do
Time
dt <- forall (m :: * -> *) b a. Monad m => m b -> MSF m a b
constM forall (m :: * -> *) r. Monad m => ReaderT r m r
ask -< ()
a
aOld <- forall (m :: * -> *) a. Monad m => a -> MSF m a a
MSF.iPre a
a0 -< a
a
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< (a
a forall v a. VectorSpace v a => v -> v -> v
^-^ a
aOld) forall v a. VectorSpace v a => v -> a -> v
^/ forall a b. (Real a, Fractional b) => a -> b
realToFrac Time
dt
iterFrom :: Monad m => (a -> a -> DTime -> b -> b) -> b -> SF m a b
iterFrom :: forall (m :: * -> *) a b.
Monad m =>
(a -> a -> Time -> b -> b) -> b -> SF m a b
iterFrom a -> a -> Time -> b -> b
f b
b = forall (m :: * -> *) a b. (a -> m (b, MSF m a b)) -> MSF m a b
MSF forall a b. (a -> b) -> a -> b
$ \a
a -> do
Time
dt <- forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
let b' :: b
b' = a -> a -> Time -> b -> b
f a
a a
a Time
dt b
b
forall (m :: * -> *) a. Monad m => a -> m a
return (b
b, forall (m :: * -> *) a b.
Monad m =>
(a -> a -> Time -> b -> b) -> b -> SF m a b
iterFrom a -> a -> Time -> b -> b
f b
b')
occasionally :: MonadRandom m
=> Time
-> b
-> SF m a (Event b)
occasionally :: forall (m :: * -> *) b a.
MonadRandom m =>
Time -> b -> SF m a (Event b)
occasionally Time
tAvg b
b
| Time
tAvg forall a. Ord a => a -> a -> Bool
<= Time
0 = forall a. HasCallStack => String -> a
error String
"bearriver: Non-positive average interval in occasionally."
| Bool
otherwise = proc a
_ -> do
Time
r <- forall (m :: * -> *) b a.
(MonadRandom m, Random b) =>
(b, b) -> MSF m a b
getRandomRS (Time
0, Time
1) -< ()
Time
dt <- forall (m :: * -> *) a. Monad m => SF m a Time
timeDelta -< ()
let p :: Time
p = Time
1 forall a. Num a => a -> a -> a
- forall a. Floating a => a -> a
exp (-(Time
dt forall a. Fractional a => a -> a -> a
/ Time
tAvg))
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< if Time
r forall a. Ord a => a -> a -> Bool
< Time
p then forall a. a -> Event a
Event b
b else forall a. Event a
NoEvent
where
timeDelta :: Monad m => SF m a DTime
timeDelta :: forall (m :: * -> *) a. Monad m => SF m a Time
timeDelta = forall (m :: * -> *) b a. Monad m => m b -> MSF m a b
constM forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
reactimate :: Monad m => m a -> (Bool -> m (DTime, Maybe a)) -> (Bool -> b -> m Bool) -> SF Identity a b -> m ()
reactimate :: forall (m :: * -> *) a b.
Monad m =>
m a
-> (Bool -> m (Time, Maybe a))
-> (Bool -> b -> m Bool)
-> SF Identity a b
-> m ()
reactimate m a
senseI Bool -> m (Time, Maybe a)
sense Bool -> b -> m Bool
actuate SF Identity a b
sf = do
forall (m :: * -> *). Monad m => MSF m () Bool -> m ()
MSF.reactimateB forall a b. (a -> b) -> a -> b
$ forall {a}. MSF m a (Time, a)
senseSF forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> MSF m (Time, a) b
sfIO forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> MSF m b Bool
actuateSF
forall (m :: * -> *) a. Monad m => a -> m a
return ()
where sfIO :: MSF m (Time, a) b
sfIO = forall (m2 :: * -> *) (m1 :: * -> *) a b.
(Monad m2, Monad m1) =>
(forall c. m1 c -> m2 c) -> MSF m1 a b -> MSF m2 a b
morphS (forall (m :: * -> *) a. Monad m => a -> m a
returnforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a. Identity a -> a
runIdentity) (forall (m :: * -> *) r a b.
Monad m =>
MSF (ReaderT r m) a b -> MSF m (r, a) b
runReaderS SF Identity a b
sf)
senseSF :: MSF m a (Time, a)
senseSF = forall (m :: * -> *) a b c.
Monad m =>
MSF m a (b, Maybe c) -> (c -> MSF m a b) -> MSF m a b
MSF.dSwitch forall {a}. MSF m a ((Time, a), Maybe a)
senseFirst forall {a}. a -> MSF m a (Time, a)
senseRest
senseFirst :: MSF m a ((Time, a), Maybe a)
senseFirst = forall (m :: * -> *) b a. Monad m => m b -> MSF m a b
constM m a
senseI forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (\a
x -> ((Time
0, a
x), forall a. a -> Maybe a
Just a
x))
senseRest :: a -> MSF m a (Time, a)
senseRest a
a = forall (m :: * -> *) b a. Monad m => m b -> MSF m a b
constM (Bool -> m (Time, Maybe a)
sense Bool
True) forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr forall a. a -> a
id forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** forall (m :: * -> *) a. Monad m => a -> MSF m (Maybe a) a
keepLast a
a)
keepLast :: Monad m => a -> MSF m (Maybe a) a
keepLast :: forall (m :: * -> *) a. Monad m => a -> MSF m (Maybe a) a
keepLast a
a = forall (m :: * -> *) a b. (a -> m (b, MSF m a b)) -> MSF m a b
MSF forall a b. (a -> b) -> a -> b
$ \Maybe a
ma -> let a' :: a
a' = forall a. a -> Maybe a -> a
fromMaybe a
a Maybe a
ma in a
a' seq :: forall a b. a -> b -> b
`seq` forall (m :: * -> *) a. Monad m => a -> m a
return (a
a', forall (m :: * -> *) a. Monad m => a -> MSF m (Maybe a) a
keepLast a
a')
actuateSF :: MSF m b Bool
actuateSF = forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (\b
x -> (Bool
True, b
x)) forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (m :: * -> *) a b. Monad m => (a -> m b) -> MSF m a b
arrM (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Bool -> b -> m Bool
actuate)
evalAtZero :: SF Identity a b -> a -> (b, SF Identity a b)
evalAtZero :: forall a b. SF Identity a b -> a -> (b, SF Identity a b)
evalAtZero SF Identity a b
sf a
a = forall a. Identity a -> a
runIdentity forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (forall (m :: * -> *) a b. MSF m a b -> a -> m (b, MSF m a b)
unMSF SF Identity a b
sf a
a) Time
0
evalAt :: SF Identity a b -> DTime -> a -> (b, SF Identity a b)
evalAt :: forall a b. SF Identity a b -> Time -> a -> (b, SF Identity a b)
evalAt SF Identity a b
sf Time
dt a
a = forall a. Identity a -> a
runIdentity forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (forall (m :: * -> *) a b. MSF m a b -> a -> m (b, MSF m a b)
unMSF SF Identity a b
sf a
a) Time
dt
evalFuture :: SF Identity a b -> a -> DTime -> (b, SF Identity a b)
evalFuture :: forall a b. SF Identity a b -> a -> Time -> (b, SF Identity a b)
evalFuture SF Identity a b
sf = forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall a b. SF Identity a b -> Time -> a -> (b, SF Identity a b)
evalAt SF Identity a b
sf)
replaceOnce :: Monad m => a -> SF m a a
replaceOnce :: forall (m :: * -> *) a. Monad m => a -> SF m a a
replaceOnce a
a = forall (m :: * -> *) a b c.
Monad m =>
SF m a (b, Event c) -> (c -> SF m a b) -> SF m a b
dSwitch (forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const (a
a, forall a. a -> Event a
Event ())) (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr forall a. a -> a
id)
dup :: b -> (b, b)
dup b
x = (b
x,b
x)