module Control.Monad.STM.Class where
import Control.Concurrent.STM (STM)
import Control.Concurrent.STM.TVar (TVar, newTVar, readTVar, writeTVar)
import Control.Exception (Exception)
import Control.Monad (unless)
import Control.Monad.Catch (MonadCatch, MonadThrow, throwM, catch)
import Control.Monad.Reader (ReaderT(..), runReaderT)
import Control.Monad.Trans (lift)
import qualified Control.Monad.RWS.Lazy as RL
import qualified Control.Monad.RWS.Strict as RS
import qualified Control.Monad.STM as S
import qualified Control.Monad.State.Lazy as SL
import qualified Control.Monad.State.Strict as SS
import qualified Control.Monad.Writer.Lazy as WL
import qualified Control.Monad.Writer.Strict as WS
#if __GLASGOW_HASKELL__ < 710
import Control.Applicative (Applicative)
import Data.Monoid (Monoid)
#endif
class (Applicative m, Monad m, MonadCatch m, MonadThrow m) => MonadSTM m where
type CTVar m :: * -> *
retry :: m a
orElse :: m a -> m a -> m a
check :: Bool -> m ()
check b = unless b retry
newCTVar :: a -> m (CTVar m a)
readCTVar :: CTVar m a -> m a
writeCTVar :: CTVar m a -> a -> m ()
throwSTM :: Exception e => e -> m a
throwSTM = throwM
catchSTM :: Exception e => m a -> (e -> m a) -> m a
catchSTM = Control.Monad.Catch.catch
instance MonadSTM STM where
type CTVar STM = TVar
retry = S.retry
orElse = S.orElse
newCTVar = newTVar
readCTVar = readTVar
writeCTVar = writeTVar
instance MonadSTM m => MonadSTM (ReaderT r m) where
type CTVar (ReaderT r m) = CTVar m
retry = lift retry
orElse ma mb = ReaderT $ \r -> orElse (runReaderT ma r) (runReaderT mb r)
check = lift . check
newCTVar = lift . newCTVar
readCTVar = lift . readCTVar
writeCTVar v = lift . writeCTVar v
instance (MonadSTM m, Monoid w) => MonadSTM (WL.WriterT w m) where
type CTVar (WL.WriterT w m) = CTVar m
retry = lift retry
orElse ma mb = WL.WriterT $ orElse (WL.runWriterT ma) (WL.runWriterT mb)
check = lift . check
newCTVar = lift . newCTVar
readCTVar = lift . readCTVar
writeCTVar v = lift . writeCTVar v
instance (MonadSTM m, Monoid w) => MonadSTM (WS.WriterT w m) where
type CTVar (WS.WriterT w m) = CTVar m
retry = lift retry
orElse ma mb = WS.WriterT $ orElse (WS.runWriterT ma) (WS.runWriterT mb)
check = lift . check
newCTVar = lift . newCTVar
readCTVar = lift . readCTVar
writeCTVar v = lift . writeCTVar v
instance MonadSTM m => MonadSTM (SL.StateT s m) where
type CTVar (SL.StateT s m) = CTVar m
retry = lift retry
orElse ma mb = SL.StateT $ \s -> orElse (SL.runStateT ma s) (SL.runStateT mb s)
check = lift . check
newCTVar = lift . newCTVar
readCTVar = lift . readCTVar
writeCTVar v = lift . writeCTVar v
instance MonadSTM m => MonadSTM (SS.StateT s m) where
type CTVar (SS.StateT s m) = CTVar m
retry = lift retry
orElse ma mb = SS.StateT $ \s -> orElse (SS.runStateT ma s) (SS.runStateT mb s)
check = lift . check
newCTVar = lift . newCTVar
readCTVar = lift . readCTVar
writeCTVar v = lift . writeCTVar v
instance (MonadSTM m, Monoid w) => MonadSTM (RL.RWST r w s m) where
type CTVar (RL.RWST r w s m) = CTVar m
retry = lift retry
orElse ma mb = RL.RWST $ \r s -> orElse (RL.runRWST ma r s) (RL.runRWST mb r s)
check = lift . check
newCTVar = lift . newCTVar
readCTVar = lift . readCTVar
writeCTVar v = lift . writeCTVar v
instance (MonadSTM m, Monoid w) => MonadSTM (RS.RWST r w s m) where
type CTVar (RS.RWST r w s m) = CTVar m
retry = lift retry
orElse ma mb = RS.RWST $ \r s -> orElse (RS.runRWST ma r s) (RS.runRWST mb r s)
check = lift . check
newCTVar = lift . newCTVar
readCTVar = lift . readCTVar
writeCTVar v = lift . writeCTVar v