{-# LANGUAGE RecordWildCards #-}

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

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 (b, s)
amGet :: s      -> m (b, s)
  -- ^ 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 =>
  AsyncMealy m s a b -> -- The asynchronous Mealy machine from which the buffer is built

  -- | 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 (b, s)
s -> a -> m s
amGet :: s -> m (b, s)
amPut :: s -> a -> m s
amGet :: forall (m :: Type -> Type) s a b.
AsyncMealy m s a b -> s -> m (b, s)
amPut :: forall (m :: Type -> Type) s a b.
AsyncMealy m s a b -> s -> a -> m s
..} = forall {cla} {clb}. s -> ResamplingBuffer m cla clb a b
go
  where
    go :: s -> ResamplingBuffer m cla clb a b
go s
s =
      let
        put :: p -> a -> m (ResamplingBuffer m cla clb a b)
put p
_ a
a = s -> ResamplingBuffer m cla clb a b
go forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> a -> m s
amPut s
s a
a
        get :: p -> m (b, ResamplingBuffer m cla clb a b)
get p
_ = do
          (b
b, s
s') <- s -> m (b, s)
amGet s
s
          forall (m :: Type -> Type) a. Monad m => a -> m a
return (b
b, s -> ResamplingBuffer m cla clb a b
go s
s')
       in
        ResamplingBuffer {forall {p}. p -> m (b, ResamplingBuffer m cla clb a b)
forall {p}. p -> a -> m (ResamplingBuffer m cla clb a b)
get :: TimeInfo clb -> m (b, ResamplingBuffer m cla clb a b)
put :: TimeInfo cla -> a -> m (ResamplingBuffer m cla clb a b)
get :: forall {p}. p -> m (b, ResamplingBuffer m cla clb a b)
put :: forall {p}. p -> a -> m (ResamplingBuffer m cla clb a b)
..}

-- | 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 =
  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 = forall a b. a -> b -> a
const (forall a b. a -> b -> a
const (forall (m :: Type -> Type) a. Monad m => a -> m a
return ()))
      , amGet :: () -> m ((), ())
amGet = forall a b. a -> b -> a
const (forall (m :: Type -> Type) a. Monad m => a -> m a
return ((), ()))
      }
    ()