{-# LANGUAGE RecordWildCards #-}

{- |
Different implementations of LIFO buffers.
-}
module FRP.Rhine.ResamplingBuffer.LIFO where

-- base
import Prelude hiding (length, take)

-- containers
import Data.Sequence

-- automaton
import Data.Stream.Result (Result (..))

-- 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 :: forall (m :: Type -> Type) cl1 cl2 a.
Monad m =>
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 {Seq a -> m (Result (Seq a) (Maybe a))
Seq a -> a -> m (Seq a)
forall {m :: Type -> Type} {a}.
Monad m =>
Seq a -> m (Result (Seq a) (Maybe a))
forall {m :: Type -> Type} {a}. Monad m => Seq a -> a -> m (Seq a)
amPut :: forall {m :: Type -> Type} {a}. Monad m => Seq a -> a -> m (Seq a)
amGet :: forall {m :: Type -> Type} {a}.
Monad m =>
Seq a -> m (Result (Seq a) (Maybe a))
amPut :: Seq a -> a -> m (Seq a)
amGet :: Seq a -> m (Result (Seq a) (Maybe 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 a. a -> m 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 (Result (Seq a) (Maybe a))
amGet Seq a
as = case Seq a -> ViewL a
forall a. Seq a -> ViewL a
viewl Seq a
as of
      ViewL a
EmptyL -> Result (Seq a) (Maybe a) -> m (Result (Seq a) (Maybe a))
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Result (Seq a) (Maybe a) -> m (Result (Seq a) (Maybe a)))
-> Result (Seq a) (Maybe a) -> m (Result (Seq a) (Maybe a))
forall a b. (a -> b) -> a -> b
$! Seq a -> Maybe a -> Result (Seq a) (Maybe a)
forall s a. s -> a -> Result s a
Result Seq a
forall a. Seq a
empty Maybe a
forall a. Maybe a
Nothing
      a
a :< Seq a
as' -> Result (Seq a) (Maybe a) -> m (Result (Seq a) (Maybe a))
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Result (Seq a) (Maybe a) -> m (Result (Seq a) (Maybe a)))
-> Result (Seq a) (Maybe a) -> m (Result (Seq a) (Maybe a))
forall a b. (a -> b) -> a -> b
$! Seq a -> Maybe a -> Result (Seq a) (Maybe a)
forall s a. s -> a -> Result s a
Result Seq a
as' (a -> Maybe a
forall a. a -> Maybe a
Just a
a)

{- |  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 :: forall (m :: Type -> Type) cl1 cl2 a.
Monad m =>
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 {Seq a -> m (Result (Seq a) (Maybe a))
Seq a -> a -> m (Seq a)
forall {m :: Type -> Type} {a}.
Monad m =>
Seq a -> m (Result (Seq a) (Maybe a))
amPut :: Seq a -> a -> m (Seq a)
amGet :: Seq a -> m (Result (Seq a) (Maybe a))
amPut :: Seq a -> a -> m (Seq a)
amGet :: forall {m :: Type -> Type} {a}.
Monad m =>
Seq a -> m (Result (Seq a) (Maybe 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 a. a -> m 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 (Result (Seq a) (Maybe a))
amGet Seq a
as = case Seq a -> ViewL a
forall a. Seq a -> ViewL a
viewl Seq a
as of
      ViewL a
EmptyL -> Result (Seq a) (Maybe a) -> m (Result (Seq a) (Maybe a))
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Result (Seq a) (Maybe a) -> m (Result (Seq a) (Maybe a)))
-> Result (Seq a) (Maybe a) -> m (Result (Seq a) (Maybe a))
forall a b. (a -> b) -> a -> b
$! Seq a -> Maybe a -> Result (Seq a) (Maybe a)
forall s a. s -> a -> Result s a
Result Seq a
forall a. Seq a
empty Maybe a
forall a. Maybe a
Nothing
      a
a :< Seq a
as' -> Result (Seq a) (Maybe a) -> m (Result (Seq a) (Maybe a))
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Result (Seq a) (Maybe a) -> m (Result (Seq a) (Maybe a)))
-> Result (Seq a) (Maybe a) -> m (Result (Seq a) (Maybe a))
forall a b. (a -> b) -> a -> b
$! Seq a -> Maybe a -> Result (Seq a) (Maybe a)
forall s a. s -> a -> Result s a
Result Seq a
as' (a -> Maybe a
forall a. a -> Maybe a
Just a
a)

-- | An unbounded LIFO buffer that also returns its current size.
lifoWatch :: (Monad m) => ResamplingBuffer m cl1 cl2 a (Maybe a, Int)
lifoWatch :: forall (m :: Type -> Type) cl1 cl2 a.
Monad m =>
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 {Seq a -> m (Result (Seq a) (Maybe a, Int))
Seq a -> a -> m (Seq a)
forall {m :: Type -> Type} {a}.
Monad m =>
Seq a -> m (Result (Seq a) (Maybe a, Int))
forall {m :: Type -> Type} {a}. Monad m => Seq a -> a -> m (Seq a)
amPut :: Seq a -> a -> m (Seq a)
amGet :: Seq a -> m (Result (Seq a) (Maybe a, Int))
amPut :: forall {m :: Type -> Type} {a}. Monad m => Seq a -> a -> m (Seq a)
amGet :: forall {m :: Type -> Type} {a}.
Monad m =>
Seq a -> m (Result (Seq a) (Maybe a, Int))
..} 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 a. a -> m 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 (Result (Seq a) (Maybe a, Int))
amGet Seq a
as = case Seq a -> ViewL a
forall a. Seq a -> ViewL a
viewl Seq a
as of
      ViewL a
EmptyL -> Result (Seq a) (Maybe a, Int) -> m (Result (Seq a) (Maybe a, Int))
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Result (Seq a) (Maybe a, Int)
 -> m (Result (Seq a) (Maybe a, Int)))
-> Result (Seq a) (Maybe a, Int)
-> m (Result (Seq a) (Maybe a, Int))
forall a b. (a -> b) -> a -> b
$! Seq a -> (Maybe a, Int) -> Result (Seq a) (Maybe a, Int)
forall s a. s -> a -> Result s a
Result Seq a
forall a. Seq a
empty (Maybe a
forall a. Maybe a
Nothing, Int
0)
      a
a :< Seq a
as' -> Result (Seq a) (Maybe a, Int) -> m (Result (Seq a) (Maybe a, Int))
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Result (Seq a) (Maybe a, Int)
 -> m (Result (Seq a) (Maybe a, Int)))
-> Result (Seq a) (Maybe a, Int)
-> m (Result (Seq a) (Maybe a, Int))
forall a b. (a -> b) -> a -> b
$! Seq a -> (Maybe a, Int) -> Result (Seq a) (Maybe a, Int)
forall s a. s -> a -> Result s a
Result Seq a
as' (a -> Maybe a
forall a. a -> Maybe a
Just a
a, Seq a -> Int
forall a. Seq a -> Int
length Seq a
as')