{- |
Different implementations of LIFO buffers.
-}

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

-- base
import Prelude hiding (length, take)

-- containers
import Data.Sequence

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

-- * LIFO (last-in-first-out) buffers

-- | An unbounded LIFO buffer.
--   If the buffer is empty, it will return 'Nothing'.
lifoUnbounded :: Monad m => ResamplingBuffer m cl1 cl2 a (Maybe a)
lifoUnbounded :: ResamplingBuffer m cl1 cl2 a (Maybe a)
lifoUnbounded = 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 -> ViewL a
forall a. Seq a -> ViewL a
viewl Seq a
as of
      ViewL a
EmptyL   -> (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)
      a
a :< Seq a
as' -> (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 LIFO buffer that forgets the oldest values when the size is above a given threshold.
--   If the buffer is empty, it will return 'Nothing'.
lifoBounded :: Monad m => Int -> ResamplingBuffer m cl1 cl2 a (Maybe a)
lifoBounded :: Int -> ResamplingBuffer m cl1 cl2 a (Maybe a)
lifoBounded 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 -> ViewL a
forall a. Seq a -> ViewL a
viewl Seq a
as of
      ViewL a
EmptyL   -> (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)
      a
a :< Seq a
as' -> (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 LIFO buffer that also returns its current size.
lifoWatch :: Monad m => ResamplingBuffer m cl1 cl2 a (Maybe a, Int)
lifoWatch :: ResamplingBuffer m cl1 cl2 a (Maybe a, Int)
lifoWatch = 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 -> ViewL a
forall a. Seq a -> ViewL a
viewl Seq a
as of
      ViewL a
EmptyL   -> ((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)
      a
a :< Seq a
as' -> ((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'  )