├── .github └── workflows │ └── haskell.yml ├── CHANGELOG.md ├── LICENSE ├── Setup.hs ├── mmorph.cabal ├── release.nix ├── shell.nix ├── src └── Control │ └── Monad │ ├── Morph.hs │ └── Trans │ └── Compose.hs └── stack.yaml /.github/workflows/haskell.yml: -------------------------------------------------------------------------------- 1 | name: Haskell CI 2 | 3 | on: 4 | push: 5 | branches: [ master ] 6 | pull_request: 7 | branches: [ master ] 8 | 9 | jobs: 10 | build: 11 | 12 | runs-on: ubuntu-latest 13 | 14 | steps: 15 | - uses: actions/checkout@v2 16 | - uses: haskell/actions/setup@v1.2 17 | - name: Cache 18 | uses: actions/cache@v1 19 | env: 20 | cache-name: cache-cabal 21 | with: 22 | path: ~/.cabal 23 | key: ${{ runner.os }}-build-${{ env.cache-name }}-${{ hashFiles('**/*.cabal') }}-${{ hashFiles('**/cabal.project') }} 24 | restore-keys: | 25 | ${{ runner.os }}-build-${{ env.cache-name }}- 26 | ${{ runner.os }}-build- 27 | ${{ runner.os }}- 28 | 29 | - name: Install dependencies 30 | run: | 31 | cabal update 32 | cabal build --only-dependencies --enable-tests --enable-benchmarks 33 | - name: Build 34 | run: cabal build --enable-tests --enable-benchmarks all 35 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | 1.2.1 2 | 3 | - `MFunctor` and `MMonad` instances for `AccumT` 4 | 5 | 1.2.0 6 | 7 | * BREAKING CHANGE: Remove instances for `ErrorT` and `ListT` 8 | * These types are deprecated 9 | 10 | 1.1.5 11 | 12 | * Fix build failures on GHC 8.4 and 8.6 13 | * Add support for safe Haskell 14 | * Specifically, this marks the `Control.Monad.Trans.Compose` module as 15 | `Trustworthy` 16 | * The change in 1.1.4 to use `GeneralizedNewtypeDeriving` meant that the 17 | `Control.Monad.Trans.Compose` module was no longer inferred as safe 18 | * Restore `Traversable` instance removed by mistake in 1.1.4 19 | 20 | 1.1.4 (Blacklisted) 21 | 22 | * Unintentional removal of `Traversable` instance for `ComposeT` 23 | * This missing instance is restored in 1.1.5 24 | * This is the reason why the 1.1.4 release is blacklisted 25 | * Fix `MonadFail`-related code to work for GHCJS 26 | * The `MonadRWS` instance for `ComposeT` has a more flexible constraint 27 | * The constraint is now 28 | `MonadReader r (f (g m)), MonadWriter w (f (g m)), MonadState s (f (g m))` 29 | instead of `MonadRWS r w s (f g m)` 30 | * This loosening of the constraint is backwards-compatible 31 | 32 | 1.1.3 33 | 34 | * Add an `MFunctor` instance for `ComposeT` for GHC >= 8.6 35 | * Add GHC 8.8 support 36 | 37 | 1.1.2 38 | 39 | * Conditionally disable `Polykinds` to support older versions of GHC 40 | 41 | 1.1.1 42 | 43 | * Increase upper bound on `transformers-compat` 44 | 45 | 1.1.0 46 | 47 | * BREAKING CHANGE: Enable `PolyKinds` 48 | * This should in theory be a non-breaking change, but due to a bug in 49 | GHC 8.0.1 and kind inference ambiguities I'm marking this as a breaking 50 | change 51 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2013, Gabriella Gonzalez 2 | All rights reserved. 3 | 4 | Redistribution and use in source and binary forms, with or without modification, 5 | are permitted provided that the following conditions are met: 6 | 7 | * Redistributions of source code must retain the above copyright notice, this 8 | list of conditions and the following disclaimer. 9 | * Redistributions in binary form must reproduce the above copyright notice, this 10 | list of conditions and the following disclaimer in the documentation and/or 11 | other materials provided with the distribution. 12 | * Neither the name of Gabriella Gonzalez nor the names of other contributors may 13 | be used to endorse or promote products derived from this software without 14 | specific prior written permission. 15 | 16 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 17 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 18 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 19 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR 20 | ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES 21 | (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 22 | LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON 23 | ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 24 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 25 | SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 26 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /mmorph.cabal: -------------------------------------------------------------------------------- 1 | Name: mmorph 2 | Version: 1.2.1 3 | Cabal-Version: >= 1.10 4 | Build-Type: Simple 5 | License: BSD3 6 | License-File: LICENSE 7 | Copyright: 2013 Gabriella Gonzalez 8 | Author: Gabriella Gonzalez 9 | Maintainer: GenuineGabriella@gmail.com 10 | Bug-Reports: https://github.com/Gabriella439/Haskell-MMorph-Library/issues 11 | Synopsis: Monad morphisms 12 | Description: This library provides monad morphism utilities, most commonly used 13 | for manipulating monad transformer stacks. 14 | Category: Control 15 | Extra-Source-Files: CHANGELOG.md 16 | Source-Repository head 17 | Type: git 18 | Location: https://github.com/Gabriella439/Haskell-MMorph-Library 19 | 20 | Library 21 | Hs-Source-Dirs: src 22 | Build-Depends: 23 | base >= 4.5 && < 5 , 24 | mtl >= 2.1 && < 2.4, 25 | transformers >= 0.2.0.0 && < 0.7, 26 | transformers-compat >= 0.3 && < 0.8 27 | if impl(ghc < 8.0) 28 | Build-Depends: 29 | fail == 4.9.* 30 | Exposed-Modules: Control.Monad.Morph, Control.Monad.Trans.Compose 31 | GHC-Options: -O2 32 | Default-Language: Haskell2010 33 | -------------------------------------------------------------------------------- /release.nix: -------------------------------------------------------------------------------- 1 | # You can build this repository using Nix by running: 2 | # 3 | # $ nix-build -A mmorph release.nix 4 | # 5 | # You can also open up this repository inside of a Nix shell by running: 6 | # 7 | # $ nix-shell -A mmorph.env release.nix 8 | # 9 | # ... and then Nix will supply the correct Haskell development environment for 10 | # you 11 | let 12 | config = { }; 13 | 14 | overlay = pkgsNew: pkgsOld: { 15 | haskellPackages = pkgsOld.haskellPackages.override (old: { 16 | overrides = 17 | pkgsNew.lib.composeExtensions 18 | (old.overrides or (_: _: {})) 19 | (pkgsNew.haskell.lib.packageSourceOverrides { 20 | mmorph = ./.; 21 | }); 22 | }); 23 | }; 24 | 25 | pkgs = import { inherit config; overlays = [ overlay ]; }; 26 | 27 | in 28 | { mmorph = pkgs.haskellPackages.mmorph; 29 | } 30 | -------------------------------------------------------------------------------- /shell.nix: -------------------------------------------------------------------------------- 1 | (import ./release.nix).mmorph.env 2 | -------------------------------------------------------------------------------- /src/Control/Monad/Morph.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE RankNTypes #-} 3 | {-# LANGUAGE Safe #-} 4 | #if __GLASGOW_HASKELL__ >= 706 5 | {-# LANGUAGE PolyKinds #-} 6 | #endif 7 | 8 | {-| A monad morphism is a natural transformation: 9 | 10 | > morph :: forall a . m a -> n a 11 | 12 | ... that obeys the following two laws: 13 | 14 | > morph $ do x <- m = do x <- morph m 15 | > f x morph (f x) 16 | > 17 | > morph (return x) = return x 18 | 19 | ... which are equivalent to the following two functor laws: 20 | 21 | > morph . (f >=> g) = morph . f >=> morph . g 22 | > 23 | > morph . return = return 24 | 25 | Examples of monad morphisms include: 26 | 27 | * 'lift' (from 'MonadTrans') 28 | 29 | * 'squash' (See below) 30 | 31 | * @'hoist' f@ (See below), if @f@ is a monad morphism 32 | 33 | * @(f . g)@, if @f@ and @g@ are both monad morphisms 34 | 35 | * 'id' 36 | 37 | Monad morphisms commonly arise when manipulating existing monad transformer 38 | code for compatibility purposes. The 'MFunctor', 'MonadTrans', and 39 | 'MMonad' classes define standard ways to change monad transformer stacks: 40 | 41 | * 'lift' introduces a new monad transformer layer of any type. 42 | 43 | * 'squash' flattens two identical monad transformer layers into a single 44 | layer of the same type. 45 | 46 | * 'hoist' maps monad morphisms to modify deeper layers of the monad 47 | transformer stack. 48 | 49 | -} 50 | 51 | module Control.Monad.Morph ( 52 | -- * Functors over Monads 53 | MFunctor(..), 54 | generalize, 55 | -- * Monads over Monads 56 | MMonad(..), 57 | MonadTrans(lift), 58 | squash, 59 | (>|>), 60 | (<|<), 61 | (=<|), 62 | (|>=) 63 | 64 | -- * Tutorial 65 | -- $tutorial 66 | 67 | -- ** Generalizing base monads 68 | -- $generalize 69 | 70 | -- ** Monad morphisms 71 | -- $mmorph 72 | 73 | -- ** Mixing diverse transformers 74 | -- $interleave 75 | 76 | -- ** Embedding transformers 77 | -- $embed 78 | ) where 79 | 80 | import Control.Monad.Trans.Class (MonadTrans(lift)) 81 | import qualified Control.Monad.Trans.Accum as A 82 | import qualified Control.Monad.Trans.Except as Ex 83 | import qualified Control.Monad.Trans.Identity as I 84 | import qualified Control.Monad.Trans.Maybe as M 85 | import qualified Control.Monad.Trans.Reader as R 86 | import qualified Control.Monad.Trans.RWS.Lazy as RWS 87 | import qualified Control.Monad.Trans.RWS.Strict as RWS' 88 | import qualified Control.Monad.Trans.State.Lazy as S 89 | import qualified Control.Monad.Trans.State.Strict as S' 90 | import qualified Control.Monad.Trans.Writer.Lazy as W' 91 | import qualified Control.Monad.Trans.Writer.Strict as W 92 | import Data.Monoid (Monoid, mappend) 93 | import Data.Functor.Compose (Compose (Compose)) 94 | import Data.Functor.Identity (runIdentity) 95 | import Data.Functor.Product (Product (Pair)) 96 | import Control.Applicative.Backwards (Backwards (Backwards)) 97 | import Control.Applicative.Lift (Lift (Pure, Other)) 98 | 99 | -- For documentation 100 | import Control.Exception (try, IOException) 101 | import Control.Monad ((=<<), (>=>), (<=<), join) 102 | import Data.Functor.Identity (Identity) 103 | 104 | {-| A functor in the category of monads, using 'hoist' as the analog of 'fmap': 105 | 106 | > hoist (f . g) = hoist f . hoist g 107 | > 108 | > hoist id = id 109 | -} 110 | class MFunctor t where 111 | {-| Lift a monad morphism from @m@ to @n@ into a monad morphism from 112 | @(t m)@ to @(t n)@ 113 | 114 | The first argument to `hoist` must be a monad morphism, even though the 115 | type system does not enforce this 116 | -} 117 | hoist :: (Monad m) => (forall a . m a -> n a) -> t m b -> t n b 118 | 119 | instance MFunctor (A.AccumT w) where 120 | hoist nat m = A.AccumT (nat . A.runAccumT m) 121 | 122 | instance MFunctor (Ex.ExceptT e) where 123 | hoist nat m = Ex.ExceptT (nat (Ex.runExceptT m)) 124 | 125 | instance MFunctor I.IdentityT where 126 | hoist nat m = I.IdentityT (nat (I.runIdentityT m)) 127 | 128 | instance MFunctor M.MaybeT where 129 | hoist nat m = M.MaybeT (nat (M.runMaybeT m)) 130 | 131 | instance MFunctor (R.ReaderT r) where 132 | hoist nat m = R.ReaderT (\i -> nat (R.runReaderT m i)) 133 | 134 | instance MFunctor (RWS.RWST r w s) where 135 | hoist nat m = RWS.RWST (\r s -> nat (RWS.runRWST m r s)) 136 | 137 | instance MFunctor (RWS'.RWST r w s) where 138 | hoist nat m = RWS'.RWST (\r s -> nat (RWS'.runRWST m r s)) 139 | 140 | instance MFunctor (S.StateT s) where 141 | hoist nat m = S.StateT (\s -> nat (S.runStateT m s)) 142 | 143 | instance MFunctor (S'.StateT s) where 144 | hoist nat m = S'.StateT (\s -> nat (S'.runStateT m s)) 145 | 146 | instance MFunctor (W.WriterT w) where 147 | hoist nat m = W.WriterT (nat (W.runWriterT m)) 148 | 149 | instance MFunctor (W'.WriterT w) where 150 | hoist nat m = W'.WriterT (nat (W'.runWriterT m)) 151 | 152 | instance Functor f => MFunctor (Compose f) where 153 | hoist nat (Compose f) = Compose (fmap nat f) 154 | 155 | instance MFunctor (Product f) where 156 | hoist nat (Pair f g) = Pair f (nat g) 157 | 158 | instance MFunctor Backwards where 159 | hoist nat (Backwards f) = Backwards (nat f) 160 | 161 | instance MFunctor Lift where 162 | hoist _ (Pure a) = Pure a 163 | hoist nat (Other f) = Other (nat f) 164 | 165 | -- | A function that @generalize@s the 'Identity' base monad to be any monad. 166 | generalize :: Monad m => Identity a -> m a 167 | generalize = return . runIdentity 168 | {-# INLINABLE generalize #-} 169 | 170 | {-| A monad in the category of monads, using 'lift' from 'MonadTrans' as the 171 | analog of 'return' and 'embed' as the analog of ('=<<'): 172 | 173 | > embed lift = id 174 | > 175 | > embed f (lift m) = f m 176 | > 177 | > embed g (embed f t) = embed (\m -> embed g (f m)) t 178 | -} 179 | class (MFunctor t, MonadTrans t) => MMonad t where 180 | {-| Embed a newly created 'MMonad' layer within an existing layer 181 | 182 | 'embed' is analogous to ('=<<') 183 | -} 184 | embed :: (Monad n) => (forall a . m a -> t n a) -> t m b -> t n b 185 | 186 | {-| Squash two 'MMonad' layers into a single layer 187 | 188 | 'squash' is analogous to 'join' 189 | -} 190 | squash :: (Monad m, MMonad t) => t (t m) a -> t m a 191 | squash = embed id 192 | {-# INLINABLE squash #-} 193 | 194 | infixr 2 >|>, =<| 195 | infixl 2 <|<, |>= 196 | 197 | {-| Compose two 'MMonad' layer-building functions 198 | 199 | ('>|>') is analogous to ('>=>') 200 | -} 201 | (>|>) 202 | :: (Monad m3, MMonad t) 203 | => (forall a . m1 a -> t m2 a) 204 | -> (forall b . m2 b -> t m3 b) 205 | -> m1 c -> t m3 c 206 | (f >|> g) m = embed g (f m) 207 | {-# INLINABLE (>|>) #-} 208 | 209 | {-| Equivalent to ('>|>') with the arguments flipped 210 | 211 | ('<|<') is analogous to ('<=<') 212 | -} 213 | (<|<) 214 | :: (Monad m3, MMonad t) 215 | => (forall b . m2 b -> t m3 b) 216 | -> (forall a . m1 a -> t m2 a) 217 | -> m1 c -> t m3 c 218 | (g <|< f) m = embed g (f m) 219 | {-# INLINABLE (<|<) #-} 220 | 221 | {-| An infix operator equivalent to 'embed' 222 | 223 | ('=<|') is analogous to ('=<<') 224 | -} 225 | (=<|) :: (Monad n, MMonad t) => (forall a . m a -> t n a) -> t m b -> t n b 226 | (=<|) = embed 227 | {-# INLINABLE (=<|) #-} 228 | 229 | {-| Equivalent to ('=<|') with the arguments flipped 230 | 231 | ('|>=') is analogous to ('>>=') 232 | -} 233 | (|>=) :: (Monad n, MMonad t) => t m b -> (forall a . m a -> t n a) -> t n b 234 | t |>= f = embed f t 235 | {-# INLINABLE (|>=) #-} 236 | 237 | instance Monoid w => MMonad (A.AccumT w) where 238 | embed f m = A.AccumT $ \w -> do 239 | ((b, wInner), wOuter) <- A.runAccumT (f $ A.runAccumT m w) w 240 | return (b, wInner `mappend` wOuter) 241 | 242 | instance MMonad (Ex.ExceptT e) where 243 | embed f m = Ex.ExceptT (do 244 | x <- Ex.runExceptT (f (Ex.runExceptT m)) 245 | return (case x of 246 | Left e -> Left e 247 | Right (Left e) -> Left e 248 | Right (Right a) -> Right a ) ) 249 | 250 | instance MMonad I.IdentityT where 251 | embed f m = f (I.runIdentityT m) 252 | 253 | instance MMonad M.MaybeT where 254 | embed f m = M.MaybeT (do 255 | x <- M.runMaybeT (f (M.runMaybeT m)) 256 | return (case x of 257 | Nothing -> Nothing 258 | Just Nothing -> Nothing 259 | Just (Just a) -> Just a ) ) 260 | 261 | instance MMonad (R.ReaderT r) where 262 | embed f m = R.ReaderT (\i -> R.runReaderT (f (R.runReaderT m i)) i) 263 | 264 | instance (Monoid w) => MMonad (W.WriterT w) where 265 | embed f m = W.WriterT (do 266 | ~((a, w1), w2) <- W.runWriterT (f (W.runWriterT m)) 267 | return (a, mappend w1 w2) ) 268 | 269 | instance (Monoid w) => MMonad (W'.WriterT w) where 270 | embed f m = W'.WriterT (do 271 | ((a, w1), w2) <- W'.runWriterT (f (W'.runWriterT m)) 272 | return (a, mappend w1 w2) ) 273 | 274 | {- $tutorial 275 | Monad morphisms solve the common problem of fixing monadic code after the 276 | fact without modifying the original source code or type signatures. The 277 | following sections illustrate various examples of transparently modifying 278 | existing functions. 279 | -} 280 | 281 | {- $generalize 282 | Imagine that some library provided the following 'S.State' code: 283 | 284 | > import Control.Monad.Trans.State 285 | > 286 | > tick :: State Int () 287 | > tick = modify (+1) 288 | 289 | ... but we would prefer to reuse @tick@ within a larger 290 | @('S.StateT' Int 'IO')@ block in order to mix in 'IO' actions. 291 | 292 | We could patch the original library to generalize @tick@'s type signature: 293 | 294 | > tick :: (Monad m) => StateT Int m () 295 | 296 | ... but we would prefer not to fork upstream code if possible. How could 297 | we generalize @tick@'s type without modifying the original code? 298 | 299 | We can solve this if we realize that 'S.State' is a type synonym for 300 | 'S.StateT' with an 'Identity' base monad: 301 | 302 | > type State s = StateT s Identity 303 | 304 | ... which means that @tick@'s true type is actually: 305 | 306 | > tick :: StateT Int Identity () 307 | 308 | Now all we need is a function that @generalize@s the 'Identity' base monad 309 | to be any monad: 310 | 311 | > import Data.Functor.Identity 312 | > 313 | > generalize :: (Monad m) => Identity a -> m a 314 | > generalize m = return (runIdentity m) 315 | 316 | ... which we can 'hoist' to change @tick@'s base monad: 317 | 318 | > hoist :: (Monad m, MFunctor t) => (forall a . m a -> n a) -> t m b -> t n b 319 | > 320 | > hoist generalize :: (Monad m, MFunctor t) => t Identity b -> t m b 321 | > 322 | > hoist generalize tick :: (Monad m) => StateT Int m () 323 | 324 | This lets us mix @tick@ alongside 'IO' using 'lift': 325 | 326 | > import Control.Monad.Morph 327 | > import Control.Monad.Trans.Class 328 | > 329 | > tock :: StateT Int IO () 330 | > tock = do 331 | > hoist generalize tick :: (Monad m) => StateT Int m () 332 | > lift $ putStrLn "Tock!" :: (MonadTrans t) => t IO () 333 | 334 | >>> runStateT tock 0 335 | Tock! 336 | ((), 1) 337 | 338 | -} 339 | 340 | {- $mmorph 341 | Notice that @generalize@ is a monad morphism, and the following two proofs 342 | show how @generalize@ satisfies the monad morphism laws. You can refer to 343 | these proofs as an example for how to prove a function obeys the monad 344 | morphism laws: 345 | 346 | > generalize (return x) 347 | > 348 | > -- Definition of 'return' for the Identity monad 349 | > = generalize (Identity x) 350 | > 351 | > -- Definition of 'generalize' 352 | > = return (runIdentity (Identity x)) 353 | > 354 | > -- runIdentity (Identity x) = x 355 | > = return x 356 | 357 | > generalize $ do x <- m 358 | > f x 359 | > 360 | > -- Definition of (>>=) for the Identity monad 361 | > = generalize (f (runIdentity m)) 362 | > 363 | > -- Definition of 'generalize' 364 | > = return (runIdentity (f (runIdentity m))) 365 | > 366 | > -- Monad law: Left identity 367 | > = do x <- return (runIdentity m) 368 | > return (runIdentity (f x)) 369 | > 370 | > -- Definition of 'generalize' in reverse 371 | > = do x <- generalize m 372 | > generalize (f x) 373 | -} 374 | 375 | {- $interleave 376 | You can combine 'hoist' and 'lift' to insert arbitrary layers anywhere 377 | within a monad transformer stack. This comes in handy when interleaving two 378 | diverse stacks. 379 | 380 | For example, we might want to combine the following @save@ function: 381 | 382 | > import Control.Monad.Trans.Writer 383 | > 384 | > -- i.e. :: StateT Int (WriterT [Int] Identity) () 385 | > save :: StateT Int (Writer [Int]) () 386 | > save = do 387 | > n <- get 388 | > lift $ tell [n] 389 | 390 | ... with our previous @tock@ function: 391 | 392 | > tock :: StateT Int IO () 393 | 394 | However, @save@ and @tock@ differ in two ways: 395 | 396 | * @tock@ lacks a 'W.WriterT' layer 397 | 398 | * @save@ has an 'Identity' base monad 399 | 400 | We can mix the two by inserting a 'W.WriterT' layer for @tock@ and 401 | generalizing @save@'s base monad: 402 | 403 | > import Control.Monad 404 | > 405 | > program :: StateT Int (WriterT [Int] IO) () 406 | > program = replicateM_ 4 $ do 407 | > hoist lift tock 408 | > :: (MonadTrans t) => StateT Int (t IO) () 409 | > hoist (hoist generalize) save 410 | > :: (Monad m) => StateT Int (WriterT [Int] m ) () 411 | 412 | >>> execWriterT (runStateT program 0) 413 | Tock! 414 | Tock! 415 | Tock! 416 | Tock! 417 | [1,2,3,4] 418 | 419 | -} 420 | 421 | {- $embed 422 | Suppose we decided to @check@ all 'IOException's using a combination of 423 | 'try' and 'ErrorT': 424 | 425 | > import Control.Exception 426 | > import Control.Monad.Trans.Class 427 | > import Control.Monad.Trans.Error 428 | > 429 | > check :: IO a -> ErrorT IOException IO a 430 | > check io = ErrorT (try io) 431 | 432 | ... but then we forget to use @check@ in one spot, mistakenly using 'lift' 433 | instead: 434 | 435 | > program :: ErrorT IOException IO () 436 | > program = do 437 | > str <- lift $ readFile "test.txt" 438 | > check $ putStr str 439 | 440 | >>> runErrorT program 441 | *** Exception: test.txt: openFile: does not exist (No such file or directory) 442 | 443 | How could we go back and fix 'program' without modifying its source code? 444 | 445 | Well, @check@ is a monad morphism, but we can't 'hoist' it to modify the 446 | base monad because then we get two 'E.ErrorT' layers instead of one: 447 | 448 | > hoist check :: (MFunctor t) => t IO a -> t (ErrorT IOException IO) a 449 | > 450 | > hoist check program :: ErrorT IOException (ErrorT IOException IO) () 451 | 452 | We'd prefer to 'embed' all newly generated exceptions in the existing 453 | 'E.ErrorT' layer: 454 | 455 | > embed check :: ErrorT IOException IO a -> ErrorT IOException IO a 456 | > 457 | > embed check program :: ErrorT IOException IO () 458 | 459 | This correctly checks the exceptions that slipped through the cracks: 460 | 461 | >>> import Control.Monad.Morph 462 | >>> runErrorT (embed check program) 463 | Left test.txt: openFile: does not exist (No such file or directory) 464 | 465 | -} 466 | -------------------------------------------------------------------------------- /src/Control/Monad/Trans/Compose.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleContexts #-} 2 | {-# LANGUAGE FlexibleInstances #-} 3 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 4 | {-# LANGUAGE KindSignatures #-} 5 | {-# LANGUAGE MultiParamTypeClasses #-} 6 | {-# LANGUAGE UndecidableInstances #-} 7 | {-# LANGUAGE DeriveTraversable #-} 8 | {-# LANGUAGE CPP #-} 9 | {-# LANGUAGE Trustworthy #-} 10 | 11 | #if __GLASGOW_HASKELL__ >= 806 12 | {-# LANGUAGE QuantifiedConstraints #-} 13 | #endif 14 | 15 | {-| Composition of monad transformers. A higher-order version of 16 | "Data.Functor.Compose". 17 | -} 18 | 19 | module Control.Monad.Trans.Compose ( 20 | -- * ComposeT 21 | ComposeT(ComposeT, getComposeT), 22 | mapComposeT 23 | ) where 24 | 25 | import Control.Applicative ( 26 | Applicative(pure, (<*>), (*>), (<*)), Alternative(empty, (<|>)) ) 27 | import Control.Monad (MonadPlus(mzero, mplus), liftM) 28 | import Control.Monad.Cont.Class (MonadCont(callCC)) 29 | import Control.Monad.Error.Class (MonadError(throwError, catchError)) 30 | import Control.Monad.Fail (MonadFail(..)) 31 | import Control.Monad.Morph (MFunctor(hoist)) 32 | import Control.Monad.RWS.Class (MonadRWS) 33 | import Control.Monad.Reader.Class (MonadReader(ask, local, reader)) 34 | import Control.Monad.State.Class (MonadState(get, put, state)) 35 | import Control.Monad.Trans.Class (MonadTrans(lift)) 36 | import Control.Monad.Writer.Class (MonadWriter(writer, tell, listen, pass)) 37 | import Control.Monad.IO.Class (MonadIO(liftIO)) 38 | import Data.Foldable (Foldable(fold, foldMap, foldr, foldl, foldr1, foldl1)) 39 | import Data.Traversable (Traversable(traverse, sequenceA, mapM, sequence)) 40 | import Prelude hiding (foldr, foldl, foldr1, foldl1, mapM, sequence) 41 | 42 | infixr 9 `ComposeT` 43 | 44 | -- | Composition of monad transformers. 45 | newtype ComposeT (f :: (* -> *) -> * -> *) (g :: (* -> *) -> * -> *) m a 46 | = ComposeT { getComposeT :: f (g m) a } 47 | deriving 48 | ( Alternative 49 | , Applicative 50 | , Eq 51 | , Foldable 52 | , Functor 53 | , Ord 54 | , Read 55 | , Show 56 | , Traversable 57 | , Monad 58 | , MonadCont 59 | , MonadError e 60 | , MonadFail 61 | , MonadIO 62 | , MonadPlus 63 | , MonadReader r 64 | , MonadRWS r w s 65 | , MonadState s 66 | , MonadWriter w 67 | ) 68 | 69 | instance (MFunctor f, MonadTrans f, MonadTrans g) => MonadTrans (ComposeT f g) 70 | where 71 | lift = ComposeT . hoist lift . lift 72 | 73 | #if __GLASGOW_HASKELL__ >= 806 74 | instance (MFunctor f, MFunctor g, forall m. Monad m => Monad (g m)) 75 | => MFunctor (ComposeT f g) where 76 | hoist f (ComposeT m) = ComposeT (hoist (hoist f) m) 77 | #endif 78 | 79 | -- | Transform the computation inside a 'ComposeT'. 80 | mapComposeT :: (f (g m) a -> p (q n) b) -> ComposeT f g m a -> ComposeT p q n b 81 | mapComposeT f = ComposeT . f . getComposeT 82 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | resolver: lts-7.9 2 | --------------------------------------------------------------------------------