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