{-# LANGUAGE TypeFamilies, GeneralizedNewtypeDeriving #-}
{-# OPTIONS -fno-warn-name-shadowing #-}

-- | A basic first-in, first-out queue implementation implementing the 'Queuelike' abstraction.  Bootstrapped from "Data.Sequence".
module Data.Queue.Queue (Queue, cons) where

import Data.Monoid
import Data.Queue.Class
import Data.Sequence (Seq, ViewL (..), viewl, (|>))
import qualified Data.Sequence as Seq
import qualified Data.Foldable as Fold
import Prelude hiding (null)

--newtype Queue e = Queue (Seq e) deriving (Monoid, Fold.Foldable, Functor)
data Queue e = Queue Int [e] [e] [e]
	-- we never actually look at the spine of a
	-- and if we're performing fmap operations, it
	-- actually helps to existentially quantify the type

instance Functor Queue where
	fmap f (Queue n l r a) = Queue n (map f l) (map f r) (map f a)

instance IQueue (Queue e) where
	type QueueKey (Queue e) = e
	empty = Queue 0 [] [] []
	singleton x = let l = [x] in Queue 1 l [] l
	fromList xs = Queue (length xs) xs [] xs
	
	null (Queue _ [] _ _) = True
	null _ = False
	size (Queue n _ _ _) = n

	x `insert` Queue n l r a = rot (n+1) l (x:r) a
	extract (Queue n (l:ls) r a) = Just (l, rot (n-1) ls r a)
	extract _ = Nothing

--	toList (Queue _ l r _) = l ++ reverse r

rot :: Int -> [e] -> [e] -> [e] -> Queue e
rot n l r (_:as) = Queue n l r as
rot n l r [] = let	rot' (l:ls) (r:rs) a = l:rot' ls rs (r:a)
			rot' ls [] a = ls ++ a
			rot' [] (r:_) a = r:a
			l' = rot' l r []
			in Queue n l' [] l'

cons :: e -> Queue e -> Queue e
cons x (Queue n l r a) = Queue (n+1) (x:l) r a