-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Queue.TwoStack
-- Copyright   :  (c) Leon P Smith 2009
-- License     :  BSD3
--
-- Maintainer  :  leon at melding-monads dot com
-- Stability   :  experimental
-- Portability :  portable
--
-- Two-Stack Queues of functional programming folklore.
-- Notably mentioned inside Chris Okasaki's thesis, with
-- relevant citations.
--
-- /Purely Functional Data Structures/ by Chris Okasaki,
-- /Cambridge University Press/,  1998
--
-- http://www.cs.cmu.edu/~rwh/theses/okasaki.pdf
--
-----------------------------------------------------------------------------

module Data.Queue.TwoStack
     ( Q()
     , empty
     , enque
     , deque
     , listToQueue
     , queueToList
     , len
     ) where

import qualified Data.Queue.Class as Class
import Data.List

import Control.Monad.Queue.Util

data Q e = Q !LenType [e] [e]

instance Functor Q where
  fmap f (Q n as zs) = Q n (map f as ++ map f (reverse zs)) []

instance (Eq e) => Eq (Q e) where
  (Q ln as ys) == (Q mn bs zs)   =  ln == mn  &&  loop   as bs ys zs
    where
      loop as bs (y:ys) (z:zs)   =  y == z    &&  loop   as bs ys zs
      loop as bs ys     zs       =                loop2  as bs ys zs

      loop2 (a:as) (b:bs) ys zs  =  a == b    &&  loop2  as bs ys zs
      loop2 as     []     [] zs  =  as == reverse zs
      loop2 []     bs     ys []  =  bs == reverse ys

instance (Ord e) => Ord (Q e) where
  compare (Q _ as ys) (Q _ bs zs) = loop as bs ys zs
     where
       loop (a:as) (b:bs) ys zs
          = case compare a b of
             LT -> LT
             EQ -> loop as bs ys zs
             GT -> GT
       loop [] [] [] [] = EQ
       loop [] bs [] zs = LT
       loop [] bs ys zs = loop (reverse ys) bs [] zs
       loop as [] ys [] = GT
       loop as [] ys zs = loop as (reverse zs) ys []

empty :: Q e
empty =  Q 0 [] []

enque :: e -> Q e -> Q e
enque z  (Q 0 []     [])  = Q 1     [z]     []
enque z  (Q n (a:as) zs)  = Q (n+1) (a:as)  (z:zs)

deque :: Q e -> (Maybe e, Q e)
deque    (Q 0 []     [])  =   ( Nothing  ,  Q 0     []   []  )
deque    (Q n (a:as) zs)
         |  null as       =   ( Just a   ,  Q (n-1) as'  []  )
         |  otherwise     =   ( Just a   ,  Q (n-1) as   zs  )
            where as'     = reverse zs

listToQueue :: [e] -> Q e
listToQueue as = Q (genericLength as) as []

queueToList :: Q e -> [e]
queueToList (Q _ as zs) = as ++ reverse zs

len :: Q e -> LenType
len (Q l _ _) = l


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