{-# LANGUAGE CPP #-}
#if __GLASGOW_HASKELL__ < 800
{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}
#else
{-# OPTIONS_GHC -Wno-deprecations #-}
#endif
module FRP.BearRiver.Switches
(
switch, dSwitch
, parB
, dpSwitchB
, parC
)
where
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative (Applicative (..), (<$>))
#endif
import Data.Traversable as T
import Control.Monad.Trans.MSF (local)
import Control.Monad.Trans.MSF.List (sequenceS, widthFirst)
import Data.MonadicStreamFunction.InternalCore (MSF (MSF, unMSF))
import FRP.BearRiver.Event (Event (..))
import FRP.BearRiver.InternalCore (SF)
switch :: Monad m => SF m a (b, Event c) -> (c -> SF m a b) -> SF m a b
switch :: forall (m :: * -> *) a b c.
Monad m =>
SF m a (b, Event c) -> (c -> SF m a b) -> SF m a b
switch SF m a (b, Event c)
sf c -> SF m a b
sfC = (a -> ClockInfo m (b, SF m a b)) -> SF m a b
forall (m :: * -> *) a b. (a -> m (b, MSF m a b)) -> MSF m a b
MSF ((a -> ClockInfo m (b, SF m a b)) -> SF m a b)
-> (a -> ClockInfo m (b, SF m a b)) -> SF m a b
forall a b. (a -> b) -> a -> b
$ \a
a -> do
((b, Event c)
o, SF m a (b, Event c)
ct) <- SF m a (b, Event c)
-> a -> ReaderT DTime m ((b, Event c), SF m a (b, Event c))
forall (m :: * -> *) a b. MSF m a b -> a -> m (b, MSF m a b)
unMSF SF m a (b, Event c)
sf a
a
case (b, Event c)
o of
(b
_, Event c
c) -> (DTime -> DTime)
-> ClockInfo m (b, SF m a b) -> ClockInfo m (b, SF m a b)
forall r (m :: * -> *) a.
(r -> r) -> ReaderT r m a -> ReaderT r m a
local (DTime -> DTime -> DTime
forall a b. a -> b -> a
const DTime
0) (SF m a b -> a -> ClockInfo m (b, SF m a b)
forall (m :: * -> *) a b. MSF m a b -> a -> m (b, MSF m a b)
unMSF (c -> SF m a b
sfC c
c) a
a)
(b
b, Event c
NoEvent) -> (b, SF m a b) -> ClockInfo m (b, SF m a b)
forall a. a -> ReaderT DTime m a
forall (m :: * -> *) a. Monad m => a -> m a
return (b
b, SF m a (b, Event c) -> (c -> SF m a b) -> SF m a b
forall (m :: * -> *) a b c.
Monad m =>
SF m a (b, Event c) -> (c -> SF m a b) -> SF m a b
switch SF m a (b, Event c)
ct c -> SF m a b
sfC)
dSwitch :: Monad m => SF m a (b, Event c) -> (c -> SF m a b) -> SF m a b
dSwitch :: forall (m :: * -> *) a b c.
Monad m =>
SF m a (b, Event c) -> (c -> SF m a b) -> SF m a b
dSwitch SF m a (b, Event c)
sf c -> SF m a b
sfC = (a -> ClockInfo m (b, SF m a b)) -> SF m a b
forall (m :: * -> *) a b. (a -> m (b, MSF m a b)) -> MSF m a b
MSF ((a -> ClockInfo m (b, SF m a b)) -> SF m a b)
-> (a -> ClockInfo m (b, SF m a b)) -> SF m a b
forall a b. (a -> b) -> a -> b
$ \a
a -> do
((b, Event c)
o, SF m a (b, Event c)
ct) <- SF m a (b, Event c)
-> a -> ReaderT DTime m ((b, Event c), SF m a (b, Event c))
forall (m :: * -> *) a b. MSF m a b -> a -> m (b, MSF m a b)
unMSF SF m a (b, Event c)
sf a
a
case (b, Event c)
o of
(b
b, Event c
c) -> do (b
_, SF m a b
ct') <- (DTime -> DTime)
-> ClockInfo m (b, SF m a b) -> ClockInfo m (b, SF m a b)
forall r (m :: * -> *) a.
(r -> r) -> ReaderT r m a -> ReaderT r m a
local (DTime -> DTime -> DTime
forall a b. a -> b -> a
const DTime
0) (SF m a b -> a -> ClockInfo m (b, SF m a b)
forall (m :: * -> *) a b. MSF m a b -> a -> m (b, MSF m a b)
unMSF (c -> SF m a b
sfC c
c) a
a)
(b, SF m a b) -> ClockInfo m (b, SF m a b)
forall a. a -> ReaderT DTime m a
forall (m :: * -> *) a. Monad m => a -> m a
return (b
b, SF m a b
ct')
(b
b, Event c
NoEvent) -> (b, SF m a b) -> ClockInfo m (b, SF m a b)
forall a. a -> ReaderT DTime m a
forall (m :: * -> *) a. Monad m => a -> m a
return (b
b, SF m a (b, Event c) -> (c -> SF m a b) -> SF m a b
forall (m :: * -> *) a b c.
Monad m =>
SF m a (b, Event c) -> (c -> SF m a b) -> SF m a b
dSwitch SF m a (b, Event c)
ct c -> SF m a b
sfC)
#if MIN_VERSION_base(4,8,0)
parB :: Monad m => [SF m a b] -> SF m a [b]
#else
parB :: (Functor m, Monad m) => [SF m a b] -> SF m a [b]
#endif
parB :: forall (m :: * -> *) a b. Monad m => [SF m a b] -> SF m a [b]
parB = MSF (ListT (ClockInfo m)) a b -> MSF (ClockInfo m) a [b]
forall (m :: * -> *) a b.
(Functor m, Monad m) =>
MSF (ListT m) a b -> MSF m a [b]
widthFirst (MSF (ListT (ClockInfo m)) a b -> MSF (ClockInfo m) a [b])
-> ([SF m a b] -> MSF (ListT (ClockInfo m)) a b)
-> [SF m a b]
-> MSF (ClockInfo m) a [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SF m a b] -> MSF (ListT (ClockInfo m)) a b
forall (m :: * -> *) a b.
Monad m =>
[MSF m a b] -> MSF (ListT m) a b
sequenceS
dpSwitchB :: (Functor m, Monad m, Traversable col)
=> col (SF m a b)
-> SF m (a, col b) (Event c)
-> (col (SF m a b) -> c -> SF m a (col b))
-> SF m a (col b)
dpSwitchB :: forall (m :: * -> *) (col :: * -> *) a b c.
(Functor m, Monad m, Traversable col) =>
col (SF m a b)
-> SF m (a, col b) (Event c)
-> (col (SF m a b) -> c -> SF m a (col b))
-> SF m a (col b)
dpSwitchB col (SF m a b)
sfs SF m (a, col b) (Event c)
sfF col (SF m a b) -> c -> SF m a (col b)
sfCs = (a -> ClockInfo m (col b, SF m a (col b))) -> SF m a (col b)
forall (m :: * -> *) a b. (a -> m (b, MSF m a b)) -> MSF m a b
MSF ((a -> ClockInfo m (col b, SF m a (col b))) -> SF m a (col b))
-> (a -> ClockInfo m (col b, SF m a (col b))) -> SF m a (col b)
forall a b. (a -> b) -> a -> b
$ \a
a -> do
col (b, SF m a b)
res <- (SF m a b -> ReaderT DTime m (b, SF m a b))
-> col (SF m a b) -> ReaderT DTime m (col (b, SF m a b))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> col a -> m (col b)
T.mapM (SF m a b -> a -> ReaderT DTime m (b, SF m a b)
forall (m :: * -> *) a b. MSF m a b -> a -> m (b, MSF m a b)
`unMSF` a
a) col (SF m a b)
sfs
let bs :: col b
bs = ((b, SF m a b) -> b) -> col (b, SF m a b) -> col b
forall a b. (a -> b) -> col a -> col b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (b, SF m a b) -> b
forall a b. (a, b) -> a
fst col (b, SF m a b)
res
sfs' :: col (SF m a b)
sfs' = ((b, SF m a b) -> SF m a b) -> col (b, SF m a b) -> col (SF m a b)
forall a b. (a -> b) -> col a -> col b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (b, SF m a b) -> SF m a b
forall a b. (a, b) -> b
snd col (b, SF m a b)
res
(Event c
e, SF m (a, col b) (Event c)
sfF') <- SF m (a, col b) (Event c)
-> (a, col b)
-> ReaderT DTime m (Event c, SF m (a, col b) (Event c))
forall (m :: * -> *) a b. MSF m a b -> a -> m (b, MSF m a b)
unMSF SF m (a, col b) (Event c)
sfF (a
a, col b
bs)
SF m a (col b)
ct <- case Event c
e of
Event c
c -> (col b, SF m a (col b)) -> SF m a (col b)
forall a b. (a, b) -> b
snd ((col b, SF m a (col b)) -> SF m a (col b))
-> ClockInfo m (col b, SF m a (col b))
-> ReaderT DTime m (SF m a (col b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SF m a (col b) -> a -> ClockInfo m (col b, SF m a (col b))
forall (m :: * -> *) a b. MSF m a b -> a -> m (b, MSF m a b)
unMSF (col (SF m a b) -> c -> SF m a (col b)
sfCs col (SF m a b)
sfs c
c) a
a
Event c
NoEvent -> SF m a (col b) -> ReaderT DTime m (SF m a (col b))
forall a. a -> ReaderT DTime m a
forall (m :: * -> *) a. Monad m => a -> m a
return (col (SF m a b)
-> SF m (a, col b) (Event c)
-> (col (SF m a b) -> c -> SF m a (col b))
-> SF m a (col b)
forall (m :: * -> *) (col :: * -> *) a b c.
(Functor m, Monad m, Traversable col) =>
col (SF m a b)
-> SF m (a, col b) (Event c)
-> (col (SF m a b) -> c -> SF m a (col b))
-> SF m a (col b)
dpSwitchB col (SF m a b)
sfs' SF m (a, col b) (Event c)
sfF' col (SF m a b) -> c -> SF m a (col b)
sfCs)
(col b, SF m a (col b)) -> ClockInfo m (col b, SF m a (col b))
forall a. a -> ReaderT DTime m a
forall (m :: * -> *) a. Monad m => a -> m a
return (col b
bs, SF m a (col b)
ct)
parC :: Monad m => SF m a b -> SF m [a] [b]
parC :: forall (m :: * -> *) a b. Monad m => SF m a b -> SF m [a] [b]
parC = SF m a b -> SF m [a] [b]
forall (m :: * -> *) a b. Monad m => SF m a b -> SF m [a] [b]
parC0
where
parC0 :: Monad m => SF m a b -> SF m [a] [b]
parC0 :: forall (m :: * -> *) a b. Monad m => SF m a b -> SF m [a] [b]
parC0 SF m a b
sf0 = ([a] -> ClockInfo m ([b], MSF (ReaderT DTime m) [a] [b]))
-> MSF (ReaderT DTime m) [a] [b]
forall (m :: * -> *) a b. (a -> m (b, MSF m a b)) -> MSF m a b
MSF (([a] -> ClockInfo m ([b], MSF (ReaderT DTime m) [a] [b]))
-> MSF (ReaderT DTime m) [a] [b])
-> ([a] -> ClockInfo m ([b], MSF (ReaderT DTime m) [a] [b]))
-> MSF (ReaderT DTime m) [a] [b]
forall a b. (a -> b) -> a -> b
$ \[a]
as -> do
[(b, SF m a b)]
os <- ((a, SF m a b) -> ReaderT DTime m (b, SF m a b))
-> [(a, SF m a b)] -> ReaderT DTime m [(b, SF m a b)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
T.mapM (\(a
a, SF m a b
sf) -> SF m a b -> a -> ReaderT DTime m (b, SF m a b)
forall (m :: * -> *) a b. MSF m a b -> a -> m (b, MSF m a b)
unMSF SF m a b
sf a
a) ([(a, SF m a b)] -> ReaderT DTime m [(b, SF m a b)])
-> [(a, SF m a b)] -> ReaderT DTime m [(b, SF m a b)]
forall a b. (a -> b) -> a -> b
$
[a] -> [SF m a b] -> [(a, SF m a b)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
as (Int -> SF m a b -> [SF m a b]
forall a. Int -> a -> [a]
replicate ([a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
as) SF m a b
sf0)
let bs :: [b]
bs = ((b, SF m a b) -> b) -> [(b, SF m a b)] -> [b]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (b, SF m a b) -> b
forall a b. (a, b) -> a
fst [(b, SF m a b)]
os
cts :: [SF m a b]
cts = ((b, SF m a b) -> SF m a b) -> [(b, SF m a b)] -> [SF m a b]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (b, SF m a b) -> SF m a b
forall a b. (a, b) -> b
snd [(b, SF m a b)]
os
([b], MSF (ReaderT DTime m) [a] [b])
-> ClockInfo m ([b], MSF (ReaderT DTime m) [a] [b])
forall a. a -> ReaderT DTime m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([b]
bs, [SF m a b] -> MSF (ReaderT DTime m) [a] [b]
forall (m :: * -> *) a b. Monad m => [SF m a b] -> SF m [a] [b]
parC' [SF m a b]
cts)
parC' :: Monad m => [SF m a b] -> SF m [a] [b]
parC' :: forall (m :: * -> *) a b. Monad m => [SF m a b] -> SF m [a] [b]
parC' [SF m a b]
sfs = ([a] -> ClockInfo m ([b], MSF (ReaderT DTime m) [a] [b]))
-> MSF (ReaderT DTime m) [a] [b]
forall (m :: * -> *) a b. (a -> m (b, MSF m a b)) -> MSF m a b
MSF (([a] -> ClockInfo m ([b], MSF (ReaderT DTime m) [a] [b]))
-> MSF (ReaderT DTime m) [a] [b])
-> ([a] -> ClockInfo m ([b], MSF (ReaderT DTime m) [a] [b]))
-> MSF (ReaderT DTime m) [a] [b]
forall a b. (a -> b) -> a -> b
$ \[a]
as -> do
[(b, SF m a b)]
os <- ((a, SF m a b) -> ReaderT DTime m (b, SF m a b))
-> [(a, SF m a b)] -> ReaderT DTime m [(b, SF m a b)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
T.mapM (\(a
a, SF m a b
sf) -> SF m a b -> a -> ReaderT DTime m (b, SF m a b)
forall (m :: * -> *) a b. MSF m a b -> a -> m (b, MSF m a b)
unMSF SF m a b
sf a
a) ([(a, SF m a b)] -> ReaderT DTime m [(b, SF m a b)])
-> [(a, SF m a b)] -> ReaderT DTime m [(b, SF m a b)]
forall a b. (a -> b) -> a -> b
$ [a] -> [SF m a b] -> [(a, SF m a b)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
as [SF m a b]
sfs
let bs :: [b]
bs = ((b, SF m a b) -> b) -> [(b, SF m a b)] -> [b]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (b, SF m a b) -> b
forall a b. (a, b) -> a
fst [(b, SF m a b)]
os
cts :: [SF m a b]
cts = ((b, SF m a b) -> SF m a b) -> [(b, SF m a b)] -> [SF m a b]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (b, SF m a b) -> SF m a b
forall a b. (a, b) -> b
snd [(b, SF m a b)]
os
([b], MSF (ReaderT DTime m) [a] [b])
-> ClockInfo m ([b], MSF (ReaderT DTime m) [a] [b])
forall a. a -> ReaderT DTime m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([b]
bs, [SF m a b] -> MSF (ReaderT DTime m) [a] [b]
forall (m :: * -> *) a b. Monad m => [SF m a b] -> SF m [a] [b]
parC' [SF m a b]
cts)