{- |
Several utilities to create 'ResamplingBuffer's.
-}

{-# LANGUAGE RankNTypes #-}
module FRP.Rhine.ResamplingBuffer.Util where

-- transformers
import Control.Monad.Trans.Reader (runReaderT)

-- dunai
import Data.MonadicStreamFunction.InternalCore

-- rhine
import FRP.Rhine.Clock
import FRP.Rhine.ClSF
import FRP.Rhine.ResamplingBuffer

-- * Utilities to build 'ResamplingBuffer's from smaller components

infix 2 >>-^
-- | Postcompose a 'ResamplingBuffer' with a matching 'ClSF'.
(>>-^) :: Monad m
      => ResamplingBuffer m cl1 cl2 a b
      -> ClSF             m     cl2   b c
      -> ResamplingBuffer m cl1 cl2 a   c
ResamplingBuffer m cl1 cl2 a b
resBuf >>-^ :: ResamplingBuffer m cl1 cl2 a b
-> ClSF m cl2 b c -> ResamplingBuffer m cl1 cl2 a c
>>-^ ClSF m cl2 b c
clsf = (TimeInfo cl1 -> a -> m (ResamplingBuffer m cl1 cl2 a c))
-> (TimeInfo cl2 -> m (c, ResamplingBuffer m cl1 cl2 a c))
-> ResamplingBuffer m cl1 cl2 a c
forall (m :: Type -> Type) cla clb a b.
(TimeInfo cla -> a -> m (ResamplingBuffer m cla clb a b))
-> (TimeInfo clb -> m (b, ResamplingBuffer m cla clb a b))
-> ResamplingBuffer m cla clb a b
ResamplingBuffer TimeInfo cl1 -> a -> m (ResamplingBuffer m cl1 cl2 a c)
put_ TimeInfo cl2 -> m (c, ResamplingBuffer m cl1 cl2 a c)
get_
  where
    put_ :: TimeInfo cl1 -> a -> m (ResamplingBuffer m cl1 cl2 a c)
put_ TimeInfo cl1
theTimeInfo a
a = (ResamplingBuffer m cl1 cl2 a b
-> ClSF m cl2 b c -> ResamplingBuffer m cl1 cl2 a c
forall (m :: Type -> Type) cl1 cl2 a b c.
Monad m =>
ResamplingBuffer m cl1 cl2 a b
-> ClSF m cl2 b c -> ResamplingBuffer m cl1 cl2 a c
>>-^ ClSF m cl2 b c
clsf) (ResamplingBuffer m cl1 cl2 a b -> ResamplingBuffer m cl1 cl2 a c)
-> m (ResamplingBuffer m cl1 cl2 a b)
-> m (ResamplingBuffer m cl1 cl2 a c)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ResamplingBuffer m cl1 cl2 a b
-> TimeInfo cl1 -> a -> m (ResamplingBuffer m cl1 cl2 a b)
forall (m :: Type -> Type) cla clb a b.
ResamplingBuffer m cla clb a b
-> TimeInfo cla -> a -> m (ResamplingBuffer m cla clb a b)
put ResamplingBuffer m cl1 cl2 a b
resBuf TimeInfo cl1
theTimeInfo a
a
    get_ :: TimeInfo cl2 -> m (c, ResamplingBuffer m cl1 cl2 a c)
get_ TimeInfo cl2
theTimeInfo   = do
      (b
b, ResamplingBuffer m cl1 cl2 a b
resBuf') <- ResamplingBuffer m cl1 cl2 a b
-> TimeInfo cl2 -> m (b, ResamplingBuffer m cl1 cl2 a b)
forall (m :: Type -> Type) cla clb a b.
ResamplingBuffer m cla clb a b
-> TimeInfo clb -> m (b, ResamplingBuffer m cla clb a b)
get ResamplingBuffer m cl1 cl2 a b
resBuf TimeInfo cl2
theTimeInfo
      (c
c, ClSF m cl2 b c
clsf')   <- ClSF m cl2 b c -> b -> ReaderT (TimeInfo cl2) m (c, ClSF m cl2 b c)
forall (m :: Type -> Type) a b. MSF m a b -> a -> m (b, MSF m a b)
unMSF ClSF m cl2 b c
clsf b
b ReaderT (TimeInfo cl2) m (c, ClSF m cl2 b c)
-> TimeInfo cl2 -> m (c, ClSF m cl2 b c)
forall r (m :: Type -> Type) a. ReaderT r m a -> r -> m a
`runReaderT` TimeInfo cl2
theTimeInfo
      (c, ResamplingBuffer m cl1 cl2 a c)
-> m (c, ResamplingBuffer m cl1 cl2 a c)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (c
c, ResamplingBuffer m cl1 cl2 a b
resBuf' ResamplingBuffer m cl1 cl2 a b
-> ClSF m cl2 b c -> ResamplingBuffer m cl1 cl2 a c
forall (m :: Type -> Type) cl1 cl2 a b c.
Monad m =>
ResamplingBuffer m cl1 cl2 a b
-> ClSF m cl2 b c -> ResamplingBuffer m cl1 cl2 a c
>>-^ ClSF m cl2 b c
clsf')


infix 1 ^->>
-- | Precompose a 'ResamplingBuffer' with a matching 'ClSF'.
(^->>) :: Monad m
      => ClSF             m cl1     a b
      -> ResamplingBuffer m cl1 cl2   b c
      -> ResamplingBuffer m cl1 cl2 a   c
ClSF m cl1 a b
clsf ^->> :: ClSF m cl1 a b
-> ResamplingBuffer m cl1 cl2 b c -> ResamplingBuffer m cl1 cl2 a c
^->> ResamplingBuffer m cl1 cl2 b c
resBuf = (TimeInfo cl1 -> a -> m (ResamplingBuffer m cl1 cl2 a c))
-> (TimeInfo cl2 -> m (c, ResamplingBuffer m cl1 cl2 a c))
-> ResamplingBuffer m cl1 cl2 a c
forall (m :: Type -> Type) cla clb a b.
(TimeInfo cla -> a -> m (ResamplingBuffer m cla clb a b))
-> (TimeInfo clb -> m (b, ResamplingBuffer m cla clb a b))
-> ResamplingBuffer m cla clb a b
ResamplingBuffer TimeInfo cl1 -> a -> m (ResamplingBuffer m cl1 cl2 a c)
put_ TimeInfo cl2 -> m (c, ResamplingBuffer m cl1 cl2 a c)
get_
  where
    put_ :: TimeInfo cl1 -> a -> m (ResamplingBuffer m cl1 cl2 a c)
put_ TimeInfo cl1
theTimeInfo a
a = do
      (b
b, ClSF m cl1 a b
clsf') <- ClSF m cl1 a b -> a -> ReaderT (TimeInfo cl1) m (b, ClSF m cl1 a b)
forall (m :: Type -> Type) a b. MSF m a b -> a -> m (b, MSF m a b)
unMSF ClSF m cl1 a b
clsf a
a ReaderT (TimeInfo cl1) m (b, ClSF m cl1 a b)
-> TimeInfo cl1 -> m (b, ClSF m cl1 a b)
forall r (m :: Type -> Type) a. ReaderT r m a -> r -> m a
`runReaderT` TimeInfo cl1
theTimeInfo
      ResamplingBuffer m cl1 cl2 b c
resBuf'    <- ResamplingBuffer m cl1 cl2 b c
-> TimeInfo cl1 -> b -> m (ResamplingBuffer m cl1 cl2 b c)
forall (m :: Type -> Type) cla clb a b.
ResamplingBuffer m cla clb a b
-> TimeInfo cla -> a -> m (ResamplingBuffer m cla clb a b)
put ResamplingBuffer m cl1 cl2 b c
resBuf TimeInfo cl1
theTimeInfo b
b
      ResamplingBuffer m cl1 cl2 a c
-> m (ResamplingBuffer m cl1 cl2 a c)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (ResamplingBuffer m cl1 cl2 a c
 -> m (ResamplingBuffer m cl1 cl2 a c))
-> ResamplingBuffer m cl1 cl2 a c
-> m (ResamplingBuffer m cl1 cl2 a c)
forall a b. (a -> b) -> a -> b
$ ClSF m cl1 a b
clsf' ClSF m cl1 a b
-> ResamplingBuffer m cl1 cl2 b c -> ResamplingBuffer m cl1 cl2 a c
forall (m :: Type -> Type) cl1 a b cl2 c.
Monad m =>
ClSF m cl1 a b
-> ResamplingBuffer m cl1 cl2 b c -> ResamplingBuffer m cl1 cl2 a c
^->> ResamplingBuffer m cl1 cl2 b c
resBuf'
    get_ :: TimeInfo cl2 -> m (c, ResamplingBuffer m cl1 cl2 a c)
get_ TimeInfo cl2
theTimeInfo   = (ResamplingBuffer m cl1 cl2 b c -> ResamplingBuffer m cl1 cl2 a c)
-> (c, ResamplingBuffer m cl1 cl2 b c)
-> (c, ResamplingBuffer m cl1 cl2 a c)
forall (a :: Type -> Type -> Type) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (ClSF m cl1 a b
clsf ClSF m cl1 a b
-> ResamplingBuffer m cl1 cl2 b c -> ResamplingBuffer m cl1 cl2 a c
forall (m :: Type -> Type) cl1 a b cl2 c.
Monad m =>
ClSF m cl1 a b
-> ResamplingBuffer m cl1 cl2 b c -> ResamplingBuffer m cl1 cl2 a c
^->>) ((c, ResamplingBuffer m cl1 cl2 b c)
 -> (c, ResamplingBuffer m cl1 cl2 a c))
-> m (c, ResamplingBuffer m cl1 cl2 b c)
-> m (c, ResamplingBuffer m cl1 cl2 a c)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ResamplingBuffer m cl1 cl2 b c
-> TimeInfo cl2 -> m (c, ResamplingBuffer m cl1 cl2 b c)
forall (m :: Type -> Type) cla clb a b.
ResamplingBuffer m cla clb a b
-> TimeInfo clb -> m (b, ResamplingBuffer m cla clb a b)
get ResamplingBuffer m cl1 cl2 b c
resBuf TimeInfo cl2
theTimeInfo


infixl 4 *-*
-- | Parallely compose two 'ResamplingBuffer's.
(*-*) :: Monad m
      => ResamplingBuffer m cl1 cl2  a      b
      -> ResamplingBuffer m cl1 cl2     c      d
      -> ResamplingBuffer m cl1 cl2 (a, c) (b, d)
ResamplingBuffer m cl1 cl2 a b
resBuf1 *-* :: ResamplingBuffer m cl1 cl2 a b
-> ResamplingBuffer m cl1 cl2 c d
-> ResamplingBuffer m cl1 cl2 (a, c) (b, d)
*-* ResamplingBuffer m cl1 cl2 c d
resBuf2 = (TimeInfo cl1
 -> (a, c) -> m (ResamplingBuffer m cl1 cl2 (a, c) (b, d)))
-> (TimeInfo cl2
    -> m ((b, d), ResamplingBuffer m cl1 cl2 (a, c) (b, d)))
-> ResamplingBuffer m cl1 cl2 (a, c) (b, d)
forall (m :: Type -> Type) cla clb a b.
(TimeInfo cla -> a -> m (ResamplingBuffer m cla clb a b))
-> (TimeInfo clb -> m (b, ResamplingBuffer m cla clb a b))
-> ResamplingBuffer m cla clb a b
ResamplingBuffer TimeInfo cl1
-> (a, c) -> m (ResamplingBuffer m cl1 cl2 (a, c) (b, d))
put_ TimeInfo cl2
-> m ((b, d), ResamplingBuffer m cl1 cl2 (a, c) (b, d))
get_
  where
    put_ :: TimeInfo cl1
-> (a, c) -> m (ResamplingBuffer m cl1 cl2 (a, c) (b, d))
put_ TimeInfo cl1
theTimeInfo (a
a, c
c) = do
      ResamplingBuffer m cl1 cl2 a b
resBuf1' <- ResamplingBuffer m cl1 cl2 a b
-> TimeInfo cl1 -> a -> m (ResamplingBuffer m cl1 cl2 a b)
forall (m :: Type -> Type) cla clb a b.
ResamplingBuffer m cla clb a b
-> TimeInfo cla -> a -> m (ResamplingBuffer m cla clb a b)
put ResamplingBuffer m cl1 cl2 a b
resBuf1 TimeInfo cl1
theTimeInfo a
a
      ResamplingBuffer m cl1 cl2 c d
resBuf2' <- ResamplingBuffer m cl1 cl2 c d
-> TimeInfo cl1 -> c -> m (ResamplingBuffer m cl1 cl2 c d)
forall (m :: Type -> Type) cla clb a b.
ResamplingBuffer m cla clb a b
-> TimeInfo cla -> a -> m (ResamplingBuffer m cla clb a b)
put ResamplingBuffer m cl1 cl2 c d
resBuf2 TimeInfo cl1
theTimeInfo c
c
      ResamplingBuffer m cl1 cl2 (a, c) (b, d)
-> m (ResamplingBuffer m cl1 cl2 (a, c) (b, d))
forall (m :: Type -> Type) a. Monad m => a -> m a
return (ResamplingBuffer m cl1 cl2 (a, c) (b, d)
 -> m (ResamplingBuffer m cl1 cl2 (a, c) (b, d)))
-> ResamplingBuffer m cl1 cl2 (a, c) (b, d)
-> m (ResamplingBuffer m cl1 cl2 (a, c) (b, d))
forall a b. (a -> b) -> a -> b
$ ResamplingBuffer m cl1 cl2 a b
resBuf1' ResamplingBuffer m cl1 cl2 a b
-> ResamplingBuffer m cl1 cl2 c d
-> ResamplingBuffer m cl1 cl2 (a, c) (b, d)
forall (m :: Type -> Type) cl1 cl2 a b c d.
Monad m =>
ResamplingBuffer m cl1 cl2 a b
-> ResamplingBuffer m cl1 cl2 c d
-> ResamplingBuffer m cl1 cl2 (a, c) (b, d)
*-* ResamplingBuffer m cl1 cl2 c d
resBuf2'
    get_ :: TimeInfo cl2
-> m ((b, d), ResamplingBuffer m cl1 cl2 (a, c) (b, d))
get_ TimeInfo cl2
theTimeInfo        = do
      (b
b, ResamplingBuffer m cl1 cl2 a b
resBuf1') <- ResamplingBuffer m cl1 cl2 a b
-> TimeInfo cl2 -> m (b, ResamplingBuffer m cl1 cl2 a b)
forall (m :: Type -> Type) cla clb a b.
ResamplingBuffer m cla clb a b
-> TimeInfo clb -> m (b, ResamplingBuffer m cla clb a b)
get ResamplingBuffer m cl1 cl2 a b
resBuf1 TimeInfo cl2
theTimeInfo
      (d
d, ResamplingBuffer m cl1 cl2 c d
resBuf2') <- ResamplingBuffer m cl1 cl2 c d
-> TimeInfo cl2 -> m (d, ResamplingBuffer m cl1 cl2 c d)
forall (m :: Type -> Type) cla clb a b.
ResamplingBuffer m cla clb a b
-> TimeInfo clb -> m (b, ResamplingBuffer m cla clb a b)
get ResamplingBuffer m cl1 cl2 c d
resBuf2 TimeInfo cl2
theTimeInfo
      ((b, d), ResamplingBuffer m cl1 cl2 (a, c) (b, d))
-> m ((b, d), ResamplingBuffer m cl1 cl2 (a, c) (b, d))
forall (m :: Type -> Type) a. Monad m => a -> m a
return ((b
b, d
d), ResamplingBuffer m cl1 cl2 a b
resBuf1' ResamplingBuffer m cl1 cl2 a b
-> ResamplingBuffer m cl1 cl2 c d
-> ResamplingBuffer m cl1 cl2 (a, c) (b, d)
forall (m :: Type -> Type) cl1 cl2 a b c d.
Monad m =>
ResamplingBuffer m cl1 cl2 a b
-> ResamplingBuffer m cl1 cl2 c d
-> ResamplingBuffer m cl1 cl2 (a, c) (b, d)
*-* ResamplingBuffer m cl1 cl2 c d
resBuf2')

infixl 4 &-&
-- | Parallely compose two 'ResamplingBuffer's, duplicating the input.
(&-&) :: Monad m
      => ResamplingBuffer m cl1 cl2  a  b
      -> ResamplingBuffer m cl1 cl2  a     c
      -> ResamplingBuffer m cl1 cl2  a (b, c)
ResamplingBuffer m cl1 cl2 a b
resBuf1 &-& :: ResamplingBuffer m cl1 cl2 a b
-> ResamplingBuffer m cl1 cl2 a c
-> ResamplingBuffer m cl1 cl2 a (b, c)
&-& ResamplingBuffer m cl1 cl2 a c
resBuf2 = (a -> (a, a)) -> MSF (ReaderT (TimeInfo cl1) m) a (a, a)
forall (a :: Type -> Type -> Type) b c.
Arrow a =>
(b -> c) -> a b c
arr (\a
a -> (a
a, a
a)) MSF (ReaderT (TimeInfo cl1) m) a (a, a)
-> ResamplingBuffer m cl1 cl2 (a, a) (b, c)
-> ResamplingBuffer m cl1 cl2 a (b, c)
forall (m :: Type -> Type) cl1 a b cl2 c.
Monad m =>
ClSF m cl1 a b
-> ResamplingBuffer m cl1 cl2 b c -> ResamplingBuffer m cl1 cl2 a c
^->> ResamplingBuffer m cl1 cl2 a b
resBuf1 ResamplingBuffer m cl1 cl2 a b
-> ResamplingBuffer m cl1 cl2 a c
-> ResamplingBuffer m cl1 cl2 (a, a) (b, c)
forall (m :: Type -> Type) cl1 cl2 a b c d.
Monad m =>
ResamplingBuffer m cl1 cl2 a b
-> ResamplingBuffer m cl1 cl2 c d
-> ResamplingBuffer m cl1 cl2 (a, c) (b, d)
*-* ResamplingBuffer m cl1 cl2 a c
resBuf2


-- | Given a 'ResamplingBuffer' where the output type depends on the input type polymorphically,
--   we can produce a timestamped version that simply annotates every input value
--   with the 'TimeInfo' when it arrived.
timestamped
  :: Monad m
  => (forall b. ResamplingBuffer m cl clf b (f b))
  -> ResamplingBuffer m cl clf a (f (a, TimeInfo cl))
timestamped :: (forall b. ResamplingBuffer m cl clf b (f b))
-> ResamplingBuffer m cl clf a (f (a, TimeInfo cl))
timestamped forall b. ResamplingBuffer m cl clf b (f b)
resBuf = (ClSF m cl a a
forall (m :: Type -> Type) cl a. Monad m => ClSF m cl a a
clId ClSF m cl a a
-> MSF (ReaderT (TimeInfo cl) m) a (TimeInfo cl)
-> MSF (ReaderT (TimeInfo cl) m) a (a, TimeInfo cl)
forall (a :: Type -> Type -> Type) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& MSF (ReaderT (TimeInfo cl) m) a (TimeInfo cl)
forall (m :: Type -> Type) cl a.
Monad m =>
ClSF m cl a (TimeInfo cl)
timeInfo) MSF (ReaderT (TimeInfo cl) m) a (a, TimeInfo cl)
-> ResamplingBuffer m cl clf (a, TimeInfo cl) (f (a, TimeInfo cl))
-> ResamplingBuffer m cl clf a (f (a, TimeInfo cl))
forall (m :: Type -> Type) cl1 a b cl2 c.
Monad m =>
ClSF m cl1 a b
-> ResamplingBuffer m cl1 cl2 b c -> ResamplingBuffer m cl1 cl2 a c
^->> ResamplingBuffer m cl clf (a, TimeInfo cl) (f (a, TimeInfo cl))
forall b. ResamplingBuffer m cl clf b (f b)
resBuf