Queue.hs

-- |
-- Module:     Control.Wire.Prefab.Queue
-- Copyright:  (c) 2011 Ertugrul Soeylemez
-- License:    BSD3
-- Maintainer: Ertugrul Soeylemez <es@ertes.de>
--
-- Various wires for queuing.

module Control.Wire.Prefab.Queue
    ( -- * Signal dams
      fifo,
      lifo
    )
    where

import qualified Data.Sequence as S
import Control.Wire.Types
import Data.Monoid
import Data.Sequence (Seq, ViewL(..), (><))


-- | Queues incoming signals and acts as a dam outputting incoming
-- signals in a FIFO fashion (one-way pipe).  Note: Incorrect usage can
-- lead to congestion.
--
-- * Depends: current instant.
--
-- * Inhibits: when the queue is empty.

fifo :: forall a e (>~). (Monoid e, WirePure (>~)) => Wire e (>~) [a] a
fifo = fifo' S.empty
    where
    fifo' :: Seq a -> Wire e (>~) [a] a
    fifo' xs' =
        mkPure $ \((xs' ><) . S.fromList -> xs) ->
            case S.viewl xs of
              x :< rest -> (Right x, fifo' rest)
              EmptyL    -> (Left mempty, fifo' xs)


-- | Queues incoming signals and acts as a dam outputting incoming
-- signals in a LIFO fashion (stack).  Note: Incorrect usage can lead to
-- congestion.
--
-- * Depends: current instant.
--
-- * Inhibits: when the queue is empty.

lifo :: forall a e (>~). (Monoid e, WirePure (>~)) => Wire e (>~) [a] a
lifo = lifo' S.empty
    where
    lifo' :: Seq a -> Wire e (>~) [a] a
    lifo' xs' =
        mkPure $ \((>< xs') . S.fromList -> xs) ->
            case S.viewl xs of
              x :< rest -> (Right x, lifo' rest)
              EmptyL    -> (Left mempty, lifo' xs)