-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Queue.Okasaki
-- Copyright   :  (c) The University of Glasgow 2002
-- License     :  BSD-style (see the file libraries/base/LICENSE)
--
-- Maintainer  :  leon at melding-monads dot com
-- Stability   :  experimental
-- Portability :  portable
--
-- Queues with constant time operations, from
-- /Simple and efficient purely functional queues and deques/,
-- by Chris Okasaki, /JFP/ 5(4):583-592, October 1995.
--
-- Based on the incremental reversals of lazy lists.
--
-----------------------------------------------------------------------------

module  Data.Queue.Okasaki
     (  Q
        -- * Primitive operations
        -- | Each of these requires /O(1)/ time in the worst case.
     ,  empty, enque, deque
        -- * Queues and lists
     ,  listToQueue, queueToList
     )  where

import Prelude -- necessary to get dependencies right
import qualified Data.Queue.Class as Class

-- import Data.Typeable

-- | The type of FIFO queues.
data Q a = Q [a] [a] [a]


-- #include "Typeable.h"
-- `INSTANCE_TYPEABLE1(Queue,queueTc,"Queue")

-- Invariants for Q xs ys xs':
--	length xs = length ys + length xs'
--	xs' = drop (length ys) xs	-- in fact, shared (except after fmap)
-- The queue then represents the list xs ++ reverse ys


instance Functor Q where
	fmap f (Q xs ys xs') = Q (map f xs) (map f ys) (map f xs')
	-- The new xs' does not share the tail of the new xs, but it does
	-- share the tail of the old xs, so it still forces the rotations.
	-- Note that elements of xs' are ignored.

-- | The empty queue.
empty :: Q a
empty = Q [] [] []

-- | Add an element to the back of a queue.
enque :: a -> Q a  -> Q a
enque y (Q xs ys xs') = makeQ xs (y:ys) xs'

-- | Attempt to extract the front element from a queue.
-- If the queue is empty,  return 'Nothing' paired with the original queue
-- otherwise return 'Just' the first element paired with the modified queue

deque :: Q a -> (Maybe a, Q a)
deque q@(Q [] _ _) = (Nothing,  q)
deque q@(Q (x:xs) ys xs') = (Just x, makeQ xs ys xs')

-- Assuming
--	length ys <= length xs + 1
--	xs' = drop (length ys - 1) xs
-- construct a queue respecting the invariant.
makeQ :: [a] -> [a] -> [a] -> Q a
makeQ xs ys [] = listToQueue (rotate xs ys [])
makeQ xs ys (_:xs') = Q xs ys xs'

-- Assuming length ys = length xs + 1,
--	rotate xs ys zs = xs ++ reverse ys ++ zs
rotate :: [a] -> [a] -> [a] -> [a]
rotate [] (y:_) zs = y : zs		-- the _ here must be []
rotate (x:xs) (y:ys) zs = x : rotate xs ys (y:zs)

-- | A queue with the same elements as the list.
listToQueue :: [a] -> Q a
listToQueue xs = Q xs [] xs

-- | The elements of a queue, front first.
queueToList :: Q a -> [a]
queueToList (Q xs ys _) = xs ++ reverse ys


instance Class.Queue Q where
   empty = empty
   deque = deque
   enque = enque