{-# LANGUAGE RecordWildCards #-}
module FRP.Rhine.ResamplingBuffer.LIFO where
import Prelude hiding (length, take)
import Data.Sequence
import FRP.Rhine.ResamplingBuffer
import FRP.Rhine.ResamplingBuffer.Timeless
lifoUnbounded :: Monad m => ResamplingBuffer m cl1 cl2 a (Maybe a)
lifoUnbounded = timelessResamplingBuffer AsyncMealy {..} empty
where
amPut as a = return $ a <| as
amGet as = case viewl as of
EmptyL -> return (Nothing, empty)
a :< as' -> return (Just a , as' )
lifoBounded :: Monad m => Int -> ResamplingBuffer m cl1 cl2 a (Maybe a)
lifoBounded threshold = timelessResamplingBuffer AsyncMealy {..} empty
where
amPut as a = return $ take threshold $ a <| as
amGet as = case viewl as of
EmptyL -> return (Nothing, empty)
a :< as' -> return (Just a , as' )
lifoWatch :: Monad m => ResamplingBuffer m cl1 cl2 a (Maybe a, Int)
lifoWatch = timelessResamplingBuffer AsyncMealy {..} empty
where
amPut as a = return $ a <| as
amGet as = case viewl as of
EmptyL -> return ((Nothing, 0 ), empty)
a :< as' -> return ((Just a , length as'), as' )