{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, TypeFamilies #-}

-- | Defines a Chan-like structure and makes it an MQueue instance.
module Data.MQueue.Chan where

import Data.MQueue.Class

import Control.Concurrent.Chan
import Control.Monad.Trans

import Control.Monad
import Data.Maybe

instance MonadIO m => MQueue (Chan a) m where
	{-# SPECIALIZE instance MQueue (Chan a) IO #-}
	type MQueueKey (Chan a) = a

	newQueue = liftIO newChan
	push ch = liftIO . writeChan ch
	pop ch = liftIO $ isEmptyChan ch >>= \ ans -> if ans then return Nothing else liftM Just (readChan ch)
	peek ch = liftIO $ isEmptyChan ch >>= \ ans -> if ans then return Nothing else do
		top <- readChan ch
		unGetChan ch top
		return (Just top)
	isEmpty = liftIO . isEmptyChan

blockingPop :: Chan a -> IO a
blockingPop = readChan