{-|
Module: Control.Monad.IO.Rerunnable

Defines the 'MonadRerunnableIO' type class that is functionally equivalent
to 'Control.Monad.IO.Class.MonadIO', but use of it requires the user to
explicitly acknowledge that the given IO operation can be rerun.
-}

module Control.Monad.IO.Rerunnable
  ( MonadRerunnableIO(..)
  ) where

import Control.Monad.Trans.Class (lift)
import qualified Control.Monad.Trans.Except as Except
import qualified Control.Monad.Trans.Identity as Identity
import qualified Control.Monad.Trans.Maybe as Maybe
import qualified Control.Monad.Trans.RWS.Lazy as RWS.Lazy
import qualified Control.Monad.Trans.RWS.Strict as RWS.Strict
import qualified Control.Monad.Trans.Reader as Reader
import qualified Control.Monad.Trans.Resource as Resource
import qualified Control.Monad.Trans.State.Lazy as State.Lazy
import qualified Control.Monad.Trans.State.Strict as State.Strict
import qualified Control.Monad.Trans.Writer.Lazy as Writer.Lazy
import qualified Control.Monad.Trans.Writer.Strict as Writer.Strict

-- | A copy of 'Control.Monad.IO.Class.MonadIO' to explicitly allow only IO
-- operations that are rerunnable, e.g. in the context of a SQL transaction.
class Monad m => MonadRerunnableIO m where
  -- | Lift the given IO operation to @m@.
  --
  -- The given IO operation may be rerun, so use of this function requires
  -- manually verifying that the given IO operation is rerunnable.
  rerunnableIO :: IO a -> m a

instance MonadRerunnableIO IO where
  rerunnableIO :: IO a -> IO a
rerunnableIO = IO a -> IO a
forall a. a -> a
id

{- Instances for common monad transformers -}

instance MonadRerunnableIO m => MonadRerunnableIO (Reader.ReaderT r m) where
  rerunnableIO :: IO a -> ReaderT r m a
rerunnableIO = m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ReaderT r m a) -> (IO a -> m a) -> IO a -> ReaderT r m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> m a
forall (m :: * -> *) a. MonadRerunnableIO m => IO a -> m a
rerunnableIO

instance MonadRerunnableIO m => MonadRerunnableIO (Except.ExceptT e m) where
  rerunnableIO :: IO a -> ExceptT e m a
rerunnableIO = m a -> ExceptT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ExceptT e m a) -> (IO a -> m a) -> IO a -> ExceptT e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> m a
forall (m :: * -> *) a. MonadRerunnableIO m => IO a -> m a
rerunnableIO

instance MonadRerunnableIO m => MonadRerunnableIO (Identity.IdentityT m) where
  rerunnableIO :: IO a -> IdentityT m a
rerunnableIO = m a -> IdentityT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> IdentityT m a) -> (IO a -> m a) -> IO a -> IdentityT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> m a
forall (m :: * -> *) a. MonadRerunnableIO m => IO a -> m a
rerunnableIO

instance MonadRerunnableIO m => MonadRerunnableIO (Maybe.MaybeT m) where
  rerunnableIO :: IO a -> MaybeT m a
rerunnableIO = m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> MaybeT m a) -> (IO a -> m a) -> IO a -> MaybeT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> m a
forall (m :: * -> *) a. MonadRerunnableIO m => IO a -> m a
rerunnableIO

instance (Monoid w, MonadRerunnableIO m) => MonadRerunnableIO (RWS.Lazy.RWST r w s m) where
  rerunnableIO :: IO a -> RWST r w s m a
rerunnableIO = m a -> RWST r w s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> RWST r w s m a) -> (IO a -> m a) -> IO a -> RWST r w s m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> m a
forall (m :: * -> *) a. MonadRerunnableIO m => IO a -> m a
rerunnableIO

instance (Monoid w, MonadRerunnableIO m) => MonadRerunnableIO (RWS.Strict.RWST r w s m) where
  rerunnableIO :: IO a -> RWST r w s m a
rerunnableIO = m a -> RWST r w s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> RWST r w s m a) -> (IO a -> m a) -> IO a -> RWST r w s m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> m a
forall (m :: * -> *) a. MonadRerunnableIO m => IO a -> m a
rerunnableIO

instance MonadRerunnableIO m => MonadRerunnableIO (State.Lazy.StateT s m) where
  rerunnableIO :: IO a -> StateT s m a
rerunnableIO = m a -> StateT s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> StateT s m a) -> (IO a -> m a) -> IO a -> StateT s m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> m a
forall (m :: * -> *) a. MonadRerunnableIO m => IO a -> m a
rerunnableIO

instance MonadRerunnableIO m => MonadRerunnableIO (State.Strict.StateT s m) where
  rerunnableIO :: IO a -> StateT s m a
rerunnableIO = m a -> StateT s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> StateT s m a) -> (IO a -> m a) -> IO a -> StateT s m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> m a
forall (m :: * -> *) a. MonadRerunnableIO m => IO a -> m a
rerunnableIO

instance (Monoid w, MonadRerunnableIO m) => MonadRerunnableIO (Writer.Lazy.WriterT w m) where
  rerunnableIO :: IO a -> WriterT w m a
rerunnableIO = m a -> WriterT w m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> WriterT w m a) -> (IO a -> m a) -> IO a -> WriterT w m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> m a
forall (m :: * -> *) a. MonadRerunnableIO m => IO a -> m a
rerunnableIO

instance (Monoid w, MonadRerunnableIO m) => MonadRerunnableIO (Writer.Strict.WriterT w m) where
  rerunnableIO :: IO a -> WriterT w m a
rerunnableIO = m a -> WriterT w m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> WriterT w m a) -> (IO a -> m a) -> IO a -> WriterT w m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> m a
forall (m :: * -> *) a. MonadRerunnableIO m => IO a -> m a
rerunnableIO

instance MonadRerunnableIO m => MonadRerunnableIO (Resource.ResourceT m) where
  rerunnableIO :: IO a -> ResourceT m a
rerunnableIO = m a -> ResourceT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ResourceT m a) -> (IO a -> m a) -> IO a -> ResourceT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> m a
forall (m :: * -> *) a. MonadRerunnableIO m => IO a -> m a
rerunnableIO