module ConIO.MonadSTM (MonadSTM (..)) where

import Control.Concurrent.STM
import Control.Monad.Trans.Class

-- | 'MonadSTM' is a class for all monads which can do 'STM' actions.
--
-- Keep in mind that while some monads (e.g. 'IO') can do 'STM', your 'STM' actions may not
-- be executed 'atomically' if you run them all in the 'IO' monad. Keep them together in 'STM' and
-- then use one 'liftSTM' to lift them to the 'IO' monad.
class (Monad m) => MonadSTM m where
  -- | Lift 'STM' into the monad `m`.
  --
  -- Keep in mind that 'liftSTM' may lose atomicity. `liftSTM action1 >> liftSTM action2` might not be atomic, depending on the monad `m`. Use `liftSTM (action1 >> action2)` instead.
  liftSTM :: STM a -> m a

  -- | Lift an action which can be done in 'STM' or in 'IO'.
  -- This can be useful if the 'IO' version is more performant.
  liftSTM_IO :: STM a -> IO a -> m a
  liftSTM_IO STM a
stm IO a
_ = STM a -> m a
forall a. STM a -> m a
forall (m :: * -> *) a. MonadSTM m => STM a -> m a
liftSTM STM a
stm

instance MonadSTM STM where
  liftSTM :: forall a. STM a -> STM a
liftSTM = STM a -> STM a
forall a. a -> a
id

instance MonadSTM IO where
  liftSTM :: forall a. STM a -> IO a
liftSTM = STM a -> IO a
forall a. STM a -> IO a
atomically
  liftSTM_IO :: forall a. STM a -> IO a -> IO a
liftSTM_IO STM a
_ IO a
io = IO a
io

instance (MonadSTM m, MonadTrans t) => MonadSTM (t m) where
  liftSTM :: forall a. STM a -> t m a
liftSTM = m a -> t m a
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> t m a) -> (STM a -> m a) -> STM a -> t m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. STM a -> m a
forall a. STM a -> m a
forall (m :: * -> *) a. MonadSTM m => STM a -> m a
liftSTM
  liftSTM_IO :: forall a. STM a -> IO a -> t m a
liftSTM_IO STM a
stm IO a
io = m a -> t m a
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> t m a) -> m a -> t m a
forall a b. (a -> b) -> a -> b
$ STM a -> IO a -> m a
forall a. STM a -> IO a -> m a
forall (m :: * -> *) a. MonadSTM m => STM a -> IO a -> m a
liftSTM_IO STM a
stm IO a
io