{- |
Different implementations of FIFO buffers.
-}

{-# LANGUAGE RecordWildCards #-}
module FRP.Rhine.ResamplingBuffer.FIFO where

-- base
import Prelude hiding (length, take)

-- containers
import Data.Sequence

-- rhine
import FRP.Rhine.ResamplingBuffer
import FRP.Rhine.ResamplingBuffer.Timeless

-- * FIFO (first-in-first-out) buffers

-- | An unbounded FIFO buffer.
--   If the buffer is empty, it will return 'Nothing'.
fifoUnbounded :: Monad m => ResamplingBuffer m cl1 cl2 a (Maybe a)
fifoUnbounded :: ResamplingBuffer m cl1 cl2 a (Maybe a)
fifoUnbounded = AsyncMealy m (Seq a) a (Maybe a)
-> Seq a -> ResamplingBuffer m cl1 cl2 a (Maybe a)
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 :: forall (m :: Type -> Type) s a b.
(s -> a -> m s) -> (s -> m (b, s)) -> AsyncMealy m s a b
AsyncMealy {Seq a -> m (Maybe a, Seq a)
Seq a -> a -> m (Seq a)
forall (m :: Type -> Type) a.
Monad m =>
Seq a -> m (Maybe a, Seq a)
forall (m :: Type -> Type) a. Monad m => Seq a -> a -> m (Seq a)
amGet :: Seq a -> m (Maybe a, Seq a)
amPut :: Seq a -> a -> m (Seq a)
amGet :: forall (m :: Type -> Type) a.
Monad m =>
Seq a -> m (Maybe a, Seq a)
amPut :: forall (m :: Type -> Type) a. Monad m => Seq a -> a -> m (Seq a)
..} Seq a
forall a. Seq a
empty
  where
    amPut :: Seq a -> a -> m (Seq a)
amPut Seq a
as a
a = Seq a -> m (Seq a)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Seq a -> m (Seq a)) -> Seq a -> m (Seq a)
forall a b. (a -> b) -> a -> b
$ a
a a -> Seq a -> Seq a
forall a. a -> Seq a -> Seq a
<| Seq a
as
    amGet :: Seq a -> m (Maybe a, Seq a)
amGet Seq a
as   = case Seq a -> ViewR a
forall a. Seq a -> ViewR a
viewr Seq a
as of
      ViewR a
EmptyR   -> (Maybe a, Seq a) -> m (Maybe a, Seq a)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Maybe a
forall a. Maybe a
Nothing, Seq a
forall a. Seq a
empty)
      Seq a
as' :> a
a -> (Maybe a, Seq a) -> m (Maybe a, Seq a)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (a -> Maybe a
forall a. a -> Maybe a
Just a
a , Seq a
as'  )

-- |  A bounded FIFO buffer that forgets the oldest values when the size is above a given threshold.
--    If the buffer is empty, it will return 'Nothing'.
fifoBounded :: Monad m => Int -> ResamplingBuffer m cl1 cl2 a (Maybe a)
fifoBounded :: Int -> ResamplingBuffer m cl1 cl2 a (Maybe a)
fifoBounded Int
threshold = AsyncMealy m (Seq a) a (Maybe a)
-> Seq a -> ResamplingBuffer m cl1 cl2 a (Maybe a)
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 :: forall (m :: Type -> Type) s a b.
(s -> a -> m s) -> (s -> m (b, s)) -> AsyncMealy m s a b
AsyncMealy {Seq a -> m (Maybe a, Seq a)
Seq a -> a -> m (Seq a)
forall (m :: Type -> Type) a.
Monad m =>
Seq a -> m (Maybe a, Seq a)
forall (m :: Type -> Type) a. Monad m => Seq a -> a -> m (Seq a)
amGet :: forall (m :: Type -> Type) a.
Monad m =>
Seq a -> m (Maybe a, Seq a)
amPut :: forall (m :: Type -> Type) a. Monad m => Seq a -> a -> m (Seq a)
amGet :: Seq a -> m (Maybe a, Seq a)
amPut :: Seq a -> a -> m (Seq a)
..} Seq a
forall a. Seq a
empty
  where
    amPut :: Seq a -> a -> m (Seq a)
amPut Seq a
as a
a = Seq a -> m (Seq a)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Seq a -> m (Seq a)) -> Seq a -> m (Seq a)
forall a b. (a -> b) -> a -> b
$ Int -> Seq a -> Seq a
forall a. Int -> Seq a -> Seq a
take Int
threshold (Seq a -> Seq a) -> Seq a -> Seq a
forall a b. (a -> b) -> a -> b
$ a
a a -> Seq a -> Seq a
forall a. a -> Seq a -> Seq a
<| Seq a
as
    amGet :: Seq a -> m (Maybe a, Seq a)
amGet Seq a
as = case Seq a -> ViewR a
forall a. Seq a -> ViewR a
viewr Seq a
as of
      ViewR a
EmptyR   -> (Maybe a, Seq a) -> m (Maybe a, Seq a)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Maybe a
forall a. Maybe a
Nothing, Seq a
forall a. Seq a
empty)
      Seq a
as' :> a
a -> (Maybe a, Seq a) -> m (Maybe a, Seq a)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (a -> Maybe a
forall a. a -> Maybe a
Just a
a , Seq a
as'  )

-- | An unbounded FIFO buffer that also returns its current size.
fifoWatch :: Monad m => ResamplingBuffer m cl1 cl2 a (Maybe a, Int)
fifoWatch :: ResamplingBuffer m cl1 cl2 a (Maybe a, Int)
fifoWatch = AsyncMealy m (Seq a) a (Maybe a, Int)
-> Seq a -> ResamplingBuffer m cl1 cl2 a (Maybe a, Int)
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 :: forall (m :: Type -> Type) s a b.
(s -> a -> m s) -> (s -> m (b, s)) -> AsyncMealy m s a b
AsyncMealy {Seq a -> m ((Maybe a, Int), Seq a)
Seq a -> a -> m (Seq a)
forall (m :: Type -> Type) a.
Monad m =>
Seq a -> m ((Maybe a, Int), Seq a)
forall (m :: Type -> Type) a. Monad m => Seq a -> a -> m (Seq a)
amGet :: forall (m :: Type -> Type) a.
Monad m =>
Seq a -> m ((Maybe a, Int), Seq a)
amPut :: forall (m :: Type -> Type) a. Monad m => Seq a -> a -> m (Seq a)
amGet :: Seq a -> m ((Maybe a, Int), Seq a)
amPut :: Seq a -> a -> m (Seq a)
..} Seq a
forall a. Seq a
empty
  where
    amPut :: Seq a -> a -> m (Seq a)
amPut Seq a
as a
a = Seq a -> m (Seq a)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Seq a -> m (Seq a)) -> Seq a -> m (Seq a)
forall a b. (a -> b) -> a -> b
$ a
a a -> Seq a -> Seq a
forall a. a -> Seq a -> Seq a
<| Seq a
as
    amGet :: Seq a -> m ((Maybe a, Int), Seq a)
amGet Seq a
as   = case Seq a -> ViewR a
forall a. Seq a -> ViewR a
viewr Seq a
as of
      ViewR a
EmptyR   -> ((Maybe a, Int), Seq a) -> m ((Maybe a, Int), Seq a)
forall (m :: Type -> Type) a. Monad m => a -> m a
return ((Maybe a
forall a. Maybe a
Nothing, Int
0         ), Seq a
forall a. Seq a
empty)
      Seq a
as' :> a
a -> ((Maybe a, Int), Seq a) -> m ((Maybe a, Int), Seq a)
forall (m :: Type -> Type) a. Monad m => a -> m a
return ((a -> Maybe a
forall a. a -> Maybe a
Just a
a , Seq a -> Int
forall a. Seq a -> Int
length Seq a
as'), Seq a
as'  )