1{-# LANGUAGE CPP 2 , NoImplicitPrelude 3 , RankNTypes 4 , TypeFamilies 5 , FunctionalDependencies 6 , FlexibleInstances 7 , UndecidableInstances 8 , MultiParamTypeClasses #-} 9 10#if __GLASGOW_HASKELL__ >= 702 11{-# LANGUAGE Safe #-} 12#endif 13 14#if MIN_VERSION_transformers(0,4,0) 15-- Hide warnings for the deprecated ErrorT transformer: 16{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} 17#endif 18 19{- | 20Copyright : Bas van Dijk, Anders Kaseorg 21License : BSD3 22Maintainer : Bas van Dijk <v.dijk.bas@gmail.com> 23 24This module defines the type class 'MonadBaseControl', a subset of 25'MonadBase' into which generic control operations such as @catch@ can be 26lifted from @IO@ or any other base monad. Instances are based on monad 27transformers in 'MonadTransControl', which includes all standard monad 28transformers in the @transformers@ library except @ContT@. 29 30See the <http://hackage.haskell.org/package/lifted-base lifted-base> 31package which uses @monad-control@ to lift @IO@ 32operations from the @base@ library (like @catch@ or @bracket@) into any monad 33that is an instance of @MonadBase@ or @MonadBaseControl@. 34 35See the following tutorial by Michael Snoyman on how to use this package: 36 37<https://www.yesodweb.com/book/monad-control> 38 39=== Quick implementation guide 40 41Given a base monad @B@ and a stack of transformers @T@: 42 43* Define instances @'MonadTransControl' T@ for all transformers @T@, using the 44 @'defaultLiftWith'@ and @'defaultRestoreT'@ functions on the constructor and 45 deconstructor of @T@. 46 47* Define an instance @'MonadBaseControl' B B@ for the base monad: 48 49 @ 50 instance MonadBaseControl B B where 51 type StM B a = a 52 liftBaseWith f = f 'id' 53 restoreM = 'return' 54 @ 55 56* Define instances @'MonadBaseControl' B m => 'MonadBaseControl' B (T m)@ for 57 all transformers: 58 59 @ 60 instance MonadBaseControl b m => MonadBaseControl b (T m) where 61 type StM (T m) a = 'ComposeSt' T m a 62 liftBaseWith f = 'defaultLiftBaseWith' 63 restoreM = 'defaultRestoreM' 64 @ 65-} 66 67module Control.Monad.Trans.Control 68 ( -- * MonadTransControl 69 MonadTransControl(..), Run 70 71 -- ** Defaults 72 -- $MonadTransControlDefaults 73 , RunDefault, defaultLiftWith, defaultRestoreT 74 -- *** Defaults for a stack of two 75 -- $MonadTransControlDefaults2 76 , RunDefault2, defaultLiftWith2, defaultRestoreT2 77 78 -- * MonadBaseControl 79 , MonadBaseControl (..), RunInBase 80 81 -- ** Defaults 82 -- $MonadBaseControlDefaults 83 , ComposeSt, RunInBaseDefault, defaultLiftBaseWith, defaultRestoreM 84 85 -- * Utility functions 86 , control, embed, embed_, captureT, captureM 87 88 , liftBaseOp, liftBaseOp_ 89 90 , liftBaseDiscard, liftBaseOpDiscard 91 92 , liftThrough 93 ) where 94 95 96-------------------------------------------------------------------------------- 97-- Imports 98-------------------------------------------------------------------------------- 99 100-- from base: 101import Data.Function ( (.), ($), const ) 102import Data.Monoid ( Monoid, mempty ) 103import Control.Monad ( Monad, (>>=), return, liftM ) 104import System.IO ( IO ) 105import Data.Maybe ( Maybe ) 106import Data.Either ( Either ) 107 108#if MIN_VERSION_base(4,4,0) 109import Control.Monad.ST.Lazy.Safe ( ST ) 110import qualified Control.Monad.ST.Safe as Strict ( ST ) 111#endif 112 113-- from stm: 114import Control.Monad.STM ( STM ) 115 116-- from transformers: 117import Control.Monad.Trans.Class ( MonadTrans ) 118 119import Control.Monad.Trans.Identity ( IdentityT(IdentityT), runIdentityT ) 120import Control.Monad.Trans.List ( ListT (ListT), runListT ) 121import Control.Monad.Trans.Maybe ( MaybeT (MaybeT), runMaybeT ) 122import Control.Monad.Trans.Error ( ErrorT (ErrorT), runErrorT, Error ) 123import Control.Monad.Trans.Reader ( ReaderT (ReaderT), runReaderT ) 124import Control.Monad.Trans.State ( StateT (StateT), runStateT ) 125import Control.Monad.Trans.Writer ( WriterT (WriterT), runWriterT ) 126import Control.Monad.Trans.RWS ( RWST (RWST), runRWST ) 127import Control.Monad.Trans.Except ( ExceptT (ExceptT), runExceptT ) 128 129import qualified Control.Monad.Trans.RWS.Strict as Strict ( RWST (RWST), runRWST ) 130import qualified Control.Monad.Trans.State.Strict as Strict ( StateT (StateT), runStateT ) 131import qualified Control.Monad.Trans.Writer.Strict as Strict ( WriterT(WriterT), runWriterT ) 132 133import Data.Functor.Identity ( Identity ) 134 135-- from transformers-base: 136import Control.Monad.Base ( MonadBase ) 137 138#if MIN_VERSION_base(4,3,0) 139import Control.Monad ( void ) 140#else 141import Data.Functor (Functor, fmap) 142void :: Functor f => f a -> f () 143void = fmap (const ()) 144#endif 145 146import Prelude (id) 147 148-------------------------------------------------------------------------------- 149-- MonadTransControl type class 150-------------------------------------------------------------------------------- 151 152-- | The @MonadTransControl@ type class is a stronger version of @'MonadTrans'@: 153-- 154-- Instances of @'MonadTrans'@ know how to @'lift'@ actions in the base monad to 155-- the transformed monad. These lifted actions, however, are completely unaware 156-- of the monadic state added by the transformer. 157-- 158-- @'MonadTransControl'@ instances are aware of the monadic state of the 159-- transformer and allow to save and restore this state. 160-- 161-- This allows to lift functions that have a monad transformer in both positive 162-- and negative position. Take, for example, the function 163-- 164-- @ 165-- withFile :: FilePath -> IOMode -> (Handle -> IO r) -> IO r 166-- @ 167-- 168-- @'MonadTrans'@ instances can only lift the return type of the @withFile@ 169-- function: 170-- 171-- @ 172-- withFileLifted :: MonadTrans t => FilePath -> IOMode -> (Handle -> IO r) -> t IO r 173-- withFileLifted file mode action = lift (withFile file mode action) 174-- @ 175-- 176-- However, @'MonadTrans'@ is not powerful enough to make @withFileLifted@ 177-- accept a function that returns @t IO@. The reason is that we need to take 178-- away the transformer layer in order to pass the function to @'withFile'@. 179-- @'MonadTransControl'@ allows us to do this: 180-- 181-- @ 182-- withFileLifted' :: (Monad (t IO), MonadTransControl t) => FilePath -> IOMode -> (Handle -> t IO r) -> t IO r 183-- withFileLifted' file mode action = liftWith (\\run -> withFile file mode (run . action)) >>= restoreT . return 184-- @ 185class MonadTrans t => MonadTransControl t where 186 -- | Monadic state of @t@. 187 -- 188 -- The monadic state of a monad transformer is the result type of its @run@ 189 -- function, e.g.: 190 -- 191 -- @ 192 -- 'runReaderT' :: 'ReaderT' r m a -> r -> m a 193 -- 'StT' ('ReaderT' r) a ~ a 194 -- 195 -- 'runStateT' :: 'StateT' s m a -> s -> m (a, s) 196 -- 'StT' ('StateT' s) a ~ (a, s) 197 -- 198 -- 'runMaybeT' :: 'MaybeT' m a -> m ('Maybe' a) 199 -- 'StT' 'MaybeT' a ~ 'Maybe' a 200 -- @ 201 -- 202 -- Provided type instances: 203 -- 204 -- @ 205 -- StT 'IdentityT' a ~ a 206 -- StT 'MaybeT' a ~ 'Maybe' a 207 -- StT ('ErrorT' e) a ~ 'Error' e => 'Either' e a 208 -- StT ('ExceptT' e) a ~ 'Either' e a 209 -- StT 'ListT' a ~ [a] 210 -- StT ('ReaderT' r) a ~ a 211 -- StT ('StateT' s) a ~ (a, s) 212 -- StT ('WriterT' w) a ~ 'Monoid' w => (a, w) 213 -- StT ('RWST' r w s) a ~ 'Monoid' w => (a, s, w) 214 -- @ 215 type StT t a :: * 216 217 -- | @liftWith@ is similar to 'lift' in that it lifts a computation from 218 -- the argument monad to the constructed monad. 219 -- 220 -- Instances should satisfy similar laws as the 'MonadTrans' laws: 221 -- 222 -- @liftWith . const . return = return@ 223 -- 224 -- @liftWith (const (m >>= f)) = liftWith (const m) >>= liftWith . const . f@ 225 -- 226 -- The difference with 'lift' is that before lifting the @m@ computation 227 -- @liftWith@ captures the state of @t@. It then provides the @m@ 228 -- computation with a 'Run' function that allows running @t n@ computations in 229 -- @n@ (for all @n@) on the captured state, e.g. 230 -- 231 -- @ 232 -- withFileLifted :: (Monad (t IO), MonadTransControl t) => FilePath -> IOMode -> (Handle -> t IO r) -> t IO r 233 -- withFileLifted file mode action = liftWith (\\run -> withFile file mode (run . action)) >>= restoreT . return 234 -- @ 235 -- 236 -- If the @Run@ function is ignored, @liftWith@ coincides with @lift@: 237 -- 238 -- @lift f = liftWith (const f)@ 239 -- 240 -- Implementations use the @'Run'@ function associated with a transformer: 241 -- 242 -- @ 243 -- liftWith :: 'Monad' m => (('Monad' n => 'ReaderT' r n b -> n b) -> m a) -> 'ReaderT' r m a 244 -- liftWith f = 'ReaderT' (\r -> f (\action -> 'runReaderT' action r)) 245 -- 246 -- liftWith :: 'Monad' m => (('Monad' n => 'StateT' s n b -> n (b, s)) -> m a) -> 'StateT' s m a 247 -- liftWith f = 'StateT' (\s -> 'liftM' (\x -> (x, s)) (f (\action -> 'runStateT' action s))) 248 -- 249 -- liftWith :: 'Monad' m => (('Monad' n => 'MaybeT' n b -> n ('Maybe' b)) -> m a) -> 'MaybeT' m a 250 -- liftWith f = 'MaybeT' ('liftM' 'Just' (f 'runMaybeT')) 251 -- @ 252 liftWith :: Monad m => (Run t -> m a) -> t m a 253 254 -- | Construct a @t@ computation from the monadic state of @t@ that is 255 -- returned from a 'Run' function. 256 -- 257 -- Instances should satisfy: 258 -- 259 -- @liftWith (\\run -> run t) >>= restoreT . return = t@ 260 -- 261 -- @restoreT@ is usually implemented through the constructor of the monad 262 -- transformer: 263 -- 264 -- @ 265 -- 'ReaderT' :: (r -> m a) -> 'ReaderT' r m a 266 -- restoreT :: m a -> 'ReaderT' r m a 267 -- restoreT action = 'ReaderT' { runReaderT = 'const' action } 268 -- 269 -- 'StateT' :: (s -> m (a, s)) -> 'StateT' s m a 270 -- restoreT :: m (a, s) -> 'StateT' s m a 271 -- restoreT action = 'StateT' { runStateT = 'const' action } 272 -- 273 -- 'MaybeT' :: m ('Maybe' a) -> 'MaybeT' m a 274 -- restoreT :: m ('Maybe' a) -> 'MaybeT' m a 275 -- restoreT action = 'MaybeT' action 276 -- @ 277 -- 278 -- Example type signatures: 279 -- 280 -- @ 281 -- restoreT :: 'Monad' m => m a -> 'IdentityT' m a 282 -- restoreT :: 'Monad' m => m ('Maybe' a) -> 'MaybeT' m a 283 -- restoreT :: ('Monad' m, 'Error' e) => m ('Either' e a) -> 'ErrorT' e m a 284 -- restoreT :: 'Monad' m => m ('Either' e a) -> 'ExceptT' e m a 285 -- restoreT :: 'Monad' m => m [a] -> 'ListT' m a 286 -- restoreT :: 'Monad' m => m a -> 'ReaderT' r m a 287 -- restoreT :: 'Monad' m => m (a, s) -> 'StateT' s m a 288 -- restoreT :: ('Monad' m, 'Monoid' w) => m (a, w) -> 'WriterT' w m a 289 -- restoreT :: ('Monad' m, 'Monoid' w) => m (a, s, w) -> 'RWST' r w s m a 290 -- @ 291 restoreT :: Monad m => m (StT t a) -> t m a 292 293-- | A function that runs a transformed monad @t n@ on the monadic state that 294-- was captured by 'liftWith' 295-- 296-- A @Run t@ function yields a computation in @n@ that returns the monadic state 297-- of @t@. This state can later be used to restore a @t@ computation using 298-- 'restoreT'. 299-- 300-- Example type equalities: 301-- 302-- @ 303-- Run 'IdentityT' ~ forall n b. 'Monad' n => 'IdentityT' n b -> n b 304-- Run 'MaybeT' ~ forall n b. 'Monad' n => 'MaybeT' n b -> n ('Maybe' b) 305-- Run ('ErrorT' e) ~ forall n b. ('Monad' n, 'Error' e) => 'ErrorT' e n b -> n ('Either' e b) 306-- Run ('ExceptT' e) ~ forall n b. 'Monad' n => 'ExceptT' e n b -> n ('Either' e b) 307-- Run 'ListT' ~ forall n b. 'Monad' n => 'ListT' n b -> n [b] 308-- Run ('ReaderT' r) ~ forall n b. 'Monad' n => 'ReaderT' r n b -> n b 309-- Run ('StateT' s) ~ forall n b. 'Monad' n => 'StateT' s n b -> n (a, s) 310-- Run ('WriterT' w) ~ forall n b. ('Monad' n, 'Monoid' w) => 'WriterT' w n b -> n (a, w) 311-- Run ('RWST' r w s) ~ forall n b. ('Monad' n, 'Monoid' w) => 'RWST' r w s n b -> n (a, s, w) 312-- @ 313-- 314-- This type is usually satisfied by the @run@ function of a transformer: 315-- 316-- @ 317-- 'flip' 'runReaderT' :: r -> Run ('ReaderT' r) 318-- 'flip' 'runStateT' :: s -> Run ('StateT' s) 319-- 'runMaybeT' :: Run 'MaybeT' 320-- @ 321type Run t = forall n b. Monad n => t n b -> n (StT t b) 322 323 324-------------------------------------------------------------------------------- 325-- Defaults for MonadTransControl 326-------------------------------------------------------------------------------- 327 328-- $MonadTransControlDefaults 329-- 330-- The following functions can be used to define a 'MonadTransControl' instance 331-- for a monad transformer which simply is a newtype around another monad 332-- transformer which already has a @MonadTransControl@ instance. For example: 333-- 334-- @ 335-- {-\# LANGUAGE GeneralizedNewtypeDeriving \#-} 336-- {-\# LANGUAGE UndecidableInstances \#-} 337-- {-\# LANGUAGE TypeFamilies \#-} 338-- 339-- newtype CounterT m a = CounterT {unCounterT :: StateT Int m a} 340-- deriving (Monad, MonadTrans) 341-- 342-- instance MonadTransControl CounterT where 343-- type StT CounterT a = StT (StateT Int) a 344-- liftWith = 'defaultLiftWith' CounterT unCounterT 345-- restoreT = 'defaultRestoreT' CounterT 346-- @ 347 348-- | A function like 'Run' that runs a monad transformer @t@ which wraps the 349-- monad transformer @t'@. This is used in 'defaultLiftWith'. 350type RunDefault t t' = forall n b. Monad n => t n b -> n (StT t' b) 351 352-- | Default definition for the 'liftWith' method. 353defaultLiftWith :: (Monad m, MonadTransControl n) 354 => (forall b. n m b -> t m b) -- ^ Monad constructor 355 -> (forall o b. t o b -> n o b) -- ^ Monad deconstructor 356 -> (RunDefault t n -> m a) 357 -> t m a 358defaultLiftWith t unT = \f -> t $ liftWith $ \run -> f $ run . unT 359{-# INLINABLE defaultLiftWith #-} 360 361-- | Default definition for the 'restoreT' method. 362defaultRestoreT :: (Monad m, MonadTransControl n) 363 => (n m a -> t m a) -- ^ Monad constructor 364 -> m (StT n a) 365 -> t m a 366defaultRestoreT t = t . restoreT 367{-# INLINABLE defaultRestoreT #-} 368 369------------------------------------------------------------------------------- 370-- 371------------------------------------------------------------------------------- 372 373-- $MonadTransControlDefaults2 374-- 375-- The following functions can be used to define a 'MonadTransControl' instance 376-- for a monad transformer stack of two. 377-- 378-- @ 379-- {-\# LANGUAGE GeneralizedNewtypeDeriving \#-} 380-- 381-- newtype CalcT m a = CalcT { unCalcT :: StateT Int (ExceptT String m) a } 382-- deriving (Monad, MonadTrans) 383-- 384-- instance MonadTransControl CalcT where 385-- type StT CalcT a = StT (ExceptT String) (StT (StateT Int) a) 386-- liftWith = 'defaultLiftWith2' CalcT unCalcT 387-- restoreT = 'defaultRestoreT2' CalcT 388-- @ 389 390-- | A function like 'Run' that runs a monad transformer @t@ which wraps the 391-- monad transformers @n@ and @n'@. This is used in 'defaultLiftWith2'. 392type RunDefault2 t n n' = forall m b. (Monad m, Monad (n' m)) => t m b -> m (StT n' (StT n b)) 393 394-- | Default definition for the 'liftWith' method. 395defaultLiftWith2 :: (Monad m, Monad (n' m), MonadTransControl n, MonadTransControl n') 396 => (forall b. n (n' m) b -> t m b) -- ^ Monad constructor 397 -> (forall o b. t o b -> n (n' o) b) -- ^ Monad deconstructor 398 -> (RunDefault2 t n n' -> m a) 399 -> t m a 400defaultLiftWith2 t unT = \f -> t $ liftWith $ \run -> liftWith $ \run' -> f $ run' . run . unT 401{-# INLINABLE defaultLiftWith2 #-} 402 403-- | Default definition for the 'restoreT' method for double 'MonadTransControl'. 404defaultRestoreT2 :: (Monad m, Monad (n' m), MonadTransControl n, MonadTransControl n') 405 => (n (n' m) a -> t m a) -- ^ Monad constructor 406 -> m (StT n' (StT n a)) 407 -> t m a 408defaultRestoreT2 t = t . restoreT . restoreT 409{-# INLINABLE defaultRestoreT2 #-} 410 411-------------------------------------------------------------------------------- 412-- MonadTransControl instances 413-------------------------------------------------------------------------------- 414 415instance MonadTransControl IdentityT where 416 type StT IdentityT a = a 417 liftWith f = IdentityT $ f $ runIdentityT 418 restoreT = IdentityT 419 {-# INLINABLE liftWith #-} 420 {-# INLINABLE restoreT #-} 421 422instance MonadTransControl MaybeT where 423 type StT MaybeT a = Maybe a 424 liftWith f = MaybeT $ liftM return $ f $ runMaybeT 425 restoreT = MaybeT 426 {-# INLINABLE liftWith #-} 427 {-# INLINABLE restoreT #-} 428 429instance Error e => MonadTransControl (ErrorT e) where 430 type StT (ErrorT e) a = Either e a 431 liftWith f = ErrorT $ liftM return $ f $ runErrorT 432 restoreT = ErrorT 433 {-# INLINABLE liftWith #-} 434 {-# INLINABLE restoreT #-} 435 436instance MonadTransControl (ExceptT e) where 437 type StT (ExceptT e) a = Either e a 438 liftWith f = ExceptT $ liftM return $ f $ runExceptT 439 restoreT = ExceptT 440 {-# INLINABLE liftWith #-} 441 {-# INLINABLE restoreT #-} 442 443instance MonadTransControl ListT where 444 type StT ListT a = [a] 445 liftWith f = ListT $ liftM return $ f $ runListT 446 restoreT = ListT 447 {-# INLINABLE liftWith #-} 448 {-# INLINABLE restoreT #-} 449 450instance MonadTransControl (ReaderT r) where 451 type StT (ReaderT r) a = a 452 liftWith f = ReaderT $ \r -> f $ \t -> runReaderT t r 453 restoreT = ReaderT . const 454 {-# INLINABLE liftWith #-} 455 {-# INLINABLE restoreT #-} 456 457instance MonadTransControl (StateT s) where 458 type StT (StateT s) a = (a, s) 459 liftWith f = StateT $ \s -> 460 liftM (\x -> (x, s)) 461 (f $ \t -> runStateT t s) 462 restoreT = StateT . const 463 {-# INLINABLE liftWith #-} 464 {-# INLINABLE restoreT #-} 465 466instance MonadTransControl (Strict.StateT s) where 467 type StT (Strict.StateT s) a = (a, s) 468 liftWith f = Strict.StateT $ \s -> 469 liftM (\x -> (x, s)) 470 (f $ \t -> Strict.runStateT t s) 471 restoreT = Strict.StateT . const 472 {-# INLINABLE liftWith #-} 473 {-# INLINABLE restoreT #-} 474 475instance Monoid w => MonadTransControl (WriterT w) where 476 type StT (WriterT w) a = (a, w) 477 liftWith f = WriterT $ liftM (\x -> (x, mempty)) 478 (f $ runWriterT) 479 restoreT = WriterT 480 {-# INLINABLE liftWith #-} 481 {-# INLINABLE restoreT #-} 482 483instance Monoid w => MonadTransControl (Strict.WriterT w) where 484 type StT (Strict.WriterT w) a = (a, w) 485 liftWith f = Strict.WriterT $ liftM (\x -> (x, mempty)) 486 (f $ Strict.runWriterT) 487 restoreT = Strict.WriterT 488 {-# INLINABLE liftWith #-} 489 {-# INLINABLE restoreT #-} 490 491instance Monoid w => MonadTransControl (RWST r w s) where 492 type StT (RWST r w s) a = (a, s, w) 493 liftWith f = RWST $ \r s -> liftM (\x -> (x, s, mempty)) 494 (f $ \t -> runRWST t r s) 495 restoreT mSt = RWST $ \_ _ -> mSt 496 {-# INLINABLE liftWith #-} 497 {-# INLINABLE restoreT #-} 498 499instance Monoid w => MonadTransControl (Strict.RWST r w s) where 500 type StT (Strict.RWST r w s) a = (a, s, w) 501 liftWith f = 502 Strict.RWST $ \r s -> liftM (\x -> (x, s, mempty)) 503 (f $ \t -> Strict.runRWST t r s) 504 restoreT mSt = Strict.RWST $ \_ _ -> mSt 505 {-# INLINABLE liftWith #-} 506 {-# INLINABLE restoreT #-} 507 508 509-------------------------------------------------------------------------------- 510-- MonadBaseControl type class 511-------------------------------------------------------------------------------- 512 513-- | 514-- == Writing instances 515-- 516-- The usual way to write a @'MonadBaseControl'@ instance for a transformer 517-- stack over a base monad @B@ is to write an instance @MonadBaseControl B B@ 518-- for the base monad, and @MonadTransControl T@ instances for every transformer 519-- @T@. Instances for @'MonadBaseControl'@ are then simply implemented using 520-- @'ComposeSt'@, @'defaultLiftBaseWith'@, @'defaultRestoreM'@. 521class MonadBase b m => MonadBaseControl b m | m -> b where 522 -- | Monadic state that @m@ adds to the base monad @b@. 523 -- 524 -- For all base (non-transformed) monads, @StM m a ~ a@: 525 -- 526 -- @ 527 -- StM 'IO' a ~ a 528 -- StM 'Maybe' a ~ a 529 -- StM ('Either' e) a ~ a 530 -- StM [] a ~ a 531 -- StM ((->) r) a ~ a 532 -- StM 'Identity' a ~ a 533 -- StM 'STM' a ~ a 534 -- StM ('ST' s) a ~ a 535 -- @ 536 -- 537 -- If @m@ is a transformed monad, @m ~ t b@, @'StM'@ is the monadic state of 538 -- the transformer @t@ (given by its 'StT' from 'MonadTransControl'). For a 539 -- transformer stack, @'StM'@ is defined recursively: 540 -- 541 -- @ 542 -- StM ('IdentityT' m) a ~ 'ComposeSt' 'IdentityT' m a ~ StM m a 543 -- StM ('MaybeT' m) a ~ 'ComposeSt' 'MaybeT' m a ~ StM m ('Maybe' a) 544 -- StM ('ErrorT' e m) a ~ 'ComposeSt' 'ErrorT' m a ~ 'Error' e => StM m ('Either' e a) 545 -- StM ('ExceptT' e m) a ~ 'ComposeSt' 'ExceptT' m a ~ StM m ('Either' e a) 546 -- StM ('ListT' m) a ~ 'ComposeSt' 'ListT' m a ~ StM m [a] 547 -- StM ('ReaderT' r m) a ~ 'ComposeSt' 'ReaderT' m a ~ StM m a 548 -- StM ('StateT' s m) a ~ 'ComposeSt' 'StateT' m a ~ StM m (a, s) 549 -- StM ('WriterT' w m) a ~ 'ComposeSt' 'WriterT' m a ~ 'Monoid' w => StM m (a, w) 550 -- StM ('RWST' r w s m) a ~ 'ComposeSt' 'RWST' m a ~ 'Monoid' w => StM m (a, s, w) 551 -- @ 552 type StM m a :: * 553 554 -- | @liftBaseWith@ is similar to 'liftIO' and 'liftBase' in that it 555 -- lifts a base computation to the constructed monad. 556 -- 557 -- Instances should satisfy similar laws as the 'MonadIO' and 'MonadBase' laws: 558 -- 559 -- @liftBaseWith . const . return = return@ 560 -- 561 -- @liftBaseWith (const (m >>= f)) = liftBaseWith (const m) >>= liftBaseWith . const . f@ 562 -- 563 -- The difference with 'liftBase' is that before lifting the base computation 564 -- @liftBaseWith@ captures the state of @m@. It then provides the base 565 -- computation with a 'RunInBase' function that allows running @m@ 566 -- computations in the base monad on the captured state: 567 -- 568 -- @ 569 -- withFileLifted :: MonadBaseControl IO m => FilePath -> IOMode -> (Handle -> m a) -> m a 570 -- withFileLifted file mode action = liftBaseWith (\\runInBase -> withFile file mode (runInBase . action)) >>= restoreM 571 -- -- = control $ \\runInBase -> withFile file mode (runInBase . action) 572 -- -- = liftBaseOp (withFile file mode) action 573 -- @ 574 -- 575 -- @'liftBaseWith'@ is usually not implemented directly, but using 576 -- @'defaultLiftBaseWith'@. 577 liftBaseWith :: (RunInBase m b -> b a) -> m a 578 579 -- | Construct a @m@ computation from the monadic state of @m@ that is 580 -- returned from a 'RunInBase' function. 581 -- 582 -- Instances should satisfy: 583 -- 584 -- @liftBaseWith (\\runInBase -> runInBase m) >>= restoreM = m@ 585 -- 586 -- @'restoreM'@ is usually not implemented directly, but using 587 -- @'defaultRestoreM'@. 588 restoreM :: StM m a -> m a 589 590-- | A function that runs a @m@ computation on the monadic state that was 591-- captured by 'liftBaseWith' 592-- 593-- A @RunInBase m@ function yields a computation in the base monad of @m@ that 594-- returns the monadic state of @m@. This state can later be used to restore the 595-- @m@ computation using 'restoreM'. 596-- 597-- Example type equalities: 598-- 599-- @ 600-- RunInBase ('IdentityT' m) b ~ forall a. 'IdentityT' m a -> b ('StM' m a) 601-- RunInBase ('MaybeT' m) b ~ forall a. 'MaybeT' m a -> b ('StM' m ('Maybe' a)) 602-- RunInBase ('ErrorT' e m) b ~ forall a. 'Error' e => 'ErrorT' e m a -> b ('StM' m ('Either' e a)) 603-- RunInBase ('ExceptT' e m) b ~ forall a. 'ExceptT' e m a -> b ('StM' m ('Either' e a)) 604-- RunInBase ('ListT' m) b ~ forall a. 'ListT' m a -> b ('StM' m [a]) 605-- RunInBase ('ReaderT' r m) b ~ forall a. 'ReaderT' m a -> b ('StM' m a) 606-- RunInBase ('StateT' s m) b ~ forall a. 'StateT' s m a -> b ('StM' m (a, s)) 607-- RunInBase ('WriterT' w m) b ~ forall a. 'Monoid' w => 'WriterT' w m a -> b ('StM' m (a, w)) 608-- RunInBase ('RWST' r w s m) b ~ forall a. 'Monoid' w => 'RWST' r w s m a -> b ('StM' m (a, s, w)) 609-- @ 610-- 611-- For a transformed base monad @m ~ t b@, @'RunInBase m b' ~ 'Run' t@. 612type RunInBase m b = forall a. m a -> b (StM m a) 613 614 615-------------------------------------------------------------------------------- 616-- MonadBaseControl instances for all monads in the base library 617-------------------------------------------------------------------------------- 618 619#define BASE(M) \ 620instance MonadBaseControl (M) (M) where { \ 621 type StM (M) a = a; \ 622 liftBaseWith f = f id; \ 623 restoreM = return; \ 624 {-# INLINABLE liftBaseWith #-}; \ 625 {-# INLINABLE restoreM #-}} 626 627BASE(IO) 628BASE(Maybe) 629BASE(Either e) 630BASE([]) 631BASE((->) r) 632BASE(Identity) 633 634BASE(STM) 635 636#if MIN_VERSION_base(4,4,0) 637BASE(Strict.ST s) 638BASE( ST s) 639#endif 640 641#undef BASE 642 643 644-------------------------------------------------------------------------------- 645-- Defaults for MonadBaseControl 646-------------------------------------------------------------------------------- 647 648-- $MonadBaseControlDefaults 649-- 650-- Note that by using the following default definitions it's easy to make a 651-- monad transformer @T@ an instance of 'MonadBaseControl': 652-- 653-- @ 654-- instance MonadBaseControl b m => MonadBaseControl b (T m) where 655-- type StM (T m) a = 'ComposeSt' T m a 656-- liftBaseWith = 'defaultLiftBaseWith' 657-- restoreM = 'defaultRestoreM' 658-- @ 659-- 660-- Defining an instance for a base monad @B@ is equally straightforward: 661-- 662-- @ 663-- instance MonadBaseControl B B where 664-- type StM B a = a 665-- liftBaseWith f = f 'id' 666-- restoreM = 'return' 667-- @ 668 669-- | Handy type synonym that composes the monadic states of @t@ and @m@. 670-- 671-- It can be used to define the 'StM' for new 'MonadBaseControl' instances. 672type ComposeSt t m a = StM m (StT t a) 673 674-- | A function like 'RunInBase' that runs a monad transformer @t@ in its base 675-- monad @b@. It is used in 'defaultLiftBaseWith'. 676type RunInBaseDefault t m b = forall a. t m a -> b (ComposeSt t m a) 677 678-- | Default definition for the 'liftBaseWith' method. 679-- 680-- Note that it composes a 'liftWith' of @t@ with a 'liftBaseWith' of @m@ to 681-- give a 'liftBaseWith' of @t m@: 682-- 683-- @ 684-- defaultLiftBaseWith = \\f -> 'liftWith' $ \\run -> 685-- 'liftBaseWith' $ \\runInBase -> 686-- f $ runInBase . run 687-- @ 688defaultLiftBaseWith :: (MonadTransControl t, MonadBaseControl b m) 689 => (RunInBaseDefault t m b -> b a) -> t m a 690defaultLiftBaseWith = \f -> liftWith $ \run -> 691 liftBaseWith $ \runInBase -> 692 f $ runInBase . run 693{-# INLINABLE defaultLiftBaseWith #-} 694 695-- | Default definition for the 'restoreM' method. 696-- 697-- Note that: @defaultRestoreM = 'restoreT' . 'restoreM'@ 698defaultRestoreM :: (MonadTransControl t, MonadBaseControl b m) 699 => ComposeSt t m a -> t m a 700defaultRestoreM = restoreT . restoreM 701{-# INLINABLE defaultRestoreM #-} 702 703 704-------------------------------------------------------------------------------- 705-- MonadBaseControl transformer instances 706-------------------------------------------------------------------------------- 707 708#define BODY(T) { \ 709 type StM (T m) a = ComposeSt (T) m a; \ 710 liftBaseWith = defaultLiftBaseWith; \ 711 restoreM = defaultRestoreM; \ 712 {-# INLINABLE liftBaseWith #-}; \ 713 {-# INLINABLE restoreM #-}} 714 715#define TRANS( T) \ 716 instance ( MonadBaseControl b m) => MonadBaseControl b (T m) where BODY(T) 717#define TRANS_CTX(CTX, T) \ 718 instance (CTX, MonadBaseControl b m) => MonadBaseControl b (T m) where BODY(T) 719 720TRANS(IdentityT) 721TRANS(MaybeT) 722TRANS(ListT) 723TRANS(ReaderT r) 724TRANS(Strict.StateT s) 725TRANS( StateT s) 726TRANS(ExceptT e) 727 728TRANS_CTX(Error e, ErrorT e) 729TRANS_CTX(Monoid w, Strict.WriterT w) 730TRANS_CTX(Monoid w, WriterT w) 731TRANS_CTX(Monoid w, Strict.RWST r w s) 732TRANS_CTX(Monoid w, RWST r w s) 733 734 735-------------------------------------------------------------------------------- 736-- * Utility functions 737-------------------------------------------------------------------------------- 738 739-- | An often used composition: @control f = 'liftBaseWith' f >>= 'restoreM'@ 740-- 741-- Example: 742-- 743-- @ 744-- liftedBracket :: MonadBaseControl IO m => m a -> (a -> m b) -> (a -> m c) -> m c 745-- liftedBracket acquire release action = control $ \\runInBase -> 746-- bracket (runInBase acquire) 747-- (\\saved -> runInBase (restoreM saved >>= release)) 748-- (\\saved -> runInBase (restoreM saved >>= action)) 749-- @ 750control :: MonadBaseControl b m => (RunInBase m b -> b (StM m a)) -> m a 751control f = liftBaseWith f >>= restoreM 752{-# INLINABLE control #-} 753 754-- | Embed a transformer function as an function in the base monad returning a 755-- mutated transformer state. 756embed :: MonadBaseControl b m => (a -> m c) -> m (a -> b (StM m c)) 757embed f = liftBaseWith $ \runInBase -> return (runInBase . f) 758{-# INLINABLE embed #-} 759 760-- | Performs the same function as 'embed', but discards transformer state 761-- from the embedded function. 762embed_ :: MonadBaseControl b m => (a -> m ()) -> m (a -> b ()) 763embed_ f = liftBaseWith $ \runInBase -> return (void . runInBase . f) 764{-# INLINABLE embed_ #-} 765 766-- | Capture the current state of a transformer 767captureT :: (MonadTransControl t, Monad (t m), Monad m) => t m (StT t ()) 768captureT = liftWith $ \runInM -> runInM (return ()) 769{-# INLINABLE captureT #-} 770 771-- | Capture the current state above the base monad 772captureM :: MonadBaseControl b m => m (StM m ()) 773captureM = liftBaseWith $ \runInBase -> runInBase (return ()) 774{-# INLINABLE captureM #-} 775 776-- | @liftBaseOp@ is a particular application of 'liftBaseWith' that allows 777-- lifting control operations of type: 778-- 779-- @((a -> b c) -> b c)@ 780-- 781-- to: 782-- 783-- @('MonadBaseControl' b m => (a -> m c) -> m c)@ 784-- 785-- For example: 786-- 787-- @liftBaseOp alloca :: (Storable a, 'MonadBaseControl' 'IO' m) => (Ptr a -> m c) -> m c@ 788liftBaseOp :: MonadBaseControl b m 789 => ((a -> b (StM m c)) -> b (StM m d)) 790 -> ((a -> m c) -> m d) 791liftBaseOp f = \g -> control $ \runInBase -> f $ runInBase . g 792{-# INLINABLE liftBaseOp #-} 793 794-- | @liftBaseOp_@ is a particular application of 'liftBaseWith' that allows 795-- lifting control operations of type: 796-- 797-- @(b a -> b a)@ 798-- 799-- to: 800-- 801-- @('MonadBaseControl' b m => m a -> m a)@ 802-- 803-- For example: 804-- 805-- @liftBaseOp_ mask_ :: 'MonadBaseControl' 'IO' m => m a -> m a@ 806liftBaseOp_ :: MonadBaseControl b m 807 => (b (StM m a) -> b (StM m c)) 808 -> ( m a -> m c) 809liftBaseOp_ f = \m -> control $ \runInBase -> f $ runInBase m 810{-# INLINABLE liftBaseOp_ #-} 811 812-- | @liftBaseDiscard@ is a particular application of 'liftBaseWith' that allows 813-- lifting control operations of type: 814-- 815-- @(b () -> b a)@ 816-- 817-- to: 818-- 819-- @('MonadBaseControl' b m => m () -> m a)@ 820-- 821-- Note that, while the argument computation @m ()@ has access to the captured 822-- state, all its side-effects in @m@ are discarded. It is run only for its 823-- side-effects in the base monad @b@. 824-- 825-- For example: 826-- 827-- @liftBaseDiscard forkIO :: 'MonadBaseControl' 'IO' m => m () -> m ThreadId@ 828liftBaseDiscard :: MonadBaseControl b m => (b () -> b a) -> (m () -> m a) 829liftBaseDiscard f = \m -> liftBaseWith $ \runInBase -> f $ void $ runInBase m 830{-# INLINABLE liftBaseDiscard #-} 831 832-- | @liftBaseOpDiscard@ is a particular application of 'liftBaseWith' that allows 833-- lifting control operations of type: 834-- 835-- @((a -> b ()) -> b c)@ 836-- 837-- to: 838-- 839-- @('MonadBaseControl' b m => (a -> m ()) -> m c)@ 840-- 841-- Note that, while the argument computation @m ()@ has access to the captured 842-- state, all its side-effects in @m@ are discarded. It is run only for its 843-- side-effects in the base monad @b@. 844-- 845-- For example: 846-- 847-- @liftBaseDiscard (runServer addr port) :: 'MonadBaseControl' 'IO' m => m () -> m ()@ 848liftBaseOpDiscard :: MonadBaseControl b m 849 => ((a -> b ()) -> b c) 850 -> (a -> m ()) -> m c 851liftBaseOpDiscard f g = liftBaseWith $ \runInBase -> f $ void . runInBase . g 852{-# INLINABLE liftBaseOpDiscard #-} 853 854-- | Transform an action in @t m@ using a transformer that operates on the underlying monad @m@ 855liftThrough 856 :: (MonadTransControl t, Monad (t m), Monad m) 857 => (m (StT t a) -> m (StT t b)) -- ^ 858 -> t m a -> t m b 859liftThrough f t = do 860 st <- liftWith $ \run -> do 861 f $ run t 862 restoreT $ return st 863