{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE RecordWildCards #-}

{- |
Resampling buffers that collect the incoming data in some data structure
and release all of it on output.
-}
module FRP.Rhine.ResamplingBuffer.Collect where

-- containers
import Data.Sequence

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

-- 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 :: forall (m :: Type -> Type) cl1 cl2 a.
Monad m =>
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 {[a] -> m (Result [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 (Result [a] a)
amPut :: forall {m :: Type -> Type} {a}. Monad m => [a] -> a -> m [a]
amGet :: forall {m :: Type -> Type} {a} {a}.
Monad m =>
a -> m (Result [a] a)
amPut :: [a] -> a -> m [a]
amGet :: [a] -> m (Result [a] [a])
..} []
  where
    amPut :: [a] -> a -> m [a]
amPut [a]
as a
a = [a] -> m [a]
forall 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 (Result [a] a)
amGet a
as = Result [a] a -> m (Result [a] a)
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Result [a] a -> m (Result [a] a))
-> Result [a] a -> m (Result [a] a)
forall a b. (a -> b) -> a -> b
$! [a] -> a -> Result [a] a
forall s a. s -> a -> Result s a
Result [] 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 :: forall (m :: Type -> Type) cl1 cl2 a.
Monad m =>
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 {Seq a -> m (Result (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 (Result (Seq a) a)
amPut :: Seq a -> a -> m (Seq a)
amGet :: Seq a -> m (Result (Seq a) (Seq a))
amPut :: forall {m :: Type -> Type} {a}. Monad m => Seq a -> a -> m (Seq a)
amGet :: forall {m :: Type -> Type} {a} {a}.
Monad m =>
a -> m (Result (Seq a) 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 :: a -> m (Result (Seq a) a)
amGet a
as = Result (Seq a) a -> m (Result (Seq a) a)
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Result (Seq a) a -> m (Result (Seq a) a))
-> Result (Seq a) a -> m (Result (Seq a) a)
forall a b. (a -> b) -> a -> b
$! Seq a -> a -> Result (Seq a) a
forall s a. s -> a -> Result s a
Result Seq a
forall a. Seq a
empty a
as

{- | '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 :: forall (m :: Type -> Type) a b cl1 cl2.
Monad m =>
([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 {[a] -> m (Result [a] b)
[a] -> a -> m [a]
forall {m :: Type -> Type} {a}. Monad m => [a] -> a -> m [a]
amPut :: [a] -> a -> m [a]
amGet :: [a] -> m (Result [a] b)
amPut :: forall {m :: Type -> Type} {a}. Monad m => [a] -> a -> m [a]
amGet :: [a] -> m (Result [a] b)
..} []
  where
    amPut :: [a] -> a -> m [a]
amPut [a]
as a
a = [a] -> m [a]
forall 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 (Result [a] b)
amGet [a]
as = Result [a] b -> m (Result [a] b)
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Result [a] b -> m (Result [a] b))
-> Result [a] b -> m (Result [a] b)
forall a b. (a -> b) -> a -> b
$! [a] -> b -> Result [a] b
forall s a. s -> a -> Result s a
Result [] (b -> Result [a] b) -> b -> Result [a] b
forall a b. (a -> b) -> a -> b
$! [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) =>
  -- | The folding function
  (a -> b -> b) ->
  -- | The initial value
  b ->
  ResamplingBuffer m cl1 cl2 a b
foldBuffer :: forall (m :: Type -> Type) a b cl1 cl2.
Monad m =>
(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 {b -> m (Result b b)
b -> a -> m b
forall {m :: Type -> Type} {a}. Monad m => a -> m (Result a a)
amPut :: b -> a -> m b
amGet :: b -> m (Result b b)
amPut :: b -> a -> m b
amGet :: forall {m :: Type -> Type} {a}. Monad m => a -> m (Result a a)
..}
  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 a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return b
b'
    amGet :: a -> m (Result a a)
amGet a
b = Result a a -> m (Result a a)
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Result a a -> m (Result a a)) -> Result a a -> m (Result a a)
forall a b. (a -> b) -> a -> b
$! a -> a -> Result a a
forall s a. s -> a -> Result s a
Result a
b a
b