{- |
Resampling buffers that collect the incoming data in some data structure
and release all of it on output.
-}

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

-- containers
import Data.Sequence

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

-- | Collects all input in a list, with the newest element at the head,
--   which is returned and emptied upon `get`.
collect :: Monad m => ResamplingBuffer m cl1 cl2 a [a]
collect :: ResamplingBuffer m cl1 cl2 a [a]
collect = AsyncMealy m [a] a [a] -> [a] -> ResamplingBuffer m cl1 cl2 a [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 {[a] -> m ([a], [a])
[a] -> a -> m [a]
forall (m :: Type -> Type) a. Monad m => [a] -> a -> m [a]
forall (m :: Type -> Type) a a. Monad m => a -> m (a, [a])
amGet :: [a] -> m ([a], [a])
amPut :: [a] -> a -> m [a]
amGet :: forall (m :: Type -> Type) a a. Monad m => a -> m (a, [a])
amPut :: forall (m :: Type -> Type) a. Monad m => [a] -> a -> m [a]
..} []
  where
    amPut :: [a] -> a -> m [a]
amPut [a]
as a
a = [a] -> m [a]
forall (m :: Type -> Type) a. Monad m => a -> m a
return ([a] -> m [a]) -> [a] -> m [a]
forall a b. (a -> b) -> a -> b
$ a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
as
    amGet :: a -> m (a, [a])
amGet a
as   = (a, [a]) -> m (a, [a])
forall (m :: Type -> Type) a. Monad m => a -> m a
return (a
as, [])


-- | Reimplementation of 'collect' with sequences,
--   which gives a performance benefit if the sequence needs to be reversed or searched.
collectSequence :: Monad m => ResamplingBuffer m cl1 cl2 a (Seq a)
collectSequence :: ResamplingBuffer m cl1 cl2 a (Seq a)
collectSequence = AsyncMealy m (Seq a) a (Seq a)
-> Seq a -> ResamplingBuffer m cl1 cl2 a (Seq 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 (Seq a, Seq a)
Seq a -> a -> m (Seq a)
forall (m :: Type -> Type) a. Monad m => Seq a -> a -> m (Seq a)
forall (m :: Type -> Type) a a. Monad m => a -> m (a, Seq a)
amGet :: forall (m :: Type -> Type) a a. Monad m => a -> m (a, Seq a)
amPut :: forall (m :: Type -> Type) a. Monad m => Seq a -> a -> m (Seq a)
amGet :: Seq a -> m (Seq 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
$ a
a a -> Seq a -> Seq a
forall a. a -> Seq a -> Seq a
<| Seq a
as
    amGet :: a -> m (a, Seq a)
amGet a
as   = (a, Seq a) -> m (a, Seq a)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (a
as, Seq a
forall a. Seq a
empty)

-- | 'pureBuffer' collects all input values lazily in a list
--   and processes it when output is required.
--   Semantically, @pureBuffer f == collect >>-^ arr f@,
--   but 'pureBuffer' is slightly more efficient.
pureBuffer :: Monad m => ([a] -> b) -> ResamplingBuffer m cl1 cl2 a b
pureBuffer :: ([a] -> b) -> ResamplingBuffer m cl1 cl2 a b
pureBuffer [a] -> b
f = AsyncMealy m [a] a b -> [a] -> ResamplingBuffer m cl1 cl2 a b
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 {[a] -> m (b, [a])
[a] -> a -> m [a]
forall (m :: Type -> Type) a. Monad m => [a] -> m (b, [a])
forall (m :: Type -> Type) a. Monad m => [a] -> a -> m [a]
amGet :: forall (m :: Type -> Type) a. Monad m => [a] -> m (b, [a])
amPut :: forall (m :: Type -> Type) a. Monad m => [a] -> a -> m [a]
amGet :: [a] -> m (b, [a])
amPut :: [a] -> a -> m [a]
..} []
  where
    amPut :: [a] -> a -> m [a]
amPut [a]
as a
a = [a] -> m [a]
forall (m :: Type -> Type) a. Monad m => a -> m a
return (a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
as)
    amGet :: [a] -> m (b, [a])
amGet [a]
as   = (b, [a]) -> m (b, [a])
forall (m :: Type -> Type) a. Monad m => a -> m a
return ([a] -> b
f [a]
as, [])

-- TODO Test whether strictness works here, or consider using deepSeq
-- | A buffer collecting all incoming values with a folding function.
--   It is strict, i.e. the state value 'b' is calculated on every 'put'.
foldBuffer
  :: Monad m
  => (a -> b -> b) -- ^ The folding function
  -> b -- ^ The initial value
  -> ResamplingBuffer m cl1 cl2 a b
foldBuffer :: (a -> b -> b) -> b -> ResamplingBuffer m cl1 cl2 a b
foldBuffer a -> b -> b
f = AsyncMealy m b a b -> b -> ResamplingBuffer m cl1 cl2 a b
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 {b -> m (b, b)
b -> a -> m b
forall (m :: Type -> Type). Monad m => b -> a -> m b
forall (m :: Type -> Type) b. Monad m => b -> m (b, b)
amGet :: forall (m :: Type -> Type) b. Monad m => b -> m (b, b)
amPut :: forall (m :: Type -> Type). Monad m => b -> a -> m b
amGet :: b -> m (b, b)
amPut :: b -> a -> m b
..}
  where
    amPut :: b -> a -> m b
amPut b
b a
a = let !b' :: b
b' = a -> b -> b
f a
a b
b in b -> m b
forall (m :: Type -> Type) a. Monad m => a -> m a
return b
b'
    amGet :: b -> m (b, b)
amGet b
b   = (b, b) -> m (b, b)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (b
b, b
b)