dejafu/Control/Monad/Conc/Class.hs

98 lines
3.8 KiB
Haskell
Executable File

{-# LANGUAGE TypeFamilies #-}
-- | This module captures the interface of @Conc@ monads in a
-- typeclass.
module Control.Monad.Conc.Class where
import Control.Concurrent (forkIO)
import Control.Concurrent.MVar (MVar, readMVar, newEmptyMVar, putMVar, tryPutMVar, takeMVar, tryTakeMVar)
import Control.Monad (unless, void)
-- | @MonadConc@ is like a combination of 'ParFuture' and 'ParIVar'
-- from the abstract-par package. It captures the interface of @Conc@
-- monads in terms of how they can operate on shared state.
--
-- There are a few notable differences: firstly, @Par@ imposes
-- 'NFData' constraints on everything, as it achieves its speed-up by
-- forcing evaluation in separate threads. @MonadConc@ doesn't do
-- that, and so you need to be careful about where evaluation occurs,
-- just like with 'MVar's. Secondly, this builds on futures by
-- allowing @CVar@s which threads can read from and write to, possibly
-- multiple times, whereas with the @Par@ monads it is illegal to
-- write multiple times to the same @IVar@ (or to non-blockingly read
-- from it), which removes the possibility of data races.
--
-- A minimal implementation consists of 'fork', 'newEmptyCVar',
-- 'tryPutCVar', and 'tryTakeCVar'. The default implementations of
-- 'takeCVar' and 'putCVar', however, are very inefficient, and should
-- probably always be overridden to make use of
-- implementation-specific blocking functionality.
class Monad m => MonadConc m where
-- | The mutable reference type. This may contain one value at a
-- time, attempting to read or take from an \"empty\" @CVar@ will
-- block until it is full, and attempting to put to a \"full\"
-- @CVar@ will block until it is empty.
type CVar m :: * -> *
-- | Fork a computation to happen concurrently. Communication may
-- happen over @CVar@s.
fork :: m () -> m ()
-- | Create a concurrent computation for the provided action, and
-- return a @CVar@ which can be used to query the result.
--
-- > spawn ma = do
-- > cvar <- newEmptyCVar
-- > fork $ ma >>= putCVar cvar
-- > return cvar
spawn :: m a -> m (CVar m a)
spawn ma = do
cvar <- newEmptyCVar
fork $ ma >>= putCVar cvar
return cvar
-- | Create a new empty @CVar@.
newEmptyCVar :: m (CVar m a)
-- | Put a value into a @CVar@. If there is already a value there,
-- this will block until that value has been taken, at which point
-- the value will be stored.
--
-- > putCVar cvar a = tryPutCVar cvar a >>= \b -> unless b $ putCVar cvar a
putCVar :: CVar m a -> a -> m ()
putCVar cvar a = tryPutCVar cvar a >>= \b -> unless b $ putCVar cvar a
-- | Attempt to put a value in a @CVar@, returning 'True' (and
-- filling the @CVar@) if there was nothing there, otherwise
-- returning 'False'.
tryPutCVar :: CVar m a -> a -> m Bool
-- | Block until a value is present in the @CVar@, and then return
-- it. As with 'readMVar', this does not \"remove\" the value,
-- multiple reads are possible.
readCVar :: CVar m a -> m a
-- | Take a value from a @CVar@. This \"empties\" the @CVar@,
-- allowing a new value to be put in. This will block if there is no
-- value in the @CVar@ already, until one has been put.
--
-- > takeCVar cvar = tryTakeCVar cvar >>= maybe (takeCVar cvar) return
takeCVar :: CVar m a -> m a
takeCVar cvar = tryTakeCVar cvar >>= maybe (takeCVar cvar) return
-- | Attempt to take a value from a @CVar@, returning a 'Just' (and
-- emptying the @CVar@) if there was something there, otherwise
-- returning 'Nothing'.
tryTakeCVar :: CVar m a -> m (Maybe a)
instance MonadConc IO where
type CVar IO = MVar
readCVar = readMVar
fork = void . forkIO
newEmptyCVar = newEmptyMVar
putCVar = putMVar
tryPutCVar = tryPutMVar
takeCVar = takeMVar
tryTakeCVar = tryTakeMVar