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