{-# LANGUAGE TypeOperators, MultiParamTypeClasses, TypeFamilies #-}

-- | Abstracts the implementation details of a single-insertion, single-extraction queuelike structure.
module Data.Queue.Class where

import Data.List(unfoldr)
import Data.Maybe

import Control.Monad.Instances()
import Control.Monad

-- | Type that only orders on the key, ignoring the value completely; frequently useful in priority queues, so made available here.
data e :-> f = e :-> f

instance Eq f => Eq (e :-> f) where
	(_ :-> x) == (_ :-> y) = x == y
instance Ord f => Ord (e :-> f) where
	(_ :-> x) `compare` (_ :-> y)	= compare x y

-- | A generic type class encapsulating a generic queuelike structure, that supports single-insertion and single-extraction; this abstraction includes priority queues, stacks, and FIFO queues.  There are many minimal implementations, so each method lists the prerequisites for its default implementation.  Most implementations will implement 'empty', ('singleton' and 'merge') or 'insert', ('peek' and 'delete') or 'extract', and 'size'.  (The absolute minimal implementation is 'empty', 'insert', 'extract', and 'size'.)
class IQueue q where
	type QueueKey q
	-- | Inserts a single element into the queue.  The default implementation uses 'merge' and 'singleton'.
	insert :: QueueKey q -> q -> q
	insert x q = q `merge` singleton x
	-- | Inserts several elements into the queue.  The default implementation uses 'insert'.  (In some cases, it may be advantageous to override this implementation with @xs \``insertAll`\` q = q \``merge`\` `fromList` xs@.)
	{-# INLINE insertAll #-}
	insertAll :: [QueueKey q] -> q -> q
	insertAll = flip (foldr insert)
	-- | Attempts to extract an element from the queue; if the queue is empty, returns Nothing.  The default implementation uses 'peek' and 'delete'.
	extract :: q -> Maybe (QueueKey q, q)
	extract = liftM2 (liftM2 (,)) top delete
	-- | Gets the element that will next be extracted from the queue, if there is an element available.  The default implementation uses 'extract'.
	top ::  q -> Maybe (QueueKey q)
	top = liftM fst . extract
	-- | Deletes an element from the queue, if the queue is nonempty.  The default implementation uses 'extract'.
	delete :: q -> Maybe q
	delete = liftM snd . extract
	-- | Constructs an empty queue.  The default implementation uses 'fromList'.
	empty :: q
	empty = fromList []
	-- | Constructs a queue with a single element.  The default implementation uses 'insert' and 'empty'.
	singleton :: QueueKey q -> q
	singleton x = insert x empty
	-- | Constructs a queue with all of the elements in the list.  The default implementation uses 'insertAll' and 'empty'.
	{-# INLINE fromList #-}
	fromList :: [QueueKey q] -> q
	fromList xs = insertAll xs empty
	-- | Gets the size of the queue.  The default implementation uses 'toList_'.
	size :: q -> Int
	size = length . toList_
	-- | Checks if the queue is empty.  The default implementation uses 'peek'.
	null :: q -> Bool
	null = isNothing . top
	-- | Extracts every element from the queue.  The default implementation uses 'extract'.
	toList :: q -> [QueueKey q]
	toList = unfoldr extract
	-- | Extracts every element from the queue, with no guarantees upon order.  The default implementation uses 'toList'.
	toList_ :: q -> [QueueKey q]
	toList_ = toList
	-- | Merges two queues so that the contents of the second queue are inserted into the first queue in extraction order.  The default implementation uses 'toList' and 'insertAll'.
	{-# INLINE merge #-}
	merge :: q -> q -> q
	q1 `merge` q2 = insertAll (toList q2) q1
	mergeAll :: [q] -> q
	mergeAll = foldr merge empty