{-# LANGUAGE TypeFamilies, TypeOperators #-}

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 qualified Control.Monad.Writer.Strict as StrictW
import qualified Control.Monad.Writer.Lazy as LazyW

import Data.Monoid

-- | 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 m where
	type QKey m
	queueInsert :: QKey m -> m ()
	queueInsertAll :: [QKey m] -> m ()
	queueExtract :: m (Maybe (QKey m))
	queueDelete :: m ()
	queuePeek :: m (Maybe (QKey m))
	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 m, Monad (t m)) => MonadQueue (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 m => MonadQueue (StrictS.StateT s m) where
	type QKey (StrictS.StateT s m) = QKey m
	queueInsert = lift . queueInsert
	queueInsertAll = lift . queueInsertAll
	queueExtract = lift queueExtract
	queueDelete = lift queueDelete
	queuePeek = lift queuePeek
	queueEmpty = lift queueEmpty
	queueSize = lift queueSize
	
instance MonadQueue m => MonadQueue (LazyS.StateT s m) where
	type QKey (LazyS.StateT s m) = QKey m
	queueInsert = lift . queueInsert
	queueInsertAll = lift . queueInsertAll
	queueExtract = lift queueExtract
	queueDelete = lift queueDelete
	queuePeek = lift queuePeek
	queueEmpty = lift queueEmpty
	queueSize = lift queueSize
	
instance MonadQueue m => MonadQueue (ReaderT r m) where
	type QKey (ReaderT r m) = QKey m
	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 m) => MonadQueue (StrictW.WriterT w m) where
	type QKey (StrictW.WriterT w m) = QKey m
	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 m) => MonadQueue (LazyW.WriterT w m) where
	type QKey (LazyW.WriterT w m) = QKey m
	queueInsert = lift . queueInsert
	queueInsertAll = lift . queueInsertAll
	queueExtract = lift queueExtract
	queueDelete = lift queueDelete
	queuePeek = lift queuePeek
	queueEmpty = lift queueEmpty
	queueSize = lift queueSize
	
instance MonadQueue m => MonadQueue (MaybeT m) where
	type QKey (MaybeT m) = QKey m
	queueInsert = lift . queueInsert
	queueInsertAll = lift . queueInsertAll
	queueExtract = lift queueExtract
	queueDelete = lift queueDelete
	queuePeek = lift queuePeek
	queueEmpty = lift queueEmpty
	queueSize = lift queueSize
	
instance MonadQueue m => MonadQueue (ListT m) where
	type QKey (ListT m) = QKey m
	queueInsert = lift . queueInsert
	queueInsertAll = lift . queueInsertAll
	queueExtract = lift queueExtract
	queueDelete = lift queueDelete
	queuePeek = lift queuePeek
	queueEmpty = lift queueEmpty
	queueSize = lift queueSize
	
instance MonadQueue m => MonadQueue (IntMapT f m) where
	type QKey (IntMapT f m) = QKey m
	queueInsert = lift . queueInsert
	queueInsertAll = lift . queueInsertAll
	queueExtract = lift queueExtract
	queueDelete = lift queueDelete
	queuePeek = lift queuePeek
	queueEmpty = lift queueEmpty
	queueSize = lift queueSize

instance MonadQueue m => MonadQueue (ArrayT f m) where
	type QKey (ArrayT f m) = QKey m
	queueInsert = lift . queueInsert
	queueInsertAll = lift . queueInsertAll
	queueExtract = lift queueExtract
	queueDelete = lift queueDelete
	queuePeek = lift queuePeek
	queueEmpty = lift queueEmpty
	queueSize = lift queueSize