module Dyna(
(|>),
Frp(..),
Evt(..),
once,
never,
Dyn(..),
constDyn,
runDyn,
DynRef(..),
readDyn,
cancelDyn,
newEvt,
newDyn,
withDyn,
scan,
scanMay,
mapMay,
accum,
accumB,
accumMay,
filters,
filterJust,
whens,
splits,
lefts,
rights,
iterates,
withIterates,
fix1,
fix2,
fix3,
fix4,
switch,
joins,
delay,
delayFork,
sums,
sumD,
integrate,
integrate2,
products,
count,
withCount,
appends,
foldMaps,
takes,
drops,
takesWhile,
dropsWhile,
cycles,
listAt,
toToggle,
forevers,
races,
forks,
heads,
prints,
putStrLns,
folds,
foldls,
foldls',
foldrs,
foldrs',
Parser,
runParser,
takeP,
cycleP,
headP,
maybeP,
hold,
unhold,
scanD,
scanMayD,
switchD,
switchDyn,
apply,
applyMay,
snap,
attach,
attachWith,
attachWithMay,
(<@>),
(<@),
FunctorM(..),
foreach,
posteach,
iterates',
scan',
scanMay',
accum',
accumMay',
filters',
mapMay',
apply',
applyMay',
mchanEvt,
tchanEvt,
uchanEvt,
UChan,
newTriggerEvt,
getLines,
clock,
pulse,
ticks,
timer,
timerD,
toRandom,
toRandomR,
withRandom,
withRandomR,
oneOf,
withOneOf,
freqOf,
withFreqOf,
randSkip,
randSkipBy,
liftA2,
liftA3,
BasisArity(..),
module X,
) where
import Prelude hiding ((<*))
import Data.IORef
import Control.Applicative (liftA2, liftA3)
import Control.Monad
import Control.Monad.IO.Class
import System.Environment
import Data.Functor
import Data.Bifunctor
import Data.Function
import Data.Maybe (fromJust)
import Data.Vector qualified as V
import Data.AdditiveGroup as X
import Data.AffineSpace as X
import Data.Basis
import Data.Cross as X
import Data.VectorSpace as X
import Data.String
import Control.Concurrent.Lifted
import Control.Concurrent.Thread.Delay qualified as D
import Control.Concurrent.Async.Lifted
import Control.Concurrent.STM
import Control.Concurrent.STM.TVar
import Control.Concurrent.STM.TChan
import Control.Concurrent.Chan.Unagi (InChan)
import Control.Concurrent.Chan.Unagi qualified as U
import Control.Concurrent.Chan qualified as M
import Control.Monad.Trans.Control
import Dyna.Ref
import Data.Time
import System.Random (Random, newStdGen, randomR, random)
import Control.Exception.Lifted
import Control.Monad.Random.Class qualified as R
import Temporal.Class as X
import Data.Boolean
infixl 4 <@>
infixl 4 <@
infixl 0 |>
{-# inline (|>) #-}
(|>) :: a -> (a -> b) -> b
a
a |> :: a -> (a -> b) -> b
|> a -> b
f = a -> b
f a
a
class (IsRef (Ref m), MonadBaseControl IO m, MonadIO m) => Frp m where
type Ref m :: * -> *
instance Frp IO where
type Ref IO = TVar
data Dyn m a
= forall s . Dyn
{ ()
dyn'get :: s -> m a
, ()
dyn'evt :: Evt m s
, ()
dyn'init :: m s
, Dyn m a -> m ()
dyn'release :: m ()
}
| ConstDyn a
data DynRef m a
= forall s . DynRef (s -> m a) (Ref m s) ThreadId (m ())
| ConstRef a
withDyn :: Frp m => Dyn m a -> (m a -> m b) -> m b
withDyn :: Dyn m a -> (m a -> m b) -> m b
withDyn Dyn m a
dyn m a -> m b
f = m (DynRef m a)
-> (DynRef m a -> m ()) -> (DynRef m a -> m b) -> m b
forall (m :: * -> *) a b c.
MonadBaseControl IO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket (Dyn m a -> m (DynRef m a)
forall (m :: * -> *) a. Frp m => Dyn m a -> m (DynRef m a)
runDyn Dyn m a
dyn) DynRef m a -> m ()
forall (m :: * -> *) a. Frp m => DynRef m a -> m ()
cancelDyn (\DynRef m a
ref -> m a -> m b
f (DynRef m a -> m a
forall (m :: * -> *) a. Frp m => DynRef m a -> m a
readDyn DynRef m a
ref))
constDyn :: Frp m => m a -> Dyn m a
constDyn :: m a -> Dyn m a
constDyn m a
act = (() -> m a) -> Evt m () -> m () -> m () -> Dyn m a
forall (m :: * -> *) a s.
(s -> m a) -> Evt m s -> m s -> m () -> Dyn m a
Dyn (m a -> () -> m a
forall a b. a -> b -> a
const m a
act) Evt m ()
forall (m :: * -> *) a. Frp m => Evt m a
never (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
instance Functor m => Functor (Dyn m) where
fmap :: (a -> b) -> Dyn m a -> Dyn m b
fmap a -> b
f (ConstDyn a
a) = b -> Dyn m b
forall (m :: * -> *) a. a -> Dyn m a
ConstDyn (a -> b
f a
a)
fmap a -> b
f (Dyn s -> m a
extract Evt m s
evt m s
s m ()
release) = (s -> m b) -> Evt m s -> m s -> m () -> Dyn m b
forall (m :: * -> *) a s.
(s -> m a) -> Evt m s -> m s -> m () -> Dyn m a
Dyn ((a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (m a -> m b) -> (s -> m a) -> s -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> m a
extract) Evt m s
evt m s
s m ()
release
instance Frp m => Applicative (Dyn m) where
pure :: a -> Dyn m a
pure a
a = a -> Dyn m a
forall (m :: * -> *) a. a -> Dyn m a
ConstDyn a
a
(ConstDyn a -> b
f) <*> :: Dyn m (a -> b) -> Dyn m a -> Dyn m b
<*> (ConstDyn a
a) = b -> Dyn m b
forall (m :: * -> *) a. a -> Dyn m a
ConstDyn (a -> b
f a
a)
(ConstDyn a -> b
f) <*> (Dyn s -> m a
aget Evt m s
aevt m s
as m ()
release) = (s -> m b) -> Evt m s -> m s -> m () -> Dyn m b
forall (m :: * -> *) a s.
(s -> m a) -> Evt m s -> m s -> m () -> Dyn m a
Dyn (\s
s -> a -> b
f (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m a
aget s
s) Evt m s
aevt m s
as m ()
release
(Dyn s -> m (a -> b)
fget Evt m s
fevt m s
fs m ()
release) <*> (ConstDyn a
a) = (s -> m b) -> Evt m s -> m s -> m () -> Dyn m b
forall (m :: * -> *) a s.
(s -> m a) -> Evt m s -> m s -> m () -> Dyn m a
Dyn (\s
s -> ((a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ a
a) ((a -> b) -> b) -> m (a -> b) -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m (a -> b)
fget s
s) Evt m s
fevt m s
fs m ()
release
(Dyn s -> m (a -> b)
fget Evt m s
fevt m s
fs m ()
releaseF) <*> (Dyn s -> m a
aget Evt m s
aevt m s
as m ()
releaseA) =
((s, s) -> m b) -> Evt m (s, s) -> m (s, s) -> m () -> Dyn m b
forall (m :: * -> *) a s.
(s -> m a) -> Evt m s -> m s -> m () -> Dyn m a
Dyn (\(s
f, s
a) -> (s -> m (a -> b)
fget s
f) m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (s -> m a
aget s
a)) Evt m (s, s)
evt ((s -> s -> (s, s)) -> m s -> m s -> m (s, s)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) m s
fs m s
as) (m ()
releaseF m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m ()
releaseA)
where
evt :: Evt m (s, s)
evt = (((s, s) -> m ()) -> m ()) -> Evt m (s, s)
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt ((((s, s) -> m ()) -> m ()) -> Evt m (s, s))
-> (((s, s) -> m ()) -> m ()) -> Evt m (s, s)
forall a b. (a -> b) -> a -> b
$ \(s, s) -> m ()
go -> do
Ref m (s, s)
tv <- Evt m (s, s) -> (s, s) -> m (Ref m (s, s))
forall (m :: * -> *) a b. Frp m => Evt m a -> b -> m (Ref m b)
proxyNewRef Evt m (s, s)
evt ((s, s) -> m (Ref m (s, s))) -> m (s, s) -> m (Ref m (s, s))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (s -> s -> (s, s)) -> m s -> m s -> m (s, s)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) m s
fs m s
as
m ThreadId -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m ThreadId -> m ()) -> m ThreadId -> m ()
forall a b. (a -> b) -> a -> b
$ m () -> m ThreadId
forall (m :: * -> *). MonadBaseControl IO m => m () -> m ThreadId
fork (m () -> m ThreadId) -> m () -> m ThreadId
forall a b. (a -> b) -> a -> b
$ Evt m (Either s s) -> (Either s s -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m (Either s s)
joint ((Either s s -> m ()) -> m ()) -> (Either s s -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \case
Left s
s -> do
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m (s, s) -> ((s, s) -> (s, s)) -> IO ()
forall (ref :: * -> *) a. IsRef ref => ref a -> (a -> a) -> IO ()
modifyRef Ref m (s, s)
tv ((s -> s) -> (s, s) -> (s, s)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((s -> s) -> (s, s) -> (s, s)) -> (s -> s) -> (s, s) -> (s, s)
forall a b. (a -> b) -> a -> b
$ s -> s -> s
forall a b. a -> b -> a
const s
s)
(s, s) -> m ()
go ((s, s) -> m ()) -> m (s, s) -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (s, s) -> m (s, s)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Ref m (s, s) -> IO (s, s)
forall (ref :: * -> *) a. IsRef ref => ref a -> IO a
readRef Ref m (s, s)
tv)
Right s
s -> do
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m (s, s) -> ((s, s) -> (s, s)) -> IO ()
forall (ref :: * -> *) a. IsRef ref => ref a -> (a -> a) -> IO ()
modifyRef Ref m (s, s)
tv ((s -> s) -> (s, s) -> (s, s)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ((s -> s) -> (s, s) -> (s, s)) -> (s -> s) -> (s, s) -> (s, s)
forall a b. (a -> b) -> a -> b
$ s -> s -> s
forall a b. a -> b -> a
const s
s)
(s, s) -> m ()
go ((s, s) -> m ()) -> m (s, s) -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (s, s) -> m (s, s)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Ref m (s, s) -> IO (s, s)
forall (ref :: * -> *) a. IsRef ref => ref a -> IO a
readRef Ref m (s, s)
tv)
joint :: Evt m (Either s s)
joint = (s -> Either s s) -> Evt m s -> Evt m (Either s s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap s -> Either s s
forall a b. a -> Either a b
Left Evt m s
fevt Evt m (Either s s) -> Evt m (Either s s) -> Evt m (Either s s)
forall a. Semigroup a => a -> a -> a
<> (s -> Either s s) -> Evt m s -> Evt m (Either s s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap s -> Either s s
forall a b. b -> Either a b
Right Evt m s
aevt
newtype Evt m a = Evt { Evt m a -> (a -> m ()) -> m ()
runEvt :: (a -> m ()) -> m () }
once :: Frp m => m a -> Evt m a
once :: m a -> Evt m a
once m a
ask = ((a -> m ()) -> m ()) -> Evt m a
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((a -> m ()) -> m ()) -> Evt m a)
-> ((a -> m ()) -> m ()) -> Evt m a
forall a b. (a -> b) -> a -> b
$ \a -> m ()
go -> a -> m ()
go (a -> m ()) -> m a -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m a
ask
never :: Frp m => Evt m a
never :: Evt m a
never = ((a -> m ()) -> m ()) -> Evt m a
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (m () -> (a -> m ()) -> m ()
forall a b. a -> b -> a
const (m () -> (a -> m ()) -> m ()) -> m () -> (a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
newEvt :: Frp m => Evt m a -> m (Evt m a)
newEvt :: Evt m a -> m (Evt m a)
newEvt Evt m a
evt = do
(InChan a, OutChan a)
ch <- IO (InChan a, OutChan a) -> m (InChan a, OutChan a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (InChan a, OutChan a) -> m (InChan a, OutChan a))
-> IO (InChan a, OutChan a) -> m (InChan a, OutChan a)
forall a b. (a -> b) -> a -> b
$ IO (InChan a, OutChan a)
forall a. IO (InChan a, OutChan a)
U.newChan
ThreadId
tid <- m () -> m ThreadId
forall (m :: * -> *). MonadBaseControl IO m => m () -> m ThreadId
fork (m () -> m ThreadId) -> m () -> m ThreadId
forall a b. (a -> b) -> a -> b
$ Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt ((a -> m ()) -> m ()) -> (a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (a -> IO ()) -> a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InChan a -> a -> IO ()
forall a. InChan a -> a -> IO ()
U.writeChan ((InChan a, OutChan a) -> InChan a
forall a b. (a, b) -> a
fst (InChan a, OutChan a)
ch)
Evt m a -> m (Evt m a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Evt m a -> m (Evt m a)) -> Evt m a -> m (Evt m a)
forall a b. (a -> b) -> a -> b
$ ThreadId -> m (InChan a) -> Evt m a
forall (m :: * -> *) a.
Frp m =>
ThreadId -> m (InChan a) -> Evt m a
uchanEvtFinally ThreadId
tid (InChan a -> m (InChan a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InChan a -> m (InChan a)) -> InChan a -> m (InChan a)
forall a b. (a -> b) -> a -> b
$ (InChan a, OutChan a) -> InChan a
forall a b. (a, b) -> a
fst (InChan a, OutChan a)
ch)
uchanEvtFinally :: (Frp m) => ThreadId -> m (InChan a) -> Evt m a
uchanEvtFinally :: ThreadId -> m (InChan a) -> Evt m a
uchanEvtFinally ThreadId
tid m (InChan a)
mchan = ((a -> m ()) -> m ()) -> Evt m a
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((a -> m ()) -> m ()) -> Evt m a)
-> ((a -> m ()) -> m ()) -> Evt m a
forall a b. (a -> b) -> a -> b
$ \a -> m ()
go -> do
OutChan a
chan <- IO (OutChan a) -> m (OutChan a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (OutChan a) -> m (OutChan a))
-> (InChan a -> IO (OutChan a)) -> InChan a -> m (OutChan a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InChan a -> IO (OutChan a)
forall a. InChan a -> IO (OutChan a)
U.dupChan (InChan a -> m (OutChan a)) -> m (InChan a) -> m (OutChan a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m (InChan a)
mchan
OutChan a -> (a -> m ()) -> m ()
forall (m :: * -> *) t a b.
MonadIO m =>
OutChan t -> (t -> m a) -> m b
loop OutChan a
chan a -> m ()
go m () -> m () -> m ()
forall (m :: * -> *) a b.
MonadBaseControl IO m =>
m a -> m b -> m a
`finally` (ThreadId -> m ()
forall (m :: * -> *). MonadBase IO m => ThreadId -> m ()
killThread ThreadId
tid)
where
loop :: OutChan t -> (t -> m a) -> m b
loop OutChan t
chan t -> m a
go = do
t
a <- IO t -> m t
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO t -> m t) -> IO t -> m t
forall a b. (a -> b) -> a -> b
$ OutChan t -> IO t
forall a. OutChan a -> IO a
U.readChan OutChan t
chan
t -> m a
go t
a
OutChan t -> (t -> m a) -> m b
loop OutChan t
chan t -> m a
go
newDyn :: Frp m => Dyn m a -> m (Dyn m a)
newDyn :: Dyn m a -> m (Dyn m a)
newDyn Dyn m a
dyn = do
DynRef m a
ref <- Dyn m a -> m (DynRef m a)
forall (m :: * -> *) a. Frp m => Dyn m a -> m (DynRef m a)
runDyn Dyn m a
dyn
Dyn m a -> m (Dyn m a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Dyn m a -> m (Dyn m a)) -> Dyn m a -> m (Dyn m a)
forall a b. (a -> b) -> a -> b
$ (DynRef m a -> m a)
-> Evt m (DynRef m a) -> m (DynRef m a) -> m () -> Dyn m a
forall (m :: * -> *) a s.
(s -> m a) -> Evt m s -> m s -> m () -> Dyn m a
Dyn DynRef m a -> m a
forall (m :: * -> *) a. Frp m => DynRef m a -> m a
readDyn Evt m (DynRef m a)
forall (m :: * -> *) a. Frp m => Evt m a
never (DynRef m a -> m (DynRef m a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure DynRef m a
ref) (DynRef m a -> m ()
forall (m :: * -> *) a. Frp m => DynRef m a -> m ()
cancelDyn DynRef m a
ref)
instance Functor (Evt m) where
fmap :: (a -> b) -> Evt m a -> Evt m b
fmap a -> b
f (Evt (a -> m ()) -> m ()
evt) = ((b -> m ()) -> m ()) -> Evt m b
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((b -> m ()) -> m ()) -> Evt m b)
-> ((b -> m ()) -> m ()) -> Evt m b
forall a b. (a -> b) -> a -> b
$ \b -> m ()
proc -> (a -> m ()) -> m ()
evt (b -> m ()
proc (b -> m ()) -> (a -> b) -> a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
instance Frp m => Semigroup (Evt m a) where
<> :: Evt m a -> Evt m a -> Evt m a
(<>) (Evt (a -> m ()) -> m ()
a) (Evt (a -> m ()) -> m ()
b) = ((a -> m ()) -> m ()) -> Evt m a
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((a -> m ()) -> m ()) -> Evt m a)
-> ((a -> m ()) -> m ()) -> Evt m a
forall a b. (a -> b) -> a -> b
$ \a -> m ()
proc ->
m () -> m () -> m ()
forall (m :: * -> *) a b.
MonadBaseControl IO m =>
m a -> m b -> m ()
concurrently_ ((a -> m ()) -> m ()
a a -> m ()
proc) ((a -> m ()) -> m ()
b a -> m ()
proc)
races :: Frp m => Evt m a -> Evt m a -> Evt m a
races :: Evt m a -> Evt m a -> Evt m a
races (Evt (a -> m ()) -> m ()
a) (Evt (a -> m ()) -> m ()
b) = ((a -> m ()) -> m ()) -> Evt m a
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((a -> m ()) -> m ()) -> Evt m a)
-> ((a -> m ()) -> m ()) -> Evt m a
forall a b. (a -> b) -> a -> b
$ \a -> m ()
go ->
m () -> m () -> m ()
forall (m :: * -> *) a b.
MonadBaseControl IO m =>
m a -> m b -> m ()
race_ ((a -> m ()) -> m ()
a a -> m ()
go) ((a -> m ()) -> m ()
b a -> m ()
go)
forks :: Frp m => Evt m a -> Evt m a
forks :: Evt m a -> Evt m a
forks Evt m a
evt =
((a -> m ()) -> m ()) -> Evt m a
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((a -> m ()) -> m ()) -> Evt m a)
-> ((a -> m ()) -> m ()) -> Evt m a
forall a b. (a -> b) -> a -> b
$ \a -> m ()
go -> Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt ((a -> m ()) -> m ()) -> (a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ m ThreadId -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m ThreadId -> m ()) -> (a -> m ThreadId) -> a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m () -> m ThreadId
forall (m :: * -> *). MonadBaseControl IO m => m () -> m ThreadId
fork (m () -> m ThreadId) -> (a -> m ()) -> a -> m ThreadId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m ()
go
instance Frp m => Monoid (Evt m a) where
mempty :: Evt m a
mempty = Evt m a
forall (m :: * -> *) a. Frp m => Evt m a
never
instance Frp m => Applicative (Evt m) where
pure :: a -> Evt m a
pure a
a = m a -> Evt m a
forall (m :: * -> *) a. Frp m => m a -> Evt m a
once (a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a)
Evt m (a -> b)
f <*> :: Evt m (a -> b) -> Evt m a -> Evt m b
<*> Evt m a
a = Evt m a
a Evt m a -> (a -> Evt m b) -> Evt m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\a
x -> ((a -> b) -> b) -> Evt m (a -> b) -> Evt m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ( (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ a
x) Evt m (a -> b)
f)
instance Frp m => Monad (Evt m) where
>>= :: Evt m a -> (a -> Evt m b) -> Evt m b
(>>=) Evt m a
a a -> Evt m b
f = Evt m (Evt m b) -> Evt m b
forall (m :: * -> *) a. Frp m => Evt m (Evt m a) -> Evt m a
switch ((a -> Evt m b) -> Evt m a -> Evt m (Evt m b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Evt m b
f Evt m a
a)
accum :: Frp m => (a -> s -> (b, s)) -> s -> Evt m a -> Evt m b
accum :: (a -> s -> (b, s)) -> s -> Evt m a -> Evt m b
accum a -> s -> (b, s)
f s
s Evt m a
evt = ((b -> m ()) -> m ()) -> Evt m b
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((b -> m ()) -> m ()) -> Evt m b)
-> ((b -> m ()) -> m ()) -> Evt m b
forall a b. (a -> b) -> a -> b
$ \b -> m ()
go -> do
Ref m s
ref <- Evt m a -> s -> m (Ref m s)
forall (m :: * -> *) a b. Frp m => Evt m a -> b -> m (Ref m b)
proxyNewRef Evt m a
evt s
s
Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt ((a -> m ()) -> m ()) -> (a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \a
x -> do
(b
b, s
s) <- a -> s -> (b, s)
f a
x (s -> (b, s)) -> m s -> m (b, s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO s -> m s
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Ref m s -> IO s
forall (ref :: * -> *) a. IsRef ref => ref a -> IO a
readRef Ref m s
ref)
b -> m ()
go b
b
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m s -> s -> IO ()
forall (ref :: * -> *) a. IsRef ref => ref a -> a -> IO ()
writeRef Ref m s
ref s
s
accum' :: Frp m => (a -> s -> m (b, s)) -> s -> Evt m a -> Evt m b
accum' :: (a -> s -> m (b, s)) -> s -> Evt m a -> Evt m b
accum' a -> s -> m (b, s)
f s
s Evt m a
evt = ((b -> m ()) -> m ()) -> Evt m b
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((b -> m ()) -> m ()) -> Evt m b)
-> ((b -> m ()) -> m ()) -> Evt m b
forall a b. (a -> b) -> a -> b
$ \b -> m ()
go -> do
Ref m s
ref <- Evt m a -> s -> m (Ref m s)
forall (m :: * -> *) a b. Frp m => Evt m a -> b -> m (Ref m b)
proxyNewRef Evt m a
evt s
s
Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt ((a -> m ()) -> m ()) -> (a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \a
x -> do
(b
b, s
s) <- a -> s -> m (b, s)
f a
x (s -> m (b, s)) -> m s -> m (b, s)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO s -> m s
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Ref m s -> IO s
forall (ref :: * -> *) a. IsRef ref => ref a -> IO a
readRef Ref m s
ref)
b -> m ()
go b
b
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m s -> s -> IO ()
forall (ref :: * -> *) a. IsRef ref => ref a -> a -> IO ()
writeRef Ref m s
ref s
s
accumMay :: Frp m => (a -> s -> Maybe (b, s)) -> s -> Evt m a -> Evt m b
accumMay :: (a -> s -> Maybe (b, s)) -> s -> Evt m a -> Evt m b
accumMay a -> s -> Maybe (b, s)
f s
s Evt m a
evt = ((b -> m ()) -> m ()) -> Evt m b
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((b -> m ()) -> m ()) -> Evt m b)
-> ((b -> m ()) -> m ()) -> Evt m b
forall a b. (a -> b) -> a -> b
$ \b -> m ()
go -> do
Ref m s
ref <- Evt m a -> s -> m (Ref m s)
forall (m :: * -> *) a b. Frp m => Evt m a -> b -> m (Ref m b)
proxyNewRef Evt m a
evt s
s
Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt ((a -> m ()) -> m ()) -> (a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \a
x -> do
Maybe (b, s)
mRes <- a -> s -> Maybe (b, s)
f a
x (s -> Maybe (b, s)) -> m s -> m (Maybe (b, s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO s -> m s
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Ref m s -> IO s
forall (ref :: * -> *) a. IsRef ref => ref a -> IO a
readRef Ref m s
ref)
Maybe (b, s) -> ((b, s) -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (b, s)
mRes (((b, s) -> m ()) -> m ()) -> ((b, s) -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \(b
b, s
s) -> do
b -> m ()
go b
b
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m s -> s -> IO ()
forall (ref :: * -> *) a. IsRef ref => ref a -> a -> IO ()
writeRef Ref m s
ref s
s
accumMay' :: Frp m => (a -> s -> m (Maybe (b, s))) -> s -> Evt m a -> Evt m b
accumMay' :: (a -> s -> m (Maybe (b, s))) -> s -> Evt m a -> Evt m b
accumMay' a -> s -> m (Maybe (b, s))
f s
s Evt m a
evt = ((b -> m ()) -> m ()) -> Evt m b
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((b -> m ()) -> m ()) -> Evt m b)
-> ((b -> m ()) -> m ()) -> Evt m b
forall a b. (a -> b) -> a -> b
$ \b -> m ()
go -> do
Ref m s
ref <- Evt m a -> s -> m (Ref m s)
forall (m :: * -> *) a b. Frp m => Evt m a -> b -> m (Ref m b)
proxyNewRef Evt m a
evt s
s
Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt ((a -> m ()) -> m ()) -> (a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \a
x -> do
Maybe (b, s)
mRes <- a -> s -> m (Maybe (b, s))
f a
x (s -> m (Maybe (b, s))) -> m s -> m (Maybe (b, s))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO s -> m s
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Ref m s -> IO s
forall (ref :: * -> *) a. IsRef ref => ref a -> IO a
readRef Ref m s
ref)
Maybe (b, s) -> ((b, s) -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (b, s)
mRes (((b, s) -> m ()) -> m ()) -> ((b, s) -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \(b
b, s
s) -> do
b -> m ()
go b
b
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m s -> s -> IO ()
forall (ref :: * -> *) a. IsRef ref => ref a -> a -> IO ()
writeRef Ref m s
ref s
s
scan :: Frp m => (a -> b -> b) -> b -> Evt m a -> Evt m b
scan :: (a -> b -> b) -> b -> Evt m a -> Evt m b
scan a -> b -> b
f b
s Evt m a
evt = ((b -> m ()) -> m ()) -> Evt m b
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((b -> m ()) -> m ()) -> Evt m b)
-> ((b -> m ()) -> m ()) -> Evt m b
forall a b. (a -> b) -> a -> b
$ \b -> m ()
go -> do
Ref m b
ref <- Evt m a -> b -> m (Ref m b)
forall (m :: * -> *) a b. Frp m => Evt m a -> b -> m (Ref m b)
proxyNewRef Evt m a
evt b
s
Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt ((a -> m ()) -> m ()) -> (a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \a
x -> do
b
s <- a -> b -> b
f a
x (b -> b) -> m b -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO b -> m b
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Ref m b -> IO b
forall (ref :: * -> *) a. IsRef ref => ref a -> IO a
readRef Ref m b
ref)
b -> m ()
go b
s
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m b -> b -> IO ()
forall (ref :: * -> *) a. IsRef ref => ref a -> a -> IO ()
writeRef Ref m b
ref b
s
scan' :: Frp m => (a -> b -> m b) -> b -> Evt m a -> Evt m b
scan' :: (a -> b -> m b) -> b -> Evt m a -> Evt m b
scan' a -> b -> m b
f b
s Evt m a
evt = ((b -> m ()) -> m ()) -> Evt m b
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((b -> m ()) -> m ()) -> Evt m b)
-> ((b -> m ()) -> m ()) -> Evt m b
forall a b. (a -> b) -> a -> b
$ \b -> m ()
go -> do
Ref m b
ref <- Evt m a -> b -> m (Ref m b)
forall (m :: * -> *) a b. Frp m => Evt m a -> b -> m (Ref m b)
proxyNewRef Evt m a
evt b
s
Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt ((a -> m ()) -> m ()) -> (a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \a
x -> do
b
s <- a -> b -> m b
f a
x (b -> m b) -> m b -> m b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO b -> m b
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Ref m b -> IO b
forall (ref :: * -> *) a. IsRef ref => ref a -> IO a
readRef Ref m b
ref)
b -> m ()
go b
s
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m b -> b -> IO ()
forall (ref :: * -> *) a. IsRef ref => ref a -> a -> IO ()
writeRef Ref m b
ref b
s
scanMay :: Frp m => (a -> b -> Maybe b) -> b -> Evt m a -> Evt m b
scanMay :: (a -> b -> Maybe b) -> b -> Evt m a -> Evt m b
scanMay a -> b -> Maybe b
f b
s Evt m a
evt = ((b -> m ()) -> m ()) -> Evt m b
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((b -> m ()) -> m ()) -> Evt m b)
-> ((b -> m ()) -> m ()) -> Evt m b
forall a b. (a -> b) -> a -> b
$ \b -> m ()
go -> do
Ref m b
ref <- Evt m a -> b -> m (Ref m b)
forall (m :: * -> *) a b. Frp m => Evt m a -> b -> m (Ref m b)
proxyNewRef Evt m a
evt b
s
Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt ((a -> m ()) -> m ()) -> (a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \a
x -> do
Maybe b
ms <- a -> b -> Maybe b
f a
x (b -> Maybe b) -> m b -> m (Maybe b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO b -> m b
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Ref m b -> IO b
forall (ref :: * -> *) a. IsRef ref => ref a -> IO a
readRef Ref m b
ref)
Maybe b -> (b -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe b
ms ((b -> m ()) -> m ()) -> (b -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \b
s -> do
b -> m ()
go b
s
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m b -> b -> IO ()
forall (ref :: * -> *) a. IsRef ref => ref a -> a -> IO ()
writeRef Ref m b
ref b
s
scanMay' :: Frp m => (a -> b -> m (Maybe b)) -> b -> Evt m a -> Evt m b
scanMay' :: (a -> b -> m (Maybe b)) -> b -> Evt m a -> Evt m b
scanMay' a -> b -> m (Maybe b)
f b
s Evt m a
evt = ((b -> m ()) -> m ()) -> Evt m b
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((b -> m ()) -> m ()) -> Evt m b)
-> ((b -> m ()) -> m ()) -> Evt m b
forall a b. (a -> b) -> a -> b
$ \b -> m ()
go -> do
Ref m b
ref <- Evt m a -> b -> m (Ref m b)
forall (m :: * -> *) a b. Frp m => Evt m a -> b -> m (Ref m b)
proxyNewRef Evt m a
evt b
s
Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt ((a -> m ()) -> m ()) -> (a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \a
x -> do
Maybe b
ms <- a -> b -> m (Maybe b)
f a
x (b -> m (Maybe b)) -> m b -> m (Maybe b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO b -> m b
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Ref m b -> IO b
forall (ref :: * -> *) a. IsRef ref => ref a -> IO a
readRef Ref m b
ref)
Maybe b -> (b -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe b
ms ((b -> m ()) -> m ()) -> (b -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \b
s -> do
b -> m ()
go b
s
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m b -> b -> IO ()
forall (ref :: * -> *) a. IsRef ref => ref a -> a -> IO ()
writeRef Ref m b
ref b
s
iterates :: Frp m => (a -> a) -> a -> Evt m b -> Evt m a
iterates :: (a -> a) -> a -> Evt m b -> Evt m a
iterates a -> a
f a
val Evt m b
evt = ((a -> m ()) -> m ()) -> Evt m a
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((a -> m ()) -> m ()) -> Evt m a)
-> ((a -> m ()) -> m ()) -> Evt m a
forall a b. (a -> b) -> a -> b
$ \a -> m ()
go -> do
Ref m a
ref <- Evt m b -> a -> m (Ref m a)
forall (m :: * -> *) a b. Frp m => Evt m a -> b -> m (Ref m b)
proxyNewRef Evt m b
evt a
val
Evt m b -> (b -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m b
evt ((b -> m ()) -> m ()) -> (b -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \b
_ -> do
a
s <- IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Ref m a -> IO a
forall (ref :: * -> *) a. IsRef ref => ref a -> IO a
readRef Ref m a
ref)
a -> m ()
go a
s
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m a -> a -> IO ()
forall (ref :: * -> *) a. IsRef ref => ref a -> a -> IO ()
writeRef Ref m a
ref (a -> a
f a
s)
withIterates :: Frp m => (a -> a) -> a -> Evt m b -> Evt m (a, b)
withIterates :: (a -> a) -> a -> Evt m b -> Evt m (a, b)
withIterates a -> a
f a
val Evt m b
evt = (((a, b) -> m ()) -> m ()) -> Evt m (a, b)
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt ((((a, b) -> m ()) -> m ()) -> Evt m (a, b))
-> (((a, b) -> m ()) -> m ()) -> Evt m (a, b)
forall a b. (a -> b) -> a -> b
$ \(a, b) -> m ()
go -> do
Ref m a
ref <- Evt m b -> a -> m (Ref m a)
forall (m :: * -> *) a b. Frp m => Evt m a -> b -> m (Ref m b)
proxyNewRef Evt m b
evt a
val
Evt m b -> (b -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m b
evt ((b -> m ()) -> m ()) -> (b -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \b
x -> do
a
s <- IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Ref m a -> IO a
forall (ref :: * -> *) a. IsRef ref => ref a -> IO a
readRef Ref m a
ref)
(a, b) -> m ()
go (a
s, b
x)
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m a -> a -> IO ()
forall (ref :: * -> *) a. IsRef ref => ref a -> a -> IO ()
writeRef Ref m a
ref (a -> a
f a
s)
iterates' :: Frp m => (a -> m a) -> a -> Evt m b -> Evt m a
iterates' :: (a -> m a) -> a -> Evt m b -> Evt m a
iterates' a -> m a
f a
val Evt m b
evt = ((a -> m ()) -> m ()) -> Evt m a
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((a -> m ()) -> m ()) -> Evt m a)
-> ((a -> m ()) -> m ()) -> Evt m a
forall a b. (a -> b) -> a -> b
$ \a -> m ()
go -> do
Ref m a
ref <- Evt m b -> a -> m (Ref m a)
forall (m :: * -> *) a b. Frp m => Evt m a -> b -> m (Ref m b)
proxyNewRef Evt m b
evt a
val
Evt m b -> (b -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m b
evt ((b -> m ()) -> m ()) -> (b -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \b
_ -> do
a
s <- IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Ref m a -> IO a
forall (ref :: * -> *) a. IsRef ref => ref a -> IO a
readRef Ref m a
ref)
a -> m ()
go a
s
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (a -> IO ()) -> a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ref m a -> a -> IO ()
forall (ref :: * -> *) a. IsRef ref => ref a -> a -> IO ()
writeRef Ref m a
ref (a -> m ()) -> m a -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< a -> m a
f a
s
instance (Frp m, Num a) => Num (Dyn m a) where
fromInteger :: Integer -> Dyn m a
fromInteger = a -> Dyn m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Dyn m a) -> (Integer -> a) -> Integer -> Dyn m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> a
forall a. Num a => Integer -> a
fromInteger
+ :: Dyn m a -> Dyn m a -> Dyn m a
(+) = (a -> a -> a) -> Dyn m a -> Dyn m a -> Dyn m a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Num a => a -> a -> a
(+)
* :: Dyn m a -> Dyn m a -> Dyn m a
(*) = (a -> a -> a) -> Dyn m a -> Dyn m a -> Dyn m a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Num a => a -> a -> a
(*)
(-) = (a -> a -> a) -> Dyn m a -> Dyn m a -> Dyn m a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (-)
negate :: Dyn m a -> Dyn m a
negate = (a -> a) -> Dyn m a -> Dyn m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Num a => a -> a
negate
abs :: Dyn m a -> Dyn m a
abs = (a -> a) -> Dyn m a -> Dyn m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Num a => a -> a
abs
signum :: Dyn m a -> Dyn m a
signum = (a -> a) -> Dyn m a -> Dyn m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Num a => a -> a
signum
instance (Frp m, Fractional a) => Fractional (Dyn m a) where
fromRational :: Rational -> Dyn m a
fromRational = a -> Dyn m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Dyn m a) -> (Rational -> a) -> Rational -> Dyn m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> a
forall a. Fractional a => Rational -> a
fromRational
recip :: Dyn m a -> Dyn m a
recip = (a -> a) -> Dyn m a -> Dyn m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Fractional a => a -> a
recip
instance (Frp m, Semigroup a) => Semigroup (Dyn m a) where
<> :: Dyn m a -> Dyn m a -> Dyn m a
(<>) = (a -> a -> a) -> Dyn m a -> Dyn m a -> Dyn m a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>)
instance (Frp m, Monoid a) => Monoid (Dyn m a) where
mempty :: Dyn m a
mempty = a -> Dyn m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
forall a. Monoid a => a
mempty
instance (Frp m, IsString a) => IsString (Dyn m a) where
fromString :: String -> Dyn m a
fromString = a -> Dyn m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Dyn m a) -> (String -> a) -> String -> Dyn m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> a
forall a. IsString a => String -> a
fromString
readDyn :: Frp m => DynRef m a -> m a
readDyn :: DynRef m a -> m a
readDyn (ConstRef a
val) = a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
val
readDyn (DynRef s -> m a
extract Ref m s
ref ThreadId
_ m ()
_) = do
s
s <- IO s -> m s
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Ref m s -> IO s
forall (ref :: * -> *) a. IsRef ref => ref a -> IO a
readRef Ref m s
ref)
s -> m a
extract s
s
cancelDyn :: Frp m => DynRef m a -> m ()
cancelDyn :: DynRef m a -> m ()
cancelDyn (ConstRef a
_) = () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
cancelDyn (DynRef s -> m a
_ Ref m s
_ ThreadId
tid m ()
release) = ThreadId -> m ()
forall (m :: * -> *). MonadBase IO m => ThreadId -> m ()
killThread ThreadId
tid m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m ()
release
runDyn :: Frp m => Dyn m a -> m (DynRef m a)
runDyn :: Dyn m a -> m (DynRef m a)
runDyn (ConstDyn a
val) = DynRef m a -> m (DynRef m a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> DynRef m a
forall (m :: * -> *) a. a -> DynRef m a
ConstRef a
val)
runDyn dyn :: Dyn m a
dyn@(Dyn s -> m a
extract Evt m s
evt m s
init m ()
release) = do
Ref m s
ref <- Dyn m a -> s -> m (Ref m s)
forall (m :: * -> *) a b. Frp m => Dyn m a -> b -> m (Ref m b)
proxyNewRefDyn Dyn m a
dyn (s -> m (Ref m s)) -> m s -> m (Ref m s)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m s
init
ThreadId
tid <- m () -> m ThreadId
forall (m :: * -> *). MonadBaseControl IO m => m () -> m ThreadId
fork (m () -> m ThreadId) -> m () -> m ThreadId
forall a b. (a -> b) -> a -> b
$ Evt m s -> (s -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m s
evt ((s -> m ()) -> m ()) -> (s -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \s
s -> do
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m s -> s -> IO ()
forall (ref :: * -> *) a. IsRef ref => ref a -> a -> IO ()
writeRef Ref m s
ref s
s
DynRef m a -> m (DynRef m a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((s -> m a) -> Ref m s -> ThreadId -> m () -> DynRef m a
forall (m :: * -> *) a s.
(s -> m a) -> Ref m s -> ThreadId -> m () -> DynRef m a
DynRef s -> m a
extract Ref m s
ref ThreadId
tid m ()
release)
hold :: Frp m => a -> Evt m a -> Dyn m a
hold :: a -> Evt m a -> Dyn m a
hold a
s Evt m a
evt = (a -> m a) -> Evt m a -> m a -> m () -> Dyn m a
forall (m :: * -> *) a s.
(s -> m a) -> Evt m s -> m s -> m () -> Dyn m a
Dyn a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Evt m a
evt (a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
s) (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
count :: Frp m => Evt m a -> Evt m Int
count :: Evt m a -> Evt m Int
count = (a -> Int -> Int) -> Int -> Evt m a -> Evt m Int
forall (m :: * -> *) a b.
Frp m =>
(a -> b -> b) -> b -> Evt m a -> Evt m b
scan ((Int -> Int) -> a -> Int -> Int
forall a b. a -> b -> a
const Int -> Int
forall a. Enum a => a -> a
succ) Int
0
withCount :: Frp m => Evt m a -> Evt m (Int, a)
withCount :: Evt m a -> Evt m (Int, a)
withCount = (a -> Int -> ((Int, a), Int)) -> Int -> Evt m a -> Evt m (Int, a)
forall (m :: * -> *) a s b.
Frp m =>
(a -> s -> (b, s)) -> s -> Evt m a -> Evt m b
accum (\a
a Int
b -> ((Int
b, a
a), Int -> Int
forall a. Enum a => a -> a
succ Int
b)) Int
1
unhold :: Frp m => Dyn m a -> Evt m a
unhold :: Dyn m a -> Evt m a
unhold (ConstDyn a
val) = ((a -> m ()) -> m ()) -> Evt m a
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((a -> m ()) -> m ()) -> Evt m a)
-> ((a -> m ()) -> m ()) -> Evt m a
forall a b. (a -> b) -> a -> b
$ \a -> m ()
go -> a -> m ()
go a
val
unhold (Dyn s -> m a
extract Evt m s
evts m s
init m ()
release) = ((a -> m ()) -> m ()) -> Evt m a
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((a -> m ()) -> m ()) -> Evt m a)
-> ((a -> m ()) -> m ()) -> Evt m a
forall a b. (a -> b) -> a -> b
$ \a -> m ()
go -> do
a -> m ()
go (a -> m ()) -> m a -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< s -> m a
extract (s -> m a) -> m s -> m a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m s
init
Evt m s -> (s -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m s
evts (a -> m ()
go (a -> m ()) -> (s -> m a) -> s -> m ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< s -> m a
extract) m () -> m () -> m ()
forall (m :: * -> *) a b.
MonadBaseControl IO m =>
m a -> m b -> m a
`finally` m ()
release
scanD :: Frp m => (a -> b -> b) -> b -> Evt m a -> Dyn m b
scanD :: (a -> b -> b) -> b -> Evt m a -> Dyn m b
scanD a -> b -> b
f b
s Evt m a
evt = b -> Evt m b -> Dyn m b
forall (m :: * -> *) a. Frp m => a -> Evt m a -> Dyn m a
hold b
s ((a -> b -> b) -> b -> Evt m a -> Evt m b
forall (m :: * -> *) a b.
Frp m =>
(a -> b -> b) -> b -> Evt m a -> Evt m b
scan a -> b -> b
f b
s Evt m a
evt)
accumB :: Frp m => a -> Evt m (a -> a) -> Dyn m a
accumB :: a -> Evt m (a -> a) -> Dyn m a
accumB a
a Evt m (a -> a)
evt = ((a -> a) -> a -> a) -> a -> Evt m (a -> a) -> Dyn m a
forall (m :: * -> *) a b.
Frp m =>
(a -> b -> b) -> b -> Evt m a -> Dyn m b
scanD (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
($) a
a Evt m (a -> a)
evt
scanMayD :: Frp m => (a -> b -> Maybe b) -> b -> Evt m a -> Dyn m b
scanMayD :: (a -> b -> Maybe b) -> b -> Evt m a -> Dyn m b
scanMayD a -> b -> Maybe b
f b
s Evt m a
evt = b -> Evt m b -> Dyn m b
forall (m :: * -> *) a. Frp m => a -> Evt m a -> Dyn m a
hold b
s ((a -> b -> Maybe b) -> b -> Evt m a -> Evt m b
forall (m :: * -> *) a b.
Frp m =>
(a -> b -> Maybe b) -> b -> Evt m a -> Evt m b
scanMay a -> b -> Maybe b
f b
s Evt m a
evt)
foreach :: Frp m => (a -> m ()) -> Evt m a -> Evt m a
foreach :: (a -> m ()) -> Evt m a -> Evt m a
foreach a -> m ()
call Evt m a
evt = ((a -> m ()) -> m ()) -> Evt m a
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((a -> m ()) -> m ()) -> Evt m a)
-> ((a -> m ()) -> m ()) -> Evt m a
forall a b. (a -> b) -> a -> b
$ \a -> m ()
go ->
Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt ((a -> m ()) -> m ()) -> (a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \a
x -> do
a -> m ()
call a
x
a -> m ()
go a
x
posteach :: Frp m => (a -> m ()) -> Evt m a -> Evt m a
posteach :: (a -> m ()) -> Evt m a -> Evt m a
posteach a -> m ()
call Evt m a
evt = ((a -> m ()) -> m ()) -> Evt m a
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((a -> m ()) -> m ()) -> Evt m a)
-> ((a -> m ()) -> m ()) -> Evt m a
forall a b. (a -> b) -> a -> b
$ \a -> m ()
go ->
Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt ((a -> m ()) -> m ()) -> (a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \a
x -> do
a -> m ()
go a
x
a -> m ()
call a
x
apply :: Frp m => Dyn m (a -> b) -> Evt m a -> Evt m b
apply :: Dyn m (a -> b) -> Evt m a -> Evt m b
apply Dyn m (a -> b)
dyn Evt m a
evt = ((b -> m ()) -> m ()) -> Evt m b
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((b -> m ()) -> m ()) -> Evt m b)
-> ((b -> m ()) -> m ()) -> Evt m b
forall a b. (a -> b) -> a -> b
$ \b -> m ()
go -> do
DynRef m (a -> b)
ref <- Dyn m (a -> b) -> m (DynRef m (a -> b))
forall (m :: * -> *) a. Frp m => Dyn m a -> m (DynRef m a)
runDyn Dyn m (a -> b)
dyn
Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt (\a
b -> do
b -> m ()
go (b -> m ()) -> ((a -> b) -> b) -> (a -> b) -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ a
b) ((a -> b) -> m ()) -> m (a -> b) -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< DynRef m (a -> b) -> m (a -> b)
forall (m :: * -> *) a. Frp m => DynRef m a -> m a
readDyn DynRef m (a -> b)
ref
)
m () -> m () -> m ()
forall (m :: * -> *) a b.
MonadBaseControl IO m =>
m a -> m b -> m a
`finally` DynRef m (a -> b) -> m ()
forall (m :: * -> *) a. Frp m => DynRef m a -> m ()
cancelDyn DynRef m (a -> b)
ref
apply' :: Frp m => Dyn m (a -> m b) -> Evt m a -> Evt m b
apply' :: Dyn m (a -> m b) -> Evt m a -> Evt m b
apply' Dyn m (a -> m b)
dyn Evt m a
evt = ((b -> m ()) -> m ()) -> Evt m b
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((b -> m ()) -> m ()) -> Evt m b)
-> ((b -> m ()) -> m ()) -> Evt m b
forall a b. (a -> b) -> a -> b
$ \b -> m ()
go -> do
DynRef m (a -> m b)
ref <- Dyn m (a -> m b) -> m (DynRef m (a -> m b))
forall (m :: * -> *) a. Frp m => Dyn m a -> m (DynRef m a)
runDyn Dyn m (a -> m b)
dyn
Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt (\a
b -> do
(\a -> m b
f -> b -> m ()
go (b -> m ()) -> m b -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< a -> m b
f a
b) ((a -> m b) -> m ()) -> m (a -> m b) -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< DynRef m (a -> m b) -> m (a -> m b)
forall (m :: * -> *) a. Frp m => DynRef m a -> m a
readDyn DynRef m (a -> m b)
ref)
m () -> m () -> m ()
forall (m :: * -> *) a b.
MonadBaseControl IO m =>
m a -> m b -> m a
`finally` DynRef m (a -> m b) -> m ()
forall (m :: * -> *) a. Frp m => DynRef m a -> m ()
cancelDyn DynRef m (a -> m b)
ref
(<@>) :: Frp m => Dyn m (a -> b) -> Evt m a -> Evt m b
<@> :: Dyn m (a -> b) -> Evt m a -> Evt m b
(<@>) = Dyn m (a -> b) -> Evt m a -> Evt m b
forall (m :: * -> *) a b.
Frp m =>
Dyn m (a -> b) -> Evt m a -> Evt m b
apply
(<@) :: Frp m => Dyn m a -> Evt m b -> Evt m a
<@ :: Dyn m a -> Evt m b -> Evt m a
(<@) = Dyn m a -> Evt m b -> Evt m a
forall (m :: * -> *) a b. Frp m => Dyn m a -> Evt m b -> Evt m a
snap
applyMay :: Frp m => Dyn m (a -> Maybe b) -> Evt m a -> Evt m b
applyMay :: Dyn m (a -> Maybe b) -> Evt m a -> Evt m b
applyMay Dyn m (a -> Maybe b)
dyn Evt m a
evt = ((b -> m ()) -> m ()) -> Evt m b
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((b -> m ()) -> m ()) -> Evt m b)
-> ((b -> m ()) -> m ()) -> Evt m b
forall a b. (a -> b) -> a -> b
$ \b -> m ()
go -> do
DynRef m (a -> Maybe b)
ref <- Dyn m (a -> Maybe b) -> m (DynRef m (a -> Maybe b))
forall (m :: * -> *) a. Frp m => Dyn m a -> m (DynRef m a)
runDyn Dyn m (a -> Maybe b)
dyn
Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt (\a
b -> do
(b -> m ()) -> Maybe b -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ b -> m ()
go (Maybe b -> m ())
-> ((a -> Maybe b) -> Maybe b) -> (a -> Maybe b) -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a -> Maybe b) -> a -> Maybe b
forall a b. (a -> b) -> a -> b
$ a
b) ((a -> Maybe b) -> m ()) -> m (a -> Maybe b) -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< DynRef m (a -> Maybe b) -> m (a -> Maybe b)
forall (m :: * -> *) a. Frp m => DynRef m a -> m a
readDyn DynRef m (a -> Maybe b)
ref)
m () -> m () -> m ()
forall (m :: * -> *) a b.
MonadBaseControl IO m =>
m a -> m b -> m a
`finally` DynRef m (a -> Maybe b) -> m ()
forall (m :: * -> *) a. Frp m => DynRef m a -> m ()
cancelDyn DynRef m (a -> Maybe b)
ref
applyMay' :: Frp m => Dyn m (a -> m (Maybe b)) -> Evt m a -> Evt m b
applyMay' :: Dyn m (a -> m (Maybe b)) -> Evt m a -> Evt m b
applyMay' Dyn m (a -> m (Maybe b))
dyn Evt m a
evt = ((b -> m ()) -> m ()) -> Evt m b
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((b -> m ()) -> m ()) -> Evt m b)
-> ((b -> m ()) -> m ()) -> Evt m b
forall a b. (a -> b) -> a -> b
$ \b -> m ()
go -> do
DynRef m (a -> m (Maybe b))
ref <- Dyn m (a -> m (Maybe b)) -> m (DynRef m (a -> m (Maybe b)))
forall (m :: * -> *) a. Frp m => Dyn m a -> m (DynRef m a)
runDyn Dyn m (a -> m (Maybe b))
dyn
Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt (\a
b -> do
(\a -> m (Maybe b)
f -> (b -> m ()) -> Maybe b -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ b -> m ()
go (Maybe b -> m ()) -> m (Maybe b) -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< a -> m (Maybe b)
f a
b) ((a -> m (Maybe b)) -> m ()) -> m (a -> m (Maybe b)) -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< DynRef m (a -> m (Maybe b)) -> m (a -> m (Maybe b))
forall (m :: * -> *) a. Frp m => DynRef m a -> m a
readDyn DynRef m (a -> m (Maybe b))
ref)
m () -> m () -> m ()
forall (m :: * -> *) a b.
MonadBaseControl IO m =>
m a -> m b -> m a
`finally` DynRef m (a -> m (Maybe b)) -> m ()
forall (m :: * -> *) a. Frp m => DynRef m a -> m ()
cancelDyn DynRef m (a -> m (Maybe b))
ref
snap :: Frp m => Dyn m a -> Evt m b -> Evt m a
snap :: Dyn m a -> Evt m b -> Evt m a
snap Dyn m a
dyn Evt m b
evt = Dyn m (b -> a) -> Evt m b -> Evt m a
forall (m :: * -> *) a b.
Frp m =>
Dyn m (a -> b) -> Evt m a -> Evt m b
apply (a -> b -> a
forall a b. a -> b -> a
const (a -> b -> a) -> Dyn m a -> Dyn m (b -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dyn m a
dyn) Evt m b
evt
attach :: Frp m => Dyn m a-> Evt m b -> Evt m (a, b)
attach :: Dyn m a -> Evt m b -> Evt m (a, b)
attach Dyn m a
dyn Evt m b
evt = (a -> b -> (a, b)) -> Dyn m a -> Evt m b -> Evt m (a, b)
forall (m :: * -> *) a b c.
Frp m =>
(a -> b -> c) -> Dyn m a -> Evt m b -> Evt m c
attachWith (,) Dyn m a
dyn Evt m b
evt
attachWith :: Frp m => (a -> b -> c) -> Dyn m a -> Evt m b -> Evt m c
attachWith :: (a -> b -> c) -> Dyn m a -> Evt m b -> Evt m c
attachWith a -> b -> c
f Dyn m a
dyn Evt m b
evt = Dyn m (b -> c) -> Evt m b -> Evt m c
forall (m :: * -> *) a b.
Frp m =>
Dyn m (a -> b) -> Evt m a -> Evt m b
apply (a -> b -> c
f (a -> b -> c) -> Dyn m a -> Dyn m (b -> c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dyn m a
dyn) Evt m b
evt
attachWithMay :: Frp m => (a -> b -> Maybe c) -> Dyn m a -> Evt m b -> Evt m c
attachWithMay :: (a -> b -> Maybe c) -> Dyn m a -> Evt m b -> Evt m c
attachWithMay a -> b -> Maybe c
f Dyn m a
dyn Evt m b
evt = Dyn m (b -> Maybe c) -> Evt m b -> Evt m c
forall (m :: * -> *) a b.
Frp m =>
Dyn m (a -> Maybe b) -> Evt m a -> Evt m b
applyMay (a -> b -> Maybe c
f (a -> b -> Maybe c) -> Dyn m a -> Dyn m (b -> Maybe c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dyn m a
dyn) Evt m b
evt
mapMay :: Frp m => (a -> Maybe b) -> Evt m a -> Evt m b
mapMay :: (a -> Maybe b) -> Evt m a -> Evt m b
mapMay a -> Maybe b
f Evt m a
evt = ((b -> m ()) -> m ()) -> Evt m b
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((b -> m ()) -> m ()) -> Evt m b)
-> ((b -> m ()) -> m ()) -> Evt m b
forall a b. (a -> b) -> a -> b
$ \b -> m ()
go -> Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt ((b -> m ()) -> Maybe b -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ b -> m ()
go (Maybe b -> m ()) -> (a -> Maybe b) -> a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe b
f)
mapMay' :: Frp m => (a -> m (Maybe b)) -> Evt m a -> Evt m b
mapMay' :: (a -> m (Maybe b)) -> Evt m a -> Evt m b
mapMay' a -> m (Maybe b)
f Evt m a
evt = ((b -> m ()) -> m ()) -> Evt m b
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((b -> m ()) -> m ()) -> Evt m b)
-> ((b -> m ()) -> m ()) -> Evt m b
forall a b. (a -> b) -> a -> b
$ \b -> m ()
go -> Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt ((b -> m ()) -> Maybe b -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ b -> m ()
go (Maybe b -> m ()) -> (a -> m (Maybe b)) -> a -> m ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< a -> m (Maybe b)
f)
filters :: Frp m => (a -> Bool) -> Evt m a -> Evt m a
filters :: (a -> Bool) -> Evt m a -> Evt m a
filters a -> Bool
f Evt m a
evt = ((a -> m ()) -> m ()) -> Evt m a
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((a -> m ()) -> m ()) -> Evt m a)
-> ((a -> m ()) -> m ()) -> Evt m a
forall a b. (a -> b) -> a -> b
$ \a -> m ()
go -> Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt (\a
x -> Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (a -> Bool
f a
x) (a -> m ()
go a
x))
filters' :: Frp m => (a -> m Bool) -> Evt m a -> Evt m a
filters' :: (a -> m Bool) -> Evt m a -> Evt m a
filters' a -> m Bool
f Evt m a
evt = ((a -> m ()) -> m ()) -> Evt m a
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((a -> m ()) -> m ()) -> Evt m a)
-> ((a -> m ()) -> m ()) -> Evt m a
forall a b. (a -> b) -> a -> b
$ \a -> m ()
go -> Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt (\a
x -> (\Bool
cond -> Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
cond (a -> m ()
go a
x)) (Bool -> m ()) -> m Bool -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< a -> m Bool
f a
x)
filterJust :: Frp m => Evt m (Maybe a) -> Evt m a
filterJust :: Evt m (Maybe a) -> Evt m a
filterJust Evt m (Maybe a)
evt = ((a -> m ()) -> m ()) -> Evt m a
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((a -> m ()) -> m ()) -> Evt m a)
-> ((a -> m ()) -> m ()) -> Evt m a
forall a b. (a -> b) -> a -> b
$ \a -> m ()
go -> Evt m (Maybe a) -> (Maybe a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m (Maybe a)
evt ((a -> m ()) -> Maybe a -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ a -> m ()
go)
whens :: Frp m => Dyn m Bool -> Evt m a -> Evt m a
whens :: Dyn m Bool -> Evt m a -> Evt m a
whens Dyn m Bool
dyn Evt m a
evt = ((a -> m ()) -> m ()) -> Evt m a
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((a -> m ()) -> m ()) -> Evt m a)
-> ((a -> m ()) -> m ()) -> Evt m a
forall a b. (a -> b) -> a -> b
$ \a -> m ()
go -> do
DynRef m Bool
ref <- Dyn m Bool -> m (DynRef m Bool)
forall (m :: * -> *) a. Frp m => Dyn m a -> m (DynRef m a)
runDyn Dyn m Bool
dyn
Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt ((a -> m ()) -> m ()) -> (a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \a
b -> do
Bool
a <- DynRef m Bool -> m Bool
forall (m :: * -> *) a. Frp m => DynRef m a -> m a
readDyn DynRef m Bool
ref
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
a (a -> m ()
go a
b)
splits :: Frp m => Evt m (Either a b) -> (Evt m a, Evt m b)
splits :: Evt m (Either a b) -> (Evt m a, Evt m b)
splits Evt m (Either a b)
evt = (Evt m (Either a b) -> Evt m a
forall (m :: * -> *) a b. Frp m => Evt m (Either a b) -> Evt m a
lefts Evt m (Either a b)
evt, Evt m (Either a b) -> Evt m b
forall (m :: * -> *) a b. Frp m => Evt m (Either a b) -> Evt m b
rights Evt m (Either a b)
evt)
lefts :: Frp m => Evt m (Either a b) -> Evt m a
lefts :: Evt m (Either a b) -> Evt m a
lefts Evt m (Either a b)
evt = (Either a b -> Maybe a) -> Evt m (Either a b) -> Evt m a
forall (m :: * -> *) a b.
Frp m =>
(a -> Maybe b) -> Evt m a -> Evt m b
mapMay ((a -> Maybe a) -> (b -> Maybe a) -> Either a b -> Maybe a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> Maybe a
forall a. a -> Maybe a
Just (Maybe a -> b -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing)) Evt m (Either a b)
evt
rights :: Frp m => Evt m (Either a b) -> Evt m b
rights :: Evt m (Either a b) -> Evt m b
rights Evt m (Either a b)
evt = (Either a b -> Maybe b) -> Evt m (Either a b) -> Evt m b
forall (m :: * -> *) a b.
Frp m =>
(a -> Maybe b) -> Evt m a -> Evt m b
mapMay ((a -> Maybe b) -> (b -> Maybe b) -> Either a b -> Maybe b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe b -> a -> Maybe b
forall a b. a -> b -> a
const Maybe b
forall a. Maybe a
Nothing) b -> Maybe b
forall a. a -> Maybe a
Just) Evt m (Either a b)
evt
takes :: Frp m => Int -> Evt m a -> Evt m a
takes :: Int -> Evt m a -> Evt m a
takes Int
n Evt m a
evt = ((a -> m ()) -> m ()) -> Evt m a
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((a -> m ()) -> m ()) -> Evt m a)
-> ((a -> m ()) -> m ()) -> Evt m a
forall a b. (a -> b) -> a -> b
$ \a -> m ()
go -> do
Ref m Int
ref <- Evt m a -> Int -> m (Ref m Int)
forall (m :: * -> *) a b. Frp m => Evt m a -> b -> m (Ref m b)
proxyNewRef Evt m a
evt Int
0
m () -> m ()
forall (m :: * -> *). Frp m => m () -> m ()
waitAsync (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt ((a -> m ()) -> m ()) -> (a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \a
x -> do
Int
cur <- IO Int -> m Int
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Ref m Int -> IO Int
forall (ref :: * -> *) a. IsRef ref => ref a -> IO a
readRef Ref m Int
ref)
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
cur Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
a -> m ()
go a
x
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
cur Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) m ()
forall (m :: * -> *). Frp m => m ()
stopSelf
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m Int -> Int -> IO ()
forall (ref :: * -> *) a. IsRef ref => ref a -> a -> IO ()
writeRef Ref m Int
ref (Int
cur Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
drops :: Frp m => Int -> Evt m a -> Evt m a
drops :: Int -> Evt m a -> Evt m a
drops Int
n Evt m a
evt = ((a -> m ()) -> m ()) -> Evt m a
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((a -> m ()) -> m ()) -> Evt m a)
-> ((a -> m ()) -> m ()) -> Evt m a
forall a b. (a -> b) -> a -> b
$ \a -> m ()
go -> do
Ref m Int
tv <- Evt m a -> Int -> m (Ref m Int)
forall (m :: * -> *) a b. Frp m => Evt m a -> b -> m (Ref m b)
proxyNewRef Evt m a
evt Int
n
Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt ((a -> m ()) -> m ()) -> (a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \a
x -> do
Int
cur <- IO Int -> m Int
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Ref m Int -> IO Int
forall (ref :: * -> *) a. IsRef ref => ref a -> IO a
readRef Ref m Int
tv)
if (Int
cur Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0)
then a -> m ()
go a
x
else IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Ref m Int -> (Int -> Int) -> IO ()
forall (ref :: * -> *) a. IsRef ref => ref a -> (a -> a) -> IO ()
modifyRef Ref m Int
tv Int -> Int
forall a. Enum a => a -> a
pred)
stopSelf :: Frp m => m ()
stopSelf :: m ()
stopSelf = ThreadId -> m ()
forall (m :: * -> *). MonadBase IO m => ThreadId -> m ()
killThread (ThreadId -> m ()) -> m ThreadId -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m ThreadId
forall (m :: * -> *). MonadBase IO m => m ThreadId
myThreadId
waitStop :: Frp m => Async a -> m ()
waitStop :: Async a -> m ()
waitStop Async a
x = m (Either SomeException a) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (Either SomeException a) -> m ())
-> m (Either SomeException a) -> m ()
forall a b. (a -> b) -> a -> b
$ IO (Either SomeException a) -> m (Either SomeException a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either SomeException a) -> m (Either SomeException a))
-> IO (Either SomeException a) -> m (Either SomeException a)
forall a b. (a -> b) -> a -> b
$ Async (StM IO a) -> IO (Either SomeException a)
forall (m :: * -> *) a.
MonadBaseControl IO m =>
Async (StM m a) -> m (Either SomeException a)
waitCatch Async a
Async (StM IO a)
x
waitAsync :: Frp m => m () -> m ()
waitAsync :: m () -> m ()
waitAsync m ()
act = do
Async (StM m ())
tid <- m () -> m (Async (StM m ()))
forall (m :: * -> *) a.
MonadBaseControl IO m =>
m a -> m (Async (StM m a))
async m ()
act
Async (StM m ()) -> m ()
forall (m :: * -> *) a. Frp m => Async a -> m ()
waitStop Async (StM m ())
tid
takesWhile :: Frp m => (a -> Bool) -> Evt m a -> Evt m a
takesWhile :: (a -> Bool) -> Evt m a -> Evt m a
takesWhile a -> Bool
pred Evt m a
evt = ((a -> m ()) -> m ()) -> Evt m a
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((a -> m ()) -> m ()) -> Evt m a)
-> ((a -> m ()) -> m ()) -> Evt m a
forall a b. (a -> b) -> a -> b
$ \a -> m ()
go -> do
m () -> m ()
forall (m :: * -> *). Frp m => m () -> m ()
waitAsync (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt ((a -> m ()) -> m ()) -> (a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \a
x -> do
if (a -> Bool
pred a
x)
then a -> m ()
go a
x
else m ()
forall (m :: * -> *). Frp m => m ()
stopSelf
dropsWhile :: Frp m => (a -> Bool) -> Evt m a -> Evt m a
dropsWhile :: (a -> Bool) -> Evt m a -> Evt m a
dropsWhile a -> Bool
pred Evt m a
evt = ((a -> m ()) -> m ()) -> Evt m a
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((a -> m ()) -> m ()) -> Evt m a)
-> ((a -> m ()) -> m ()) -> Evt m a
forall a b. (a -> b) -> a -> b
$ \a -> m ()
go -> do
Ref m Bool
tv <- Evt m a -> Bool -> m (Ref m Bool)
forall (m :: * -> *) a b. Frp m => Evt m a -> b -> m (Ref m b)
proxyNewRef Evt m a
evt Bool
True
Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt ((a -> m ()) -> m ()) -> (a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \a
x -> do
Bool
cur <- IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Ref m Bool -> IO Bool
forall (ref :: * -> *) a. IsRef ref => ref a -> IO a
readRef Ref m Bool
tv)
if Bool
cur
then
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (a -> Bool
pred a
x) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m Bool -> Bool -> IO ()
forall (ref :: * -> *) a. IsRef ref => ref a -> a -> IO ()
writeRef Ref m Bool
tv Bool
False
a -> m ()
go a
x
else a -> m ()
go a
x
listAt :: Frp m => [a] -> Evt m Int -> Evt m a
listAt :: [a] -> Evt m Int -> Evt m a
listAt [a]
vals Evt m Int
evt = (Int -> Maybe a) -> Evt m Int -> Evt m a
forall (m :: * -> *) a b.
Frp m =>
(a -> Maybe b) -> Evt m a -> Evt m b
mapMay (Vector a
vec Vector a -> Int -> Maybe a
forall a. Vector a -> Int -> Maybe a
V.!?) Evt m Int
evt
where
vec :: Vector a
vec = [a] -> Vector a
forall a. [a] -> Vector a
V.fromList [a]
vals
toToggle :: Frp m => Evt m a -> Evt m Bool
toToggle :: Evt m a -> Evt m Bool
toToggle = (Bool -> Bool) -> Bool -> Evt m a -> Evt m Bool
forall (m :: * -> *) a b.
Frp m =>
(a -> a) -> a -> Evt m b -> Evt m a
iterates Bool -> Bool
not Bool
True
cycles :: Frp m => [a] -> Evt m b -> Evt m a
cycles :: [a] -> Evt m b -> Evt m a
cycles [a]
vals Evt m b
evt = (Int -> a) -> Evt m Int -> Evt m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Vector a
vec Vector a -> Int -> a
forall a. Vector a -> Int -> a
V.!) (Evt m Int -> Evt m a) -> Evt m Int -> Evt m a
forall a b. (a -> b) -> a -> b
$ (Int -> Int) -> Int -> Evt m b -> Evt m Int
forall (m :: * -> *) a b.
Frp m =>
(a -> a) -> a -> Evt m b -> Evt m a
iterates ((Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
len) (Int -> Int) -> (Int -> Int) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
forall a. Enum a => a -> a
succ) Int
0 Evt m b
evt
where
vec :: Vector a
vec = [a] -> Vector a
forall a. [a] -> Vector a
V.fromList [a]
vals
len :: Int
len = Vector a -> Int
forall a. Vector a -> Int
V.length Vector a
vec
sums :: (Frp m, Num a) => Evt m a -> Evt m a
sums :: Evt m a -> Evt m a
sums = (a -> a -> a) -> a -> Evt m a -> Evt m a
forall (m :: * -> *) a b.
Frp m =>
(a -> b -> b) -> b -> Evt m a -> Evt m b
scan a -> a -> a
forall a. Num a => a -> a -> a
(+) a
0
integrate :: (Frp m, VectorSpace v, Real (Scalar v), Fractional (Scalar v)) => (Scalar v) -> Dyn m v -> Dyn m v
integrate :: Scalar v -> Dyn m v -> Dyn m v
integrate Scalar v
dt Dyn m v
dyn =
v -> Evt m v -> Dyn m v
forall (m :: * -> *) a. Frp m => a -> Evt m a -> Dyn m a
hold v
forall v. AdditiveGroup v => v
zeroV (Evt m v -> Dyn m v) -> Evt m v -> Dyn m v
forall a b. (a -> b) -> a -> b
$ (v -> v -> v) -> v -> Evt m v -> Evt m v
forall (m :: * -> *) a b.
Frp m =>
(a -> b -> b) -> b -> Evt m a -> Evt m b
scan v -> v -> v
forall v. AdditiveGroup v => v -> v -> v
(^+^) v
forall v. AdditiveGroup v => v
zeroV ((v -> NominalDiffTime -> v)
-> Dyn m v -> Evt m NominalDiffTime -> Evt m v
forall (m :: * -> *) a b c.
Frp m =>
(a -> b -> c) -> Dyn m a -> Evt m b -> Evt m c
attachWith (\v
v NominalDiffTime
k -> NominalDiffTime -> Scalar v
forall a b. (Real a, Fractional b) => a -> b
realToFrac NominalDiffTime
k Scalar v -> v -> v
forall v. VectorSpace v => Scalar v -> v -> v
*^ v
v) Dyn m v
dyn (NominalDiffTime -> Evt m NominalDiffTime
forall (m :: * -> *).
Frp m =>
NominalDiffTime -> Evt m NominalDiffTime
ticks (Scalar v -> NominalDiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac Scalar v
dt)))
integrate2 :: (Frp m, VectorSpace v, Real (Scalar v), Fractional (Scalar v)) => (Scalar v) -> Dyn m v -> Dyn m v
integrate2 :: Scalar v -> Dyn m v -> Dyn m v
integrate2 Scalar v
dt Dyn m v
dyn =
v -> Evt m v -> Dyn m v
forall (m :: * -> *) a. Frp m => a -> Evt m a -> Dyn m a
hold v
forall v. AdditiveGroup v => v
zeroV (Evt m v -> Dyn m v) -> Evt m v -> Dyn m v
forall a b. (a -> b) -> a -> b
$ ((Maybe (v, NominalDiffTime), v) -> v)
-> Evt m (Maybe (v, NominalDiffTime), v) -> Evt m v
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe (v, NominalDiffTime), v) -> v
forall a b. (a, b) -> b
snd (Evt m (Maybe (v, NominalDiffTime), v) -> Evt m v)
-> Evt m (Maybe (v, NominalDiffTime), v) -> Evt m v
forall a b. (a -> b) -> a -> b
$ ((v, NominalDiffTime)
-> (Maybe (v, NominalDiffTime), v)
-> (Maybe (v, NominalDiffTime), v))
-> (Maybe (v, NominalDiffTime), v)
-> Evt m (v, NominalDiffTime)
-> Evt m (Maybe (v, NominalDiffTime), v)
forall (m :: * -> *) a b.
Frp m =>
(a -> b -> b) -> b -> Evt m a -> Evt m b
scan (v, NominalDiffTime)
-> (Maybe (v, NominalDiffTime), v)
-> (Maybe (v, NominalDiffTime), v)
forall v a b.
(VectorSpace v, Real a, Fractional (Scalar v)) =>
(v, a) -> (Maybe (v, b), v) -> (Maybe (v, a), v)
go (Maybe (v, NominalDiffTime)
forall a. Maybe a
Nothing, v
forall v. AdditiveGroup v => v
zeroV) (Dyn m v -> Evt m NominalDiffTime -> Evt m (v, NominalDiffTime)
forall (m :: * -> *) a b.
Frp m =>
Dyn m a -> Evt m b -> Evt m (a, b)
attach Dyn m v
dyn (NominalDiffTime -> Evt m NominalDiffTime
forall (m :: * -> *).
Frp m =>
NominalDiffTime -> Evt m NominalDiffTime
ticks (Scalar v -> NominalDiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac Scalar v
dt)))
where
go :: (v, a) -> (Maybe (v, b), v) -> (Maybe (v, a), v)
go (v
v, a
h) (Maybe (v, b)
mPrev, v
res) = (((v, a) -> Maybe (v, a)
forall a. a -> Maybe a
Just (v
v, a
h), ) (v -> (Maybe (v, a), v)) -> (v -> v) -> v -> (Maybe (v, a), v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (v
res v -> v -> v
forall v. AdditiveGroup v => v -> v -> v
^+^ )) (v -> (Maybe (v, a), v)) -> v -> (Maybe (v, a), v)
forall a b. (a -> b) -> a -> b
$ case Maybe (v, b)
mPrev of
Maybe (v, b)
Nothing -> a -> Scalar v
forall a b. (Real a, Fractional b) => a -> b
realToFrac a
h Scalar v -> v -> v
forall v. VectorSpace v => Scalar v -> v -> v
*^ v
v
Just (v
v0, b
h0) -> (a -> Scalar v
forall a b. (Real a, Fractional b) => a -> b
realToFrac a
h Scalar v -> Scalar v -> Scalar v
forall a. Num a => a -> a -> a
* Scalar v
0.5) Scalar v -> v -> v
forall v. VectorSpace v => Scalar v -> v -> v
*^ (v
v0 v -> v -> v
forall v. AdditiveGroup v => v -> v -> v
^+^ v
v)
sumD :: (Frp m, Num a) => NominalDiffTime -> Dyn m a -> Dyn m a
sumD :: NominalDiffTime -> Dyn m a -> Dyn m a
sumD NominalDiffTime
dt Dyn m a
dyn = a -> Evt m a -> Dyn m a
forall (m :: * -> *) a. Frp m => a -> Evt m a -> Dyn m a
hold a
0 (Evt m a -> Dyn m a) -> Evt m a -> Dyn m a
forall a b. (a -> b) -> a -> b
$ Evt m a -> Evt m a
forall (m :: * -> *) a. (Frp m, Num a) => Evt m a -> Evt m a
sums (Dyn m a -> Evt m () -> Evt m a
forall (m :: * -> *) a b. Frp m => Dyn m a -> Evt m b -> Evt m a
snap Dyn m a
dyn (NominalDiffTime -> Evt m ()
forall (m :: * -> *). Frp m => NominalDiffTime -> Evt m ()
pulse NominalDiffTime
dt))
products :: (Frp m, Num a) => Evt m a -> Evt m a
products :: Evt m a -> Evt m a
products = (a -> a -> a) -> a -> Evt m a -> Evt m a
forall (m :: * -> *) a b.
Frp m =>
(a -> b -> b) -> b -> Evt m a -> Evt m b
scan a -> a -> a
forall a. Num a => a -> a -> a
(*) a
1
appends :: (Frp m, Monoid a) => Evt m a -> Evt m a
appends :: Evt m a -> Evt m a
appends = (a -> a -> a) -> a -> Evt m a -> Evt m a
forall (m :: * -> *) a b.
Frp m =>
(a -> b -> b) -> b -> Evt m a -> Evt m b
scan ((a -> a -> a) -> a -> a -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>)) a
forall a. Monoid a => a
mempty
foldMaps :: (Frp m, Monoid b) => (a -> b) -> Evt m a -> Evt m b
foldMaps :: (a -> b) -> Evt m a -> Evt m b
foldMaps a -> b
f = Evt m b -> Evt m b
forall (m :: * -> *) a. (Frp m, Monoid a) => Evt m a -> Evt m a
appends (Evt m b -> Evt m b) -> (Evt m a -> Evt m b) -> Evt m a -> Evt m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> Evt m a -> Evt m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f
folds :: (Frp m, Monoid a) => Evt m a -> m a
folds :: Evt m a -> m a
folds = (a -> a -> a) -> a -> Evt m a -> m a
forall (m :: * -> *) b a.
Frp m =>
(b -> a -> b) -> b -> Evt m a -> m b
foldls a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>) a
forall a. Monoid a => a
mempty
foldls :: (Frp m) => (b -> a -> b) -> b -> Evt m a -> m b
foldls :: (b -> a -> b) -> b -> Evt m a -> m b
foldls b -> a -> b
f b
s Evt m a
evt = do
Ref m b
ref <- Evt m a -> b -> m (Ref m b)
forall (m :: * -> *) a b. Frp m => Evt m a -> b -> m (Ref m b)
proxyNewRef Evt m a
evt b
s
Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt ((a -> m ()) -> m ()) -> (a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \a
x -> IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m b -> (b -> b) -> IO ()
forall (ref :: * -> *) a. IsRef ref => ref a -> (a -> a) -> IO ()
modifyRef Ref m b
ref ((b -> b) -> IO ()) -> (b -> b) -> IO ()
forall a b. (a -> b) -> a -> b
$ (b -> a -> b) -> a -> b -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip b -> a -> b
f a
x
IO b -> m b
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO b -> m b) -> IO b -> m b
forall a b. (a -> b) -> a -> b
$ Ref m b -> IO b
forall (ref :: * -> *) a. IsRef ref => ref a -> IO a
readRef Ref m b
ref
foldls' :: (Frp m) => (b -> a -> m b) -> b -> Evt m a -> m b
foldls' :: (b -> a -> m b) -> b -> Evt m a -> m b
foldls' b -> a -> m b
f b
s Evt m a
evt = do
Ref m b
ref <- Evt m a -> b -> m (Ref m b)
forall (m :: * -> *) a b. Frp m => Evt m a -> b -> m (Ref m b)
proxyNewRef Evt m a
evt b
s
Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt ((a -> m ()) -> m ()) -> (a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \a
x -> IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (b -> IO ()) -> b -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ref m b -> b -> IO ()
forall (ref :: * -> *) a. IsRef ref => ref a -> a -> IO ()
writeRef Ref m b
ref (b -> m ()) -> m b -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (b -> a -> m b) -> a -> b -> m b
forall a b c. (a -> b -> c) -> b -> a -> c
flip b -> a -> m b
f a
x (b -> m b) -> m b -> m b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO b -> m b
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Ref m b -> IO b
forall (ref :: * -> *) a. IsRef ref => ref a -> IO a
readRef Ref m b
ref)
IO b -> m b
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO b -> m b) -> IO b -> m b
forall a b. (a -> b) -> a -> b
$ Ref m b -> IO b
forall (ref :: * -> *) a. IsRef ref => ref a -> IO a
readRef Ref m b
ref
foldrs :: (Frp m) => (a -> b -> b) -> b -> Evt m a -> m b
foldrs :: (a -> b -> b) -> b -> Evt m a -> m b
foldrs a -> b -> b
f b
s Evt m a
evt = do
Ref m b
ref <- Evt m a -> b -> m (Ref m b)
forall (m :: * -> *) a b. Frp m => Evt m a -> b -> m (Ref m b)
proxyNewRef Evt m a
evt b
s
Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt ((a -> m ()) -> m ()) -> (a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \a
x -> IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m b -> (b -> b) -> IO ()
forall (ref :: * -> *) a. IsRef ref => ref a -> (a -> a) -> IO ()
modifyRef Ref m b
ref ((b -> b) -> IO ()) -> (b -> b) -> IO ()
forall a b. (a -> b) -> a -> b
$ a -> b -> b
f a
x
IO b -> m b
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO b -> m b) -> IO b -> m b
forall a b. (a -> b) -> a -> b
$ Ref m b -> IO b
forall (ref :: * -> *) a. IsRef ref => ref a -> IO a
readRef Ref m b
ref
foldrs' :: (Frp m) => (a -> b -> m b) -> b -> Evt m a -> m b
foldrs' :: (a -> b -> m b) -> b -> Evt m a -> m b
foldrs' a -> b -> m b
f b
s Evt m a
evt = do
Ref m b
ref <- Evt m a -> b -> m (Ref m b)
forall (m :: * -> *) a b. Frp m => Evt m a -> b -> m (Ref m b)
proxyNewRef Evt m a
evt b
s
Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt ((a -> m ()) -> m ()) -> (a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \a
x -> IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (b -> IO ()) -> b -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ref m b -> b -> IO ()
forall (ref :: * -> *) a. IsRef ref => ref a -> a -> IO ()
writeRef Ref m b
ref (b -> m ()) -> m b -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< a -> b -> m b
f a
x (b -> m b) -> m b -> m b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO b -> m b
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Ref m b -> IO b
forall (ref :: * -> *) a. IsRef ref => ref a -> IO a
readRef Ref m b
ref)
IO b -> m b
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO b -> m b) -> IO b -> m b
forall a b. (a -> b) -> a -> b
$ Ref m b -> IO b
forall (ref :: * -> *) a. IsRef ref => ref a -> IO a
readRef Ref m b
ref
prints :: (Frp m, Show a) => Evt m a -> m ()
prints :: Evt m a -> m ()
prints Evt m a
evt = Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt (IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (a -> IO ()) -> a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> IO ()
forall a. Show a => a -> IO ()
print)
putStrLns :: (Frp m) => Evt m String -> m ()
putStrLns :: Evt m String -> m ()
putStrLns Evt m String
evt = Evt m String -> (String -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m String
evt (IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (String -> IO ()) -> String -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
putStrLn)
getLines :: Frp m => Evt m String
getLines :: Evt m String
getLines = m String -> Evt m String
forall (m :: * -> *) a. Frp m => m a -> Evt m a
once (IO String -> m String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO String
getLine)
switchDyn :: Frp m => Dyn m (Evt m a) -> Evt m a
switchDyn :: Dyn m (Evt m a) -> Evt m a
switchDyn Dyn m (Evt m a)
dyn = ((a -> m ()) -> m ()) -> Evt m a
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((a -> m ()) -> m ()) -> Evt m a)
-> ((a -> m ()) -> m ()) -> Evt m a
forall a b. (a -> b) -> a -> b
$ \a -> m ()
go -> do
DynRef m (Evt m a)
ref <- Dyn m (Evt m a) -> m (DynRef m (Evt m a))
forall (m :: * -> *) a. Frp m => Dyn m a -> m (DynRef m a)
runDyn Dyn m (Evt m a)
dyn
Evt m a
evt <- DynRef m (Evt m a) -> m (Evt m a)
forall (m :: * -> *) a. Frp m => DynRef m a -> m a
readDyn DynRef m (Evt m a)
ref
Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt a -> m ()
go
joins :: Frp m => Evt m (Evt m a) -> Evt m a
joins :: Evt m (Evt m a) -> Evt m a
joins Evt m (Evt m a)
evt = ((a -> m ()) -> m ()) -> Evt m a
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((a -> m ()) -> m ()) -> Evt m a)
-> ((a -> m ()) -> m ()) -> Evt m a
forall a b. (a -> b) -> a -> b
$ \a -> m ()
go ->
Evt m (Evt m a) -> (Evt m a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m (Evt m a)
evt ((Evt m a -> m ()) -> m ()) -> (Evt m a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Evt m a
e -> m ThreadId -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m ThreadId -> m ()) -> m ThreadId -> m ()
forall a b. (a -> b) -> a -> b
$ m () -> m ThreadId
forall (m :: * -> *). MonadBaseControl IO m => m () -> m ThreadId
fork (m () -> m ThreadId) -> m () -> m ThreadId
forall a b. (a -> b) -> a -> b
$ Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
e a -> m ()
go
fix1 :: Frp m => (Evt m a -> m (Evt m a)) -> Evt m a
fix1 :: (Evt m a -> m (Evt m a)) -> Evt m a
fix1 Evt m a -> m (Evt m a)
f = ((a -> m ()) -> m ()) -> Evt m a
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((a -> m ()) -> m ()) -> Evt m a)
-> ((a -> m ()) -> m ()) -> Evt m a
forall a b. (a -> b) -> a -> b
$ \a -> m ()
go -> do
(InChan a, OutChan a)
chan <- IO (InChan a, OutChan a) -> m (InChan a, OutChan a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (InChan a, OutChan a)
forall a. IO (InChan a, OutChan a)
U.newChan
let evt :: Evt m a
evt = InChan a -> Evt m a
forall (m :: * -> *) a. Frp m => InChan a -> Evt m a
uchanEvt ((InChan a, OutChan a) -> InChan a
forall a b. (a, b) -> a
fst (InChan a, OutChan a)
chan)
Evt m a
evt' <- Evt m a -> m (Evt m a)
f Evt m a
evt
Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt' ((a -> m ()) -> m ()) -> (a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \a
x -> do
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ InChan a -> a -> IO ()
forall a. InChan a -> a -> IO ()
U.writeChan ((InChan a, OutChan a) -> InChan a
forall a b. (a, b) -> a
fst (InChan a, OutChan a)
chan) a
x
a -> m ()
go a
x
fix2 :: Frp m => (Evt m a -> Evt m b -> m (Evt m a, Evt m b)) -> (Evt m a, Evt m b)
fix2 :: (Evt m a -> Evt m b -> m (Evt m a, Evt m b)) -> (Evt m a, Evt m b)
fix2 Evt m a -> Evt m b -> m (Evt m a, Evt m b)
f = Evt m (Either a b) -> (Evt m a, Evt m b)
forall (m :: * -> *) a b.
Frp m =>
Evt m (Either a b) -> (Evt m a, Evt m b)
splits (Evt m (Either a b) -> (Evt m a, Evt m b))
-> Evt m (Either a b) -> (Evt m a, Evt m b)
forall a b. (a -> b) -> a -> b
$ (Evt m (Either a b) -> m (Evt m (Either a b)))
-> Evt m (Either a b)
forall (m :: * -> *) a.
Frp m =>
(Evt m a -> m (Evt m a)) -> Evt m a
fix1 Evt m (Either a b) -> m (Evt m (Either a b))
g
where
g :: Evt m (Either a b) -> m (Evt m (Either a b))
g Evt m (Either a b)
x = (Evt m a, Evt m b) -> Evt m (Either a b)
forall (f :: * -> *) a b.
(Semigroup (f (Either a b)), Functor f) =>
(f a, f b) -> f (Either a b)
wrap ((Evt m a, Evt m b) -> Evt m (Either a b))
-> m (Evt m a, Evt m b) -> m (Evt m (Either a b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Evt m a -> Evt m b -> m (Evt m a, Evt m b)
f (Evt m (Either a b) -> Evt m a
forall (m :: * -> *) a b. Frp m => Evt m (Either a b) -> Evt m a
lefts Evt m (Either a b)
x) (Evt m (Either a b) -> Evt m b
forall (m :: * -> *) a b. Frp m => Evt m (Either a b) -> Evt m b
rights Evt m (Either a b)
x)
wrap :: (f a, f b) -> f (Either a b)
wrap (f a
a, f b
b) = (a -> Either a b
forall a b. a -> Either a b
Left (a -> Either a b) -> f a -> f (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> )f a
a f (Either a b) -> f (Either a b) -> f (Either a b)
forall a. Semigroup a => a -> a -> a
<> (b -> Either a b
forall a b. b -> Either a b
Right (b -> Either a b) -> f b -> f (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f b
b)
data Tag3 a b c = TagA3 a | TagB3 b | TagC3 c
fix3 :: Frp m
=> (Evt m a -> Evt m b -> Evt m c -> m (Evt m a, Evt m b, Evt m c))
-> (Evt m a, Evt m b, Evt m c)
fix3 :: (Evt m a -> Evt m b -> Evt m c -> m (Evt m a, Evt m b, Evt m c))
-> (Evt m a, Evt m b, Evt m c)
fix3 Evt m a -> Evt m b -> Evt m c -> m (Evt m a, Evt m b, Evt m c)
f = Evt m (Tag3 a b c) -> (Evt m a, Evt m b, Evt m c)
unwrap (Evt m (Tag3 a b c) -> (Evt m a, Evt m b, Evt m c))
-> Evt m (Tag3 a b c) -> (Evt m a, Evt m b, Evt m c)
forall a b. (a -> b) -> a -> b
$ (Evt m (Tag3 a b c) -> m (Evt m (Tag3 a b c)))
-> Evt m (Tag3 a b c)
forall (m :: * -> *) a.
Frp m =>
(Evt m a -> m (Evt m a)) -> Evt m a
fix1 Evt m (Tag3 a b c) -> m (Evt m (Tag3 a b c))
g
where
g :: Evt m (Tag3 a b c) -> m (Evt m (Tag3 a b c))
g Evt m (Tag3 a b c)
x = (Evt m a, Evt m b, Evt m c) -> Evt m (Tag3 a b c)
forall (f :: * -> *) a b c.
(Semigroup (f (Tag3 a b c)), Functor f) =>
(f a, f b, f c) -> f (Tag3 a b c)
wrap ((Evt m a, Evt m b, Evt m c) -> Evt m (Tag3 a b c))
-> m (Evt m a, Evt m b, Evt m c) -> m (Evt m (Tag3 a b c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Evt m a -> Evt m b -> Evt m c -> m (Evt m a, Evt m b, Evt m c)
f (Evt m (Tag3 a b c) -> Evt m a
forall b b c. Evt m (Tag3 b b c) -> Evt m b
unwrapA Evt m (Tag3 a b c)
x) (Evt m (Tag3 a b c) -> Evt m b
forall a b c. Evt m (Tag3 a b c) -> Evt m b
unwrapB Evt m (Tag3 a b c)
x) (Evt m (Tag3 a b c) -> Evt m c
forall a b b. Evt m (Tag3 a b b) -> Evt m b
unwrapC Evt m (Tag3 a b c)
x)
wrap :: (f a, f b, f c) -> f (Tag3 a b c)
wrap (f a
a, f b
b, f c
c) = (a -> Tag3 a b c
forall a b c. a -> Tag3 a b c
TagA3 (a -> Tag3 a b c) -> f a -> f (Tag3 a b c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
a) f (Tag3 a b c) -> f (Tag3 a b c) -> f (Tag3 a b c)
forall a. Semigroup a => a -> a -> a
<> (b -> Tag3 a b c
forall a b c. b -> Tag3 a b c
TagB3 (b -> Tag3 a b c) -> f b -> f (Tag3 a b c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f b
b) f (Tag3 a b c) -> f (Tag3 a b c) -> f (Tag3 a b c)
forall a. Semigroup a => a -> a -> a
<> (c -> Tag3 a b c
forall a b c. c -> Tag3 a b c
TagC3 (c -> Tag3 a b c) -> f c -> f (Tag3 a b c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f c
c)
unwrap :: Evt m (Tag3 a b c) -> (Evt m a, Evt m b, Evt m c)
unwrap Evt m (Tag3 a b c)
x = (Evt m (Tag3 a b c) -> Evt m a
forall b b c. Evt m (Tag3 b b c) -> Evt m b
unwrapA Evt m (Tag3 a b c)
x, Evt m (Tag3 a b c) -> Evt m b
forall a b c. Evt m (Tag3 a b c) -> Evt m b
unwrapB Evt m (Tag3 a b c)
x, Evt m (Tag3 a b c) -> Evt m c
forall a b b. Evt m (Tag3 a b b) -> Evt m b
unwrapC Evt m (Tag3 a b c)
x)
unwrapA :: Evt m (Tag3 b b c) -> Evt m b
unwrapA = (Tag3 b b c -> Maybe b) -> Evt m (Tag3 b b c) -> Evt m b
forall (m :: * -> *) a b.
Frp m =>
(a -> Maybe b) -> Evt m a -> Evt m b
mapMay ((Tag3 b b c -> Maybe b) -> Evt m (Tag3 b b c) -> Evt m b)
-> (Tag3 b b c -> Maybe b) -> Evt m (Tag3 b b c) -> Evt m b
forall a b. (a -> b) -> a -> b
$ \case
TagA3 b
a -> b -> Maybe b
forall a. a -> Maybe a
Just b
a
Tag3 b b c
_ -> Maybe b
forall a. Maybe a
Nothing
unwrapB :: Evt m (Tag3 a b c) -> Evt m b
unwrapB = (Tag3 a b c -> Maybe b) -> Evt m (Tag3 a b c) -> Evt m b
forall (m :: * -> *) a b.
Frp m =>
(a -> Maybe b) -> Evt m a -> Evt m b
mapMay ((Tag3 a b c -> Maybe b) -> Evt m (Tag3 a b c) -> Evt m b)
-> (Tag3 a b c -> Maybe b) -> Evt m (Tag3 a b c) -> Evt m b
forall a b. (a -> b) -> a -> b
$ \case
TagB3 b
a -> b -> Maybe b
forall a. a -> Maybe a
Just b
a
Tag3 a b c
_ -> Maybe b
forall a. Maybe a
Nothing
unwrapC :: Evt m (Tag3 a b b) -> Evt m b
unwrapC = (Tag3 a b b -> Maybe b) -> Evt m (Tag3 a b b) -> Evt m b
forall (m :: * -> *) a b.
Frp m =>
(a -> Maybe b) -> Evt m a -> Evt m b
mapMay ((Tag3 a b b -> Maybe b) -> Evt m (Tag3 a b b) -> Evt m b)
-> (Tag3 a b b -> Maybe b) -> Evt m (Tag3 a b b) -> Evt m b
forall a b. (a -> b) -> a -> b
$ \case
TagC3 b
a -> b -> Maybe b
forall a. a -> Maybe a
Just b
a
Tag3 a b b
_ -> Maybe b
forall a. Maybe a
Nothing
data Tag4 a b c d = TagA4 a | TagB4 b | TagC4 c | TagD4 d
fix4 :: Frp m =>
(Evt m a -> Evt m b -> Evt m c -> Evt m d -> m (Evt m a, Evt m b, Evt m c, Evt m d))
-> (Evt m a, Evt m b, Evt m c, Evt m d)
fix4 :: (Evt m a
-> Evt m b
-> Evt m c
-> Evt m d
-> m (Evt m a, Evt m b, Evt m c, Evt m d))
-> (Evt m a, Evt m b, Evt m c, Evt m d)
fix4 Evt m a
-> Evt m b
-> Evt m c
-> Evt m d
-> m (Evt m a, Evt m b, Evt m c, Evt m d)
f = Evt m (Tag4 a b c d) -> (Evt m a, Evt m b, Evt m c, Evt m d)
unwrap (Evt m (Tag4 a b c d) -> (Evt m a, Evt m b, Evt m c, Evt m d))
-> Evt m (Tag4 a b c d) -> (Evt m a, Evt m b, Evt m c, Evt m d)
forall a b. (a -> b) -> a -> b
$ (Evt m (Tag4 a b c d) -> m (Evt m (Tag4 a b c d)))
-> Evt m (Tag4 a b c d)
forall (m :: * -> *) a.
Frp m =>
(Evt m a -> m (Evt m a)) -> Evt m a
fix1 Evt m (Tag4 a b c d) -> m (Evt m (Tag4 a b c d))
g
where
g :: Evt m (Tag4 a b c d) -> m (Evt m (Tag4 a b c d))
g Evt m (Tag4 a b c d)
x = (Evt m a, Evt m b, Evt m c, Evt m d) -> Evt m (Tag4 a b c d)
forall (f :: * -> *) a b c d.
(Semigroup (f (Tag4 a b c d)), Functor f) =>
(f a, f b, f c, f d) -> f (Tag4 a b c d)
wrap ((Evt m a, Evt m b, Evt m c, Evt m d) -> Evt m (Tag4 a b c d))
-> m (Evt m a, Evt m b, Evt m c, Evt m d)
-> m (Evt m (Tag4 a b c d))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Evt m a
-> Evt m b
-> Evt m c
-> Evt m d
-> m (Evt m a, Evt m b, Evt m c, Evt m d)
f (Evt m (Tag4 a b c d) -> Evt m a
forall b b c d. Evt m (Tag4 b b c d) -> Evt m b
unwrapA Evt m (Tag4 a b c d)
x) (Evt m (Tag4 a b c d) -> Evt m b
forall a b c d. Evt m (Tag4 a b c d) -> Evt m b
unwrapB Evt m (Tag4 a b c d)
x) (Evt m (Tag4 a b c d) -> Evt m c
forall a b b d. Evt m (Tag4 a b b d) -> Evt m b
unwrapC Evt m (Tag4 a b c d)
x) (Evt m (Tag4 a b c d) -> Evt m d
forall a b c b. Evt m (Tag4 a b c b) -> Evt m b
unwrapD Evt m (Tag4 a b c d)
x)
wrap :: (f a, f b, f c, f d) -> f (Tag4 a b c d)
wrap (f a
a, f b
b, f c
c, f d
d) = (a -> Tag4 a b c d
forall a b c d. a -> Tag4 a b c d
TagA4 (a -> Tag4 a b c d) -> f a -> f (Tag4 a b c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
a) f (Tag4 a b c d) -> f (Tag4 a b c d) -> f (Tag4 a b c d)
forall a. Semigroup a => a -> a -> a
<> (b -> Tag4 a b c d
forall a b c d. b -> Tag4 a b c d
TagB4 (b -> Tag4 a b c d) -> f b -> f (Tag4 a b c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f b
b) f (Tag4 a b c d) -> f (Tag4 a b c d) -> f (Tag4 a b c d)
forall a. Semigroup a => a -> a -> a
<> (c -> Tag4 a b c d
forall a b c d. c -> Tag4 a b c d
TagC4 (c -> Tag4 a b c d) -> f c -> f (Tag4 a b c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f c
c) f (Tag4 a b c d) -> f (Tag4 a b c d) -> f (Tag4 a b c d)
forall a. Semigroup a => a -> a -> a
<> (d -> Tag4 a b c d
forall a b c d. d -> Tag4 a b c d
TagD4 (d -> Tag4 a b c d) -> f d -> f (Tag4 a b c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f d
d)
unwrap :: Evt m (Tag4 a b c d) -> (Evt m a, Evt m b, Evt m c, Evt m d)
unwrap Evt m (Tag4 a b c d)
x = (Evt m (Tag4 a b c d) -> Evt m a
forall b b c d. Evt m (Tag4 b b c d) -> Evt m b
unwrapA Evt m (Tag4 a b c d)
x, Evt m (Tag4 a b c d) -> Evt m b
forall a b c d. Evt m (Tag4 a b c d) -> Evt m b
unwrapB Evt m (Tag4 a b c d)
x, Evt m (Tag4 a b c d) -> Evt m c
forall a b b d. Evt m (Tag4 a b b d) -> Evt m b
unwrapC Evt m (Tag4 a b c d)
x, Evt m (Tag4 a b c d) -> Evt m d
forall a b c b. Evt m (Tag4 a b c b) -> Evt m b
unwrapD Evt m (Tag4 a b c d)
x)
unwrapA :: Evt m (Tag4 b b c d) -> Evt m b
unwrapA = (Tag4 b b c d -> Maybe b) -> Evt m (Tag4 b b c d) -> Evt m b
forall (m :: * -> *) a b.
Frp m =>
(a -> Maybe b) -> Evt m a -> Evt m b
mapMay ((Tag4 b b c d -> Maybe b) -> Evt m (Tag4 b b c d) -> Evt m b)
-> (Tag4 b b c d -> Maybe b) -> Evt m (Tag4 b b c d) -> Evt m b
forall a b. (a -> b) -> a -> b
$ \case
TagA4 b
a -> b -> Maybe b
forall a. a -> Maybe a
Just b
a
Tag4 b b c d
_ -> Maybe b
forall a. Maybe a
Nothing
unwrapB :: Evt m (Tag4 a b c d) -> Evt m b
unwrapB = (Tag4 a b c d -> Maybe b) -> Evt m (Tag4 a b c d) -> Evt m b
forall (m :: * -> *) a b.
Frp m =>
(a -> Maybe b) -> Evt m a -> Evt m b
mapMay ((Tag4 a b c d -> Maybe b) -> Evt m (Tag4 a b c d) -> Evt m b)
-> (Tag4 a b c d -> Maybe b) -> Evt m (Tag4 a b c d) -> Evt m b
forall a b. (a -> b) -> a -> b
$ \case
TagB4 b
a -> b -> Maybe b
forall a. a -> Maybe a
Just b
a
Tag4 a b c d
_ -> Maybe b
forall a. Maybe a
Nothing
unwrapC :: Evt m (Tag4 a b b d) -> Evt m b
unwrapC = (Tag4 a b b d -> Maybe b) -> Evt m (Tag4 a b b d) -> Evt m b
forall (m :: * -> *) a b.
Frp m =>
(a -> Maybe b) -> Evt m a -> Evt m b
mapMay ((Tag4 a b b d -> Maybe b) -> Evt m (Tag4 a b b d) -> Evt m b)
-> (Tag4 a b b d -> Maybe b) -> Evt m (Tag4 a b b d) -> Evt m b
forall a b. (a -> b) -> a -> b
$ \case
TagC4 b
a -> b -> Maybe b
forall a. a -> Maybe a
Just b
a
Tag4 a b b d
_ -> Maybe b
forall a. Maybe a
Nothing
unwrapD :: Evt m (Tag4 a b c b) -> Evt m b
unwrapD = (Tag4 a b c b -> Maybe b) -> Evt m (Tag4 a b c b) -> Evt m b
forall (m :: * -> *) a b.
Frp m =>
(a -> Maybe b) -> Evt m a -> Evt m b
mapMay ((Tag4 a b c b -> Maybe b) -> Evt m (Tag4 a b c b) -> Evt m b)
-> (Tag4 a b c b -> Maybe b) -> Evt m (Tag4 a b c b) -> Evt m b
forall a b. (a -> b) -> a -> b
$ \case
TagD4 b
a -> b -> Maybe b
forall a. a -> Maybe a
Just b
a
Tag4 a b c b
_ -> Maybe b
forall a. Maybe a
Nothing
switch :: Frp m => Evt m (Evt m a) -> Evt m a
switch :: Evt m (Evt m a) -> Evt m a
switch Evt m (Evt m a)
evts = ((a -> m ()) -> m ()) -> Evt m a
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((a -> m ()) -> m ()) -> Evt m a)
-> ((a -> m ()) -> m ()) -> Evt m a
forall a b. (a -> b) -> a -> b
$ \a -> m ()
go -> do
Ref m (Maybe ThreadId)
tidRef <- Evt m (Evt m a) -> Maybe ThreadId -> m (Ref m (Maybe ThreadId))
forall (m :: * -> *) a b. Frp m => Evt m a -> b -> m (Ref m b)
proxyNewRef Evt m (Evt m a)
evts Maybe ThreadId
forall a. Maybe a
Nothing
let stop :: m ()
stop = (ThreadId -> m ()) -> Maybe ThreadId -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ThreadId -> m ()
forall (m :: * -> *). MonadBase IO m => ThreadId -> m ()
killThread (Maybe ThreadId -> m ()) -> m (Maybe ThreadId) -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (Maybe ThreadId) -> m (Maybe ThreadId)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Ref m (Maybe ThreadId) -> IO (Maybe ThreadId)
forall (ref :: * -> *) a. IsRef ref => ref a -> IO a
readRef Ref m (Maybe ThreadId)
tidRef)
MVar ()
lock <- m (MVar ())
forall (m :: * -> *) a. MonadBase IO m => m (MVar a)
newEmptyMVar
Evt m (Evt m a) -> (Evt m a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m (Evt m a)
evts (\Evt m a
evt -> do
m ()
stop
ThreadId
tid <- m () -> m ThreadId
forall (m :: * -> *). MonadBaseControl IO m => m () -> m ThreadId
fork (MVar () -> m ()
forall (m :: * -> *) a. MonadBase IO m => MVar a -> m a
takeMVar MVar ()
lock m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt a -> m ()
go)
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe ThreadId) -> Maybe ThreadId -> IO ()
forall (ref :: * -> *) a. IsRef ref => ref a -> a -> IO ()
writeRef Ref m (Maybe ThreadId)
tidRef (ThreadId -> Maybe ThreadId
forall a. a -> Maybe a
Just ThreadId
tid)
MVar () -> () -> m ()
forall (m :: * -> *) a. MonadBase IO m => MVar a -> a -> m ()
putMVar MVar ()
lock ()
) m () -> m () -> m ()
forall (m :: * -> *) a b.
MonadBaseControl IO m =>
m a -> m b -> m a
`finally` m ()
stop
switchD :: Frp m => Dyn m a -> Evt m (Dyn m a) -> Dyn m a
switchD :: Dyn m a -> Evt m (Dyn m a) -> Dyn m a
switchD Dyn m a
d Evt m (Dyn m a)
evts = (DynRef m a -> m a)
-> Evt m (DynRef m a) -> m (DynRef m a) -> m () -> Dyn m a
forall (m :: * -> *) a s.
(s -> m a) -> Evt m s -> m s -> m () -> Dyn m a
Dyn DynRef m a -> m a
forall a. DynRef m a -> m a
extract Evt m (DynRef m a)
resEvt m (DynRef m a)
init (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
where
init :: m (DynRef m a)
init = Dyn m a -> m (DynRef m a)
forall (m :: * -> *) a. Frp m => Dyn m a -> m (DynRef m a)
runDyn Dyn m a
d
extract :: DynRef m a -> m a
extract = DynRef m a -> m a
forall (m :: * -> *) a. Frp m => DynRef m a -> m a
readDyn
resEvt :: Evt m (DynRef m a)
resEvt = ((DynRef m a -> m ()) -> m ()) -> Evt m (DynRef m a)
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((DynRef m a -> m ()) -> m ()) -> Evt m (DynRef m a))
-> ((DynRef m a -> m ()) -> m ()) -> Evt m (DynRef m a)
forall a b. (a -> b) -> a -> b
$ \DynRef m a -> m ()
go -> do
Evt m (Dyn m a) -> (Dyn m a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m (Dyn m a)
evts ((Dyn m a -> m ()) -> m ()) -> (Dyn m a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Dyn m a
dyn -> do
DynRef m a
ref <- Dyn m a -> m (DynRef m a)
forall (m :: * -> *) a. Frp m => Dyn m a -> m (DynRef m a)
runDyn Dyn m a
dyn
DynRef m a -> m ()
go DynRef m a
ref m () -> m () -> m ()
forall (m :: * -> *) a b.
MonadBaseControl IO m =>
m a -> m b -> m a
`finally` DynRef m a -> m ()
forall (m :: * -> *) a. Frp m => DynRef m a -> m ()
cancelDyn DynRef m a
ref
mchanEvt :: (Frp m) => M.Chan a -> Evt m a
mchanEvt :: Chan a -> Evt m a
mchanEvt Chan a
chan = ((a -> m ()) -> m ()) -> Evt m a
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((a -> m ()) -> m ()) -> Evt m a)
-> ((a -> m ()) -> m ()) -> Evt m a
forall a b. (a -> b) -> a -> b
$ \a -> m ()
go -> do
Chan a
chan <- IO (Chan a) -> m (Chan a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Chan a) -> m (Chan a)) -> IO (Chan a) -> m (Chan a)
forall a b. (a -> b) -> a -> b
$ Chan a -> IO (Chan a)
forall a. Chan a -> IO (Chan a)
M.dupChan Chan a
chan
Chan a -> (a -> m ()) -> m ()
forall (m :: * -> *) t a b.
MonadIO m =>
Chan t -> (t -> m a) -> m b
loop Chan a
chan a -> m ()
go
where
loop :: Chan t -> (t -> m a) -> m b
loop Chan t
chan t -> m a
go = do
t
a <- IO t -> m t
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO t -> m t) -> IO t -> m t
forall a b. (a -> b) -> a -> b
$ Chan t -> IO t
forall a. Chan a -> IO a
M.readChan Chan t
chan
t -> m a
go t
a
Chan t -> (t -> m a) -> m b
loop Chan t
chan t -> m a
go
tchanEvt :: (Frp m) => TChan a -> Evt m a
tchanEvt :: TChan a -> Evt m a
tchanEvt TChan a
chan = ((a -> m ()) -> m ()) -> Evt m a
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((a -> m ()) -> m ()) -> Evt m a)
-> ((a -> m ()) -> m ()) -> Evt m a
forall a b. (a -> b) -> a -> b
$ \a -> m ()
go -> do
TChan a
chan <- IO (TChan a) -> m (TChan a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (TChan a) -> m (TChan a)) -> IO (TChan a) -> m (TChan a)
forall a b. (a -> b) -> a -> b
$ STM (TChan a) -> IO (TChan a)
forall a. STM a -> IO a
atomically (STM (TChan a) -> IO (TChan a)) -> STM (TChan a) -> IO (TChan a)
forall a b. (a -> b) -> a -> b
$ TChan a -> STM (TChan a)
forall a. TChan a -> STM (TChan a)
dupTChan TChan a
chan
TChan a -> (a -> m ()) -> m ()
forall (m :: * -> *) t a b.
MonadIO m =>
TChan t -> (t -> m a) -> m b
loop TChan a
chan a -> m ()
go
where
loop :: TChan t -> (t -> m a) -> m b
loop TChan t
chan t -> m a
go = do
t
a <- IO t -> m t
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO t -> m t) -> IO t -> m t
forall a b. (a -> b) -> a -> b
$ STM t -> IO t
forall a. STM a -> IO a
atomically (STM t -> IO t) -> STM t -> IO t
forall a b. (a -> b) -> a -> b
$ TChan t -> STM t
forall a. TChan a -> STM a
readTChan TChan t
chan
t -> m a
go t
a
TChan t -> (t -> m a) -> m b
loop TChan t
chan t -> m a
go
uchanEvt :: (Frp m) => InChan a -> Evt m a
uchanEvt :: InChan a -> Evt m a
uchanEvt InChan a
chan = ((a -> m ()) -> m ()) -> Evt m a
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((a -> m ()) -> m ()) -> Evt m a)
-> ((a -> m ()) -> m ()) -> Evt m a
forall a b. (a -> b) -> a -> b
$ \a -> m ()
go -> do
OutChan a
chan <- IO (OutChan a) -> m (OutChan a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (OutChan a) -> m (OutChan a))
-> IO (OutChan a) -> m (OutChan a)
forall a b. (a -> b) -> a -> b
$ InChan a -> IO (OutChan a)
forall a. InChan a -> IO (OutChan a)
U.dupChan InChan a
chan
OutChan a -> (a -> m ()) -> m ()
forall (m :: * -> *) t a b.
MonadIO m =>
OutChan t -> (t -> m a) -> m b
loop OutChan a
chan a -> m ()
go
where
loop :: OutChan t -> (t -> m a) -> m b
loop OutChan t
chan t -> m a
go = do
t
a <- IO t -> m t
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO t -> m t) -> IO t -> m t
forall a b. (a -> b) -> a -> b
$ OutChan t -> IO t
forall a. OutChan a -> IO a
U.readChan OutChan t
chan
t -> m a
go t
a
OutChan t -> (t -> m a) -> m b
loop OutChan t
chan t -> m a
go
type UChan a = (U.InChan a, U.OutChan a)
proxyNewRef :: Frp m => Evt m a -> b -> m (Ref m b)
proxyNewRef :: Evt m a -> b -> m (Ref m b)
proxyNewRef Evt m a
_ b
v = IO (Ref m b) -> m (Ref m b)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ref m b) -> m (Ref m b)) -> IO (Ref m b) -> m (Ref m b)
forall a b. (a -> b) -> a -> b
$ b -> IO (Ref m b)
forall (ref :: * -> *) a. IsRef ref => a -> IO (ref a)
newRef b
v
proxyNewRefDyn :: Frp m => Dyn m a -> b -> m (Ref m b)
proxyNewRefDyn :: Dyn m a -> b -> m (Ref m b)
proxyNewRefDyn Dyn m a
_ b
v = IO (Ref m b) -> m (Ref m b)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ref m b) -> m (Ref m b)) -> IO (Ref m b) -> m (Ref m b)
forall a b. (a -> b) -> a -> b
$ b -> IO (Ref m b)
forall (ref :: * -> *) a. IsRef ref => a -> IO (ref a)
newRef b
v
proxyFunRes :: (a -> b) -> b
proxyFunRes :: (a -> b) -> b
proxyFunRes a -> b
_ = b
forall a. HasCallStack => a
undefined
clock :: Frp m => NominalDiffTime -> Evt m UTCTime
clock :: NominalDiffTime -> Evt m UTCTime
clock NominalDiffTime
t = ((UTCTime -> m ()) -> m ()) -> Evt m UTCTime
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((UTCTime -> m ()) -> m ()) -> Evt m UTCTime)
-> ((UTCTime -> m ()) -> m ()) -> Evt m UTCTime
forall a b. (a -> b) -> a -> b
$ \UTCTime -> m ()
go -> NominalDiffTime -> m () -> m ()
forall (m :: * -> *). MonadIO m => NominalDiffTime -> m () -> m ()
periodic NominalDiffTime
t (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ UTCTime -> m ()
go (UTCTime -> m ()) -> m UTCTime -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO UTCTime -> m UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
pulse :: Frp m => NominalDiffTime -> Evt m ()
pulse :: NominalDiffTime -> Evt m ()
pulse NominalDiffTime
t = ((() -> m ()) -> m ()) -> Evt m ()
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((() -> m ()) -> m ()) -> Evt m ())
-> ((() -> m ()) -> m ()) -> Evt m ()
forall a b. (a -> b) -> a -> b
$ \() -> m ()
go -> NominalDiffTime -> m () -> m ()
forall (m :: * -> *). MonadIO m => NominalDiffTime -> m () -> m ()
periodic NominalDiffTime
t (() -> m ()
go ())
ticks :: Frp m => NominalDiffTime -> Evt m NominalDiffTime
ticks :: NominalDiffTime -> Evt m NominalDiffTime
ticks NominalDiffTime
t = ((NominalDiffTime -> m ()) -> m ()) -> Evt m NominalDiffTime
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((NominalDiffTime -> m ()) -> m ()) -> Evt m NominalDiffTime)
-> ((NominalDiffTime -> m ()) -> m ()) -> Evt m NominalDiffTime
forall a b. (a -> b) -> a -> b
$ \NominalDiffTime -> m ()
go -> do
IORef UTCTime
startRef <- IO (IORef UTCTime) -> m (IORef UTCTime)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef UTCTime) -> m (IORef UTCTime))
-> IO (IORef UTCTime) -> m (IORef UTCTime)
forall a b. (a -> b) -> a -> b
$ UTCTime -> IO (IORef UTCTime)
forall a. a -> IO (IORef a)
newIORef (UTCTime -> IO (IORef UTCTime)) -> IO UTCTime -> IO (IORef UTCTime)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO UTCTime
getCurrentTime
NominalDiffTime -> m () -> m ()
forall (m :: * -> *). MonadIO m => NominalDiffTime -> m () -> m ()
periodic NominalDiffTime
t (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
NominalDiffTime
dt <- IO NominalDiffTime -> m NominalDiffTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO NominalDiffTime -> m NominalDiffTime)
-> IO NominalDiffTime -> m NominalDiffTime
forall a b. (a -> b) -> a -> b
$ do
UTCTime
cur <- IO UTCTime
getCurrentTime
UTCTime
start <- IORef UTCTime -> IO UTCTime
forall a. IORef a -> IO a
readIORef IORef UTCTime
startRef
IORef UTCTime -> UTCTime -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef UTCTime
startRef UTCTime
cur
NominalDiffTime -> IO NominalDiffTime
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NominalDiffTime -> IO NominalDiffTime)
-> NominalDiffTime -> IO NominalDiffTime
forall a b. (a -> b) -> a -> b
$ UTCTime
cur UTCTime -> UTCTime -> NominalDiffTime
`diffUTCTime` UTCTime
start
NominalDiffTime -> m ()
go NominalDiffTime
dt
timer :: Frp m => NominalDiffTime -> Evt m NominalDiffTime
timer :: NominalDiffTime -> Evt m NominalDiffTime
timer NominalDiffTime
t = ((NominalDiffTime -> m ()) -> m ()) -> Evt m NominalDiffTime
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((NominalDiffTime -> m ()) -> m ()) -> Evt m NominalDiffTime)
-> ((NominalDiffTime -> m ()) -> m ()) -> Evt m NominalDiffTime
forall a b. (a -> b) -> a -> b
$ \NominalDiffTime -> m ()
go -> do
UTCTime
start <- IO UTCTime -> m UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
NominalDiffTime -> m () -> m ()
forall (m :: * -> *). MonadIO m => NominalDiffTime -> m () -> m ()
periodic NominalDiffTime
t (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ NominalDiffTime -> m ()
go (NominalDiffTime -> m ()) -> m NominalDiffTime -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO NominalDiffTime -> m NominalDiffTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ((UTCTime -> UTCTime -> NominalDiffTime
`diffUTCTime` UTCTime
start) (UTCTime -> NominalDiffTime) -> IO UTCTime -> IO NominalDiffTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime
getCurrentTime)
timerD :: Frp m => NominalDiffTime -> Dyn m NominalDiffTime
timerD :: NominalDiffTime -> Dyn m NominalDiffTime
timerD NominalDiffTime
t = NominalDiffTime -> Evt m NominalDiffTime -> Dyn m NominalDiffTime
forall (m :: * -> *) a. Frp m => a -> Evt m a -> Dyn m a
hold NominalDiffTime
0 (Evt m NominalDiffTime -> Dyn m NominalDiffTime)
-> Evt m NominalDiffTime -> Dyn m NominalDiffTime
forall a b. (a -> b) -> a -> b
$ NominalDiffTime -> Evt m NominalDiffTime
forall (m :: * -> *).
Frp m =>
NominalDiffTime -> Evt m NominalDiffTime
timer NominalDiffTime
t
{-# NOINLINE periodic #-}
periodic :: MonadIO m => NominalDiffTime -> m () -> m ()
periodic :: NominalDiffTime -> m () -> m ()
periodic NominalDiffTime
dur m ()
proc = do
IORef UTCTime
startRef <- IO (IORef UTCTime) -> m (IORef UTCTime)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef UTCTime) -> m (IORef UTCTime))
-> IO (IORef UTCTime) -> m (IORef UTCTime)
forall a b. (a -> b) -> a -> b
$ UTCTime -> IO (IORef UTCTime)
forall a. a -> IO (IORef a)
newIORef (UTCTime -> IO (IORef UTCTime)) -> IO UTCTime -> IO (IORef UTCTime)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO UTCTime
getCurrentTime
(m () -> m ()) -> m ()
forall a. (a -> a) -> a
fix ((m () -> m ()) -> m ()) -> (m () -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \m ()
next -> do
m ()
proc
NominalDiffTime
time <- IO NominalDiffTime -> m NominalDiffTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO NominalDiffTime -> m NominalDiffTime)
-> IO NominalDiffTime -> m NominalDiffTime
forall a b. (a -> b) -> a -> b
$ do
UTCTime
last <- IORef UTCTime -> IO UTCTime
forall a. IORef a -> IO a
readIORef IORef UTCTime
startRef
UTCTime
cur <- IO UTCTime
getCurrentTime
let dt :: NominalDiffTime
dt = NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Ord a => a -> a -> a
max NominalDiffTime
0 (NominalDiffTime -> NominalDiffTime)
-> NominalDiffTime -> NominalDiffTime
forall a b. (a -> b) -> a -> b
$ NominalDiffTime
dur NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
- (UTCTime
cur UTCTime -> UTCTime -> NominalDiffTime
`diffUTCTime` UTCTime
last)
IORef UTCTime -> UTCTime -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef UTCTime
startRef (NominalDiffTime -> UTCTime -> UTCTime
addUTCTime NominalDiffTime
dt UTCTime
cur)
NominalDiffTime -> IO NominalDiffTime
forall (f :: * -> *) a. Applicative f => a -> f a
pure NominalDiffTime
dt
NominalDiffTime -> m ()
forall (m :: * -> *). MonadIO m => NominalDiffTime -> m ()
sleep NominalDiffTime
time
m ()
next
sleep :: MonadIO m => NominalDiffTime -> m ()
sleep :: NominalDiffTime -> m ()
sleep NominalDiffTime
dt = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (Integer -> IO ()) -> Integer -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> IO ()
D.delay (Integer -> m ()) -> Integer -> m ()
forall a b. (a -> b) -> a -> b
$ NominalDiffTime -> Integer
toMicroseconds NominalDiffTime
dt
toMicroseconds :: NominalDiffTime -> Integer
toMicroseconds :: NominalDiffTime -> Integer
toMicroseconds NominalDiffTime
t = Rational -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Rational -> Integer) -> Rational -> Integer
forall a b. (a -> b) -> a -> b
$ NominalDiffTime -> Rational
forall a. Real a => a -> Rational
toRational NominalDiffTime
t Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
1000000
toRandom :: forall m a b . (Frp m, Random b) => Evt m a -> Evt m b
toRandom :: Evt m a -> Evt m b
toRandom Evt m a
evt = ((b -> m ()) -> m ()) -> Evt m b
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((b -> m ()) -> m ()) -> Evt m b)
-> ((b -> m ()) -> m ()) -> Evt m b
forall a b. (a -> b) -> a -> b
$ \b -> m ()
go -> do
Ref m StdGen
tv <- Evt m a -> StdGen -> m (Ref m StdGen)
forall (m :: * -> *) a b. Frp m => Evt m a -> b -> m (Ref m b)
proxyNewRef Evt m a
evt (StdGen -> m (Ref m StdGen)) -> m StdGen -> m (Ref m StdGen)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO StdGen -> m StdGen
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO StdGen
forall (m :: * -> *). MonadIO m => m StdGen
newStdGen
Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt ((a -> m ()) -> m ()) -> (a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \a
_ -> do
(b
a, StdGen
g) <- IO (b, StdGen) -> m (b, StdGen)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (b, StdGen) -> m (b, StdGen))
-> IO (b, StdGen) -> m (b, StdGen)
forall a b. (a -> b) -> a -> b
$ StdGen -> (b, StdGen)
forall a g. (Random a, RandomGen g) => g -> (a, g)
random (StdGen -> (b, StdGen)) -> IO StdGen -> IO (b, StdGen)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ref m StdGen -> IO StdGen
forall (ref :: * -> *) a. IsRef ref => ref a -> IO a
readRef Ref m StdGen
tv
b -> m ()
go b
a
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m StdGen -> StdGen -> IO ()
forall (ref :: * -> *) a. IsRef ref => ref a -> a -> IO ()
writeRef Ref m StdGen
tv StdGen
g
toRandomR :: forall m a b . (Frp m, Random b) => (b, b) -> Evt m a -> Evt m b
toRandomR :: (b, b) -> Evt m a -> Evt m b
toRandomR (b, b)
range Evt m a
evt = ((b -> m ()) -> m ()) -> Evt m b
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((b -> m ()) -> m ()) -> Evt m b)
-> ((b -> m ()) -> m ()) -> Evt m b
forall a b. (a -> b) -> a -> b
$ \b -> m ()
go -> do
Ref m StdGen
tv <- Evt m a -> StdGen -> m (Ref m StdGen)
forall (m :: * -> *) a b. Frp m => Evt m a -> b -> m (Ref m b)
proxyNewRef Evt m a
evt (StdGen -> m (Ref m StdGen)) -> m StdGen -> m (Ref m StdGen)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO StdGen -> m StdGen
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO StdGen
forall (m :: * -> *). MonadIO m => m StdGen
newStdGen
Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt ((a -> m ()) -> m ()) -> (a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \a
_ -> do
(b
a, StdGen
g) <- IO (b, StdGen) -> m (b, StdGen)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (b, StdGen) -> m (b, StdGen))
-> IO (b, StdGen) -> m (b, StdGen)
forall a b. (a -> b) -> a -> b
$ (b, b) -> StdGen -> (b, StdGen)
forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
randomR (b, b)
range (StdGen -> (b, StdGen)) -> IO StdGen -> IO (b, StdGen)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ref m StdGen -> IO StdGen
forall (ref :: * -> *) a. IsRef ref => ref a -> IO a
readRef Ref m StdGen
tv
b -> m ()
go b
a
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m StdGen -> StdGen -> IO ()
forall (ref :: * -> *) a. IsRef ref => ref a -> a -> IO ()
writeRef Ref m StdGen
tv StdGen
g
withRandom :: forall m a b . (Frp m, Random b) => Evt m a -> Evt m (b, a)
withRandom :: Evt m a -> Evt m (b, a)
withRandom Evt m a
evt = (((b, a) -> m ()) -> m ()) -> Evt m (b, a)
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt ((((b, a) -> m ()) -> m ()) -> Evt m (b, a))
-> (((b, a) -> m ()) -> m ()) -> Evt m (b, a)
forall a b. (a -> b) -> a -> b
$ \(b, a) -> m ()
go -> do
Ref m StdGen
tv <- Evt m a -> StdGen -> m (Ref m StdGen)
forall (m :: * -> *) a b. Frp m => Evt m a -> b -> m (Ref m b)
proxyNewRef Evt m a
evt (StdGen -> m (Ref m StdGen)) -> m StdGen -> m (Ref m StdGen)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO StdGen -> m StdGen
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO StdGen
forall (m :: * -> *). MonadIO m => m StdGen
newStdGen
Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt ((a -> m ()) -> m ()) -> (a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \a
x -> do
(b
a, StdGen
g) <- IO (b, StdGen) -> m (b, StdGen)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (b, StdGen) -> m (b, StdGen))
-> IO (b, StdGen) -> m (b, StdGen)
forall a b. (a -> b) -> a -> b
$ StdGen -> (b, StdGen)
forall a g. (Random a, RandomGen g) => g -> (a, g)
random (StdGen -> (b, StdGen)) -> IO StdGen -> IO (b, StdGen)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ref m StdGen -> IO StdGen
forall (ref :: * -> *) a. IsRef ref => ref a -> IO a
readRef Ref m StdGen
tv
(b, a) -> m ()
go (b
a, a
x)
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m StdGen -> StdGen -> IO ()
forall (ref :: * -> *) a. IsRef ref => ref a -> a -> IO ()
writeRef Ref m StdGen
tv StdGen
g
withRandomR :: forall m a b . (Frp m, Random b) => (b, b) -> Evt m a -> Evt m (b, a)
withRandomR :: (b, b) -> Evt m a -> Evt m (b, a)
withRandomR (b, b)
range Evt m a
evt = (((b, a) -> m ()) -> m ()) -> Evt m (b, a)
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt ((((b, a) -> m ()) -> m ()) -> Evt m (b, a))
-> (((b, a) -> m ()) -> m ()) -> Evt m (b, a)
forall a b. (a -> b) -> a -> b
$ \(b, a) -> m ()
go -> do
Ref m StdGen
tv <- Evt m a -> StdGen -> m (Ref m StdGen)
forall (m :: * -> *) a b. Frp m => Evt m a -> b -> m (Ref m b)
proxyNewRef Evt m a
evt (StdGen -> m (Ref m StdGen)) -> m StdGen -> m (Ref m StdGen)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO StdGen -> m StdGen
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO StdGen
forall (m :: * -> *). MonadIO m => m StdGen
newStdGen
Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt ((a -> m ()) -> m ()) -> (a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \a
x -> do
(b
a, StdGen
g) <- IO (b, StdGen) -> m (b, StdGen)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (b, StdGen) -> m (b, StdGen))
-> IO (b, StdGen) -> m (b, StdGen)
forall a b. (a -> b) -> a -> b
$ (b, b) -> StdGen -> (b, StdGen)
forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
randomR (b, b)
range (StdGen -> (b, StdGen)) -> IO StdGen -> IO (b, StdGen)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ref m StdGen -> IO StdGen
forall (ref :: * -> *) a. IsRef ref => ref a -> IO a
readRef Ref m StdGen
tv
(b, a) -> m ()
go (b
a, a
x)
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m StdGen -> StdGen -> IO ()
forall (ref :: * -> *) a. IsRef ref => ref a -> a -> IO ()
writeRef Ref m StdGen
tv StdGen
g
oneOf :: Frp m => [a] -> Evt m b -> Evt m a
oneOf :: [a] -> Evt m b -> Evt m a
oneOf [a]
xs Evt m b
evt = [a] -> Evt m Int -> Evt m a
forall (m :: * -> *) a. Frp m => [a] -> Evt m Int -> Evt m a
listAt [a]
xs (Evt m Int -> Evt m a) -> Evt m Int -> Evt m a
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> Evt m b -> Evt m Int
forall (m :: * -> *) a b.
(Frp m, Random b) =>
(b, b) -> Evt m a -> Evt m b
toRandomR (Int
0, Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Evt m b
evt
where
len :: Int
len = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs
withOneOf :: Frp m => [a] -> Evt m b -> Evt m (a, b)
withOneOf :: [a] -> Evt m b -> Evt m (a, b)
withOneOf [a]
xs Evt m b
evt = (Int -> a) -> (Int, b) -> (a, b)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Vector a
vec Vector a -> Int -> a
forall a. Vector a -> Int -> a
V.! ) ((Int, b) -> (a, b)) -> Evt m (Int, b) -> Evt m (a, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int, Int) -> Evt m b -> Evt m (Int, b)
forall (m :: * -> *) a b.
(Frp m, Random b) =>
(b, b) -> Evt m a -> Evt m (b, a)
withRandomR (Int
0, Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Evt m b
evt
where
len :: Int
len = Vector a -> Int
forall a. Vector a -> Int
V.length Vector a
vec
vec :: Vector a
vec = [a] -> Vector a
forall a. [a] -> Vector a
V.fromList [a]
xs
freqOf :: (R.MonadRandom m, Frp m) => Dyn m [(a, Rational)] -> Evt m b -> Evt m a
freqOf :: Dyn m [(a, Rational)] -> Evt m b -> Evt m a
freqOf Dyn m [(a, Rational)]
dynVals Evt m b
evts = Dyn m (b -> m (Maybe a)) -> Evt m b -> Evt m a
forall (m :: * -> *) a b.
Frp m =>
Dyn m (a -> m (Maybe b)) -> Evt m a -> Evt m b
applyMay' ((\[(a, Rational)]
vals -> m (Maybe a) -> b -> m (Maybe a)
forall a b. a -> b -> a
const ([(a, Rational)] -> m (Maybe a)
forall (m :: * -> *) a.
MonadRandom m =>
[(a, Rational)] -> m (Maybe a)
go [(a, Rational)]
vals)) ([(a, Rational)] -> b -> m (Maybe a))
-> Dyn m [(a, Rational)] -> Dyn m (b -> m (Maybe a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dyn m [(a, Rational)]
dynVals) Evt m b
evts
where
go :: [(a, Rational)] -> m (Maybe a)
go [(a, Rational)]
vals = [(a, Rational)] -> m (Maybe a)
forall (m :: * -> *) a.
MonadRandom m =>
[(a, Rational)] -> m (Maybe a)
R.fromListMay [(a, Rational)]
vals
withFreqOf :: (R.MonadRandom m, Frp m) => Dyn m [(a, Rational)] -> Evt m b -> Evt m (a, b)
withFreqOf :: Dyn m [(a, Rational)] -> Evt m b -> Evt m (a, b)
withFreqOf Dyn m [(a, Rational)]
dynVals Evt m b
evts = Dyn m (b -> m (Maybe (a, b))) -> Evt m b -> Evt m (a, b)
forall (m :: * -> *) a b.
Frp m =>
Dyn m (a -> m (Maybe b)) -> Evt m a -> Evt m b
applyMay' ([(a, Rational)] -> b -> m (Maybe (a, b))
forall (f :: * -> *) t t.
MonadRandom f =>
[(t, Rational)] -> t -> f (Maybe (t, t))
go ([(a, Rational)] -> b -> m (Maybe (a, b)))
-> Dyn m [(a, Rational)] -> Dyn m (b -> m (Maybe (a, b)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dyn m [(a, Rational)]
dynVals) Evt m b
evts
where
go :: [(t, Rational)] -> t -> f (Maybe (t, t))
go [(t, Rational)]
vals t
x = (Maybe t -> Maybe (t, t)) -> f (Maybe t) -> f (Maybe (t, t))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((t -> (t, t)) -> Maybe t -> Maybe (t, t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((, t
x))) (f (Maybe t) -> f (Maybe (t, t)))
-> f (Maybe t) -> f (Maybe (t, t))
forall a b. (a -> b) -> a -> b
$ [(t, Rational)] -> f (Maybe t)
forall (m :: * -> *) a.
MonadRandom m =>
[(a, Rational)] -> m (Maybe a)
R.fromListMay [(t, Rational)]
vals
randSkip :: Frp m => Dyn m Double -> Evt m a -> Evt m a
randSkip :: Dyn m Double -> Evt m a -> Evt m a
randSkip Dyn m Double
prob Evt m a
evt = Dyn m (a -> Double) -> Evt m a -> Evt m a
forall (m :: * -> *) a.
Frp m =>
Dyn m (a -> Double) -> Evt m a -> Evt m a
randSkipBy (Double -> a -> Double
forall a b. a -> b -> a
const (Double -> a -> Double) -> Dyn m Double -> Dyn m (a -> Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dyn m Double
prob) Evt m a
evt
randSkipBy :: Frp m => Dyn m (a -> Double) -> Evt m a -> Evt m a
randSkipBy :: Dyn m (a -> Double) -> Evt m a -> Evt m a
randSkipBy Dyn m (a -> Double)
prob Evt m a
evt = ((a -> Double) -> (Double, a) -> Maybe a)
-> Dyn m (a -> Double) -> Evt m (Double, a) -> Evt m a
forall (m :: * -> *) a b c.
Frp m =>
(a -> b -> Maybe c) -> Dyn m a -> Evt m b -> Evt m c
attachWithMay (a -> Double) -> (Double, a) -> Maybe a
forall a a. Ord a => (a -> a) -> (a, a) -> Maybe a
f Dyn m (a -> Double)
prob (Evt m (Double, a) -> Evt m a) -> Evt m (Double, a) -> Evt m a
forall a b. (a -> b) -> a -> b
$ (Double, Double) -> Evt m a -> Evt m (Double, a)
forall (m :: * -> *) a b.
(Frp m, Random b) =>
(b, b) -> Evt m a -> Evt m (b, a)
withRandomR (Double
0, Double
1 :: Double) Evt m a
evt
where
f :: (a -> a) -> (a, a) -> Maybe a
f a -> a
getProb (a
curProb, a
a)
| a
curProb a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a -> a
getProb a
a = Maybe a
forall a. Maybe a
Nothing
| Bool
otherwise = a -> Maybe a
forall a. a -> Maybe a
Just a
a
delay :: Frp m => NominalDiffTime -> Evt m a -> Evt m a
delay :: NominalDiffTime -> Evt m a -> Evt m a
delay NominalDiffTime
dt Evt m a
evt = ((a -> m ()) -> m ()) -> Evt m a
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((a -> m ()) -> m ()) -> Evt m a)
-> ((a -> m ()) -> m ()) -> Evt m a
forall a b. (a -> b) -> a -> b
$ \a -> m ()
go ->
Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt ((a -> m ()) -> m ()) -> (a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \a
x -> NominalDiffTime -> m ()
forall (m :: * -> *). MonadIO m => NominalDiffTime -> m ()
sleep NominalDiffTime
dt m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> m ()
go a
x
delayFork :: Frp m => NominalDiffTime -> Evt m a -> Evt m a
delayFork :: NominalDiffTime -> Evt m a -> Evt m a
delayFork NominalDiffTime
dt Evt m a
evt = ((a -> m ()) -> m ()) -> Evt m a
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((a -> m ()) -> m ()) -> Evt m a)
-> ((a -> m ()) -> m ()) -> Evt m a
forall a b. (a -> b) -> a -> b
$ \a -> m ()
go ->
Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt ((a -> m ()) -> m ()) -> (a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \a
x -> m ThreadId -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m ThreadId -> m ()) -> m ThreadId -> m ()
forall a b. (a -> b) -> a -> b
$ m () -> m ThreadId
forall (m :: * -> *). MonadBaseControl IO m => m () -> m ThreadId
fork (m () -> m ThreadId) -> m () -> m ThreadId
forall a b. (a -> b) -> a -> b
$ NominalDiffTime -> m ()
forall (m :: * -> *). MonadIO m => NominalDiffTime -> m ()
sleep NominalDiffTime
dt m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> m ()
go a
x
class FunctorM f where
fmap' :: Frp m => (a -> m b) -> f m a -> f m b
instance FunctorM Evt where
fmap' :: (a -> m b) -> Evt m a -> Evt m b
fmap' a -> m b
f Evt m a
evt = ((b -> m ()) -> m ()) -> Evt m b
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((b -> m ()) -> m ()) -> Evt m b)
-> ((b -> m ()) -> m ()) -> Evt m b
forall a b. (a -> b) -> a -> b
$ \b -> m ()
go -> Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt ((a -> m ()) -> m ()) -> (a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \a
x -> b -> m ()
go (b -> m ()) -> m b -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< a -> m b
f a
x
instance FunctorM Dyn where
fmap' :: (a -> m b) -> Dyn m a -> Dyn m b
fmap' a -> m b
f (ConstDyn a
a) = (a -> m b) -> Evt m a -> m a -> m () -> Dyn m b
forall (m :: * -> *) a s.
(s -> m a) -> Evt m s -> m s -> m () -> Dyn m a
Dyn a -> m b
f Evt m a
forall (m :: * -> *) a. Frp m => Evt m a
never (a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a) (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
fmap' a -> m b
f (Dyn s -> m a
extract Evt m s
evt m s
s m ()
release) = (s -> m b) -> Evt m s -> m s -> m () -> Dyn m b
forall (m :: * -> *) a s.
(s -> m a) -> Evt m s -> m s -> m () -> Dyn m a
Dyn (a -> m b
f (a -> m b) -> (s -> m a) -> s -> m b
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< s -> m a
extract) Evt m s
evt m s
s m ()
release
instance (Boolean b, Frp m) => Boolean (Dyn m b) where
true :: Dyn m b
true = b -> Dyn m b
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
forall b. Boolean b => b
true
false :: Dyn m b
false = b -> Dyn m b
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
forall b. Boolean b => b
false
notB :: Dyn m b -> Dyn m b
notB = (b -> b) -> Dyn m b -> Dyn m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> b
forall b. Boolean b => b -> b
notB
&&* :: Dyn m b -> Dyn m b -> Dyn m b
(&&*) = (b -> b -> b) -> Dyn m b -> Dyn m b -> Dyn m b
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 b -> b -> b
forall b. Boolean b => b -> b -> b
(&&*)
||* :: Dyn m b -> Dyn m b -> Dyn m b
(||*) = (b -> b -> b) -> Dyn m b -> Dyn m b -> Dyn m b
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 b -> b -> b
forall b. Boolean b => b -> b -> b
(||*)
type instance BooleanOf (Dyn m a) = Dyn m (BooleanOf a)
instance (Frp m, IfB a) => IfB (Dyn m a) where
ifB :: bool -> Dyn m a -> Dyn m a -> Dyn m a
ifB = (BooleanOf a -> a -> a -> a)
-> Dyn m (BooleanOf a) -> Dyn m a -> Dyn m a -> Dyn m a
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 BooleanOf a -> a -> a -> a
forall a bool. (IfB a, bool ~ BooleanOf a) => bool -> a -> a -> a
ifB
instance (EqB a, Frp m) => EqB (Dyn m a) where
==* :: Dyn m a -> Dyn m a -> bool
(==*) = (a -> a -> BooleanOf a)
-> Dyn m a -> Dyn m a -> Dyn m (BooleanOf a)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> BooleanOf a
forall a bool. (EqB a, bool ~ BooleanOf a) => a -> a -> bool
(==*)
instance (OrdB a, Frp m) => OrdB (Dyn m a) where
<* :: Dyn m a -> Dyn m a -> bool
(<*) = (a -> a -> BooleanOf a)
-> Dyn m a -> Dyn m a -> Dyn m (BooleanOf a)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> BooleanOf a
forall a bool. (OrdB a, bool ~ BooleanOf a) => a -> a -> bool
(<*)
>* :: Dyn m a -> Dyn m a -> bool
(>*) = (a -> a -> BooleanOf a)
-> Dyn m a -> Dyn m a -> Dyn m (BooleanOf a)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> BooleanOf a
forall a bool. (OrdB a, bool ~ BooleanOf a) => a -> a -> bool
(>*)
<=* :: Dyn m a -> Dyn m a -> bool
(<=*) = (a -> a -> BooleanOf a)
-> Dyn m a -> Dyn m a -> Dyn m (BooleanOf a)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> BooleanOf a
forall a bool. (OrdB a, bool ~ BooleanOf a) => a -> a -> bool
(<=*)
>=* :: Dyn m a -> Dyn m a -> bool
(>=*) = (a -> a -> BooleanOf a)
-> Dyn m a -> Dyn m a -> Dyn m (BooleanOf a)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> BooleanOf a
forall a bool. (OrdB a, bool ~ BooleanOf a) => a -> a -> bool
(>=*)
instance (AdditiveGroup a, Frp m) => AdditiveGroup (Dyn m a) where
zeroV :: Dyn m a
zeroV = a -> Dyn m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
forall v. AdditiveGroup v => v
zeroV
^+^ :: Dyn m a -> Dyn m a -> Dyn m a
(^+^) = (a -> a -> a) -> Dyn m a -> Dyn m a -> Dyn m a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall v. AdditiveGroup v => v -> v -> v
(^+^)
^-^ :: Dyn m a -> Dyn m a -> Dyn m a
(^-^) = (a -> a -> a) -> Dyn m a -> Dyn m a -> Dyn m a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall v. AdditiveGroup v => v -> v -> v
(^-^)
negateV :: Dyn m a -> Dyn m a
negateV = (a -> a) -> Dyn m a -> Dyn m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall v. AdditiveGroup v => v -> v
negateV
instance (VectorSpace a, Frp m) => VectorSpace (Dyn m a) where
type Scalar (Dyn m a) = Dyn m (Scalar a)
*^ :: Scalar (Dyn m a) -> Dyn m a -> Dyn m a
(*^) = (Scalar a -> a -> a) -> Dyn m (Scalar a) -> Dyn m a -> Dyn m a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Scalar a -> a -> a
forall v. VectorSpace v => Scalar v -> v -> v
(*^)
instance (AffineSpace p, Frp m) => AffineSpace (Dyn m p) where
type Diff (Dyn m p) = Dyn m (Diff p)
.-. :: Dyn m p -> Dyn m p -> Diff (Dyn m p)
(.-.) = (p -> p -> Diff p) -> Dyn m p -> Dyn m p -> Dyn m (Diff p)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 p -> p -> Diff p
forall p. AffineSpace p => p -> p -> Diff p
(.-.)
.+^ :: Dyn m p -> Diff (Dyn m p) -> Dyn m p
(.+^) = (p -> Diff p -> p) -> Dyn m p -> Dyn m (Diff p) -> Dyn m p
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 p -> Diff p -> p
forall p. AffineSpace p => p -> Diff p -> p
(.+^)
class BasisArity v where
basisArity :: v -> Int
instance BasisArity Float where
basisArity :: Float -> Int
basisArity Float
_ = Int
1
instance BasisArity Double where
basisArity :: Double -> Int
basisArity Double
_ = Int
1
instance (BasisArity a, BasisArity b) => BasisArity (a, b) where
basisArity :: (a, b) -> Int
basisArity (a, b)
v = a -> Int
forall v. BasisArity v => v -> Int
basisArity ((a, b) -> a
forall a b. (a, b) -> a
proxyA (a, b)
v) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ b -> Int
forall v. BasisArity v => v -> Int
basisArity ((a, b) -> b
forall a b. (a, b) -> b
proxyB (a, b)
v)
where
proxyA :: (a, b) -> a
proxyA :: (a, b) -> a
proxyA (a, b)
_ = a
forall a. HasCallStack => a
undefined
proxyB :: (a, b) -> b
proxyB :: (a, b) -> b
proxyB (a, b)
_ = b
forall a. HasCallStack => a
undefined
instance (BasisArity a, BasisArity b, BasisArity c) => BasisArity (a, b, c) where
basisArity :: (a, b, c) -> Int
basisArity (a, b, c)
v = a -> Int
forall v. BasisArity v => v -> Int
basisArity ((a, b, c) -> a
forall a b c. (a, b, c) -> a
proxyA (a, b, c)
v) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ b -> Int
forall v. BasisArity v => v -> Int
basisArity ((a, b, c) -> b
forall a b c. (a, b, c) -> b
proxyB (a, b, c)
v) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ c -> Int
forall v. BasisArity v => v -> Int
basisArity ((a, b, c) -> c
forall a b c. (a, b, c) -> c
proxyC (a, b, c)
v)
where
proxyA :: (a, b, c) -> a
proxyA :: (a, b, c) -> a
proxyA (a, b, c)
_ = a
forall a. HasCallStack => a
undefined
proxyB :: (a, b, c) -> b
proxyB :: (a, b, c) -> b
proxyB (a, b, c)
_ = b
forall a. HasCallStack => a
undefined
proxyC :: (a, b, c) -> c
proxyC :: (a, b, c) -> c
proxyC (a, b, c)
_ = c
forall a. HasCallStack => a
undefined
instance (Frp m, BasisArity v) => BasisArity (Dyn m v) where
basisArity :: Dyn m v -> Int
basisArity Dyn m v
v = v -> Int
forall v. BasisArity v => v -> Int
basisArity (Dyn m v -> v
forall (m :: * -> *) v. Dyn m v -> v
proxy Dyn m v
v)
where
proxy :: Dyn m v -> v
proxy :: Dyn m v -> v
proxy Dyn m v
_ = v
forall a. HasCallStack => a
undefined
instance (BasisArity v, HasBasis v, Frp m) => HasBasis (Dyn m v) where
type Basis (Dyn m v) = Dyn m (Basis v)
basisValue :: Basis (Dyn m v) -> Dyn m v
basisValue = (Basis v -> v) -> Dyn m (Basis v) -> Dyn m v
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Basis v -> v
forall v. HasBasis v => Basis v -> v
basisValue
decompose :: Dyn m v -> [(Basis (Dyn m v), Scalar (Dyn m v))]
decompose Dyn m v
v = (Dyn m (Basis v, Scalar v) -> (Dyn m (Basis v), Dyn m (Scalar v)))
-> [Dyn m (Basis v, Scalar v)]
-> [(Dyn m (Basis v), Dyn m (Scalar v))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Dyn m (Basis v, Scalar v) -> (Dyn m (Basis v), Dyn m (Scalar v))
forall (m :: * -> *) a b.
Frp m =>
Dyn m (a, b) -> (Dyn m a, Dyn m b)
unTupleD ([Dyn m (Basis v, Scalar v)]
-> [(Dyn m (Basis v), Dyn m (Scalar v))])
-> [Dyn m (Basis v, Scalar v)]
-> [(Dyn m (Basis v), Dyn m (Scalar v))]
forall a b. (a -> b) -> a -> b
$ Int -> Dyn m [(Basis v, Scalar v)] -> [Dyn m (Basis v, Scalar v)]
forall (m :: * -> *) a. Frp m => Int -> Dyn m [a] -> [Dyn m a]
unListD (Dyn m v -> Int
forall v. BasisArity v => v -> Int
basisArity Dyn m v
v) (Dyn m [(Basis v, Scalar v)] -> [Dyn m (Basis v, Scalar v)])
-> Dyn m [(Basis v, Scalar v)] -> [Dyn m (Basis v, Scalar v)]
forall a b. (a -> b) -> a -> b
$ (v -> [(Basis v, Scalar v)])
-> Dyn m v -> Dyn m [(Basis v, Scalar v)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap v -> [(Basis v, Scalar v)]
forall v. HasBasis v => v -> [(Basis v, Scalar v)]
decompose Dyn m v
v
decompose' :: Dyn m v -> Basis (Dyn m v) -> Scalar (Dyn m v)
decompose' = (v -> Basis v -> Scalar v)
-> Dyn m v -> Dyn m (Basis v) -> Dyn m (Scalar v)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 v -> Basis v -> Scalar v
forall v. HasBasis v => v -> Basis v -> Scalar v
decompose'
unTupleD :: Frp m => Dyn m (a, b) -> (Dyn m a, Dyn m b)
unTupleD :: Dyn m (a, b) -> (Dyn m a, Dyn m b)
unTupleD Dyn m (a, b)
x = (((a, b) -> a) -> Dyn m (a, b) -> Dyn m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, b) -> a
forall a b. (a, b) -> a
fst Dyn m (a, b)
x, ((a, b) -> b) -> Dyn m (a, b) -> Dyn m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, b) -> b
forall a b. (a, b) -> b
snd Dyn m (a, b)
x)
unListD :: Frp m => Int -> Dyn m [a] -> [Dyn m a]
unListD :: Int -> Dyn m [a] -> [Dyn m a]
unListD Int
n Dyn m [a]
ds = (Int -> Dyn m a) -> [Int] -> [Dyn m a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Int
a -> ([a] -> a) -> Dyn m [a] -> Dyn m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ( [a] -> Int -> a
forall a. [a] -> Int -> a
!! Int
a) Dyn m [a]
ds) [Int
0.. Int -> Int
forall a. Enum a => a -> a
pred Int
n]
instance (HasNormal v, Frp m) => HasNormal (Dyn m v) where
normalVec :: Dyn m v -> Dyn m v
normalVec = (v -> v) -> Dyn m v -> Dyn m v
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap v -> v
forall v. HasNormal v => v -> v
normalVec
instance (HasCross2 v, Frp m) => HasCross2 (Dyn m v) where
cross2 :: Dyn m v -> Dyn m v
cross2 = (v -> v) -> Dyn m v -> Dyn m v
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap v -> v
forall v. HasCross2 v => v -> v
cross2
instance (HasCross3 v, Frp m) => HasCross3 (Dyn m v) where
cross3 :: Dyn m v -> Dyn m v -> Dyn m v
cross3 = (v -> v -> v) -> Dyn m v -> Dyn m v -> Dyn m v
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 v -> v -> v
forall v. HasCross3 v => v -> v -> v
cross3
instance Frp m => Melody (Evt m a) where
+:+ :: Evt m a -> Evt m a -> Evt m a
(+:+) Evt m a
evtA Evt m a
evtB = ((a -> m ()) -> m ()) -> Evt m a
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((a -> m ()) -> m ()) -> Evt m a)
-> ((a -> m ()) -> m ()) -> Evt m a
forall a b. (a -> b) -> a -> b
$ \a -> m ()
go -> do
Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evtA a -> m ()
go
Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evtB a -> m ()
go
instance Frp m => Harmony (Evt m a) where
=:= :: Evt m a -> Evt m a -> Evt m a
(=:=) = Evt m a -> Evt m a -> Evt m a
forall a. Semigroup a => a -> a -> a
(<>)
instance Frp m => Compose (Evt m a) where
instance Frp m => Loop (Evt m a) where
loop :: Evt m a -> Evt m a
loop Evt m a
evt = ((a -> m ()) -> m ()) -> Evt m a
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((a -> m ()) -> m ()) -> Evt m a)
-> ((a -> m ()) -> m ()) -> Evt m a
forall a b. (a -> b) -> a -> b
$ \a -> m ()
go -> m () -> m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt a -> m ()
go)
forevers :: Frp m => Evt m a -> Evt m a
forevers :: Evt m a -> Evt m a
forevers Evt m a
evt = ((a -> m ()) -> m ()) -> Evt m a
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((a -> m ()) -> m ()) -> Evt m a)
-> ((a -> m ()) -> m ()) -> Evt m a
forall a b. (a -> b) -> a -> b
$ \a -> m ()
go -> m () -> m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt a -> m ()
go)
type instance DurOf (Evt m a) = NominalDiffTime
instance Frp m => Limit (Evt m a) where
lim :: DurOf (Evt m a) -> Evt m a -> Evt m a
lim DurOf (Evt m a)
t Evt m a
evt = ((a -> m ()) -> m ()) -> Evt m a
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((a -> m ()) -> m ()) -> Evt m a)
-> ((a -> m ()) -> m ()) -> Evt m a
forall a b. (a -> b) -> a -> b
$ \a -> m ()
go ->
m () -> m () -> m ()
forall (m :: * -> *) a b.
MonadBaseControl IO m =>
m a -> m b -> m ()
race_ (Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt a -> m ()
go) (NominalDiffTime -> m ()
forall (m :: * -> *). MonadIO m => NominalDiffTime -> m ()
sleep DurOf (Evt m a)
NominalDiffTime
t)
data St a = Final a | Cont a
deriving (a -> St b -> St a
(a -> b) -> St a -> St b
(forall a b. (a -> b) -> St a -> St b)
-> (forall a b. a -> St b -> St a) -> Functor St
forall a b. a -> St b -> St a
forall a b. (a -> b) -> St a -> St b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> St b -> St a
$c<$ :: forall a b. a -> St b -> St a
fmap :: (a -> b) -> St a -> St b
$cfmap :: forall a b. (a -> b) -> St a -> St b
Functor)
data Parser m a b = forall s . Parser
{ ()
parser'init :: s
, ()
parser'modify :: (a -> s -> m (Maybe (St s)))
, ()
parser'get :: s -> m (Maybe b)
}
runParser :: Frp m => Parser m a b -> Evt m a -> m (Maybe b)
runParser :: Parser m a b -> Evt m a -> m (Maybe b)
runParser (Parser s
init a -> s -> m (Maybe (St s))
modify s -> m (Maybe b)
get) Evt m a
evt = do
Ref m (St s)
ref <- Evt m a -> St s -> m (Ref m (St s))
forall (m :: * -> *) a b. Frp m => Evt m a -> b -> m (Ref m b)
proxyNewRef Evt m a
evt (s -> St s
forall a. a -> St a
Cont s
init)
m () -> m ()
forall (m :: * -> *). Frp m => m () -> m ()
waitAsync (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt ((a -> m ()) -> m ()) -> (a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \a
x -> do
St s
st <- IO (St s) -> m (St s)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (St s) -> m (St s)) -> IO (St s) -> m (St s)
forall a b. (a -> b) -> a -> b
$ Ref m (St s) -> IO (St s)
forall (ref :: * -> *) a. IsRef ref => ref a -> IO a
readRef Ref m (St s)
ref
case St s
st of
Final s
s -> m ()
forall (m :: * -> *). Frp m => m ()
stopSelf
Cont s
s -> do
Maybe (St s)
mS' <- a -> s -> m (Maybe (St s))
modify a
x s
s
Maybe (St s) -> (St s -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (St s)
mS' ((St s -> m ()) -> m ()) -> (St s -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \case
Cont s
s -> IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m (St s) -> St s -> IO ()
forall (ref :: * -> *) a. IsRef ref => ref a -> a -> IO ()
writeRef Ref m (St s)
ref (s -> St s
forall a. a -> St a
Cont s
s)
Final s
s -> IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Ref m (St s) -> St s -> IO ()
forall (ref :: * -> *) a. IsRef ref => ref a -> a -> IO ()
writeRef Ref m (St s)
ref (s -> St s
forall a. a -> St a
Final s
s)
IO ()
forall (m :: * -> *). Frp m => m ()
stopSelf
St s
st <- IO (St s) -> m (St s)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Ref m (St s) -> IO (St s)
forall (ref :: * -> *) a. IsRef ref => ref a -> IO a
readRef Ref m (St s)
ref)
case St s
st of
Final s
s -> s -> m (Maybe b)
get s
s
St s
_ -> Maybe b -> m (Maybe b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe b
forall a. Maybe a
Nothing
heads :: Frp m => Evt m a -> m a
heads :: Evt m a -> m a
heads Evt m a
evt = do
Ref m (Maybe a)
ref <- Evt m a -> Maybe a -> m (Ref m (Maybe a))
forall (m :: * -> *) a b. Frp m => Evt m a -> b -> m (Ref m b)
proxyNewRef Evt m a
evt Maybe a
forall a. Maybe a
Nothing
m () -> m ()
forall (m :: * -> *). Frp m => m () -> m ()
waitAsync (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt ((a -> m ()) -> m ()) -> (a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \a
x -> do
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe a) -> Maybe a -> IO ()
forall (ref :: * -> *) a. IsRef ref => ref a -> a -> IO ()
writeRef Ref m (Maybe a)
ref (a -> Maybe a
forall a. a -> Maybe a
Just a
x)
m ()
forall (m :: * -> *). Frp m => m ()
stopSelf
Maybe a -> a
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe a -> a) -> m (Maybe a) -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Maybe a) -> m (Maybe a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Ref m (Maybe a) -> IO (Maybe a)
forall (ref :: * -> *) a. IsRef ref => ref a -> IO a
readRef Ref m (Maybe a)
ref)
takeP :: Frp m => Parser m a b -> Evt m a -> Evt m b
takeP :: Parser m a b -> Evt m a -> Evt m b
takeP (Parser s
init a -> s -> m (Maybe (St s))
modify s -> m (Maybe b)
get) Evt m a
evt = ((b -> m ()) -> m ()) -> Evt m b
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((b -> m ()) -> m ()) -> Evt m b)
-> ((b -> m ()) -> m ()) -> Evt m b
forall a b. (a -> b) -> a -> b
$ \b -> m ()
go -> do
Ref m s
ref <- Evt m a -> s -> m (Ref m s)
forall (m :: * -> *) a b. Frp m => Evt m a -> b -> m (Ref m b)
proxyNewRef Evt m a
evt s
init
m () -> m ()
forall (m :: * -> *). Frp m => m () -> m ()
waitAsync (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt ((a -> m ()) -> m ()) -> (a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \a
x -> do
s
s <- IO s -> m s
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO s -> m s) -> IO s -> m s
forall a b. (a -> b) -> a -> b
$ Ref m s -> IO s
forall (ref :: * -> *) a. IsRef ref => ref a -> IO a
readRef Ref m s
ref
Maybe (St s)
mS' <- a -> s -> m (Maybe (St s))
modify a
x s
s
Maybe (St s) -> (St s -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (St s)
mS' ((St s -> m ()) -> m ()) -> (St s -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \case
Cont s
s' -> IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m s -> s -> IO ()
forall (ref :: * -> *) a. IsRef ref => ref a -> a -> IO ()
writeRef Ref m s
ref s
s'
Final s
s' -> do
(b -> m ()) -> Maybe b -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ b -> m ()
go (Maybe b -> m ()) -> m (Maybe b) -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< s -> m (Maybe b)
get s
s'
m ()
forall (m :: * -> *). Frp m => m ()
stopSelf
cycleP :: Frp m => Parser m a b -> Evt m a -> Evt m b
cycleP :: Parser m a b -> Evt m a -> Evt m b
cycleP (Parser s
init a -> s -> m (Maybe (St s))
modify s -> m (Maybe b)
get) Evt m a
evt = ((b -> m ()) -> m ()) -> Evt m b
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((b -> m ()) -> m ()) -> Evt m b)
-> ((b -> m ()) -> m ()) -> Evt m b
forall a b. (a -> b) -> a -> b
$ \b -> m ()
go -> do
Ref m s
ref <- Evt m a -> s -> m (Ref m s)
forall (m :: * -> *) a b. Frp m => Evt m a -> b -> m (Ref m b)
proxyNewRef Evt m a
evt s
init
m () -> m ()
forall (m :: * -> *). Frp m => m () -> m ()
waitAsync (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt ((a -> m ()) -> m ()) -> (a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \a
x -> do
s
s <- IO s -> m s
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO s -> m s) -> IO s -> m s
forall a b. (a -> b) -> a -> b
$ Ref m s -> IO s
forall (ref :: * -> *) a. IsRef ref => ref a -> IO a
readRef Ref m s
ref
Maybe (St s)
mS' <- a -> s -> m (Maybe (St s))
modify a
x s
s
Maybe (St s) -> (St s -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (St s)
mS' ((St s -> m ()) -> m ()) -> (St s -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \case
Cont s
s' -> IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m s -> s -> IO ()
forall (ref :: * -> *) a. IsRef ref => ref a -> a -> IO ()
writeRef Ref m s
ref s
s'
Final s
s' -> do
(b -> m ()) -> Maybe b -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ b -> m ()
go (Maybe b -> m ()) -> m (Maybe b) -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< s -> m (Maybe b)
get s
s'
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m s -> s -> IO ()
forall (ref :: * -> *) a. IsRef ref => ref a -> a -> IO ()
writeRef Ref m s
ref s
init
headP :: Frp m => Parser m a a
headP :: Parser m a a
headP = Maybe a
-> (a -> Maybe a -> m (Maybe (St (Maybe a))))
-> (Maybe a -> m (Maybe a))
-> Parser m a a
forall (m :: * -> *) a b s.
s
-> (a -> s -> m (Maybe (St s)))
-> (s -> m (Maybe b))
-> Parser m a b
Parser Maybe a
forall a. Maybe a
init a -> Maybe a -> m (Maybe (St (Maybe a)))
forall (f :: * -> *) a p.
Applicative f =>
a -> p -> f (Maybe (St (Maybe a)))
modify Maybe a -> m (Maybe a)
forall a. a -> m a
get
where
init :: Maybe a
init = Maybe a
forall a. Maybe a
Nothing
modify :: a -> p -> f (Maybe (St (Maybe a)))
modify a
a p
_ = Maybe (St (Maybe a)) -> f (Maybe (St (Maybe a)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (St (Maybe a)) -> f (Maybe (St (Maybe a))))
-> Maybe (St (Maybe a)) -> f (Maybe (St (Maybe a)))
forall a b. (a -> b) -> a -> b
$ St (Maybe a) -> Maybe (St (Maybe a))
forall a. a -> Maybe a
Just (Maybe a -> St (Maybe a)
forall a. a -> St a
Final (a -> Maybe a
forall a. a -> Maybe a
Just a
a))
get :: a -> m a
get = a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
maybeP :: Frp m => (a -> Maybe b) -> Parser m a b
maybeP :: (a -> Maybe b) -> Parser m a b
maybeP a -> Maybe b
f = Maybe b
-> (a -> Maybe b -> m (Maybe (St (Maybe b))))
-> (Maybe b -> m (Maybe b))
-> Parser m a b
forall (m :: * -> *) a b s.
s
-> (a -> s -> m (Maybe (St s)))
-> (s -> m (Maybe b))
-> Parser m a b
Parser Maybe b
forall a. Maybe a
init a -> Maybe b -> m (Maybe (St (Maybe b)))
modify Maybe b -> m (Maybe b)
forall a. a -> m a
get
where
init :: Maybe a
init = Maybe a
forall a. Maybe a
Nothing
modify :: a -> Maybe b -> m (Maybe (St (Maybe b)))
modify a
a Maybe b
_ = Maybe (St (Maybe b)) -> m (Maybe (St (Maybe b)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (St (Maybe b)) -> m (Maybe (St (Maybe b))))
-> Maybe (St (Maybe b)) -> m (Maybe (St (Maybe b)))
forall a b. (a -> b) -> a -> b
$ (b -> St (Maybe b)) -> Maybe b -> Maybe (St (Maybe b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe b -> St (Maybe b)
forall a. a -> St a
Final (Maybe b -> St (Maybe b)) -> (b -> Maybe b) -> b -> St (Maybe b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Maybe b
forall a. a -> Maybe a
Just) (Maybe b -> Maybe (St (Maybe b)))
-> Maybe b -> Maybe (St (Maybe b))
forall a b. (a -> b) -> a -> b
$ a -> Maybe b
f a
a
get :: a -> m a
get = a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
instance Frp m => Functor (Parser m a) where
fmap :: (a -> b) -> Parser m a a -> Parser m a b
fmap a -> b
f (Parser s
init a -> s -> m (Maybe (St s))
modify s -> m (Maybe a)
get) = s
-> (a -> s -> m (Maybe (St s)))
-> (s -> m (Maybe b))
-> Parser m a b
forall (m :: * -> *) a b s.
s
-> (a -> s -> m (Maybe (St s)))
-> (s -> m (Maybe b))
-> Parser m a b
Parser s
init a -> s -> m (Maybe (St s))
modify ((Maybe a -> Maybe b) -> m (Maybe a) -> m (Maybe b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) (m (Maybe a) -> m (Maybe b))
-> (s -> m (Maybe a)) -> s -> m (Maybe b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> m (Maybe a)
get)
instance Frp m => Applicative (Parser m a) where
pure :: a -> Parser m a a
pure a
a = ()
-> (a -> () -> m (Maybe (St ())))
-> (() -> m (Maybe a))
-> Parser m a a
forall (m :: * -> *) a b s.
s
-> (a -> s -> m (Maybe (St s)))
-> (s -> m (Maybe b))
-> Parser m a b
Parser () (\a
_ ()
_ -> Maybe (St ()) -> m (Maybe (St ()))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (St () -> Maybe (St ())
forall a. a -> Maybe a
Just (() -> St ()
forall a. a -> St a
Final ()))) (m (Maybe a) -> () -> m (Maybe a)
forall a b. a -> b -> a
const (m (Maybe a) -> () -> m (Maybe a))
-> m (Maybe a) -> () -> m (Maybe a)
forall a b. (a -> b) -> a -> b
$ Maybe a -> m (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe a -> m (Maybe a)) -> Maybe a -> m (Maybe a)
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just a
a)
(Parser s
initF a -> s -> m (Maybe (St s))
modifyF s -> m (Maybe (a -> b))
getF) <*> :: Parser m a (a -> b) -> Parser m a a -> Parser m a b
<*> (Parser s
initA a -> s -> m (Maybe (St s))
modifyA s -> m (Maybe a)
getA) = (St s, St s)
-> (a -> (St s, St s) -> m (Maybe (St (St s, St s))))
-> ((St s, St s) -> m (Maybe b))
-> Parser m a b
forall (m :: * -> *) a b s.
s
-> (a -> s -> m (Maybe (St s)))
-> (s -> m (Maybe b))
-> Parser m a b
Parser (St s, St s)
initRes a -> (St s, St s) -> m (Maybe (St (St s, St s)))
modifyRes (St s, St s) -> m (Maybe b)
getRes
where
initRes :: (St s, St s)
initRes = (s -> St s
forall a. a -> St a
Cont s
initF, s -> St s
forall a. a -> St a
Cont s
initA)
modifyRes :: a -> (St s, St s) -> m (Maybe (St (St s, St s)))
modifyRes a
inp (St s
sf, St s
sa) = case St s
sf of
Cont s
f -> do
Maybe (St s)
mF' <- a -> s -> m (Maybe (St s))
modifyF a
inp s
f
Maybe (St (St s, St s)) -> m (Maybe (St (St s, St s)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (St (St s, St s)) -> m (Maybe (St (St s, St s))))
-> Maybe (St (St s, St s)) -> m (Maybe (St (St s, St s)))
forall a b. (a -> b) -> a -> b
$ (St s -> St (St s, St s))
-> Maybe (St s) -> Maybe (St (St s, St s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((St s, St s) -> St (St s, St s)
forall a. a -> St a
Cont ((St s, St s) -> St (St s, St s))
-> (St s -> (St s, St s)) -> St s -> St (St s, St s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (, St s
sa)) Maybe (St s)
mF'
Final s
f ->
case St s
sa of
Cont s
a -> do
Maybe (St s)
mA' <- a -> s -> m (Maybe (St s))
modifyA a
inp s
a
Maybe (St (St s, St s)) -> m (Maybe (St (St s, St s)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (St (St s, St s)) -> m (Maybe (St (St s, St s))))
-> Maybe (St (St s, St s)) -> m (Maybe (St (St s, St s)))
forall a b. (a -> b) -> a -> b
$ ((St s -> St (St s, St s))
-> Maybe (St s) -> Maybe (St (St s, St s)))
-> Maybe (St s)
-> (St s -> St (St s, St s))
-> Maybe (St (St s, St s))
forall a b c. (a -> b -> c) -> b -> a -> c
flip (St s -> St (St s, St s))
-> Maybe (St s) -> Maybe (St (St s, St s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe (St s)
mA' ((St s -> St (St s, St s)) -> Maybe (St (St s, St s)))
-> (St s -> St (St s, St s)) -> Maybe (St (St s, St s))
forall a b. (a -> b) -> a -> b
$ \case
Cont s
a' -> (St s, St s) -> St (St s, St s)
forall a. a -> St a
Cont (s -> St s
forall a. a -> St a
Final s
f, s -> St s
forall a. a -> St a
Cont s
a')
Final s
a' -> (St s, St s) -> St (St s, St s)
forall a. a -> St a
Final (s -> St s
forall a. a -> St a
Final s
f, s -> St s
forall a. a -> St a
Final s
a')
Final s
a -> Maybe (St (St s, St s)) -> m (Maybe (St (St s, St s)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (St (St s, St s) -> Maybe (St (St s, St s))
forall a. a -> Maybe a
Just ((St s, St s) -> St (St s, St s)
forall a. a -> St a
Final (St s
sf, St s
sa)))
getRes :: (St s, St s) -> m (Maybe b)
getRes = \case
(Final s
f, Final s
a) -> do
Maybe (a -> b)
mf <- s -> m (Maybe (a -> b))
getF s
f
Maybe a
ma <- s -> m (Maybe a)
getA s
a
Maybe b -> m (Maybe b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (a -> b)
mf Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe a
ma)
(St s, St s)
_ -> Maybe b -> m (Maybe b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe b
forall a. Maybe a
Nothing
newTriggerEvt :: (Frp m, MonadIO io) => m (Evt m a, a -> io ())
newTriggerEvt :: m (Evt m a, a -> io ())
newTriggerEvt = do
(InChan a, OutChan a)
chan <- IO (InChan a, OutChan a) -> m (InChan a, OutChan a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (InChan a, OutChan a)
forall a. IO (InChan a, OutChan a)
U.newChan
(Evt m a, a -> io ()) -> m (Evt m a, a -> io ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InChan a -> Evt m a
forall (m :: * -> *) a. Frp m => InChan a -> Evt m a
uchanEvt ((InChan a, OutChan a) -> InChan a
forall a b. (a, b) -> a
fst (InChan a, OutChan a)
chan), IO () -> io ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> io ()) -> (a -> IO ()) -> a -> io ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InChan a -> a -> IO ()
forall a. InChan a -> a -> IO ()
U.writeChan ((InChan a, OutChan a) -> InChan a
forall a b. (a, b) -> a
fst (InChan a, OutChan a)
chan))