{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}

{- |
This module introduces 'ResamplingBuffer's,
which are primitives that consume and produce data at different rates.
Just as schedules form the boundaries between different clocks,
(resampling) buffers form the boundaries between
synchronous signal functions ticking at different speeds.
-}
module FRP.Rhine.ResamplingBuffer (
  module FRP.Rhine.ResamplingBuffer,
  module FRP.Rhine.Clock,
)
where

-- profunctors
import Data.Profunctor (Profunctor (..))

-- automaton
import Data.Stream.Result

-- rhine
import FRP.Rhine.Clock

-- A quick note on naming conventions, to whoever cares:
-- . Call a single clock @cl@.
-- . Call several clocks @cl1@, @cl2@ etc. in most situations.
-- . Call it @cla@, @clb@ etc. when they are 'In' or 'Out' clocks,
-- i.e. associated to particular boundary types @a@, @b@ etc.,

{- | A stateful buffer from which one may 'get' a value,
or to which one may 'put' a value,
depending on the clocks.
'ResamplingBuffer's can be clock-polymorphic,
or specific to certain clocks.

* 'm': Monad in which the 'ResamplingBuffer' may have side effects
* 'cla': The clock at which data enters the buffer
* 'clb': The clock at which data leaves the buffer
* 'a': The input type
* 'b': The output type
-}
data ResamplingBuffer m cla clb a b = forall s.
  ResamplingBuffer
  { ()
buffer :: s
  -- ^ The internal state of the buffer.
  , ()
put ::
      TimeInfo cla ->
      a ->
      s ->
      m s
  -- ^ Store one input value of type 'a' at a given time stamp,
  --   and return an updated state.
  , ()
get ::
      TimeInfo clb ->
      s ->
      m (Result s b)
  -- ^ Retrieve one output value of type 'b' at a given time stamp,
  --   and an updated state.
  }

-- | A type synonym to allow for abbreviation.
type ResBuf m cla clb a b = ResamplingBuffer m cla clb a b

-- | Hoist a 'ResamplingBuffer' along a monad morphism.
hoistResamplingBuffer ::
  (Monad m1, Monad m2) =>
  (forall c. m1 c -> m2 c) ->
  ResamplingBuffer m1 cla clb a b ->
  ResamplingBuffer m2 cla clb a b
hoistResamplingBuffer :: forall (m1 :: Type -> Type) (m2 :: Type -> Type) cla clb a b.
(Monad m1, Monad m2) =>
(forall c. m1 c -> m2 c)
-> ResamplingBuffer m1 cla clb a b
-> ResamplingBuffer m2 cla clb a b
hoistResamplingBuffer forall c. m1 c -> m2 c
morph ResamplingBuffer {s
TimeInfo cla -> a -> s -> m1 s
TimeInfo clb -> s -> m1 (Result s b)
get :: ()
put :: ()
buffer :: ()
buffer :: s
put :: TimeInfo cla -> a -> s -> m1 s
get :: TimeInfo clb -> s -> m1 (Result s b)
..} =
  ResamplingBuffer
    { put :: TimeInfo cla -> a -> s -> m2 s
put = ((m1 s -> m2 s
forall c. m1 c -> m2 c
morph (m1 s -> m2 s) -> (s -> m1 s) -> s -> m2 s
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((s -> m1 s) -> s -> m2 s) -> (a -> s -> m1 s) -> a -> s -> m2 s
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((a -> s -> m1 s) -> a -> s -> m2 s)
-> (TimeInfo cla -> a -> s -> m1 s)
-> TimeInfo cla
-> a
-> s
-> m2 s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeInfo cla -> a -> s -> m1 s
put
    , get :: TimeInfo clb -> s -> m2 (Result s b)
get = (m1 (Result s b) -> m2 (Result s b)
forall c. m1 c -> m2 c
morph (m1 (Result s b) -> m2 (Result s b))
-> (s -> m1 (Result s b)) -> s -> m2 (Result s b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((s -> m1 (Result s b)) -> s -> m2 (Result s b))
-> (TimeInfo clb -> s -> m1 (Result s b))
-> TimeInfo clb
-> s
-> m2 (Result s b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeInfo clb -> s -> m1 (Result s b)
get
    , s
buffer :: s
buffer :: s
buffer
    }

instance (Functor m) => Profunctor (ResamplingBuffer m cla clb) where
  lmap :: forall a b c.
(a -> b)
-> ResamplingBuffer m cla clb b c -> ResamplingBuffer m cla clb a c
lmap a -> b
f ResamplingBuffer {TimeInfo cla -> b -> s -> m s
put :: ()
put :: TimeInfo cla -> b -> s -> m s
put, TimeInfo clb -> s -> m (Result s c)
get :: ()
get :: TimeInfo clb -> s -> m (Result s c)
get, s
buffer :: ()
buffer :: s
buffer} =
    ResamplingBuffer
      { put :: TimeInfo cla -> a -> s -> m s
put = ((b -> s -> m s) -> (a -> b) -> a -> s -> m s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) ((b -> s -> m s) -> a -> s -> m s)
-> (TimeInfo cla -> b -> s -> m s) -> TimeInfo cla -> a -> s -> m s
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> TimeInfo cla -> b -> s -> m s
put
      , TimeInfo clb -> s -> m (Result s c)
get :: TimeInfo clb -> s -> m (Result s c)
get :: TimeInfo clb -> s -> m (Result s c)
get
      , s
buffer :: s
buffer :: s
buffer
      }
  rmap :: forall b c a.
(b -> c)
-> ResamplingBuffer m cla clb a b -> ResamplingBuffer m cla clb a c
rmap = (b -> c)
-> ResamplingBuffer m cla clb a b -> ResamplingBuffer m cla clb a c
forall a b.
(a -> b)
-> ResamplingBuffer m cla clb a a -> ResamplingBuffer m cla clb a b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap

instance (Functor m) => Functor (ResamplingBuffer m cla clb a) where
  fmap :: forall a b.
(a -> b)
-> ResamplingBuffer m cla clb a a -> ResamplingBuffer m cla clb a b
fmap a -> b
f ResamplingBuffer {TimeInfo cla -> a -> s -> m s
put :: ()
put :: TimeInfo cla -> a -> s -> m s
put, TimeInfo clb -> s -> m (Result s a)
get :: ()
get :: TimeInfo clb -> s -> m (Result s a)
get, s
buffer :: ()
buffer :: s
buffer} =
    ResamplingBuffer
      { TimeInfo cla -> a -> s -> m s
put :: TimeInfo cla -> a -> s -> m s
put :: TimeInfo cla -> a -> s -> m s
put
      , get :: TimeInfo clb -> s -> m (Result s b)
get = (m (Result s a) -> m (Result s b))
-> (s -> m (Result s a)) -> s -> m (Result s b)
forall a b. (a -> b) -> (s -> a) -> s -> b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Result s a -> Result s b) -> m (Result s a) -> m (Result s b)
forall a b. (a -> b) -> m a -> m b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> Result s a -> Result s b
forall a b. (a -> b) -> Result s a -> Result s b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f)) ((s -> m (Result s a)) -> s -> m (Result s b))
-> (TimeInfo clb -> s -> m (Result s a))
-> TimeInfo clb
-> s
-> m (Result s b)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> TimeInfo clb -> s -> m (Result s a)
get
      , s
buffer :: s
buffer :: s
buffer
      }