-- | 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 [a]
f1 [a]
r1) == :: Queue a -> Queue a -> Bool
== (Queue [a]
f2 [a]
r2) =
                ([a]
f1 [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a] -> [a]
forall a. [a] -> [a]
reverse [a]
r1) [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
== ([a]
f2 [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a] -> [a]
forall a. [a] -> [a]
reverse [a]
r2)

instance Functor Queue where
        fmap :: (a -> b) -> Queue a -> Queue b
fmap a -> b
f (Queue [a]
l1 [a]
l2) = [b] -> [b] -> Queue b
forall a. [a] -> [a] -> Queue a
Queue ((a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map a -> b
f [a]
l1) ((a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map a -> b
f [a]
l2)

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

emptyQ :: Queue a
emptyQ :: Queue a
emptyQ =  [a] -> [a] -> Queue a
forall a. [a] -> [a] -> Queue a
Queue [] []


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


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



insertQ :: Queue a -> a -> Queue a
insertQ :: Queue a -> a -> Queue a
insertQ (Queue [a]
fl [a]
rl) a
e = [a] -> [a] -> Queue a
forall a. [a] -> [a] -> Queue a
Queue (a
ea -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
fl) [a]
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 a -> Maybe (a, Queue a)
removeQ (Queue [] [] ) = Maybe (a, Queue a)
forall a. Maybe a
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 [a]
fl [] ) = (a, Queue a) -> Maybe (a, Queue a)
forall a. a -> Maybe a
Just (a
x, [a] -> [a] -> Queue a
forall a. [a] -> [a] -> Queue a
Queue [] [a]
tl) where (a
x : [a]
tl) = [a] -> [a]
forall a. [a] -> [a]
reverse [a]
fl
removeQ (Queue [a]
fl [a]
rl ) = (a, Queue a) -> Maybe (a, Queue a)
forall a. a -> Maybe a
Just ([a] -> a
forall a. [a] -> a
head [a]
rl, [a] -> [a] -> Queue a
forall a. [a] -> [a] -> Queue a
Queue [a]
fl ([a] -> [a]
forall a. [a] -> [a]
tail [a]
rl))

insertAtEndQ :: Queue a -> a -> Queue a
insertAtEndQ :: Queue a -> a -> Queue a
insertAtEndQ (Queue [a]
fl [a]
rl) a
next = [a] -> [a] -> Queue a
forall a. [a] -> [a] -> Queue a
Queue [a]
fl (a
nexta -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
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 :: [a] -> Queue a
listToQueue [a]
xs = (Queue a -> a -> Queue a) -> Queue a -> [a] -> Queue a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Queue a -> a -> Queue a
forall a. Queue a -> a -> Queue a
insertQ Queue a
forall a. Queue a
emptyQ [a]
xs

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