uni-util-2.2.0.0: Util/Queue.hs

-- | This is an implementation of queues inspired by the paper in
-- Software Practice & Experience, ...
-- The queue is divided into two sequences. The first sequence
-- holds the elements in a LIFO order, the second in a FIFO order.
-- The LIFO sequence is the one where elements are added, the FIFO
-- the one from which elements are removed. When the remove operation
-- is called and the FIFO sequence is empty, the LIFO sequence is
-- turned into a FIFO sequence by reversing the order of its elements.
--
-- Note from GER - as far as I know, we only need the values
--    emptyQ :: Queue a -- new empty queue
--    singletonQ :: a -> Queue a -- new singleton queue
--    insertQ :: Queue a -> a -> Queue a -- add to queue
--    removeQ :: Queue a -> Maybe (a,Queue a) -- pop from queue.
--    insertAtEndQ :: Queue a -> a -> Queue a
--    -- undo the effect of the previous removeQ.
--    isEmptyQ :: Queue a -> Bool
--    queueToList :: Queue a -> [a]
module Util.Queue (
        Queue,

        emptyQ,
        singletonQ,
        isEmptyQ,
        insertQ,
        removeQ,
        insertAtEndQ,

        listToQueue,
        queueToList,
        ) where

-- --------------------------------------------------------------------------
-- Data Type
-- --------------------------------------------------------------------------

data Queue a = Queue [a] [a]


-- --------------------------------------------------------------------------
-- Instances
-- --------------------------------------------------------------------------

instance Eq a => Eq (Queue a) where
        (Queue f1 r1) == (Queue f2 r2) =
                (f1 ++ reverse r1) == (f2 ++ reverse r2)

instance Functor Queue where
        fmap f (Queue l1 l2) = Queue (map f l1) (map f l2)

-- --------------------------------------------------------------------------
-- Operations
-- --------------------------------------------------------------------------

emptyQ :: Queue a
emptyQ =  Queue [] []


singletonQ :: a -> Queue a
singletonQ e =  Queue [] [e]


isEmptyQ :: Queue a -> Bool
isEmptyQ (Queue [] []) = True
isEmptyQ _ = False



insertQ :: Queue a -> a -> Queue a
insertQ (Queue fl rl) e = Queue (e:fl) rl



{-

lengthQ :: Queue a -> Int
lengthQ (Queue fl rl) = length fl + length rl

headQ :: Queue a -> a
headQ (Queue fl []) = (head (reverse fl))
headQ (Queue _ rl) = (head rl)

tailQ :: Queue a -> Queue a
tailQ (Queue fl [] ) = Queue [] tl where (_ : tl) = reverse fl
tailQ (Queue fl rl ) = Queue fl (tail rl)


frontQ :: Queue a -> Maybe a
frontQ (Queue [] []) = Nothing
frontQ (Queue fl []) = Just (head (reverse fl))
frontQ (Queue _ rl) = Just (head rl)

-}

removeQ :: Queue a -> Maybe (a, Queue a)
removeQ (Queue [] [] ) = Nothing
-- This function used to return
-- error "removeQ: Queue is empty" where above we have "Nothing".
-- Heaven knows why.  Anyway it's only used in Selective.hs and a
-- test case, so I think I can safely change it.  (GER, 10/2/2000)
removeQ (Queue fl [] ) = Just (x, Queue [] tl) where (x : tl) = reverse fl
removeQ (Queue fl rl ) = Just (head rl, Queue fl (tail rl))

insertAtEndQ :: Queue a -> a -> Queue a
insertAtEndQ (Queue fl rl) next = Queue fl (next:rl)

-- --------------------------------------------------------------------------
-- Converting to and from lists
-- --------------------------------------------------------------------------


-- | Converts a list to a queue with the first element of the list the
-- first element of the queue.
listToQueue :: [a] -> Queue a
listToQueue xs = foldl insertQ emptyQ xs

-- | Inverts listToQueue
queueToList :: Queue a -> [a]
queueToList (Queue fl rl) = rl ++ reverse fl