{-# LANGUAGE RankNTypes, CPP #-}
-----------------------------------------------------------------------------
-- |
-- Module : Control.Monad.Queue.Allison
-- Copyright : (c) Leon P Smith 2009-2011
-- License : BSD3
--
-- Maintainer : leon@melding-monads.com
-- Stability : experimental
--
-- A library implementation of corecursive queues, see
-- /Circular Programs and Self-Referential Structures/ by Lloyd Allison,
-- /Software Practice and Experience/, 19(2), pp.99-109, Feb 1989
--
--
--
-- For an explanation of the library implementation, see
-- /Lloyd Allison's Corecursive Queues: Why Continuations Matter/
-- by Leon P Smith, in /The Monad Reader/, Issue 14, Jul 2009. This library
-- corresponds to @CorecQ@ in that paper.
--
--
--
-----------------------------------------------------------------------------
module Control.Monad.Queue.Allison
( Q()
, LenType
, runQueue
, enQ
, deQ
, deQs
, deQ_break
, peekQ
, peekQn
, peekQs
, lenQ
, lenQ_
, callCC
, exit
) where
import Control.Applicative
import Control.Monad.Queue.Util
import Data.List(genericIndex, genericTake, genericSplitAt)
newtype Q e a = Q { unQ :: Cont (LenType -> [e] -> [e]) a }
instance Functor (Q e) where
fmap f m = Q (\k -> unQ m (k . f))
instance Applicative (Q e) where
pure a = Q (\k -> k a)
f <*> v = Q (\k -> unQ f (\g -> unQ v (k . g)))
instance Monad (Q e) where
#if !(MIN_VERSION_base(4,8,0))
return = pure
#endif
m >>= f = Q (\k -> unQ m (\a -> unQ (f a) k))
callCC :: ((a -> forall b. Q e b) -> Q e a) -> Q e a
callCC f = Q (\k -> unQ (f (\a -> Q (\_ -> k a))) k)
-- | Terminates the queue computation
exit :: Q e a
exit = Q (\_k _n _q -> [])
-- | Enqueues an element to the queue
enQ :: e -> Q e ()
enQ e = Q (\k n q -> e : (k () $! n+1) q)
-- | Dequeues an element, returns 'Nothing' if the queue is empty.
deQ :: Q e (Maybe e)
deQ = Q delta
where
delta k n q
| n <= 0 = k Nothing n q
| otherwise = case q of
[] -> error "Control.Monad.Queue.Allison.deQ: empty list"
(e:q') -> (k (Just e) $! n-1) q'
-- | Dequeues an element: terminates the queue computation if the queue is empty.
deQ_break :: Q e e
deQ_break = Q delta
where
delta k n q
| n <= 0 = []
| otherwise = case q of
[] -> error "Control.Monad.Queue.Allison.deQ_break: empty list"
(e:q') -> (k e $! n-1) q'
-- | Dequeues up to @len@ elements from the queue
deQs :: Integral len => len -> Q e [e]
deQs i = Q delta
where
delta k n q
= let i' = min (fromIntegral (max 0 i)) n
(res,q') = genericSplitAt i' q
in (k res $! n-i') q'
-- | Examines the front element of the queue without removing it.
peekQ :: Q e (Maybe e)
peekQ = Q delta
where
delta k n q
| n <= 0 = k Nothing n q
| otherwise = case q of
[] -> error "Control.Monad.Queue.Allison.peekQ: empty list"
(e:_q') -> k (Just e) n q
-- | Examines the element currently at position @index@ in the queue, indexing starts with @0@, like '!!'.
peekQn :: (Integral index) => index -> Q e (Maybe e)
peekQn i_ = Q delta
where
i = fromIntegral i_
delta k n q
| not (0 <= i_ && i < n) = k Nothing n q
| otherwise = k (Just (genericIndex q i)) n q
-- | Examines up to @maxlen@ elements of the queue without removing them.
peekQs :: (Integral maxlen) => maxlen -> Q e [e]
peekQs i_ = Q delta
where
i = fromIntegral (max 0 i_)
delta k n q = k (genericTake (min i n) q) n q
-- | Returns the length of the queue
lenQ_ :: Q e LenType
lenQ_ = Q (\k n q -> k n n q)
-- | Returns the length of the queue
lenQ :: Integral len => Q e len
lenQ = Q (\k n q -> k (fromIntegral n) n q)
-- | Returns a list of all elements enqueued during the queue computation
runQueue :: Q e a -> [e]
runQueue m = q
where
q = unQ m (\_ _ _ -> []) 0 q