{-# 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 (ArrayT f 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

instance MonadQueue e m => MonadQueue e (STT s m) where
	queueInsert = lift . queueInsert
	queueInsertAll = lift . queueInsertAll
	queueExtract = lift queueExtract
	queueDelete = lift queueDelete
	queuePeek = lift queuePeek
	queueEmpty = lift queueEmpty
	queueSize = lift queueSize