{-# LANGUAGE TypeOperators, MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, UndecidableInstances #-}

module Control.Monad.Queue.Class ((:->)(..), MonadQueue(..)) where

import qualified Control.Monad.State.Strict as StrictS
import qualified Control.Monad.State.Lazy as LazyS
import Control.Monad.List
import Control.Monad.Reader
import Control.Monad.Maybe
import Control.Monad.Array
-- import Control.Monad.ST.Trans
import Control.Monad.Trans.Operations
import qualified Control.Monad.Writer.Strict as StrictW
import qualified Control.Monad.Writer.Lazy as LazyW
import Data.Monoid(Monoid)

-- | 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

-- | Typeclass abstraction of a monad with access to a mutable queue.  Minimal implementation: 'queueInsert' or 'queueInsertAll', 'queuePeek', 'queueExtract' or 'queueDelete', 'queueSize'.
class Monad m => MonadQueue e m | m -> e where
	queueInsert :: e -> m ()
	queueInsertAll :: [e] -> m ()
	queueExtract :: m (Maybe e)
	queueDelete :: m ()
	queuePeek :: m (Maybe e)
	queueEmpty :: m Bool
	queueSize :: m Int
	queueEmpty = liftM (==0) queueSize
	queueInsertAll = mapM_ queueInsert
	queueInsert x = queueInsertAll [x]
	queueDelete = queueExtract >> return ()
	queueExtract = do	mx <- queuePeek
				case mx of	Nothing	-> return Nothing
						Just{}	-> queueDelete >> return mx

-- instance (MonadTrans t, MonadQueue e m, Monad (t m)) => MonadQueue e (t m) where
-- 	queueInsert = lift . queueInsert
-- 	queueInsertAll = lift . queueInsertAll
-- 	queueExtract = lift queueExtract
-- 	queueDelete = lift queueDelete
-- 	queuePeek = lift queuePeek
-- 	queueEmpty = lift queueEmpty
-- 	queueSize = lift queueSize
	
	
instance MonadQueue e m => MonadQueue e (StrictS.StateT s m) where
	queueInsert = lift . queueInsert
	queueInsertAll = lift . queueInsertAll
	queueExtract = lift queueExtract
	queueDelete = lift queueDelete
	queuePeek = lift queuePeek
	queueEmpty = lift queueEmpty
	queueSize = lift queueSize
	
instance MonadQueue e m => MonadQueue e (LazyS.StateT s m) where
	queueInsert = lift . queueInsert
	queueInsertAll = lift . queueInsertAll
	queueExtract = lift queueExtract
	queueDelete = lift queueDelete
	queuePeek = lift queuePeek
	queueEmpty = lift queueEmpty
	queueSize = lift queueSize
	
instance MonadQueue e m => MonadQueue e (ReaderT r m) where
	queueInsert = lift . queueInsert
	queueInsertAll = lift . queueInsertAll
	queueExtract = lift queueExtract
	queueDelete = lift queueDelete
	queuePeek = lift queuePeek
	queueEmpty = lift queueEmpty
	queueSize = lift queueSize
	
instance (Monoid w, MonadQueue e m) => MonadQueue e (StrictW.WriterT w m) where
	queueInsert = lift . queueInsert
	queueInsertAll = lift . queueInsertAll
	queueExtract = lift queueExtract
	queueDelete = lift queueDelete
	queuePeek = lift queuePeek
	queueEmpty = lift queueEmpty
	queueSize = lift queueSize
	
instance (Monoid w, MonadQueue e m) => MonadQueue e (LazyW.WriterT w m) where
	queueInsert = lift . queueInsert
	queueInsertAll = lift . queueInsertAll
	queueExtract = lift queueExtract
	queueDelete = lift queueDelete
	queuePeek = lift queuePeek
	queueEmpty = lift queueEmpty
	queueSize = lift queueSize
	
instance MonadQueue e m => MonadQueue e (MaybeT m) where
	queueInsert = lift . queueInsert
	queueInsertAll = lift . queueInsertAll
	queueExtract = lift queueExtract
	queueDelete = lift queueDelete
	queuePeek = lift queuePeek
	queueEmpty = lift queueEmpty
	queueSize = lift queueSize
	
instance MonadQueue e m => MonadQueue e (ListT m) where
	queueInsert = lift . queueInsert
	queueInsertAll = lift . queueInsertAll
	queueExtract = lift queueExtract
	queueDelete = lift queueDelete
	queuePeek = lift queuePeek
	queueEmpty = lift queueEmpty
	queueSize = lift queueSize
	
instance MonadQueue e m => MonadQueue e (IntMapT f m) where
	queueInsert = lift . queueInsert
	queueInsertAll = lift . queueInsertAll
	queueExtract = lift queueExtract
	queueDelete = lift queueDelete
	queuePeek = lift queuePeek
	queueEmpty = lift queueEmpty
	queueSize = lift queueSize