Queue.hs

-- |
-- Module:     Control.Wire.Prefab.Queue
-- Copyright:  (c) 2012 Ertugrul Soeylemez
-- License:    BSD3
-- Maintainer: Ertugrul Soeylemez <es@ertes.de>
--
-- Wires acting as queues.

module Control.Wire.Prefab.Queue
    ( -- * Queues
      bag,
      fifo,
      lifo
    )
    where

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


-- | Incoming values are placed in a set, which is discharged element by
-- element.  Lower values are served first.  Duplicate values are served
-- once.
--
-- Note: Incorrect usage can lead to congestion.
--
-- * Complexity: O(n) space wrt bag size.
--
-- * Depends: current instant.
--
-- * Inhibits: when the bag is empty.

bag :: (Monoid e, Ord b) => Wire e m (Set b) b
bag = bag' S.empty
    where
    bag' s' =
        mkPure $ \_ xs ->
            case S.minView (S.union s' xs) of
              Nothing     -> (Left mempty, bag' S.empty)
              Just (x, s) -> (Right x, bag' s)


-- | First in, first out.  The input list is placed on the right end of
-- a queue at every instant, giving earlier elements a higher priority.
-- The queue is discharged item by item from the left.
--
-- Note: Incorrect usage can lead to congestion.
--
-- * Complexity: O(n) space wrt queue size.
--
-- * Depends: current instant.
--
-- * Inhibits: when the queue is currently empty.

fifo :: (Monoid e) => Wire e m [b] b
fifo = fifo' Seq.empty
    where
    fifo' queue' =
        mkPure $ \_ xs ->
            case viewl (queue' >< Seq.fromList xs) of
              EmptyL     -> (Left mempty, fifo' Seq.empty)
              x :< queue -> (Right x, fifo' queue)


-- | Last in, first out.  The input list is placed on a stack at every
-- instant, giving earlier elements a higher priority.  The stack is
-- discharged item by item from the top.
--
-- Note: Incorrect usage can lead to congestion.
--
-- * Complexity: O(n) space wrt stack size.
--
-- * Depends: current instant.
--
-- * Inhibits: when the stack is currently empty.

lifo :: (Monoid e) => Wire e m [b] b
lifo = lifo' Seq.empty
    where
    lifo' queue' =
        mkPure $ \_ xs ->
            case viewl (Seq.fromList xs >< queue') of
              EmptyL     -> (Left mempty, lifo' Seq.empty)
              x :< queue -> (Right x, lifo' queue)