{-# LANGUAGE RecordWildCards #-}

{- |
Resampling buffers from asynchronous Mealy machines.
These are used in many other modules implementing 'ResamplingBuffer's.
-}
module FRP.Rhine.ResamplingBuffer.Timeless where

-- automaton
import Data.Stream.Result

-- rhine
import FRP.Rhine.ResamplingBuffer

{- | An asynchronous, effectful Mealy machine description.
   (Input and output do not happen simultaneously.)
   It can be used to create 'ResamplingBuffer's.
-}
{- FOURMOLU_DISABLE -}
data AsyncMealy m s a b = AsyncMealy
  { forall (m :: Type -> Type) s a b.
AsyncMealy m s a b -> s -> a -> m s
amPut :: s -> a -> m         s
  -- ^ Given the previous state and an input value, return the new state.
  , forall (m :: Type -> Type) s a b.
AsyncMealy m s a b -> s -> m (Result s b)
amGet :: s      -> m (Result s b)
  -- ^ Given the previous state, return an output value and a new state.
  }
{- FOURMOLU_ENABLE -}

{- | A resampling buffer that is unaware of the time information of the clock,
   and thus clock-polymorphic.
   It is built from an asynchronous Mealy machine description.
   Whenever 'get' is called on @timelessResamplingBuffer machine s@,
   the method 'amGet' is called on @machine@ with state @s@,
   discarding the time stamp. Analogously for 'put'.
-}
timelessResamplingBuffer ::
  (Monad m) =>
  -- | The asynchronous Mealy machine from which the buffer is built
  AsyncMealy m s a b ->
  -- | The initial state
  s ->
  ResamplingBuffer m cl1 cl2 a b
timelessResamplingBuffer :: forall (m :: Type -> Type) s a b cl1 cl2.
Monad m =>
AsyncMealy m s a b -> s -> ResamplingBuffer m cl1 cl2 a b
timelessResamplingBuffer AsyncMealy {s -> m (Result s b)
s -> a -> m s
amPut :: forall (m :: Type -> Type) s a b.
AsyncMealy m s a b -> s -> a -> m s
amGet :: forall (m :: Type -> Type) s a b.
AsyncMealy m s a b -> s -> m (Result s b)
amPut :: s -> a -> m s
amGet :: s -> m (Result s b)
..} s
buffer = ResamplingBuffer {s
TimeInfo cl1 -> a -> s -> m s
TimeInfo cl2 -> s -> m (Result s b)
get :: TimeInfo cl2 -> s -> m (Result s b)
put :: TimeInfo cl1 -> a -> s -> m s
buffer :: s
put :: TimeInfo cl1 -> a -> s -> m s
get :: TimeInfo cl2 -> s -> m (Result s b)
buffer :: s
..}
  where
    put :: TimeInfo cl1 -> a -> s -> m s
put TimeInfo cl1
_ a
a s
s = s -> a -> m s
amPut s
s a
a
    get :: TimeInfo cl2 -> s -> m (Result s b)
get TimeInfo cl2
_ = s -> m (Result s b)
amGet

-- | A resampling buffer that only accepts and emits units.
trivialResamplingBuffer :: (Monad m) => ResamplingBuffer m cl1 cl2 () ()
trivialResamplingBuffer :: forall (m :: Type -> Type) cl1 cl2.
Monad m =>
ResamplingBuffer m cl1 cl2 () ()
trivialResamplingBuffer =
  AsyncMealy m () () () -> () -> ResamplingBuffer m cl1 cl2 () ()
forall (m :: Type -> Type) s a b cl1 cl2.
Monad m =>
AsyncMealy m s a b -> s -> ResamplingBuffer m cl1 cl2 a b
timelessResamplingBuffer
    AsyncMealy
      { amPut :: () -> () -> m ()
amPut = (() -> m ()) -> () -> () -> m ()
forall a b. a -> b -> a
const (m () -> () -> m ()
forall a b. a -> b -> a
const (() -> m ()
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()))
      , amGet :: () -> m (Result () ())
amGet = m (Result () ()) -> () -> m (Result () ())
forall a b. a -> b -> a
const (Result () () -> m (Result () ())
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Result () () -> m (Result () ()))
-> Result () () -> m (Result () ())
forall a b. (a -> b) -> a -> b
$! () -> () -> Result () ()
forall s a. s -> a -> Result s a
Result () ())
      }
    ()