├── .github └── workflows │ └── haskell.yml ├── .travis.yml ├── LICENSE ├── README.md ├── Setup.hs ├── changelog.md ├── configurations ├── ghc-8.10.project ├── ghc-9.0.project └── ghc-9.2.project ├── default.nix ├── pipes-safe.cabal ├── release.nix ├── shell.nix ├── src └── Pipes │ ├── Safe.hs │ └── Safe │ └── Prelude.hs └── stack.yaml /.github/workflows/haskell.yml: -------------------------------------------------------------------------------- 1 | on: 2 | push: 3 | branches: [ main ] 4 | pull_request: 5 | branches: [ main ] 6 | 7 | name: Haskell CI 8 | 9 | jobs: 10 | build: 11 | name: Test 12 | runs-on: ubuntu-latest 13 | 14 | strategy: 15 | matrix: 16 | ghc: ['8.10', '9.0', '9.2'] 17 | 18 | steps: 19 | - uses: actions/checkout@v2 20 | - uses: haskell/actions/setup@v1.2 21 | with: 22 | ghc-version: ${{ matrix.ghc }} 23 | - name: Cache 24 | uses: actions/cache@v1 25 | env: 26 | cache-name: cache-cabal 27 | with: 28 | path: ~/.cabal 29 | key: ${{ runner.os }}-build-${{ env.cache-name }}-${{ hashFiles('**/*.cabal') }}-${{ hashFiles('**/cabal.project') }} 30 | restore-keys: | 31 | ${{ runner.os }}-build-${{ env.cache-name }}- 32 | ${{ runner.os }}-build- 33 | ${{ runner.os }}- 34 | - name: Install dependencies 35 | run: | 36 | cabal update 37 | cabal build --only-dependencies --enable-tests --enable-benchmarks --project-file ./configurations/ghc-${{ matrix.ghc }}.project 38 | - name: Build 39 | run: cabal build --enable-tests --enable-benchmarks all --project-file ./configurations/ghc-${{ matrix.ghc }}.project 40 | - name: Run tests 41 | run: cabal test all --project-file ./configurations/ghc-${{ matrix.ghc }}.project 42 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | # This Travis job script has been generated by a script via 2 | # 3 | # runghc make_travis_yml_2.hs 'pipes-safe.cabal' 4 | # 5 | # For more information, see https://github.com/hvr/multi-ghc-travis 6 | # 7 | language: c 8 | sudo: false 9 | 10 | git: 11 | submodules: false # whether to recursively clone submodules 12 | 13 | cache: 14 | directories: 15 | - $HOME/.cabal/packages 16 | - $HOME/.cabal/store 17 | 18 | before_cache: 19 | - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log 20 | # remove files that are regenerated by 'cabal update' 21 | - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.* 22 | - rm -fv $HOME/.cabal/packages/hackage.haskell.org/*.json 23 | - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.cache 24 | - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar 25 | - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar.idx 26 | 27 | - rm -rfv $HOME/.cabal/packages/head.hackage 28 | 29 | matrix: 30 | include: 31 | - compiler: "ghc-8.6.1" 32 | # env: TEST=--disable-tests BENCH=--disable-benchmarks 33 | addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-8.6.1], sources: [hvr-ghc]}} 34 | - compiler: "ghc-8.4.3" 35 | # env: TEST=--disable-tests BENCH=--disable-benchmarks 36 | addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-8.4.3], sources: [hvr-ghc]}} 37 | - compiler: "ghc-8.2.2" 38 | # env: TEST=--disable-tests BENCH=--disable-benchmarks 39 | addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-8.2.2], sources: [hvr-ghc]}} 40 | - compiler: "ghc-8.0.2" 41 | # env: TEST=--disable-tests BENCH=--disable-benchmarks 42 | addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-8.0.2], sources: [hvr-ghc]}} 43 | - compiler: "ghc-7.10.3" 44 | # env: TEST=--disable-tests BENCH=--disable-benchmarks 45 | addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-7.10.3], sources: [hvr-ghc]}} 46 | 47 | before_install: 48 | - HC=${CC} 49 | - HCPKG=${HC/ghc/ghc-pkg} 50 | - unset CC 51 | - ROOTDIR=$(pwd) 52 | - mkdir -p $HOME/.local/bin 53 | - "PATH=/opt/ghc/bin:/opt/ghc-ppa-tools/bin:$HOME/local/bin:$PATH" 54 | - HCNUMVER=$(( $(${HC} --numeric-version|sed -E 's/([0-9]+)\.([0-9]+)\.([0-9]+).*/\1 * 10000 + \2 * 100 + \3/') )) 55 | - echo $HCNUMVER 56 | 57 | install: 58 | - cabal --version 59 | - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]" 60 | - BENCH=${BENCH---enable-benchmarks} 61 | - TEST=${TEST---enable-tests} 62 | - HADDOCK=${HADDOCK-true} 63 | - UNCONSTRAINED=${UNCONSTRAINED-true} 64 | - NOINSTALLEDCONSTRAINTS=${NOINSTALLEDCONSTRAINTS-false} 65 | - GHCHEAD=${GHCHEAD-false} 66 | - travis_retry cabal update -v 67 | - "sed -i.bak 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config" 68 | - rm -fv cabal.project cabal.project.local 69 | - grep -Ev -- '^\s*--' ${HOME}/.cabal/config | grep -Ev '^\s*$' 70 | - "printf 'packages: \".\"\\n' > cabal.project" 71 | - touch cabal.project.local 72 | - "if ! $NOINSTALLEDCONSTRAINTS; then for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/^/constraints: /' | sed 's/-[^-]*$/ installed/' >> cabal.project.local; done; fi" 73 | - cat cabal.project || true 74 | - cat cabal.project.local || true 75 | - if [ -f "./configure.ac" ]; then 76 | (cd "." && autoreconf -i); 77 | fi 78 | - rm -f cabal.project.freeze 79 | - cabal new-build -w ${HC} ${TEST} ${BENCH} --project-file="cabal.project" --dep -j2 all 80 | - cabal new-build -w ${HC} --disable-tests --disable-benchmarks --project-file="cabal.project" --dep -j2 all 81 | - rm -rf .ghc.environment.* "."/dist 82 | - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX) 83 | 84 | # Here starts the actual work to be performed for the package under test; 85 | # any command which exits with a non-zero exit code causes the build to fail. 86 | script: 87 | # test that source-distributions can be generated 88 | - (cd "." && cabal sdist) 89 | - mv "."/dist/pipes-safe-*.tar.gz ${DISTDIR}/ 90 | - cd ${DISTDIR} || false 91 | - find . -maxdepth 1 -name '*.tar.gz' -exec tar -xvf '{}' \; 92 | - "printf 'packages: pipes-safe-*/*.cabal\\n' > cabal.project" 93 | - touch cabal.project.local 94 | - "if ! $NOINSTALLEDCONSTRAINTS; then for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/^/constraints: /' | sed 's/-[^-]*$/ installed/' >> cabal.project.local; done; fi" 95 | - cat cabal.project || true 96 | - cat cabal.project.local || true 97 | # this builds all libraries and executables (without tests/benchmarks) 98 | - cabal new-build -w ${HC} --disable-tests --disable-benchmarks all 99 | 100 | # build & run tests, build benchmarks 101 | - cabal new-build -w ${HC} ${TEST} ${BENCH} all 102 | 103 | # cabal check 104 | - (cd pipes-safe-* && cabal check) 105 | 106 | # haddock 107 | - rm -rf ./dist-newstyle 108 | - if $HADDOCK; then cabal new-haddock -w ${HC} ${TEST} ${BENCH} all; else echo "Skipping haddock generation";fi 109 | 110 | # Build without installed constraints for packages in global-db 111 | - if $UNCONSTRAINED; then rm -f cabal.project.local; echo cabal new-build -w ${HC} --disable-tests --disable-benchmarks all; else echo "Not building without installed constraints"; fi 112 | 113 | # REGENDATA ["pipes-safe.cabal"] 114 | # EOF 115 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2013, 2014 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 | * Redistributions of source code must retain the above copyright notice, 7 | this list of conditions and the following disclaimer. 8 | * Redistributions in binary form must reproduce the above copyright notice, 9 | this list of conditions and the following disclaimer in the documentation 10 | and/or other materials provided with the distribution. 11 | * Neither the name of Gabriella Gonzalez nor the names of other contributors 12 | may be used to endorse or promote products derived from this software 13 | without specific prior written permission. 14 | 15 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 16 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 17 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 18 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR 19 | ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES 20 | (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 21 | LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON 22 | ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 23 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 24 | SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Pipes-Safe 2 | 3 | `pipes-safe` builds upon 4 | [the `pipes` library](https://github.com/Gabriella439/Haskell-Pipes-Library) to 5 | provide exception safety and resource management. 6 | 7 | ## Quick start 8 | 9 | * Install the [Haskell Platform](http://www.haskell.org/platform/) 10 | * `cabal install pipes-safe` 11 | 12 | The official tutorial is on 13 | [Hackage](http://hackage.haskell.org/package/pipes-safe). 14 | 15 | ## Features 16 | 17 | * *Resource Safety*: Guarantee finalization using `finally`, `bracket`, and more 18 | 19 | * *Exception Safety*: Even against asynchronous exceptions! 20 | 21 | * *Laziness*: Only acquire resources when you need them 22 | 23 | * *Promptness*: Finalize resources early when you are done with them 24 | 25 | * *Native Exception Handling*: Catch and resume from exceptions inside pipes 26 | 27 | * *No Buy-in*: Mix resource-safe pipes with unmanaged pipes using `hoist` 28 | 29 | ## Outline 30 | 31 | Use `pipes-safe` for production code where you need deterministic and prompt 32 | release of resources in the fact of exceptions or premature pipe termination. 33 | `pipes-safe` lets you safely acquire resources and handle exceptions within 34 | pipelines. 35 | 36 | ## Development Status 37 | 38 | `pipes-safe` is mostly stable. Research into prompter finalization alternatives 39 | will take place in a separate library. 40 | 41 | ## Community Resources 42 | 43 | Use the same resources as the core `pipes` library to learn more, contribute, or 44 | request help: 45 | 46 | * [Haskell wiki page](http://www.haskell.org/haskellwiki/Pipes) 47 | 48 | * [Mailing list](mailto:haskell-pipes@googlegroups.com) ([Google Group](https://groups.google.com/forum/?fromgroups#!forum/haskell-pipes)) 49 | 50 | ## How to contribute 51 | 52 | * Build derived libraries 53 | 54 | * Write `pipes-safe` tutorials 55 | 56 | ## License (BSD 3-clause) 57 | 58 | Copyright (c) 2013 Gabriella Gonzalez 59 | All rights reserved. 60 | 61 | Redistribution and use in source and binary forms, with or without modification, 62 | are permitted provided that the following conditions are met: 63 | 64 | * Redistributions of source code must retain the above copyright notice, this 65 | list of conditions and the following disclaimer. 66 | 67 | * Redistributions in binary form must reproduce the above copyright notice, this 68 | list of conditions and the following disclaimer in the documentation and/or 69 | other materials provided with the distribution. 70 | 71 | * Neither the name of Gabriella Gonzalez nor the names of other contributors may 72 | be used to endorse or promote products derived from this software without 73 | specific prior written permission. 74 | 75 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 76 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 77 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 78 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR 79 | ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES 80 | (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 81 | LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON 82 | ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 83 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 84 | SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 85 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /changelog.md: -------------------------------------------------------------------------------- 1 | # Version 2 | 3 | * Export `SafeT` constructor 4 | * Export `MonadReader` instance for `SafeT` 5 | 6 | # Version 2.3.1 7 | 8 | * Remove `MonadFail` constraints introduced in version 2.3.0 9 | * Implement `MonadFail` for `SafeT` 10 | 11 | # Version 2.3.0 12 | 13 | * BREAKING CHANGE: Support GHC 8.6.1 14 | * This requires adding a `MonadFail` constraints to certain utilities 15 | 16 | # Version 2.2.9 17 | 18 | * Fix build against older versions of `exceptions` 19 | 20 | # Version 2.2.8 21 | 22 | * Increase upper bound on `exceptions` 23 | 24 | # Version 2.2.7 25 | 26 | * Increase upper bound on `exceptions` 27 | 28 | # Version 2.2.6 29 | 30 | * Add `PrimMonad` instance for `SafeT` 31 | 32 | # Version 2.2.5 33 | 34 | * Add `tryP` and `catchP` 35 | * `MonadThrow` and `MonadCatch` instances for `Proxy` upstreamed to `pipes` 36 | 37 | # Version 2.2.4 38 | 39 | * Increase upper bound on `pipes` 40 | 41 | # Version 2.2.3 42 | 43 | * Add several new instances to `SafeT` 44 | * Add `tryP` and `catchP` 45 | 46 | # Version 2.2.2 47 | 48 | * Raise upper-bound on `exceptions` dependency 49 | 50 | # Version 2.2.1 51 | 52 | * Raise upper-bound on `exceptions` dependency. 53 | -------------------------------------------------------------------------------- /configurations/ghc-8.10.project: -------------------------------------------------------------------------------- 1 | packages: ./pipes-safe.cabal 2 | 3 | constraints: 4 | base == 4.14.* 5 | , containers == 0.6.2.1 6 | , exceptions == 0.10.4 7 | , mtl == 2.2.2 8 | , transformers == 0.5.6.2 9 | , transformers-base == 0.4.4 10 | , monad-control == 1.0.0.4 11 | , primitive == 0.7.0.0 12 | , pipes == 4.3.10 13 | -------------------------------------------------------------------------------- /configurations/ghc-9.0.project: -------------------------------------------------------------------------------- 1 | packages: ./pipes-safe.cabal 2 | 3 | constraints: 4 | base == 4.15.* 5 | -------------------------------------------------------------------------------- /configurations/ghc-9.2.project: -------------------------------------------------------------------------------- 1 | packages: ./pipes-safe.cabal 2 | 3 | constraints: 4 | base == 4.16.* 5 | -------------------------------------------------------------------------------- /default.nix: -------------------------------------------------------------------------------- 1 | { mkDerivation, base, containers, exceptions, lib, monad-control 2 | , mtl, pipes, primitive, transformers, transformers-base 3 | }: 4 | mkDerivation { 5 | pname = "pipes-safe"; 6 | version = "2.3.4"; 7 | src = ./.; 8 | libraryHaskellDepends = [ 9 | base containers exceptions monad-control mtl pipes primitive 10 | transformers transformers-base 11 | ]; 12 | description = "Safety for the pipes ecosystem"; 13 | license = lib.licenses.bsd3; 14 | } 15 | -------------------------------------------------------------------------------- /pipes-safe.cabal: -------------------------------------------------------------------------------- 1 | Name: pipes-safe 2 | Version: 2.3.5 3 | Cabal-Version: >=1.10 4 | Build-Type: Simple 5 | License: BSD3 6 | License-File: LICENSE 7 | Extra-Source-Files: README.md changelog.md 8 | Copyright: 2013, 2014 Gabriella Gonzalez 9 | Author: Gabriella Gonzalez 10 | Maintainer: GenuineGabriella@gmail.com 11 | Tested-With: GHC == 8.10.7, GHC == 9.0.2, GHC == 9.2.1 12 | Bug-Reports: https://github.com/Gabriella439/Haskell-Pipes-Safe-Library/issues 13 | Synopsis: Safety for the pipes ecosystem 14 | Description: 15 | This package adds resource management and exception handling to the @pipes@ 16 | ecosystem. 17 | . 18 | Notable features include: 19 | . 20 | * /Resource Safety/: Guarantee finalization using @finally@, @bracket@ and 21 | more 22 | . 23 | * /Exception Safety/: Even against asynchronous exceptions! 24 | . 25 | * /Laziness/: Only acquire resources when you need them 26 | . 27 | * /Promptness/: Finalize resources early when you are done with them 28 | . 29 | * /Native Exception Handling/: Catch and resume from exceptions inside pipes 30 | . 31 | * /No Buy-in/: Mix resource-safe pipes with unmanaged pipes using @hoist@ 32 | Category: Control, Pipes, Error Handling 33 | Source-Repository head 34 | Type: git 35 | Location: https://github.com/Gabriella439/Haskell-Pipes-Safe-Library 36 | 37 | Library 38 | Build-Depends: 39 | base >= 4.14 && < 4.21, 40 | containers >= 0.6.2.1 && < 0.8 , 41 | exceptions >= 0.10.4 && < 0.11, 42 | mtl >= 2.2.2 && < 2.4 , 43 | transformers >= 0.5.6.2 && < 0.7 , 44 | transformers-base >= 0.4.4 && < 0.5 , 45 | monad-control >= 1.0.0.4 && < 1.1 , 46 | primitive >= 0.7.0.0 && < 0.10, 47 | pipes >= 4.3.10 && < 4.4 48 | Exposed-Modules: 49 | Pipes.Safe, 50 | Pipes.Safe.Prelude 51 | HS-Source-Dirs: src 52 | GHC-Options: -O2 -Wall 53 | Default-Language: Haskell2010 54 | -------------------------------------------------------------------------------- /release.nix: -------------------------------------------------------------------------------- 1 | # You can build this repository using Nix by running: 2 | # 3 | # $ nix-build 4 | # 5 | # You can also open up this repository inside of a Nix shell by running: 6 | # 7 | # $ nix-shell 8 | # 9 | # ... and then Nix will supply the correct Haskell development environment for 10 | # you 11 | let 12 | config = { 13 | packageOverrides = pkgs: { 14 | haskellPackages = pkgs.haskellPackages.override { 15 | overrides = haskellPackagesNew: haskellPackagesOld: { 16 | pipes-safe = haskellPackagesNew.callPackage ./default.nix { }; 17 | }; 18 | }; 19 | }; 20 | }; 21 | 22 | pkgs = 23 | import { inherit config; }; 24 | 25 | in 26 | { pipes-safe = pkgs.haskellPackages.pipes-safe; 27 | } 28 | -------------------------------------------------------------------------------- /shell.nix: -------------------------------------------------------------------------------- 1 | (import ./release.nix).pipes-safe.env 2 | -------------------------------------------------------------------------------- /src/Pipes/Safe.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE RankNTypes, TypeFamilies, FlexibleContexts, FlexibleInstances, 2 | MultiParamTypeClasses, UndecidableInstances, ScopedTypeVariables, 3 | GeneralizedNewtypeDeriving, Trustworthy #-} 4 | {-# OPTIONS_GHC -fno-warn-orphans #-} 5 | 6 | {-| This module provides an orphan 'MonadMask' instance for 'Proxy' of the 7 | form: 8 | 9 | > instance (MonadMask m, MonadIO m) => MonadMask (Proxy a' a b' b m) where 10 | 11 | Which is needed to implement the instance for MonadSafe for Proxy. 12 | 13 | This module also provides generalized versions of some 'MonadCatch' 14 | operations so that you can also protect against premature termination of 15 | connected components. For example, if you protect a 'readFile' computation 16 | using 'bracket' from this module: 17 | 18 | > -- readFile.hs 19 | > import Pipes 20 | > import qualified Pipes.Prelude as P 21 | > import Pipes.Safe 22 | > import qualified System.IO as IO 23 | > import Prelude hiding (readFile) 24 | > 25 | > readFile :: FilePath -> Producer' String (SafeT IO) () 26 | > readFile file = bracket 27 | > (do h <- IO.openFile file IO.ReadMode 28 | > putStrLn $ "{" ++ file ++ " open}" 29 | > return h ) 30 | > (\h -> do 31 | > IO.hClose h 32 | > putStrLn $ "{" ++ file ++ " closed}" ) 33 | > P.fromHandle 34 | 35 | ... then this generalized 'bracket' will guard against both exceptions and 36 | premature termination of other pipes: 37 | 38 | >>> runSafeT $ runEffect $ readFile "readFile.hs" >-> P.take 4 >-> P.stdoutLn 39 | {readFile.hs open} 40 | -- readFile.hs 41 | import Pipes 42 | import qualified Pipes.Prelude as P 43 | import Pipes.Safe 44 | {readFile.hs closed} 45 | 46 | Note that the 'MonadCatch' instance for 'Proxy' provides weaker versions of 47 | 'mask' and 'uninterruptibleMask' that do not completely prevent asynchronous 48 | exceptions. Instead, they provide a weaker guarantee that asynchronous 49 | exceptions will only occur during 'Pipes.await's or 'Pipes.yield's and 50 | nowhere else. For example, if you write: 51 | 52 | > mask_ $ do 53 | > x <- await 54 | > lift $ print x 55 | > lift $ print x 56 | 57 | ... then you may receive an asynchronous exception during the 'Pipes.await', 58 | but you will not receive an asynchronous exception during or in between the 59 | two 'print' statements. This weaker guarantee suffices to provide 60 | asynchronous exception safety. 61 | -} 62 | 63 | module Pipes.Safe 64 | ( -- * SafeT 65 | SafeT(SafeT) 66 | , runSafeT 67 | , runSafeP 68 | 69 | -- * MonadSafe 70 | , ReleaseKey 71 | , MonadSafe(..) 72 | 73 | -- * Utilities 74 | -- $utilities 75 | , onException 76 | , tryP 77 | , catchP 78 | , finally 79 | , bracket 80 | , bracket_ 81 | , bracketOnError 82 | 83 | -- * Internals 84 | , Env 85 | 86 | -- * Re-exports 87 | -- $reexports 88 | , module Control.Monad.Catch 89 | , module Control.Exception 90 | ) where 91 | 92 | import Control.Applicative (Alternative) 93 | import Control.Exception(Exception(..), SomeException(..)) 94 | import qualified Control.Monad.Catch as C 95 | import Control.Monad.Catch 96 | ( MonadCatch(..) 97 | , MonadThrow(..) 98 | , MonadMask(..) 99 | , ExitCase(..) 100 | , mask_ 101 | , uninterruptibleMask_ 102 | , catchAll 103 | , catchIOError 104 | , catchJust 105 | , catchIf 106 | , Handler(..) 107 | , catches 108 | , handle 109 | , handleAll 110 | , handleIOError 111 | , handleJust 112 | , handleIf 113 | , tryJust 114 | , Exception(..) 115 | , SomeException 116 | ) 117 | import Control.Monad (MonadPlus, liftM) 118 | import Control.Monad.Fix (MonadFix) 119 | import Control.Monad.IO.Class (MonadIO(liftIO)) 120 | import Control.Monad.Trans.Control (MonadBaseControl(..)) 121 | import Control.Monad.Trans.Class (MonadTrans(lift)) 122 | import qualified Control.Monad.Base as B 123 | import qualified Control.Monad.Catch.Pure as E 124 | import qualified Control.Monad.Trans.Identity as I 125 | import qualified Control.Monad.Cont.Class as CC 126 | import qualified Control.Monad.Error.Class as EC 127 | import qualified Control.Monad.Primitive as Prim 128 | import qualified Control.Monad.Reader.Class as SR 129 | import qualified Control.Monad.Trans.Reader as R 130 | import qualified Control.Monad.Trans.RWS.Lazy as RWS 131 | import qualified Control.Monad.Trans.RWS.Strict as RWS' 132 | import qualified Control.Monad.Trans.State.Lazy as S 133 | import qualified Control.Monad.Trans.State.Strict as S' 134 | import qualified Control.Monad.State.Class as SC 135 | import qualified Control.Monad.Trans.Writer.Lazy as W 136 | import qualified Control.Monad.Trans.Writer.Strict as W' 137 | import qualified Control.Monad.Writer.Class as WC 138 | import Data.IORef (IORef, newIORef, readIORef, writeIORef, atomicModifyIORef') 139 | import Data.Kind (Type) 140 | import qualified Data.Map as M 141 | import Pipes (Proxy, Effect, Effect', runEffect) 142 | import Pipes.Internal (Proxy(..)) 143 | 144 | data Restore m = Unmasked | Masked (forall x . m x -> m x) 145 | 146 | liftMask 147 | :: forall m a' a b' b r . (MonadIO m, MonadCatch m) 148 | => (forall s . ((forall x . m x -> m x) -> m s) -> m s) 149 | -> ((forall x . Proxy a' a b' b m x -> Proxy a' a b' b m x) 150 | -> Proxy a' a b' b m r) 151 | -> Proxy a' a b' b m r 152 | liftMask maskVariant k = do 153 | ioref <- liftIO $ newIORef Unmasked 154 | 155 | let -- mask adjacent actions in base monad 156 | loop :: Proxy a' a b' b m r -> Proxy a' a b' b m r 157 | loop (Request a' fa ) = Request a' (loop . fa ) 158 | loop (Respond b fb') = Respond b (loop . fb') 159 | loop (M m) = M $ maskVariant $ \unmaskVariant -> do 160 | -- stash base's unmask and merge action 161 | liftIO $ writeIORef ioref $ Masked unmaskVariant 162 | m >>= chunk >>= return . loop 163 | loop (Pure r) = Pure r 164 | 165 | -- unmask adjacent actions in base monad 166 | unmask :: forall q. Proxy a' a b' b m q -> Proxy a' a b' b m q 167 | unmask (Request a' fa ) = Request a' (unmask . fa ) 168 | unmask (Respond b fb') = Respond b (unmask . fb') 169 | unmask (M m) = M $ do 170 | -- retrieve base's unmask and apply to merged action 171 | unmaskVariant <- liftIO $ do 172 | Masked unmaskVariant <- readIORef ioref 173 | return unmaskVariant 174 | unmaskVariant (m >>= chunk >>= return . unmask) 175 | unmask (Pure q) = Pure q 176 | 177 | -- merge adjacent actions in base monad 178 | chunk :: forall s. Proxy a' a b' b m s -> m (Proxy a' a b' b m s) 179 | chunk (M m) = m >>= chunk 180 | chunk s = return s 181 | 182 | loop $ k unmask 183 | 184 | instance (MonadMask m, MonadIO m) => MonadMask (Proxy a' a b' b m) where 185 | mask = liftMask mask 186 | 187 | uninterruptibleMask = liftMask uninterruptibleMask 188 | 189 | generalBracket acquire release_ use = mask $ \unmasked -> do 190 | a <- acquire 191 | let action = do 192 | b <- use a 193 | return (ExitCaseSuccess b, ExitCaseSuccess_ b) 194 | let handler e = return (ExitCaseException e, ExitCaseException_ e) 195 | (exitCase, exitCase_) <- unmasked action `catch` handler 196 | c <- release_ a exitCase 197 | case exitCase_ of 198 | ExitCaseException_ e -> throwM e 199 | ExitCaseSuccess_ b -> return (b, c) 200 | 201 | -- | This is to avoid an unnecessary partial pattern match in `generalBracket` 202 | data ExitCase_ a = ExitCaseSuccess_ a | ExitCaseException_ SomeException 203 | 204 | data Finalizers m = Finalizers 205 | { _nextKey :: !Integer 206 | , _finalizers :: !(M.Map Integer (m ())) 207 | } 208 | 209 | -- | Internal 'SafeT' read-write environment. Exported only so that it can be 210 | -- passed around unmodified by users of the v'SafeT' constructor. 211 | -- 212 | -- Warning: Using the 'Env' outside the corresponding 'SafeT' scope will 213 | -- result in undefined behavior. 214 | newtype Env m = Env (IORef (Maybe (Finalizers m))) 215 | 216 | {-| 'SafeT' is a monad transformer that extends the base monad with the ability 217 | to 'register' and 'release' finalizers. 218 | 219 | All unreleased finalizers are called at the end of the 'SafeT' block, even 220 | in the event of exceptions. 221 | -} 222 | newtype SafeT m r 223 | = -- | Constructor exported in case it's necessary for integrating 'SafeT' 224 | -- with other libraries. For example, implementing @mtl@-like 225 | -- Monad/Something/ instances will often require access to the 'SafeT' 226 | -- constructor. 227 | -- 228 | -- Warning: Using the 'Env' outside the corresponding 'SafeT' scope will 229 | -- result in undefined behavior. 230 | SafeT (R.ReaderT (Env m) m r) 231 | deriving 232 | ( Functor 233 | , Applicative 234 | , Alternative 235 | , Monad 236 | -- The derived instance for `MonadFail` requires a `MonadFail` instance for 237 | -- `ReaderT` which is first available in `transformers-0.5.0.0` 238 | , MonadFail 239 | , MonadPlus 240 | , MonadFix 241 | , EC.MonadError e 242 | , SC.MonadState s 243 | , WC.MonadWriter w 244 | , CC.MonadCont 245 | , MonadThrow 246 | , MonadCatch 247 | , MonadMask 248 | , MonadIO 249 | , B.MonadBase b 250 | ) 251 | 252 | instance MonadTrans SafeT where 253 | lift m = SafeT (lift m) 254 | 255 | instance MonadBaseControl b m => MonadBaseControl b (SafeT m) where 256 | type StM (SafeT m) a = StM m a 257 | liftBaseWith f = SafeT $ R.ReaderT $ \reader' -> 258 | liftBaseWith $ \runInBase -> 259 | f $ runInBase . (\(SafeT r) -> R.runReaderT r reader' ) 260 | restoreM = SafeT . R.ReaderT . const . restoreM 261 | 262 | instance Prim.PrimMonad m => Prim.PrimMonad (SafeT m) where 263 | type PrimState (SafeT m) = Prim.PrimState m 264 | primitive = lift . Prim.primitive 265 | {-# INLINE primitive #-} 266 | 267 | instance SR.MonadReader e m => SR.MonadReader e (SafeT m) where 268 | ask = lift SR.ask 269 | local f (SafeT (R.ReaderT g)) = SafeT (R.ReaderT (\e -> SR.local f (g e))) 270 | 271 | {-| Run the 'SafeT' monad transformer, executing all unreleased finalizers at 272 | the end of the computation 273 | -} 274 | runSafeT :: (MonadMask m, MonadIO m) => SafeT m r -> m r 275 | runSafeT (SafeT m) = C.bracket 276 | (liftIO $ newIORef $! Just $! Finalizers 0 M.empty) 277 | (\ioref -> do 278 | mres <- liftIO $ atomicModifyIORef' ioref $ \val -> 279 | (Nothing, val) 280 | case mres of 281 | Nothing -> error "runSafeT's resources were freed by another" 282 | Just (Finalizers _ fs) -> mapM snd (M.toDescList fs) ) 283 | (R.runReaderT m . Env) 284 | {-# INLINABLE runSafeT #-} 285 | 286 | {-| Run 'SafeT' in the base monad, executing all unreleased finalizers at the 287 | end of the computation 288 | 289 | Use 'runSafeP' to safely flush all unreleased finalizers and ensure prompt 290 | finalization without exiting the 'Proxy' monad. 291 | -} 292 | runSafeP :: (MonadMask m, MonadIO m) => Effect (SafeT m) r -> Effect' m r 293 | runSafeP e = lift . runSafeT . runEffect $ e 294 | {-# INLINABLE runSafeP #-} 295 | 296 | -- | Token used to 'release' a previously 'register'ed finalizer 297 | newtype ReleaseKey = ReleaseKey { unlock :: Integer } 298 | 299 | {-| 'MonadSafe' lets you 'register' and 'release' finalizers that execute in a 300 | 'Base' monad 301 | -} 302 | class (MonadCatch m, MonadMask m, MonadIO m, MonadIO (Base m)) => MonadSafe m where 303 | {-| The monad used to run resource management actions, corresponding to the 304 | monad directly beneath 'SafeT' 305 | -} 306 | type Base (m :: Type -> Type) :: Type -> Type 307 | 308 | -- | Lift an action from the 'Base' monad 309 | liftBase :: Base m r -> m r 310 | 311 | {-| 'register' a finalizer, ensuring that the finalizer gets called if the 312 | finalizer is not 'release'd before the end of the surrounding 'SafeT' 313 | block. 314 | -} 315 | register :: Base m () -> m ReleaseKey 316 | 317 | {-| 'release' a registered finalizer 318 | 319 | You can safely call 'release' more than once on the same 'ReleaseKey'. 320 | Every 'release' after the first one does nothing. 321 | -} 322 | release :: ReleaseKey -> m () 323 | 324 | instance (MonadIO m, MonadCatch m, MonadMask m) => MonadSafe (SafeT m) where 325 | type Base (SafeT m) = m 326 | 327 | liftBase = lift 328 | 329 | register io = do 330 | Env ioref <- SafeT R.ask 331 | liftIO $ do 332 | n <- atomicModifyIORef' ioref $ \val -> 333 | case val of 334 | Nothing -> error "register: SafeT block is closed" 335 | Just (Finalizers n fs) -> 336 | (Just $! Finalizers (n + 1) (M.insert n io fs), n) 337 | return (ReleaseKey n) 338 | 339 | release key = do 340 | Env ioref <- SafeT R.ask 341 | liftIO $ atomicModifyIORef' ioref $ \val -> 342 | case val of 343 | Nothing -> error "release: SafeT block is closed" 344 | Just (Finalizers n fs) -> 345 | (Just $! Finalizers n (M.delete (unlock key) fs), ()) 346 | 347 | instance MonadSafe m => MonadSafe (Proxy a' a b' b m) where 348 | type Base (Proxy a' a b' b m) = Base m 349 | liftBase = lift . liftBase 350 | register = lift . register 351 | release = lift . release 352 | 353 | instance (MonadSafe m) => MonadSafe (I.IdentityT m) where 354 | type Base (I.IdentityT m) = Base m 355 | liftBase = lift . liftBase 356 | register = lift . register 357 | release = lift . release 358 | 359 | instance (MonadSafe m) => MonadSafe (E.CatchT m) where 360 | type Base (E.CatchT m) = Base m 361 | liftBase = lift . liftBase 362 | register = lift . register 363 | release = lift . release 364 | 365 | instance (MonadSafe m) => MonadSafe (R.ReaderT i m) where 366 | type Base (R.ReaderT i m) = Base m 367 | liftBase = lift . liftBase 368 | register = lift . register 369 | release = lift . release 370 | 371 | instance (MonadSafe m) => MonadSafe (S.StateT s m) where 372 | type Base (S.StateT s m) = Base m 373 | liftBase = lift . liftBase 374 | register = lift . register 375 | release = lift . release 376 | 377 | instance (MonadSafe m) => MonadSafe (S'.StateT s m) where 378 | type Base (S'.StateT s m) = Base m 379 | liftBase = lift . liftBase 380 | register = lift . register 381 | release = lift . release 382 | 383 | instance (MonadSafe m, Monoid w) => MonadSafe (W.WriterT w m) where 384 | type Base (W.WriterT w m) = Base m 385 | liftBase = lift . liftBase 386 | register = lift . register 387 | release = lift . release 388 | 389 | instance (MonadSafe m, Monoid w) => MonadSafe (W'.WriterT w m) where 390 | type Base (W'.WriterT w m) = Base m 391 | liftBase = lift . liftBase 392 | register = lift . register 393 | release = lift . release 394 | 395 | instance (MonadSafe m, Monoid w) => MonadSafe (RWS.RWST i w s m) where 396 | type Base (RWS.RWST i w s m) = Base m 397 | liftBase = lift . liftBase 398 | register = lift . register 399 | release = lift . release 400 | 401 | instance (MonadSafe m, Monoid w) => MonadSafe (RWS'.RWST i w s m) where 402 | type Base (RWS'.RWST i w s m) = Base m 403 | liftBase = lift . liftBase 404 | register = lift . register 405 | release = lift . release 406 | 407 | {-| Analogous to 'C.onException' from @Control.Monad.Catch@, except this also 408 | protects against premature termination 409 | 410 | @(\`onException\` io)@ is a monad morphism. 411 | -} 412 | onException :: (MonadSafe m) => m a -> Base m b -> m a 413 | m1 `onException` io = do 414 | key <- register (io >> return ()) 415 | r <- m1 416 | release key 417 | return r 418 | {-# INLINABLE onException #-} 419 | 420 | {- $utilities 421 | These utilities let you supply a finalizer that runs in the 'Base' monad 422 | (i.e. the monad directly beneath 'SafeT'). If you don't need to use the 423 | full power of the 'Base' monad and you only need to use to use 'IO', then 424 | just wrap the finalizer in 'liftIO', like this: 425 | 426 | > myAction `finally` (liftIO myFinalizer) 427 | 428 | This will lead to a simple inferred type with a single 'MonadSafe' 429 | constraint: 430 | 431 | > (MonadSafe m) => ... 432 | 433 | For examples of this, see the utilities in "Pipes.Safe.Prelude". 434 | 435 | If you omit the 'liftIO', the compiler will infer the following constraint 436 | instead: 437 | 438 | > (MonadSafe m, Base m ~ IO) => ... 439 | 440 | This means that this function would require 'IO' directly beneath the 441 | 'SafeT' monad transformer, which might not be what you want. 442 | -} 443 | 444 | {-| Analogous to 'C.finally' from @Control.Monad.Catch@, except this also 445 | protects against premature termination 446 | -} 447 | finally :: (MonadSafe m) => m a -> Base m b -> m a 448 | m1 `finally` after = bracket_ (return ()) after m1 449 | {-# INLINABLE finally #-} 450 | 451 | {-| Analogous to 'C.bracket' from @Control.Monad.Catch@, except this also 452 | protects against premature termination 453 | -} 454 | bracket :: (MonadSafe m) => Base m a -> (a -> Base m b) -> (a -> m c) -> m c 455 | bracket before after action = mask $ \restore -> do 456 | h <- liftBase before 457 | r <- restore (action h) `onException` after h 458 | _ <- liftBase (after h) 459 | return r 460 | {-# INLINABLE bracket #-} 461 | 462 | {-| Analogous to 'C.bracket_' from @Control.Monad.Catch@, except this also 463 | protects against premature termination 464 | -} 465 | bracket_ :: (MonadSafe m) => Base m a -> Base m b -> m c -> m c 466 | bracket_ before after action = bracket before (\_ -> after) (\_ -> action) 467 | {-# INLINABLE bracket_ #-} 468 | 469 | {-| Analogous to 'C.bracketOnError' from @Control.Monad.Catch@, except this also 470 | protects against premature termination 471 | -} 472 | bracketOnError 473 | :: (MonadSafe m) => Base m a -> (a -> Base m b) -> (a -> m c) -> m c 474 | bracketOnError before after action = mask $ \restore -> do 475 | h <- liftBase before 476 | restore (action h) `onException` after h 477 | {-# INLINABLE bracketOnError #-} 478 | 479 | {- $reexports 480 | @Control.Monad.Catch@ re-exports all functions except for the ones that 481 | conflict with the generalized versions provided here (i.e. 'bracket', 482 | 'finally', etc.). 483 | 484 | @Control.Exception@ re-exports 'Exception' and 'SomeException'. 485 | -} 486 | 487 | {- | Transform a 'Proxy' into one that catches any exceptions caused by its 488 | effects, and returns the resulting exception. 489 | -} 490 | tryP :: (MonadSafe m, Exception e) 491 | => Proxy a' a b' b m r -> Proxy a' a b' b m (Either e r) 492 | tryP p = case p of 493 | Request a' fa -> Request a' (\a -> tryP (fa a)) 494 | Respond b fb' -> Respond b (\b' -> tryP (fb' b')) 495 | M m -> M $ C.try m >>= \eres -> return $ case eres of 496 | Left e -> Pure (Left e) 497 | Right a -> tryP a 498 | Pure r -> Pure (Right r) 499 | 500 | {- | Allows direct handling of exceptions raised by the effects in a 'Proxy'. 501 | -} 502 | catchP :: (MonadSafe m, Exception e) 503 | => Proxy a' a b' b m r -> (e -> Proxy a' a b' b m r) 504 | -> Proxy a' a b' b m r 505 | catchP p0 f = go p0 506 | where 507 | go p = case p of 508 | Request a' fa -> Request a' (\a -> go (fa a)) 509 | Respond b fb' -> Respond b (\b' -> go (fb' b')) 510 | M m -> M $ C.catch (liftM go m) (return . f) 511 | Pure r -> Pure r 512 | -------------------------------------------------------------------------------- /src/Pipes/Safe/Prelude.hs: -------------------------------------------------------------------------------- 1 | -- | Simple resource management functions 2 | 3 | {-# LANGUAGE RankNTypes, Safe #-} 4 | 5 | module Pipes.Safe.Prelude ( 6 | -- * Handle management 7 | withFile, 8 | withBinaryFile, 9 | openFile, 10 | openBinaryFile, 11 | 12 | -- * String I/O 13 | -- $strings 14 | readFile, 15 | writeFile, 16 | 17 | -- * Registering/releasing 18 | allocate, 19 | allocate_ 20 | ) where 21 | 22 | import Control.Monad.Catch (mask_) 23 | import Control.Monad.IO.Class (MonadIO(liftIO)) 24 | import Pipes (Producer', Consumer') 25 | import Pipes.Safe (bracket, liftBase, register, Base, MonadSafe, ReleaseKey) 26 | import qualified Pipes.Prelude as P 27 | import qualified System.IO as IO 28 | import Prelude hiding (readFile, writeFile) 29 | 30 | {- | Acquire a 'IO.Handle' within 'MonadSafe' 31 | 32 | The file is opened in text mode. See also: 'withBinaryFile' 33 | -} 34 | withFile :: MonadSafe m => FilePath -> IO.IOMode -> (IO.Handle -> m r) -> m r 35 | withFile file ioMode = bracket (liftIO $ IO.openFile file ioMode) (liftIO . IO.hClose) 36 | {-# INLINABLE withFile #-} 37 | 38 | {- | Like 'withFile', but open the file in binary mode 39 | 40 | See 'System.IO.hSetBinaryMode' for the differences between binary and text mode. 41 | -} 42 | withBinaryFile :: MonadSafe m => FilePath -> IO.IOMode -> (IO.Handle -> m r) -> m r 43 | withBinaryFile file ioMode = bracket (liftIO $ IO.openBinaryFile file ioMode) (liftIO . IO.hClose) 44 | {-# INLINABLE withBinaryFile #-} 45 | 46 | {- | Acquire a 'IO.Handle' within 'MonadSafe' 47 | 48 | The 'ReleaseKey' can be used to close the handle with 'Pipes.Safe.release'; 49 | otherwise the handle will be closed automatically at the conclusion of the 50 | 'MonadSafe' block. 51 | 52 | The file is opened in text mode. See also: 'openBinaryFile' 53 | -} 54 | openFile :: MonadSafe m => FilePath -> IO.IOMode -> m (ReleaseKey, IO.Handle) 55 | openFile file ioMode = allocate (liftIO $ IO.openFile file ioMode) (liftIO . IO.hClose) 56 | {-# INLINABLE openFile #-} 57 | 58 | {- | Like 'openFile', but open the file in binary mode 59 | 60 | See 'System.IO.hSetBinaryMode' for the differences between binary and text mode. 61 | -} 62 | openBinaryFile :: MonadSafe m => FilePath -> IO.IOMode -> m (ReleaseKey, IO.Handle) 63 | openBinaryFile file ioMode = allocate (liftIO $ IO.openBinaryFile file ioMode) (liftIO . IO.hClose) 64 | {-# INLINABLE openBinaryFile #-} 65 | 66 | {- $strings 67 | Note that 'String's are very inefficient, and I will release future separate 68 | packages with 'Data.ByteString.ByteString' and 'Data.Text.Text' operations. 69 | I only provide these to allow users to test simple I/O without requiring any 70 | additional library dependencies. 71 | -} 72 | 73 | {-| Read lines from a file, automatically opening and closing the file as 74 | necessary 75 | -} 76 | readFile :: MonadSafe m => FilePath -> Producer' String m () 77 | readFile file = withFile file IO.ReadMode P.fromHandle 78 | {-# INLINABLE readFile #-} 79 | 80 | {-| Write lines to a file, automatically opening and closing the file as 81 | necessary 82 | -} 83 | writeFile :: MonadSafe m => FilePath -> Consumer' String m r 84 | writeFile file = withFile file IO.WriteMode $ \h -> P.toHandle h 85 | {-# INLINABLE writeFile #-} 86 | 87 | {- | Acquire some resource with a guarantee that it will eventually be released 88 | 89 | The 'ReleaseKey' can be passed to 'Pipes.Safe.release' to 90 | release the resource manually. If this has not been done by the end 91 | of the 'MonadSafe' block, the resource will be released automatically. 92 | -} 93 | allocate :: MonadSafe m => 94 | Base m a -- ^ Acquire 95 | -> (a -> Base m ()) -- ^ Release 96 | -> m (ReleaseKey, a) 97 | allocate acq rel = mask_ $ do 98 | a <- liftBase acq 99 | key <- register (rel a) 100 | return (key, a) 101 | 102 | {- | Like 'allocate', but for when the resource itself is not needed 103 | 104 | The acquire action runs immediately. The 'ReleaseKey' can be passed 105 | to 'Pipes.Safe.release' to run the release action. If this has not been 106 | done by the end of the 'MonadSafe' block, the release action will be 107 | run automatically. 108 | -} 109 | allocate_ :: MonadSafe m => 110 | Base m a -- ^ Acquire 111 | -> (Base m ()) -- ^ Release 112 | -> m ReleaseKey 113 | allocate_ acq rel = fmap fst (allocate acq (const rel)) 114 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | resolver: lts-7.11 2 | extra-deps: 3 | - pipes-4.3.0 4 | --------------------------------------------------------------------------------