{-# LANGUAGE RankNTypes #-}

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

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

-- automaton
import Data.Stream (StreamT (..))
import Data.Stream.Internal (JointState (..))
import Data.Stream.Optimized (toStreamT)
import Data.Stream.Result (Result (..), mapResultState)

-- rhine
import FRP.Rhine.ClSF hiding (step)
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 = ResamplingBuffer m cl1 cl2 a b
-> StreamT (ReaderT b (ReaderT (TimeInfo cl2) m)) c
-> ResamplingBuffer m cl1 cl2 a c
forall {m :: Type -> Type} {cla} {clb} {a} {b} {a}.
Monad m =>
ResamplingBuffer m cla clb a b
-> StreamT (ReaderT b (ReaderT (TimeInfo clb) m)) a
-> ResamplingBuffer m cla clb a a
helper ResamplingBuffer m cl1 cl2 a b
resbuf (StreamT (ReaderT b (ReaderT (TimeInfo cl2) m)) c
 -> ResamplingBuffer m cl1 cl2 a c)
-> StreamT (ReaderT b (ReaderT (TimeInfo cl2) m)) c
-> ResamplingBuffer m cl1 cl2 a c
forall a b. (a -> b) -> a -> b
$ OptimizedStreamT (ReaderT b (ReaderT (TimeInfo cl2) m)) c
-> StreamT (ReaderT b (ReaderT (TimeInfo cl2) m)) c
forall (m :: Type -> Type) b.
Functor m =>
OptimizedStreamT m b -> StreamT m b
toStreamT (OptimizedStreamT (ReaderT b (ReaderT (TimeInfo cl2) m)) c
 -> StreamT (ReaderT b (ReaderT (TimeInfo cl2) m)) c)
-> OptimizedStreamT (ReaderT b (ReaderT (TimeInfo cl2) m)) c
-> StreamT (ReaderT b (ReaderT (TimeInfo cl2) m)) c
forall a b. (a -> b) -> a -> b
$ ClSF m cl2 b c
-> OptimizedStreamT (ReaderT b (ReaderT (TimeInfo cl2) m)) c
forall (m :: Type -> Type) a b.
Automaton m a b -> OptimizedStreamT (ReaderT a m) b
getAutomaton ClSF m cl2 b c
clsf
  where
    helper :: ResamplingBuffer m cla clb a b
-> StreamT (ReaderT b (ReaderT (TimeInfo clb) m)) a
-> ResamplingBuffer m cla clb a a
helper ResamplingBuffer { s
buffer :: s
buffer :: ()
buffer, TimeInfo cla -> a -> s -> m s
put :: TimeInfo cla -> a -> s -> m s
put :: ()
put, TimeInfo clb -> s -> m (Result s b)
get :: TimeInfo clb -> s -> m (Result s b)
get :: ()
get} StreamT { s
state :: s
state :: ()
state, s -> ReaderT b (ReaderT (TimeInfo clb) m) (Result s a)
step :: s -> ReaderT b (ReaderT (TimeInfo clb) m) (Result s a)
step :: ()
step} = ResamplingBuffer
      { buffer :: JointState s s
buffer = s -> s -> JointState s s
forall a b. a -> b -> JointState a b
JointState s
buffer s
state,
      put :: TimeInfo cla -> a -> JointState s s -> m (JointState s s)
put = \TimeInfo cla
theTimeInfo a
a (JointState s
b s
s) -> (s -> s -> JointState s s
forall a b. a -> b -> JointState a b
`JointState` s
s) (s -> JointState s s) -> m s -> m (JointState s s)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> TimeInfo cla -> a -> s -> m s
put TimeInfo cla
theTimeInfo a
a s
b
      , get :: TimeInfo clb -> JointState s s -> m (Result (JointState s s) a)
get = \TimeInfo clb
theTimeInfo (JointState s
b s
s) -> do
          Result s
b' b
b <- TimeInfo clb -> s -> m (Result s b)
get TimeInfo clb
theTimeInfo s
b
          Result s
s' a
c <- s -> ReaderT b (ReaderT (TimeInfo clb) m) (Result s a)
step s
s ReaderT b (ReaderT (TimeInfo clb) m) (Result s a)
-> b -> ReaderT (TimeInfo clb) m (Result s a)
forall r (m :: Type -> Type) a. ReaderT r m a -> r -> m a
`runReaderT` b
b ReaderT (TimeInfo clb) m (Result s a)
-> TimeInfo clb -> m (Result s a)
forall r (m :: Type -> Type) a. ReaderT r m a -> r -> m a
`runReaderT` TimeInfo clb
theTimeInfo
          Result (JointState s s) a -> m (Result (JointState s s) a)
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Result (JointState s s) a -> m (Result (JointState s s) a))
-> Result (JointState s s) a -> m (Result (JointState s s) a)
forall a b. (a -> b) -> a -> b
$! JointState s s -> a -> Result (JointState s s) a
forall s a. s -> a -> Result s a
Result (s -> s -> JointState s s
forall a b. a -> b -> JointState a b
JointState s
b' s
s') a
c
      }

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 = StreamT (ReaderT a (ReaderT (TimeInfo cl1) m)) b
-> ResamplingBuffer m cl1 cl2 b c -> ResamplingBuffer m cl1 cl2 a c
forall {m :: Type -> Type} {r} {cla} {a} {clb} {b}.
Monad m =>
StreamT (ReaderT r (ReaderT (TimeInfo cla) m)) a
-> ResamplingBuffer m cla clb a b -> ResamplingBuffer m cla clb r b
helper (OptimizedStreamT (ReaderT a (ReaderT (TimeInfo cl1) m)) b
-> StreamT (ReaderT a (ReaderT (TimeInfo cl1) m)) b
forall (m :: Type -> Type) b.
Functor m =>
OptimizedStreamT m b -> StreamT m b
toStreamT (ClSF m cl1 a b
-> OptimizedStreamT (ReaderT a (ReaderT (TimeInfo cl1) m)) b
forall (m :: Type -> Type) a b.
Automaton m a b -> OptimizedStreamT (ReaderT a m) b
getAutomaton ClSF m cl1 a b
clsf)) ResamplingBuffer m cl1 cl2 b c
resBuf
  where
   helper :: StreamT (ReaderT r (ReaderT (TimeInfo cla) m)) a
-> ResamplingBuffer m cla clb a b -> ResamplingBuffer m cla clb r b
helper StreamT {s
state :: ()
state :: s
state, s -> ReaderT r (ReaderT (TimeInfo cla) m) (Result s a)
step :: ()
step :: s -> ReaderT r (ReaderT (TimeInfo cla) m) (Result s a)
step} ResamplingBuffer {s
buffer :: ()
buffer :: s
buffer, TimeInfo cla -> a -> s -> m s
put :: ()
put :: TimeInfo cla -> a -> s -> m s
put, TimeInfo clb -> s -> m (Result s b)
get :: ()
get :: TimeInfo clb -> s -> m (Result s b)
get} = ResamplingBuffer
      {
        buffer :: JointState s s
buffer = s -> s -> JointState s s
forall a b. a -> b -> JointState a b
JointState s
buffer s
state
    , put :: TimeInfo cla -> r -> JointState s s -> m (JointState s s)
put = \TimeInfo cla
theTimeInfo r
a (JointState s
buf s
s) -> do
      Result s
s' a
b <- s -> ReaderT r (ReaderT (TimeInfo cla) m) (Result s a)
step s
s ReaderT r (ReaderT (TimeInfo cla) m) (Result s a)
-> r -> ReaderT (TimeInfo cla) m (Result s a)
forall r (m :: Type -> Type) a. ReaderT r m a -> r -> m a
`runReaderT` r
a ReaderT (TimeInfo cla) m (Result s a)
-> TimeInfo cla -> m (Result s a)
forall r (m :: Type -> Type) a. ReaderT r m a -> r -> m a
`runReaderT` TimeInfo cla
theTimeInfo
      s
buf' <- TimeInfo cla -> a -> s -> m s
put TimeInfo cla
theTimeInfo a
b s
buf
      JointState s s -> m (JointState s s)
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (JointState s s -> m (JointState s s))
-> JointState s s -> m (JointState s s)
forall a b. (a -> b) -> a -> b
$! s -> s -> JointState s s
forall a b. a -> b -> JointState a b
JointState s
buf' s
s'
    , get :: TimeInfo clb -> JointState s s -> m (Result (JointState s s) b)
get = \TimeInfo clb
theTimeInfo (JointState s
buf s
s) -> (s -> JointState s s) -> Result s b -> Result (JointState s s) b
forall s1 s2 a. (s1 -> s2) -> Result s1 a -> Result s2 a
mapResultState (s -> s -> JointState s s
forall a b. a -> b -> JointState a b
`JointState` s
s) (Result s b -> Result (JointState s s) b)
-> m (Result s b) -> m (Result (JointState s s) b)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> TimeInfo clb -> s -> m (Result s b)
get TimeInfo clb
theTimeInfo s
buf
      }

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 s
buf1 TimeInfo cl1 -> a -> s -> m s
put1 TimeInfo cl2 -> s -> m (Result s b)
get1 *-* :: 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 s
buf2 TimeInfo cl1 -> c -> s -> m s
put2 TimeInfo cl2 -> s -> m (Result s d)
get2 = ResamplingBuffer
  {
    buffer :: JointState s s
buffer = s -> s -> JointState s s
forall a b. a -> b -> JointState a b
JointState s
buf1 s
buf2
  , put :: TimeInfo cl1 -> (a, c) -> JointState s s -> m (JointState s s)
put = \TimeInfo cl1
theTimeInfo (a
a, c
c) (JointState s
s1 s
s2) -> do
      s
s1' <- TimeInfo cl1 -> a -> s -> m s
put1 TimeInfo cl1
theTimeInfo a
a s
s1
      s
s2' <- TimeInfo cl1 -> c -> s -> m s
put2 TimeInfo cl1
theTimeInfo c
c s
s2
      JointState s s -> m (JointState s s)
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (JointState s s -> m (JointState s s))
-> JointState s s -> m (JointState s s)
forall a b. (a -> b) -> a -> b
$! s -> s -> JointState s s
forall a b. a -> b -> JointState a b
JointState s
s1' s
s2'
  , get :: TimeInfo cl2
-> JointState s s -> m (Result (JointState s s) (b, d))
get = \TimeInfo cl2
theTimeInfo (JointState s
s1 s
s2) -> do
      Result s
s1' b
b <- TimeInfo cl2 -> s -> m (Result s b)
get1 TimeInfo cl2
theTimeInfo s
s1
      Result s
s2' d
d <- TimeInfo cl2 -> s -> m (Result s d)
get2 TimeInfo cl2
theTimeInfo s
s2
      Result (JointState s s) (b, d)
-> m (Result (JointState s s) (b, d))
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Result (JointState s s) (b, d)
 -> m (Result (JointState s s) (b, d)))
-> Result (JointState s s) (b, d)
-> m (Result (JointState s s) (b, d))
forall a b. (a -> b) -> a -> b
$! JointState s s -> (b, d) -> Result (JointState s s) (b, d)
forall s a. s -> a -> Result s a
Result (s -> s -> JointState s s
forall a b. a -> b -> JointState a b
JointState s
s1' s
s2') (b
b, d
d)
  }

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 = (a -> (a, a)) -> Automaton (ReaderT (TimeInfo cl1) m) a (a, a)
forall b c. (b -> c) -> Automaton (ReaderT (TimeInfo cl1) m) b c
forall (a :: Type -> Type -> Type) b c.
Arrow a =>
(b -> c) -> a b c
arr (\a
a -> (a
a, a
a)) Automaton (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 (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 = (ClSF m cl a a
forall (m :: Type -> Type) cl a. Monad m => ClSF m cl a a
clId ClSF m cl a a
-> Automaton (ReaderT (TimeInfo cl) m) a (TimeInfo cl)
-> Automaton (ReaderT (TimeInfo cl) m) a (a, TimeInfo cl)
forall b c c'.
Automaton (ReaderT (TimeInfo cl) m) b c
-> Automaton (ReaderT (TimeInfo cl) m) b c'
-> Automaton (ReaderT (TimeInfo cl) m) b (c, c')
forall (a :: Type -> Type -> Type) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Automaton (ReaderT (TimeInfo cl) m) a (TimeInfo cl)
forall (m :: Type -> Type) cl a.
Monad m =>
ClSF m cl a (TimeInfo cl)
timeInfo) Automaton (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