├── .github └── workflows │ └── haskell-ci.yml ├── .gitignore ├── CHANGELOG ├── CONTRIBUTORS ├── LICENSE ├── README.markdown ├── cabal.haskell-ci ├── cabal.project ├── default.nix ├── monad-control.cabal ├── monad-control.nix ├── shell.nix ├── src └── Control │ └── Monad │ └── Trans │ └── Control.hs └── stack.yaml /.github/workflows/haskell-ci.yml: -------------------------------------------------------------------------------- 1 | # This GitHub workflow config has been generated by a script via 2 | # 3 | # haskell-ci 'github' 'cabal.project' 4 | # 5 | # To regenerate the script (for example after adjusting tested-with) run 6 | # 7 | # haskell-ci regenerate 8 | # 9 | # For more information, see https://github.com/haskell-CI/haskell-ci 10 | # 11 | # version: 0.15.20220826 12 | # 13 | # REGENDATA ("0.15.20220826",["github","cabal.project"]) 14 | # 15 | name: Haskell-CI 16 | on: 17 | push: 18 | branches: 19 | - master 20 | pull_request: 21 | branches: 22 | - master 23 | jobs: 24 | linux: 25 | name: Haskell-CI - Linux - ${{ matrix.compiler }} 26 | runs-on: ubuntu-20.04 27 | timeout-minutes: 28 | 60 29 | container: 30 | image: buildpack-deps:bionic 31 | continue-on-error: ${{ matrix.allow-failure }} 32 | strategy: 33 | matrix: 34 | include: 35 | - compiler: ghc-9.4.2 36 | compilerKind: ghc 37 | compilerVersion: 9.4.2 38 | setup-method: ghcup 39 | allow-failure: false 40 | - compiler: ghc-9.2.4 41 | compilerKind: ghc 42 | compilerVersion: 9.2.4 43 | setup-method: ghcup 44 | allow-failure: false 45 | - compiler: ghc-9.0.2 46 | compilerKind: ghc 47 | compilerVersion: 9.0.2 48 | setup-method: ghcup 49 | allow-failure: false 50 | - compiler: ghc-8.10.7 51 | compilerKind: ghc 52 | compilerVersion: 8.10.7 53 | setup-method: ghcup 54 | allow-failure: false 55 | - compiler: ghc-8.8.4 56 | compilerKind: ghc 57 | compilerVersion: 8.8.4 58 | setup-method: hvr-ppa 59 | allow-failure: false 60 | - compiler: ghc-8.6.5 61 | compilerKind: ghc 62 | compilerVersion: 8.6.5 63 | setup-method: hvr-ppa 64 | allow-failure: false 65 | - compiler: ghc-8.4.4 66 | compilerKind: ghc 67 | compilerVersion: 8.4.4 68 | setup-method: hvr-ppa 69 | allow-failure: false 70 | - compiler: ghc-8.2.2 71 | compilerKind: ghc 72 | compilerVersion: 8.2.2 73 | setup-method: hvr-ppa 74 | allow-failure: false 75 | - compiler: ghc-8.0.2 76 | compilerKind: ghc 77 | compilerVersion: 8.0.2 78 | setup-method: hvr-ppa 79 | allow-failure: false 80 | - compiler: ghc-7.10.3 81 | compilerKind: ghc 82 | compilerVersion: 7.10.3 83 | setup-method: hvr-ppa 84 | allow-failure: false 85 | - compiler: ghc-7.8.4 86 | compilerKind: ghc 87 | compilerVersion: 7.8.4 88 | setup-method: hvr-ppa 89 | allow-failure: false 90 | - compiler: ghc-7.6.3 91 | compilerKind: ghc 92 | compilerVersion: 7.6.3 93 | setup-method: hvr-ppa 94 | allow-failure: false 95 | - compiler: ghc-7.4.2 96 | compilerKind: ghc 97 | compilerVersion: 7.4.2 98 | setup-method: hvr-ppa 99 | allow-failure: false 100 | fail-fast: false 101 | steps: 102 | - name: apt 103 | run: | 104 | apt-get update 105 | apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5 106 | if [ "${{ matrix.setup-method }}" = ghcup ]; then 107 | mkdir -p "$HOME/.ghcup/bin" 108 | curl -sL https://downloads.haskell.org/ghcup/0.1.18.0/x86_64-linux-ghcup-0.1.18.0 > "$HOME/.ghcup/bin/ghcup" 109 | chmod a+x "$HOME/.ghcup/bin/ghcup" 110 | "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false) 111 | "$HOME/.ghcup/bin/ghcup" install cabal 3.6.2.0 || (cat "$HOME"/.ghcup/logs/*.* && false) 112 | else 113 | apt-add-repository -y 'ppa:hvr/ghc' 114 | apt-get update 115 | apt-get install -y "$HCNAME" 116 | mkdir -p "$HOME/.ghcup/bin" 117 | curl -sL https://downloads.haskell.org/ghcup/0.1.18.0/x86_64-linux-ghcup-0.1.18.0 > "$HOME/.ghcup/bin/ghcup" 118 | chmod a+x "$HOME/.ghcup/bin/ghcup" 119 | "$HOME/.ghcup/bin/ghcup" install cabal 3.6.2.0 || (cat "$HOME"/.ghcup/logs/*.* && false) 120 | fi 121 | env: 122 | HCKIND: ${{ matrix.compilerKind }} 123 | HCNAME: ${{ matrix.compiler }} 124 | HCVER: ${{ matrix.compilerVersion }} 125 | - name: Set PATH and environment variables 126 | run: | 127 | echo "$HOME/.cabal/bin" >> $GITHUB_PATH 128 | echo "LANG=C.UTF-8" >> "$GITHUB_ENV" 129 | echo "CABAL_DIR=$HOME/.cabal" >> "$GITHUB_ENV" 130 | echo "CABAL_CONFIG=$HOME/.cabal/config" >> "$GITHUB_ENV" 131 | HCDIR=/opt/$HCKIND/$HCVER 132 | if [ "${{ matrix.setup-method }}" = ghcup ]; then 133 | HC=$HOME/.ghcup/bin/$HCKIND-$HCVER 134 | echo "HC=$HC" >> "$GITHUB_ENV" 135 | echo "HCPKG=$HOME/.ghcup/bin/$HCKIND-pkg-$HCVER" >> "$GITHUB_ENV" 136 | echo "HADDOCK=$HOME/.ghcup/bin/haddock-$HCVER" >> "$GITHUB_ENV" 137 | echo "CABAL=$HOME/.ghcup/bin/cabal-3.6.2.0 -vnormal+nowrap" >> "$GITHUB_ENV" 138 | else 139 | HC=$HCDIR/bin/$HCKIND 140 | echo "HC=$HC" >> "$GITHUB_ENV" 141 | echo "HCPKG=$HCDIR/bin/$HCKIND-pkg" >> "$GITHUB_ENV" 142 | echo "HADDOCK=$HCDIR/bin/haddock" >> "$GITHUB_ENV" 143 | echo "CABAL=$HOME/.ghcup/bin/cabal-3.6.2.0 -vnormal+nowrap" >> "$GITHUB_ENV" 144 | fi 145 | 146 | HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\d+)\.(\d+)\.(\d+)(\.(\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))') 147 | echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV" 148 | echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV" 149 | echo "ARG_BENCH=--enable-benchmarks" >> "$GITHUB_ENV" 150 | echo "HEADHACKAGE=false" >> "$GITHUB_ENV" 151 | echo "ARG_COMPILER=--$HCKIND --with-compiler=$HC" >> "$GITHUB_ENV" 152 | echo "GHCJSARITH=0" >> "$GITHUB_ENV" 153 | env: 154 | HCKIND: ${{ matrix.compilerKind }} 155 | HCNAME: ${{ matrix.compiler }} 156 | HCVER: ${{ matrix.compilerVersion }} 157 | - name: env 158 | run: | 159 | env 160 | - name: write cabal config 161 | run: | 162 | mkdir -p $CABAL_DIR 163 | cat >> $CABAL_CONFIG <> $CABAL_CONFIG < cabal-plan.xz 196 | echo 'de73600b1836d3f55e32d80385acc055fd97f60eaa0ab68a755302685f5d81bc cabal-plan.xz' | sha256sum -c - 197 | xz -d < cabal-plan.xz > $HOME/.cabal/bin/cabal-plan 198 | rm -f cabal-plan.xz 199 | chmod a+x $HOME/.cabal/bin/cabal-plan 200 | cabal-plan --version 201 | - name: checkout 202 | uses: actions/checkout@v2 203 | with: 204 | path: source 205 | - name: initial cabal.project for sdist 206 | run: | 207 | touch cabal.project 208 | echo "packages: $GITHUB_WORKSPACE/source/." >> cabal.project 209 | cat cabal.project 210 | - name: sdist 211 | run: | 212 | mkdir -p sdist 213 | $CABAL sdist all --output-dir $GITHUB_WORKSPACE/sdist 214 | - name: unpack 215 | run: | 216 | mkdir -p unpacked 217 | find sdist -maxdepth 1 -type f -name '*.tar.gz' -exec tar -C $GITHUB_WORKSPACE/unpacked -xzvf {} \; 218 | - name: generate cabal.project 219 | run: | 220 | PKGDIR_monad_control="$(find "$GITHUB_WORKSPACE/unpacked" -maxdepth 1 -type d -regex '.*/monad-control-[0-9.]*')" 221 | echo "PKGDIR_monad_control=${PKGDIR_monad_control}" >> "$GITHUB_ENV" 222 | rm -f cabal.project cabal.project.local 223 | touch cabal.project 224 | touch cabal.project.local 225 | echo "packages: ${PKGDIR_monad_control}" >> cabal.project 226 | if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo "package monad-control" >> cabal.project ; fi 227 | if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo " ghc-options: -Werror=missing-methods" >> cabal.project ; fi 228 | cat >> cabal.project <> cabal.project.local 231 | cat cabal.project 232 | cat cabal.project.local 233 | - name: dump install plan 234 | run: | 235 | $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dry-run all 236 | cabal-plan 237 | - name: cache 238 | uses: actions/cache@v2 239 | with: 240 | key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }} 241 | path: ~/.cabal/store 242 | restore-keys: ${{ runner.os }}-${{ matrix.compiler }}- 243 | - name: install dependencies 244 | run: | 245 | $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --dependencies-only -j2 all 246 | $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dependencies-only -j2 all 247 | - name: build w/o tests 248 | run: | 249 | $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all 250 | - name: build 251 | run: | 252 | $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --write-ghc-environment-files=always 253 | - name: cabal check 254 | run: | 255 | cd ${PKGDIR_monad_control} || false 256 | ${CABAL} -vnormal check 257 | - name: haddock 258 | run: | 259 | $CABAL v2-haddock --haddock-all $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all 260 | - name: unconstrained build 261 | run: | 262 | rm -f cabal.project.local 263 | $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all 264 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .cabal-sandbox* 2 | cabal.sandbox.config* 3 | dist 4 | --list-options 5 | .stack-work 6 | -------------------------------------------------------------------------------- /CHANGELOG: -------------------------------------------------------------------------------- 1 | 1.0.4 2 | 3 | * Add instances for `AccumT` 4 | 5 | 1.0.3.1 6 | 7 | * Support transformers-0.6 8 | 9 | 1.0.3 10 | 11 | * Add `controlT` 12 | * Support transformers-compat-0.7 13 | 14 | 1.0.2.4 15 | 16 | 17 | 1.0.2.3 18 | 19 | * Correct spelling mistake. Courtesy of Edward Betts. 20 | 21 | * Support transformers-compat-0.6. 22 | 23 | 24 | 1.0.2.2 25 | 26 | * Added some good documentation. Courtesy of Franz Thoma. 27 | 28 | 29 | 1.0.2.1 30 | 31 | * Refer to Michael Snoyman's excellent tutorial on monad-control. 32 | 33 | 34 | 1.0.2.0 35 | 36 | * Improve documentation by including type equalities in the Haddock documentation. 37 | 38 | * Add helpers to define MonadTransControl for stack of two: 39 | RunDefault2, defaultLiftWith2, defaultRestoreT2 40 | 41 | 1.0.1.0 42 | 43 | * Added the functions: 44 | 45 | liftThrough 46 | :: (MonadTransControl t, Monad (t m), Monad m) 47 | => (m (StT t a) -> m (StT t b)) -- ^ 48 | -> t m a -> t m b 49 | 50 | captureT :: (MonadTransControl t, Monad (t m), Monad m) => t m (StT t ()) 51 | captureM :: MonadBaseControl b m => m (StM m ()) 52 | 53 | * Added Travis-CI integration 54 | 55 | 56 | 1.0.0.5 57 | 58 | * Support transformers-0.5 & ransformers-compat-0.5.*. 59 | 60 | 61 | 1.0.0.4 62 | 63 | * Support transformers-compat-0.4.*. 64 | 65 | 66 | 1.0.0.3 67 | 68 | * Unconditionally add ExceptT instances using transformers-compat. 69 | Courtesy of Adam Bergmark. 70 | 71 | 72 | 1.0.0.2 73 | 74 | * Add a base >= 4.5 constraint because monad-control only builds on GHC >= 7.4. 75 | 76 | 77 | 1.0.0.1 78 | 79 | * Use Safe instead of Trustworthy. 80 | 81 | This requires a dependency on stm. 82 | 83 | 84 | 1.0.0.0 85 | 86 | * Switch the associated data types StT and StM to associated type synonyms. 87 | 88 | This is an API breaking change. To fix your MonadTransControl or 89 | MonadBaseControl instances simply remove the StT or StM constructors 90 | and deconstructors for your monad transformers or monad. 91 | 92 | * Add the embed, embed_ and liftBaseOpDiscard functions. 93 | 94 | 95 | 0.3.3.1 96 | 97 | * Unconditionally add ExceptT instances using transformers-compat. 98 | Courtesy of Adam Bergmark. 99 | 100 | 101 | 0.3.3.0 102 | 103 | * Support transformers-0.4.0.0 104 | 105 | * Drop unicode syntax and symbols 106 | 107 | 108 | 0.3.2.3 109 | 110 | * Fix haddock documentation error 111 | 112 | 113 | 0.3.2.2 114 | 115 | * Fix preprocessor directive for GHC 7.6.3 116 | 117 | 118 | 0.3.2.1 119 | 120 | * Resolve #14. Bump upper version bound of base to 5 121 | 122 | 123 | 0.3.2 124 | 125 | * Added defaultLiftWith and defaultRestoreT to simplify defining 126 | MonadTransControl for newtypes. 127 | 128 | 129 | 0.3.1.4 130 | 131 | * Compatibility with ghc head 132 | 133 | 134 | 0.3.1.3 135 | 136 | * Added a Trustworthy flag 137 | 138 | 139 | 0.3.1.2 140 | 141 | * Fix issue #9. Replace all Unicode in type variables. 142 | 143 | 144 | 0.3.1.1 145 | 146 | * Add MonadBaseControl instances for ST and STM. 147 | 148 | 149 | 0.3 150 | 151 | (Released on: Fri Dec 2 09:52:16 UTC 2011) 152 | 153 | * Major new API which IMHO is easier to understand than the old one. 154 | 155 | * On average about 60 times faster than the previous release! 156 | 157 | * New package lifted-base providing lifted versions of functions from the base 158 | library. It exports the following modules: 159 | 160 | - Control.Exception.Lifted 161 | - Control.Concurrent.Lifted 162 | - Control.Concurrent.MVar.Lifted 163 | - System.Timeout.Lifted 164 | 165 | Not all modules from base are converted yet. If you need a lifted version of 166 | some function from base, just ask me to add it or send me a patch. 167 | 168 | 169 | 0.2.0.3 170 | 171 | (Released on: Sat Aug 27 21:18:22 UTC 2011) 172 | 173 | * Fixed issue #2 174 | https://github.com/basvandijk/monad-control/issues/2 175 | 176 | 177 | 0.2.0.2 178 | 179 | (Released on: Mon Aug 8 09:16:08 UTC 2011) 180 | 181 | * Switched to git on github. 182 | 183 | * Tested with base-4.4 and ghc-7.2.1. 184 | 185 | * Use the new cabal test-suite feature. 186 | 187 | 188 | 0.2.0.1 189 | 190 | (Released on: Wed Mar 16 15:53:50 UTC 2011) 191 | 192 | * Added laws for MonadTransControl and MonadControlIO 193 | 194 | * Bug fix: Add proper laziness to the MonadTransControl instances 195 | of the lazy StateT, WriteT and RWST 196 | These all failed the law: control $ \run -> run t = t 197 | where t = return undefined 198 | 199 | * Add INLINABLE pragmas for most public functions 200 | A simple benchmark showed some functions 201 | (bracket and mask) improving by 30%. 202 | 203 | 204 | 0.2 205 | 206 | (Released on: Wed Feb 9 12:05:26 UTC 2011) 207 | 208 | * Use RunInBase in the type of idLiftControl. 209 | 210 | * Added this NEWS file. 211 | 212 | * Only parameterize Run with t and use RankNTypes to quantify n and o 213 | -liftControl :: (Monad m, Monad n, Monad o) => (Run t n o -> m a) -> t m a 214 | +liftControl :: Monad m => (Run t -> m a) -> t m a 215 | 216 | -type Run t n o = forall b. t n b -> n (t o b) 217 | +type Run t = forall n o b. (Monad n, Monad o, Monad (t o)) => t n b -> n (t o b) 218 | 219 | Bumped version from 0.1 to 0.2 to indicate this breaking change in API. 220 | 221 | * Added example of a derivation of liftControlIO. 222 | Really enlightening! 223 | 224 | 225 | 0.1 226 | 227 | (Released on: Sat Feb 5 23:36:21 UTC 2011) 228 | 229 | * Initial release 230 | 231 | This is the announcement message sent to the Haskell mailinglists: 232 | http://www.mail-archive.com/haskell@haskell.org/msg23278.html 233 | 234 | 235 | Dear all, 236 | 237 | Several attempts have been made to lift control operations (functions 238 | that use monadic actions as input instead of just output) through 239 | monad transformers: 240 | 241 | MonadCatchIO-transformers[1] provided a type class that allowed to 242 | overload some often used control operations (catch, block and 243 | unblock). Unfortunately that library was limited to those operations. 244 | It was not possible to use, say, alloca in a monad transformer. More 245 | importantly however, the library was broken as was explained[2] by 246 | Michael Snoyman. In response Michael created the MonadInvertIO type 247 | class which solved the problems. Then Anders Kaseorg created the 248 | monad-peel library which provided an even nicer implementation. 249 | 250 | monad-control is a rewrite of monad-peel that uses CPS style 251 | operations and exploits the RankNTypes language extension to simplify 252 | and speedup most functions. A very preliminary and not yet fully 253 | representative, benchmark shows that monad-control is on average about 254 | 2.6 times faster than monad-peel: 255 | 256 | bracket: 2.4 x faster 257 | bracket_: 3.1 x faster 258 | catch: 1.8 x faster 259 | try: 4.0 x faster 260 | mask: 2.0 x faster 261 | 262 | Note that, although the package comes with a test suite that passes, I 263 | still consider it highly experimental. 264 | 265 | 266 | API DOCS: 267 | 268 | http://hackage.haskell.org/package/monad-control 269 | 270 | 271 | INSTALLING: 272 | 273 | $ cabal update 274 | $ cabal install monad-control 275 | 276 | 277 | TESTING: 278 | 279 | The package contains a copy of the monad-peel test suite written by 280 | Anders. You can perform the tests using: 281 | 282 | $ cabal unpack monad-control 283 | $ cd monad-control 284 | $ cabal configure -ftest 285 | $ cabal test 286 | 287 | 288 | BENCHMARKING: 289 | 290 | $ darcs get http://bifunctor.homelinux.net/~bas/bench-monad-peel-control/ 291 | $ cd bench-monad-peel-control 292 | $ cabal configure 293 | $ cabal build 294 | $ dist/build/bench-monad-peel-control/bench-monad-peel-control 295 | 296 | 297 | DEVELOPING: 298 | 299 | The darcs repository will be hosted on code.haskell.org ones that 300 | server is back online. For the time being you can get the repository 301 | from: 302 | 303 | $ darcs get http://bifunctor.homelinux.net/~bas/monad-control/ 304 | 305 | 306 | TUTORIAL: 307 | 308 | This short unpolished tutorial will explain how to lift control 309 | operations through monad transformers. Our goal is to lift a control 310 | operation like: 311 | 312 | foo ∷ M a → M a 313 | 314 | where M is some monad, into a transformed monad like 'StateT M': 315 | 316 | foo' ∷ StateT M a → StateT M a 317 | 318 | The first thing we need to do is write an instance for the 319 | MonadTransControl type class: 320 | 321 | class MonadTrans t ⇒ MonadTransControl t where 322 | liftControl ∷ (Monad m, Monad n, Monad o) 323 | ⇒ (Run t n o → m a) → t m a 324 | 325 | If you ignore the Run argument for now, you'll see that liftControl is 326 | identical to the 'lift' method of the MonadTrans type class: 327 | 328 | class MonadTrans t where 329 | lift ∷ Monad m ⇒ m a → t m a 330 | 331 | So the instance for MonadTransControl will probably look very much 332 | like the instance for MonadTrans. Let's see: 333 | 334 | instance MonadTransControl (StateT s) where 335 | liftControl f = StateT $ \s → liftM (\x → (x, s)) (f run) 336 | 337 | So what is this run function? Let's look at its type: 338 | 339 | type Run t n o = ∀ b. t n b → n (t o b) 340 | 341 | The run function executes a transformed monadic action 't n b' in the 342 | non-transformed monad 'n'. In our case the 't' will be a StateT 343 | computation. The only way to run a StateT computation is to give it 344 | some state and the only state we have lying around is the one from the 345 | outer computation: 's'. So let's run it on 's': 346 | 347 | instance MonadTransControl (StateT s) where 348 | liftControl f = 349 | StateT $ \s → 350 | let run t = ... runStateT t s ... 351 | in liftM (\x → (x, s)) (f run) 352 | 353 | Now that we are able to run a transformed monadic action, we're almost 354 | done. Look at the type of Run again. The function should leave the 355 | result 't o b' in the monad 'n'. This 't o b' computation should 356 | contain the final state after running the supplied 't n b' 357 | computation. In case of our StateT it should contain the final state 358 | s': 359 | 360 | instance MonadTransControl (StateT s) where 361 | liftControl f = 362 | StateT $ \s → 363 | let run t = liftM (\(x, s') → StateT $ \_ → return (x, s')) 364 | (runStateT t s) 365 | in liftM (\x → (x, s)) (f run) 366 | 367 | This final computation, "StateT $ \_ → return (x, s')", can later be 368 | used to restore the final state. Now that we have our 369 | MonadTransControl instance we can start using it. Recall that our goal 370 | was to lift "foo ∷ M a → M a" into our StateT transformer yielding the 371 | function "foo' ∷ StateT M a → StateT M a". 372 | 373 | To define foo', the first thing we need to do is call liftControl: 374 | 375 | foo' t = liftControl $ \run → ... 376 | 377 | This captures the current state of the StateT computation and provides 378 | us with the run function that allows us to run a StateT computation on 379 | this captured state. 380 | 381 | Now recall the type of liftControl ∷ (Run t n o → m a) → t m a. You 382 | can see that in place of the ... we must fill in a value of type 'm 383 | a'. In our case this will be a value of type 'M a'. We can construct 384 | such a value by calling foo. However, foo expects an argument of type 385 | 'M a'. Fortunately we can provide one if we convert the supplied 't' 386 | computation of type 'StateT M a' to 'M a' using our run function of 387 | type ∀ b. StateT M b → M (StateT o b): 388 | 389 | foo' t = ... liftControl $ \run → foo $ run t 390 | 391 | However, note that the run function returns the final StateT 392 | computation inside M. So the type of the right hand side is now 393 | 'StateT M (StateT o b)'. We would like to restore this final state. We 394 | can do that using join: 395 | 396 | foo' t = join $ liftControl $ \run → foo $ run t 397 | 398 | That's it! Note that because it's so common to join after a 399 | liftControl I provide an abstraction for it: 400 | 401 | control = join ∘ liftControl 402 | 403 | Allowing you to simplify foo' to: 404 | 405 | foo' t = control $ \run → foo $ run t 406 | 407 | Probably the most common control operations that you want to lift 408 | through your transformers are IO operations. Think about: bracket, 409 | alloca, mask, etc.. For this reason I provide the MonadControlIO type 410 | class: 411 | 412 | class MonadIO m ⇒ MonadControlIO m where 413 | liftControlIO ∷ (RunInBase m IO → IO a) → m a 414 | 415 | Again, if you ignore the RunInBase argument, you will see that 416 | liftControlIO is identical to the liftIO method of the MonadIO type 417 | class: 418 | 419 | class Monad m ⇒ MonadIO m where 420 | liftIO ∷ IO a → m a 421 | 422 | Just like Run, RunInBase allows you to run your monadic computation 423 | inside your base monad, which in case of liftControlIO is IO: 424 | 425 | type RunInBase m base = ∀ b. m b → base (m b) 426 | 427 | The instance for the base monad is trivial: 428 | 429 | instance MonadControlIO IO where 430 | liftControlIO = idLiftControl 431 | 432 | idLiftControl directly executes f and passes it a run function which 433 | executes the given action and lifts the result r into the trivial 434 | 'return r' action: 435 | 436 | idLiftControl ∷ Monad m ⇒ ((∀ b. m b → m (m b)) → m a) → m a 437 | idLiftControl f = f $ liftM $ \r -> return r 438 | 439 | The instances for the transformers are all identical. Let's look at 440 | StateT and ReaderT: 441 | 442 | instance MonadControlIO m ⇒ MonadControlIO (StateT s m) where 443 | liftControlIO = liftLiftControlBase liftControlIO 444 | 445 | instance MonadControlIO m ⇒ MonadControlIO (ReaderT r m) where 446 | liftControlIO = liftLiftControlBase liftControlIO 447 | 448 | The magic function is liftLiftControlBase. This function is used to 449 | compose two liftControl operations, the outer provided by a 450 | MonadTransControl instance and the inner provided as the argument: 451 | 452 | liftLiftControlBase ∷ (MonadTransControl t, Monad base, Monad m, Monad (t m)) 453 | ⇒ ((RunInBase m base → base a) → m a) 454 | → ((RunInBase (t m) base → base a) → t m a) 455 | liftLiftControlBase lftCtrlBase = 456 | \f → liftControl $ \run → 457 | lftCtrlBase $ \runInBase → 458 | f $ liftM (join ∘ lift) ∘ runInBase ∘ run 459 | 460 | Basically it captures the state of the outer monad transformer using 461 | liftControl. Then it captures the state of the inner monad using the 462 | supplied lftCtrlBase function. If you recall the identical definitions 463 | of the liftControlIO methods: 'liftLiftControlBase liftControlIO' you 464 | will see that this lftCtrlBase function is the recursive step of 465 | liftLiftControlBase. If you use 'liftLiftControlBase liftControlIO' in 466 | a stack of monad transformers a chain of liftControl operations is 467 | created: 468 | 469 | liftControl $ \run1 -> liftControl $ \run2 -> liftControl $ \run3 -> ... 470 | 471 | This will recurse until we hit the base monad. Then 472 | liftLiftControlBase will finally run f in the base monad supplying it 473 | with a run function that is able to run a 't m a' computation in the 474 | base monad. It does this by composing the run and runInBase functions. 475 | Note that runInBase is basically the composition: '... ∘ run3 ∘ run2'. 476 | 477 | However, just composing the run and runInBase functions is not enough. 478 | Namely: runInBase ∘ run ∷ ∀ b. t m b → base (m (t m b)) while we need 479 | to have ∀ b. t m b → base (t m b). So we need to lift the 'm (t m b)' 480 | computation inside t yielding: 't m (t m b)' and then join that to get 481 | 't m b'. 482 | 483 | Now that we have our MonadControlIO instances we can start using them. 484 | Let's look at how to lift 'bracket' into a monad supporting 485 | MonadControlIO. Before we do that I define a little convenience 486 | function similar to 'control': 487 | 488 | controlIO = join ∘ liftControlIO 489 | 490 | Bracket just calls controlIO which captures the state of m and 491 | provides us with a runInIO function which allows us to run an m 492 | computation in IO: 493 | 494 | bracket ∷ MonadControlIO m 495 | ⇒ m a → (a → m b) → (a → m c) → m c 496 | bracket before after thing = 497 | controlIO $ \runInIO → 498 | E.bracket (runInIO before) 499 | (\m → runInIO $ m >>= after) 500 | (\m → runInIO $ m >>= thing) 501 | 502 | I welcome any comments, questions or patches. 503 | 504 | Regards, 505 | 506 | Bas 507 | 508 | [1] http://hackage.haskell.org/package/MonadCatchIO-transformers 509 | [2] http://docs.yesodweb.com/blog/invertible-monads-exceptions-allocations/ 510 | [3] http://hackage.haskell.org/package/monad-peel 511 | -------------------------------------------------------------------------------- /CONTRIBUTORS: -------------------------------------------------------------------------------- 1 | Bas van Dijk wrote this library. 2 | 3 | Anders Kaseorg wrote the monad-peel which provided inspiration for this library. 4 | 5 | kudah wrote the default methods for the MonadTransControl class. 6 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright © 2010, Bas van Dijk, Anders Kaseorg 2 | All rights reserved. 3 | 4 | Redistribution and use in source and binary forms, with or without 5 | modification, are permitted provided that the following conditions are 6 | met: 7 | 8 | • Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | • Redistributions in binary form must reproduce the above copyright 12 | notice, this list of conditions and the following disclaimer in the 13 | documentation and/or other materials provided with the distribution. 14 | 15 | • Neither the name of the author nor the names of other contributors 16 | may be used to endorse or promote products derived from this 17 | software without specific prior written permission. 18 | 19 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 20 | “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 21 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 22 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 23 | HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 24 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 25 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 26 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 27 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 28 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 29 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 30 | -------------------------------------------------------------------------------- /README.markdown: -------------------------------------------------------------------------------- 1 | [![Hackage](https://img.shields.io/hackage/v/monad-control.svg)](https://hackage.haskell.org/package/monad-control) 2 | [![Build Status](https://travis-ci.org/basvandijk/monad-control.svg)](https://travis-ci.org/basvandijk/monad-control) 3 | 4 | This package defines the type class `MonadControlIO`, a subset of 5 | `MonadIO` into which generic control operations such as `catch` can be 6 | lifted from `IO`. Instances are based on monad transformers in 7 | `MonadTransControl`, which includes all standard monad transformers in 8 | the `transformers` library except `ContT`. 9 | 10 | Note that this package is a rewrite of Anders Kaseorg's `monad-peel` 11 | library. The main difference is that this package provides CPS style 12 | operators and exploits the `RankNTypes` language extension to simplify 13 | most definitions. 14 | 15 | [This `criterion`](https://github.com/basvandijk/bench-monad-peel-control) 16 | based benchmark shows that `monad-control` is on average about 2.5 17 | times faster than `monad-peel`. 18 | -------------------------------------------------------------------------------- /cabal.haskell-ci: -------------------------------------------------------------------------------- 1 | branches: master 2 | -------------------------------------------------------------------------------- /cabal.project: -------------------------------------------------------------------------------- 1 | packages: . 2 | -------------------------------------------------------------------------------- /default.nix: -------------------------------------------------------------------------------- 1 | let pkgs = import {}; 2 | in pkgs.haskellPackages.callPackage ./monad-control.nix {} 3 | -------------------------------------------------------------------------------- /monad-control.cabal: -------------------------------------------------------------------------------- 1 | name: monad-control 2 | version: 1.0.4 3 | synopsis: 4 | Lift control operations, like exception catching, through monad transformers 5 | 6 | license: BSD3 7 | license-file: LICENSE 8 | author: Bas van Dijk, Anders Kaseorg 9 | maintainer: 10 | Oleg Grenrus , Bas van Dijk 11 | 12 | copyright: (c) 2011 Bas van Dijk, Anders Kaseorg 13 | homepage: https://github.com/basvandijk/monad-control 14 | bug-reports: https://github.com/basvandijk/monad-control/issues 15 | category: Control 16 | build-type: Simple 17 | cabal-version: 1.12 18 | description: 19 | This package defines the type class @MonadBaseControl@, a subset of 20 | @MonadBase@ into which generic control operations such as @catch@ can be 21 | lifted from @IO@ or any other base monad. Instances are based on monad 22 | transformers in @MonadTransControl@, which includes all standard monad 23 | transformers in the @transformers@ library except @ContT@. 24 | . 25 | See the 26 | package which uses @monad-control@ to lift @IO@ 27 | operations from the @base@ library (like @catch@ or @bracket@) into any monad 28 | that is an instance of @MonadBase@ or @MonadBaseControl@. 29 | . 30 | Note that this package is a rewrite of Anders Kaseorg's @monad-peel@ 31 | library. The main difference is that this package provides CPS style operators 32 | and exploits the @RankNTypes@ and @TypeFamilies@ language extensions to 33 | simplify and speedup most definitions. 34 | 35 | extra-source-files: 36 | CHANGELOG 37 | README.markdown 38 | 39 | tested-with: 40 | GHC ==7.4.2 41 | || ==7.6.3 42 | || ==7.8.4 43 | || ==7.10.3 44 | || ==8.0.2 45 | || ==8.2.2 46 | || ==8.4.4 47 | || ==8.6.5 48 | || ==8.8.4 49 | || ==8.10.7 50 | || ==9.0.2 51 | || ==9.2.4 52 | || ==9.4.2 53 | 54 | -------------------------------------------------------------------------------- 55 | 56 | source-repository head 57 | type: git 58 | location: git://github.com/basvandijk/monad-control.git 59 | 60 | -------------------------------------------------------------------------------- 61 | 62 | library 63 | default-language: Haskell2010 64 | hs-source-dirs: src 65 | ghc-options: -Wall 66 | exposed-modules: Control.Monad.Trans.Control 67 | build-depends: 68 | base >=4.5 && <5 69 | , stm >=2.3 && <2.6 70 | , transformers >=0.2 && <0.7 71 | , transformers-base >=0.4.6 && <0.5 72 | , transformers-compat >=0.6.1 && <0.8 73 | -------------------------------------------------------------------------------- /monad-control.nix: -------------------------------------------------------------------------------- 1 | { mkDerivation, base, stdenv, stm, transformers, transformers-base 2 | , transformers-compat 3 | }: 4 | mkDerivation { 5 | pname = "monad-control"; 6 | version = "HEAD"; 7 | src = ./.; 8 | libraryHaskellDepends = [ 9 | base stm transformers transformers-base transformers-compat 10 | ]; 11 | homepage = "https://github.com/basvandijk/monad-control"; 12 | description = "Lift control operations, like exception catching, through monad transformers"; 13 | license = stdenv.lib.licenses.bsd3; 14 | } 15 | -------------------------------------------------------------------------------- /shell.nix: -------------------------------------------------------------------------------- 1 | { nixpkgs ? import {}, compiler ? "default" }: 2 | 3 | let 4 | 5 | inherit (nixpkgs) pkgs; 6 | 7 | haskellPackages = if compiler == "default" 8 | then pkgs.haskellPackages 9 | else pkgs.haskell.packages.${compiler}; 10 | 11 | drv = haskellPackages.callPackage (import ./monad-control.nix) {}; 12 | 13 | in 14 | 15 | if pkgs.lib.inNixShell then drv.env else drv 16 | -------------------------------------------------------------------------------- /src/Control/Monad/Trans/Control.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP 2 | , NoImplicitPrelude 3 | , RankNTypes 4 | , TypeFamilies 5 | , FunctionalDependencies 6 | , FlexibleInstances 7 | , UndecidableInstances 8 | , MultiParamTypeClasses #-} 9 | 10 | {-# LANGUAGE Safe #-} 11 | 12 | #if MIN_VERSION_transformers(0,4,0) 13 | -- Hide warnings for the deprecated ErrorT transformer: 14 | {-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} 15 | #endif 16 | 17 | {- | 18 | Copyright : Bas van Dijk, Anders Kaseorg 19 | License : BSD3 20 | Maintainer : Bas van Dijk 21 | 22 | This module defines the type class 'MonadBaseControl', a subset of 23 | 'MonadBase' into which generic control operations such as @catch@ can be 24 | lifted from @IO@ or any other base monad. Instances are based on monad 25 | transformers in 'MonadTransControl', which includes all standard monad 26 | transformers in the @transformers@ library except @ContT@ and @SelectT@. 27 | 28 | See the 29 | package which uses @monad-control@ to lift @IO@ 30 | operations from the @base@ library (like @catch@ or @bracket@) into any monad 31 | that is an instance of @MonadBase@ or @MonadBaseControl@. 32 | 33 | See the following tutorial by Michael Snoyman on how to use this package: 34 | 35 | 36 | 37 | === Quick implementation guide 38 | 39 | Given a base monad @B@ and a stack of transformers @T@: 40 | 41 | * Define instances @'MonadTransControl' T@ for all transformers @T@, using the 42 | @'defaultLiftWith'@ and @'defaultRestoreT'@ functions on the constructor and 43 | deconstructor of @T@. 44 | 45 | * Define an instance @'MonadBaseControl' B B@ for the base monad: 46 | 47 | @ 48 | instance MonadBaseControl B B where 49 | type StM B a = a 50 | liftBaseWith f = f 'id' 51 | restoreM = 'return' 52 | @ 53 | 54 | * Define instances @'MonadBaseControl' B m => 'MonadBaseControl' B (T m)@ for 55 | all transformers: 56 | 57 | @ 58 | instance MonadBaseControl b m => MonadBaseControl b (T m) where 59 | type StM (T m) a = 'ComposeSt' T m a 60 | liftBaseWith f = 'defaultLiftBaseWith' 61 | restoreM = 'defaultRestoreM' 62 | @ 63 | -} 64 | 65 | module Control.Monad.Trans.Control 66 | ( -- * MonadTransControl 67 | MonadTransControl(..), Run 68 | 69 | -- ** Defaults 70 | -- $MonadTransControlDefaults 71 | , RunDefault, defaultLiftWith, defaultRestoreT 72 | -- *** Defaults for a stack of two 73 | -- $MonadTransControlDefaults2 74 | , RunDefault2, defaultLiftWith2, defaultRestoreT2 75 | 76 | -- * MonadBaseControl 77 | , MonadBaseControl (..), RunInBase 78 | 79 | -- ** Defaults 80 | -- $MonadBaseControlDefaults 81 | , ComposeSt, RunInBaseDefault, defaultLiftBaseWith, defaultRestoreM 82 | 83 | -- * Utility functions 84 | , control, controlT, embed, embed_, captureT, captureM 85 | 86 | , liftBaseOp, liftBaseOp_ 87 | 88 | , liftBaseDiscard, liftBaseOpDiscard 89 | 90 | , liftThrough 91 | ) where 92 | 93 | 94 | -------------------------------------------------------------------------------- 95 | -- Imports 96 | -------------------------------------------------------------------------------- 97 | 98 | -- from base: 99 | import Data.Function ( (.), ($), const ) 100 | import Data.Monoid ( Monoid, mempty ) 101 | import Control.Monad ( Monad, (>>=), return, liftM ) 102 | import System.IO ( IO ) 103 | import Data.Maybe ( Maybe ) 104 | import Data.Either ( Either ) 105 | import Control.Monad ( void ) 106 | import Prelude ( id ) 107 | 108 | import Control.Monad.ST.Lazy.Safe ( ST ) 109 | import qualified Control.Monad.ST.Safe as Strict ( ST ) 110 | 111 | -- from stm: 112 | import Control.Monad.STM ( STM ) 113 | 114 | -- from transformers: 115 | import Control.Monad.Trans.Class ( MonadTrans ) 116 | 117 | import Control.Monad.Trans.Identity ( IdentityT(IdentityT), runIdentityT ) 118 | import Control.Monad.Trans.Maybe ( MaybeT (MaybeT), runMaybeT ) 119 | import Control.Monad.Trans.Reader ( ReaderT (ReaderT), runReaderT ) 120 | import Control.Monad.Trans.State ( StateT (StateT), runStateT ) 121 | import Control.Monad.Trans.Writer ( WriterT (WriterT), runWriterT ) 122 | import Control.Monad.Trans.RWS ( RWST (RWST), runRWST ) 123 | import Control.Monad.Trans.Except ( ExceptT (ExceptT), runExceptT ) 124 | import Control.Monad.Trans.Accum ( AccumT (AccumT), runAccumT ) 125 | 126 | #if !(MIN_VERSION_transformers(0,6,0)) 127 | import Control.Monad.Trans.List ( ListT (ListT), runListT ) 128 | import Control.Monad.Trans.Error ( ErrorT (ErrorT), runErrorT, Error ) 129 | #endif 130 | 131 | import qualified Control.Monad.Trans.RWS.Strict as Strict ( RWST (RWST), runRWST ) 132 | import qualified Control.Monad.Trans.State.Strict as Strict ( StateT (StateT), runStateT ) 133 | import qualified Control.Monad.Trans.Writer.Strict as Strict ( WriterT(WriterT), runWriterT ) 134 | 135 | import Data.Functor.Identity ( Identity ) 136 | 137 | -- from transformers-base: 138 | import Control.Monad.Base ( MonadBase ) 139 | 140 | 141 | -------------------------------------------------------------------------------- 142 | -- MonadTransControl type class 143 | -------------------------------------------------------------------------------- 144 | 145 | -- | The @MonadTransControl@ type class is a stronger version of @'MonadTrans'@: 146 | -- 147 | -- Instances of @'MonadTrans'@ know how to @'lift'@ actions in the base monad to 148 | -- the transformed monad. These lifted actions, however, are completely unaware 149 | -- of the monadic state added by the transformer. 150 | -- 151 | -- @'MonadTransControl'@ instances are aware of the monadic state of the 152 | -- transformer and allow to save and restore this state. 153 | -- 154 | -- This allows to lift functions that have a monad transformer in both positive 155 | -- and negative position. Take, for example, the function 156 | -- 157 | -- @ 158 | -- withFile :: FilePath -> IOMode -> (Handle -> IO r) -> IO r 159 | -- @ 160 | -- 161 | -- @'MonadTrans'@ instances can only lift the return type of the @withFile@ 162 | -- function: 163 | -- 164 | -- @ 165 | -- withFileLifted :: MonadTrans t => FilePath -> IOMode -> (Handle -> IO r) -> t IO r 166 | -- withFileLifted file mode action = lift (withFile file mode action) 167 | -- @ 168 | -- 169 | -- However, @'MonadTrans'@ is not powerful enough to make @withFileLifted@ 170 | -- accept a function that returns @t IO@. The reason is that we need to take 171 | -- away the transformer layer in order to pass the function to @'withFile'@. 172 | -- @'MonadTransControl'@ allows us to do this: 173 | -- 174 | -- @ 175 | -- withFileLifted' :: (Monad (t IO), MonadTransControl t) => FilePath -> IOMode -> (Handle -> t IO r) -> t IO r 176 | -- withFileLifted' file mode action = liftWith (\\run -> withFile file mode (run . action)) >>= restoreT . return 177 | -- @ 178 | class MonadTrans t => MonadTransControl t where 179 | -- | Monadic state of @t@. 180 | -- 181 | -- The monadic state of a monad transformer is the result type of its @run@ 182 | -- function, e.g.: 183 | -- 184 | -- @ 185 | -- 'runReaderT' :: 'ReaderT' r m a -> r -> m a 186 | -- 'StT' ('ReaderT' r) a ~ a 187 | -- 188 | -- 'runStateT' :: 'StateT' s m a -> s -> m (a, s) 189 | -- 'StT' ('StateT' s) a ~ (a, s) 190 | -- 191 | -- 'runMaybeT' :: 'MaybeT' m a -> m ('Maybe' a) 192 | -- 'StT' 'MaybeT' a ~ 'Maybe' a 193 | -- @ 194 | -- 195 | -- Provided type instances: 196 | -- 197 | -- @ 198 | -- StT 'IdentityT' a ~ a 199 | -- StT 'MaybeT' a ~ 'Maybe' a 200 | -- StT ('ErrorT' e) a ~ 'Error' e => 'Either' e a 201 | -- StT ('ExceptT' e) a ~ 'Either' e a 202 | -- StT 'ListT' a ~ [a] 203 | -- StT ('ReaderT' r) a ~ a 204 | -- StT ('StateT' s) a ~ (a, s) 205 | -- StT ('WriterT' w) a ~ 'Monoid' w => (a, w) 206 | -- StT ('RWST' r w s) a ~ 'Monoid' w => (a, s, w) 207 | -- @ 208 | type StT t a :: * 209 | 210 | -- | @liftWith@ is similar to 'lift' in that it lifts a computation from 211 | -- the argument monad to the constructed monad. 212 | -- 213 | -- Instances should satisfy similar laws as the 'MonadTrans' laws: 214 | -- 215 | -- @liftWith (\\_ -> return a) = return a@ 216 | -- 217 | -- @liftWith (\\_ -> m >>= f) = liftWith (\\_ -> m) >>= (\\a -> liftWith (\\_ -> f a))@ 218 | -- 219 | -- The difference with 'lift' is that before lifting the @m@ computation 220 | -- @liftWith@ captures the state of @t@. It then provides the @m@ 221 | -- computation with a 'Run' function that allows running @t n@ computations in 222 | -- @n@ (for all @n@) on the captured state, e.g. 223 | -- 224 | -- @ 225 | -- withFileLifted :: (Monad (t IO), MonadTransControl t) => FilePath -> IOMode -> (Handle -> t IO r) -> t IO r 226 | -- withFileLifted file mode action = liftWith (\\run -> withFile file mode (run . action)) >>= restoreT . return 227 | -- @ 228 | -- 229 | -- If the @Run@ function is ignored, @liftWith@ coincides with @lift@: 230 | -- 231 | -- @lift f = liftWith (\\_ -> f)@ 232 | -- 233 | -- Implementations use the @'Run'@ function associated with a transformer: 234 | -- 235 | -- @ 236 | -- liftWith :: 'Monad' m => (('Monad' n => 'ReaderT' r n b -> n b) -> m a) -> 'ReaderT' r m a 237 | -- liftWith f = 'ReaderT' (\\r -> f (\\action -> 'runReaderT' action r)) 238 | -- 239 | -- liftWith :: 'Monad' m => (('Monad' n => 'StateT' s n b -> n (b, s)) -> m a) -> 'StateT' s m a 240 | -- liftWith f = 'StateT' (\\s -> 'liftM' (\\x -> (x, s)) (f (\\action -> 'runStateT' action s))) 241 | -- 242 | -- liftWith :: 'Monad' m => (('Monad' n => 'MaybeT' n b -> n ('Maybe' b)) -> m a) -> 'MaybeT' m a 243 | -- liftWith f = 'MaybeT' ('liftM' 'Just' (f 'runMaybeT')) 244 | -- @ 245 | liftWith :: Monad m => (Run t -> m a) -> t m a 246 | 247 | -- | Construct a @t@ computation from the monadic state of @t@ that is 248 | -- returned from a 'Run' function. 249 | -- 250 | -- Instances should satisfy: 251 | -- 252 | -- @liftWith (\\run -> run t) >>= restoreT . return = t@ 253 | -- 254 | -- @restoreT@ is usually implemented through the constructor of the monad 255 | -- transformer: 256 | -- 257 | -- @ 258 | -- 'ReaderT' :: (r -> m a) -> 'ReaderT' r m a 259 | -- restoreT :: m a -> 'ReaderT' r m a 260 | -- restoreT action = 'ReaderT' { runReaderT = 'const' action } 261 | -- 262 | -- 'StateT' :: (s -> m (a, s)) -> 'StateT' s m a 263 | -- restoreT :: m (a, s) -> 'StateT' s m a 264 | -- restoreT action = 'StateT' { runStateT = 'const' action } 265 | -- 266 | -- 'MaybeT' :: m ('Maybe' a) -> 'MaybeT' m a 267 | -- restoreT :: m ('Maybe' a) -> 'MaybeT' m a 268 | -- restoreT action = 'MaybeT' action 269 | -- @ 270 | -- 271 | -- Example type signatures: 272 | -- 273 | -- @ 274 | -- restoreT :: 'Monad' m => m a -> 'IdentityT' m a 275 | -- restoreT :: 'Monad' m => m ('Maybe' a) -> 'MaybeT' m a 276 | -- restoreT :: ('Monad' m, 'Error' e) => m ('Either' e a) -> 'ErrorT' e m a 277 | -- restoreT :: 'Monad' m => m ('Either' e a) -> 'ExceptT' e m a 278 | -- restoreT :: 'Monad' m => m [a] -> 'ListT' m a 279 | -- restoreT :: 'Monad' m => m a -> 'ReaderT' r m a 280 | -- restoreT :: 'Monad' m => m (a, s) -> 'StateT' s m a 281 | -- restoreT :: ('Monad' m, 'Monoid' w) => m (a, w) -> 'WriterT' w m a 282 | -- restoreT :: ('Monad' m, 'Monoid' w) => m (a, s, w) -> 'RWST' r w s m a 283 | -- @ 284 | restoreT :: Monad m => m (StT t a) -> t m a 285 | 286 | -- | A function that runs a transformed monad @t n@ on the monadic state that 287 | -- was captured by 'liftWith' 288 | -- 289 | -- A @Run t@ function yields a computation in @n@ that returns the monadic state 290 | -- of @t@. This state can later be used to restore a @t@ computation using 291 | -- 'restoreT'. 292 | -- 293 | -- Example type equalities: 294 | -- 295 | -- @ 296 | -- Run 'IdentityT' ~ forall n b. 'Monad' n => 'IdentityT' n b -> n b 297 | -- Run 'MaybeT' ~ forall n b. 'Monad' n => 'MaybeT' n b -> n ('Maybe' b) 298 | -- Run ('ErrorT' e) ~ forall n b. ('Monad' n, 'Error' e) => 'ErrorT' e n b -> n ('Either' e b) 299 | -- Run ('ExceptT' e) ~ forall n b. 'Monad' n => 'ExceptT' e n b -> n ('Either' e b) 300 | -- Run 'ListT' ~ forall n b. 'Monad' n => 'ListT' n b -> n [b] 301 | -- Run ('ReaderT' r) ~ forall n b. 'Monad' n => 'ReaderT' r n b -> n b 302 | -- Run ('StateT' s) ~ forall n b. 'Monad' n => 'StateT' s n b -> n (a, s) 303 | -- Run ('WriterT' w) ~ forall n b. ('Monad' n, 'Monoid' w) => 'WriterT' w n b -> n (a, w) 304 | -- Run ('RWST' r w s) ~ forall n b. ('Monad' n, 'Monoid' w) => 'RWST' r w s n b -> n (a, s, w) 305 | -- @ 306 | -- 307 | -- This type is usually satisfied by the @run@ function of a transformer: 308 | -- 309 | -- @ 310 | -- 'flip' 'runReaderT' :: r -> Run ('ReaderT' r) 311 | -- 'flip' 'runStateT' :: s -> Run ('StateT' s) 312 | -- 'runMaybeT' :: Run 'MaybeT' 313 | -- @ 314 | type Run t = forall n b. Monad n => t n b -> n (StT t b) 315 | 316 | 317 | -------------------------------------------------------------------------------- 318 | -- Defaults for MonadTransControl 319 | -------------------------------------------------------------------------------- 320 | 321 | -- $MonadTransControlDefaults 322 | -- 323 | -- The following functions can be used to define a 'MonadTransControl' instance 324 | -- for a monad transformer which simply is a newtype around another monad 325 | -- transformer which already has a @MonadTransControl@ instance. For example: 326 | -- 327 | -- @ 328 | -- {-\# LANGUAGE GeneralizedNewtypeDeriving \#-} 329 | -- {-\# LANGUAGE UndecidableInstances \#-} 330 | -- {-\# LANGUAGE TypeFamilies \#-} 331 | -- 332 | -- newtype CounterT m a = CounterT {unCounterT :: StateT Int m a} 333 | -- deriving (Monad, MonadTrans) 334 | -- 335 | -- instance MonadTransControl CounterT where 336 | -- type StT CounterT a = StT (StateT Int) a 337 | -- liftWith = 'defaultLiftWith' CounterT unCounterT 338 | -- restoreT = 'defaultRestoreT' CounterT 339 | -- @ 340 | 341 | -- | A function like 'Run' that runs a monad transformer @t@ which wraps the 342 | -- monad transformer @t'@. This is used in 'defaultLiftWith'. 343 | type RunDefault t t' = forall n b. Monad n => t n b -> n (StT t' b) 344 | 345 | -- | Default definition for the 'liftWith' method. 346 | defaultLiftWith :: (Monad m, MonadTransControl n) 347 | => (forall b. n m b -> t m b) -- ^ Monad constructor 348 | -> (forall o b. t o b -> n o b) -- ^ Monad deconstructor 349 | -> (RunDefault t n -> m a) 350 | -> t m a 351 | defaultLiftWith t unT = \f -> t $ liftWith $ \run -> f $ run . unT 352 | {-# INLINABLE defaultLiftWith #-} 353 | 354 | -- | Default definition for the 'restoreT' method. 355 | defaultRestoreT :: (Monad m, MonadTransControl n) 356 | => (n m a -> t m a) -- ^ Monad constructor 357 | -> m (StT n a) 358 | -> t m a 359 | defaultRestoreT t = t . restoreT 360 | {-# INLINABLE defaultRestoreT #-} 361 | 362 | ------------------------------------------------------------------------------- 363 | -- 364 | ------------------------------------------------------------------------------- 365 | 366 | -- $MonadTransControlDefaults2 367 | -- 368 | -- The following functions can be used to define a 'MonadTransControl' instance 369 | -- for a monad transformer stack of two. 370 | -- 371 | -- @ 372 | -- {-\# LANGUAGE GeneralizedNewtypeDeriving \#-} 373 | -- 374 | -- newtype CalcT m a = CalcT { unCalcT :: StateT Int (ExceptT String m) a } 375 | -- deriving (Monad, MonadTrans) 376 | -- 377 | -- instance MonadTransControl CalcT where 378 | -- type StT CalcT a = StT (ExceptT String) (StT (StateT Int) a) 379 | -- liftWith = 'defaultLiftWith2' CalcT unCalcT 380 | -- restoreT = 'defaultRestoreT2' CalcT 381 | -- @ 382 | 383 | -- | A function like 'Run' that runs a monad transformer @t@ which wraps the 384 | -- monad transformers @n@ and @n'@. This is used in 'defaultLiftWith2'. 385 | type RunDefault2 t n n' = forall m b. (Monad m, Monad (n' m)) => t m b -> m (StT n' (StT n b)) 386 | 387 | -- | Default definition for the 'liftWith' method. 388 | defaultLiftWith2 :: (Monad m, Monad (n' m), MonadTransControl n, MonadTransControl n') 389 | => (forall b. n (n' m) b -> t m b) -- ^ Monad constructor 390 | -> (forall o b. t o b -> n (n' o) b) -- ^ Monad deconstructor 391 | -> (RunDefault2 t n n' -> m a) 392 | -> t m a 393 | defaultLiftWith2 t unT = \f -> t $ liftWith $ \run -> liftWith $ \run' -> f $ run' . run . unT 394 | {-# INLINABLE defaultLiftWith2 #-} 395 | 396 | -- | Default definition for the 'restoreT' method for double 'MonadTransControl'. 397 | defaultRestoreT2 :: (Monad m, Monad (n' m), MonadTransControl n, MonadTransControl n') 398 | => (n (n' m) a -> t m a) -- ^ Monad constructor 399 | -> m (StT n' (StT n a)) 400 | -> t m a 401 | defaultRestoreT2 t = t . restoreT . restoreT 402 | {-# INLINABLE defaultRestoreT2 #-} 403 | 404 | -------------------------------------------------------------------------------- 405 | -- MonadTransControl instances 406 | -------------------------------------------------------------------------------- 407 | 408 | instance MonadTransControl IdentityT where 409 | type StT IdentityT a = a 410 | liftWith f = IdentityT $ f $ runIdentityT 411 | restoreT = IdentityT 412 | {-# INLINABLE liftWith #-} 413 | {-# INLINABLE restoreT #-} 414 | 415 | instance MonadTransControl MaybeT where 416 | type StT MaybeT a = Maybe a 417 | liftWith f = MaybeT $ liftM return $ f $ runMaybeT 418 | restoreT = MaybeT 419 | {-# INLINABLE liftWith #-} 420 | {-# INLINABLE restoreT #-} 421 | 422 | #if !(MIN_VERSION_transformers(0,6,0)) 423 | instance MonadTransControl ListT where 424 | type StT ListT a = [a] 425 | liftWith f = ListT $ liftM return $ f $ runListT 426 | restoreT = ListT 427 | {-# INLINABLE liftWith #-} 428 | {-# INLINABLE restoreT #-} 429 | 430 | instance Error e => MonadTransControl (ErrorT e) where 431 | type StT (ErrorT e) a = Either e a 432 | liftWith f = ErrorT $ liftM return $ f $ runErrorT 433 | restoreT = ErrorT 434 | {-# INLINABLE liftWith #-} 435 | {-# INLINABLE restoreT #-} 436 | #endif 437 | 438 | instance MonadTransControl (ExceptT e) where 439 | type StT (ExceptT e) a = Either e a 440 | liftWith f = ExceptT $ liftM return $ f $ runExceptT 441 | restoreT = ExceptT 442 | {-# INLINABLE liftWith #-} 443 | {-# INLINABLE restoreT #-} 444 | 445 | instance MonadTransControl (ReaderT r) where 446 | type StT (ReaderT r) a = a 447 | liftWith f = ReaderT $ \r -> f $ \t -> runReaderT t r 448 | restoreT = ReaderT . const 449 | {-# INLINABLE liftWith #-} 450 | {-# INLINABLE restoreT #-} 451 | 452 | instance MonadTransControl (StateT s) where 453 | type StT (StateT s) a = (a, s) 454 | liftWith f = StateT $ \s -> 455 | liftM (\x -> (x, s)) 456 | (f $ \t -> runStateT t s) 457 | restoreT = StateT . const 458 | {-# INLINABLE liftWith #-} 459 | {-# INLINABLE restoreT #-} 460 | 461 | instance MonadTransControl (Strict.StateT s) where 462 | type StT (Strict.StateT s) a = (a, s) 463 | liftWith f = Strict.StateT $ \s -> 464 | liftM (\x -> (x, s)) 465 | (f $ \t -> Strict.runStateT t s) 466 | restoreT = Strict.StateT . const 467 | {-# INLINABLE liftWith #-} 468 | {-# INLINABLE restoreT #-} 469 | 470 | instance Monoid w => MonadTransControl (WriterT w) where 471 | type StT (WriterT w) a = (a, w) 472 | liftWith f = WriterT $ liftM (\x -> (x, mempty)) 473 | (f $ runWriterT) 474 | restoreT = WriterT 475 | {-# INLINABLE liftWith #-} 476 | {-# INLINABLE restoreT #-} 477 | 478 | instance Monoid w => MonadTransControl (Strict.WriterT w) where 479 | type StT (Strict.WriterT w) a = (a, w) 480 | liftWith f = Strict.WriterT $ liftM (\x -> (x, mempty)) 481 | (f $ Strict.runWriterT) 482 | restoreT = Strict.WriterT 483 | {-# INLINABLE liftWith #-} 484 | {-# INLINABLE restoreT #-} 485 | 486 | instance Monoid w => MonadTransControl (RWST r w s) where 487 | type StT (RWST r w s) a = (a, s, w) 488 | liftWith f = RWST $ \r s -> liftM (\x -> (x, s, mempty)) 489 | (f $ \t -> runRWST t r s) 490 | restoreT mSt = RWST $ \_ _ -> mSt 491 | {-# INLINABLE liftWith #-} 492 | {-# INLINABLE restoreT #-} 493 | 494 | instance Monoid w => MonadTransControl (Strict.RWST r w s) where 495 | type StT (Strict.RWST r w s) a = (a, s, w) 496 | liftWith f = 497 | Strict.RWST $ \r s -> liftM (\x -> (x, s, mempty)) 498 | (f $ \t -> Strict.runRWST t r s) 499 | restoreT mSt = Strict.RWST $ \_ _ -> mSt 500 | {-# INLINABLE liftWith #-} 501 | {-# INLINABLE restoreT #-} 502 | 503 | instance Monoid w => MonadTransControl (AccumT w) where 504 | type StT (AccumT w) a = (a, w) 505 | liftWith f = AccumT $ \s -> 506 | liftM (\x -> (x, s)) 507 | (f $ \t -> runAccumT t s) 508 | restoreT = AccumT . const 509 | {-# INLINABLE liftWith #-} 510 | {-# INLINABLE restoreT #-} 511 | 512 | 513 | -------------------------------------------------------------------------------- 514 | -- MonadBaseControl type class 515 | -------------------------------------------------------------------------------- 516 | 517 | -- | 518 | -- == Writing instances 519 | -- 520 | -- The usual way to write a @'MonadBaseControl'@ instance for a transformer 521 | -- stack over a base monad @B@ is to write an instance @MonadBaseControl B B@ 522 | -- for the base monad, and @MonadTransControl T@ instances for every transformer 523 | -- @T@. Instances for @'MonadBaseControl'@ are then simply implemented using 524 | -- @'ComposeSt'@, @'defaultLiftBaseWith'@, @'defaultRestoreM'@. 525 | class MonadBase b m => MonadBaseControl b m | m -> b where 526 | -- | Monadic state that @m@ adds to the base monad @b@. 527 | -- 528 | -- For all base (non-transformed) monads, @StM m a ~ a@: 529 | -- 530 | -- @ 531 | -- StM 'IO' a ~ a 532 | -- StM 'Maybe' a ~ a 533 | -- StM ('Either' e) a ~ a 534 | -- StM [] a ~ a 535 | -- StM ((->) r) a ~ a 536 | -- StM 'Identity' a ~ a 537 | -- StM 'STM' a ~ a 538 | -- StM ('ST' s) a ~ a 539 | -- @ 540 | -- 541 | -- If @m@ is a transformed monad, @m ~ t b@, @'StM'@ is the monadic state of 542 | -- the transformer @t@ (given by its 'StT' from 'MonadTransControl'). For a 543 | -- transformer stack, @'StM'@ is defined recursively: 544 | -- 545 | -- @ 546 | -- StM ('IdentityT' m) a ~ 'ComposeSt' 'IdentityT' m a ~ StM m a 547 | -- StM ('MaybeT' m) a ~ 'ComposeSt' 'MaybeT' m a ~ StM m ('Maybe' a) 548 | -- StM ('ErrorT' e m) a ~ 'ComposeSt' 'ErrorT' m a ~ 'Error' e => StM m ('Either' e a) 549 | -- StM ('ExceptT' e m) a ~ 'ComposeSt' 'ExceptT' m a ~ StM m ('Either' e a) 550 | -- StM ('ListT' m) a ~ 'ComposeSt' 'ListT' m a ~ StM m [a] 551 | -- StM ('ReaderT' r m) a ~ 'ComposeSt' 'ReaderT' m a ~ StM m a 552 | -- StM ('StateT' s m) a ~ 'ComposeSt' 'StateT' m a ~ StM m (a, s) 553 | -- StM ('WriterT' w m) a ~ 'ComposeSt' 'WriterT' m a ~ 'Monoid' w => StM m (a, w) 554 | -- StM ('RWST' r w s m) a ~ 'ComposeSt' 'RWST' m a ~ 'Monoid' w => StM m (a, s, w) 555 | -- @ 556 | type StM m a :: * 557 | 558 | -- | @liftBaseWith@ is similar to 'liftIO' and 'liftBase' in that it 559 | -- lifts a base computation to the constructed monad. 560 | -- 561 | -- Instances should satisfy similar laws as the 'MonadIO' and 'MonadBase' laws: 562 | -- 563 | -- @liftBaseWith (\\_ -> return a) = return a@ 564 | -- 565 | -- @liftBaseWith (\\_ -> m >>= f) = liftBaseWith (\\_ -> m) >>= (\\a -> liftBaseWith (\\_ -> f a))@ 566 | -- 567 | -- As , parametricity 568 | -- guarantees that 569 | -- 570 | -- @f <$> liftBaseWith q = liftBaseWith $ \runInBase -> f <$> q runInBase@ 571 | -- 572 | -- The difference with 'liftBase' is that before lifting the base computation 573 | -- @liftBaseWith@ captures the state of @m@. It then provides the base 574 | -- computation with a 'RunInBase' function that allows running @m@ 575 | -- computations in the base monad on the captured state: 576 | -- 577 | -- @ 578 | -- withFileLifted :: MonadBaseControl IO m => FilePath -> IOMode -> (Handle -> m a) -> m a 579 | -- withFileLifted file mode action = liftBaseWith (\\runInBase -> withFile file mode (runInBase . action)) >>= restoreM 580 | -- -- = control $ \\runInBase -> withFile file mode (runInBase . action) 581 | -- -- = liftBaseOp (withFile file mode) action 582 | -- @ 583 | -- 584 | -- @'liftBaseWith'@ is usually not implemented directly, but using 585 | -- @'defaultLiftBaseWith'@. 586 | liftBaseWith :: (RunInBase m b -> b a) -> m a 587 | 588 | -- | Construct a @m@ computation from the monadic state of @m@ that is 589 | -- returned from a 'RunInBase' function. 590 | -- 591 | -- Instances should satisfy: 592 | -- 593 | -- @liftBaseWith (\\runInBase -> runInBase m) >>= restoreM = m@ 594 | -- 595 | -- @'restoreM'@ is usually not implemented directly, but using 596 | -- @'defaultRestoreM'@. 597 | restoreM :: StM m a -> m a 598 | 599 | -- | A function that runs a @m@ computation on the monadic state that was 600 | -- captured by 'liftBaseWith' 601 | -- 602 | -- A @RunInBase m@ function yields a computation in the base monad of @m@ that 603 | -- returns the monadic state of @m@. This state can later be used to restore the 604 | -- @m@ computation using 'restoreM'. 605 | -- 606 | -- Example type equalities: 607 | -- 608 | -- @ 609 | -- RunInBase ('IdentityT' m) b ~ forall a. 'IdentityT' m a -> b ('StM' m a) 610 | -- RunInBase ('MaybeT' m) b ~ forall a. 'MaybeT' m a -> b ('StM' m ('Maybe' a)) 611 | -- RunInBase ('ErrorT' e m) b ~ forall a. 'Error' e => 'ErrorT' e m a -> b ('StM' m ('Either' e a)) 612 | -- RunInBase ('ExceptT' e m) b ~ forall a. 'ExceptT' e m a -> b ('StM' m ('Either' e a)) 613 | -- RunInBase ('ListT' m) b ~ forall a. 'ListT' m a -> b ('StM' m [a]) 614 | -- RunInBase ('ReaderT' r m) b ~ forall a. 'ReaderT' m a -> b ('StM' m a) 615 | -- RunInBase ('StateT' s m) b ~ forall a. 'StateT' s m a -> b ('StM' m (a, s)) 616 | -- RunInBase ('WriterT' w m) b ~ forall a. 'Monoid' w => 'WriterT' w m a -> b ('StM' m (a, w)) 617 | -- RunInBase ('RWST' r w s m) b ~ forall a. 'Monoid' w => 'RWST' r w s m a -> b ('StM' m (a, s, w)) 618 | -- @ 619 | -- 620 | -- For a transformed base monad @m ~ t b@, @'RunInBase m b' ~ 'Run' t@. 621 | type RunInBase m b = forall a. m a -> b (StM m a) 622 | 623 | 624 | -------------------------------------------------------------------------------- 625 | -- MonadBaseControl instances for all monads in the base library 626 | -------------------------------------------------------------------------------- 627 | 628 | #define BASE(M) \ 629 | instance MonadBaseControl (M) (M) where { \ 630 | type StM (M) a = a; \ 631 | liftBaseWith f = f id; \ 632 | restoreM = return; \ 633 | {-# INLINABLE liftBaseWith #-}; \ 634 | {-# INLINABLE restoreM #-}} 635 | 636 | BASE(IO) 637 | BASE(Maybe) 638 | BASE(Either e) 639 | BASE([]) 640 | BASE((->) r) 641 | BASE(Identity) 642 | 643 | BASE(STM) 644 | 645 | BASE(Strict.ST s) 646 | BASE( ST s) 647 | 648 | #undef BASE 649 | 650 | 651 | -------------------------------------------------------------------------------- 652 | -- Defaults for MonadBaseControl 653 | -------------------------------------------------------------------------------- 654 | 655 | -- $MonadBaseControlDefaults 656 | -- 657 | -- Note that by using the following default definitions it's easy to make a 658 | -- monad transformer @T@ an instance of 'MonadBaseControl': 659 | -- 660 | -- @ 661 | -- instance MonadBaseControl b m => MonadBaseControl b (T m) where 662 | -- type StM (T m) a = 'ComposeSt' T m a 663 | -- liftBaseWith = 'defaultLiftBaseWith' 664 | -- restoreM = 'defaultRestoreM' 665 | -- @ 666 | -- 667 | -- Defining an instance for a base monad @B@ is equally straightforward: 668 | -- 669 | -- @ 670 | -- instance MonadBaseControl B B where 671 | -- type StM B a = a 672 | -- liftBaseWith f = f 'id' 673 | -- restoreM = 'return' 674 | -- @ 675 | 676 | -- | Handy type synonym that composes the monadic states of @t@ and @m@. 677 | -- 678 | -- It can be used to define the 'StM' for new 'MonadBaseControl' instances. 679 | type ComposeSt t m a = StM m (StT t a) 680 | 681 | -- | A function like 'RunInBase' that runs a monad transformer @t@ in its base 682 | -- monad @b@. It is used in 'defaultLiftBaseWith'. 683 | type RunInBaseDefault t m b = forall a. t m a -> b (ComposeSt t m a) 684 | 685 | -- | Default definition for the 'liftBaseWith' method. 686 | -- 687 | -- Note that it composes a 'liftWith' of @t@ with a 'liftBaseWith' of @m@ to 688 | -- give a 'liftBaseWith' of @t m@: 689 | -- 690 | -- @ 691 | -- defaultLiftBaseWith = \\f -> 'liftWith' $ \\run -> 692 | -- 'liftBaseWith' $ \\runInBase -> 693 | -- f $ runInBase . run 694 | -- @ 695 | defaultLiftBaseWith :: (MonadTransControl t, MonadBaseControl b m) 696 | => (RunInBaseDefault t m b -> b a) -> t m a 697 | defaultLiftBaseWith = \f -> liftWith $ \run -> 698 | liftBaseWith $ \runInBase -> 699 | f $ runInBase . run 700 | {-# INLINABLE defaultLiftBaseWith #-} 701 | 702 | -- | Default definition for the 'restoreM' method. 703 | -- 704 | -- Note that: @defaultRestoreM = 'restoreT' . 'restoreM'@ 705 | defaultRestoreM :: (MonadTransControl t, MonadBaseControl b m) 706 | => ComposeSt t m a -> t m a 707 | defaultRestoreM = restoreT . restoreM 708 | {-# INLINABLE defaultRestoreM #-} 709 | 710 | 711 | -------------------------------------------------------------------------------- 712 | -- MonadBaseControl transformer instances 713 | -------------------------------------------------------------------------------- 714 | 715 | #define BODY(T) { \ 716 | type StM (T m) a = ComposeSt (T) m a; \ 717 | liftBaseWith = defaultLiftBaseWith; \ 718 | restoreM = defaultRestoreM; \ 719 | {-# INLINABLE liftBaseWith #-}; \ 720 | {-# INLINABLE restoreM #-}} 721 | 722 | #define TRANS( T) \ 723 | instance ( MonadBaseControl b m) => MonadBaseControl b (T m) where BODY(T) 724 | #define TRANS_CTX(CTX, T) \ 725 | instance (CTX, MonadBaseControl b m) => MonadBaseControl b (T m) where BODY(T) 726 | 727 | TRANS(IdentityT) 728 | TRANS(MaybeT) 729 | TRANS(ReaderT r) 730 | TRANS(Strict.StateT s) 731 | TRANS( StateT s) 732 | TRANS(ExceptT e) 733 | 734 | TRANS_CTX(Monoid w, Strict.WriterT w) 735 | TRANS_CTX(Monoid w, WriterT w) 736 | TRANS_CTX(Monoid w, Strict.RWST r w s) 737 | TRANS_CTX(Monoid w, RWST r w s) 738 | TRANS_CTX(Monoid w, AccumT w) 739 | 740 | #if !(MIN_VERSION_transformers(0,6,0)) 741 | TRANS(ListT) 742 | TRANS_CTX(Error e, ErrorT e) 743 | #endif 744 | 745 | #undef BODY 746 | #undef TRANS 747 | #undef TRANS_CTX 748 | 749 | -------------------------------------------------------------------------------- 750 | -- * Utility functions 751 | -------------------------------------------------------------------------------- 752 | 753 | -- | An often used composition: @control f = 'liftBaseWith' f >>= 'restoreM'@ 754 | -- 755 | -- Example: 756 | -- 757 | -- @ 758 | -- liftedBracket :: MonadBaseControl IO m => m a -> (a -> m b) -> (a -> m c) -> m c 759 | -- liftedBracket acquire release action = control $ \\runInBase -> 760 | -- bracket (runInBase acquire) 761 | -- (\\saved -> runInBase (restoreM saved >>= release)) 762 | -- (\\saved -> runInBase (restoreM saved >>= action)) 763 | -- @ 764 | control :: MonadBaseControl b m => (RunInBase m b -> b (StM m a)) -> m a 765 | control f = liftBaseWith f >>= restoreM 766 | {-# INLINABLE control #-} 767 | 768 | -- | Lift a computation and restore the monadic state immediately: 769 | -- @controlT f = 'liftWith' f >>= 'restoreT' . return@. 770 | controlT :: (MonadTransControl t, Monad (t m), Monad m) 771 | => (Run t -> m (StT t a)) -> t m a 772 | controlT f = liftWith f >>= restoreT . return 773 | {-# INLINABLE controlT #-} 774 | 775 | -- | Embed a transformer function as an function in the base monad returning a 776 | -- mutated transformer state. 777 | embed :: MonadBaseControl b m => (a -> m c) -> m (a -> b (StM m c)) 778 | embed f = liftBaseWith $ \runInBase -> return (runInBase . f) 779 | {-# INLINABLE embed #-} 780 | 781 | -- | Performs the same function as 'embed', but discards transformer state 782 | -- from the embedded function. 783 | embed_ :: MonadBaseControl b m => (a -> m ()) -> m (a -> b ()) 784 | embed_ f = liftBaseWith $ \runInBase -> return (void . runInBase . f) 785 | {-# INLINABLE embed_ #-} 786 | 787 | -- | Capture the current state of a transformer 788 | captureT :: (MonadTransControl t, Monad (t m), Monad m) => t m (StT t ()) 789 | captureT = liftWith $ \runInM -> runInM (return ()) 790 | {-# INLINABLE captureT #-} 791 | 792 | -- | Capture the current state above the base monad 793 | captureM :: MonadBaseControl b m => m (StM m ()) 794 | captureM = liftBaseWith $ \runInBase -> runInBase (return ()) 795 | {-# INLINABLE captureM #-} 796 | 797 | -- | @liftBaseOp@ is a particular application of 'liftBaseWith' that allows 798 | -- lifting control operations of type: 799 | -- 800 | -- @((a -> b c) -> b c)@ 801 | -- 802 | -- to: 803 | -- 804 | -- @('MonadBaseControl' b m => (a -> m c) -> m c)@ 805 | -- 806 | -- For example: 807 | -- 808 | -- @liftBaseOp alloca :: (Storable a, 'MonadBaseControl' 'IO' m) => (Ptr a -> m c) -> m c@ 809 | liftBaseOp :: MonadBaseControl b m 810 | => ((a -> b (StM m c)) -> b (StM m d)) 811 | -> ((a -> m c) -> m d) 812 | liftBaseOp f = \g -> control $ \runInBase -> f $ runInBase . g 813 | {-# INLINABLE liftBaseOp #-} 814 | 815 | -- | @liftBaseOp_@ is a particular application of 'liftBaseWith' that allows 816 | -- lifting control operations of type: 817 | -- 818 | -- @(b a -> b a)@ 819 | -- 820 | -- to: 821 | -- 822 | -- @('MonadBaseControl' b m => m a -> m a)@ 823 | -- 824 | -- For example: 825 | -- 826 | -- @liftBaseOp_ mask_ :: 'MonadBaseControl' 'IO' m => m a -> m a@ 827 | liftBaseOp_ :: MonadBaseControl b m 828 | => (b (StM m a) -> b (StM m c)) 829 | -> ( m a -> m c) 830 | liftBaseOp_ f = \m -> control $ \runInBase -> f $ runInBase m 831 | {-# INLINABLE liftBaseOp_ #-} 832 | 833 | -- | @liftBaseDiscard@ is a particular application of 'liftBaseWith' that allows 834 | -- lifting control operations of type: 835 | -- 836 | -- @(b () -> b a)@ 837 | -- 838 | -- to: 839 | -- 840 | -- @('MonadBaseControl' b m => m () -> m a)@ 841 | -- 842 | -- Note that, while the argument computation @m ()@ has access to the captured 843 | -- state, all its side-effects in @m@ are discarded. It is run only for its 844 | -- side-effects in the base monad @b@. 845 | -- 846 | -- For example: 847 | -- 848 | -- @liftBaseDiscard forkIO :: 'MonadBaseControl' 'IO' m => m () -> m ThreadId@ 849 | liftBaseDiscard :: MonadBaseControl b m => (b () -> b a) -> (m () -> m a) 850 | liftBaseDiscard f = \m -> liftBaseWith $ \runInBase -> f $ void $ runInBase m 851 | {-# INLINABLE liftBaseDiscard #-} 852 | 853 | -- | @liftBaseOpDiscard@ is a particular application of 'liftBaseWith' that allows 854 | -- lifting control operations of type: 855 | -- 856 | -- @((a -> b ()) -> b c)@ 857 | -- 858 | -- to: 859 | -- 860 | -- @('MonadBaseControl' b m => (a -> m ()) -> m c)@ 861 | -- 862 | -- Note that, while the argument computation @m ()@ has access to the captured 863 | -- state, all its side-effects in @m@ are discarded. It is run only for its 864 | -- side-effects in the base monad @b@. 865 | -- 866 | -- For example: 867 | -- 868 | -- @liftBaseDiscard (runServer addr port) :: 'MonadBaseControl' 'IO' m => m () -> m ()@ 869 | liftBaseOpDiscard :: MonadBaseControl b m 870 | => ((a -> b ()) -> b c) 871 | -> (a -> m ()) -> m c 872 | liftBaseOpDiscard f g = liftBaseWith $ \runInBase -> f $ void . runInBase . g 873 | {-# INLINABLE liftBaseOpDiscard #-} 874 | 875 | -- | Transform an action in @t m@ using a transformer that operates on the underlying monad @m@ 876 | liftThrough 877 | :: (MonadTransControl t, Monad (t m), Monad m) 878 | => (m (StT t a) -> m (StT t b)) -- ^ 879 | -> t m a -> t m b 880 | liftThrough f t = do 881 | st <- liftWith $ \run -> do 882 | f $ run t 883 | restoreT $ return st 884 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | # This file was automatically generated by 'stack init' 2 | # 3 | # Some commonly used options have been documented as comments in this file. 4 | # For advanced use and comprehensive documentation of the format, please see: 5 | # http://docs.haskellstack.org/en/stable/yaml_configuration/ 6 | 7 | # Resolver to choose a 'specific' stackage snapshot or a compiler version. 8 | # A snapshot resolver dictates the compiler version and the set of packages 9 | # to be used for project dependencies. For example: 10 | # 11 | # resolver: lts-3.5 12 | # resolver: nightly-2015-09-21 13 | # resolver: ghc-7.10.2 14 | # resolver: ghcjs-0.1.0_ghc-7.10.2 15 | # resolver: 16 | # name: custom-snapshot 17 | # location: "./custom-snapshot.yaml" 18 | resolver: lts-9.0 19 | 20 | # User packages to be built. 21 | # Various formats can be used as shown in the example below. 22 | # 23 | # packages: 24 | # - some-directory 25 | # - https://example.com/foo/bar/baz-0.0.2.tar.gz 26 | # - location: 27 | # git: https://github.com/commercialhaskell/stack.git 28 | # commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a 29 | # - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a 30 | # extra-dep: true 31 | # subdirs: 32 | # - auto-update 33 | # - wai 34 | # 35 | # A package marked 'extra-dep: true' will only be built if demanded by a 36 | # non-dependency (i.e. a user package), and its test suites and benchmarks 37 | # will not be run. This is useful for tweaking upstream packages. 38 | packages: 39 | - '.' 40 | # Dependency packages to be pulled from upstream that are not in the resolver 41 | # (e.g., acme-missiles-0.3) 42 | extra-deps: [] 43 | 44 | # Override default flag values for local packages and extra-deps 45 | flags: {} 46 | 47 | # Extra package databases containing global packages 48 | extra-package-dbs: [] 49 | 50 | # Control whether we use the GHC we find on the path 51 | # system-ghc: true 52 | # 53 | # Require a specific version of stack, using version ranges 54 | # require-stack-version: -any # Default 55 | # require-stack-version: ">=1.3" 56 | # 57 | # Override the architecture used by stack, especially useful on Windows 58 | # arch: i386 59 | # arch: x86_64 60 | # 61 | # Extra directories used by stack for building 62 | # extra-include-dirs: [/path/to/dir] 63 | # extra-lib-dirs: [/path/to/dir] 64 | # 65 | # Allow a newer minor version of GHC than the snapshot specifies 66 | # compiler-check: newer-minor --------------------------------------------------------------------------------