├── .github └── workflows │ └── haskell-ci.yml ├── .gitignore ├── .stylish-haskell.yaml ├── CONTRIBUTORS ├── LICENSE ├── README.md ├── Setup.hs ├── cabal.haskell-ci ├── changelog.md ├── io-streams.cabal ├── runTestsAndCoverage.sh ├── src └── System │ └── IO │ ├── Streams.hs │ └── Streams │ ├── Attoparsec.hs │ ├── Attoparsec │ ├── ByteString.hs │ └── Text.hs │ ├── Builder.hs │ ├── ByteString.hs │ ├── Combinators.hs │ ├── Concurrent.hs │ ├── Core.hs │ ├── Debug.hs │ ├── File.hs │ ├── Handle.hs │ ├── Internal.hs │ ├── Internal │ ├── Attoparsec.hs │ ├── Network.hs │ └── Search.hs │ ├── List.hs │ ├── Network.hs │ ├── Process.hs │ ├── Text.hs │ ├── Tutorial.hs │ ├── Vector.hs │ └── Zlib.hs └── test ├── System └── IO │ └── Streams │ └── Tests │ ├── Attoparsec │ ├── ByteString.hs │ └── Text.hs │ ├── Builder.hs │ ├── ByteString.hs │ ├── Combinators.hs │ ├── Common.hs │ ├── Concurrent.hs │ ├── Debug.hs │ ├── File.hs │ ├── Handle.hs │ ├── Internal.hs │ ├── List.hs │ ├── Network.hs │ ├── Process.hs │ ├── Text.hs │ ├── Vector.hs │ └── Zlib.hs └── TestSuite.hs /.github/workflows/haskell-ci.yml: -------------------------------------------------------------------------------- 1 | # This GitHub workflow config has been generated by a script via 2 | # 3 | # haskell-ci 'github' 'io-streams.cabal' 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/andreasabel/haskell-ci 10 | # 11 | # version: 0.19.20240403 12 | # 13 | # REGENDATA ("0.19.20240403",["github","io-streams.cabal"]) 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:focal 31 | continue-on-error: ${{ matrix.allow-failure }} 32 | strategy: 33 | matrix: 34 | include: 35 | - compiler: ghc-9.10.0.20240328 36 | compilerKind: ghc 37 | compilerVersion: 9.10.0.20240328 38 | setup-method: ghcup 39 | allow-failure: false 40 | - compiler: ghc-9.8.2 41 | compilerKind: ghc 42 | compilerVersion: 9.8.2 43 | setup-method: ghcup 44 | allow-failure: false 45 | - compiler: ghc-9.6.4 46 | compilerKind: ghc 47 | compilerVersion: 9.6.4 48 | setup-method: ghcup 49 | allow-failure: false 50 | - compiler: ghc-9.4.8 51 | compilerKind: ghc 52 | compilerVersion: 9.4.8 53 | setup-method: ghcup 54 | allow-failure: false 55 | - compiler: ghc-9.2.8 56 | compilerKind: ghc 57 | compilerVersion: 9.2.8 58 | setup-method: ghcup 59 | allow-failure: false 60 | - compiler: ghc-9.0.2 61 | compilerKind: ghc 62 | compilerVersion: 9.0.2 63 | setup-method: ghcup 64 | allow-failure: false 65 | - compiler: ghc-8.10.7 66 | compilerKind: ghc 67 | compilerVersion: 8.10.7 68 | setup-method: ghcup 69 | allow-failure: false 70 | - compiler: ghc-8.8.4 71 | compilerKind: ghc 72 | compilerVersion: 8.8.4 73 | setup-method: ghcup 74 | allow-failure: false 75 | - compiler: ghc-8.6.5 76 | compilerKind: ghc 77 | compilerVersion: 8.6.5 78 | setup-method: ghcup 79 | allow-failure: false 80 | fail-fast: false 81 | steps: 82 | - name: apt 83 | run: | 84 | apt-get update 85 | apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5 86 | mkdir -p "$HOME/.ghcup/bin" 87 | curl -sL https://downloads.haskell.org/ghcup/0.1.20.0/x86_64-linux-ghcup-0.1.20.0 > "$HOME/.ghcup/bin/ghcup" 88 | chmod a+x "$HOME/.ghcup/bin/ghcup" 89 | "$HOME/.ghcup/bin/ghcup" config add-release-channel https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.8.yaml; 90 | "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false) 91 | "$HOME/.ghcup/bin/ghcup" install cabal 3.10.3.0 || (cat "$HOME"/.ghcup/logs/*.* && false) 92 | env: 93 | HCKIND: ${{ matrix.compilerKind }} 94 | HCNAME: ${{ matrix.compiler }} 95 | HCVER: ${{ matrix.compilerVersion }} 96 | - name: Set PATH and environment variables 97 | run: | 98 | echo "$HOME/.cabal/bin" >> $GITHUB_PATH 99 | echo "LANG=C.UTF-8" >> "$GITHUB_ENV" 100 | echo "CABAL_DIR=$HOME/.cabal" >> "$GITHUB_ENV" 101 | echo "CABAL_CONFIG=$HOME/.cabal/config" >> "$GITHUB_ENV" 102 | HCDIR=/opt/$HCKIND/$HCVER 103 | HC=$("$HOME/.ghcup/bin/ghcup" whereis ghc "$HCVER") 104 | HCPKG=$(echo "$HC" | sed 's#ghc$#ghc-pkg#') 105 | HADDOCK=$(echo "$HC" | sed 's#ghc$#haddock#') 106 | echo "HC=$HC" >> "$GITHUB_ENV" 107 | echo "HCPKG=$HCPKG" >> "$GITHUB_ENV" 108 | echo "HADDOCK=$HADDOCK" >> "$GITHUB_ENV" 109 | echo "CABAL=$HOME/.ghcup/bin/cabal-3.10.3.0 -vnormal+nowrap" >> "$GITHUB_ENV" 110 | HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\d+)\.(\d+)\.(\d+)(\.(\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))') 111 | echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV" 112 | echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV" 113 | echo "ARG_BENCH=--enable-benchmarks" >> "$GITHUB_ENV" 114 | if [ $((HCNUMVER >= 91000)) -ne 0 ] ; then echo "HEADHACKAGE=true" >> "$GITHUB_ENV" ; else echo "HEADHACKAGE=false" >> "$GITHUB_ENV" ; fi 115 | echo "ARG_COMPILER=--$HCKIND --with-compiler=$HC" >> "$GITHUB_ENV" 116 | echo "GHCJSARITH=0" >> "$GITHUB_ENV" 117 | env: 118 | HCKIND: ${{ matrix.compilerKind }} 119 | HCNAME: ${{ matrix.compiler }} 120 | HCVER: ${{ matrix.compilerVersion }} 121 | - name: env 122 | run: | 123 | env 124 | - name: write cabal config 125 | run: | 126 | mkdir -p $CABAL_DIR 127 | cat >> $CABAL_CONFIG <> $CABAL_CONFIG <> $CABAL_CONFIG < cabal-plan.xz 172 | echo 'f62ccb2971567a5f638f2005ad3173dba14693a45154c1508645c52289714cb2 cabal-plan.xz' | sha256sum -c - 173 | xz -d < cabal-plan.xz > $HOME/.cabal/bin/cabal-plan 174 | rm -f cabal-plan.xz 175 | chmod a+x $HOME/.cabal/bin/cabal-plan 176 | cabal-plan --version 177 | - name: checkout 178 | uses: actions/checkout@v4 179 | with: 180 | path: source 181 | - name: initial cabal.project for sdist 182 | run: | 183 | touch cabal.project 184 | echo "packages: $GITHUB_WORKSPACE/source/." >> cabal.project 185 | cat cabal.project 186 | - name: sdist 187 | run: | 188 | mkdir -p sdist 189 | $CABAL sdist all --output-dir $GITHUB_WORKSPACE/sdist 190 | - name: unpack 191 | run: | 192 | mkdir -p unpacked 193 | find sdist -maxdepth 1 -type f -name '*.tar.gz' -exec tar -C $GITHUB_WORKSPACE/unpacked -xzvf {} \; 194 | - name: generate cabal.project 195 | run: | 196 | PKGDIR_io_streams="$(find "$GITHUB_WORKSPACE/unpacked" -maxdepth 1 -type d -regex '.*/io-streams-[0-9.]*')" 197 | echo "PKGDIR_io_streams=${PKGDIR_io_streams}" >> "$GITHUB_ENV" 198 | rm -f cabal.project cabal.project.local 199 | touch cabal.project 200 | touch cabal.project.local 201 | echo "packages: ${PKGDIR_io_streams}" >> cabal.project 202 | echo "package io-streams" >> cabal.project 203 | echo " ghc-options: -Werror=missing-methods" >> cabal.project 204 | cat >> cabal.project <> cabal.project 208 | fi 209 | $HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: $_ installed\n" unless /^(io-streams)$/; }' >> cabal.project.local 210 | cat cabal.project 211 | cat cabal.project.local 212 | - name: dump install plan 213 | run: | 214 | $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dry-run all 215 | cabal-plan 216 | - name: restore cache 217 | uses: actions/cache/restore@v4 218 | with: 219 | key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }} 220 | path: ~/.cabal/store 221 | restore-keys: ${{ runner.os }}-${{ matrix.compiler }}- 222 | - name: install dependencies 223 | run: | 224 | $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --dependencies-only -j2 all 225 | $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dependencies-only -j2 all 226 | - name: build w/o tests 227 | run: | 228 | $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all 229 | - name: build 230 | run: | 231 | $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --write-ghc-environment-files=always 232 | - name: tests 233 | run: | 234 | $CABAL v2-test $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --test-show-details=direct 235 | - name: cabal check 236 | run: | 237 | cd ${PKGDIR_io_streams} || false 238 | ${CABAL} -vnormal check 239 | - name: haddock 240 | run: | 241 | $CABAL v2-haddock --disable-documentation --haddock-all $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all 242 | - name: unconstrained build 243 | run: | 244 | rm -f cabal.project.local 245 | $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all 246 | - name: save cache 247 | uses: actions/cache/save@v4 248 | if: always() 249 | with: 250 | key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }} 251 | path: ~/.cabal/store 252 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *~ 2 | TAGS 3 | cabal-dev 4 | dist/ 5 | dist-newstyle/ 6 | tmp/ 7 | *.tix 8 | .hpc 9 | *.prof 10 | *.hi 11 | *.o 12 | *.swp 13 | #*# 14 | .#* 15 | .DS_Store 16 | **/.DS_Store 17 | docs/templates/out 18 | .cabal-sandbox/ 19 | cabal.sandbox.config 20 | cabal.project.local 21 | .stack-work/ 22 | -------------------------------------------------------------------------------- /.stylish-haskell.yaml: -------------------------------------------------------------------------------- 1 | # stylish-haskell configuration file 2 | # ================================== 3 | 4 | # The stylish-haskell tool is mainly configured by specifying steps. These steps 5 | # are a list, so they have an order, and one specific step may appear more than 6 | # once (if needed). Each file is processed by these steps in the given order. 7 | steps: 8 | # Convert some ASCII sequences to their Unicode equivalents. This is disabled 9 | # by default. 10 | # - unicode_syntax: 11 | # # In order to make this work, we also need to insert the UnicodeSyntax 12 | # # language pragma. If this flag is set to true, we insert it when it's 13 | # # not already present. You may want to disable it if you configure 14 | # # language extensions using some other method than pragmas. Default: 15 | # # true. 16 | # add_language_pragma: true 17 | 18 | # Import cleanup 19 | - imports: 20 | # There are different ways we can align names and lists. 21 | # 22 | # - global: Align the import names and import list throughout the entire 23 | # file. 24 | # 25 | # - file: Like global, but don't add padding when there are no qualified 26 | # imports in the file. 27 | # 28 | # - group: Only align the imports per group (a group is formed by adjacent 29 | # import lines). 30 | # 31 | # - none: Do not perform any alignment. 32 | # 33 | # Default: global. 34 | align: global 35 | 36 | # Language pragmas 37 | - language_pragmas: 38 | # We can generate different styles of language pragma lists. 39 | # 40 | # - vertical: Vertical-spaced language pragmas, one per line. 41 | # 42 | # - compact: A more compact style. 43 | # 44 | # Default: vertical. 45 | style: vertical 46 | 47 | # stylish-haskell can detect redundancy of some language pragmas. If this 48 | # is set to true, it will remove those redundant pragmas. Default: true. 49 | remove_redundant: true 50 | 51 | # Align the types in record declarations 52 | # 53 | # FIXME(greg): this should be on, see comment below re: "columns" 54 | # - records: {} 55 | 56 | # Replace tabs by spaces. This is disabled by default. 57 | - tabs: 58 | # Number of spaces to use for each tab. Default: 8, as specified by the 59 | # Haskell report. 60 | spaces: 8 61 | 62 | # Remove trailing whitespace 63 | - trailing_whitespace: {} 64 | 65 | # A common setting is the number of columns (parts of) code will be wrapped 66 | # to. Different steps take this into account. Default: 80. 67 | # 68 | 69 | # NOTE(greg): this should be 80 but stylish-haskell currently has a bad bug 70 | # that causes it not to wrap long import lists. Rather than get consistently 71 | # weird output, just don't wrap the lines at all. 72 | 73 | columns: 120000 74 | 75 | # Sometimes, language extensions are specified in a cabal file or from the 76 | # command line instead of using language pragmas in the file. stylish-haskell 77 | # needs to be aware of these, so it can parse the file correctly. 78 | # 79 | # No language extensions are enabled by default. 80 | # language_extensions: 81 | # - TemplateHaskell 82 | # - QuasiQuotes 83 | -------------------------------------------------------------------------------- /CONTRIBUTORS: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | IOStreams Contributors: 3 | 4 | - Gregory Collins 5 | - Gabriel Gonzalez 6 | - Ignat Insarov 7 | 8 | ------------------------------------------------------------------------------ 9 | Contains some code ported from the "blaze-builder-enumerator" package by Simon 10 | Meier and Thomas Sutton, distributed under the following license: 11 | 12 | Copyright 2010, Thomas Sutton. All rights reserved. 13 | Copyright 2011, Simon Meier. All rights reserved. 14 | 15 | Redistribution and use in source and binary forms, with or without modification, 16 | are permitted provided that the following conditions are met: 17 | 18 | * Redistributions of source code must retain the above copyright notice, this 19 | list of conditions and the following disclaimer. 20 | 21 | * Redistributions in binary form must reproduce the above copyright notice, 22 | this list of conditions and the following disclaimer in the documentation 23 | and/or other materials provided with the distribution. 24 | 25 | * The names of its contributors may not be used to endorse or promote products 26 | derived from this software without specific prior written permission. 27 | 28 | THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ''AS IS'' AND ANY 29 | EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 30 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 31 | DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR ANY 32 | DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES 33 | (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 34 | LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON 35 | ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 36 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 37 | SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 38 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2012, Google, Inc. 2 | Copyright (c) 2012, Erudify AG 3 | 4 | All rights reserved. 5 | 6 | Redistribution and use in source and binary forms, with or without 7 | modification, are permitted provided that the following conditions are met: 8 | 9 | Redistributions of source code must retain the above copyright notice, this 10 | list of conditions and the following disclaimer. 11 | 12 | Redistributions in binary form must reproduce the above copyright notice, this 13 | list of conditions and the following disclaimer in the documentation and/or 14 | other materials provided with the distribution. 15 | 16 | Neither the names of Google, Erudify, nor the names of other contributors may 17 | be used to endorse or promote products derived from this software without 18 | specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 21 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 22 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 23 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 24 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 25 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 26 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 27 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 28 | OR TORT (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.md: -------------------------------------------------------------------------------- 1 | The io-streams library contains simple and easy to use primitives for I/O 2 | using streams. Based on simple types with one type parameter (`InputStream a` 3 | and `OutputStream a`), io-streams provides a basic interface to 4 | side-effecting input and output in `IO` monad with the following 5 | features: 6 | 7 | * three fundamental I/O primitives that anyone can understand: `read :: 8 | InputStream a -> IO (Maybe a)`, `unRead :: a -> InputStream a -> IO ()`, 9 | and `write :: Maybe a -> OutputStream a -> IO ()`. 10 | 11 | * simple types and side-effecting IO operations mean straightforward and 12 | simple exception handling and resource cleanup using standard Haskell 13 | facilities like `bracket`. 14 | 15 | * code to transform files, handles, and sockets to streams 16 | 17 | * a variety of combinators for wrapping and transforming streams, including 18 | compression and decompression using zlib, controlling precisely how many 19 | bytes are read to or written from a socket, buffering output using 20 | `blaze-builder`, etc. 21 | 22 | * support for parsing from streams using `attoparsec`. 23 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /cabal.haskell-ci: -------------------------------------------------------------------------------- 1 | branches: master 2 | 3 | -- constraint-set bytestring-0.12 4 | -- -- bytestring-0.12 requires base >=4.9 (GHC 8.0) 5 | -- ghc: >= 8.0 6 | -- constraints: bytestring >= 0.12 7 | -- -- 8 | -- -- The following is silently ignored here: 9 | -- -- 10 | -- -- raw-project 11 | -- -- allow-newer: bytestring 12 | -- -- 13 | -- tests: True 14 | -- run-tests: True 15 | -- 16 | -- -- The following is meant to be for constraint-set bytestring-0.12 only, 17 | -- -- but there is currently no way to enable `allow-newer: bytestring` 18 | -- -- just for the constraint set. 19 | -- -- 20 | -- -- Since core library `bytestring` is constrained to `installed`, 21 | -- -- it is not harmful to allow newer `bytestring` in the default runs 22 | -- -- as well---it will have no effect there. 23 | -- -- 24 | -- raw-project 25 | -- allow-newer: bytestring 26 | -------------------------------------------------------------------------------- /changelog.md: -------------------------------------------------------------------------------- 1 | # Version 1.5.2.0 2 | - Add `contraunzip`. 3 | 4 | - Guard support for `network` and `zlib` by cabal flags, to support platforms 5 | like GHCJS where they are not available. 6 | 7 | # Version 1.5.1.0 8 | Fix [stackage#4312](https://github.com/commercialhaskell/stackage/issues/4312): Relax `network` upper bound 9 | 10 | # Version 1.5.0.1 11 | Bugfix: `concurrentMerge []` should not block forever, even if this case is 12 | pathological. 13 | 14 | # Version 1.5.0.0 15 | - Changed the behaviour of `ByteString.splitOn` to not emit empty string if the 16 | input ends in the delimiter; now `lines` should match Prelude's. Bumped major 17 | version because this is a potentially breaking change (even if it is a bugfix.) 18 | 19 | # Version 1.4.1.0 20 | 21 | - Added `writeTo` export to the main module (forgotten when it was added to 22 | `.Core`.) 23 | 24 | # Version 1.4.0.0 25 | 26 | - Added support for Text with Attoparsec, courtesy Kevin Brubeck Unhammer. Adds 27 | modules `System.IO.Streams.Attoparsec.{ByteString, Text}` and deprecates 28 | `System.IO.Streams.Attoparsec`, which is now a thin wrapper. 29 | 30 | # Version 1.3.6.1 31 | - Bumped dependencies on `time` and `process`. 32 | 33 | # Version 1.3.6.0 34 | - Added new fold functions: 35 | ```haskell 36 | fold_ :: (x -> a -> x) -- ^ accumulator update function 37 | -> x -- ^ initial seed 38 | -> (x -> s) -- ^ recover folded value 39 | -> InputStream a -- ^ input stream 40 | -> IO s 41 | foldM_ :: (x -> a -> IO x) -- ^ accumulator update action 42 | -> IO x -- ^ initial seed 43 | -> (x -> IO s) -- ^ recover folded value 44 | -> InputStream a -- ^ input stream 45 | -> IO s 46 | ``` 47 | 48 | # Version 1.3.5.0 49 | - Add support for latest `process`, `time`, and `transformers` releases 50 | (and thereby indirectly for the upcoming GHC 8.0). 51 | 52 | # Version 1.3.4.0 53 | - Added `System.IO.Streams.Handle.handleToStreams`, to conveniently 54 | create an `InputStream`/`OutputStream` pair. 55 | 56 | # Version 1.3.3.1 57 | - Fixed a testsuite compile error on GHC >= 7.10. 58 | 59 | # Version 1.3.3.0 60 | - Added a new convenience function, like `chunkList` but with a predicate for 61 | when to split, taking current element and current chunk length: 62 | ```haskell 63 | chunkListWith :: (a -> Int -> Bool) -> InputStream a -> IO (InputStream [a]) 64 | ``` 65 | 66 | # Version 1.3.2.0 67 | - Dependency bump for attoparsec 0.13 (another location) 68 | - Dependency bump for vector 0.11 69 | - Dependency bump for zlib 0.6 70 | 71 | # Version 1.3.1.0 72 | - Dependency bump for attoparsec 0.13. 73 | 74 | # Version 1.3.0.0 75 | - As long promised, removed the direct use of the `blaze-builder` package in 76 | favor of the new `bytestring-builder` transitional package (to be replaced 77 | by bytestring's native builder once it is mature enough). 78 | - Added a new convenience function, a flipped version of `write`: 79 | ```haskell 80 | writeTo :: OutputStream a -> Maybe a -> IO () 81 | ``` 82 | 83 | # Version 1.2.1.3 84 | - Dependency bump for primitive 0.6. 85 | 86 | # Version 1.2.1.2 87 | - Dependency bump for deepseq 1.4. 88 | 89 | # Version 1.2.1.1 90 | - Dependency bump for time 1.6. 91 | 92 | # Version 1.2.1.0 93 | - Added `System.IO.Streams.mapMaybe` for InputStream. 94 | 95 | - Added `System.IO.Streams.contramapMaybe` for OutputStream. 96 | 97 | # Version 1.2.0.1 98 | 99 | - `System.IO.Streams.Attoparsec.parseFromStream`: export more information 100 | about the context of parse errors to the message returned via 101 | `ParseException`. 102 | 103 | - Improved documentation about stream flushing in the docstring for 104 | `handleToOutputStream`. 105 | 106 | # Version 1.2.0.0 107 | - Fixed bug #27 (https://github.com/snapframework/io-streams/issues/27): 108 | makeOutputStream now properly shuts down the stream upon receiving EOF. The 109 | new invariant might break user programs if they depended on the buggy 110 | behaviour, which is the reason for the major version bump. 111 | 112 | - Fixed a few polymorphic bindings that started breaking in recent GHC. 113 | 114 | - Dependency bumps for: 115 | - text 1.2 116 | - network 2.6 117 | 118 | # Version 1.1.4.6 119 | Moved old changelog entries to `changelog.md`. 120 | 121 | # Version 1.1.4.5 122 | Allow use of attoparsec 0.12.*. 123 | 124 | # Version 1.1.4.4 125 | Allow use of transformers 0.4.*. 126 | 127 | # Version 1.1.4.3 128 | Allow use of new network version 2.5. 129 | 130 | # Version 1.1.4.2 131 | Fixed a build error with network versions older than 2.4. 132 | 133 | # Version 1.1.4.1 134 | `System.IO.Streams.Network`: scalability improvement: buffers for socket reads 135 | are now allocated by system malloc rather than by pinned pointers in GHC 136 | (currently pinned pointer allocation takes a global lock). 137 | 138 | # Version 1.1.4.0 139 | Widened `attoparsec` and `text` library dependencies to allow the latest 140 | versions. 141 | 142 | # Version 1.1.3.0 143 | Added `System.IO.Streams.ByteString.takeExactly`. Widened `network` dependency 144 | to include 2.3. Added a `NoInteractiveTests` flag to selectively disable some 145 | tests for environments where spawning interactive processes is impossible. 146 | 147 | # Version 1.1.2.2 148 | Allowed newest versions of the `process`, `test-framework`, and `text` 149 | libraries. 150 | 151 | # Version 1.1.2.1 152 | Fixed build error when compiled against attoparsec-0.10.0.x. 153 | 154 | # Version 1.1.2.0 155 | Added `System.IO.Streams.Concurrent.makeChanPipe`, to create a simple 156 | concurrent pipe between an `InputStream`/`OutputStream` pair. 157 | 158 | # Version 1.1.1.0 159 | Added `System.IO.Streams.Network.socketToStreamsWithBufferSize`, allowing 160 | control over the size of the receive buffers used when reading from sockets. 161 | 162 | # Version 1.1.0.3 163 | Fixed an inconsistent version upper bound in the test suite. 164 | 165 | # Version 1.1.0.2 166 | Fixed a typo in the tutorial. 167 | 168 | # Version 1.1.0.1 169 | A couple of Haddock markup fixes. 170 | 171 | # Version 1.1.0.0 172 | Reworked, simplified, and streamlined the internals of the library. Exports 173 | from `System.IO.Streams.Internal` relying on Sources and Sinks were deleted 174 | because they are no longer necessary: `Source(..)`, `Sink(..)`, 175 | `defaultPushback`, `withDefaultPushback`, `nullSource`, `nullSink`, 176 | `singletonSource`, `simpleSource`, `sourceToStream`, `sinkToStream`, 177 | `generatorToSource`, and `consumerToSink`. 178 | 179 | # Version 1.0.2.2 180 | Fixed a bug in which `"takeBytes 0"` was erroneously requesting input from the 181 | wrapped stream. 182 | 183 | # Version 1.0.2.1 184 | Fixed a compile error on GHC 7.0.x. 185 | 186 | # Version 1.0.2.0 187 | Added `System.IO.Streams.Process` (support for communicating with system 188 | processes using streams), added new functions to `System.IO.Streams.Handle` for 189 | converting `io-streams` types to `System.IO.Handle`s. (Now you can pass streams 190 | from this library to places that expect Handles and everything will work.) 191 | 192 | # Version 1.0.1.0 193 | Added `System.IO.Streams.Combinators.ignoreEof`. 194 | 195 | # Version 1.0.0.1 196 | Fixed some haddock markup. 197 | -------------------------------------------------------------------------------- /io-streams.cabal: -------------------------------------------------------------------------------- 1 | Name: io-streams 2 | Version: 1.5.2.2 3 | License: BSD3 4 | License-file: LICENSE 5 | Category: Data, Network, IO-Streams 6 | Build-type: Simple 7 | Maintainer: Gregory Collins 8 | Cabal-version: >= 1.10 9 | Synopsis: Simple, composable, and easy-to-use stream I/O 10 | Tested-With: 11 | GHc == 9.10.0 12 | GHc == 9.8.2 13 | GHc == 9.6.4 14 | GHC == 9.4.8 15 | GHC == 9.2.8 16 | GHC == 9.0.2 17 | GHC == 8.10.7 18 | GHC == 8.8.4 19 | GHC == 8.6.5 20 | 21 | Bug-Reports: https://github.com/snapframework/io-streams/issues 22 | Description: 23 | /Overview/ 24 | . 25 | The io-streams library contains simple and easy-to-use primitives for I/O 26 | using streams. Most users will want to import the top-level convenience 27 | module "System.IO.Streams", which re-exports most of the library: 28 | . 29 | @ 30 | import System.IO.Streams (InputStream, OutputStream) 31 | import qualified System.IO.Streams as Streams 32 | @ 33 | . 34 | For first-time users, @io-streams@ comes with an included tutorial, which can 35 | be found in the "System.IO.Streams.Tutorial" module. 36 | . 37 | /Features/ 38 | . 39 | The @io-streams@ user API has two basic types: @InputStream a@ and 40 | @OutputStream a@, and three fundamental I/O primitives: 41 | . 42 | @ 43 | \-\- read an item from an input stream 44 | Streams.read :: InputStream a -> IO (Maybe a) 45 | . 46 | \-\- push an item back to an input stream 47 | Streams.unRead :: a -> InputStream a -> IO () 48 | . 49 | \-\- write to an output stream 50 | Streams.write :: Maybe a -> OutputStream a -> IO () 51 | @ 52 | . 53 | Streams can be transformed by composition and hooked together with provided combinators: 54 | . 55 | @ 56 | ghci> Streams.fromList [1,2,3::Int] >>= Streams.map (*10) >>= Streams.toList 57 | [10,20,30] 58 | @ 59 | . 60 | Stream composition leaves the original stream accessible: 61 | . 62 | @ 63 | ghci> input \<- Streams.fromByteString \"long string\" 64 | ghci> wrapped \<- Streams.takeBytes 4 input 65 | ghci> Streams.read wrapped 66 | Just \"long\" 67 | ghci> Streams.read wrapped 68 | Nothing 69 | ghci> Streams.read input 70 | Just \" string\" 71 | @ 72 | . 73 | Simple types and operations in the IO monad mean straightforward and simple 74 | exception handling and resource cleanup using Haskell standard library 75 | facilities like 'Control.Exception.bracket'. 76 | . 77 | @io-streams@ comes with: 78 | . 79 | * functions to use files, handles, concurrent channels, sockets, lists, 80 | vectors, and more as streams. 81 | . 82 | * a variety of combinators for wrapping and transforming streams, including 83 | compression and decompression using zlib, controlling precisely how many 84 | bytes are read from or written to a stream, buffering output using 85 | bytestring builders, folds, maps, filters, zips, etc. 86 | . 87 | * support for parsing from streams using @attoparsec@. 88 | . 89 | * support for spawning processes and communicating with them using streams. 90 | 91 | Extra-Source-Files: CONTRIBUTORS README.md changelog.md 92 | 93 | Flag NoInteractiveTests 94 | Description: Do not run interactive tests 95 | Default: False 96 | 97 | Flag Zlib 98 | Description: Include zlib support 99 | Default: True 100 | Manual: True 101 | 102 | Flag Network 103 | Description: Include network support 104 | Default: True 105 | Manual: True 106 | 107 | ------------------------------------------------------------------------------ 108 | Library 109 | hs-source-dirs: src 110 | Default-language: Haskell2010 111 | 112 | ghc-options: -Wall -fwarn-tabs -funbox-strict-fields 113 | -fno-warn-unused-do-bind 114 | 115 | Exposed-modules: System.IO.Streams, 116 | System.IO.Streams.Attoparsec, 117 | System.IO.Streams.Attoparsec.ByteString, 118 | System.IO.Streams.Attoparsec.Text, 119 | System.IO.Streams.Builder, 120 | System.IO.Streams.ByteString, 121 | System.IO.Streams.Combinators, 122 | System.IO.Streams.Concurrent, 123 | System.IO.Streams.Core, 124 | System.IO.Streams.Debug, 125 | System.IO.Streams.Handle, 126 | System.IO.Streams.File, 127 | System.IO.Streams.List, 128 | System.IO.Streams.Process, 129 | System.IO.Streams.Text, 130 | System.IO.Streams.Vector, 131 | System.IO.Streams.Internal, 132 | System.IO.Streams.Tutorial 133 | 134 | Other-modules: System.IO.Streams.Internal.Attoparsec, 135 | System.IO.Streams.Internal.Search 136 | 137 | Build-depends: base >= 4 && <5, 138 | attoparsec >= 0.10 && <0.15, 139 | bytestring >= 0.9 && <0.13, 140 | primitive >= 0.2 && <0.10, 141 | process >= 1.1 && <1.7, 142 | text >=0.10 && <1.3 || >= 2.0 && <2.2, 143 | time >= 1.2 && <1.15, 144 | transformers >= 0.2 && <0.7, 145 | vector >= 0.7 && <0.14 146 | 147 | if !impl(ghc >= 7.8) 148 | Build-depends: bytestring-builder >= 0.10 && <0.11 149 | 150 | if impl(ghc >= 7.2) 151 | other-extensions: Trustworthy 152 | 153 | if flag(Zlib) 154 | Exposed-modules: System.IO.Streams.Zlib 155 | Build-depends: zlib-bindings >= 0.1 && <0.2 156 | cpp-options: -DENABLE_ZLIB 157 | 158 | if flag(Network) 159 | Exposed-modules: System.IO.Streams.Network 160 | Other-modules: System.IO.Streams.Internal.Network 161 | Build-depends: network >= 2.3 && <4 162 | cpp-options: -DENABLE_NETWORK 163 | 164 | other-extensions: 165 | BangPatterns, 166 | CPP, 167 | DeriveDataTypeable, 168 | FlexibleContexts, 169 | FlexibleInstances, 170 | GeneralizedNewtypeDeriving, 171 | MultiParamTypeClasses, 172 | OverloadedStrings, 173 | RankNTypes, 174 | TypeSynonymInstances 175 | 176 | 177 | ------------------------------------------------------------------------------ 178 | Test-suite testsuite 179 | Type: exitcode-stdio-1.0 180 | hs-source-dirs: src test 181 | Main-is: TestSuite.hs 182 | Default-language: Haskell2010 183 | 184 | Other-modules: System.IO.Streams.Tests.Attoparsec.ByteString, 185 | System.IO.Streams.Tests.Attoparsec.Text, 186 | System.IO.Streams.Tests.Builder, 187 | System.IO.Streams.Tests.ByteString, 188 | System.IO.Streams.Tests.Combinators, 189 | System.IO.Streams.Tests.Common, 190 | System.IO.Streams.Tests.Concurrent, 191 | System.IO.Streams.Tests.Debug, 192 | System.IO.Streams.Tests.File, 193 | System.IO.Streams.Tests.Handle, 194 | System.IO.Streams.Tests.Internal, 195 | System.IO.Streams.Tests.List, 196 | System.IO.Streams.Tests.Process, 197 | System.IO.Streams.Tests.Text, 198 | System.IO.Streams.Tests.Vector, 199 | System.IO.Streams, 200 | System.IO.Streams.Attoparsec.ByteString, 201 | System.IO.Streams.Attoparsec.Text, 202 | System.IO.Streams.Builder, 203 | System.IO.Streams.ByteString, 204 | System.IO.Streams.Combinators, 205 | System.IO.Streams.Concurrent, 206 | System.IO.Streams.Core, 207 | System.IO.Streams.Debug, 208 | System.IO.Streams.Handle, 209 | System.IO.Streams.File, 210 | System.IO.Streams.List, 211 | System.IO.Streams.Process, 212 | System.IO.Streams.Text, 213 | System.IO.Streams.Vector, 214 | System.IO.Streams.Internal, 215 | System.IO.Streams.Internal.Attoparsec, 216 | System.IO.Streams.Internal.Search 217 | 218 | 219 | ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -threaded 220 | -fno-warn-unused-do-bind 221 | 222 | if !os(windows) && !flag(NoInteractiveTests) 223 | cpp-options: -DENABLE_PROCESS_TESTS 224 | 225 | if flag(Zlib) 226 | Other-modules: System.IO.Streams.Tests.Zlib, 227 | System.IO.Streams.Zlib 228 | Build-depends: zlib-bindings, 229 | zlib >= 0.5 && <0.8 230 | cpp-options: -DENABLE_ZLIB 231 | 232 | if flag(Network) 233 | Other-modules: System.IO.Streams.Internal.Network, 234 | System.IO.Streams.Network, 235 | System.IO.Streams.Tests.Network 236 | Build-depends: network 237 | cpp-options: -DENABLE_NETWORK 238 | 239 | Build-depends: base, 240 | attoparsec, 241 | bytestring, 242 | deepseq >= 1.2 && <1.6, 243 | directory >= 1.1 && <2, 244 | filepath >= 1.2 && <2, 245 | mtl >= 2 && <3, 246 | primitive, 247 | process, 248 | text, 249 | time, 250 | transformers, 251 | vector, 252 | 253 | HUnit >= 1.2 && <2, 254 | QuickCheck >= 2.3.0.2 && <3, 255 | test-framework >= 0.6 && <0.9, 256 | test-framework-hunit >= 0.2.7 && <0.4, 257 | test-framework-quickcheck2 >= 0.2.12.1 && <0.4 258 | 259 | if !impl(ghc >= 7.8) 260 | Build-depends: bytestring-builder 261 | 262 | if impl(ghc >= 7.2) 263 | other-extensions: Trustworthy 264 | 265 | other-extensions: 266 | BangPatterns, 267 | CPP, 268 | DeriveDataTypeable, 269 | FlexibleInstances, 270 | GeneralizedNewtypeDeriving, 271 | MultiParamTypeClasses, 272 | OverloadedStrings, 273 | RankNTypes 274 | 275 | source-repository head 276 | type: git 277 | location: https://github.com/snapframework/io-streams.git 278 | -------------------------------------------------------------------------------- /runTestsAndCoverage.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | set -e 4 | 5 | NEWSTYLE=$(([ -d ./dist-newstyle ] && echo "1") || echo "0") 6 | DIST=$(if [ 1 == $NEWSTYLE ]; then 7 | echo ./dist-newstyle/build/io-streams*; 8 | else 9 | echo ./dist 10 | fi) 11 | 12 | echo HAVE DIST $DIST 13 | echo HAVE NEWSTYLE $NEWSTYLE 14 | 15 | TESTSUITE="./${DIST}/build/testsuite/testsuite" 16 | 17 | [ -f "${TESTSUITE}" ] || ( 18 | echo "No testsuite executable at $TESTSUITE."; exit 1 19 | ) 20 | 21 | export LC_ALL=C 22 | export LANG=C 23 | 24 | rm -f testsuite.tix 25 | 26 | $TESTSUITE -j4 -a1000 $* 27 | 28 | # cabal test --show-details=always --test-options="-j4 -a1000 $*" 29 | 30 | HPCDIR="${DIST}/hpc" 31 | 32 | rm -Rf $HPCDIR 33 | mkdir -p $HPCDIR 34 | 35 | EXCLUDES='Main 36 | System.IO.Streams.Tests.Attoparsec.ByteString 37 | System.IO.Streams.Tests.Attoparsec.Text 38 | System.IO.Streams.Tests.Builder 39 | System.IO.Streams.Tests.ByteString 40 | System.IO.Streams.Tests.Combinators 41 | System.IO.Streams.Tests.Concurrent 42 | System.IO.Streams.Tests.Common 43 | System.IO.Streams.Tests.Debug 44 | System.IO.Streams.Tests.File 45 | System.IO.Streams.Tests.Handle 46 | System.IO.Streams.Tests.Internal 47 | System.IO.Streams.Tests.List 48 | System.IO.Streams.Tests.Network 49 | System.IO.Streams.Tests.Process 50 | System.IO.Streams.Tests.Text 51 | System.IO.Streams.Tests.Vector 52 | System.IO.Streams.Tests.Zlib 53 | ' 54 | 55 | EXCL="" 56 | 57 | for m in $EXCLUDES; do 58 | EXCL="$EXCL --exclude=$m" 59 | done 60 | 61 | hpc markup $EXCL --destdir="$HPCDIR" testsuite >/dev/null 2>&1 62 | 63 | rm -f testsuite.tix 64 | 65 | cat <. 20 | module System.IO.Streams 21 | ( -- * Stream types 22 | InputStream 23 | , OutputStream 24 | 25 | 26 | -- ** A note about resource acquisition\/release semantics 27 | -- $resource 28 | 29 | -- * Creating streams 30 | , makeInputStream 31 | , makeOutputStream 32 | 33 | -- * Primitive stream operations 34 | , read 35 | , unRead 36 | , peek 37 | , write 38 | , writeTo 39 | , atEOF 40 | 41 | -- * Connecting streams together 42 | , connect 43 | , connectTo 44 | , supply 45 | , supplyTo 46 | , appendInputStream 47 | , concatInputStreams 48 | 49 | -- * Thread safety \/ concurrency 50 | , lockingInputStream 51 | , lockingOutputStream 52 | 53 | -- * Utility streams 54 | , nullInput 55 | , nullOutput 56 | 57 | -- * Generator monad 58 | -- $generator 59 | , Generator 60 | , fromGenerator 61 | , yield 62 | 63 | -- * Batteries included 64 | , module System.IO.Streams.Builder 65 | , module System.IO.Streams.ByteString 66 | , module System.IO.Streams.Combinators 67 | , module System.IO.Streams.Handle 68 | , module System.IO.Streams.File 69 | , module System.IO.Streams.List 70 | #ifdef ENABLE_NETWORK 71 | , module System.IO.Streams.Network 72 | #endif 73 | , module System.IO.Streams.Process 74 | , module System.IO.Streams.Text 75 | , module System.IO.Streams.Vector 76 | #ifdef ENABLE_ZLIB 77 | , module System.IO.Streams.Zlib 78 | #endif 79 | ) where 80 | 81 | ------------------------------------------------------------------------------ 82 | import Prelude () 83 | 84 | ------------------------------------------------------------------------------ 85 | import System.IO.Streams.Internal 86 | 87 | import System.IO.Streams.Builder 88 | import System.IO.Streams.ByteString 89 | import System.IO.Streams.Combinators 90 | import System.IO.Streams.File 91 | import System.IO.Streams.Handle 92 | import System.IO.Streams.List 93 | #ifdef ENABLE_NETWORK 94 | import System.IO.Streams.Network 95 | #endif 96 | import System.IO.Streams.Process 97 | import System.IO.Streams.Text 98 | import System.IO.Streams.Vector 99 | #ifdef ENABLE_ZLIB 100 | import System.IO.Streams.Zlib 101 | #endif 102 | 103 | ------------------------------------------------------------------------------ 104 | -- $generator 105 | -- #generator# 106 | -- 107 | -- The 'Generator' monad makes it easier for you to define more complicated 108 | -- 'InputStream's. Generators have a couple of basic features: 109 | -- 110 | -- 'Generator' is a 'MonadIO', so you can run IO actions from within it using 111 | -- 'liftIO': 112 | -- 113 | -- @ 114 | -- foo :: 'Generator' r a 115 | -- foo = 'liftIO' fireTheMissiles 116 | -- @ 117 | -- 118 | -- 'Generator' has a 'yield' function: 119 | -- 120 | -- @ 121 | -- 'yield' :: r -> 'Generator' r () 122 | -- @ 123 | -- 124 | -- A call to \"'yield' @x@\" causes \"'Just' @x@\" to appear when reading the 125 | -- 'InputStream'. Finally, 'Generator' comes with a function to turn a 126 | -- 'Generator' into an 'InputStream': 127 | -- 128 | -- @ 129 | -- 'fromGenerator' :: 'Generator' r a -> 'IO' ('InputStream' r) 130 | -- @ 131 | -- 132 | -- Once the 'Generator' action finishes, 'fromGenerator' will cause an 133 | -- end-of-stream 'Nothing' marker to appear at the output. Example: 134 | -- 135 | -- @ 136 | -- ghci> (Streams.'fromGenerator' $ 'Control.Monad.sequence' $ 'Prelude.map' Streams.'yield' [1..5::Int]) >>= Streams.'toList' 137 | -- [1,2,3,4,5] 138 | -- @ 139 | 140 | 141 | ------------------------------------------------------------------------------ 142 | -- $resource 143 | -- #resource# 144 | -- 145 | -- In general, the convention within this library is that input and output 146 | -- streams do not deal with resource acquisition\/release semantics, with rare 147 | -- exceptions like 'System.IO.Streams.withFileAsInput'. For example, sending 148 | -- \"end-of-stream\" to an 'OutputStream' wrapped around a 'System.IO.Handle' 149 | -- doesn't cause the handle to be closed. You can think of streams as little 150 | -- state machines that are attached to the underlying resources, and the 151 | -- finalization\/release of these resources is up to you. 152 | -- 153 | -- This means that you can use standard Haskell idioms like 154 | -- 'Control.Exception.bracket' to handle resource acquisition and cleanup in an 155 | -- exception-safe way. 156 | -- 157 | 158 | -------------------------------------------------------------------------------- /src/System/IO/Streams/Attoparsec.hs: -------------------------------------------------------------------------------- 1 | -- | This module is deprecated -- use 2 | -- System.IO.Streams.Attoparsec.ByteString instead (this module simply 3 | -- re-exports that one). 4 | 5 | module System.IO.Streams.Attoparsec 6 | ( -- * Parsing 7 | parseFromStream 8 | , parserToInputStream 9 | , ParseException(..) 10 | ) where 11 | 12 | ------------------------------------------------------------------------------ 13 | import System.IO.Streams.Attoparsec.ByteString (ParseException (..), parseFromStream, parserToInputStream) 14 | -------------------------------------------------------------------------------- /src/System/IO/Streams/Attoparsec/ByteString.hs: -------------------------------------------------------------------------------- 1 | -- | This module provides support for parsing values from ByteString 2 | -- 'InputStream's using @attoparsec@. /Since: 1.4.0.0./ 3 | 4 | module System.IO.Streams.Attoparsec.ByteString 5 | ( -- * Parsing 6 | parseFromStream 7 | , parserToInputStream 8 | , ParseException(..) 9 | ) where 10 | 11 | ------------------------------------------------------------------------------ 12 | import Data.Attoparsec.ByteString.Char8 (Parser) 13 | import Data.ByteString (ByteString) 14 | ------------------------------------------------------------------------------ 15 | import System.IO.Streams.Internal (InputStream) 16 | import qualified System.IO.Streams.Internal as Streams 17 | import System.IO.Streams.Internal.Attoparsec (ParseData (..), ParseException (..), parseFromStreamInternal) 18 | 19 | ------------------------------------------------------------------------------ 20 | -- | Supplies an @attoparsec@ 'Parser' with an 'InputStream', returning the 21 | -- final parsed value or throwing a 'ParseException' if parsing fails. 22 | -- 23 | -- 'parseFromStream' consumes only as much input as necessary to satisfy the 24 | -- 'Parser': any unconsumed input is pushed back onto the 'InputStream'. 25 | -- 26 | -- If the 'Parser' exhausts the 'InputStream', the end-of-stream signal is sent 27 | -- to attoparsec. 28 | -- 29 | -- Example: 30 | -- 31 | -- @ 32 | -- ghci> import "Data.Attoparsec.ByteString.Char8" 33 | -- ghci> is <- 'System.IO.Streams.fromList' [\"12345xxx\" :: 'ByteString'] 34 | -- ghci> 'parseFromStream' ('Data.Attoparsec.ByteString.Char8.takeWhile' 'Data.Attoparsec.ByteString.Char8.isDigit') is 35 | -- \"12345\" 36 | -- ghci> 'System.IO.Streams.read' is 37 | -- Just \"xxx\" 38 | -- @ 39 | parseFromStream :: Parser r 40 | -> InputStream ByteString 41 | -> IO r 42 | parseFromStream = parseFromStreamInternal parse feed 43 | 44 | ------------------------------------------------------------------------------ 45 | -- | Given a 'Parser' yielding values of type @'Maybe' r@, transforms an 46 | -- 'InputStream' over byte strings to an 'InputStream' yielding values of type 47 | -- @r@. 48 | -- 49 | -- If the parser yields @Just x@, then @x@ will be passed along downstream, and 50 | -- if the parser yields @Nothing@, that will be interpreted as end-of-stream. 51 | -- 52 | -- Upon a parse error, 'parserToInputStream' will throw a 'ParseException'. 53 | -- 54 | -- Example: 55 | -- 56 | -- @ 57 | -- ghci> import "Control.Applicative" 58 | -- ghci> import "Data.Attoparsec.ByteString.Char8" 59 | -- ghci> is <- 'System.IO.Streams.fromList' [\"1 2 3 4 5\" :: 'ByteString'] 60 | -- ghci> let parser = ('Data.Attoparsec.ByteString.Char8.endOfInput' >> 'Control.Applicative.pure' 'Nothing') \<|\> (Just \<$\> ('Data.Attoparsec.ByteString.Char8.skipWhile' 'Data.Attoparsec.ByteString.Char8.isSpace' *> 'Data.Attoparsec.ByteString.Char8.decimal')) 61 | -- ghci> 'parserToInputStream' parser is >>= 'System.IO.Streams.toList' 62 | -- [1,2,3,4,5] 63 | -- ghci> is' \<- 'System.IO.Streams.fromList' [\"1 2xx3 4 5\" :: 'ByteString'] >>= 'parserToInputStream' parser 64 | -- ghci> 'read' is' 65 | -- Just 1 66 | -- ghci> 'read' is' 67 | -- Just 2 68 | -- ghci> 'read' is' 69 | -- *** Exception: Parse exception: Failed reading: takeWhile1 70 | -- @ 71 | parserToInputStream :: Parser (Maybe r) 72 | -> InputStream ByteString 73 | -> IO (InputStream r) 74 | parserToInputStream = (Streams.makeInputStream .) . parseFromStream 75 | {-# INLINE parserToInputStream #-} 76 | -------------------------------------------------------------------------------- /src/System/IO/Streams/Attoparsec/Text.hs: -------------------------------------------------------------------------------- 1 | -- | This module provides support for parsing values from Text 2 | -- 'InputStream's using @attoparsec@. /Since: 1.4.0.0./ 3 | 4 | module System.IO.Streams.Attoparsec.Text 5 | ( -- * Parsing 6 | parseFromStream 7 | , parserToInputStream 8 | , ParseException(..) 9 | ) where 10 | 11 | ------------------------------------------------------------------------------ 12 | import Data.Attoparsec.Text (Parser) 13 | import Data.Text (Text) 14 | ------------------------------------------------------------------------------ 15 | import System.IO.Streams.Internal (InputStream) 16 | import qualified System.IO.Streams.Internal as Streams 17 | import System.IO.Streams.Internal.Attoparsec (ParseData (..), ParseException (..), parseFromStreamInternal) 18 | 19 | 20 | ------------------------------------------------------------------------------ 21 | -- | Supplies an @attoparsec@ 'Parser' with an 'InputStream', returning the 22 | -- final parsed value or throwing a 'ParseException' if parsing fails. 23 | -- 24 | -- 'parseFromStream' consumes only as much input as necessary to satisfy the 25 | -- 'Parser': any unconsumed input is pushed back onto the 'InputStream'. 26 | -- 27 | -- If the 'Parser' exhausts the 'InputStream', the end-of-stream signal is sent 28 | -- to attoparsec. 29 | -- 30 | -- Example: 31 | -- 32 | -- @ 33 | -- ghci> import "Data.Attoparsec.Text" 34 | -- ghci> is <- 'System.IO.Streams.fromList' [\"12345xxx\" :: 'Text'] 35 | -- ghci> 'parseFromStream' ('Data.Attoparsec.Text.takeWhile' 'Data.Char.isDigit') is 36 | -- \"12345\" 37 | -- ghci> 'System.IO.Streams.read' is 38 | -- Just \"xxx\" 39 | -- @ 40 | parseFromStream :: Parser r 41 | -> InputStream Text 42 | -> IO r 43 | parseFromStream = parseFromStreamInternal parse feed 44 | 45 | ------------------------------------------------------------------------------ 46 | -- | Given a 'Parser' yielding values of type @'Maybe' r@, transforms an 47 | -- 'InputStream' over byte strings to an 'InputStream' yielding values of type 48 | -- @r@. 49 | -- 50 | -- If the parser yields @Just x@, then @x@ will be passed along downstream, and 51 | -- if the parser yields @Nothing@, that will be interpreted as end-of-stream. 52 | -- 53 | -- Upon a parse error, 'parserToInputStream' will throw a 'ParseException'. 54 | -- 55 | -- Example: 56 | -- 57 | -- @ 58 | -- ghci> import "Control.Applicative" 59 | -- ghci> import "Data.Attoparsec.Text" 60 | -- ghci> is <- 'System.IO.Streams.fromList' [\"1 2 3 4 5\" :: 'Text'] 61 | -- ghci> let parser = ('Data.Attoparsec.Text.endOfInput' >> 'Control.Applicative.pure' 'Nothing') \<|\> (Just \<$\> ('Data.Attoparsec.Text.skipWhile' 'Data.Attoparsec.Text.isSpace' *> 'Data.Attoparsec.Text.decimal')) 62 | -- ghci> 'parserToInputStream' parser is >>= 'System.IO.Streams.toList' 63 | -- [1,2,3,4,5] 64 | -- ghci> is' \<- 'System.IO.Streams.fromList' [\"1 2xx3 4 5\" :: 'Text'] >>= 'parserToInputStream' parser 65 | -- ghci> 'read' is' 66 | -- Just 1 67 | -- ghci> 'read' is' 68 | -- Just 2 69 | -- ghci> 'read' is' 70 | -- *** Exception: Parse exception: Failed reading: takeWhile1 71 | -- @ 72 | parserToInputStream :: Parser (Maybe r) 73 | -> InputStream Text 74 | -> IO (InputStream r) 75 | parserToInputStream = (Streams.makeInputStream .) . parseFromStream 76 | {-# INLINE parserToInputStream #-} 77 | -------------------------------------------------------------------------------- /src/System/IO/Streams/Builder.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE BangPatterns #-} 2 | {-# LANGUAGE CPP #-} 3 | {-# LANGUAGE OverloadedStrings #-} 4 | 5 | -- | Buffering for output streams based on bytestring builders. 6 | -- 7 | -- Buffering an output stream can often improve throughput by reducing the 8 | -- number of system calls made through the file descriptor. The @bytestring@ 9 | -- package provides an efficient monoidal datatype used for serializing values 10 | -- directly to an output buffer, called a 'Builder', originally implemented in 11 | -- the @blaze-builder@ package by Simon Meier. When compiling with @bytestring@ 12 | -- versions older than 0.10.4, (i.e. GHC <= 7.6) users must depend on the 13 | -- @bytestring-builder@ library to get the new builder implementation. Since we 14 | -- try to maintain compatibility with the last three GHC versions, the 15 | -- dependency on @bytestring-builder@ can be dropped after the release of GHC 16 | -- 7.12. 17 | -- 18 | -- 19 | -- /Using this module/ 20 | -- 21 | -- Given an 'OutputStream' taking 'ByteString': 22 | -- 23 | -- > someOutputStream :: OutputStream ByteString 24 | -- 25 | -- You create a new output stream wrapping the original one that accepts 26 | -- 'Builder' values: 27 | -- 28 | -- 29 | -- @ 30 | -- do 31 | -- newStream <- Streams.'builderStream' someOutputStream 32 | -- Streams.'write' ('Just' $ 'Data.ByteString.Builder.byteString' \"hello\") newStream 33 | -- .... 34 | -- @ 35 | -- 36 | -- 37 | -- You can flush the output buffer using 'Data.ByteString.Builder.Extra.flush': 38 | -- 39 | -- @ 40 | -- .... 41 | -- Streams.'write' ('Just' 'Data.ByteString.Builder.Extra.flush') newStream 42 | -- .... 43 | -- @ 44 | -- 45 | -- As a convention, 'builderStream' will write the empty string to the wrapped 46 | -- 'OutputStream' upon a builder buffer flush. Output streams which receive 47 | -- 'ByteString' should either ignore the empty string or interpret it as a 48 | -- signal to flush their own buffers, as the @handleToOutputStream@ and 49 | -- "System.IO.Streams.Zlib" functions do. 50 | -- 51 | -- /Example/ 52 | -- 53 | -- @ 54 | -- example :: IO [ByteString] 55 | -- example = do 56 | -- let l1 = 'Data.List.intersperse' \" \" [\"the\", \"quick\", \"brown\", \"fox\"] 57 | -- let l2 = 'Data.List.intersperse' \" \" [\"jumped\", \"over\", \"the\"] 58 | -- let l = map 'Data.ByteString.Builder.byteString' l1 ++ ['Data.ByteString.Builder.Extra.flush'] ++ map 'Data.ByteString.Builder.byteString' l2 59 | -- is \<- Streams.'System.IO.Streams.fromList' l 60 | -- (os0, grab) \<- Streams.'System.IO.Streams.listOutputStream' 61 | -- os \<- Streams.'builderStream' os0 62 | -- Streams.'System.IO.Streams.connect' is os >> grab 63 | -- 64 | -- ghci> example 65 | -- [\"the quick brown fox\",\"\",\"jumped over the\"] 66 | -- @ 67 | -- 68 | module System.IO.Streams.Builder 69 | ( -- * Blaze builder conversion 70 | builderStream 71 | , builderStreamWithBufferSize 72 | , unsafeBuilderStream 73 | ) where 74 | 75 | ------------------------------------------------------------------------------ 76 | import Control.Monad (when) 77 | import Data.ByteString.Builder.Internal (Buffer (..), BufferRange (..), Builder, byteStringFromBuffer, defaultChunkSize, fillWithBuildStep, newBuffer, runBuilder) 78 | import Data.ByteString.Char8 (ByteString) 79 | import qualified Data.ByteString.Char8 as S 80 | import Data.IORef (newIORef, readIORef, writeIORef) 81 | 82 | ------------------------------------------------------------------------------ 83 | import System.IO.Streams.Internal (OutputStream, makeOutputStream, write, writeTo) 84 | 85 | 86 | ------------------------------------------------------------------------------ 87 | builderStreamWithBufferFunc :: IO Buffer 88 | -> OutputStream ByteString 89 | -> IO (OutputStream Builder) 90 | builderStreamWithBufferFunc mkNewBuf os = do 91 | ref <- newIORef Nothing 92 | makeOutputStream $ chunk ref 93 | where 94 | chunk ref Nothing = do 95 | mbuf <- readIORef ref 96 | case mbuf of 97 | -- If we existing buffer leftovers, write them to the output. 98 | Nothing -> return $! () 99 | Just buf -> writeBuf buf 100 | write Nothing os 101 | chunk ref (Just builder) = runStep ref $ runBuilder builder 102 | 103 | getBuf ref = readIORef ref >>= maybe mkNewBuf return 104 | 105 | bumpBuf (Buffer fp (BufferRange !_ endBuf)) endPtr = 106 | Buffer fp (BufferRange endPtr endBuf) 107 | 108 | updateBuf ref buf endPtr = writeIORef ref $! Just $! bumpBuf buf endPtr 109 | 110 | writeBuf buf = do 111 | let bs = byteStringFromBuffer buf 112 | when (not . S.null $ bs) $ writeTo os $! Just bs 113 | 114 | bufRange (Buffer _ rng) = rng 115 | 116 | runStep ref step = do 117 | buf <- getBuf ref 118 | fillWithBuildStep step (cDone buf) (cFull buf) (cInsert buf) 119 | (bufRange buf) 120 | where 121 | cDone buf endPtr !() = updateBuf ref buf endPtr 122 | cFull buf !endPtr !_ newStep = do 123 | writeBuf $! bumpBuf buf endPtr 124 | writeIORef ref Nothing 125 | runStep ref newStep 126 | cInsert buf !endPtr !bs newStep = do 127 | writeBuf $! bumpBuf buf endPtr 128 | writeIORef ref Nothing 129 | writeTo os $! Just bs 130 | runStep ref newStep 131 | 132 | 133 | ------------------------------------------------------------------------------ 134 | -- | Converts a 'ByteString' sink into a 'Builder' sink, using the supplied 135 | -- buffer size. 136 | -- 137 | -- Note that if the generated builder receives a 138 | -- 'Blaze.ByteString.Builder.flush', by convention it will send an empty string 139 | -- to the supplied @'OutputStream' 'ByteString'@ to indicate that any output 140 | -- buffers are to be flushed. 141 | -- 142 | -- /Since: 1.3.0.0./ 143 | builderStreamWithBufferSize :: Int -> OutputStream ByteString -> IO (OutputStream Builder) 144 | builderStreamWithBufferSize bufsiz = builderStreamWithBufferFunc (newBuffer bufsiz) 145 | 146 | 147 | ------------------------------------------------------------------------------ 148 | -- | Converts a 'ByteString' sink into a 'Builder' sink. 149 | -- 150 | -- Note that if the generated builder receives a 151 | -- 'Blaze.ByteString.Builder.flush', by convention it will send an empty string 152 | -- to the supplied @'OutputStream' 'ByteString'@ to indicate that any output 153 | -- buffers are to be flushed. 154 | -- 155 | builderStream :: OutputStream ByteString -> IO (OutputStream Builder) 156 | builderStream = builderStreamWithBufferSize defaultChunkSize 157 | 158 | 159 | ------------------------------------------------------------------------------ 160 | -- | Unsafe variation on 'builderStream' that reuses an existing buffer for 161 | -- efficiency. 162 | -- 163 | -- /NOTE/: because the buffer is reused, subsequent 'ByteString' values written 164 | -- to the wrapped 'OutputString' will cause previous yielded strings to change. 165 | -- Do not retain references to these 'ByteString' values inside the 166 | -- 'OutputStream' you pass to this function, or you will violate referential 167 | -- transparency. 168 | -- 169 | -- If you /must/ retain copies of these values, then please use 170 | -- 'Data.ByteString.copy' to ensure that you have a fresh copy of the 171 | -- underlying string. 172 | -- 173 | -- You can create a Buffer with 'Data.ByteString.Builder.Internal.newBuffer'. 174 | -- 175 | unsafeBuilderStream :: IO Buffer 176 | -> OutputStream ByteString 177 | -> IO (OutputStream Builder) 178 | unsafeBuilderStream mkBuf os = do 179 | buf <- mkBuf 180 | builderStreamWithBufferFunc (return buf) os 181 | -------------------------------------------------------------------------------- /src/System/IO/Streams/Concurrent.hs: -------------------------------------------------------------------------------- 1 | -- | Stream utilities for working with concurrent channels. 2 | 3 | {-# LANGUAGE BangPatterns #-} 4 | {-# LANGUAGE CPP #-} 5 | 6 | module System.IO.Streams.Concurrent 7 | ( -- * Channel conversions 8 | inputToChan 9 | , chanToInput 10 | , chanToOutput 11 | , concurrentMerge 12 | , makeChanPipe 13 | ) where 14 | 15 | ------------------------------------------------------------------------------ 16 | #if !MIN_VERSION_base(4,8,0) 17 | import Control.Applicative ((<$>), (<*>)) 18 | #endif 19 | import Control.Concurrent (forkIO) 20 | import Control.Concurrent.Chan (Chan, newChan, readChan, writeChan) 21 | import Control.Concurrent.MVar (modifyMVar, newEmptyMVar, newMVar, putMVar, takeMVar) 22 | import Control.Exception (SomeException, mask, throwIO, try) 23 | import Control.Monad (forM_) 24 | import Prelude hiding (read) 25 | ------------------------------------------------------------------------------ 26 | import System.IO.Streams.Internal (InputStream, OutputStream, makeInputStream, makeOutputStream, nullInput, read) 27 | 28 | 29 | ------------------------------------------------------------------------------ 30 | -- | Writes the contents of an input stream to a channel until the input stream 31 | -- yields end-of-stream. 32 | inputToChan :: InputStream a -> Chan (Maybe a) -> IO () 33 | inputToChan is ch = go 34 | where 35 | go = do 36 | mb <- read is 37 | writeChan ch mb 38 | maybe (return $! ()) (const go) mb 39 | 40 | 41 | ------------------------------------------------------------------------------ 42 | -- | Turns a 'Chan' into an input stream. 43 | -- 44 | chanToInput :: Chan (Maybe a) -> IO (InputStream a) 45 | chanToInput ch = makeInputStream $! readChan ch 46 | 47 | 48 | ------------------------------------------------------------------------------ 49 | -- | Turns a 'Chan' into an output stream. 50 | -- 51 | chanToOutput :: Chan (Maybe a) -> IO (OutputStream a) 52 | chanToOutput = makeOutputStream . writeChan 53 | 54 | 55 | ------------------------------------------------------------------------------ 56 | -- | Concurrently merges a list of 'InputStream's, combining values in the 57 | -- order they become available. 58 | -- 59 | -- Note: does /not/ forward individual end-of-stream notifications, the 60 | -- produced stream does not yield end-of-stream until all of the input streams 61 | -- have finished. 62 | -- 63 | -- Any exceptions raised in one of the worker threads will be trapped and 64 | -- re-raised in the current thread. 65 | -- 66 | -- If the supplied list is empty, `concurrentMerge` will return an empty 67 | -- stream. (/Since: 1.5.0.1/) 68 | -- 69 | concurrentMerge :: [InputStream a] -> IO (InputStream a) 70 | concurrentMerge [] = nullInput 71 | concurrentMerge iss = do 72 | mv <- newEmptyMVar 73 | nleft <- newMVar $! length iss 74 | mask $ \restore -> forM_ iss $ \is -> forkIO $ do 75 | let producer = do 76 | emb <- try $ restore $ read is 77 | case emb of 78 | Left exc -> do putMVar mv (Left (exc :: SomeException)) 79 | producer 80 | Right Nothing -> putMVar mv $! Right Nothing 81 | Right x -> putMVar mv (Right x) >> producer 82 | producer 83 | makeInputStream $ chunk mv nleft 84 | 85 | where 86 | chunk mv nleft = do 87 | emb <- takeMVar mv 88 | case emb of 89 | Left exc -> throwIO exc 90 | Right Nothing -> do x <- modifyMVar nleft $ \n -> 91 | let !n' = n - 1 92 | in return $! (n', n') 93 | if x > 0 94 | then chunk mv nleft 95 | else return Nothing 96 | Right x -> return x 97 | 98 | 99 | -------------------------------------------------------------------------------- 100 | -- | Create a new pair of streams using an underlying 'Chan'. Everything written 101 | -- to the 'OutputStream' will appear as-is on the 'InputStream'. 102 | -- 103 | -- Since reading from the 'InputStream' and writing to the 'OutputStream' are 104 | -- blocking calls, be sure to do so in different threads. 105 | makeChanPipe :: IO (InputStream a, OutputStream a) 106 | makeChanPipe = do 107 | chan <- newChan 108 | (,) <$> chanToInput chan <*> chanToOutput chan 109 | -------------------------------------------------------------------------------- /src/System/IO/Streams/Core.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | 4 | -- | Core types and functions for the @io-streams@ library. 5 | -- 6 | module System.IO.Streams.Core 7 | ( -- * Stream types 8 | InputStream 9 | , OutputStream 10 | 11 | -- * Creating streams 12 | , makeInputStream 13 | , makeOutputStream 14 | 15 | -- * Primitive stream operations 16 | , read 17 | , unRead 18 | , peek 19 | , write 20 | , writeTo 21 | , atEOF 22 | 23 | -- * Connecting streams together 24 | , connect 25 | , connectTo 26 | , supply 27 | , supplyTo 28 | , appendInputStream 29 | , concatInputStreams 30 | 31 | -- * Thread safety \/ concurrency 32 | , lockingInputStream 33 | , lockingOutputStream 34 | 35 | -- * Utility streams 36 | , nullInput 37 | , nullOutput 38 | 39 | -- * Generator monad 40 | , Generator 41 | , fromGenerator 42 | , yield 43 | ) where 44 | 45 | ------------------------------------------------------------------------------ 46 | import Prelude () 47 | import System.IO.Streams.Internal 48 | -------------------------------------------------------------------------------- /src/System/IO/Streams/Debug.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | -- | Convenience module for debugging streams. Provides stream transformers 4 | -- that wrap 'InputStream's and 'OutputStream's, sending a description of all 5 | -- data to an 'OutputStream' for debugging. 6 | 7 | module System.IO.Streams.Debug 8 | ( -- * Debuggers 9 | debugInput 10 | , debugOutput 11 | , debugInputBS 12 | , debugOutputBS 13 | ) where 14 | 15 | ------------------------------------------------------------------------------ 16 | import Data.ByteString.Char8 (ByteString) 17 | import qualified Data.ByteString.Char8 as S 18 | ------------------------------------------------------------------------------ 19 | import System.IO.Streams.Internal (InputStream (..), OutputStream) 20 | import qualified System.IO.Streams.Internal as Streams 21 | 22 | 23 | ------------------------------------------------------------------------------ 24 | debugInput :: 25 | (a -> ByteString) -- ^ function to convert stream elements to 26 | -- 'ByteString' 27 | -> ByteString -- ^ name of this debug stream, will be 28 | -- prepended to debug output 29 | -> OutputStream ByteString -- ^ stream the debug info will be sent to 30 | -> InputStream a -- ^ input stream 31 | -> IO (InputStream a) 32 | debugInput toBS name debugStream inputStream = return $ InputStream produce pb 33 | where 34 | produce = do 35 | m <- Streams.read inputStream 36 | Streams.write (Just $! describe m) debugStream 37 | return m 38 | 39 | pb c = do 40 | let s = S.concat [name, ": pushback: ", toBS c, "\n"] 41 | Streams.write (Just s) debugStream 42 | Streams.unRead c inputStream 43 | 44 | describe m = S.concat [name, ": got ", describeChunk m, "\n"] 45 | 46 | describeChunk Nothing = "EOF" 47 | describeChunk (Just s) = S.concat [ "chunk: ", toBS s ] 48 | 49 | 50 | ------------------------------------------------------------------------------ 51 | debugInputBS :: 52 | ByteString -- ^ name of this debug stream, will be 53 | -- prepended to debug output 54 | -> OutputStream ByteString -- ^ stream the debug info will be sent to 55 | -> InputStream ByteString -- ^ input stream 56 | -> IO (InputStream ByteString) 57 | debugInputBS = debugInput condense 58 | 59 | 60 | ------------------------------------------------------------------------------ 61 | debugOutput :: (a -> ByteString) -- ^ function to convert stream 62 | -- elements to 'ByteString' 63 | -> ByteString -- ^ name of this debug stream, will be 64 | -- prepended to debug output 65 | -> OutputStream ByteString -- ^ debug stream 66 | -> OutputStream a -- ^ output stream 67 | -> IO (OutputStream a) 68 | debugOutput toBS name debugStream outputStream = 69 | Streams.makeOutputStream f 70 | where 71 | f m = do 72 | Streams.write (Just $ describe m) debugStream 73 | Streams.write m outputStream 74 | 75 | describe m = S.concat [name, ": got ", describeChunk m, "\n"] 76 | 77 | describeChunk Nothing = "EOF" 78 | describeChunk (Just s) = S.concat [ "chunk: ", toBS s] 79 | 80 | 81 | ------------------------------------------------------------------------------ 82 | debugOutputBS :: 83 | ByteString -- ^ name of this debug stream, will be 84 | -- prepended to debug output 85 | -> OutputStream ByteString -- ^ stream the debug info will be sent to 86 | -> OutputStream ByteString -- ^ output stream 87 | -> IO (OutputStream ByteString) 88 | debugOutputBS = debugOutput condense 89 | 90 | 91 | ------------------------------------------------------------------------------ 92 | condense :: ByteString -> ByteString 93 | condense s | l < 32 = S.concat [ "\"", s, "\"" ] 94 | | otherwise = S.concat [ 95 | "\"" 96 | , S.take k s 97 | , " ... " 98 | , S.drop (l - k) s 99 | , "\" (" 100 | , S.pack (show l) 101 | , " bytes)" 102 | ] 103 | where 104 | k = 14 105 | l = S.length s 106 | -------------------------------------------------------------------------------- /src/System/IO/Streams/File.hs: -------------------------------------------------------------------------------- 1 | -- | Input and output streams for files. 2 | -- 3 | -- The functions in this file use \"with*\" or \"bracket\" semantics, i.e. they 4 | -- open the supplied 'FilePath', run a user computation, and then close the 5 | -- file handle. If you need more control over the lifecycle of the underlying 6 | -- file descriptor resources, you are encouraged to use the functions from 7 | -- "System.IO.Streams.Handle" instead. 8 | module System.IO.Streams.File 9 | ( -- * File conversions 10 | withFileAsInput 11 | , withFileAsInputStartingAt 12 | , unsafeWithFileAsInputStartingAt 13 | , withFileAsOutput 14 | , withFileAsOutputExt 15 | ) where 16 | 17 | ------------------------------------------------------------------------------ 18 | import Control.Monad (unless) 19 | import Data.ByteString (ByteString) 20 | import Data.Int (Int64) 21 | import System.IO (BufferMode (NoBuffering), IOMode (ReadMode, WriteMode), SeekMode (AbsoluteSeek), hSeek, hSetBuffering, withBinaryFile) 22 | ------------------------------------------------------------------------------ 23 | import System.IO.Streams.Handle (handleToInputStream, handleToOutputStream) 24 | import System.IO.Streams.Internal (InputStream, OutputStream) 25 | 26 | 27 | ------------------------------------------------------------------------------ 28 | -- | @'withFileAsInput' name act@ opens the specified file in \"read mode\" and 29 | -- passes the resulting 'InputStream' to the computation @act@. The file will 30 | -- be closed on exit from @withFileAsInput@, whether by normal termination or 31 | -- by raising an exception. 32 | -- 33 | -- If closing the file raises an exception, then /that/ exception will be 34 | -- raised by 'withFileAsInput' rather than any exception raised by @act@. 35 | withFileAsInput :: FilePath -- ^ file to open 36 | -> (InputStream ByteString -> IO a) -- ^ function to run 37 | -> IO a 38 | withFileAsInput = withFileAsInputStartingAt 0 39 | 40 | 41 | ------------------------------------------------------------------------------ 42 | -- | Like 'withFileAsInput', but seeks to the specified byte offset before 43 | -- attaching the given file descriptor to the 'InputStream'. 44 | withFileAsInputStartingAt 45 | :: Int64 -- ^ starting index to seek to 46 | -> FilePath -- ^ file to open 47 | -> (InputStream ByteString -> IO a) -- ^ function to run 48 | -> IO a 49 | withFileAsInputStartingAt idx fp m = withBinaryFile fp ReadMode go 50 | where 51 | go h = do 52 | unless (idx == 0) $ hSeek h AbsoluteSeek $ toInteger idx 53 | handleToInputStream h >>= m 54 | 55 | 56 | ------------------------------------------------------------------------------ 57 | -- | Like 'withFileAsInputStartingAt', except that the 'ByteString' emitted by 58 | -- the created 'InputStream' may reuse its buffer. You may only use this 59 | -- function if you do not retain references to the generated bytestrings 60 | -- emitted. 61 | unsafeWithFileAsInputStartingAt 62 | :: Int64 -- ^ starting index to seek to 63 | -> FilePath -- ^ file to open 64 | -> (InputStream ByteString -> IO a) -- ^ function to run 65 | -> IO a 66 | unsafeWithFileAsInputStartingAt = withFileAsInputStartingAt 67 | 68 | 69 | ------------------------------------------------------------------------------ 70 | -- | Open a file for writing and attaches an 'OutputStream' for you to write 71 | -- to. The file will be closed on error or completion of your action. 72 | withFileAsOutput 73 | :: FilePath -- ^ file to open 74 | -> (OutputStream ByteString -> IO a) -- ^ function to run 75 | -> IO a 76 | withFileAsOutput f = withFileAsOutputExt f WriteMode NoBuffering 77 | 78 | 79 | ------------------------------------------------------------------------------ 80 | -- | Like 'withFileAsOutput', but allowing you control over the output file 81 | -- mode and buffering behaviour. 82 | withFileAsOutputExt 83 | :: FilePath -- ^ file to open 84 | -> IOMode -- ^ mode to write in 85 | -> BufferMode -- ^ should we buffer the output? 86 | -> (OutputStream ByteString -> IO a) -- ^ function to run 87 | -> IO a 88 | withFileAsOutputExt fp iomode buffermode m = withBinaryFile fp iomode $ \h -> do 89 | hSetBuffering h buffermode 90 | handleToOutputStream h >>= m 91 | -------------------------------------------------------------------------------- /src/System/IO/Streams/Handle.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE FlexibleInstances #-} 3 | 4 | #if __GLASGOW_HASKELL__ >= 702 5 | {-# LANGUAGE Trustworthy #-} 6 | #endif 7 | 8 | -- | Input and output streams for file 'Handle's. 9 | module System.IO.Streams.Handle 10 | ( -- * Handle conversions 11 | handleToInputStream 12 | , handleToOutputStream 13 | , handleToStreams 14 | , inputStreamToHandle 15 | , outputStreamToHandle 16 | , streamPairToHandle 17 | 18 | -- * Standard system handles 19 | , stdin 20 | , stdout 21 | , stderr 22 | ) where 23 | 24 | ------------------------------------------------------------------------------ 25 | import Data.ByteString (ByteString) 26 | import qualified Data.ByteString as S 27 | import qualified GHC.IO.Handle as H 28 | import System.IO (Handle, hFlush) 29 | import qualified System.IO as IO 30 | import System.IO.Unsafe (unsafePerformIO) 31 | ------------------------------------------------------------------------------ 32 | import System.IO.Streams.Internal (InputStream, OutputStream, SP (..), lockingInputStream, lockingOutputStream, makeInputStream, makeOutputStream) 33 | 34 | 35 | ------------------------------------------------------------------------------ 36 | bUFSIZ :: Int 37 | bUFSIZ = 32752 38 | 39 | 40 | ------------------------------------------------------------------------------ 41 | -- | Converts a read-only handle into an 'InputStream' of strict 'ByteString's. 42 | -- 43 | -- Note that the wrapped handle is /not/ closed when it yields end-of-stream; 44 | -- you can use 'System.IO.Streams.Combinators.atEndOfInput' to close the handle 45 | -- if you would like this behaviour. 46 | handleToInputStream :: Handle -> IO (InputStream ByteString) 47 | handleToInputStream h = makeInputStream f 48 | where 49 | f = do 50 | x <- S.hGetSome h bUFSIZ 51 | return $! if S.null x then Nothing else Just x 52 | 53 | 54 | ------------------------------------------------------------------------------ 55 | -- | Converts a writable handle into an 'OutputStream' of strict 'ByteString's. 56 | -- 57 | -- Note that the wrapped handle is /not/ closed when it receives end-of-stream; 58 | -- you can use 'System.IO.Streams.Combinators.atEndOfOutput' to close the 59 | -- handle if you would like this behaviour. 60 | -- 61 | -- /Note/: to force the 'Handle' to be flushed, you can write a null string to 62 | -- the returned 'OutputStream': 63 | -- 64 | -- > Streams.write (Just "") os 65 | handleToOutputStream :: Handle -> IO (OutputStream ByteString) 66 | handleToOutputStream h = makeOutputStream f 67 | where 68 | f Nothing = hFlush h 69 | f (Just x) = if S.null x 70 | then hFlush h 71 | else S.hPut h x 72 | 73 | 74 | ------------------------------------------------------------------------------ 75 | -- | Converts a readable and writable handle into an 'InputStream'/'OutputStream' 76 | -- of strict 'ByteString's. 77 | -- 78 | -- Note that the wrapped handle is /not/ closed when it receives 79 | -- end-of-stream; you can use 80 | -- 'System.IO.Streams.Combinators.atEndOfOutput' to close the handle 81 | -- if you would like this behaviour. 82 | -- 83 | -- /Note/: to force the 'Handle' to be flushed, you can write a null string to 84 | -- the returned 'OutputStream': 85 | -- 86 | -- > Streams.write (Just "") os 87 | -- 88 | -- /Since: 1.3.4.0./ 89 | handleToStreams :: Handle 90 | -> IO (InputStream ByteString, OutputStream ByteString) 91 | handleToStreams h = do 92 | is <- handleToInputStream h 93 | os <- handleToOutputStream h 94 | return $! (is, os) 95 | 96 | 97 | ------------------------------------------------------------------------------ 98 | -- | Converts an 'InputStream' over bytestrings to a read-only 'Handle'. Note 99 | -- that the generated handle is opened unbuffered in binary mode (i.e. no 100 | -- newline translation is performed). 101 | -- 102 | -- Note: the 'InputStream' passed into this function is wrapped in 103 | -- 'lockingInputStream' to make it thread-safe. 104 | -- 105 | -- /Since: 1.0.2.0./ 106 | inputStreamToHandle :: InputStream ByteString -> IO Handle 107 | inputStreamToHandle is0 = do 108 | is <- lockingInputStream is0 109 | h <- H.mkDuplexHandle is "*input-stream*" Nothing $! H.noNewlineTranslation 110 | H.hSetBuffering h H.NoBuffering 111 | return h 112 | 113 | 114 | ------------------------------------------------------------------------------ 115 | -- | Converts an 'OutputStream' over bytestrings to a write-only 'Handle'. Note 116 | -- that the 'Handle' will be opened in non-buffering mode; if you buffer the 117 | -- 'OutputStream' using the 'Handle' buffering then @io-streams@ will copy the 118 | -- 'Handle' buffer when sending 'ByteString' values to the output, which might 119 | -- not be what you want. 120 | -- 121 | -- When the output buffer, if used, is flushed (using 'System.IO.hFlush'), an 122 | -- empty string is written to the provided 'OutputStream'. 123 | -- 124 | -- /Note/: the 'OutputStream' passed into this function is wrapped in 125 | -- 'lockingOutputStream' to make it thread-safe. 126 | -- 127 | -- /Since: 1.0.2.0./ 128 | outputStreamToHandle :: OutputStream ByteString -> IO Handle 129 | outputStreamToHandle os0 = do 130 | os <- lockingOutputStream os0 131 | h <- H.mkDuplexHandle os "*output-stream*" Nothing $! H.noNewlineTranslation 132 | H.hSetBuffering h H.NoBuffering 133 | return $! h 134 | 135 | 136 | ------------------------------------------------------------------------------ 137 | -- | Converts a pair of 'InputStream' and 'OutputStream' over bytestrings to a 138 | -- read-write 'Handle'. 139 | -- 140 | -- Note: the streams passed into this function are wrapped in 141 | -- locking primitives to make them thread-safe. 142 | -- 143 | -- /Since: 1.0.2.0./ 144 | streamPairToHandle :: InputStream ByteString -> OutputStream ByteString -> IO Handle 145 | streamPairToHandle is0 os0 = do 146 | is <- lockingInputStream is0 147 | os <- lockingOutputStream os0 148 | h <- H.mkDuplexHandle (SP is os) "*stream*" Nothing $! H.noNewlineTranslation 149 | H.hSetBuffering h H.NoBuffering 150 | return $! h 151 | 152 | 153 | ------------------------------------------------------------------------------ 154 | -- | An 'InputStream' for 'IO.stdin'. 155 | stdin :: InputStream ByteString 156 | stdin = unsafePerformIO (handleToInputStream IO.stdin >>= lockingInputStream) 157 | {-# NOINLINE stdin #-} 158 | 159 | 160 | ------------------------------------------------------------------------------ 161 | -- | An 'OutputStream' for 'IO.stdout'. 162 | stdout :: OutputStream ByteString 163 | stdout = unsafePerformIO (handleToOutputStream IO.stdout >>= 164 | lockingOutputStream) 165 | {-# NOINLINE stdout #-} 166 | 167 | 168 | ------------------------------------------------------------------------------ 169 | -- | An 'OutputStream' for 'IO.stderr'. 170 | stderr :: OutputStream ByteString 171 | stderr = unsafePerformIO (handleToOutputStream IO.stderr >>= 172 | lockingOutputStream) 173 | {-# NOINLINE stderr #-} 174 | -------------------------------------------------------------------------------- /src/System/IO/Streams/Internal/Attoparsec.hs: -------------------------------------------------------------------------------- 1 | -- | This module provides support for parsing values from 'InputStream's using 2 | -- @attoparsec@. 3 | 4 | {-# LANGUAGE BangPatterns #-} 5 | {-# LANGUAGE DeriveDataTypeable #-} 6 | {-# LANGUAGE FlexibleContexts #-} 7 | {-# LANGUAGE OverloadedStrings #-} 8 | 9 | module System.IO.Streams.Internal.Attoparsec 10 | ( -- * Parsing 11 | parseFromStreamInternal 12 | 13 | , ParseData(..) 14 | 15 | -- * Parse Exceptions 16 | , ParseException(..) 17 | 18 | , eitherResult 19 | ) where 20 | 21 | ------------------------------------------------------------------------------ 22 | import Control.Exception (Exception, throwIO) 23 | import Control.Monad (unless) 24 | import qualified Data.Attoparsec.ByteString.Char8 as S 25 | import qualified Data.Attoparsec.Text as T 26 | import Data.Attoparsec.Types (IResult (..), Parser) 27 | import qualified Data.ByteString as S 28 | import Data.List (intercalate) 29 | import Data.String (IsString) 30 | import qualified Data.Text as T 31 | import Data.Typeable (Typeable) 32 | import Prelude hiding (null, read) 33 | ------------------------------------------------------------------------------ 34 | import System.IO.Streams.Internal (InputStream) 35 | import qualified System.IO.Streams.Internal as Streams 36 | 37 | 38 | ------------------------------------------------------------------------------ 39 | -- | An exception raised when parsing fails. 40 | data ParseException = ParseException String 41 | deriving (Typeable) 42 | 43 | instance Show ParseException where 44 | show (ParseException s) = "Parse exception: " ++ s 45 | 46 | instance Exception ParseException 47 | 48 | 49 | ------------------------------------------------------------------------------ 50 | class (IsString i) => ParseData i where 51 | parse :: Parser i a -> i -> IResult i a 52 | feed :: IResult i r -> i -> IResult i r 53 | null :: i -> Bool 54 | 55 | 56 | ------------------------------------------------------------------------------ 57 | instance ParseData S.ByteString where 58 | parse = S.parse 59 | feed = S.feed 60 | null = S.null 61 | 62 | 63 | ------------------------------------------------------------------------------ 64 | instance ParseData T.Text where 65 | parse = T.parse 66 | feed = T.feed 67 | null = T.null 68 | 69 | 70 | ------------------------------------------------------------------------------ 71 | -- | Internal version of parseFromStream allowing dependency injection of the 72 | -- parse functions for testing. 73 | parseFromStreamInternal :: ParseData i 74 | => (Parser i r -> i -> IResult i r) 75 | -> (IResult i r -> i -> IResult i r) 76 | -> Parser i r 77 | -> InputStream i 78 | -> IO r 79 | parseFromStreamInternal parseFunc feedFunc parser is = 80 | Streams.read is >>= 81 | maybe (finish $ parseFunc parser "") 82 | (\s -> if null s 83 | then parseFromStreamInternal parseFunc feedFunc parser is 84 | else go $! parseFunc parser s) 85 | where 86 | leftover x = unless (null x) $ Streams.unRead x is 87 | 88 | finish k = let k' = feedFunc (feedFunc k "") "" 89 | in case k' of 90 | Fail x _ _ -> leftover x >> err k' 91 | Partial _ -> err k' -- should be impossible 92 | Done x r -> leftover x >> return r 93 | 94 | err r = let (Left (!_,c,m)) = eitherResult r 95 | in throwIO $ ParseException (ctxMsg c ++ m) 96 | 97 | ctxMsg [] = "" 98 | ctxMsg xs = "[parsing " ++ intercalate "/" xs ++ "] " 99 | 100 | go r@(Fail x _ _) = leftover x >> err r 101 | go (Done x r) = leftover x >> return r 102 | go r = Streams.read is >>= 103 | maybe (finish r) 104 | (\s -> if null s 105 | then go r 106 | else go $! feedFunc r s) 107 | 108 | 109 | ------------------------------------------------------------------------------ 110 | -- A replacement for attoparsec's 'eitherResult', which discards information 111 | -- about the context of the failed parse. 112 | eitherResult :: IsString i => IResult i r -> Either (i, [String], String) r 113 | eitherResult (Done _ r) = Right r 114 | eitherResult (Fail residual ctx msg) = Left (residual, ctx, msg) 115 | eitherResult _ = Left ("", [], "Result: incomplete input") 116 | -------------------------------------------------------------------------------- /src/System/IO/Streams/Internal/Network.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | 3 | module System.IO.Streams.Internal.Network 4 | ( socketToStreams 5 | , socketToStreamsWithBufferSize 6 | , socketToStreamsWithBufferSizeImpl 7 | ) where 8 | 9 | 10 | ------------------------------------------------------------------------------ 11 | import Control.Exception (catch) 12 | import qualified Data.ByteString.Char8 as S 13 | import qualified Data.ByteString.Internal as S 14 | import Data.Word (Word8) 15 | import Foreign.ForeignPtr (newForeignPtr, withForeignPtr) 16 | import Foreign.Marshal.Alloc (finalizerFree, mallocBytes) 17 | import Foreign.Ptr (Ptr) 18 | import Network.Socket (Socket) 19 | import qualified Network.Socket as N 20 | import qualified Network.Socket.ByteString as NB 21 | import Prelude (IO, Int, Maybe (..), return, ($!), (<=), (>>=)) 22 | import System.IO.Error (ioError, isEOFError) 23 | ------------------------------------------------------------------------------ 24 | import System.IO.Streams.Internal (InputStream, OutputStream) 25 | import qualified System.IO.Streams.Internal as Streams 26 | 27 | 28 | ------------------------------------------------------------------------------ 29 | bUFSIZ :: Int 30 | bUFSIZ = 4096 31 | 32 | 33 | ------------------------------------------------------------------------------ 34 | -- | Converts a 'Socket' to an 'InputStream' \/ 'OutputStream' pair. Note that, 35 | -- as is usually the case in @io-streams@, writing a 'Nothing' to the generated 36 | -- 'OutputStream' does not cause the underlying 'Socket' to be closed. 37 | socketToStreams :: Socket 38 | -> IO (InputStream S.ByteString, OutputStream S.ByteString) 39 | socketToStreams = socketToStreamsWithBufferSize bUFSIZ 40 | 41 | 42 | ------------------------------------------------------------------------------ 43 | -- | Converts a 'Socket' to an 'InputStream' \/ 'OutputStream' pair, with 44 | -- control over the size of the receive buffers. Note that, as is usually the 45 | -- case in @io-streams@, writing a 'Nothing' to the generated 'OutputStream' 46 | -- does not cause the underlying 'Socket' to be closed. 47 | socketToStreamsWithBufferSize 48 | :: Int -- ^ how large the receive buffer should be 49 | -> Socket -- ^ network socket 50 | -> IO (InputStream S.ByteString, OutputStream S.ByteString) 51 | #if MIN_VERSION_network(2,4,0) 52 | socketToStreamsWithBufferSize = socketToStreamsWithBufferSizeImpl N.recvBuf 53 | #else 54 | socketToStreamsWithBufferSize bufsiz socket = do 55 | is <- Streams.makeInputStream input 56 | os <- Streams.makeOutputStream output 57 | return $! (is, os) 58 | 59 | where 60 | input = do 61 | s <- NB.recv socket bufsiz 62 | return $! if S.null s then Nothing else Just s 63 | 64 | output Nothing = return $! () 65 | output (Just s) = if S.null s then return $! () else NB.sendAll socket s 66 | #endif 67 | 68 | 69 | ------------------------------------------------------------------------------ 70 | -- | Dependency-injected implementation of socketToStreamsWithBufferSize (for 71 | -- testing) 72 | socketToStreamsWithBufferSizeImpl 73 | :: (N.Socket -> Ptr Word8 -> Int -> IO Int) -- ^ recvBuf 74 | -> Int -- ^ how large the receive 75 | -- buffer should be 76 | -> Socket -- ^ network socket 77 | -> IO (InputStream S.ByteString, OutputStream S.ByteString) 78 | socketToStreamsWithBufferSizeImpl _recvBuf bufsiz socket = do 79 | is <- Streams.makeInputStream input 80 | os <- Streams.makeOutputStream output 81 | return $! (is, os) 82 | 83 | where 84 | recv buf = _recvBuf socket buf bufsiz `catch` \ioe -> 85 | if isEOFError ioe then return 0 else ioError ioe 86 | 87 | mkFp = mallocBytes bufsiz >>= newForeignPtr finalizerFree 88 | 89 | input = do 90 | fp <- mkFp 91 | n <- withForeignPtr fp recv 92 | return $! if n <= 0 93 | then Nothing 94 | else Just $! S.fromForeignPtr fp 0 n 95 | 96 | output Nothing = return $! () 97 | output (Just s) = if S.null s then return $! () else NB.sendAll socket s 98 | -------------------------------------------------------------------------------- /src/System/IO/Streams/Internal/Search.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE BangPatterns #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | {-# LANGUAGE RankNTypes #-} 4 | 5 | module System.IO.Streams.Internal.Search 6 | ( search 7 | , MatchInfo(..) 8 | ) where 9 | 10 | ------------------------------------------------------------------------------ 11 | import Control.Monad (when) 12 | import Control.Monad.IO.Class (liftIO) 13 | import Control.Monad.ST (ST) 14 | import Data.ByteString.Char8 (ByteString) 15 | import qualified Data.ByteString.Char8 as S 16 | import qualified Data.ByteString.Unsafe as S 17 | import qualified Data.Vector.Unboxed as V 18 | import qualified Data.Vector.Unboxed.Mutable as MV 19 | import Prelude (Bool (..), Either (..), Enum (..), Eq (..), IO, Int, Monad (..), Num (..), Ord (..), Show, either, id, maybe, not, otherwise, ($), ($!), (&&), (.), (||)) 20 | ------------------------------------------------------------------------------ 21 | import System.IO.Streams.Internal (InputStream) 22 | import qualified System.IO.Streams.Internal as Streams 23 | 24 | 25 | ------------------------------------------------------------------------------ 26 | -- | 'MatchInfo' provides match information when performing string search. 27 | data MatchInfo = Match {-# UNPACK #-} !ByteString 28 | | NoMatch {-# UNPACK #-} !ByteString 29 | deriving (Show, Eq) 30 | 31 | 32 | ------------------------------------------------------------------------------ 33 | -- | Does the given needle match the haystack over the given ranges of indices? 34 | matches :: ByteString -- ^ needle 35 | -> Int -- ^ needle start 36 | -> Int -- ^ needle end (inclusive) 37 | -> ByteString -- ^ haystack 38 | -> Int -- ^ haystack start 39 | -> Int -- ^ haystack end (inclusive) 40 | -> Bool 41 | matches !needle !nstart !nend' !haystack !hstart !hend' = 42 | go nend' hend' 43 | where 44 | go !nend !hend = 45 | if nend < nstart || hend < hstart 46 | then True 47 | else let !nc = S.unsafeIndex needle nend 48 | !hc = S.unsafeIndex haystack hend 49 | in if nc /= hc 50 | then False 51 | else go (nend-1) (hend-1) 52 | {-# INLINE matches #-} 53 | 54 | 55 | ------------------------------------------------------------------------------ 56 | -- | Given a 'ByteString' to look for (the \"needle\") and an 'InputStream', 57 | -- produces a new 'InputStream' which yields data of type 'MatchInfo'. 58 | -- 59 | -- Example: 60 | -- 61 | -- @ 62 | -- ghci> 'System.IO.Streams.fromList' [\"food\", \"oof\", \"oodles\", \"ok\"] >>= 63 | -- 'search' \"foo\" >>= 'System.IO.Streams.toList' 64 | -- ['Match' \"foo\",'NoMatch' \"d\",'NoMatch' \"oo\",'Match' \"foo\",'NoMatch' \"dlesok\"] 65 | -- @ 66 | -- 67 | -- Uses the Boyer-Moore-Horspool algorithm 68 | -- (). 69 | search :: ByteString -- ^ \"needle\" to look for 70 | -> InputStream ByteString -- ^ input stream to wrap 71 | -> IO (InputStream MatchInfo) 72 | search needle stream = Streams.fromGenerator $ 73 | lookahead nlen >>= either finishAndEOF startSearch 74 | 75 | where 76 | -------------------------------------------------------------------------- 77 | finishAndEOF x = if S.null x 78 | then return $! () 79 | else Streams.yield $! NoMatch x 80 | 81 | -------------------------------------------------------------------------- 82 | startSearch !haystack = 83 | if S.null haystack 84 | then lookahead nlen >>= either finishAndEOF startSearch 85 | else go 0 86 | 87 | where 88 | ---------------------------------------------------------------------- 89 | !hlen = S.length haystack 90 | 91 | ---------------------------------------------------------------------- 92 | go !hidx 93 | | hend >= hlen = crossBound hidx 94 | | otherwise = do 95 | let match = matches needle 0 lastIdx haystack hidx hend 96 | if match 97 | then do 98 | let !nomatch = S.take hidx haystack 99 | let !aftermatch = S.drop (hend + 1) haystack 100 | 101 | produceMatch nomatch aftermatch 102 | else do 103 | -- skip ahead 104 | let c = S.unsafeIndex haystack hend 105 | let !skip = V.unsafeIndex table $ fromEnum c 106 | go (hidx + skip) 107 | 108 | where 109 | !hend = hidx + nlen - 1 110 | 111 | ---------------------------------------------------------------------- 112 | mkCoeff hidx = let !ll = hlen - hidx 113 | !nm = nlen - ll 114 | in (ll, nm) 115 | 116 | ---------------------------------------------------------------------- 117 | crossBound !hidx0 = do 118 | let (!leftLen, needMore) = mkCoeff hidx0 119 | 120 | lookahead needMore >>= 121 | either (\s -> finishAndEOF $ S.append haystack s) 122 | (runNext hidx0 leftLen needMore) 123 | 124 | where 125 | runNext !hidx !leftLen !needMore !nextHaystack = do 126 | let match1 = matches needle leftLen lastIdx nextHaystack 0 127 | (needMore-1) 128 | let match2 = matches needle 0 (leftLen-1) haystack hidx 129 | (hlen-1) 130 | 131 | if match1 && match2 132 | then do 133 | let !nomatch = S.take hidx haystack 134 | let !aftermatch = S.drop needMore nextHaystack 135 | 136 | produceMatch nomatch aftermatch 137 | 138 | else do 139 | let c = S.unsafeIndex nextHaystack $ needMore - 1 140 | let p = V.unsafeIndex table (fromEnum c) 141 | 142 | if p < leftLen 143 | then do 144 | let !hidx' = hidx + p 145 | let (!leftLen', needMore') = mkCoeff hidx' 146 | let !nextlen = S.length nextHaystack 147 | if nextlen < needMore' 148 | then 149 | -- this should be impossibly rare 150 | lookahead (needMore' - nextlen) >>= 151 | either (\s -> finishAndEOF $ 152 | S.concat [ haystack 153 | , nextHaystack 154 | , s ]) 155 | (\s -> runNext hidx' leftLen' needMore' $ 156 | S.append nextHaystack s) 157 | else runNext hidx' leftLen' needMore' nextHaystack 158 | else do 159 | let sidx = p - leftLen 160 | let (!crumb, rest) = S.splitAt sidx nextHaystack 161 | Streams.yield $! NoMatch $! S.append haystack crumb 162 | startSearch rest 163 | 164 | -------------------------------------------------------------------------- 165 | produceMatch nomatch aftermatch = do 166 | when (not $ S.null nomatch) $ Streams.yield $! NoMatch nomatch 167 | Streams.yield $! Match needle 168 | startSearch aftermatch 169 | 170 | -------------------------------------------------------------------------- 171 | !nlen = S.length needle 172 | !lastIdx = nlen - 1 173 | 174 | -------------------------------------------------------------------------- 175 | !table = V.create $ do 176 | t <- MV.replicate 256 nlen 177 | go t 178 | 179 | where 180 | go :: forall s . MV.MVector s Int -> ST s (MV.MVector s Int) 181 | go !t = go' 0 182 | where 183 | go' !i | i >= lastIdx = return t 184 | | otherwise = do 185 | let c = fromEnum $ S.unsafeIndex needle i 186 | MV.unsafeWrite t c (lastIdx - i) 187 | go' $! i+1 188 | 189 | -------------------------------------------------------------------------- 190 | lookahead n = go id n 191 | where 192 | go dlist !k = liftIO (Streams.read stream) >>= maybe eof chunk 193 | where 194 | eof = return $! Left $! S.concat $ dlist [] 195 | 196 | chunk x = if r <= 0 197 | then return $! Right $! S.concat $ d' [] 198 | else go d' r 199 | where 200 | l = S.length x 201 | r = k - l 202 | d' = dlist . (x:) 203 | -------------------------------------------------------------------------------- /src/System/IO/Streams/List.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE BangPatterns #-} 2 | 3 | -- | List conversions and utilities. 4 | 5 | module System.IO.Streams.List 6 | ( -- * List conversions 7 | fromList 8 | , toList 9 | , outputToList 10 | , writeList 11 | 12 | -- * Utility 13 | , chunkList 14 | , chunkListWith 15 | , concatLists 16 | , listOutputStream 17 | ) where 18 | 19 | ------------------------------------------------------------------------------ 20 | import Control.Concurrent.MVar (modifyMVar, modifyMVar_, newMVar) 21 | import Control.Monad.IO.Class (MonadIO (..)) 22 | import Data.IORef (newIORef, readIORef, writeIORef) 23 | import Prelude hiding (read) 24 | ------------------------------------------------------------------------------ 25 | import System.IO.Streams.Internal (InputStream, OutputStream, await, connect, fromConsumer, fromGenerator, makeInputStream, read, write, yield) 26 | 27 | 28 | ------------------------------------------------------------------------------ 29 | -- | Transforms a list into an 'InputStream' that produces no side effects. 30 | -- 31 | -- @ 32 | -- ghci> is <- Streams.'fromList' [1, 2] 33 | -- ghci> 'replicateM' 3 (Streams.'read' is) 34 | -- [Just 1, Just 2, Nothing] 35 | -- @ 36 | fromList :: [c] -> IO (InputStream c) 37 | fromList inp = newIORef inp >>= makeInputStream . f 38 | where 39 | f ref = readIORef ref >>= \l -> 40 | case l of 41 | [] -> return Nothing 42 | (x:xs) -> writeIORef ref xs >> return (Just x) 43 | {-# INLINE fromList #-} 44 | 45 | 46 | ------------------------------------------------------------------------------ 47 | -- | 'listOutputStream' returns an 'OutputStream' which stores values fed into 48 | -- it and an action which flushes all stored values to a list. 49 | -- 50 | -- The flush action resets the store. 51 | -- 52 | -- Note that this function /will/ buffer any input sent to it on the heap. 53 | -- Please don't use this unless you're sure that the amount of input provided 54 | -- is bounded and will fit in memory without issues. 55 | -- 56 | -- @ 57 | -- ghci> (os, flush) <- Streams.'listOutputStream' :: IO ('OutputStream' Int, IO [Int]) 58 | -- ghci> Streams.'writeList' [1, 2] os 59 | -- ghci> flush 60 | -- [1, 2] 61 | -- ghci> Streams.'writeList' [3, 4] os 62 | -- ghci> flush 63 | -- [3, 4] 64 | -- @ 65 | listOutputStream :: IO (OutputStream c, IO [c]) 66 | listOutputStream = do 67 | r <- newMVar id 68 | c <- fromConsumer $ consumer r 69 | return (c, flush r) 70 | 71 | where 72 | consumer r = go 73 | where 74 | go = await >>= (maybe (return $! ()) $ \c -> do 75 | liftIO $ modifyMVar_ r $ \dl -> return (dl . (c:)) 76 | go) 77 | 78 | flush r = modifyMVar r $ \dl -> return (id, dl []) 79 | {-# INLINE listOutputStream #-} 80 | 81 | 82 | ------------------------------------------------------------------------------ 83 | -- | Drains an 'InputStream', converting it to a list. N.B. that this function 84 | -- reads the entire 'InputStream' strictly into memory and as such is not 85 | -- recommended for streaming applications or where the size of the input is not 86 | -- bounded or known. 87 | -- 88 | -- @ 89 | -- ghci> is <- Streams.'fromList' [1, 2] 90 | -- ghci> Streams.'toList' is 91 | -- [1, 2] 92 | -- @ 93 | toList :: InputStream a -> IO [a] 94 | toList is = outputToList (connect is) 95 | {-# INLINE toList #-} 96 | 97 | 98 | ------------------------------------------------------------------------------ 99 | -- | Given an IO action that requires an 'OutputStream', creates one and 100 | -- captures all the output the action sends to it as a list. 101 | -- 102 | -- Example: 103 | -- 104 | -- @ 105 | -- ghci> import "Control.Applicative" 106 | -- ghci> ('connect' <$> 'fromList' [\"a\", \"b\", \"c\"]) >>= 'outputToList' 107 | -- [\"a\",\"b\",\"c\"] 108 | -- @ 109 | outputToList :: (OutputStream a -> IO b) -> IO [a] 110 | outputToList f = do 111 | (os, getList) <- listOutputStream 112 | _ <- f os 113 | getList 114 | {-# INLINE outputToList #-} 115 | 116 | 117 | ------------------------------------------------------------------------------ 118 | -- | Feeds a list to an 'OutputStream'. Does /not/ write an end-of-stream to 119 | -- the stream. 120 | -- 121 | -- @ 122 | -- ghci> os \<- Streams.'unlines' Streams.'System.IO.Streams.stdout' >>= Streams.'System.IO.Streams.contramap' (S.pack . show) :: IO ('OutputStream' Int) 123 | -- ghci> Streams.'writeList' [1, 2] os 124 | -- 1 125 | -- 2 126 | -- ghci> Streams.'writeList' [3, 4] os 127 | -- 3 128 | -- 4 129 | -- @ 130 | writeList :: [a] -> OutputStream a -> IO () 131 | writeList xs os = mapM_ (flip write os . Just) xs 132 | {-# INLINE writeList #-} 133 | 134 | 135 | ------------------------------------------------------------------------------ 136 | -- | Splits an input stream into chunks of at most size @n@. 137 | -- 138 | -- Example: 139 | -- 140 | -- @ 141 | -- ghci> 'fromList' [1..14::Int] >>= 'chunkList' 4 >>= 'toList' 142 | -- [[1,2,3,4],[5,6,7,8],[9,10,11,12],[13,14]] 143 | -- @ 144 | chunkList :: Int -- ^ chunk size 145 | -> InputStream a -- ^ stream to process 146 | -> IO (InputStream [a]) 147 | chunkList n input = if n <= 0 148 | then error $ "chunkList: bad size: " ++ show n 149 | else fromGenerator $ go n id 150 | where 151 | go !k dl | k <= 0 = yield (dl []) >> go n id 152 | | otherwise = do 153 | liftIO (read input) >>= maybe finish chunk 154 | where 155 | finish = let l = dl [] 156 | in if null l then return $! () else yield l 157 | chunk x = go (k - 1) (dl . (x:)) 158 | 159 | 160 | ------------------------------------------------------------------------------ 161 | -- | Splits an input stream into chunks whenever @p elt count@ returns true. 162 | -- 163 | -- Example: 164 | -- 165 | -- @ 166 | -- ghci> 'fromList' [1..14::Int] >>= 'chunkListWith' (\x n -> n>=4) >>= 'toList' 167 | -- [[1,2,3,4],[5,6,7,8],[9,10,11,12],[13,14]] 168 | -- ghci> 'fromList' ['a'..'z'] >>= 'chunkListWith' (\x n -> n>=4 && x `elem` "aeiouy") >>= 'toList' 169 | -- ["abcde","fghi","jklmno","pqrstu","vwxy","z"] 170 | -- @ 171 | -- 172 | -- /Since: 1.3.3.0./ 173 | chunkListWith :: (a -> Int -> Bool) -- ^ break predicate 174 | -> InputStream a -- ^ stream to process 175 | -> IO (InputStream [a]) 176 | chunkListWith p input = 177 | fromGenerator $ go Nothing 0 id 178 | where 179 | go v !k dl 180 | | Just x <- v, p x k = yield (dl []) >> go Nothing 0 id 181 | | otherwise = do 182 | liftIO (read input) >>= maybe finish chunk 183 | where 184 | finish = 185 | let l = dl [] 186 | in if null l 187 | then return $! () 188 | else yield l 189 | chunk x = go (Just x) (k + 1) (dl . (x :)) 190 | 191 | 192 | ------------------------------------------------------------------------------ 193 | -- | Given an input stream containing lists, produces a new input stream that 194 | -- will yield the concatenation of these lists. See 'Prelude.concat'. 195 | -- 196 | -- Example: 197 | -- 198 | -- @ 199 | -- ghci> Streams.'fromList' [[1,2,3::Int], [4,5,6]] >>= 200 | -- Streams.'concatLists' >>= 201 | -- Streams.'toList' 202 | -- [1,2,3,4,5,6] 203 | -- @ 204 | concatLists :: InputStream [a] -> IO (InputStream a) 205 | concatLists input = fromGenerator go 206 | where 207 | go = liftIO (read input) >>= maybe (return $! ()) chunk 208 | chunk l = sequence_ (map yield l) >> go 209 | -------------------------------------------------------------------------------- /src/System/IO/Streams/Network.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | 3 | -- | Converting network 'Socket's to streams. 4 | module System.IO.Streams.Network 5 | ( -- * Sockets to Streams 6 | socketToStreams 7 | , socketToStreamsWithBufferSize 8 | ) where 9 | 10 | ------------------------------------------------------------------------------ 11 | import System.IO.Streams.Internal.Network (socketToStreams, socketToStreamsWithBufferSize) 12 | 13 | -------------------------------------------------------------------------------- /src/System/IO/Streams/Process.hs: -------------------------------------------------------------------------------- 1 | -- | A module adapting the functions from "System.Process" to work with 2 | -- @io-streams@. 3 | module System.IO.Streams.Process 4 | ( module System.Process 5 | , runInteractiveCommand 6 | , runInteractiveProcess 7 | ) where 8 | 9 | ------------------------------------------------------------------------------ 10 | import Data.ByteString.Char8 (ByteString) 11 | import System.IO (hClose) 12 | import System.Process (CmdSpec (..), CreateProcess (CreateProcess, close_fds, cmdspec, create_group, cwd, std_err, std_in, std_out), ProcessHandle, StdStream (..), createProcess, getProcessExitCode, interruptProcessGroupOf, proc, rawSystem, readProcess, readProcessWithExitCode, runCommand, shell, showCommandForUser, system, terminateProcess, waitForProcess) 13 | ------------------------------------------------------------------------------ 14 | import qualified System.IO.Streams.Combinators as Streams 15 | import qualified System.IO.Streams.Handle as Streams 16 | import System.IO.Streams.Internal (InputStream, OutputStream) 17 | import qualified System.IO.Streams.Internal as Streams 18 | 19 | import qualified System.Process as P 20 | 21 | 22 | ------------------------------------------------------------------------------ 23 | -- | Runs a command using the shell, and returns streams that may be used to 24 | -- communicate with the process via its stdin, stdout, and stderr respectively. 25 | -- 26 | -- The streams returned by this command are guarded by locks and are therefore 27 | -- safe to use in multithreaded code. 28 | -- 29 | -- /Since: 1.0.2.0/ 30 | -- 31 | runInteractiveCommand :: String 32 | -> IO (OutputStream ByteString, 33 | InputStream ByteString, 34 | InputStream ByteString, 35 | ProcessHandle) 36 | runInteractiveCommand scmd = do 37 | (hin, hout, herr, ph) <- P.runInteractiveCommand scmd 38 | sIn <- Streams.handleToOutputStream hin >>= 39 | Streams.atEndOfOutput (hClose hin) >>= 40 | Streams.lockingOutputStream 41 | sOut <- Streams.handleToInputStream hout >>= 42 | Streams.atEndOfInput (hClose hout) >>= 43 | Streams.lockingInputStream 44 | sErr <- Streams.handleToInputStream herr >>= 45 | Streams.atEndOfInput (hClose herr) >>= 46 | Streams.lockingInputStream 47 | return (sIn, sOut, sErr, ph) 48 | 49 | 50 | ------------------------------------------------------------------------------ 51 | -- | Runs a raw command, and returns streams that may be used to communicate 52 | -- with the process via its @stdin@, @stdout@ and @stderr@ respectively. 53 | -- 54 | -- For example, to start a process and feed a string to its stdin: 55 | -- 56 | -- > (inp,out,err,pid) <- runInteractiveProcess "..." 57 | -- > forkIO (Streams.write (Just str) inp) 58 | -- 59 | -- The streams returned by this command are guarded by locks and are therefore 60 | -- safe to use in multithreaded code. 61 | -- 62 | -- /Since: 1.0.2.0/ 63 | -- 64 | runInteractiveProcess 65 | :: FilePath -- ^ Filename of the executable (see 'proc' for details) 66 | -> [String] -- ^ Arguments to pass to the executable 67 | -> Maybe FilePath -- ^ Optional path to the working directory 68 | -> Maybe [(String,String)] -- ^ Optional environment (otherwise inherit) 69 | -> IO (OutputStream ByteString, 70 | InputStream ByteString, 71 | InputStream ByteString, 72 | ProcessHandle) 73 | runInteractiveProcess cmd args wd env = do 74 | (hin, hout, herr, ph) <- P.runInteractiveProcess cmd args wd env 75 | sIn <- Streams.handleToOutputStream hin >>= 76 | Streams.atEndOfOutput (hClose hin) >>= 77 | Streams.lockingOutputStream 78 | sOut <- Streams.handleToInputStream hout >>= 79 | Streams.atEndOfInput (hClose hout) >>= 80 | Streams.lockingInputStream 81 | sErr <- Streams.handleToInputStream herr >>= 82 | Streams.atEndOfInput (hClose herr) >>= 83 | Streams.lockingInputStream 84 | return (sIn, sOut, sErr, ph) 85 | -------------------------------------------------------------------------------- /src/System/IO/Streams/Text.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE BangPatterns #-} 2 | {-# LANGUAGE CPP #-} 3 | 4 | -- | Stream primitives for decoding and encoding 'Text' values in UTF-8 format. 5 | module System.IO.Streams.Text 6 | ( -- * Decoders and Encoders 7 | decodeUtf8 8 | , decodeUtf8With 9 | , encodeUtf8 10 | ) where 11 | 12 | ------------------------------------------------------------------------------ 13 | import Control.Monad (when) 14 | import Control.Monad.IO.Class (MonadIO (..)) 15 | import Data.ByteString (ByteString) 16 | import qualified Data.ByteString as S 17 | import qualified Data.ByteString.Unsafe as S 18 | #if !MIN_VERSION_base(4,8,0) 19 | import Data.Monoid (mappend) 20 | #endif 21 | import Data.Text (Text) 22 | import qualified Data.Text.Encoding as T 23 | import Data.Text.Encoding.Error (OnDecodeError) 24 | import Data.Word (Word8) 25 | ------------------------------------------------------------------------------ 26 | import qualified System.IO.Streams.Combinators as Streams 27 | import System.IO.Streams.Internal (InputStream, OutputStream) 28 | import qualified System.IO.Streams.Internal as Streams 29 | 30 | 31 | ------------------------------------------------------------------------------ 32 | -- | Convert an 'OutputStream' taking 'ByteString's to an 'OutputStream' that 33 | -- takes 'Text', encoding the data as UTF-8. See 34 | -- @Data.Text.Encoding.'T.encodeUtf8'@. 35 | encodeUtf8 :: OutputStream ByteString -> IO (OutputStream Text) 36 | encodeUtf8 = Streams.contramap T.encodeUtf8 37 | 38 | 39 | ------------------------------------------------------------------------------ 40 | -- | Decode an 'InputStream' of 'ByteString's in UTF-8 format into an 41 | -- 'InputStream' of 'Text' values. If decoding fails, will throw an exception. 42 | -- See @Data.Text.Encoding.'T.decodeUtf8'@. 43 | decodeUtf8 :: InputStream ByteString -> IO (InputStream Text) 44 | decodeUtf8 = decode T.decodeUtf8 45 | {-# INLINE decodeUtf8 #-} 46 | 47 | 48 | ------------------------------------------------------------------------------ 49 | -- | Decode an 'InputStream' of 'ByteString's in UTF-8 format into an 50 | -- 'InputStream' of 'Text' values. If decoding fails, invokes the given 51 | -- 'OnDecodeError' function to decide what to do. See 52 | -- @Data.Text.Encoding.'T.decodeUtf8With'@. 53 | decodeUtf8With :: OnDecodeError 54 | -> InputStream ByteString 55 | -> IO (InputStream Text) 56 | decodeUtf8With e = decode (T.decodeUtf8With e) 57 | {-# INLINE decodeUtf8With #-} 58 | 59 | 60 | ------------------------------------------------------------------------------ 61 | decode :: (ByteString -> Text) 62 | -> InputStream ByteString 63 | -> IO (InputStream Text) 64 | decode decodeFunc input = Streams.fromGenerator $ go Nothing 65 | where 66 | go !soFar = liftIO (Streams.read input) >>= 67 | maybe (finish soFar) (chunk soFar) 68 | 69 | finish Nothing = return $! () 70 | finish (Just x) = Streams.yield $! decodeFunc x 71 | 72 | chunk Nothing s = process s 73 | chunk (Just a) b = process $ a `mappend` b 74 | 75 | process !s = 76 | case findLastFullCode s of 77 | LastCodeIsComplete x -> (Streams.yield $! decodeFunc x) >> go Nothing 78 | Split a b -> do 79 | when (not $ S.null a) $ 80 | Streams.yield $! decodeFunc a 81 | go (Just b) 82 | NoCodesAreComplete x -> go (Just x) 83 | 84 | 85 | ------------------------------------------------------------------------------ 86 | data ByteType = Regular 87 | | Continuation 88 | | Start !Int 89 | 90 | 91 | ------------------------------------------------------------------------------ 92 | between :: Word8 -> Word8 -> Word8 -> Bool 93 | between x y z = x >= y && x <= z 94 | {-# INLINE between #-} 95 | 96 | 97 | ------------------------------------------------------------------------------ 98 | characterizeByte :: Word8 -> ByteType 99 | characterizeByte c | between c 0 0x7F = Regular 100 | | between c 0x80 0xBF = Continuation 101 | | between c 0xC0 0xDF = Start 1 102 | | between c 0xE0 0xEF = Start 2 103 | -- Technically utf-8 ends after 0xf4, but those sequences 104 | -- won't decode anyways. 105 | | otherwise = Start 3 106 | 107 | 108 | ------------------------------------------------------------------------------ 109 | data FindOutput = LastCodeIsComplete !ByteString 110 | | Split !ByteString !ByteString 111 | | NoCodesAreComplete !ByteString -- should be impossibly rare 112 | -- in real data 113 | 114 | 115 | ------------------------------------------------------------------------------ 116 | findLastFullCode :: ByteString -> FindOutput 117 | findLastFullCode b | len == 0 = LastCodeIsComplete b 118 | | otherwise = go 119 | where 120 | len = S.length b 121 | 122 | go = let !idx = len - 1 123 | !c = S.unsafeIndex b idx 124 | in case characterizeByte c of 125 | Regular -> LastCodeIsComplete b 126 | Continuation -> cont (len - 2) 127 | _ -> Split (S.unsafeTake idx b) (S.unsafeDrop idx b) 128 | 129 | cont !idx | idx < 0 = NoCodesAreComplete b 130 | | otherwise = 131 | let !c = S.unsafeIndex b idx 132 | in case characterizeByte c of 133 | -- what do we do with this? decoding will fail. give up 134 | -- and lie, the text decoder will deal with it.. 135 | Regular -> LastCodeIsComplete b 136 | Continuation -> cont (idx - 1) 137 | Start n -> if n + idx == len - 1 138 | then LastCodeIsComplete b 139 | else Split (S.unsafeTake idx b) 140 | (S.unsafeDrop idx b) 141 | {-# INLINE findLastFullCode #-} 142 | -------------------------------------------------------------------------------- /src/System/IO/Streams/Vector.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE BangPatterns #-} 2 | {-# LANGUAGE MultiParamTypeClasses #-} 3 | {-# LANGUAGE RankNTypes #-} 4 | {-# LANGUAGE CPP #-} 5 | 6 | -- | Vector conversions and utilities. 7 | 8 | module System.IO.Streams.Vector 9 | ( -- * Vector conversions 10 | fromVector 11 | , toVector 12 | , toVectorSized 13 | , outputToVector 14 | , outputToVectorSized 15 | , toMutableVector 16 | , toMutableVectorSized 17 | , outputToMutableVector 18 | , outputToMutableVectorSized 19 | , writeVector 20 | 21 | -- * Utility 22 | , chunkVector 23 | , vectorOutputStream 24 | , vectorOutputStreamSized 25 | , mutableVectorOutputStream 26 | , mutableVectorOutputStreamSized 27 | ) where 28 | 29 | ------------------------------------------------------------------------------ 30 | import Control.Concurrent.MVar (modifyMVar, modifyMVar_, newMVar) 31 | import Control.Monad (liftM, (>=>)) 32 | import Control.Monad.IO.Class (MonadIO (..)) 33 | import Control.Monad.Primitive (PrimState (..), RealWorld) 34 | import Data.IORef (IORef, newIORef, readIORef, writeIORef) 35 | import Data.Vector.Generic (Vector (..)) 36 | import qualified Data.Vector.Generic as V 37 | import Data.Vector.Generic.Mutable (MVector) 38 | import qualified Data.Vector.Generic.Mutable as VM 39 | import System.IO.Streams.Internal (InputStream, OutputStream, fromGenerator, yield) 40 | import qualified System.IO.Streams.Internal as S 41 | 42 | #if MIN_VERSION_vector(0,13,0) 43 | import Control.Monad.ST (stToIO) 44 | #endif 45 | 46 | basicUnsafeFreezeCompat :: Vector v a => V.Mutable v RealWorld a -> IO (v a) 47 | #if MIN_VERSION_vector(0,13,0) 48 | basicUnsafeFreezeCompat = stToIO . V.basicUnsafeFreeze 49 | #else 50 | basicUnsafeFreezeCompat = V.basicUnsafeFreeze 51 | #endif 52 | 53 | ------------------------------------------------------------------------------ 54 | -- | Transforms a vector into an 'InputStream' that yields each of the values 55 | -- in the vector in turn. 56 | -- 57 | -- @ 58 | -- ghci> import "Control.Monad" 59 | -- ghci> import qualified "System.IO.Streams" as Streams 60 | -- ghci> import qualified "Data.Vector" as V 61 | -- ghci> let v = V.'Data.Vector.fromList' [1, 2] 62 | -- ghci> is <- Streams.'fromVector' v 63 | -- ghci> 'Control.Monad.replicateM' 3 (Streams.'read' is) 64 | -- ['Just' 1,'Just' 2,'Nothing'] 65 | -- @ 66 | fromVector :: Vector v a => v a -> IO (InputStream a) 67 | fromVector = fromGenerator . V.mapM_ yield 68 | {-# INLINE fromVector #-} 69 | 70 | 71 | ------------------------------------------------------------------------------ 72 | -- | Drains an 'InputStream', converting it to a vector. Note that this 73 | -- function reads the entire 'InputStream' strictly into memory and as such is 74 | -- not recommended for streaming applications or where the size of the input is 75 | -- not bounded or known. 76 | -- 77 | -- @ 78 | -- ghci> is <- Streams.'System.IO.Streams.fromList' [(1::Int)..4] 79 | -- ghci> Streams.'toVector' is :: 'IO' (V.'Vector' Int) 80 | -- fromList [1,2,3,4] 81 | -- @ 82 | toVector :: Vector v a => InputStream a -> IO (v a) 83 | toVector = toVectorSized dEFAULT_BUFSIZ 84 | {-# INLINE toVector #-} 85 | 86 | 87 | ------------------------------------------------------------------------------ 88 | -- | Like 'toVector', but allows control over how large the vector buffer is to 89 | -- start with. 90 | toVectorSized :: Vector v a => Int -> InputStream a -> IO (v a) 91 | toVectorSized n = toMutableVectorSized n >=> basicUnsafeFreezeCompat 92 | {-# INLINE toVectorSized #-} 93 | 94 | 95 | ------------------------------------------------------------------------------ 96 | -- | Drains an 'InputStream', converting it to a mutable vector. Note that this 97 | -- function reads the entire 'InputStream' strictly into memory and as such is 98 | -- not recommended for streaming applications or where the size of the input is 99 | -- not bounded or known. 100 | toMutableVector :: VM.MVector v a => InputStream a -> IO (v (PrimState IO) a) 101 | toMutableVector = toMutableVectorSized dEFAULT_BUFSIZ 102 | 103 | 104 | ------------------------------------------------------------------------------ 105 | -- | Like 'toMutableVector', but allows control over how large the vector 106 | -- buffer is to start with. 107 | toMutableVectorSized :: VM.MVector v a => 108 | Int -- ^ initial size of the vector buffer 109 | -> InputStream a 110 | -> IO (v (PrimState IO) a) 111 | toMutableVectorSized initialSize input = vfNew initialSize >>= go 112 | where 113 | go vfi = S.read input >>= maybe (vfFinish vfi) (vfAppend vfi >=> go) 114 | {-# INLINE toMutableVectorSized #-} 115 | 116 | 117 | ------------------------------------------------------------------------------ 118 | -- | 'vectorOutputStream' returns an 'OutputStream' which stores values fed 119 | -- into it and an action which flushes all stored values to a vector. 120 | -- 121 | -- The flush action resets the store. 122 | -- 123 | -- Note that this function /will/ buffer any input sent to it on the heap. 124 | -- Please don't use this unless you're sure that the amount of input provided 125 | -- is bounded and will fit in memory without issues. 126 | -- 127 | -- @ 128 | -- ghci> (os, flush) <- Streams.'vectorOutputStream' :: IO ('OutputStream' Int, IO (V.'Vector' Int)) 129 | -- ghci> Streams.'System.IO.Streams.write' (Just 1) os 130 | -- ghci> Streams.'System.IO.Streams.write' (Just 2) os 131 | -- ghci> flush 132 | -- fromList [1,2] 133 | -- ghci> Streams.'System.IO.Streams.write' (Just 3) os 134 | -- ghci> Streams.'System.IO.Streams.write' Nothing os 135 | -- ghci> Streams.'System.IO.Streams.write' (Just 4) os 136 | -- ghci> flush 137 | -- fromList [3] 138 | -- @ 139 | vectorOutputStream :: Vector v c => IO (OutputStream c, IO (v c)) 140 | vectorOutputStream = vectorOutputStreamSized dEFAULT_BUFSIZ 141 | {-# INLINE vectorOutputStream #-} 142 | 143 | 144 | ------------------------------------------------------------------------------ 145 | -- | Like 'vectorOutputStream', but allows control over how large the vector 146 | -- buffer is to start with. 147 | vectorOutputStreamSized :: Vector v c => Int -> IO (OutputStream c, IO (v c)) 148 | vectorOutputStreamSized n = do 149 | (os, flush) <- mutableVectorOutputStreamSized n 150 | return $! (os, flush >>= basicUnsafeFreezeCompat) 151 | 152 | 153 | ------------------------------------------------------------------------------ 154 | data VectorFillInfo v c = VectorFillInfo { 155 | _vec :: !(v (PrimState IO) c) 156 | , _idx :: {-# UNPACK #-} !(IORef Int) 157 | 158 | -- TODO: vector contains its own size 159 | , _sz :: {-# UNPACK #-} !(IORef Int) 160 | } 161 | 162 | 163 | ------------------------------------------------------------------------------ 164 | vfNew :: MVector v a => Int -> IO (VectorFillInfo v a) 165 | vfNew initialSize = do 166 | v <- VM.unsafeNew initialSize 167 | i <- newIORef 0 168 | sz <- newIORef initialSize 169 | return $! VectorFillInfo v i sz 170 | 171 | 172 | ------------------------------------------------------------------------------ 173 | vfFinish :: MVector v a => 174 | VectorFillInfo v a 175 | -> IO (v (PrimState IO) a) 176 | vfFinish vfi = liftM (flip VM.unsafeTake v) $ readIORef i 177 | where 178 | v = _vec vfi 179 | i = _idx vfi 180 | 181 | 182 | ------------------------------------------------------------------------------ 183 | vfAppend :: MVector v a => 184 | VectorFillInfo v a 185 | -> a 186 | -> IO (VectorFillInfo v a) 187 | vfAppend vfi !x = do 188 | i <- readIORef iRef 189 | sz <- readIORef szRef 190 | if i < sz then add i else grow sz 191 | where 192 | v = _vec vfi 193 | iRef = _idx vfi 194 | szRef = _sz vfi 195 | 196 | add i = do 197 | VM.unsafeWrite v i x 198 | writeIORef iRef $! i + 1 199 | return vfi 200 | 201 | grow sz = do 202 | let !sz' = sz * 2 203 | v' <- VM.unsafeGrow v sz 204 | writeIORef szRef sz' 205 | vfAppend (vfi { _vec = v' }) x 206 | 207 | 208 | ------------------------------------------------------------------------------ 209 | -- | 'mutableVectorOutputStream' returns an 'OutputStream' which stores values 210 | -- fed into it and an action which flushes all stored values to a vector. 211 | -- 212 | -- The flush action resets the store. 213 | -- 214 | -- Note that this function /will/ buffer any input sent to it on the heap. 215 | -- Please don't use this unless you're sure that the amount of input provided 216 | -- is bounded and will fit in memory without issues. 217 | mutableVectorOutputStream :: VM.MVector v c => 218 | IO (OutputStream c, IO (v (PrimState IO) c)) 219 | mutableVectorOutputStream = mutableVectorOutputStreamSized dEFAULT_BUFSIZ 220 | 221 | 222 | ------------------------------------------------------------------------------ 223 | -- | Like 'mutableVectorOutputStream', but allows control over how large the 224 | -- vector buffer is to start with. 225 | mutableVectorOutputStreamSized :: VM.MVector v c => 226 | Int 227 | -> IO (OutputStream c, IO (v (PrimState IO) c)) 228 | mutableVectorOutputStreamSized initialSize = do 229 | r <- vfNew initialSize >>= newMVar 230 | c <- S.fromConsumer $ consumer r 231 | return (c, flush r) 232 | 233 | where 234 | consumer r = go 235 | where 236 | go = S.await >>= 237 | (maybe (return $! ()) $ \c -> do 238 | liftIO $ modifyMVar_ r $ flip vfAppend c 239 | go) 240 | 241 | flush r = modifyMVar r $ \vfi -> do 242 | !v <- vfFinish vfi 243 | vfi' <- vfNew initialSize 244 | return $! (vfi', v) 245 | {-# INLINE mutableVectorOutputStreamSized #-} 246 | 247 | 248 | ------------------------------------------------------------------------------ 249 | -- | Given an IO action that requires an 'OutputStream', creates one and 250 | -- captures all the output the action sends to it as a mutable vector. 251 | -- 252 | -- Example: 253 | -- 254 | -- @ 255 | -- ghci> import "Control.Applicative" 256 | -- ghci> ('connect' \<\$\> 'System.IO.Streams.fromList' [1, 2, 3::'Int']) 257 | -- \>\>= 'outputToMutableVector' 258 | -- \>\>= V.'Data.Vector.freeze' 259 | -- fromList [1,2,3] 260 | -- @ 261 | outputToMutableVector :: MVector v a => 262 | (OutputStream a -> IO b) 263 | -> IO (v (PrimState IO) a) 264 | outputToMutableVector = outputToMutableVectorSized dEFAULT_BUFSIZ 265 | {-# INLINE outputToMutableVector #-} 266 | 267 | 268 | ------------------------------------------------------------------------------ 269 | -- | Like 'outputToMutableVector', but allows control over how large the vector 270 | -- buffer is to start with. 271 | outputToMutableVectorSized :: MVector v a => 272 | Int 273 | -> (OutputStream a -> IO b) 274 | -> IO (v (PrimState IO) a) 275 | outputToMutableVectorSized n f = do 276 | (os, getVec) <- mutableVectorOutputStreamSized n 277 | _ <- f os 278 | getVec 279 | {-# INLINE outputToMutableVectorSized #-} 280 | 281 | 282 | ------------------------------------------------------------------------------ 283 | -- | Given an IO action that requires an 'OutputStream', creates one and 284 | -- captures all the output the action sends to it as a vector. 285 | -- 286 | -- Example: 287 | -- 288 | -- @ 289 | -- ghci> (('connect' <$> 'System.IO.Streams.fromList' [1, 2, 3]) >>= 'outputToVector') 290 | -- :: IO ('Data.Vector.Vector' Int) 291 | -- fromList [1,2,3] 292 | -- @ 293 | outputToVector :: Vector v a => (OutputStream a -> IO b) -> IO (v a) 294 | outputToVector = outputToVectorSized dEFAULT_BUFSIZ 295 | {-# INLINE outputToVector #-} 296 | 297 | 298 | ------------------------------------------------------------------------------ 299 | -- | Like 'outputToVector', but allows control over how large the vector buffer 300 | -- is to start with. 301 | outputToVectorSized :: Vector v a => 302 | Int 303 | -> (OutputStream a -> IO b) 304 | -> IO (v a) 305 | outputToVectorSized n = outputToMutableVectorSized n >=> basicUnsafeFreezeCompat 306 | {-# INLINE outputToVectorSized #-} 307 | 308 | 309 | ------------------------------------------------------------------------------ 310 | -- | Splits an input stream into chunks of at most size @n@. 311 | -- 312 | -- Example: 313 | -- 314 | -- @ 315 | -- ghci> ('System.IO.Streams.fromList' [1..14::Int] >>= 'chunkVector' 4 >>= 'System.IO.Streams.toList') 316 | -- :: IO ['Data.Vector.Vector' Int] 317 | -- [fromList [1,2,3,4],fromList [5,6,7,8],fromList [9,10,11,12],fromList [13,14]] 318 | -- @ 319 | chunkVector :: Vector v a => Int -> InputStream a -> IO (InputStream (v a)) 320 | chunkVector n input = if n <= 0 321 | then error $ "chunkVector: bad size: " ++ show n 322 | else vfNew n >>= fromGenerator . go n 323 | where 324 | doneChunk !vfi = do 325 | liftIO (vfFinish vfi >>= V.unsafeFreeze) >>= yield 326 | !vfi' <- liftIO $ vfNew n 327 | go n vfi' 328 | 329 | go !k !vfi | k <= 0 = doneChunk vfi 330 | | otherwise = liftIO (S.read input) >>= maybe finish chunk 331 | where 332 | finish = do 333 | v <- liftIO (vfFinish vfi >>= V.unsafeFreeze) 334 | if V.null v then return $! () else yield v 335 | 336 | chunk x = do 337 | !vfi' <- liftIO $ vfAppend vfi x 338 | go (k - 1) vfi' 339 | {-# INLINE chunkVector #-} 340 | 341 | 342 | ------------------------------------------------------------------------------ 343 | -- | Feeds a vector to an 'OutputStream'. Does /not/ write an end-of-stream to 344 | -- the stream. 345 | -- 346 | -- @ 347 | -- ghci> let v = V.'fromList' [1..4] :: V.'Vector' Int 348 | -- ghci> os \<- Streams.'unlines' Streams.'stdout' >>= Streams.'System.IO.Streams.contramap' (S.pack . show) :: IO ('OutputStream' Int) 349 | -- ghci> Streams.'writeVector' v os 350 | -- 1 351 | -- 2 352 | -- 3 353 | -- 4 354 | -- @ 355 | writeVector :: Vector v a => v a -> OutputStream a -> IO () 356 | writeVector v out = V.mapM_ (flip S.write out . Just) v 357 | {-# INLINE writeVector #-} 358 | 359 | 360 | ------------------------------------------------------------------------------ 361 | dEFAULT_BUFSIZ :: Int 362 | dEFAULT_BUFSIZ = 64 363 | -------------------------------------------------------------------------------- /src/System/IO/Streams/Zlib.hs: -------------------------------------------------------------------------------- 1 | -- | Interface to @zlib@ and @gzip@ compression for 'Bytestring's and 'Builder's 2 | 3 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 4 | 5 | module System.IO.Streams.Zlib 6 | ( -- * ByteString decompression 7 | gunzip 8 | , decompress 9 | -- * ByteString compression 10 | , gzip 11 | , compress 12 | -- * Builder compression 13 | , gzipBuilder 14 | , compressBuilder 15 | -- * Compression level 16 | , CompressionLevel(..) 17 | , defaultCompressionLevel 18 | ) where 19 | 20 | ------------------------------------------------------------------------------ 21 | import Data.ByteString (ByteString) 22 | import qualified Data.ByteString as S 23 | import Data.IORef (newIORef, readIORef, writeIORef) 24 | import Prelude hiding (read) 25 | ------------------------------------------------------------------------------ 26 | import Codec.Zlib (Deflate, Inflate, Popper, WindowBits (..), feedDeflate, feedInflate, finishDeflate, finishInflate, flushDeflate, flushInflate, initDeflate, initInflate) 27 | import Data.ByteString.Builder (Builder, byteString) 28 | import Data.ByteString.Builder.Extra (defaultChunkSize, flush) 29 | import Data.ByteString.Builder.Internal (newBuffer) 30 | ------------------------------------------------------------------------------ 31 | import System.IO.Streams.Builder (unsafeBuilderStream) 32 | import System.IO.Streams.Internal (InputStream, OutputStream, makeInputStream, makeOutputStream, read, write) 33 | 34 | 35 | ------------------------------------------------------------------------------ 36 | gzipBits :: WindowBits 37 | gzipBits = WindowBits 31 38 | 39 | 40 | ------------------------------------------------------------------------------ 41 | compressBits :: WindowBits 42 | compressBits = WindowBits 15 43 | 44 | 45 | ------------------------------------------------------------------------------ 46 | -- | Decompress an 'InputStream' of strict 'ByteString's from the @gzip@ format 47 | gunzip :: InputStream ByteString -> IO (InputStream ByteString) 48 | gunzip input = initInflate gzipBits >>= inflate input 49 | 50 | 51 | ------------------------------------------------------------------------------ 52 | -- | Decompress an 'InputStream' of strict 'ByteString's from the @zlib@ format 53 | decompress :: InputStream ByteString -> IO (InputStream ByteString) 54 | decompress input = initInflate compressBits >>= inflate input 55 | 56 | 57 | ------------------------------------------------------------------------------ 58 | -- Note: bytes pushed back to this input stream are not propagated back to the 59 | -- source InputStream. 60 | data IS = Input 61 | | Popper Popper 62 | | Done 63 | 64 | inflate :: InputStream ByteString -> Inflate -> IO (InputStream ByteString) 65 | inflate input state = do 66 | ref <- newIORef Input 67 | makeInputStream $ stream ref 68 | 69 | where 70 | stream ref = go 71 | where 72 | go = readIORef ref >>= \st -> 73 | case st of 74 | Input -> read input >>= maybe eof chunk 75 | Popper p -> pop p 76 | Done -> return Nothing 77 | 78 | eof = do 79 | x <- finishInflate state 80 | writeIORef ref Done 81 | if (not $ S.null x) 82 | then return $! Just x 83 | else return Nothing 84 | 85 | chunk s = 86 | if S.null s 87 | then do 88 | out <- flushInflate state 89 | return $! Just out 90 | else feedInflate state s >>= \popper -> do 91 | writeIORef ref $ Popper popper 92 | pop popper 93 | 94 | pop popper = popper >>= maybe backToInput (return . Just) 95 | backToInput = writeIORef ref Input >> read input >>= maybe eof chunk 96 | 97 | 98 | ------------------------------------------------------------------------------ 99 | deflateBuilder :: OutputStream Builder 100 | -> Deflate 101 | -> IO (OutputStream Builder) 102 | deflateBuilder stream state = do 103 | zippedStr <- makeOutputStream bytestringStream >>= 104 | \x -> deflate x state 105 | 106 | -- we can use unsafeBuilderStream here because zlib is going to consume the 107 | -- stream 108 | unsafeBuilderStream (newBuffer defaultChunkSize) zippedStr 109 | 110 | where 111 | bytestringStream x = write (fmap cvt x) stream 112 | 113 | cvt s | S.null s = flush 114 | | otherwise = byteString s 115 | 116 | 117 | ------------------------------------------------------------------------------ 118 | -- | Convert an 'OutputStream' that consumes compressed 'Builder's into an 119 | -- 'OutputStream' that consumes uncompressed 'Builder's in the @gzip@ format 120 | gzipBuilder :: CompressionLevel 121 | -> OutputStream Builder 122 | -> IO (OutputStream Builder) 123 | gzipBuilder level output = 124 | initDeflate (clamp level) gzipBits >>= deflateBuilder output 125 | 126 | 127 | ------------------------------------------------------------------------------ 128 | -- | Convert an 'OutputStream' that consumes compressed 'Builder's into an 129 | -- 'OutputStream' that consumes uncompressed 'Builder's in the @zlib@ format 130 | compressBuilder :: CompressionLevel 131 | -> OutputStream Builder 132 | -> IO (OutputStream Builder) 133 | compressBuilder level output = 134 | initDeflate (clamp level) compressBits >>= deflateBuilder output 135 | 136 | 137 | ------------------------------------------------------------------------------ 138 | deflate :: OutputStream ByteString 139 | -> Deflate 140 | -> IO (OutputStream ByteString) 141 | deflate output state = makeOutputStream stream 142 | where 143 | stream Nothing = popAll (finishDeflate state) >> write Nothing output 144 | 145 | stream (Just s) = do 146 | -- Empty string means flush 147 | if S.null s 148 | then do 149 | popAll (flushDeflate state) 150 | write (Just S.empty) output 151 | 152 | else feedDeflate state s >>= popAll 153 | 154 | 155 | popAll popper = go 156 | where 157 | go = popper >>= maybe (return $! ()) (\s -> write (Just s) output >> go) 158 | 159 | 160 | ------------------------------------------------------------------------------ 161 | -- | Parameter that defines the tradeoff between speed and compression ratio 162 | newtype CompressionLevel = CompressionLevel Int 163 | deriving (Read, Eq, Show, Num) 164 | 165 | 166 | ------------------------------------------------------------------------------ 167 | -- | A compression level that balances speed with compression ratio 168 | defaultCompressionLevel :: CompressionLevel 169 | defaultCompressionLevel = CompressionLevel 5 170 | 171 | 172 | ------------------------------------------------------------------------------ 173 | clamp :: CompressionLevel -> Int 174 | clamp (CompressionLevel x) = min 9 (max x 0) 175 | 176 | 177 | ------------------------------------------------------------------------------ 178 | -- | Convert an 'OutputStream' that consumes compressed 'ByteString's into an 179 | -- 'OutputStream' that consumes uncompressed 'ByteString's in the @gzip@ format 180 | gzip :: CompressionLevel 181 | -> OutputStream ByteString 182 | -> IO (OutputStream ByteString) 183 | gzip level output = initDeflate (clamp level) gzipBits >>= deflate output 184 | 185 | 186 | ------------------------------------------------------------------------------ 187 | -- | Convert an 'OutputStream' that consumes compressed 'ByteString's into an 188 | -- 'OutputStream' that consumes uncompressed 'ByteString's in the @zlib@ format 189 | compress :: CompressionLevel 190 | -> OutputStream ByteString 191 | -> IO (OutputStream ByteString) 192 | compress level output = initDeflate (clamp level) compressBits >>= 193 | deflate output 194 | -------------------------------------------------------------------------------- /test/System/IO/Streams/Tests/Attoparsec/ByteString.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module System.IO.Streams.Tests.Attoparsec.ByteString (tests) where 4 | 5 | ------------------------------------------------------------------------------ 6 | import Control.Monad 7 | import Data.Attoparsec.ByteString.Char8 hiding (eitherResult) 8 | import Data.ByteString.Char8 (ByteString) 9 | import Prelude hiding (takeWhile) 10 | import System.IO.Streams 11 | import System.IO.Streams.Attoparsec.ByteString 12 | import System.IO.Streams.Internal.Attoparsec (eitherResult, parseFromStreamInternal) 13 | import System.IO.Streams.Tests.Common 14 | import Test.Framework 15 | import Test.Framework.Providers.HUnit 16 | import Test.HUnit hiding (Test) 17 | ------------------------------------------------------------------------------ 18 | 19 | tests :: [Test] 20 | tests = [ testParseFromStream 21 | , testParseFromStreamError 22 | , testParseFromStreamError2 23 | , testPartialParse 24 | , testEmbeddedNull 25 | , testTrivials 26 | ] 27 | 28 | 29 | ------------------------------------------------------------------------------ 30 | testParser :: Parser (Maybe Int) 31 | testParser = do 32 | end <- atEnd 33 | if end 34 | then return Nothing 35 | else do 36 | _ <- takeWhile (\c -> isSpace c || c == ',') 37 | liftM Just decimal 38 | 39 | 40 | ------------------------------------------------------------------------------ 41 | testParser2 :: Parser (Maybe ByteString) 42 | testParser2 = do 43 | end <- atEnd 44 | if end 45 | then return Nothing 46 | else liftM Just $ string "bork" 47 | 48 | 49 | ------------------------------------------------------------------------------ 50 | testParseFromStream :: Test 51 | testParseFromStream = testCase "attoparsec/parseFromStream" $ do 52 | is <- fromList ["1", "23", ", 4", ", 5, 6, 7"] 53 | x0 <- parseFromStream testParser is 54 | 55 | assertEqual "first parse" (Just 123) x0 56 | 57 | l <- parserToInputStream testParser is >>= toList 58 | 59 | assertEqual "rest" [4, 5, 6, 7] l 60 | toList is >>= assertEqual "double eof" [] 61 | 62 | 63 | ------------------------------------------------------------------------------ 64 | testParseFromStreamError :: Test 65 | testParseFromStreamError = testCase "attoparsec/parseFromStreamError" $ do 66 | is <- fromList ["1", "23", ", 4", ",xxxx 5, 6, 7"] >>= 67 | parserToInputStream testParser 68 | 69 | expectExceptionH $ toList is 70 | 71 | 72 | ------------------------------------------------------------------------------ 73 | testParseFromStreamError2 :: Test 74 | testParseFromStreamError2 = testCase "attoparsec/parseFromStreamError2" $ do 75 | l <- fromList ["borkbork", "bork"] >>= p 76 | assertEqual "ok" ["bork", "bork", "bork"] l 77 | 78 | expectExceptionH $ fromList ["bork", "bo"] >>= p 79 | expectExceptionH $ fromList ["xxxxx"] >>= p 80 | 81 | where 82 | p = parserToInputStream ((testParser2 "foo") "bar") >=> toList 83 | 84 | 85 | ------------------------------------------------------------------------------ 86 | testPartialParse :: Test 87 | testPartialParse = testCase "attoparsec/partialParse" $ do 88 | is <- fromList ["1,", "2,", "3"] 89 | expectExceptionH $ parseFromStreamInternal parseFunc feedFunc testParser is 90 | 91 | where 92 | result = Partial (const result) 93 | parseFunc = const $ const $ result 94 | feedFunc = const $ const $ result 95 | 96 | ------------------------------------------------------------------------------ 97 | testTrivials :: Test 98 | testTrivials = testCase "attoparsec/trivials" $ do 99 | coverTypeableInstance (undefined :: ParseException) 100 | let (Right x) = eitherResult $ Done undefined 4 :: Either (ByteString, [String], String) Int 101 | assertEqual "eitherResult" 4 x 102 | 103 | ------------------------------------------------------------------------------ 104 | testEmbeddedNull :: Test 105 | testEmbeddedNull = testCase "attoparsec/embeddedNull" $ do 106 | is <- fromList ["", "1", "23", "", ", 4", ", 5, 6, 7"] 107 | x0 <- parseFromStream testParser is 108 | 109 | assertEqual "first parse" (Just 123) x0 110 | 111 | l <- parserToInputStream testParser is >>= toList 112 | 113 | assertEqual "rest" [4, 5, 6, 7] l 114 | -------------------------------------------------------------------------------- /test/System/IO/Streams/Tests/Attoparsec/Text.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module System.IO.Streams.Tests.Attoparsec.Text (tests, testParserU) where 4 | 5 | ------------------------------------------------------------------------------ 6 | import Control.Monad 7 | import Data.Attoparsec.Text hiding (eitherResult) 8 | import Data.Char (isAlpha, isSpace) 9 | import Data.Text (Text) 10 | import Prelude hiding (takeWhile) 11 | import System.IO.Streams 12 | import System.IO.Streams.Attoparsec.Text 13 | import System.IO.Streams.Internal.Attoparsec (eitherResult, parseFromStreamInternal) 14 | import System.IO.Streams.Tests.Common 15 | import Test.Framework 16 | import Test.Framework.Providers.HUnit 17 | import Test.HUnit hiding (Test) 18 | ------------------------------------------------------------------------------ 19 | 20 | tests :: [Test] 21 | tests = [ testParseFromStream 22 | , testParseFromStreamError 23 | , testParseFromStreamError2 24 | , testPartialParse 25 | , testEmbeddedNull 26 | , testTrivials 27 | , testParseFromStreamU 28 | ] 29 | 30 | 31 | ------------------------------------------------------------------------------ 32 | testParser :: Parser (Maybe Int) 33 | testParser = do 34 | end <- atEnd 35 | if end 36 | then return Nothing 37 | else do 38 | _ <- takeWhile (\c -> isSpace c || c == ',') 39 | liftM Just decimal 40 | 41 | 42 | ------------------------------------------------------------------------------ 43 | testParser2 :: Parser (Maybe Text) 44 | testParser2 = do 45 | end <- atEnd 46 | if end 47 | then return Nothing 48 | else liftM Just $ string "bork" 49 | 50 | 51 | ------------------------------------------------------------------------------ 52 | testParserU :: Parser (Maybe Text) 53 | testParserU = do 54 | end <- atEnd 55 | if end 56 | then return Nothing 57 | else do 58 | _ <- takeWhile (not . isAlpha) 59 | liftM Just (takeWhile isAlpha) 60 | 61 | 62 | ------------------------------------------------------------------------------ 63 | testParseFromStream :: Test 64 | testParseFromStream = testCase "attoparsec/parseFromStream" $ do 65 | is <- fromList ["1", "23", ", 4", ", 5, 6, 7"] 66 | x0 <- parseFromStream testParser is 67 | 68 | assertEqual "first parse" (Just 123) x0 69 | 70 | l <- parserToInputStream testParser is >>= toList 71 | 72 | assertEqual "rest" [4, 5, 6, 7] l 73 | toList is >>= assertEqual "double eof" [] 74 | 75 | 76 | ------------------------------------------------------------------------------ 77 | testParseFromStreamError :: Test 78 | testParseFromStreamError = testCase "attoparsec/parseFromStreamError" $ do 79 | is <- fromList ["1", "23", ", 4", ",xxxx 5, 6, 7"] >>= 80 | parserToInputStream testParser 81 | 82 | expectExceptionH $ toList is 83 | 84 | 85 | ------------------------------------------------------------------------------ 86 | testParseFromStreamError2 :: Test 87 | testParseFromStreamError2 = testCase "attoparsec/parseFromStreamError2" $ do 88 | l <- fromList ["borkbork", "bork"] >>= p 89 | assertEqual "ok" ["bork", "bork", "bork"] l 90 | 91 | expectExceptionH $ fromList ["bork", "bo"] >>= p 92 | expectExceptionH $ fromList ["xxxxx"] >>= p 93 | 94 | where 95 | p = parserToInputStream ((testParser2 "foo") "bar") >=> toList 96 | 97 | 98 | ------------------------------------------------------------------------------ 99 | testPartialParse :: Test 100 | testPartialParse = testCase "attoparsec/partialParse" $ do 101 | is <- fromList ["1,", "2,", "3"] 102 | expectExceptionH $ parseFromStreamInternal parseFunc feedFunc testParser is 103 | 104 | where 105 | result = Partial (const result) 106 | parseFunc = const $ const $ result 107 | feedFunc = const $ const $ result 108 | 109 | ------------------------------------------------------------------------------ 110 | testTrivials :: Test 111 | testTrivials = testCase "attoparsec/trivials" $ do 112 | coverTypeableInstance (undefined :: ParseException) 113 | let (Right x) = eitherResult $ Done undefined 4 :: Either (Text, [String], String) Int 114 | assertEqual "eitherResult" 4 x 115 | 116 | ------------------------------------------------------------------------------ 117 | testEmbeddedNull :: Test 118 | testEmbeddedNull = testCase "attoparsec/embeddedNull" $ do 119 | is <- fromList ["", "1", "23", "", ", 4", ", 5, 6, 7"] 120 | x0 <- parseFromStream testParser is 121 | 122 | assertEqual "first parse" (Just 123) x0 123 | 124 | l <- parserToInputStream testParser is >>= toList 125 | 126 | assertEqual "rest" [4, 5, 6, 7] l 127 | 128 | ------------------------------------------------------------------------------ 129 | testParseFromStreamU :: Test 130 | testParseFromStreamU = testCase "attoparsec/parseFromStreamU" $ do 131 | is <- fromList ["123æø", "å", "💻⛇⛄☃Š", "š5ŧđ6naå7"] 132 | x0 <- parseFromStream testParserU is 133 | 134 | assertEqual "first parse" (Just "æøå") x0 135 | 136 | l <- parserToInputStream testParserU is >>= toList 137 | 138 | assertEqual "rest" ["Šš", "ŧđ", "naå", ""] l 139 | toList is >>= assertEqual "double eof" [] 140 | 141 | -------------------------------------------------------------------------------- /test/System/IO/Streams/Tests/Builder.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module System.IO.Streams.Tests.Builder (tests) where 4 | 5 | ------------------------------------------------------------------------------ 6 | import Control.Monad 7 | import Data.ByteString.Builder (byteString, toLazyByteString) 8 | import Data.ByteString.Builder.Extra (flush) 9 | import Data.ByteString.Builder.Internal (newBuffer) 10 | import qualified Data.ByteString.Char8 as S 11 | import qualified Data.ByteString.Lazy.Char8 as L 12 | import Data.List 13 | import Data.Monoid 14 | import System.IO.Streams hiding (intersperse, map, take) 15 | import qualified System.IO.Streams as Streams 16 | import Test.Framework 17 | import Test.Framework.Providers.HUnit 18 | import Test.HUnit hiding (Test) 19 | ------------------------------------------------------------------------------ 20 | 21 | tests :: [Test] 22 | tests = [ testBuilderStream 23 | , testRepeatedConnects 24 | , testUnsafeBuilderStream 25 | , testSmallBuffer 26 | , testSmallBufferWithLargeOutput 27 | , testNullStream 28 | ] 29 | 30 | 31 | ------------------------------------------------------------------------------ 32 | testBuilderStream :: Test 33 | testBuilderStream = testCase "builder/builderStream" $ do 34 | let l1 = intersperse " " ["the", "quick", "brown", "fox"] 35 | let l2 = intersperse " " ["jumped", "over", "the"] 36 | let l = map byteString l1 ++ [flush] ++ map byteString l2 37 | 38 | is <- fromList l 39 | (os0, grab) <- listOutputStream 40 | os <- builderStream os0 41 | 42 | connect is os 43 | output <- grab 44 | assertEqual "properly buffered" 45 | [ "the quick brown fox" 46 | , "" 47 | , "jumped over the" 48 | ] 49 | output 50 | 51 | 52 | ------------------------------------------------------------------------------ 53 | testRepeatedConnects :: Test 54 | testRepeatedConnects = testCase "builder/repeatedConnects" $ do 55 | (os0, grab) <- Streams.listOutputStream 56 | os <- Streams.builderStream os0 57 | is0 <- Streams.fromList ["Hello, world!\n"] 58 | >>= Streams.map byteString 59 | is1 <- Streams.fromList ["Bye, world!\n"] 60 | >>= Streams.map byteString 61 | Streams.connect is0 os 62 | Streams.connect is1 os 63 | Streams.write Nothing os 64 | 65 | grab >>= assertEqual "repeated connect" ["Hello, world!\n"] 66 | 67 | 68 | ------------------------------------------------------------------------------ 69 | testUnsafeBuilderStream :: Test 70 | testUnsafeBuilderStream = testCase "builder/unsafeBuilderStream" $ do 71 | let l1 = intersperse " " ["the", "quick", "brown", "fox"] 72 | let l2 = intersperse " " ["jumped", "over", "the"] 73 | let l = map byteString l1 ++ [flush] ++ map byteString l2 74 | 75 | is <- fromList l 76 | (os0, grab) <- listOutputStream 77 | os1 <- contramapM (return . S.copy) os0 78 | 79 | os <- unsafeBuilderStream (newBuffer 1024) os1 80 | 81 | connect is os 82 | output <- grab 83 | assertEqual "properly buffered" 84 | [ "the quick brown fox" 85 | , "" 86 | , "jumped over the" 87 | ] 88 | output 89 | 90 | ------------------------------------------------------------------------------ 91 | testSmallBuffer :: Test 92 | testSmallBuffer = testCase "builder/smallBuffer" $ do 93 | (os0, grab) <- listOutputStream 94 | os <- builderStreamWithBufferSize 10 os0 95 | let l1 = intersperse " " ["the", "quick", "brown"] 96 | let l2 = [" fooooooooooooooooox"] 97 | let l = map byteString l1 ++ [flush, flush, flush] 98 | ++ map byteString l2 99 | 100 | is <- fromList l 101 | connect is os 102 | output <- liftM S.concat grab 103 | 104 | assertEqual "short buffer" "the quick brown fooooooooooooooooox" output 105 | 106 | 107 | ------------------------------------------------------------------------------ 108 | testSmallBufferWithLargeOutput :: Test 109 | testSmallBufferWithLargeOutput = 110 | testCase "builder/smallBufferWithLargeOutput" $ do 111 | (os0, grab) <- listOutputStream 112 | os1 <- contramapM (return . S.copy) os0 113 | os <- unsafeBuilderStream (newBuffer 10) os1 114 | 115 | let l = take 3000 $ cycle $ 116 | replicate 20 (byteString "bloooooooort") ++ [flush] 117 | 118 | is <- fromList l 119 | let s = S.concat $ L.toChunks $ toLazyByteString $ mconcat l 120 | 121 | connect is os 122 | output <- liftM S.concat grab 123 | 124 | assertEqual "short buffer 2" s output 125 | 126 | write (Just $ byteString "ok") os 127 | write Nothing os 128 | 129 | fout <- grab 130 | 131 | -- no output should be sent because of nullSink 132 | assertEqual "nullSink" [] fout 133 | 134 | 135 | ------------------------------------------------------------------------------ 136 | testNullStream :: Test 137 | testNullStream = testCase "builder/nullStream" $ do 138 | (os0, grab) <- listOutputStream 139 | os <- builderStream os0 140 | 141 | is <- fromList [] 142 | connect is os 143 | 144 | l <- grab 145 | assertEqual "null stream" [] l 146 | -------------------------------------------------------------------------------- /test/System/IO/Streams/Tests/Common.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleInstances #-} 2 | {-# LANGUAGE ScopedTypeVariables #-} 3 | {-# OPTIONS_GHC -fno-warn-orphans #-} 4 | module System.IO.Streams.Tests.Common where 5 | 6 | ------------------------------------------------------------------------------ 7 | import Control.DeepSeq 8 | import Control.Exception 9 | import qualified Control.Exception as E 10 | import Control.Monad 11 | import Control.Monad.Trans 12 | import qualified Data.ByteString as S 13 | import Data.ByteString.Internal (c2w) 14 | import qualified Data.ByteString.Lazy as L 15 | import Data.Typeable 16 | import Test.QuickCheck 17 | import Test.QuickCheck.Monadic 18 | import qualified Test.QuickCheck.Monadic as QC 19 | 20 | 21 | ------------------------------------------------------------------------------ 22 | instance Arbitrary S.ByteString where 23 | arbitrary = liftM (S.pack . map c2w) arbitrary 24 | 25 | instance Arbitrary L.ByteString where 26 | arbitrary = do 27 | n <- choose(0,5) 28 | chunks <- replicateM n arbitrary 29 | return $ L.fromChunks chunks 30 | 31 | 32 | ------------------------------------------------------------------------------ 33 | eatException :: IO a -> IO () 34 | eatException a = (a >> return ()) `E.catch` handler 35 | where 36 | handler :: SomeException -> IO () 37 | handler _ = return () 38 | 39 | 40 | ------------------------------------------------------------------------------ 41 | forceSameType :: a -> a -> a 42 | forceSameType _ a = a 43 | 44 | 45 | ------------------------------------------------------------------------------ 46 | -- | Kill the false negative on derived show instances. 47 | coverShowInstance :: (MonadIO m, Show a) => a -> m () 48 | coverShowInstance x = liftIO (a >> b >> c) 49 | where 50 | a = eatException $ evaluate $ showsPrec 0 x "" 51 | b = eatException $ evaluate $ show x 52 | c = eatException $ evaluate $ showList [x] "" 53 | 54 | 55 | ------------------------------------------------------------------------------ 56 | coverReadInstance :: (MonadIO m, Read a) => a -> m () 57 | coverReadInstance x = do 58 | liftIO $ eatException $ evaluate $ forceSameType [(x,"")] $ readsPrec 0 "" 59 | liftIO $ eatException $ evaluate $ forceSameType [([x],"")] $ readList "" 60 | 61 | 62 | ------------------------------------------------------------------------------ 63 | coverEqInstance :: (Monad m, Eq a) => a -> m () 64 | coverEqInstance x = a `seq` b `seq` return () 65 | where 66 | a = x == x 67 | b = x /= x 68 | 69 | 70 | ------------------------------------------------------------------------------ 71 | coverOrdInstance :: (Monad m, Ord a) => a -> m () 72 | coverOrdInstance x = a `deepseq` b `deepseq` return () 73 | where 74 | a = [ x < x 75 | , x >= x 76 | , x > x 77 | , x <= x 78 | , compare x x == EQ ] 79 | 80 | b = min a $ max a a 81 | 82 | 83 | ------------------------------------------------------------------------------ 84 | coverTypeableInstance :: (Monad m, Typeable a) => a -> m () 85 | coverTypeableInstance a = typeOf a `seq` return () 86 | 87 | 88 | ------------------------------------------------------------------------------ 89 | expectException :: IO a -> PropertyM IO () 90 | expectException m = do 91 | e <- liftQ $ try m 92 | case e of 93 | Left (z::SomeException) -> (length $ show z) `seq` return () 94 | Right _ -> fail "expected exception, didn't get one" 95 | 96 | 97 | ------------------------------------------------------------------------------ 98 | expectExceptionH :: IO a -> IO () 99 | expectExceptionH act = do 100 | e <- try act 101 | case e of 102 | Left (z::SomeException) -> (length $ show z) `seq` return () 103 | Right _ -> fail "expected exception, didn't get one" 104 | 105 | 106 | ------------------------------------------------------------------------------ 107 | liftQ :: forall a m . (Monad m) => m a -> PropertyM m a 108 | liftQ = QC.run 109 | -------------------------------------------------------------------------------- /test/System/IO/Streams/Tests/Concurrent.hs: -------------------------------------------------------------------------------- 1 | module System.IO.Streams.Tests.Concurrent (tests) where 2 | 3 | ------------------------------------------------------------------------------ 4 | import Control.Concurrent 5 | import Control.Monad 6 | import Prelude hiding (lines, read, takeWhile, unlines, unwords, unwords, words) 7 | import qualified System.IO.Streams as Streams 8 | import qualified System.IO.Streams.Concurrent as Streams 9 | import System.IO.Streams.Tests.Common 10 | import Test.Framework 11 | import Test.Framework.Providers.HUnit 12 | import Test.Framework.Providers.QuickCheck2 13 | import Test.HUnit hiding (Test) 14 | import Test.QuickCheck hiding (output) 15 | import Test.QuickCheck.Monadic 16 | ------------------------------------------------------------------------------ 17 | 18 | tests :: [Test] 19 | tests = [ testMakeChanPipe 20 | , testConcurrentMerge 21 | , testConcurrentMergeException 22 | , testInputOutput 23 | ] 24 | 25 | 26 | ------------------------------------------------------------------------------ 27 | testMakeChanPipe :: Test 28 | testMakeChanPipe = testProperty "concurrent/makeChanPipe" $ 29 | monadicIO $ 30 | forAllM arbitrary prop 31 | where 32 | prop :: [Int] -> PropertyM IO () 33 | prop l = liftQ $ do 34 | (is, os) <- Streams.makeChanPipe 35 | _ <- forkIO $ Streams.writeList l os >> Streams.write Nothing os 36 | Streams.toList is >>= assertEqual "makeChanPipe" l 37 | 38 | 39 | ------------------------------------------------------------------------------ 40 | testConcurrentMerge :: Test 41 | testConcurrentMerge = testCase "concurrent/concurrentMerge" $ do 42 | mvars <- replicateM nthreads newEmptyMVar 43 | chans <- replicateM nthreads newChan 44 | let firstMVar = head mvars 45 | 46 | mapM_ (forkIO . ring) $ zip3 mvars (take nthreads $ drop 1 $ cycle mvars) 47 | chans 48 | inputs <- mapM Streams.chanToInput chans 49 | resultMVar <- newEmptyMVar 50 | _ <- forkIO (Streams.concurrentMerge inputs >>= Streams.toList 51 | >>= putMVar resultMVar) 52 | putMVar firstMVar 0 53 | result <- takeMVar resultMVar 54 | assertEqual "concurrent merge" [0..10] result 55 | 56 | where 57 | maxval = 10 :: Int 58 | nthreads = 4 :: Int 59 | 60 | ring (prev, next, chan) = loop 61 | where 62 | loop = do x <- takeMVar prev 63 | if x > maxval 64 | then do writeChan chan Nothing 65 | putMVar next x 66 | else do writeChan chan $ Just x 67 | threadDelay 100000 68 | putMVar next $! x + 1 69 | loop 70 | 71 | ------------------------------------------------------------------------------ 72 | testConcurrentMergeException :: Test 73 | testConcurrentMergeException = 74 | testCase "concurrent/concurrentMerge/exception" $ do 75 | inp <- Streams.makeInputStream (error "bad") >>= 76 | Streams.concurrentMerge . (:[]) 77 | expectExceptionH (Streams.toList inp) 78 | 79 | 80 | ------------------------------------------------------------------------------ 81 | testInputOutput :: Test 82 | testInputOutput = testCase "concurrent/input-output" $ do 83 | is <- Streams.fromList [1..10::Int] 84 | chan <- newChan 85 | is' <- Streams.chanToInput chan 86 | Streams.inputToChan is chan 87 | Streams.toList is' >>= assertEqual "input-output" [1..10] 88 | -------------------------------------------------------------------------------- /test/System/IO/Streams/Tests/Debug.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE BangPatterns #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | 4 | module System.IO.Streams.Tests.Debug (tests) where 5 | 6 | ------------------------------------------------------------------------------ 7 | import qualified Data.ByteString.Char8 as S 8 | import qualified System.IO.Streams as Streams 9 | import qualified System.IO.Streams.Debug as Streams 10 | import Test.Framework 11 | import Test.Framework.Providers.HUnit 12 | import Test.HUnit hiding (Test) 13 | 14 | 15 | ------------------------------------------------------------------------------ 16 | tests :: [Test] 17 | tests = [ testDebugInput 18 | , testDebugOutput 19 | ] 20 | 21 | 22 | ------------------------------------------------------------------------------ 23 | testDebugInput :: Test 24 | testDebugInput = testCase "debug/input" $ do 25 | s <- Streams.fromList [S.replicate 100 'a', "foo"] 26 | (ds, getDebugOutput) <- Streams.listOutputStream 27 | s' <- Streams.debugInputBS "foo" ds s 28 | Streams.unRead "blah" s' 29 | Streams.skipToEof s' 30 | 31 | l <- getDebugOutput 32 | 33 | assertEqual "debugInput" expected l 34 | where 35 | expected = [ 36 | "foo: pushback: \"blah\"\n" 37 | , "foo: got chunk: \"blah\"\n" 38 | , "foo: got chunk: \"aaaaaaaaaaaaaa ... aaaaaaaaaaaaaa\" (100 bytes)\n" 39 | , "foo: got chunk: \"foo\"\n" 40 | , "foo: got EOF\n" 41 | ] 42 | 43 | 44 | ------------------------------------------------------------------------------ 45 | testDebugOutput :: Test 46 | testDebugOutput = testCase "debug/output" $ do 47 | is <- Streams.fromList [S.replicate 100 'a', "foo"] 48 | o <- Streams.makeOutputStream f 49 | (ds, getDebugOutput) <- Streams.listOutputStream 50 | o' <- Streams.debugOutputBS "foo" ds o 51 | Streams.connect is o' 52 | 53 | l <- getDebugOutput 54 | 55 | assertEqual "debugInput" expected l 56 | where 57 | f !_ = return () 58 | 59 | expected = [ 60 | "foo: got chunk: \"aaaaaaaaaaaaaa ... aaaaaaaaaaaaaa\" (100 bytes)\n" 61 | , "foo: got chunk: \"foo\"\n" 62 | , "foo: got EOF\n" 63 | ] 64 | 65 | -------------------------------------------------------------------------------- /test/System/IO/Streams/Tests/File.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module System.IO.Streams.Tests.File (tests) where 4 | 5 | ------------------------------------------------------------------------------ 6 | import Control.Exception 7 | import Control.Monad hiding (mapM) 8 | import Data.ByteString.Char8 (ByteString) 9 | import qualified Data.ByteString.Char8 as S 10 | import qualified Data.ByteString.Lazy.Char8 as L 11 | import Data.List 12 | import Prelude hiding (mapM, read) 13 | import System.Directory 14 | import System.FilePath 15 | import System.IO 16 | import System.IO.Streams hiding (intersperse, mapM_) 17 | import Test.Framework 18 | import Test.Framework.Providers.HUnit 19 | import Test.HUnit hiding (Test) 20 | ------------------------------------------------------------------------------ 21 | import System.IO.Streams.Tests.Common 22 | 23 | tests :: [Test] 24 | tests = [ testFiles 25 | , testBigFiles 26 | ] 27 | 28 | 29 | ------------------------------------------------------------------------------ 30 | copyingListOutputStream :: IO (OutputStream ByteString, IO [ByteString]) 31 | copyingListOutputStream = do 32 | (os, grab) <- listOutputStream 33 | os' <- contramap S.copy os >>= lockingOutputStream 34 | return (os', grab) 35 | 36 | 37 | ------------------------------------------------------------------------------ 38 | testFiles :: Test 39 | testFiles = testCase "file/files" $ do 40 | createDirectoryIfMissing False "tmp" 41 | sequence_ [tst1, tst2, tst3, tst4, tst5] `finally` cleanup 42 | 43 | where 44 | fn x = ("tmp" "data") ++ show (x :: Int) 45 | 46 | cleanup = eatException $ do 47 | mapM_ (eatException . removeFile . fn) [1, 2, 3, 4, 5] 48 | removeDirectory "tmp" 49 | 50 | tst mode n = do 51 | withFileAsOutputExt (fn n) mode (BlockBuffering $ Just 2048) $ \os -> do 52 | let l = "" : (intersperse " " ["the", "quick", "brown", "fox"]) 53 | fromList l >>= connectTo os 54 | 55 | l <- liftM S.concat $ withFileAsInput (fn n) toList 56 | assertEqual "testFiles" "the quick brown fox" l 57 | 58 | tst1 = tst WriteMode 1 59 | tst2 = tst AppendMode 2 60 | tst3 = tst ReadWriteMode 3 61 | tst4 = expectExceptionH (tst ReadMode 4) 62 | tst5 = do 63 | withFileAsOutput (fn 5) $ \os -> do 64 | let l = "" : (intersperse " " ["the", "quick", "brown", "fox"]) 65 | fromList l >>= connectTo os 66 | 67 | l <- liftM S.concat $ withFileAsInput (fn 5) toList 68 | assertEqual "testFiles" "the quick brown fox" l 69 | 70 | 71 | ------------------------------------------------------------------------------ 72 | testBigFiles :: Test 73 | testBigFiles = testCase "file/bigFiles" $ do 74 | createDirectoryIfMissing False "tmp2" 75 | tst `finally` eatException (removeFile fn >> removeDirectory "tmp2") 76 | 77 | where 78 | fn = "tmp2" "data" 79 | 80 | testSz = 20 * 1024 * 1024 81 | 82 | tst = do 83 | let l = L.take testSz $ L.cycle $ 84 | L.fromChunks (intersperse " " ["the", "quick", "brown", "fox"]) 85 | 86 | withFileAsOutputExt fn WriteMode NoBuffering $ \os -> do 87 | fromList [S.concat $ L.toChunks l] >>= connectTo os 88 | 89 | l1 <- liftM L.fromChunks $ withFileAsInput fn toList 90 | assertBool "testFiles2" (l1 == l) 91 | 92 | l2 <- liftM L.fromChunks $ withFileAsInputStartingAt 5 fn toList 93 | assertBool "testFiles3" (l2 == (L.drop 5 l)) 94 | 95 | (os, grab) <- copyingListOutputStream 96 | unsafeWithFileAsInputStartingAt 0 fn (connectTo os) 97 | 98 | l3 <- liftM L.fromChunks grab 99 | assertBool "testFiles4" (l3 == l) 100 | -------------------------------------------------------------------------------- /test/System/IO/Streams/Tests/Handle.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE BangPatterns #-} 2 | {-# LANGUAGE CPP #-} 3 | {-# LANGUAGE OverloadedStrings #-} 4 | 5 | module System.IO.Streams.Tests.Handle (tests) where 6 | 7 | ------------------------------------------------------------------------------ 8 | import Control.Exception 9 | import Control.Monad hiding (mapM) 10 | import Data.ByteString.Builder (byteString) 11 | import qualified Data.ByteString.Char8 as S 12 | import Data.List 13 | import Foreign.Marshal.Alloc (allocaBytes) 14 | import Foreign.Marshal.Utils (copyBytes) 15 | import Foreign.Ptr (castPtr) 16 | import qualified GHC.IO.Buffer as HB 17 | import qualified GHC.IO.BufferedIO as H 18 | import qualified GHC.IO.Device as H 19 | import Prelude hiding (mapM, read) 20 | import System.Directory 21 | import System.FilePath 22 | import System.IO hiding (stderr, stdin, stdout) 23 | import qualified System.IO as IO 24 | import System.IO.Streams (OutputStream) 25 | import qualified System.IO.Streams as Streams 26 | import qualified System.IO.Streams.Internal as Streams 27 | import Test.Framework 28 | import Test.Framework.Providers.HUnit 29 | import Test.HUnit hiding (Test) 30 | ------------------------------------------------------------------------------ 31 | import System.IO.Streams.Tests.Common 32 | 33 | tests :: [Test] 34 | tests = [ testHandle 35 | , testStdHandles 36 | , testRepeatedConnects 37 | , testInputStreamToHandle 38 | , testOutputStreamToHandle 39 | , testStreamPairToHandle 40 | , testHandleInstances 41 | , testHandleBadnesses 42 | ] 43 | 44 | 45 | ------------------------------------------------------------------------------ 46 | testHandle :: Test 47 | testHandle = testCase "handle/files" $ do 48 | createDirectoryIfMissing False "tmp" 49 | tst `finally` eatException (removeFile fn >> removeDirectory "tmp") 50 | 51 | where 52 | fn = "tmp" "data" 53 | 54 | tst = do 55 | withBinaryFile fn WriteMode $ \h -> do 56 | let l = "" : (intersperse " " ["the", "quick", "brown", "fox"]) 57 | os <- Streams.handleToOutputStream h 58 | Streams.fromList l >>= Streams.connectTo os 59 | 60 | withBinaryFile fn ReadMode $ \h -> do 61 | l <- liftM S.concat (Streams.handleToInputStream h >>= 62 | Streams.toList) 63 | assertEqual "testFiles" "the quick brown fox" l 64 | 65 | 66 | ------------------------------------------------------------------------------ 67 | testRepeatedConnects :: Test 68 | testRepeatedConnects = testCase "handle/repeatedConnects" $ do 69 | createDirectoryIfMissing False dirname 70 | tst `finally` eatException (removeFile fn >> removeDirectory dirname) 71 | where 72 | dirname = "tmp_r_c" 73 | fn = dirname "data" 74 | 75 | tst = do 76 | withBinaryFile fn WriteMode $ \h -> do 77 | os0 <- Streams.handleToOutputStream h 78 | os <- Streams.builderStream os0 79 | 80 | let l1 = map byteString ["the ", "quick ", "brown "] 81 | let l2 = map byteString ["fox ", "jumped"] 82 | Streams.fromList l1 >>= Streams.connectTo os 83 | Streams.fromList l2 >>= Streams.connectTo os 84 | S.readFile fn >>= assertEqual "eof should close" "the quick brown " 85 | 86 | ------------------------------------------------------------------------------ 87 | testStdHandles :: Test 88 | testStdHandles = testCase "handle/stdHandles" $ do 89 | hClose IO.stdin 90 | -- Should generate exception: handle is closed. 91 | expectExceptionH (Streams.toList Streams.stdin) 92 | Streams.write (Just "") Streams.stdout 93 | Streams.write (Just "") Streams.stderr 94 | return () 95 | 96 | 97 | ------------------------------------------------------------------------------ 98 | testInputStreamToHandle :: Test 99 | testInputStreamToHandle = testCase "handle/inputStreamToHandle" $ do 100 | h <- Streams.fromList ["foo", "bar", "baz"] >>= 101 | Streams.inputStreamToHandle 102 | S.hGetContents h >>= assertEqual "inputStreamToHandle" "foobarbaz" 103 | 104 | 105 | ------------------------------------------------------------------------------ 106 | testOutputStreamToHandle :: Test 107 | testOutputStreamToHandle = testCase "handle/outputStreamToHandle" $ do 108 | (os, getInput) <- Streams.listOutputStream 109 | h <- Streams.outputStreamToHandle os 110 | S.hPutStrLn h "foo" 111 | liftM S.concat getInput >>= assertEqual "outputStreamToHandle" "foo\n" 112 | 113 | 114 | ------------------------------------------------------------------------------ 115 | testStreamPairToHandle :: Test 116 | testStreamPairToHandle = testCase "handle/streamPairToHandle" $ do 117 | is <- Streams.fromList ["foo", "bar", "baz"] 118 | (os, getInput) <- Streams.listOutputStream 119 | 120 | h <- Streams.streamPairToHandle is os 121 | S.hPutStrLn h "foo" 122 | S.hGetContents h >>= assertEqual "input stream" "foobarbaz" 123 | liftM S.concat getInput >>= assertEqual "output stream" "foo\n" 124 | 125 | 126 | ------------------------------------------------------------------------------ 127 | testHandleBadnesses :: Test 128 | testHandleBadnesses = testCase "handle/badness" $ do 129 | h <- Streams.fromList ["foo", "bar", "baz"] >>= Streams.inputStreamToHandle 130 | _ <- S.hGetContents h 131 | expectExceptionH $ S.hGetContents h 132 | 133 | h' <- Streams.fromList ["foo", "bar", "baz"] >>= Streams.inputStreamToHandle 134 | expectExceptionH $ S.hPutStrLn h' "foo" 135 | 136 | (os, _) <- Streams.listOutputStream 137 | h'' <- Streams.outputStreamToHandle os 138 | expectExceptionH $ S.hGetContents h'' 139 | 140 | is <- Streams.fromList ["foo"] 141 | h''' <- Streams.streamPairToHandle is os 142 | _ <- S.hGetContents h''' 143 | expectExceptionH $ S.hGetContents h''' 144 | 145 | 146 | ------------------------------------------------------------------------------ 147 | testHandleInstances :: Test 148 | testHandleInstances = testCase "handle/ghc-instances" $ do 149 | is <- Streams.fromList ["foo", "bar", "baz" :: S.ByteString] 150 | (os, getList) <- Streams.listOutputStream 151 | let sp = Streams.SP is (os :: OutputStream S.ByteString) 152 | expectExceptionH $ withZeroOffset H.write is undefined undefined 153 | expectExceptionH $ withZeroOffset H.writeNonBlocking is undefined undefined 154 | expectExceptionH $ H.flushWriteBuffer is undefined 155 | expectExceptionH $ H.flushWriteBuffer0 is undefined 156 | 157 | expectExceptionH $ withZeroOffset H.read os undefined undefined 158 | expectExceptionH $ withZeroOffset H.writeNonBlocking os undefined undefined 159 | 160 | expectExceptionH $ H.fillReadBuffer0 is undefined 161 | expectExceptionH $ H.fillReadBuffer0 os undefined 162 | expectExceptionH $ H.fillReadBuffer0 sp undefined 163 | 164 | H.ready is False 0 >>= assertEqual "ready input" True 165 | H.ready os False 0 >>= assertEqual "ready output" True 166 | H.ready sp False 0 >>= assertEqual "ready pair" True 167 | 168 | H.devType is >>= assertBool "devtype input" . (== H.Stream) 169 | H.devType os >>= assertBool "devtype output" . (== H.Stream) 170 | H.devType sp >>= assertBool "devtype pair" . (== H.Stream) 171 | 172 | expectExceptionH $ withZeroOffset H.readNonBlocking is undefined undefined 173 | expectExceptionH $ withZeroOffset H.readNonBlocking os undefined undefined 174 | expectExceptionH $ withZeroOffset H.readNonBlocking sp undefined undefined 175 | expectExceptionH $ withZeroOffset H.writeNonBlocking is undefined undefined 176 | expectExceptionH $ withZeroOffset H.writeNonBlocking os undefined undefined 177 | expectExceptionH $ withZeroOffset H.writeNonBlocking sp undefined undefined 178 | 179 | S.useAsCStringLen "foo" $ \(cstr, l) -> do 180 | withZeroOffset H.write os (castPtr cstr) l 181 | liftM S.concat getList >>= assertEqual "H.write 1" "foo" 182 | withZeroOffset H.write sp (castPtr cstr) l 183 | liftM S.concat getList >>= assertEqual "H.write 2" "foo" 184 | buf <- H.newBuffer sp HB.WriteBuffer 185 | HB.withBuffer buf $ \ptr -> copyBytes ptr (castPtr cstr) 3 186 | (l', !buf') <- H.flushWriteBuffer0 sp $ buf { HB.bufR = 3 } 187 | assertEqual "flushWriteBuffer0" 3 l' 188 | assertEqual "bufR" 0 $ HB.bufR buf' 189 | liftM S.concat getList >>= assertEqual "write 3" "foo" 190 | 191 | 192 | allocaBytes 3 $ \buf -> do 193 | l <- withZeroOffset H.read is buf 3 194 | assertEqual "3 byte read" 3 l 195 | S.packCStringLen (castPtr buf, l) >>= assertEqual "first read" "foo" 196 | l' <- withZeroOffset H.read sp buf 3 197 | assertEqual "3 byte read #2" 3 l' 198 | S.packCStringLen (castPtr buf, l') >>= assertEqual "second read" "bar" 199 | expectExceptionH $ withZeroOffset H.read os buf 3 200 | where 201 | #if MIN_VERSION_base(4,15,0) 202 | withZeroOffset :: Num off => (a -> ptr -> off -> n -> ioint) -> a -> ptr -> n -> ioint 203 | withZeroOffset f a ptr n = f a ptr 0 n 204 | #else 205 | withZeroOffset :: a -> a 206 | withZeroOffset = id 207 | #endif 208 | -------------------------------------------------------------------------------- /test/System/IO/Streams/Tests/Internal.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE BangPatterns #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | 4 | module System.IO.Streams.Tests.Internal (tests) where 5 | 6 | ------------------------------------------------------------------------------ 7 | import Control.Applicative 8 | import Control.Monad hiding (mapM) 9 | import Control.Monad.IO.Class (liftIO) 10 | import Data.IORef 11 | import Prelude hiding (mapM, read) 12 | import Test.Framework 13 | import Test.Framework.Providers.HUnit 14 | import Test.HUnit hiding (Test) 15 | ------------------------------------------------------------------------------ 16 | import System.IO.Streams.Internal 17 | import System.IO.Streams.List 18 | import System.IO.Streams.Tests.Common 19 | 20 | tests :: [Test] 21 | tests = [ testAppendInput 22 | , testConst 23 | , testCoverLockingStream 24 | , testPeek 25 | , testNullInput 26 | , testGenerator 27 | , testGeneratorInstances 28 | , testConsumer 29 | , testTrivials 30 | ] 31 | 32 | 33 | ------------------------------------------------------------------------------ 34 | testAppendInput :: Test 35 | testAppendInput = testCase "internal/appendInputStream" $ do 36 | s1 <- fromList [1::Int, 2, 3] 37 | s2 <- fromList [5, 6, 7] 38 | 39 | is <- appendInputStream s1 s2 40 | l <- toList is 41 | 42 | assertEqual "appendInputStream" [1,2,3,5,6,7] l 43 | 44 | 45 | ------------------------------------------------------------------------------ 46 | testConst :: Test 47 | testConst = testCase "internal/const" $ do 48 | is <- makeInputStream (return (Just (1::Int))) 49 | read is >>= assertEqual "const" (Just 1) 50 | 51 | unRead 7 is 52 | read is >>= assertEqual "unRead" (Just 7) 53 | read is >>= assertEqual "const2" (Just 1) 54 | 55 | 56 | ------------------------------------------------------------------------------ 57 | testNullInput :: Test 58 | testNullInput = testCase "internal/nullInput" $ do 59 | is <- nullInput 60 | xs <- replicateM 10 $ read (is :: InputStream Int) 61 | assertEqual "nullInput" (replicate 10 Nothing) xs 62 | 63 | 64 | ------------------------------------------------------------------------------ 65 | testCoverLockingStream :: Test 66 | testCoverLockingStream = testCase "internal/coverLockingStreams" $ do 67 | is <- fromList [1::Int, 2, 3] >>= lockingInputStream 68 | (os0, grab) <- listOutputStream 69 | os <- lockingOutputStream os0 70 | 71 | connect is os 72 | xs <- grab 73 | 74 | assertEqual "lockingStreams" [1,2,3] xs 75 | 76 | write Nothing os 77 | write Nothing os 78 | 79 | unRead 7 is 80 | y <- read is 81 | assertEqual "unRead" (Just 7) y 82 | 83 | 84 | ------------------------------------------------------------------------------ 85 | testPeek :: Test 86 | testPeek = testCase "internal/peek" $ do 87 | is <- fromList [1::Int, 2, 3] 88 | b <- atEOF is 89 | assertEqual "eof1" False b 90 | 91 | x0 <- peek is 92 | x1 <- peek is 93 | 94 | unRead 7 is 95 | x2 <- peek is 96 | 97 | assertEqual "peek" (map Just [1, 1, 7]) [x0, x1, x2] 98 | 99 | l <- toList is 100 | assertEqual "toList" [7, 1, 2, 3] l 101 | 102 | z <- peek is 103 | assertEqual "peekEOF" Nothing z 104 | 105 | b' <- atEOF is 106 | assertEqual "eof2" True b' 107 | 108 | 109 | ------------------------------------------------------------------------------ 110 | testGenerator :: Test 111 | testGenerator = testCase "internal/generator" $ do 112 | is <- fromGenerator $ sequence $ 113 | Prelude.map ((>>= yield) . (liftIO . return)) [1..5::Int] 114 | toList is >>= assertEqual "generator" [1..5] 115 | read is >>= assertEqual "read after EOF" Nothing 116 | 117 | 118 | ------------------------------------------------------------------------------ 119 | testGeneratorInstances :: Test 120 | testGeneratorInstances = testCase "internal/generatorInstances" $ do 121 | fromGenerator g1 >>= toList 122 | >>= assertEqual "generator" [2,4..10] 123 | 124 | fromGenerator g2 >>= toList 125 | >>= assertEqual "generator" [2,4..10] 126 | 127 | where 128 | g1 = do 129 | l <- fmap (map (*2)) $ return [1..5::Int] 130 | fmap id $ sequence_ $ Prelude.map yield l 131 | 132 | g2 = pure id <*> g1 133 | 134 | 135 | ------------------------------------------------------------------------------ 136 | testConsumer :: Test 137 | testConsumer = testCase "internal/consumer" $ do 138 | is <- fromList [1..10::Int] 139 | ref <- newIORef 0 140 | os <- fromConsumer (fmap id (pure id <*> c ref)) 141 | connect is os 142 | readIORef ref >>= assertEqual "sum" (sum [1..10]) 143 | 144 | -- should be nullsink after receiving Nothing 145 | write (Just 2) os 146 | readIORef ref >>= assertEqual "sum" (sum [1..10]) 147 | 148 | is2 <- fromList [1..10::Int] 149 | os2 <- fromConsumer (return ()) 150 | connect is2 os2 151 | 152 | where 153 | c ref = await >>= maybe (return ()) 154 | (\x -> do 155 | !t <- liftIO $ readIORef ref 156 | liftIO $ writeIORef ref $! t + x 157 | c ref) 158 | 159 | 160 | ------------------------------------------------------------------------------ 161 | testTrivials :: Test 162 | testTrivials = testCase "internal/trivials" $ do 163 | coverTypeableInstance (undefined :: InputStream Int) 164 | coverTypeableInstance (undefined :: OutputStream Int) 165 | coverTypeableInstance (undefined :: Generator Int ()) 166 | coverTypeableInstance (undefined :: Consumer Int ()) 167 | coverTypeableInstance (undefined :: SP Int Int) 168 | -------------------------------------------------------------------------------- /test/System/IO/Streams/Tests/List.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module System.IO.Streams.Tests.List (tests) where 4 | 5 | ------------------------------------------------------------------------------ 6 | import Control.Monad hiding (mapM) 7 | import Prelude hiding (mapM, read) 8 | import Test.Framework 9 | import Test.Framework.Providers.HUnit 10 | import Test.HUnit hiding (Test) 11 | ------------------------------------------------------------------------------ 12 | import System.IO.Streams.List 13 | ------------------------------------------------------------------------------ 14 | import System.IO.Streams.Tests.Common (expectExceptionH) 15 | 16 | tests :: [Test] 17 | tests = [ testChunkJoin, testChunkWithJoin ] 18 | 19 | 20 | 21 | testChunkJoin :: Test 22 | testChunkJoin = testCase "list/chunkList and join" $ do 23 | expectExceptionH (fromList [1..10::Int] >>= chunkList 0 >>= toList) 24 | 25 | fromList [1..10 :: Int] >>= chunkList 3 26 | >>= toList 27 | >>= assertEqual "chunkList" [ [1,2,3] 28 | , [4,5,6] 29 | , [7,8,9] 30 | , [10] 31 | ] 32 | fromList [1..12 :: Int] >>= chunkList 3 33 | >>= concatLists 34 | >>= toList 35 | >>= assertEqual "concatlists" [1..12] 36 | 37 | testChunkWithJoin :: Test 38 | testChunkWithJoin = testCase "list/chunkListWith and join" $ do 39 | fromList [1..10 :: Int] >>= chunkListWith (\_ n -> n>=3) 40 | >>= toList 41 | >>= assertEqual "chunkListWith" [ [1,2,3] 42 | , [4,5,6] 43 | , [7,8,9] 44 | , [10] 45 | ] 46 | fromList [1..12 :: Int] >>= chunkListWith (\_ n -> n>=3) 47 | >>= concatLists 48 | >>= toList 49 | >>= assertEqual "concatlists" [1..12] 50 | 51 | fromList ['a'..'z' :: Char] 52 | >>= chunkListWith (\x n -> n>=4 && x `elem` ("aeiouy" :: String)) 53 | >>= toList 54 | >>= assertEqual "chunkListWith" [ "abcde" 55 | , "fghi" 56 | , "jklmno" 57 | , "pqrstu" 58 | , "vwxy" 59 | , "z" 60 | ] 61 | -------------------------------------------------------------------------------- /test/System/IO/Streams/Tests/Network.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | {-# LANGUAGE CPP #-} 3 | 4 | module System.IO.Streams.Tests.Network (tests) where 5 | 6 | ------------------------------------------------------------------------------ 7 | import Control.Concurrent (forkIO, newEmptyMVar, putMVar, takeMVar) 8 | import Control.Monad (join) 9 | import qualified Data.ByteString.Char8 as S 10 | import Data.IORef (atomicModifyIORef, newIORef) 11 | import qualified Network.Socket as N 12 | import System.IO.Error (eofErrorType, mkIOError) 13 | import System.Timeout (timeout) 14 | import Test.Framework 15 | import Test.Framework.Providers.HUnit 16 | import Test.HUnit hiding (Test) 17 | #if MIN_VERSION_network(2,7,0) 18 | #else 19 | import Data.List (intercalate) 20 | #endif 21 | ------------------------------------------------------------------------------ 22 | import qualified System.IO.Streams.Internal as Streams 23 | import qualified System.IO.Streams.Internal.Network as Streams 24 | import qualified System.IO.Streams.List as Streams 25 | ------------------------------------------------------------------------------ 26 | import System.IO.Streams.Tests.Common (expectExceptionH) 27 | 28 | tests :: [Test] 29 | tests = [ testSocket 30 | , testSocketWithError 31 | ] 32 | 33 | testSocket :: Test 34 | testSocket = testCase "network/socket" $ 35 | N.withSocketsDo $ do 36 | x <- timeout (10 * 10^(6::Int)) go 37 | assertEqual "ok" (Just ()) x 38 | 39 | where 40 | -- compats 41 | #if MIN_VERSION_network(2,7,0) 42 | mkAddr = return . N.tupleToHostAddress 43 | defaultPort = N.defaultPort 44 | close = N.close 45 | bind = N.bind 46 | #else 47 | mkAddr (o1,o2,o3,o4) = N.inet_addr . intercalate "." $ map show [o1,o2,o3,o4] 48 | defaultPort = N.aNY_PORT 49 | close = N.sClose 50 | bind = N.bindSocket 51 | #endif 52 | 53 | go = do 54 | portMVar <- newEmptyMVar 55 | resultMVar <- newEmptyMVar 56 | _ <- forkIO $ client portMVar resultMVar 57 | server portMVar 58 | l <- takeMVar resultMVar 59 | assertEqual "testSocket" l ["ok"] 60 | 61 | client mvar resultMVar = do 62 | port <- takeMVar mvar 63 | sock <- N.socket N.AF_INET N.Stream N.defaultProtocol 64 | addr <- mkAddr (127, 0, 0, 1) 65 | let saddr = N.SockAddrInet port addr 66 | N.connect sock saddr 67 | (is, os) <- Streams.socketToStreams sock 68 | Streams.fromList ["", "ok"] >>= Streams.connectTo os 69 | N.shutdown sock N.ShutdownSend 70 | Streams.toList is >>= putMVar resultMVar 71 | close sock 72 | 73 | server mvar = do 74 | sock <- N.socket N.AF_INET N.Stream N.defaultProtocol 75 | addr <- mkAddr (127, 0, 0, 1) 76 | let saddr = N.SockAddrInet defaultPort addr 77 | bind sock saddr 78 | N.listen sock 5 79 | port <- N.socketPort sock 80 | putMVar mvar port 81 | (csock, _) <- N.accept sock 82 | (is, os) <- Streams.socketToStreams csock 83 | Streams.toList is >>= flip Streams.writeList os 84 | close csock 85 | close sock 86 | 87 | testSocketWithError :: Test 88 | testSocketWithError = testCase "network/socket-error" $ N.withSocketsDo $ do 89 | codes1 <- newIORef [ return 1 90 | , ioError $ mkIOError eofErrorType "eof" Nothing Nothing ] 91 | codes2 <- newIORef [ return 1 92 | , ioError $ userError "foo" ] 93 | 94 | (is1, _) <- Streams.socketToStreamsWithBufferSizeImpl (rbuf codes1) 64 (error "z") 95 | (Just s1) <- Streams.read is1 96 | assertEqual "one byte" 1 $ S.length s1 97 | Nothing <- Streams.read is1 98 | 99 | (is2, _) <- Streams.socketToStreamsWithBufferSizeImpl (rbuf codes2) 64 undefined 100 | (Just s2) <- Streams.read is2 101 | assertEqual "one byte" 1 $ S.length s2 102 | expectExceptionH $ Streams.read is2 103 | 104 | where 105 | rbuf rcodes _ _ _ = join $ atomicModifyIORef rcodes $ \codes -> 106 | (tail codes, head codes) 107 | -------------------------------------------------------------------------------- /test/System/IO/Streams/Tests/Process.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | {-# LANGUAGE ScopedTypeVariables #-} 4 | 5 | module System.IO.Streams.Tests.Process (tests) where 6 | 7 | ------------------------------------------------------------------------------ 8 | import Control.Concurrent 9 | import Control.Exception 10 | import Control.Monad (liftM, void) 11 | import Data.ByteString.Char8 (ByteString) 12 | import qualified Data.ByteString.Char8 as S 13 | import qualified System.IO.Streams as Streams 14 | import System.Timeout 15 | import Test.Framework 16 | import Test.Framework.Providers.HUnit 17 | import Test.HUnit hiding (Test) 18 | ------------------------------------------------------------------------------ 19 | 20 | tests :: [Test] 21 | #ifndef ENABLE_PROCESS_TESTS 22 | tests = [] 23 | #else 24 | tests = [ testInteractiveCommand 25 | , testInteractiveProcess 26 | ] 27 | 28 | 29 | ------------------------------------------------------------------------------ 30 | testInteractiveCommand :: Test 31 | testInteractiveCommand = testCase "process/interactiveCommand" $ do 32 | (out, err) <- Streams.runInteractiveCommand "cat" >>= run [expected] 33 | assertEqual "interactiveCommand" expected out 34 | assertEqual "interactiveCommand" "" err 35 | 36 | where 37 | expected = "testing 1-2-3" 38 | 39 | 40 | ------------------------------------------------------------------------------ 41 | testInteractiveProcess :: Test 42 | testInteractiveProcess = testCase "process/interactiveProcess" $ do 43 | (out, err) <- Streams.runInteractiveProcess "tr" ["a-z", "A-Z"] 44 | Nothing Nothing 45 | >>= run [inputdata] 46 | assertEqual "interactiveProcess" expected out 47 | assertEqual "interactiveProcess" "" err 48 | 49 | where 50 | inputdata = "testing 1-2-3" 51 | expected = "TESTING 1-2-3" 52 | 53 | 54 | ------------------------------------------------------------------------------ 55 | run :: [ByteString] 56 | -> (Streams.OutputStream ByteString, 57 | Streams.InputStream S.ByteString, 58 | Streams.InputStream S.ByteString, 59 | Streams.ProcessHandle) 60 | -> IO (S.ByteString, S.ByteString) 61 | run input (stdin, stdout, stderr, processHandle) = tout 5000000 $ do 62 | me <- myThreadId 63 | outM <- newEmptyMVar 64 | errM <- newEmptyMVar 65 | bracket (mkThreads me outM errM) killThreads $ go outM errM 66 | 67 | where 68 | tout t m = timeout t m >>= maybe (error "timeout") return 69 | 70 | barfTo me (e :: SomeException) = throwTo me e 71 | 72 | killMe restore me m = 73 | void (try (restore m) >>= either (barfTo me) return) 74 | 75 | mkThreads me outM errM = mask $ \restore -> do 76 | tid1 <- forkIO $ killMe restore me $ snarf stdout outM 77 | tid2 <- forkIO $ killMe restore me $ snarf stderr errM 78 | return (tid1, tid2) 79 | 80 | killThreads (t1, t2) = do 81 | mapM_ killThread [t1, t2] 82 | Streams.waitForProcess processHandle 83 | 84 | go outM errM _ = do 85 | Streams.fromList input >>= Streams.connectTo stdin 86 | out <- takeMVar outM 87 | err <- takeMVar errM 88 | return (out, err) 89 | 90 | snarf is mv = liftM S.concat (Streams.toList is) >>= putMVar mv 91 | 92 | -- ENABLE_PROCESS_TESTS 93 | #endif 94 | -------------------------------------------------------------------------------- /test/System/IO/Streams/Tests/Text.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module System.IO.Streams.Tests.Text (tests) where 4 | 5 | ------------------------------------------------------------------------------ 6 | import Control.Monad ((>=>)) 7 | import Data.Text.Encoding.Error 8 | import qualified System.IO.Streams.Internal as Streams 9 | import qualified System.IO.Streams.List as Streams 10 | import System.IO.Streams.Tests.Common 11 | import qualified System.IO.Streams.Text as Streams 12 | import Test.Framework 13 | import Test.Framework.Providers.HUnit 14 | import Test.HUnit hiding (Test) 15 | ------------------------------------------------------------------------------ 16 | 17 | tests :: [Test] 18 | tests = [ testDecodeOK 19 | , testStrictDecodeError 20 | , testEncode 21 | ] 22 | 23 | 24 | ------------------------------------------------------------------------------ 25 | testEncode :: Test 26 | testEncode = testCase "text/encodeUtf8" $ do 27 | is <- Streams.fromList ["\x3BC", "ok", ""] 28 | Streams.outputToList (Streams.encodeUtf8 >=> Streams.connect is) 29 | >>= assertEqual "ok encode" ["\xCE\xBC", "ok", ""] 30 | 31 | 32 | ------------------------------------------------------------------------------ 33 | testDecodeOK :: Test 34 | testDecodeOK = testCase "text/decodeUtf8/wholeChunk" $ do 35 | Streams.fromList ["\xCE\xBC", "ok", ""] 36 | >>= Streams.decodeUtf8 37 | >>= Streams.toList 38 | >>= assertEqual "ok decode" ["\x3BC", "ok", ""] 39 | 40 | Streams.fromList ["\xCE", "\xBC", "ok", "foo\xCE", "\xBC"] 41 | >>= Streams.decodeUtf8 42 | >>= Streams.toList 43 | >>= assertEqual "ok decode 2" ["\x3BC", "ok", "foo", "\x3BC"] 44 | 45 | Streams.fromList ["\xE2\xB6", "\x8E"] 46 | >>= Streams.decodeUtf8 47 | >>= Streams.toList 48 | >>= assertEqual "ok decode 3" ["\x2D8E"] 49 | 50 | Streams.fromList ["\xF0\x90\x80\x83"] 51 | >>= Streams.decodeUtf8 52 | >>= Streams.toList 53 | >>= assertEqual "ok decode 4" ["\x10003"] 54 | 55 | Streams.fromList [] 56 | >>= Streams.decodeUtf8With strictDecode 57 | >>= Streams.toList 58 | >>= assertEqual "ok strict empty" [] 59 | 60 | 61 | ------------------------------------------------------------------------------ 62 | testStrictDecodeError :: Test 63 | testStrictDecodeError = testCase "text/decodeUtf8/error" $ do 64 | expectExceptionH (Streams.fromList ["\x87"] >>= 65 | Streams.decodeUtf8With strictDecode >>= 66 | Streams.toList) 67 | expectExceptionH (Streams.fromList ["o\x87\x87"] >>= 68 | Streams.decodeUtf8With strictDecode >>= 69 | Streams.toList) 70 | -------------------------------------------------------------------------------- /test/System/IO/Streams/Tests/Vector.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module System.IO.Streams.Tests.Vector (tests) where 4 | 5 | ------------------------------------------------------------------------------ 6 | import Control.Monad hiding (mapM) 7 | import qualified Data.Vector as V 8 | import Prelude hiding (mapM, read) 9 | import Test.Framework 10 | import Test.Framework.Providers.HUnit 11 | import Test.HUnit hiding (Test) 12 | ------------------------------------------------------------------------------ 13 | import qualified System.IO.Streams as S 14 | import System.IO.Streams.List 15 | import System.IO.Streams.Vector 16 | ------------------------------------------------------------------------------ 17 | import System.IO.Streams.Tests.Common (expectExceptionH) 18 | 19 | 20 | ------------------------------------------------------------------------------ 21 | tests :: [Test] 22 | tests = [ testChunk 23 | , testWrite 24 | , testVectorOutputStream 25 | , testFromTo 26 | , testOutputToMutableVector 27 | , testToMutableVector 28 | ] 29 | 30 | 31 | ------------------------------------------------------------------------------ 32 | testChunk :: Test 33 | testChunk = testCase "vector/chunkVector" $ do 34 | let zeroLen :: IO ([V.Vector Int]) 35 | zeroLen = fromList [1..10::Int] >>= chunkVector 0 >>= toList 36 | expectExceptionH zeroLen 37 | 38 | fromList [1..10 :: Int] >>= chunkVector 3 39 | >>= toList 40 | >>= assertEqual "chunkVector" 41 | (map V.fromList [ [1,2,3] 42 | , [4,5,6] 43 | , [7,8,9] 44 | , [10] 45 | ]) 46 | fromList [1..12 :: Int] >>= chunkVector 3 47 | >>= toList 48 | >>= assertEqual "chunkVector2" 49 | (map V.fromList [ [1,2,3] 50 | , [4,5,6] 51 | , [7,8,9] 52 | , [10,11,12] 53 | ]) 54 | 55 | 56 | ------------------------------------------------------------------------------ 57 | testWrite :: Test 58 | testWrite = testCase "vector/writeVector" $ 59 | outputToVector act >>= 60 | assertEqual "testWrite" (V.fromList [1..10::Int]) 61 | where 62 | act str = do 63 | writeVector (V.fromList [1..10]) str 64 | S.write Nothing str 65 | S.write Nothing str 66 | 67 | 68 | ------------------------------------------------------------------------------ 69 | testVectorOutputStream :: Test 70 | testVectorOutputStream = testCase "vector/vectorOutputStream" $ test1 >> test2 71 | where 72 | test1 = do 73 | (os, flush) <- vectorOutputStream 74 | fromList [1,2,3::Int] >>= S.connectTo os 75 | flush >>= assertEqual "v1" (V.fromList [1,2,3::Int]) 76 | S.write (Just 4) os 77 | flush >>= assertEqual "v2" V.empty 78 | 79 | test2 = do 80 | (os, flush) <- mutableVectorOutputStream 81 | fromList [1,2,3::Int] >>= S.supplyTo os 82 | flush >>= V.unsafeFreeze 83 | >>= assertEqual "v1" (V.fromList [1,2,3::Int]) 84 | S.write (Just 4) os 85 | flush >>= V.unsafeFreeze 86 | >>= assertEqual "v2" (V.singleton (4::Int)) 87 | 88 | 89 | ------------------------------------------------------------------------------ 90 | testFromTo :: Test 91 | testFromTo = testCase "vector/fromVector" $ do 92 | fromVector V.empty >>= toVector 93 | >>= assertEqual "f1" (V.empty :: V.Vector Int) 94 | fromVector vtest >>= toVector >>= assertEqual "f2" vtest 95 | 96 | where 97 | vtest = V.fromList [1..100::Int] 98 | 99 | 100 | ------------------------------------------------------------------------------ 101 | testOutputToMutableVector :: Test 102 | testOutputToMutableVector = testCase "vector/outputToMutableVector" $ do 103 | is <- S.fromList [1::Int,2,3] 104 | outputToMutableVector (S.connect is) 105 | >>= V.unsafeFreeze 106 | >>= assertEqual "outputToMutableVector" (V.fromList [1,2,3]) 107 | 108 | 109 | ------------------------------------------------------------------------------ 110 | testToMutableVector :: Test 111 | testToMutableVector = testCase "vector/toMutableVector" $ do 112 | is <- S.fromList [1::Int,2,3] 113 | toMutableVector is 114 | >>= V.unsafeFreeze 115 | >>= assertEqual "toMutableVector" (V.fromList [1,2,3]) 116 | -------------------------------------------------------------------------------- /test/System/IO/Streams/Tests/Zlib.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module System.IO.Streams.Tests.Zlib (tests) where 4 | 5 | ------------------------------------------------------------------------------ 6 | import qualified Codec.Compression.GZip as GZ 7 | import qualified Codec.Compression.Zlib as Z 8 | import Control.Monad hiding (mapM) 9 | import Data.ByteString.Builder (Builder, byteString) 10 | import Data.ByteString.Builder.Extra (flush) 11 | import Data.ByteString.Char8 (ByteString) 12 | import qualified Data.ByteString.Char8 as S 13 | import qualified Data.ByteString.Lazy.Char8 as L 14 | import Prelude hiding (mapM, read) 15 | import Test.Framework 16 | import Test.Framework.Providers.HUnit 17 | import Test.Framework.Providers.QuickCheck2 18 | import Test.HUnit hiding (Test) 19 | import Test.QuickCheck hiding (output) 20 | import Test.QuickCheck.Monadic 21 | ------------------------------------------------------------------------------ 22 | import System.IO.Streams 23 | import System.IO.Streams.Tests.Common 24 | 25 | tests :: [Test] 26 | tests = [ testIdGzip 27 | , testIdCompress 28 | , testBigString 29 | , testBuilderFlushGZip 30 | , testBuilderFlushCompress 31 | , testTrivials 32 | ] 33 | 34 | 35 | ------------------------------------------------------------------------------ 36 | testIdGzip :: Test 37 | testIdGzip = testProperty "zlib/idGZip" $ monadicIO $ forAllM arbitrary prop 38 | where 39 | prop :: [ByteString] -> PropertyM IO () 40 | prop l = propId "idGZip" GZ.decompress GZ.compress gunzip gzip l 41 | 42 | 43 | ------------------------------------------------------------------------------ 44 | testIdCompress :: Test 45 | testIdCompress = testProperty "zlib/idCompress" $ monadicIO $ 46 | forAllM arbitrary prop 47 | where 48 | prop :: [ByteString] -> PropertyM IO () 49 | prop l = propId "idCompress" Z.decompress Z.compress 50 | decompress compress l 51 | 52 | 53 | ------------------------------------------------------------------------------ 54 | propId :: String 55 | -> (L.ByteString -> L.ByteString) 56 | -> (L.ByteString -> L.ByteString) 57 | -> (InputStream ByteString -> IO (InputStream ByteString)) 58 | -> (CompressionLevel -> OutputStream ByteString 59 | -> IO (OutputStream ByteString)) 60 | -> [ByteString] 61 | -> PropertyM IO () 62 | propId name inf def infStr defStr l0 = do 63 | pre (not (null l0) && L.length (L.fromChunks l0) > 0) 64 | liftQ $ do 65 | let l = L.fromChunks $ l0 ++ 66 | [ S.concat $ L.toChunks $ L.take 32000 $ L.fromChunks $ 67 | cycle l0 ] 68 | let inp = def l 69 | 70 | is <- fromList (L.toChunks inp) >>= infStr 71 | (os0, grab) <- listOutputStream 72 | os <- defStr defaultCompressionLevel os0 73 | 74 | connect is os 75 | outp <- liftM L.fromChunks grab 76 | 77 | assertEqual name l (inf outp) 78 | 79 | 80 | 81 | ------------------------------------------------------------------------------ 82 | testBigString :: Test 83 | testBigString = testCase "zlib/bigString" $ do 84 | let l = S.concat $ L.toChunks $ L.take 640000 $ L.fromChunks $ cycle 85 | [ "lfkdsjflkdshflkjdhsfkljhdslkfhdslakjfhlkdsjhflkjdsahflkjhsa" 86 | , "39287647893264987368947632198746328974698327649873216498713" 87 | , "bznmbxz879hJKHYG^&%^&^%*&^%*&^%*&^%&*^%&*65tykjhdgbmdnvkjch" 88 | , "VBUYDUHKJC*(HJKDHLCJBUYEOUIHJCHUOY&*^(*)@HJDNM>= connectTo os 99 | 100 | out <- liftM L.fromChunks grab 101 | 102 | 103 | 104 | let o1 = L.fromChunks [l] 105 | let o2 = GZ.decompress out 106 | 107 | when (o1 /= o2) $ do 108 | putStrLn "o1 /= o2" 109 | putStrLn $ "o1 = " ++ (show $ S.concat $ L.toChunks $ L.take 1000 o1) 110 | ++ "..." 111 | putStrLn $ "o2 = " ++ (show $ S.concat $ L.toChunks $ L.take 1000 o2) 112 | ++ "..." 113 | 114 | putStrLn $ "len(o1)=" ++ show (L.length o1) 115 | putStrLn $ "len(o2)=" ++ show (L.length o2) 116 | 117 | assertBool "bigString1" $ o1 == o2 118 | 119 | is2 <- fromList ([""] ++ L.toChunks out ++ [""]) >>= gunzip 120 | (os1, grab') <- listOutputStream 121 | connect is2 os1 122 | out' <- liftM L.fromChunks grab' 123 | 124 | assertBool "bigString2" $ o1 == out' 125 | 126 | 127 | 128 | ------------------------------------------------------------------------------ 129 | testBuilderFlushGZip :: Test 130 | testBuilderFlushGZip = testProperty "zlib/builderFlushGZip" $ monadicIO $ 131 | forAllM arbitrary prop 132 | where 133 | prop :: (ByteString, ByteString) -> PropertyM IO () 134 | prop (a,b) = propBuilderFlush "gzip" GZ.decompress gzipBuilder a b 135 | 136 | 137 | ------------------------------------------------------------------------------ 138 | testBuilderFlushCompress :: Test 139 | testBuilderFlushCompress = testProperty "zlib/builderFlushCompress" $ 140 | monadicIO $ forAllM arbitrary prop 141 | where 142 | prop :: (ByteString, ByteString) -> PropertyM IO () 143 | prop (a,b) = propBuilderFlush "zlib" Z.decompress compressBuilder a b 144 | 145 | 146 | ------------------------------------------------------------------------------ 147 | propBuilderFlush :: String 148 | -> (L.ByteString -> L.ByteString) 149 | -> (CompressionLevel 150 | -> OutputStream Builder -> IO (OutputStream Builder)) 151 | -> ByteString 152 | -> ByteString 153 | -> PropertyM IO () 154 | propBuilderFlush name inf comp a b = do 155 | pre (not (S.null a) && not (S.null b)) 156 | liftQ $ do 157 | t 7 [ byteString a, flush, flush, byteString b 158 | , flush, flush ] 159 | 160 | t 4 [ byteString a, flush, flush, byteString b ] 161 | 162 | where 163 | t expected input = do 164 | (os0, grab) <- listOutputStream 165 | os <- builderStream os0 >>= comp defaultCompressionLevel 166 | 167 | fromList input >>= connectTo os 168 | xs <- grab 169 | 170 | when (length xs /= expected) $ putStrLn $ "xs is " ++ show xs 171 | assertEqual (name ++ "/len") expected (length xs) 172 | 173 | let outp = inf $ L.fromChunks xs 174 | 175 | assertEqual (name ++ "/eq") (L.fromChunks [a,b]) outp 176 | 177 | 178 | ------------------------------------------------------------------------------ 179 | testTrivials :: Test 180 | testTrivials = testCase "zlib/trivials" $ do 181 | let cl = CompressionLevel 4 182 | coverReadInstance cl 183 | coverShowInstance cl 184 | coverEqInstance cl 185 | -------------------------------------------------------------------------------- /test/TestSuite.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | 3 | module Main where 4 | 5 | import qualified System.IO.Streams.Tests.Attoparsec.ByteString as AttoparsecByteString 6 | import qualified System.IO.Streams.Tests.Attoparsec.Text as AttoparsecText 7 | import qualified System.IO.Streams.Tests.Builder as Builder 8 | import qualified System.IO.Streams.Tests.ByteString as ByteString 9 | import qualified System.IO.Streams.Tests.Combinators as Combinators 10 | import qualified System.IO.Streams.Tests.Concurrent as Concurrent 11 | import qualified System.IO.Streams.Tests.Debug as Debug 12 | import qualified System.IO.Streams.Tests.File as File 13 | import qualified System.IO.Streams.Tests.Handle as Handle 14 | import qualified System.IO.Streams.Tests.Internal as Internal 15 | import qualified System.IO.Streams.Tests.List as List 16 | #ifdef ENABLE_NETWORK 17 | import qualified System.IO.Streams.Tests.Network as Network 18 | #endif 19 | import qualified System.IO.Streams.Tests.Process as Process 20 | import qualified System.IO.Streams.Tests.Text as Text 21 | import qualified System.IO.Streams.Tests.Vector as Vector 22 | #ifdef ENABLE_ZLIB 23 | import qualified System.IO.Streams.Tests.Zlib as Zlib 24 | #endif 25 | import Test.Framework (defaultMain, testGroup) 26 | 27 | 28 | ------------------------------------------------------------------------------ 29 | main :: IO () 30 | main = defaultMain tests 31 | where 32 | tests = [ testGroup "Tests.Attoparsec.ByteString" AttoparsecByteString.tests 33 | , testGroup "Tests.Attoparsec.Text" AttoparsecText.tests 34 | , testGroup "Tests.Builder" Builder.tests 35 | , testGroup "Tests.ByteString" ByteString.tests 36 | , testGroup "Tests.Debug" Debug.tests 37 | , testGroup "Tests.Combinators" Combinators.tests 38 | , testGroup "Tests.Concurrent" Concurrent.tests 39 | , testGroup "Tests.File" File.tests 40 | , testGroup "Tests.Handle" Handle.tests 41 | , testGroup "Tests.Internal" Internal.tests 42 | , testGroup "Tests.List" List.tests 43 | #ifdef ENABLE_NETWORK 44 | , testGroup "Tests.Network" Network.tests 45 | #endif 46 | , testGroup "Tests.Process" Process.tests 47 | , testGroup "Tests.Text" Text.tests 48 | , testGroup "Tests.Vector" Vector.tests 49 | #ifdef ENABLE_ZLIB 50 | , testGroup "Tests.Zlib" Zlib.tests 51 | #endif 52 | ] 53 | --------------------------------------------------------------------------------