{-# LANGUAGE RankNTypes #-}

{- |
Several utilities to create 'ResamplingBuffer's.
-}
module FRP.Rhine.ResamplingBuffer.Util where

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

-- dunai
import Data.MonadicStreamFunction.InternalCore

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

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

infix 2 >>-^

{- FOURMOLU_DISABLE -}

-- | 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 >>-^ :: 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 = 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 = (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) forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f 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') <- 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') <- 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 forall r (m :: Type -> Type) a. ReaderT r m a -> r -> m a
`runReaderT` TimeInfo cl2
theTimeInfo
      forall (m :: Type -> Type) a. Monad m => a -> m a
return (c
c, ResamplingBuffer m cl1 cl2 a b
resBuf' 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 ^->> :: 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 = 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') <- 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 forall r (m :: Type -> Type) a. ReaderT r m a -> r -> m a
`runReaderT` TimeInfo cl1
theTimeInfo
      ResamplingBuffer m cl1 cl2 b c
resBuf' <- 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
      forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ClSF m cl1 a b
clsf' 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 = 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 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
^->>) forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f 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 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 *-* :: 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 = 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' <- 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' <- 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
      forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ResamplingBuffer m cl1 cl2 a b
resBuf1' 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') <- 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') <- 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
      forall (m :: Type -> Type) a. Monad m => a -> m a
return ((b
b, d
d), ResamplingBuffer m cl1 cl2 a b
resBuf1' 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 &-& :: forall (m :: Type -> Type) cl1 cl2 a b c.
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 c
resBuf2 = forall (a :: Type -> Type -> Type) b c.
Arrow a =>
(b -> c) -> a b c
arr (\a
a -> (a
a, a
a)) 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 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 (m :: Type -> Type) cl clf (f :: Type -> Type) a.
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)
resBuf = (forall (m :: Type -> Type) cl a. Monad m => ClSF m cl a a
clId forall (a :: Type -> Type -> Type) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& forall (m :: Type -> Type) cl a.
Monad m =>
ClSF m cl a (TimeInfo cl)
timeInfo) 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
^->> forall b. ResamplingBuffer m cl clf b (f b)
resBuf