Ticket #3331: A.hs

{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE FunctionalDependencies     #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE RankNTypes                 #-}
{-# LANGUAGE TypeOperators              #-}

module A (runQueue, zenQ, zdeQ) where

import Data.Word

type QSt e = Word -> [e] -> [e]

newtype Q e a = Q { unQ :: (a -> QSt e) -> QSt e }

instance Monad (Q e) where
  return a  = Q (\k -> k a)
  m >>= f   = Q (\k -> unQ m (\a -> unQ (f a) k))

-- | Enqueues an element to the queue
zenQ :: e -> Q e ()
zenQ e = Q (\k n q -> e : (k () $! n+1) q)

-- | Dequeues an element,  returns 'Nothing' if the queue is empty.
zdeQ :: Q e (Maybe e)
zdeQ   = 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'

runQueue :: Q e a -> [e]
runQueue m = q
  where
    q = unQ m (\_ _ _ -> []) 0 q