module Data.MQueue.SyncQueue (SyncQ, SyncMQ) where
import Data.Queue.Class hiding (peek)
import qualified Data.Queue.Class as Q
import Data.MQueue.Class
import Data.Tuple.HT
import Control.Arrow
import Control.Concurrent.MVar
import Control.Monad.Trans
import Control.Monad
import Data.Maybe
newtype SyncQ q = SyncQ (MVar q)
newtype SyncMQ q = SyncMQ (MVar q)
instance (MonadIO m, Queuelike q) => MQueue (SyncQ q) m where
type MQueueKey (SyncQ q) = QueueKey q
newQueue = liftIO $ liftM SyncQ $ newMVar empty
push (SyncQ var) k = liftIO $ modifyMVar_ var (return . insert k)
peek = withSyncQ Q.peek
pop (SyncQ var) = liftIO $ modifyMVar var (\ q -> return ((maybe q snd &&& fmap fst) (extract q)))
pop_ (SyncQ var) = liftIO $ modifyMVar_ var (return . (fromMaybe `ap` delete))
isEmpty = withSyncQ Q.null
withSyncQ :: (MonadIO m, Queuelike q) => (q -> a) -> SyncQ q -> m a
withSyncQ f (SyncQ var) = liftIO $ withMVar var (return . f)
instance (MonadIO m, MQueue q IO) => MQueue (SyncMQ q) m where
type MQueueKey (SyncMQ q) = MQueueKey q
newQueue = liftIO $ liftM SyncMQ $ newQueue >>= newMVar
q `push` k = onSyncMQ (`push` k) q
q `pushAll` ks = onSyncMQ (`pushAll` ks) q
peek = onSyncMQ peek
pop = onSyncMQ pop
pop_ = onSyncMQ pop_
isEmpty = onSyncMQ isEmpty
onSyncMQ :: (MonadIO m, MQueue q IO) => (q -> IO a) -> SyncMQ q -> m a
onSyncMQ f (SyncMQ var) = liftIO $ withMVar var f