Queue.hs

module Queue (
    empty
  , isEmpty
  , peek
  , remove
  , add
  ) where

data Queue a = Queue [a] [a] [a]
                 deriving (Eq, Show)

empty :: Queue a
empty = Queue [] [] []

isEmpty :: Queue a 
        -> Bool
isEmpty (Queue xs _ _) = null xs

peek :: Queue a 
     -> a
peek (Queue (x : _) _ _) = x

remove :: Queue a 
       -> Queue a
remove (Queue (_ : xs) ys zs) = mkValid xs ys zs

add :: a 
    -> Queue a 
    -> Queue a
add x (Queue xs ys zs) = mkValid xs (x : ys) zs

mkValid :: [a]
        -> [a]
        -> [a]
        -> Queue a
mkValid xs ys [] = Queue zs [] zs
  where
    zs = rot xs ys []
mkValid xs ys (_ : zs) = Queue xs ys zs 

rot :: [a]
    -> [a]
    -> [a]
    -> [a]
rot [] [y] zs            = y : zs
rot (x : xs) (y : ys) zs = x : rot xs ys (y : zs)
rot _ _ _                = error "rot: should not happen"