├── .github ├── dependabot.yml └── workflows │ └── stack-ci.yaml ├── .gitignore ├── CHANGELOG.md ├── LICENSE ├── README.md ├── Setup.hs ├── bench ├── benchbuilders.hs ├── benchio.hs └── benchlines.hs ├── examples ├── HttpGet.hs └── shell.hs ├── lib ├── Data │ └── ByteString │ │ ├── Streaming.hs │ │ └── Streaming │ │ ├── Char8.hs │ │ └── Internal.hs └── Streaming │ ├── ByteString.hs │ └── ByteString │ ├── Char8.hs │ └── Internal.hs ├── stack.yaml ├── streaming-bytestring.cabal ├── tests ├── Test.hs ├── groupBy.txt └── sample.txt └── upload.sh /.github/dependabot.yml: -------------------------------------------------------------------------------- 1 | version: 2 2 | updates: 3 | - package-ecosystem: "github-actions" 4 | directory: "/" 5 | schedule: 6 | interval: "daily" 7 | -------------------------------------------------------------------------------- /.github/workflows/stack-ci.yaml: -------------------------------------------------------------------------------- 1 | name: Tests 2 | on: 3 | pull_request: 4 | push: 5 | branches: 6 | - master 7 | 8 | jobs: 9 | build: 10 | name: CI 11 | runs-on: ubuntu-latest 12 | strategy: 13 | fail-fast: false 14 | matrix: 15 | resolver: 16 | [ 17 | "lts-23.7", 18 | "lts-22.36", 19 | "lts-21.25", 20 | "lts-20.26", 21 | "lts-19.33", 22 | "lts-18.28", 23 | "lts-16.31", 24 | "lts-14.27", 25 | "lts-12.26", 26 | "lts-11.22", 27 | "lts-9.21", 28 | ] 29 | include: 30 | - resolver: "lts-23.7" 31 | ghc: "9.8.4" 32 | stack-version: latest 33 | - resolver: "lts-22.36" 34 | ghc: "9.6.6" 35 | stack-version: latest 36 | - resolver: "lts-21.25" 37 | ghc: "9.4.8" 38 | stack-version: latest 39 | - resolver: "lts-20.26" 40 | ghc: "9.2.5" 41 | stack-version: latest 42 | - resolver: "lts-19.33" 43 | ghc: "9.0.2" 44 | stack-version: latest 45 | - resolver: "lts-18.28" 46 | ghc: "8.10.7" 47 | stack-version: latest 48 | - resolver: "lts-16.31" 49 | ghc: "8.8.4" 50 | stack-version: latest 51 | - resolver: "lts-14.27" 52 | ghc: "8.6.5" 53 | stack-version: latest 54 | - resolver: "lts-12.26" 55 | ghc: "8.4.4" 56 | stack-version: latest 57 | - resolver: "lts-11.22" 58 | ghc: "8.2.2" 59 | stack-version: "2.15.5" 60 | - resolver: "lts-9.21" 61 | ghc: "8.0.2" 62 | stack-version: "2.15.5" 63 | 64 | steps: 65 | - name: Setup GHC 66 | uses: haskell-actions/setup@v2 67 | with: 68 | ghc-version: ${{ matrix.ghc }} 69 | enable-stack: true 70 | stack-version: ${{ matrix.stack-version }} 71 | 72 | - name: Clone project 73 | uses: actions/checkout@v4 74 | 75 | - name: Cache dependencies 76 | uses: actions/cache@v4 77 | with: 78 | path: ~/.stack 79 | key: ${{ runner.os }}-${{ matrix.resolver }}-${{ hashFiles('stack.yaml') }} 80 | restore-keys: | 81 | ${{ runner.os }}-${{ matrix.resolver }}- 82 | 83 | # This entirely avoids the caching of a GHC version. 84 | - name: Build and run tests 85 | run: "stack test --fast --no-terminal --resolver=${{ matrix.resolver }} --system-ghc" 86 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | dist 2 | cabal-dev 3 | *.o 4 | *.hi 5 | *.chi 6 | *.chs.h 7 | *.dyn_o 8 | *.dyn_hi 9 | .virtualenv 10 | .hpc 11 | .hsenv 12 | .cabal-sandbox/ 13 | cabal.sandbox.config 14 | dist-newstyle/ 15 | .stack-work/ 16 | *.prof 17 | *.aux 18 | *.hp 19 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # streaming-bytestring 2 | 3 | ## 0.3.4 (2025-02-11) 4 | 5 | #### Changed 6 | 7 | - Ensure support for GHC 9.12. 8 | 9 | ## 0.3.3 (2024-10-01) 10 | 11 | #### Fixed 12 | 13 | - A subtle bug involving conversion to lazy bytestrings. 14 | 15 | ## 0.3.2 (2023-11-17) 16 | 17 | #### Changed 18 | 19 | - Ensure support for GHC 9.8. 20 | 21 | ## 0.3.1 (2023-06-28) 22 | 23 | #### Changed 24 | 25 | - Ensure support for GHC 9.6. 26 | 27 | ## 0.3.0 (2023-04-24) 28 | 29 | #### Changed 30 | 31 | - Dropped support for GHC 7. 32 | - Tightened PVP version bounds, for GHC 8.0 through to GHC 9.4.4. 33 | 34 | ## 0.2.4 (2022-08-26) 35 | 36 | #### Changed 37 | 38 | - Changed `for`'s callback to return `ByteStream m x`, to clarify that it is not 39 | used. 40 | 41 | ## 0.2.3 (2022-08-18) 42 | 43 | #### Added 44 | 45 | - Add `for :: Monad m => ByteStream m r -> (P.ByteString -> ByteStream m r) -> ByteStream m r` 46 | 47 | ## 0.2.2 (2022-05-18) 48 | 49 | #### Changed 50 | 51 | - Dependency adjustments. 52 | 53 | ## 0.2.1 (2021-06-23) 54 | 55 | #### Changed 56 | 57 | - Performance improvement when using GHC 9. 58 | 59 | ## 0.2.0 (2020-10-26) 60 | 61 | **Note:** The deprecations added in `0.1.7` have _not_ been removed in this 62 | version. Instead of `0.1.7`, that release should have been `0.2` in the first 63 | place. 64 | 65 | #### Added 66 | 67 | - Add missing exports of `zipWithStream`, `materialize`, and `dematerialize`. 68 | 69 | #### Changed 70 | 71 | - **Breaking:** Switched names of `fold` and `fold_` in the non-`Char8` modules. 72 | The corresponding `Char8` functions and the rest of the library uses `_` for 73 | the variant that forgets the `r` value. 74 | - **Breaking:** Unified `nextByte`/`nextChar` with `uncons`. The old `uncons` 75 | returned `Maybe` instead of the more natural `Either r`. 76 | - **Breaking:** Similarly, `unconsChunk` and `nextChunk` have been unified. 77 | - `nextByte`, `nextChar`, and `nextChunk` have been deprecated. 78 | - Relaxed signature of `toStrict_` to allow any `r`, not just `()`. 79 | - Permance improvements for `packChars` and `denull`. 80 | - Various documentation improvements. 81 | - Improved performance of `w8IsSpace` to more quickly filter out non-whitespace 82 | characters, and updated `words` to use it instead of the internal function 83 | `isSpaceWord8` from the `bytestring` package. See also 84 | [bytestring#315](https://github.com/haskell/bytestring/pull/315). 85 | 86 | #### Fixed 87 | 88 | - An edge case involving overflow in `readInt`. 89 | - A potential crash in `uncons`. 90 | - `intersperse` now ignores any initial empty chunks. 91 | - `intercalate` now does not insert anything between the final substream and the 92 | outer stream end. 93 | - `unlines` now correctly handles `Chunk "" (Empty r)` and `Empty r`. 94 | 95 | ## 0.1.7 (2020-10-14) 96 | 97 | Thanks to Viktor Dukhovni and Colin Woodbury for their contributions to this release. 98 | 99 | #### Added 100 | 101 | - The `skipSomeWS` function for efficiently skipping leading whitespace of both 102 | ASCII and non-ASCII. 103 | 104 | #### Changed 105 | 106 | - **The `ByteString` type has been renamed to `ByteStream`**. This fixes a 107 | well-reported confusion from users. An alias to the old name has been provided 108 | for back-compatibility, but is deprecated and be removed in the next major 109 | release. 110 | - **Modules have been renamed** to match the precedent set by the main 111 | `streaming` library. Aliases to the old names have been provided, but will be 112 | removed in the next major release. 113 | - `Data.ByteString.Streaming` -> `Streaming.ByteString` 114 | - `Data.ByteString.Streaming.Char8` -> `Streaming.ByteString.Char8` 115 | - An order-of-magnitude performance improvement in line splitting. [#18] 116 | - Performance and correctness improvements for the `readInt` function. [#31] 117 | - Documentation improved, and docstring coverage is now 100%. [#27] 118 | 119 | #### Fixed 120 | 121 | - An incorrect comment about `Handle`s being automatically closed upon EOF with 122 | `hGetContents` and `hGetContentsN`. [#9] 123 | - A crash in `group` and `groupBy` when reading too many bytes. [#22] 124 | - `groupBy` incorrectly ordering its output elements. [#4] 125 | 126 | [#9]: https://github.com/haskell-streaming/streaming-bytestring/issues/9 127 | [#18]: https://github.com/haskell-streaming/streaming-bytestring/pull/18 128 | [#22]: https://github.com/haskell-streaming/streaming-bytestring/pull/22 129 | [#4]: https://github.com/haskell-streaming/streaming-bytestring/issues/4 130 | [#27]: https://github.com/haskell-streaming/streaming-bytestring/pull/27 131 | [#31]: https://github.com/haskell-streaming/streaming-bytestring/pull/31 132 | 133 | ## 0.1.6 134 | 135 | - `Semigroup` instance for `ByteString m r` added 136 | - New function `lineSplit` 137 | 138 | ## 0.1.5 139 | 140 | - Update for `streaming-0.2` 141 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2015, Michael Thompson 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of michaelt nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # streaming-bytestring 2 | 3 | [![Build](https://github.com/haskell-streaming/streaming-bytestring/workflows/Tests/badge.svg)](https://github.com/haskell-streaming/streaming-bytestring/actions) 4 | [![Build Status](https://travis-ci.org/haskell-streaming/streaming-bytestring.svg?branch=master)](https://travis-ci.org/haskell-streaming/streaming-bytestring) 5 | [![Hackage](https://img.shields.io/hackage/v/streaming-bytestring.svg)](https://hackage.haskell.org/package/streaming-bytestring) 6 | 7 | This library enables fast and safe streaming of byte data, in either `Word8` or 8 | `Char` form. It is a core addition to the [`streaming` 9 | ecosystem](https://github.com/haskell-streaming/) and avoids the usual pitfalls 10 | of combinbing lazy `ByteString`s with lazy `IO`. 11 | 12 | This library is used by 13 | [`streaming-attoparsec`](http://hackage.haskell.org/package/streaming-attoparsec) 14 | to enable vanilla [Attoparsec](http://hackage.haskell.org/package/attoparsec) 15 | parsers to work with `streaming` "for free". 16 | 17 | ## Usage 18 | 19 | ### Importing and Types 20 | 21 | Modules from this library are intended to be imported qualified. To avoid 22 | conflicts with both the `bytestring` library and `streaming`, we recommended `Q` 23 | as the qualified name: 24 | 25 | ```haskell 26 | import qualified Streaming.ByteString.Char8 as Q 27 | ``` 28 | 29 | Like the `bytestring` library, leaving off the `Char8` will expose an API based 30 | on `Word8`. Following the philosophy of `streaming` that "the best API is the 31 | one you already know", these APIs are based closely on `bytestring`. The core 32 | type is `ByteStream m r`, where: 33 | 34 | - `m`: The Monad used to fetch further chunks from the "source", usually `IO`. 35 | - `r`: The final return value after all streaming has concluded, usually `()` as in `streaming`. 36 | 37 | You can imagine this type to represent an infinitely-sized collection of bytes, 38 | although internally it references a **strict** `ByteString` no larger than 32kb, 39 | followed by monadic instructions to fetch further chunks. 40 | 41 | ### Examples 42 | 43 | #### File Input 44 | 45 | To open a file of any size and count its characters: 46 | 47 | ```haskell 48 | import Control.Monad.Trans.Resource (runResourceT) 49 | import qualified Streaming.Streaming.Char8 as Q 50 | 51 | -- | Represents a potentially-infinite stream of `Char`. 52 | chars :: ByteStream IO () 53 | chars = Q.readFile "huge-file.txt" 54 | 55 | main :: IO () 56 | main = runResourceT (Q.length_ chars) >>= print 57 | ``` 58 | 59 | Note that file IO specifically requires the 60 | [`resourcet`](http://hackage.haskell.org/package/resourcet) library. 61 | 62 | #### Line splitting and `Stream` interop 63 | 64 | In the example above you may have noticed a lack of `Of` that we usually see 65 | with `Stream`. Our old friend `lines` hints at this too: 66 | 67 | ```haskell 68 | lines :: Monad m => ByteStream m r -> Stream (ByteStream m) m r 69 | ``` 70 | 71 | A stream-of-streams, yet no `Of` here either. The return type can't naively be 72 | `Stream (Of ByteString) m r`, since the first line break might be at the very 73 | end of a large file. Forcing that into a single strict `ByteString` would crash 74 | your program. 75 | 76 | To count the number of lines whose first letter is `i`: 77 | 78 | ```haskell 79 | countOfI :: IO Int 80 | countOfI = runResourceT 81 | . S.length_ -- IO Int 82 | . S.filter (== 'i') -- Stream (Of Char) IO () 83 | . S.concat -- Stream (Of Char) IO () 84 | . S.mapped Q.head -- Stream (Of (Maybe Char)) IO () 85 | . Q.lines -- Stream (ByteStream IO) IO () 86 | $ Q.readFile "huge-file.txt" -- ByteStream IO () 87 | ``` 88 | 89 | Critically, there are several functions which when combined with `mapped` can 90 | bring us back into `Of`-land: 91 | 92 | ```haskell 93 | head :: Monad m => ByteStream m r -> m (Of (Maybe Char) r) 94 | last :: Monad m => ByteStream m r -> m (Of (Maybe Char) r) 95 | null :: Monad m => ByteStream m r -> m (Of Bool) r) 96 | count :: Monad m => ByteStream m r -> m (Of Int) r) 97 | toLazy :: Monad m => ByteStream m r -> m (Of ByteString r) -- Be careful with this. 98 | toStrict :: Monad m => ByteStream m r -> m (Of ByteString r) -- Be even *more* careful with this. 99 | ``` 100 | 101 | When moving in the opposite direction API-wise, consider: 102 | 103 | ```haskell 104 | fromChunks :: Stream (Of ByteString) m r -> ByteStream m r 105 | ``` 106 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /bench/benchbuilders.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings, PackageImports #-} 2 | -- | 3 | -- Copyright : (c) 2010-2011 Simon Meier 4 | -- License : BSD3-style (see LICENSE) 5 | -- 6 | -- Maintainer : Simon Meier 7 | -- Stability : experimental 8 | -- Portability : tested on GHC only 9 | -- 10 | -- Running example for documentation of Data.ByteString.Lazy.Builder 11 | -- 12 | -- module Main (main) where 13 | 14 | -- ************************************************************************** 15 | -- CamHac 2011: An introduction to Data.ByteString.Lazy.Builder 16 | -- ************************************************************************** 17 | 18 | ------------------------------------------------------------------------------ 19 | -- Benchmarking 20 | ------------------------------------------------------------------------------ 21 | 22 | main :: IO () 23 | main = do 24 | putStrLn "Encoding the maxiTable" 25 | putStrLn $ "Total length in bytes: " ++ 26 | (show $ L.length $ encodeUtf8CSV maxiTable) 27 | putStrLn $ "Chunk lengths: " ++ 28 | (show $ map S.length $ L.toChunks $ encodeUtf8CSV maxiTable) 29 | putStrLn "" 30 | defaultMain 31 | [ benchNF 32 | , benchBuilderUtf8 -- LB.length $ toLazyByteString builder 33 | , benchBuilderUtf8Streaming -- Q.length $ toStreamingByteString builder 34 | , benchBuilderEncodingUtf8 -- LB.length $ toLazyByteString builder 35 | , benchBuilderEncodingUtf8Streaming -- Q.length $ toStreamingByteString builder 36 | 37 | ] 38 | where 39 | encodeUtf8CSV = B.toLazyByteString . renderTableBE 40 | 41 | {- The Encoding Problem 42 | ---------------------- 43 | 44 | Encoding: Conversion from a Haskell value to a sequence of bytes. 45 | 46 | 47 | Efficient encoding implementation: 48 | 49 | 1. represent sequence of bytes as a list of byte arrays (chunks) 50 | 2. generate chunks that are large on average 51 | 3. avoid intermediate copies/datastructures 52 | 53 | Compositionality: 54 | 55 | 4. support fast append 56 | 57 | 58 | Problem: Provide a library for defining compositional, efficient encodings. 59 | 60 | -} 61 | 62 | 63 | 64 | {- Data.ByteString.Lazy.Builder 65 | ------------------------------ 66 | 67 | A solution to the "Encoding Problem" (based on the code of blaze-builder). 68 | 69 | Builder creation: 70 | 71 | word8 :: Word8 -> Builder 72 | int64LE :: Int64 -> Builder 73 | floatBE :: Float -> Builder 74 | .... 75 | 76 | 77 | Builder composition via its Monoid instance: 78 | 79 | word8 10 `mappend` floatBE 1.4 80 | 81 | 82 | Builder execution by converting it to a lazy bytestring: 83 | 84 | toLazyByteString :: Builder -> L.ByteString 85 | 86 | -} 87 | 88 | 89 | {- Typical users of Builders 90 | --------------------------- 91 | 92 | binary, text, aeson, blaze-html, blaze-textual, warp, snap-server, ... 93 | 94 | => they want support for maximal performance! 95 | => use of Builders is rather local: in rendering/encoding functions. 96 | 97 | -} 98 | 99 | 100 | 101 | {- Notable properties 102 | -------------------- 103 | 104 | * Built-in UTF-8 support: very hard to get efficient otherwise. 105 | 106 | stringUtf8 :: String -> Builder 107 | intDec :: Int -> Builder 108 | intHex :: Int -> Builder 109 | 110 | * Fine-grained control over when to copy/reference existing bytestrings 111 | 112 | * EDSL for defining low-level Encodings of bounded values (e.g., Int, Char) 113 | to improve speed of escaping and similar operations. 114 | 115 | * If used together with iteratee-style IO: no 'unsafePerformIO' required 116 | 117 | -} 118 | 119 | 120 | {- An example problem: 121 | --------------------- 122 | 123 | Rendering a table in comma-separated-value (CSV) format using UTF-8 encoded 124 | Unicode characters. 125 | 126 | * We are willing to fuse table-rendering with UTF8-encoding to achieve better 127 | performance. 128 | 129 | -} 130 | 131 | 132 | import qualified Data.ByteString as S 133 | import qualified Data.ByteString.Lazy as L 134 | 135 | import Data.ByteString.Lazy.Builder as B 136 | import Data.ByteString.Lazy.Builder.ASCII as B 137 | 138 | import Data.Monoid 139 | import Data.Foldable (foldMap) 140 | 141 | import Criterion.Main 142 | import Control.DeepSeq 143 | 144 | 145 | -- To be used in a later optimization 146 | import Data.ByteString.Builder.Prim ( (>*<), (>$<) ) 147 | import qualified Data.ByteString.Builder.Prim as E 148 | 149 | -- To be used in a later comparison 150 | import qualified Data.DList as D 151 | import qualified Codec.Binary.UTF8.Light as Utf8Light 152 | import qualified Data.String.UTF8 as Utf8String 153 | import qualified Data.Text.Lazy as TL 154 | import qualified Data.Text.Lazy.Encoding as TL 155 | import qualified Data.Text.Lazy.Builder as TB 156 | import qualified Data.Text.Lazy.Builder.Int as TB 157 | 158 | import Data.Char (ord) 159 | import qualified Data.Binary.Builder as BinB 160 | import Data.Functor.Identity 161 | import qualified Data.ByteString.Streaming as Streaming 162 | ------------------------------------------------------------------------------ 163 | -- Simplife CSV Tables 164 | ------------------------------------------------------------------------------ 165 | 166 | data Cell = StringC String 167 | | IntC Int 168 | deriving( Eq, Ord, Show ) 169 | 170 | type Row = [Cell] 171 | type Table = [Row] 172 | 173 | -- Example data 174 | strings :: [String] 175 | strings = ["hello", "\"1\"", "λ-wörld"] 176 | 177 | table :: Table 178 | table = [map StringC strings, map IntC [-3..3]] 179 | 180 | 181 | -- | The rendered 'table': 182 | -- 183 | -- > "hello","\"1\"","λ-wörld" 184 | -- > -3,-2,-1,0,1,2,3 185 | -- 186 | 187 | 188 | -- | A bigger table for benchmarking our encoding functions. 189 | maxiTable :: Table 190 | maxiTable = take 5000 $ cycle table 191 | 192 | 193 | ------------------------------------------------------------------------------ 194 | -- String based rendering 195 | ------------------------------------------------------------------------------ 196 | 197 | renderString :: String -> String 198 | renderString cs = "\"" ++ concatMap escape cs ++ "\"" 199 | where 200 | escape '\\' = "\\" 201 | escape '\"' = "\\\"" 202 | escape c = return c 203 | 204 | renderCell :: Cell -> String 205 | renderCell (StringC cs) = renderString cs 206 | renderCell (IntC i) = show i 207 | 208 | renderRow :: Row -> String 209 | renderRow [] = "" 210 | renderRow (c:cs) = renderCell c ++ concat [',' : renderCell c' | c' <- cs] 211 | 212 | renderTable :: Table -> String 213 | renderTable rs = concat [renderRow r ++ "\n" | r <- rs] 214 | 215 | -- 1.36 ms 216 | benchString :: Benchmark 217 | benchString = bench "renderTable maxiTable" $ nf renderTable maxiTable 218 | 219 | -- 1.36 ms 220 | benchStringUtf8 :: Benchmark 221 | benchStringUtf8 = bench "utf8 + renderTable maxiTable" $ 222 | nf (L.length . B.toLazyByteString . B.stringUtf8 . renderTable) maxiTable 223 | 224 | 225 | -- using difference lists: 0.91 ms 226 | -- 227 | -- (++) is a performance-grinch! 228 | 229 | 230 | ------------------------------------------------------------------------------ 231 | -- Builder based rendering 232 | ------------------------------------------------------------------------------ 233 | 234 | -- better syntax for `mappend` 235 | -- infixr 4 <> 236 | -- (<>) :: Monoid m => m -> m -> m 237 | -- (<>) = mappend 238 | 239 | -- As a reminder: 240 | -- 241 | -- import Data.ByteString.Lazy.Builder as B 242 | -- import Data.ByteString.Lazy.Builder.Utf8 as B 243 | 244 | renderStringB :: String -> Builder 245 | renderStringB cs = B.charUtf8 '"' <> foldMap escape cs <> B.charUtf8 '"' 246 | where 247 | escape '\\' = B.charUtf8 '\\' <> B.charUtf8 '\\' 248 | escape '\"' = B.charUtf8 '\\' <> B.charUtf8 '"' 249 | escape c = B.charUtf8 c 250 | 251 | renderCellB :: Cell -> Builder 252 | renderCellB (StringC cs) = renderStringB cs 253 | renderCellB (IntC i) = B.intDec i 254 | 255 | renderRowB :: Row -> Builder 256 | renderRowB [] = mempty 257 | renderRowB (c:cs) = 258 | renderCellB c <> mconcat [ B.charUtf8 ',' <> renderCellB c' | c' <- cs ] 259 | 260 | renderTableB :: Table -> Builder 261 | renderTableB rs = mconcat [renderRowB r <> B.charUtf8 '\n' | r <- rs] 262 | 263 | -- 0.81ms 264 | benchBuilderUtf8 :: Benchmark 265 | benchBuilderUtf8 = bench "utf8 + renderTableB maxiTable + lazy" $ 266 | nf (L.length . B.toLazyByteString . renderTableB) maxiTable 267 | 268 | 269 | benchBuilderUtf8Streaming :: Benchmark 270 | benchBuilderUtf8Streaming = bench "utf8 + renderTableB maxiTable + streaming " $ 271 | nfIO ((Streaming.length . Streaming.toStreamingByteString . renderTableB) maxiTable) 272 | 273 | -- 1.11x faster than DList 274 | 275 | -- However: touching the whole table 'nf maxiTable' takes 0.27ms 276 | 277 | -- 1.16x faster than DList on the code path other than touching all data 278 | -- (0.91 - 0.27) / (0.82 - 0.27) 279 | 280 | 281 | ------------------------------------------------------------------------------ 282 | -- Baseline: Touching all data 283 | ------------------------------------------------------------------------------ 284 | 285 | instance NFData Cell where 286 | rnf (StringC cs) = rnf cs 287 | rnf (IntC i) = rnf i 288 | 289 | -- 0.27 ms 290 | benchNF :: Benchmark 291 | benchNF = bench "nf maxiTable" $ nf id maxiTable 292 | 293 | 294 | ------------------------------------------------------------------------------ 295 | -- Exploiting bounded encodings 296 | ------------------------------------------------------------------------------ 297 | 298 | {- Why 'Bounded Encodings'? 299 | -------------------------- 300 | 301 | Hot code of encoding implementations: 302 | 303 | * Appending Builders: Optimized already. 304 | 305 | * Encoding primitive Haskell values: room for optimization: 306 | 307 | - reduce buffer-free checks 308 | - remove jumps/function calls 309 | - hoist constant values out of inner-loops 310 | (e.g., the loop for encoding the elements of a list) 311 | 312 | * Bounded encoding: 313 | an encoding that never takes more than a fixed number of bytes. 314 | 315 | - intuitively: (Int, Ptr Word8 -> IO (Ptr Word8)) 316 | ^bound ^ low-level encoding function 317 | 318 | - compositional: coalesce buffer-checks, ... 319 | 320 | E.encodeIfB :: (a -> Bool) 321 | -> BoundedEncoding a -> BoundedEncoding a -> BoundedEncoding a 322 | E.charUtf8 :: BoundedEncoding Char 323 | (>*<) :: BoundedEncoding a -> BoundedEncoding b -> BoundedEncoding (a, b) 324 | 325 | (>$<) :: (b -> a) -> BoundedEncoding a -> BoundedEncoding b 326 | 327 | ^ BoundedEncodings are contrafunctors; like most data-sinks 328 | 329 | 330 | - Implementation relies heavily on inlining to compute bounds and 331 | low-level encoding code during compilation. 332 | -} 333 | renderStringBE :: String -> Builder 334 | renderStringBE cs = B.charUtf8 '"' <> foldMap escape cs <> B.charUtf8 '"' 335 | where 336 | escape '\\' = B.charUtf8 '\\' <> B.charUtf8 '\\' 337 | escape '\"' = B.charUtf8 '\\' <> B.charUtf8 '\"' 338 | escape c = B.charUtf8 c 339 | 340 | renderCellBE :: Cell -> Builder 341 | renderCellBE (StringC cs) = renderStringBE cs 342 | renderCellBE (IntC i) = B.intDec i 343 | 344 | renderRowBE :: Row -> Builder 345 | renderRowBE [] = mempty 346 | renderRowBE (c:cs) = 347 | renderCellBE c <> mconcat [ B.charUtf8 ',' <> renderCellBE c' | c' <- cs ] 348 | 349 | renderTableBE :: Table -> Builder 350 | renderTableBE rs = mconcat [renderRowBE r <> B.charUtf8 '\n' | r <- rs] 351 | 352 | -- 0.65 ms 353 | benchBuilderEncodingUtf8 :: Benchmark 354 | benchBuilderEncodingUtf8 = bench "utf8 + renderTableBE maxiTable + lazy" $ 355 | nf (L.length . B.toLazyByteString . renderTableBE) maxiTable 356 | 357 | benchBuilderEncodingUtf8Streaming :: Benchmark 358 | benchBuilderEncodingUtf8Streaming = bench "utf8 + renderTableBE maxiTable + streaming " $ 359 | nfIO $ (Streaming.length . Streaming.toStreamingByteString . renderTableBE) maxiTable 360 | 361 | 362 | 363 | -- 1.4x faster than DList based 364 | 365 | -- 1.7x faster than DList based on code other than touching all data 366 | 367 | 368 | ------------------------------------------------------------------------------ 369 | -- Difference-list based rendering 370 | ------------------------------------------------------------------------------ 371 | 372 | type DString = D.DList Char 373 | 374 | renderStringD :: String -> DString 375 | renderStringD cs = return '"' <> foldMap escape cs <> return '"' 376 | where 377 | escape '\\' = D.fromList "\\\\" 378 | escape '\"' = D.fromList "\\\"" 379 | escape c = return c 380 | 381 | renderCellD :: Cell -> DString 382 | renderCellD (StringC cs) = renderStringD cs 383 | renderCellD (IntC i) = D.fromList $ show i 384 | 385 | renderRowD :: Row -> DString 386 | renderRowD [] = mempty 387 | renderRowD (c:cs) = 388 | renderCellD c <> mconcat [ return ',' <> renderCellD c' | c' <- cs ] 389 | 390 | renderTableD :: Table -> DString 391 | renderTableD rs = mconcat [renderRowD r <> return '\n' | r <- rs] 392 | 393 | -- 0.91 ms 394 | benchDListUtf8 :: Benchmark 395 | benchDListUtf8 = bench "utf8 + renderTableD maxiTable" $ 396 | nf (L.length . B.toLazyByteString . B.stringUtf8 . D.toList . renderTableD) maxiTable 397 | 398 | 399 | ------------------------------------------------------------------------------ 400 | -- utf8-string and utf8-light 401 | ------------------------------------------------------------------------------ 402 | 403 | -- 4.12 ms 404 | benchDListUtf8Light :: Benchmark 405 | benchDListUtf8Light = bench "utf8-light + renderTable maxiTable" $ 406 | whnf (Utf8Light.encode . D.toList . renderTableD) maxiTable 407 | 408 | {- Couldn't get utf8-string to work :-( 409 | 410 | benchDListUtf8String :: Benchmark 411 | benchDListUtf8String = bench "utf8-light + renderTable maxiTable" $ 412 | whnf (Utf8String.toRep . encode . 413 | D.toList . renderTableD) maxiTable 414 | where 415 | encode :: String -> Utf8String.UTF8 S.ByteString 416 | encode = Utf8String.fromString 417 | -} 418 | 419 | ------------------------------------------------------------------------------ 420 | -- Data.Binary.Builder based rendering 421 | ------------------------------------------------------------------------------ 422 | 423 | -- Note that as of binary-0.6.0.0 the binary builder is the same as the one 424 | -- provided by the bytestring library. 425 | -- 426 | -- {-# INLINE char8BinB #-} 427 | -- char8BinB :: Char -> BinB.Builder 428 | -- char8BinB = BinB.singleton . fromIntegral . ord 429 | -- 430 | -- renderStringBinB :: String -> BinB.Builder 431 | -- renderStringBinB cs = char8BinB '"' <> foldMap escape cs <> char8BinB '"' 432 | -- where 433 | -- escape '\\' = char8BinB '\\' <> char8BinB '\\' 434 | -- escape '\"' = char8BinB '\\' <> char8BinB '"' 435 | -- escape c = char8BinB c 436 | -- 437 | -- renderCellBinB :: Cell -> BinB.Builder 438 | -- renderCellBinB (StringC cs) = renderStringBinB cs 439 | -- renderCellBinB (IntC i) = B.intDec i 440 | -- 441 | -- renderRowBinB :: Row -> BinB.Builder 442 | -- renderRowBinB [] = mempty 443 | -- renderRowBinB (c:cs) = 444 | -- renderCellBinB c <> mconcat [ char8BinB ',' <> renderCellBinB c' | c' <- cs ] 445 | -- 446 | -- renderTableBinB :: Table -> BinB.Builder 447 | -- renderTableBinB rs = mconcat [renderRowBinB r <> char8BinB '\n' | r <- rs] 448 | -- 449 | -- -- 1.22 ms 450 | -- benchBinaryBuilderChar8 :: Benchmark 451 | -- benchBinaryBuilderChar8 = bench "char8 + renderTableBinB maxiTable" $ 452 | -- nf (L.length . BinB.toLazyByteString . renderTableBinB) maxiTable 453 | -- 454 | 455 | ------------------------------------------------------------------------------ 456 | -- Text Builder 457 | ------------------------------------------------------------------------------ 458 | 459 | renderStringTB :: String -> TB.Builder 460 | renderStringTB cs = TB.singleton '"' <> foldMap escape cs <> TB.singleton '"' 461 | where 462 | escape '\\' = "\\\\" 463 | escape '\"' = "\\\"" 464 | escape c = TB.singleton c 465 | 466 | renderCellTB :: Cell -> TB.Builder 467 | renderCellTB (StringC cs) = renderStringTB cs 468 | renderCellTB (IntC i) = TB.decimal i 469 | 470 | renderRowTB :: Row -> TB.Builder 471 | renderRowTB [] = mempty 472 | renderRowTB (c:cs) = 473 | renderCellTB c <> mconcat [ TB.singleton ',' <> renderCellTB c' | c' <- cs ] 474 | 475 | renderTableTB :: Table -> TB.Builder 476 | renderTableTB rs = mconcat [renderRowTB r <> TB.singleton '\n' | r <- rs] 477 | 478 | -- 0.95 ms 479 | benchTextBuilder :: Benchmark 480 | benchTextBuilder = bench "renderTableTB maxiTable" $ 481 | nf (TL.length . TB.toLazyText . renderTableTB) maxiTable 482 | 483 | -- 1.10 ms 484 | benchTextBuilderUtf8 :: Benchmark 485 | benchTextBuilderUtf8 = bench "utf8 + renderTableTB maxiTable" $ 486 | nf (L.length . TL.encodeUtf8 . TB.toLazyText . renderTableTB) maxiTable 487 | 488 | 489 | 490 | {- On a Core 2 Duo 2.2 GHz running a 32-bit Linux: 491 | 492 | 493 | touching all data: 0.25 ms 494 | string rendering: 1.36 ms 495 | string rendering + utf8 encoding: 1.36 ms 496 | DList rendering + utf8 encoding: 0.91 ms 497 | builder rendering (incl. utf8): 0.82 ms 498 | builder + faster escaping: 0.65 ms 499 | 500 | text builder: 0.95 ms 501 | text builder + utf8 encoding: 1.10 ms 502 | binary builder + char8 (!!): 1.22 ms 503 | DList render + utf8-light: 4.12 ms 504 | 505 | How to improve further? 506 | * Use packed formats for string literals 507 | - fast memcpy (that's what blaze-html does for tags) 508 | - using Text literals should also help 509 | 510 | 511 | results from criterion: 512 | 513 | benchmarking nf maxiTable 514 | mean: 257.2927 us, lb 255.9210 us, ub 259.6692 us, ci 0.950 515 | std dev: 9.026280 us, lb 5.887942 us, ub 12.76582 us, ci 0.950 516 | 517 | benchmarking renderTable maxiTable 518 | mean: 1.358458 ms, lb 1.356732 ms, ub 1.362377 ms, ci 0.950 519 | std dev: 12.66932 us, lb 7.110377 us, ub 24.97397 us, ci 0.950 520 | 521 | benchmarking utf8 + renderTable maxiTable 522 | mean: 1.364343 ms, lb 1.362391 ms, ub 1.366973 ms, ci 0.950 523 | std dev: 11.65388 us, lb 9.094074 us, ub 17.47765 us, ci 0.950 524 | 525 | benchmarking utf8 + renderTableD maxiTable 526 | mean: 909.5255 us, lb 908.0049 us, ub 911.7639 us, ci 0.950 527 | std dev: 9.434182 us, lb 6.906120 us, ub 15.43223 us, ci 0.950 528 | 529 | benchmarking utf8-light + renderTable maxiTable 530 | mean: 4.128315 ms, lb 4.121109 ms, ub 4.138436 ms, ci 0.950 531 | std dev: 42.93755 us, lb 32.58115 us, ub 58.61780 us, ci 0.950 532 | 533 | benchmarking char8 + renderTableBinB maxiTable 534 | mean: 1.224156 ms, lb 1.222510 ms, ub 1.226101 ms, ci 0.950 535 | std dev: 9.046150 us, lb 7.568433 us, ub 11.74996 us, ci 0.950 536 | 537 | benchmarking renderTableTB maxiTable 538 | mean: 954.8066 us, lb 953.6650 us, ub 957.0134 us, ci 0.950 539 | std dev: 7.763098 us, lb 5.072194 us, ub 14.09216 us, ci 0.950 540 | 541 | benchmarking utf8 + renderTableTB maxiTable 542 | mean: 1.095913 ms, lb 1.094811 ms, ub 1.098280 ms, ci 0.950 543 | std dev: 7.865781 us, lb 4.189907 us, ub 15.24606 us, ci 0.950 544 | 545 | benchmarking utf8 + renderTableB maxiTable 546 | mean: 818.0223 us, lb 816.5118 us, ub 819.9397 us, ci 0.950 547 | std dev: 8.603917 us, lb 6.764347 us, ub 12.29236 us, ci 0.950 548 | 549 | benchmarking utf8 + renderTableBE maxiTable 550 | mean: 646.5248 us, lb 645.3735 us, ub 648.2405 us, ci 0.950 551 | std dev: 7.147889 us, lb 5.222494 us, ub 11.82482 us, ci 0.950 552 | 553 | -} 554 | 555 | 556 | 557 | {- Conclusion: 558 | ------------- 559 | 560 | * Whenever generating a sequence of bytes: use the 'Builder' type 561 | 562 | => chunks can always be kept large; impossible when exporting only 563 | a strict/lazy bytestring interface. 564 | 565 | => filtering/mapping lazy bytestrings now automatically defragments 566 | the output and guarantees a large chunk size. 567 | 568 | 569 | * Status of work: API complete, documentation needs more reviewing. 570 | 571 | 572 | * Bounded encodings: safely exploiting low-level optimizations 573 | 574 | => a performance advantage on other outputstream-libraries? 575 | 576 | 577 | --------------- 578 | - Questions ? - 579 | --------------- 580 | 581 | -} 582 | 583 | 584 | 585 | 586 | {- Implementation outline: 587 | ------------------------ 588 | 589 | data BufferRange = BufferRange {-# UNPACK #-} !(Ptr Word8) -- First byte of range 590 | {-# UNPACK #-} !(Ptr Word8) -- First byte /after/ range 591 | 592 | newtype BuildStep a = 593 | BuildStep { runBuildStep :: BufferRange -> IO (BuildSignal a) } 594 | 595 | data BuildSignal a = 596 | Done !(Ptr Word8) -- next free byte in current buffer 597 | a -- return value 598 | | BufferFull 599 | !Int -- minimal size of next buffer 600 | !(Ptr Word8) -- next free byte in current buffer 601 | !(BuildStep a) -- continuation to call on next buffer 602 | | InsertByteString 603 | !(Ptr Word8) -- next free byte in current buffer 604 | !S.ByteString -- bytestring to insert directly 605 | !(BuildStep a) -- continuation to call on next buffer 606 | 607 | 608 | -- | A "difference list" of build-steps. 609 | newtype Builder = Builder (forall r. BuildStep r -> BuildStep r) 610 | 611 | 612 | -- | The corresponding "Writer" monad. 613 | newtype Put a = Put { unPut :: forall r. (a -> BuildStep r) -> BuildStep r } 614 | 615 | 616 | -} -------------------------------------------------------------------------------- /bench/benchio.hs: -------------------------------------------------------------------------------- 1 | {-#LANGUAGE OverloadedStrings #-} 2 | import qualified System.IO as IO 3 | import qualified System.Environment as IO 4 | import qualified Data.ByteString.Lazy as L 5 | import qualified Data.ByteString.Lazy.Char8 as LC 6 | import qualified Data.ByteString.Streaming.Char8 as S 7 | import Data.ByteString.Char8 (pack) 8 | import qualified Pipes.Group as PG 9 | import qualified Pipes.ByteString as PB 10 | import qualified Data.Conduit.Binary as CB 11 | import Pipes 12 | import Data.Conduit 13 | import Data.Monoid 14 | import Lens.Simple 15 | import Data.Char 16 | main = 17 | IO.withFile "txt/words3b.txt" IO.ReadMode $ \hIn -> 18 | IO.withFile "txt/words3c.txt" IO.WriteMode $ \hOut -> 19 | do xs <- IO.getArgs 20 | case xs of 21 | x:_ -> 22 | case x of 23 | "lazy" -> L.hGetContents hIn >>= L.hPut hOut 24 | "streaming" -> S.hPut hOut (S.hGetContents hIn) 25 | "conduit" -> CB.sourceHandle hIn $$ CB.sinkHandle hOut 26 | "pipes" -> runEffect $ PB.fromHandle hIn >-> PB.toHandle hOut 27 | _ -> info 28 | [] -> info 29 | where 30 | info = putStrLn "lazy conduit pipe streaming" 31 | 32 | -------------------------------------------------------------------------------- /bench/benchlines.hs: -------------------------------------------------------------------------------- 1 | {-#LANGUAGE OverloadedStrings #-} 2 | import qualified System.IO as IO 3 | import qualified System.Environment as IO 4 | import qualified Data.ByteString.Lazy as L 5 | import qualified Data.ByteString.Lazy.Char8 as LC 6 | import qualified Data.ByteString.Streaming.Char8 as S 7 | import Data.ByteString.Char8 (pack) 8 | import qualified Pipes.Group as PG 9 | import qualified Pipes.ByteString as PB 10 | import qualified Data.Conduit.Binary as CB 11 | import qualified Data.Conduit.List as CL 12 | import Pipes 13 | import Data.Conduit 14 | import Data.Monoid 15 | import Lens.Simple 16 | import Data.Char 17 | import Stream.Prelude (maps) 18 | 19 | main = 20 | IO.withFile "txt/words3b.txt" IO.ReadMode $ \hIn -> 21 | IO.withFile "txt/words3c.txt" IO.WriteMode $ \hOut -> 22 | do xs <- IO.getArgs 23 | case xs of 24 | x:_ -> 25 | case x of 26 | "lazy" -> L.hGetContents hIn >>= L.hPut hOut . l 27 | "streaming" -> S.hPut hOut (s (S.hGetContents hIn) ) 28 | "conduit" -> CB.sourceHandle hIn $$ CB.sinkHandle hOut 29 | "pipes" -> runEffect $ p (PB.fromHandle hIn) >-> PB.toHandle hOut 30 | _ -> info 31 | [] -> info 32 | where 33 | info = putStrLn "lazy conduit pipe streaming" 34 | 35 | s x = S.unlines (maps ( S.Chunk "!") (S.lines x)) 36 | l x = LC.unlines (map ("!" <>) (LC.lines x)) 37 | p = over PB.lines (PG.maps (Pipes.yield "!" >>)) 38 | c = CB.lines =$= go 39 | where 40 | go = do 41 | m <- await 42 | case m of 43 | Nothing -> return () 44 | Just x -> do 45 | yield "\n" 46 | yield x 47 | go 48 | 49 | -- ss = S.unlines . S.zipWithList S.Chunk titles . S.lines 50 | -- ll = LC.unlines . zipWith (\x y -> LC.fromStrict x <> y) titles . LC.lines 51 | 52 | titles = map title [1..] where 53 | title n = 54 | let str = show n 55 | len = length str 56 | pad = take (10-len) (repeat ' ') 57 | in pack (str <> pad) 58 | -- 59 | -- s' = S.map toLower . S.intercalate (S.yield "!\n") . S.lines 60 | -- l' = LC.map toLower . LC.intercalate "!\n" . LC.lines 61 | -------------------------------------------------------------------------------- /examples/HttpGet.hs: -------------------------------------------------------------------------------- 1 | {-#LANGUAGE OverloadedStrings #-} 2 | import Streaming 3 | import Streaming.Prelude (each, next, yield) 4 | import qualified Data.ByteString.Streaming.Char8 as Q 5 | import qualified Data.ByteString.Char8 as B 6 | import qualified Streaming.Prelude as S 7 | import qualified Control.Foldl as L 8 | import Data.ByteString.Streaming.HTTP -- git clone https://github.com/michaelt/streaming-http 9 | -- cabal install ./streaming-http 10 | infixl 5 >>>; (>>>) = flip (.) 11 | infixl 1 &; (&) = flip ($) 12 | 13 | main = do 14 | req <- parseUrl "https://raw.githubusercontent.com/michaelt/kjv/master/kjv.txt" 15 | m <- newManager tlsManagerSettings 16 | withHTTP req m $ \resp -> 17 | resp & -- Response (Q.ByteString IO ()) 18 | responseBody -- Q.ByteString IO () 19 | >>> Q.lines -- Stream (Q.ByteString IO) IO () 20 | >>> Q.denull -- Stream (Q.ByteString IO) IO () 21 | >>> interleaves numerals -- Stream (Q.ByteString IO) IO () 22 | >>> Q.unlines -- Q.ByteString IO () 23 | >>> Q.stdout -- IO () 24 | where 25 | numerals = maps padded (S.enumFrom 1) 26 | padded (n:>r) = Q.chunk stuff >> return r 27 | where 28 | len = length (show n); diff = 5 - len 29 | padding = if diff > 0 then B.replicate diff ' ' else "" 30 | stuff = padding `mappend` B.pack (show n ++ " ") 31 | 32 | 33 | -------------------------------------------------------------------------------- /examples/shell.hs: -------------------------------------------------------------------------------- 1 | -- these examples are from the io-streams tutorial 2 | {-#LANGUAGE OverloadedStrings #-} 3 | import Streaming 4 | import Streaming.Prelude (yield, next, each) 5 | import qualified Streaming.Prelude as S 6 | import qualified Data.ByteString.Char8 as B 7 | import Data.ByteString.Streaming (ByteString) 8 | import qualified Data.ByteString.Streaming.Char8 as Q 9 | import System.IO (withFile, IOMode(..)) 10 | import Control.Monad 11 | import Control.Applicative 12 | import Data.Monoid 13 | 14 | cat :: FilePath -> IO () 15 | cat file = withFile file ReadMode $ \h -> Q.stdout (Q.fromHandle h) 16 | -- catStdin :: IO () 17 | -- catStdin = Q.stdout Q.stdin 18 | 19 | head :: Int -> FilePath -> IO () 20 | head n file = withFile file ReadMode $ \h -> 21 | Q.stdout -- IO () -- stream to IO.stdout 22 | $ Q.unlines -- ByteString m () -- insert '\n' between bytestream layers 23 | $ takes n -- Stream (ByteString m) m () -- nb. "takes" is 'functor general' 24 | $ Q.lines -- Stream (ByteString m) m () -- divided into Stream layers 25 | $ Q.fromHandle h -- ByteString m () -- raw bytes 26 | 27 | yes :: IO () 28 | yes = Q.stdout $ Q.cycle "y\n" -- uses OverloadedStrings instance for 'ByteString m ()' 29 | 30 | grep :: B.ByteString -> FilePath -> IO () 31 | grep pat file = withFile file ReadMode $ \h -> do 32 | let raw :: ByteString IO () -- get raw bytes 33 | raw = Q.fromHandle h 34 | 35 | segmented :: Stream (ByteString IO) IO () -- divide on newlines 36 | segmented = Q.lines raw 37 | 38 | individualized :: Stream (Of B.ByteString) IO () 39 | individualized = mapsM Q.toStrict' segmented -- danger: concatenate 'real' bytestrings! 40 | 41 | matching :: Stream (Of B.ByteString) IO () -- filter out matching bytestrings 42 | matching = S.filter (B.isInfixOf pat) individualized 43 | 44 | deindividualized :: Stream (ByteString IO) IO () -- restream (implicitly using 45 | deindividualized = for matching (layer . Q.chunk) -- the new chunk structure) 46 | 47 | unsegmented :: ByteString IO () -- add newlines 48 | unsegmented = Q.unlines deindividualized 49 | 50 | Q.stdout unsegmented -- stream to IO.stdout 51 | 52 | 53 | data Option = Bytes | Words | Lines 54 | len = S.fold (\n _ -> n + 1) 0 id 55 | 56 | wc :: Option -> FilePath -> IO () 57 | wc opt file = withFile file ReadMode $ \h -> 58 | do n <- count (Q.fromHandle h) 59 | print n 60 | where 61 | count is = case opt of 62 | Bytes -> Q.length is 63 | Words -> S.sum $ mapsM blank_layer $ Q.words is 64 | Lines -> S.sum $ mapsM blank_layer $ Q.lines is 65 | blank_layer :: Monad m => ByteString m r -> m (Of Int r) 66 | blank_layer = liftM (1 :>) . Q.drain 67 | -- replace each layer with (1 :> ...); here we do not accumlate strict-bs words 68 | 69 | -- exercise: write `wc` to permit a list of options, using `foldl` to combine 70 | -- the different folds. This would require a more direct implementation 71 | -- of what might be called `line_count :: Fold Char Int` and `word_count :: Fold Char Int` 72 | 73 | paste file file' = withFile file ReadMode $ \h -> 74 | withFile file' ReadMode $ \h' -> 75 | Q.stdout 76 | $ Q.unlines 77 | $ interleaves (Q.lines (Q.fromHandle h)) 78 | $ maps (Q.cons '\t') 79 | $ Q.lines 80 | $ Q.fromHandle h' 81 | 82 | nl :: FilePath -> IO () 83 | nl file = withFile file ReadMode $ \h -> 84 | Q.stdout 85 | $ Q.unlinesIndividual 86 | $ S.zipWith nlpad (each [1..]) 87 | $ Q.linesIndividual -- note unnecessary failure to stream; see below 88 | $ Q.fromHandle h 89 | where 90 | nlpad :: Int -> B.ByteString -> B.ByteString 91 | nlpad n bs = padding <> B.pack (show n <> " ") <> bs 92 | where 93 | len = length (show n); diff = 9 - len 94 | padding = if diff > 0 then B.replicate diff ' ' else B.singleton ' ' 95 | 96 | nl_streaming :: FilePath -> IO () 97 | nl_streaming file = withFile file ReadMode $ \h -> 98 | Q.stdout 99 | $ Q.unlines 100 | $ interleaves numerals -- interleaves might instead be called 'fuseLayers' or something 101 | $ Q.lines -- note proper streaming 102 | $ Q.fromHandle h 103 | where 104 | numerals :: Monad m => Stream (ByteString m) m () 105 | numerals = maps trans (each [1..]) where 106 | trans (n:>r) = Q.chunk stuff >> return r 107 | where 108 | len = length (show n); diff = 9 - len 109 | padding = if diff > 0 then B.replicate diff ' ' else B.singleton ' ' 110 | stuff = padding <> B.pack (show n ++ " ") -------------------------------------------------------------------------------- /lib/Data/ByteString/Streaming.hs: -------------------------------------------------------------------------------- 1 | -- | A simple module reexport to aid back-compatibility. Please use the new 2 | -- module. 3 | module Data.ByteString.Streaming 4 | {-# DEPRECATED "Use Streaming.ByteString instead." #-} 5 | ( module Streaming.ByteString ) where 6 | 7 | import Streaming.ByteString 8 | -------------------------------------------------------------------------------- /lib/Data/ByteString/Streaming/Char8.hs: -------------------------------------------------------------------------------- 1 | -- | A simple module reexport to aid back-compatibility. Please use the new 2 | -- module. 3 | module Data.ByteString.Streaming.Char8 4 | {-# DEPRECATED "Use Streaming.ByteString.Char8 instead." #-} 5 | ( module Streaming.ByteString.Char8 ) where 6 | 7 | import Streaming.ByteString.Char8 8 | -------------------------------------------------------------------------------- /lib/Data/ByteString/Streaming/Internal.hs: -------------------------------------------------------------------------------- 1 | -- | A simple module reexport to aid back-compatibility. Please use the new 2 | -- module. 3 | module Data.ByteString.Streaming.Internal 4 | {-# DEPRECATED "Use Streaming.ByteString.Internal instead." #-} 5 | ( module Streaming.ByteString.Internal ) where 6 | 7 | import Streaming.ByteString.Internal 8 | -------------------------------------------------------------------------------- /lib/Streaming/ByteString.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE BangPatterns #-} 2 | {-# LANGUAGE CPP #-} 3 | {-# LANGUAGE GADTs #-} 4 | {-# LANGUAGE LambdaCase #-} 5 | {-# LANGUAGE RankNTypes #-} 6 | {-# LANGUAGE ViewPatterns #-} 7 | 8 | -- | 9 | -- Module : Streaming.ByteString 10 | -- Copyright : (c) Don Stewart 2006 11 | -- (c) Duncan Coutts 2006-2011 12 | -- (c) Michael Thompson 2015 13 | -- License : BSD-style 14 | -- 15 | -- Maintainer : what_is_it_to_do_anything@yahoo.com 16 | -- Stability : experimental 17 | -- Portability : portable 18 | -- 19 | -- See the simple examples of use 20 | -- and the @ghci@ examples especially in "Streaming.ByteString.Char8". 21 | -- We begin with a slight modification of the documentation to "Data.ByteString.Lazy": 22 | -- 23 | -- A time and space-efficient implementation of effectful byte streams using a 24 | -- stream of packed 'Word8' arrays, suitable for high performance use, both in 25 | -- terms of large data quantities, or high speed requirements. Streaming 26 | -- ByteStrings are encoded as streams of strict chunks of bytes. 27 | -- 28 | -- A key feature of streaming ByteStrings is the means to manipulate large or 29 | -- unbounded streams of data without requiring the entire sequence to be 30 | -- resident in memory. To take advantage of this you have to write your 31 | -- functions in a streaming style, e.g. classic pipeline composition. The 32 | -- default I\/O chunk size is 32k, which should be good in most circumstances. 33 | -- 34 | -- Some operations, such as 'concat', 'append', and 'cons', have better 35 | -- complexity than their "Data.ByteString" equivalents, due to optimisations 36 | -- resulting from the list spine structure. For other operations streaming, like 37 | -- lazy, ByteStrings are usually within a few percent of strict ones. 38 | -- 39 | -- This module is intended to be imported @qualified@, to avoid name clashes 40 | -- with "Prelude" functions. eg. 41 | -- 42 | -- > import qualified Streaming.ByteString as Q 43 | -- 44 | -- Original GHC implementation by Bryan O\'Sullivan. Rewritten to use 45 | -- 'Data.Array.Unboxed.UArray' by Simon Marlow. Rewritten to support slices and 46 | -- use 'Foreign.ForeignPtr.ForeignPtr' by David Roundy. Rewritten again and 47 | -- extended by Don Stewart and Duncan Coutts. Lazy variant by Duncan Coutts and 48 | -- Don Stewart. Streaming variant by Michael Thompson, following the ideas of 49 | -- Gabriel Gonzales' pipes-bytestring. 50 | module Streaming.ByteString 51 | ( -- * The @ByteStream@ type 52 | ByteStream 53 | , ByteString 54 | 55 | -- * Introducing and eliminating 'ByteStream's 56 | , empty 57 | , singleton 58 | , pack 59 | , unpack 60 | , fromLazy 61 | , toLazy 62 | , toLazy_ 63 | , fromChunks 64 | , toChunks 65 | , fromStrict 66 | , toStrict 67 | , toStrict_ 68 | , effects 69 | , copy 70 | , drained 71 | , mwrap 72 | 73 | -- * Transforming ByteStreams 74 | , map 75 | , for 76 | , intercalate 77 | , intersperse 78 | 79 | -- * Basic interface 80 | , cons 81 | , cons' 82 | , snoc 83 | , append 84 | , filter 85 | , uncons 86 | , nextByte 87 | 88 | -- * Substrings 89 | -- ** Breaking strings 90 | , break 91 | , drop 92 | , dropWhile 93 | , group 94 | , groupBy 95 | , span 96 | , splitAt 97 | , splitWith 98 | , take 99 | , takeWhile 100 | 101 | -- ** Breaking into many substrings 102 | , split 103 | 104 | -- ** Special folds 105 | , concat 106 | , denull 107 | 108 | -- * Builders 109 | , toStreamingByteString 110 | 111 | , toStreamingByteStringWith 112 | 113 | , toBuilder 114 | , concatBuilders 115 | 116 | -- * Building ByteStreams 117 | -- ** Infinite ByteStreams 118 | , repeat 119 | , iterate 120 | , cycle 121 | 122 | -- ** Unfolding ByteStreams 123 | , unfoldM 124 | , unfoldr 125 | , reread 126 | 127 | -- * Folds, including support for `Control.Foldl` 128 | , foldr 129 | , fold 130 | , fold_ 131 | , head 132 | , head_ 133 | , last 134 | , last_ 135 | , length 136 | , length_ 137 | , null 138 | , null_ 139 | , nulls 140 | , testNull 141 | , count 142 | , count_ 143 | 144 | -- * I\/O with 'ByteStream's 145 | -- ** Standard input and output 146 | , getContents 147 | , stdin 148 | , stdout 149 | , interact 150 | 151 | -- ** Files 152 | , readFile 153 | , writeFile 154 | , appendFile 155 | 156 | -- ** I\/O with Handles 157 | , fromHandle 158 | , toHandle 159 | , hGet 160 | , hGetContents 161 | , hGetContentsN 162 | , hGetN 163 | , hGetNonBlocking 164 | , hGetNonBlockingN 165 | , hPut 166 | -- , hPutNonBlocking 167 | 168 | -- * Simple chunkwise operations 169 | , unconsChunk 170 | , nextChunk 171 | , chunk 172 | , foldrChunks 173 | , foldlChunks 174 | , chunkFold 175 | , chunkFoldM 176 | , chunkMap 177 | , chunkMapM 178 | , chunkMapM_ 179 | 180 | -- * Etc. 181 | , dematerialize 182 | , materialize 183 | , distribute 184 | , zipWithStream 185 | ) where 186 | 187 | import Prelude hiding 188 | (all, any, appendFile, break, concat, concatMap, cycle, drop, dropWhile, 189 | elem, filter, foldl, foldl1, foldr, foldr1, getContents, getLine, head, 190 | init, interact, iterate, last, length, lines, map, maximum, minimum, 191 | notElem, null, putStr, putStrLn, readFile, repeat, replicate, reverse, 192 | scanl, scanl1, scanr, scanr1, span, splitAt, tail, take, takeWhile, unlines, 193 | unzip, writeFile, zip, zipWith) 194 | 195 | import qualified Data.ByteString as B 196 | import qualified Data.ByteString as P (ByteString) 197 | import Data.ByteString.Builder.Internal hiding 198 | (append, defaultChunkSize, empty, hPut) 199 | import qualified Data.ByteString.Internal as B 200 | import qualified Data.ByteString.Lazy.Internal as BI 201 | import qualified Data.ByteString.Unsafe as B 202 | 203 | import Streaming hiding (concats, distribute, unfold) 204 | import Streaming.ByteString.Internal 205 | import Streaming.Internal (Stream(..)) 206 | import qualified Streaming.Prelude as SP 207 | 208 | import Control.Monad (forever) 209 | import Control.Monad.Trans.Resource 210 | import Data.Int (Int64) 211 | import qualified Data.List as L 212 | import Data.Word (Word8) 213 | import Foreign.Ptr 214 | import Foreign.Storable 215 | import qualified System.IO as IO (stdin, stdout) 216 | import System.IO (Handle, IOMode(..), hClose, openBinaryFile) 217 | import System.IO.Error (illegalOperationErrorType, mkIOError) 218 | 219 | -- | /O(n)/ Concatenate a stream of byte streams. 220 | concat :: Monad m => Stream (ByteStream m) m r -> ByteStream m r 221 | concat x = destroy x join Go Empty 222 | {-# INLINE concat #-} 223 | 224 | -- | Given a byte stream on a transformed monad, make it possible to \'run\' 225 | -- transformer. 226 | distribute 227 | :: (Monad m, MonadTrans t, MFunctor t, Monad (t m), Monad (t (ByteStream m))) 228 | => ByteStream (t m) a -> t (ByteStream m) a 229 | distribute ls = dematerialize ls 230 | return 231 | (\bs x -> join $ lift $ Chunk bs (Empty x) ) 232 | (join . hoist (Go . fmap Empty)) 233 | {-# INLINE distribute #-} 234 | 235 | -- | Perform the effects contained in an effectful bytestring, ignoring the bytes. 236 | effects :: Monad m => ByteStream m r -> m r 237 | effects bs = case bs of 238 | Empty r -> return r 239 | Go m -> m >>= effects 240 | Chunk _ rest -> effects rest 241 | {-# INLINABLE effects #-} 242 | 243 | -- | Perform the effects contained in the second in an effectful pair of 244 | -- bytestrings, ignoring the bytes. It would typically be used at the type 245 | -- 246 | -- > ByteStream m (ByteStream m r) -> ByteStream m r 247 | drained :: (Monad m, MonadTrans t, Monad (t m)) => t m (ByteStream m r) -> t m r 248 | drained t = t >>= lift . effects 249 | 250 | -- ----------------------------------------------------------------------------- 251 | -- Introducing and eliminating 'ByteStream's 252 | 253 | -- | /O(1)/ The empty 'ByteStream' -- i.e. @return ()@ Note that @ByteStream m w@ is 254 | -- generally a monoid for monoidal values of @w@, like @()@. 255 | empty :: ByteStream m () 256 | empty = Empty () 257 | {-# INLINE empty #-} 258 | 259 | -- | /O(1)/ Yield a 'Word8' as a minimal 'ByteStream'. 260 | singleton :: Monad m => Word8 -> ByteStream m () 261 | singleton w = Chunk (B.singleton w) (Empty ()) 262 | {-# INLINE singleton #-} 263 | 264 | -- | /O(n)/ Convert a monadic stream of individual 'Word8's into a packed byte stream. 265 | pack :: Monad m => Stream (Of Word8) m r -> ByteStream m r 266 | pack = packBytes 267 | {-# INLINE pack #-} 268 | 269 | -- | /O(n)/ Converts a packed byte stream into a stream of individual bytes. 270 | unpack :: Monad m => ByteStream m r -> Stream (Of Word8) m r 271 | unpack = unpackBytes 272 | 273 | -- | /O(c)/ Convert a monadic stream of individual strict 'ByteString' chunks 274 | -- into a byte stream. 275 | fromChunks :: Monad m => Stream (Of P.ByteString) m r -> ByteStream m r 276 | fromChunks cs = destroy cs (\(bs :> rest) -> Chunk bs rest) Go return 277 | {-# INLINE fromChunks #-} 278 | 279 | -- | /O(c)/ Convert a byte stream into a stream of individual strict 280 | -- bytestrings. This of course exposes the internal chunk structure. 281 | toChunks :: Monad m => ByteStream m r -> Stream (Of P.ByteString) m r 282 | toChunks bs = dematerialize bs return (\b mx -> Step (b:> mx)) Effect 283 | {-# INLINE toChunks #-} 284 | 285 | -- | /O(1)/ Yield a strict 'ByteString' chunk. 286 | fromStrict :: P.ByteString -> ByteStream m () 287 | fromStrict bs | B.null bs = Empty () 288 | | otherwise = Chunk bs (Empty ()) 289 | {-# INLINE fromStrict #-} 290 | 291 | -- | /O(n)/ Convert a byte stream into a single strict 'ByteString'. 292 | -- 293 | -- Note that this is an /expensive/ operation that forces the whole monadic 294 | -- ByteString into memory and then copies all the data. If possible, try to 295 | -- avoid converting back and forth between streaming and strict bytestrings. 296 | toStrict_ :: Monad m => ByteStream m r -> m B.ByteString 297 | #if MIN_VERSION_streaming (0,2,2) 298 | toStrict_ = fmap B.concat . SP.toList_ . toChunks 299 | #else 300 | toStrict_ = fmap B.concat . SP.toList_ . void . toChunks 301 | #endif 302 | {-# INLINE toStrict_ #-} 303 | 304 | -- | /O(n)/ Convert a monadic byte stream into a single strict 'ByteString', 305 | -- retaining the return value of the original pair. This operation is for use 306 | -- with 'mapped'. 307 | -- 308 | -- > mapped R.toStrict :: Monad m => Stream (ByteStream m) m r -> Stream (Of ByteString) m r 309 | -- 310 | -- It is subject to all the objections one makes to Data.ByteString.Lazy 311 | -- 'toStrict'; all of these are devastating. 312 | toStrict :: Monad m => ByteStream m r -> m (Of B.ByteString r) 313 | toStrict bs = do 314 | (bss :> r) <- SP.toList (toChunks bs) 315 | return (B.concat bss :> r) 316 | {-# INLINE toStrict #-} 317 | 318 | -- |/O(c)/ Transmute a pseudo-pure lazy bytestring to its representation as a 319 | -- monadic stream of chunks. 320 | -- 321 | -- >>> Q.putStrLn $ Q.fromLazy "hi" 322 | -- hi 323 | -- >>> Q.fromLazy "hi" 324 | -- Chunk "hi" (Empty (())) -- note: a 'show' instance works in the identity monad 325 | -- >>> Q.fromLazy $ BL.fromChunks ["here", "are", "some", "chunks"] 326 | -- Chunk "here" (Chunk "are" (Chunk "some" (Chunk "chunks" (Empty (()))))) 327 | fromLazy :: Monad m => BI.ByteString -> ByteStream m () 328 | fromLazy = BI.foldrChunks Chunk (Empty ()) 329 | {-# INLINE fromLazy #-} 330 | 331 | -- | /O(n)/ Convert an effectful byte stream into a single lazy 'ByteStream' 332 | -- with the same internal chunk structure. See `toLazy` which preserves 333 | -- connectness by keeping the return value of the effectful bytestring. 334 | toLazy_ :: Monad m => ByteStream m r -> m BI.ByteString 335 | toLazy_ bs = dematerialize bs (\_ -> return BI.Empty) (fmap . BI.chunk) join 336 | {-# INLINE toLazy_ #-} 337 | 338 | -- | /O(n)/ Convert an effectful byte stream into a single lazy 'ByteString' 339 | -- with the same internal chunk structure, retaining the original return value. 340 | -- 341 | -- This is the canonical way of breaking streaming (`toStrict` and the like are 342 | -- far more demonic). Essentially one is dividing the interleaved layers of 343 | -- effects and bytes into one immense layer of effects, followed by the memory 344 | -- of the succession of bytes. 345 | -- 346 | -- Because one preserves the return value, `toLazy` is a suitable argument for 347 | -- 'Streaming.mapped': 348 | -- 349 | -- > S.mapped Q.toLazy :: Stream (ByteStream m) m r -> Stream (Of L.ByteString) m r 350 | -- 351 | -- >>> Q.toLazy "hello" 352 | -- "hello" :> () 353 | -- >>> S.toListM $ traverses Q.toLazy $ Q.lines "one\ntwo\nthree\nfour\nfive\n" 354 | -- ["one","two","three","four","five",""] -- [L.ByteString] 355 | toLazy :: Monad m => ByteStream m r -> m (Of BI.ByteString r) 356 | toLazy bs0 = dematerialize bs0 357 | (\r -> return (BI.Empty :> r)) 358 | (\b mx -> do 359 | (bs :> x) <- mx 360 | return $ BI.chunk b bs :> x 361 | ) 362 | join 363 | {-# INLINE toLazy #-} 364 | 365 | -- --------------------------------------------------------------------- 366 | -- Basic interface 367 | -- 368 | 369 | -- | Test whether a `ByteStream` is empty, collecting its return value; to reach 370 | -- the return value, this operation must check the whole length of the string. 371 | -- 372 | -- >>> Q.null "one\ntwo\three\nfour\nfive\n" 373 | -- False :> () 374 | -- >>> Q.null "" 375 | -- True :> () 376 | -- >>> S.print $ mapped R.null $ Q.lines "yours,\nMeredith" 377 | -- False 378 | -- False 379 | -- 380 | -- Suitable for use with `SP.mapped`: 381 | -- 382 | -- @ 383 | -- S.mapped Q.null :: Streaming (ByteStream m) m r -> Stream (Of Bool) m r 384 | -- @ 385 | null :: Monad m => ByteStream m r -> m (Of Bool r) 386 | null (Empty r) = return (True :> r) 387 | null (Go m) = m >>= null 388 | null (Chunk bs rest) = if B.null bs 389 | then null rest 390 | else do 391 | r <- SP.effects (toChunks rest) 392 | return (False :> r) 393 | {-# INLINABLE null #-} 394 | 395 | -- | /O(1)/ Test whether a `ByteStream` is empty. The value is of course in the 396 | -- monad of the effects. 397 | -- 398 | -- >>> Q.null "one\ntwo\three\nfour\nfive\n" 399 | -- False 400 | -- >>> Q.null $ Q.take 0 Q.stdin 401 | -- True 402 | -- >>> :t Q.null $ Q.take 0 Q.stdin 403 | -- Q.null $ Q.take 0 Q.stdin :: MonadIO m => m Bool 404 | null_ :: Monad m => ByteStream m r -> m Bool 405 | null_ (Empty _) = return True 406 | null_ (Go m) = m >>= null_ 407 | null_ (Chunk bs rest) = if B.null bs 408 | then null_ rest 409 | else return False 410 | {-# INLINABLE null_ #-} 411 | 412 | -- | Similar to `null`, but yields the remainder of the `ByteStream` stream when 413 | -- an answer has been determined. 414 | testNull :: Monad m => ByteStream m r -> m (Of Bool (ByteStream m r)) 415 | testNull (Empty r) = return (True :> Empty r) 416 | testNull (Go m) = m >>= testNull 417 | testNull p@(Chunk bs rest) = if B.null bs 418 | then testNull rest 419 | else return (False :> p) 420 | {-# INLINABLE testNull #-} 421 | 422 | -- | Remove empty ByteStrings from a stream of bytestrings. 423 | denull :: Monad m => Stream (ByteStream m) m r -> Stream (ByteStream m) m r 424 | {-# INLINABLE denull #-} 425 | denull = loop . Right 426 | where 427 | -- Scan each substream, dropping empty chunks along the way. As soon as a 428 | -- non-empty chunk is found, just apply the loop to the next substream in 429 | -- the terminal value via fmap. If Empty comes up before that happens, 430 | -- continue the current stream instead with its denulled tail. 431 | -- 432 | -- This implementation is tail recursive: 433 | -- * Recursion via 'loop . Left' continues scanning an inner ByteStream. 434 | -- * Recursion via 'loop . Right' moves to the next substream. 435 | -- 436 | -- The old version below was shorter, but noticeably slower, especially 437 | -- when empty substreams are frequent: 438 | -- 439 | -- denull = hoist (run . maps effects) . separate . mapped nulls 440 | -- 441 | loop = \ case 442 | Left mbs -> case mbs of 443 | Chunk c cs | B.length c > 0 -> Step $ Chunk c $ fmap (loop . Right) cs 444 | | otherwise -> loop $ Left cs 445 | Go m -> Effect $ loop . Left <$> m 446 | Empty r -> loop $ Right r 447 | Right strm -> case strm of 448 | Step mbs -> case mbs of 449 | Chunk c cs | B.length c > 0 -> Step $ Chunk c $ fmap (loop . Right) cs 450 | | otherwise -> loop $ Left cs 451 | Go m -> Effect $ loop . Left <$> m 452 | Empty r -> loop $ Right r 453 | Effect m -> Effect $ fmap (loop . Right) m 454 | r@(Return _) -> r 455 | 456 | {-| /O1/ Distinguish empty from non-empty lines, while maintaining streaming; 457 | the empty ByteStrings are on the right 458 | 459 | >>> nulls :: ByteStream m r -> m (Sum (ByteStream m) (ByteStream m) r) 460 | 461 | There are many (generally slower) ways to remove null bytestrings from a 462 | @Stream (ByteStream m) m r@ (besides using @denull@). If we pass next to 463 | 464 | >>> mapped nulls bs :: Stream (Sum (ByteStream m) (ByteStream m)) m r 465 | 466 | then can then apply @Streaming.separate@ to get 467 | 468 | >>> separate (mapped nulls bs) :: Stream (ByteStream m) (Stream (ByteStream m) m) r 469 | 470 | The inner monad is now made of the empty bytestrings; we act on this 471 | with @hoist@ , considering that 472 | 473 | >>> :t Q.effects . Q.concat 474 | Q.effects . Q.concat 475 | :: Monad m => Stream (Q.ByteStream m) m r -> m r 476 | 477 | we have 478 | 479 | >>> hoist (Q.effects . Q.concat) . separate . mapped Q.nulls 480 | :: Monad n => Stream (Q.ByteStream n) n b -> Stream (Q.ByteStream n) n b 481 | -} 482 | nulls :: Monad m => ByteStream m r -> m (Sum (ByteStream m) (ByteStream m) r) 483 | nulls (Empty r) = return (InR (return r)) 484 | nulls (Go m) = m >>= nulls 485 | nulls (Chunk bs rest) = if B.null bs 486 | then nulls rest 487 | else return (InL (Chunk bs rest)) 488 | {-# INLINABLE nulls #-} 489 | 490 | -- | Like `length`, report the length in bytes of the `ByteStream` by running 491 | -- through its contents. Since the return value is in the effect @m@, this is 492 | -- one way to "get out" of the stream. 493 | length_ :: Monad m => ByteStream m r -> m Int 494 | length_ = fmap (\(n:> _) -> n) . foldlChunks (\n c -> n + fromIntegral (B.length c)) 0 495 | {-# INLINE length_ #-} 496 | 497 | -- | /O(n\/c)/ 'length' returns the length of a byte stream as an 'Int' together 498 | -- with the return value. This makes various maps possible. 499 | -- 500 | -- >>> Q.length "one\ntwo\three\nfour\nfive\n" 501 | -- 23 :> () 502 | -- >>> S.print $ S.take 3 $ mapped Q.length $ Q.lines "one\ntwo\three\nfour\nfive\n" 503 | -- 3 504 | -- 8 505 | -- 4 506 | length :: Monad m => ByteStream m r -> m (Of Int r) 507 | length = foldlChunks (\n c -> n + fromIntegral (B.length c)) 0 508 | {-# INLINE length #-} 509 | 510 | -- | /O(1)/ 'cons' is analogous to @(:)@ for lists. 511 | cons :: Monad m => Word8 -> ByteStream m r -> ByteStream m r 512 | cons c cs = Chunk (B.singleton c) cs 513 | {-# INLINE cons #-} 514 | 515 | -- | /O(1)/ Unlike 'cons', 'cons\'' is strict in the ByteString that we are 516 | -- consing onto. More precisely, it forces the head and the first chunk. It does 517 | -- this because, for space efficiency, it may coalesce the new byte onto the 518 | -- first \'chunk\' rather than starting a new \'chunk\'. 519 | -- 520 | -- So that means you can't use a lazy recursive contruction like this: 521 | -- 522 | -- > let xs = cons\' c xs in xs 523 | -- 524 | -- You can however use 'cons', as well as 'repeat' and 'cycle', to build 525 | -- infinite byte streams. 526 | cons' :: Word8 -> ByteStream m r -> ByteStream m r 527 | cons' w (Chunk c cs) | B.length c < 16 = Chunk (B.cons w c) cs 528 | cons' w cs = Chunk (B.singleton w) cs 529 | {-# INLINE cons' #-} 530 | 531 | -- | /O(n\/c)/ Append a byte to the end of a 'ByteStream'. 532 | snoc :: Monad m => ByteStream m r -> Word8 -> ByteStream m r 533 | snoc cs w = do -- cs <* singleton w 534 | r <- cs 535 | singleton w 536 | return r 537 | {-# INLINE snoc #-} 538 | 539 | -- | /O(1)/ Extract the first element of a 'ByteStream', which must be non-empty. 540 | head_ :: Monad m => ByteStream m r -> m Word8 541 | head_ (Empty _) = error "head" 542 | head_ (Chunk c bs) = if B.null c 543 | then head_ bs 544 | else return $ B.unsafeHead c 545 | head_ (Go m) = m >>= head_ 546 | {-# INLINABLE head_ #-} 547 | 548 | -- | /O(c)/ Extract the first element of a 'ByteStream', if there is one. 549 | -- Suitable for use with `SP.mapped`: 550 | -- 551 | -- @ 552 | -- S.mapped Q.head :: Stream (Q.ByteStream m) m r -> Stream (Of (Maybe Word8)) m r 553 | -- @ 554 | head :: Monad m => ByteStream m r -> m (Of (Maybe Word8) r) 555 | head (Empty r) = return (Nothing :> r) 556 | head (Chunk c rest) = case B.uncons c of 557 | Nothing -> head rest 558 | Just (w,_) -> do 559 | r <- SP.effects $ toChunks rest 560 | return $! Just w :> r 561 | head (Go m) = m >>= head 562 | {-# INLINABLE head #-} 563 | 564 | -- | /O(1)/ Extract the head and tail of a 'ByteStream', or its return value if 565 | -- it is empty. This is the \'natural\' uncons for an effectful byte stream. 566 | uncons :: Monad m => ByteStream m r -> m (Either r (Word8, ByteStream m r)) 567 | uncons (Chunk c@(B.length -> len) cs) 568 | | len > 0 = let !h = B.unsafeHead c 569 | !t = if len > 1 then Chunk (B.unsafeTail c) cs else cs 570 | in return $ Right (h, t) 571 | | otherwise = uncons cs 572 | uncons (Go m) = m >>= uncons 573 | uncons (Empty r) = return (Left r) 574 | {-# INLINABLE uncons #-} 575 | 576 | -- | The same as `uncons`, will be removed in the next version. 577 | nextByte :: Monad m => ByteStream m r -> m (Either r (Word8, ByteStream m r)) 578 | nextByte = uncons 579 | {-# INLINABLE nextByte #-} 580 | {-# DEPRECATED nextByte "Use uncons instead." #-} 581 | 582 | -- | Like `uncons`, but yields the entire first `B.ByteString` chunk that the 583 | -- stream is holding onto. If there wasn't one, it tries to fetch it. Yields 584 | -- the final @r@ return value when the 'ByteStream' is empty. 585 | unconsChunk :: Monad m => ByteStream m r -> m (Either r (B.ByteString, ByteStream m r)) 586 | unconsChunk (Chunk c cs) 587 | | B.null c = unconsChunk cs 588 | | otherwise = return (Right (c,cs)) 589 | unconsChunk (Go m) = m >>= unconsChunk 590 | unconsChunk (Empty r) = return (Left r) 591 | {-# INLINABLE unconsChunk #-} 592 | 593 | -- | The same as `unconsChunk`, will be removed in the next version. 594 | nextChunk :: Monad m => ByteStream m r -> m (Either r (B.ByteString, ByteStream m r)) 595 | nextChunk = unconsChunk 596 | {-# INLINABLE nextChunk #-} 597 | {-# DEPRECATED nextChunk "Use unconsChunk instead." #-} 598 | 599 | -- | /O(n\/c)/ Extract the last element of a 'ByteStream', which must be finite 600 | -- and non-empty. 601 | last_ :: Monad m => ByteStream m r -> m Word8 602 | last_ (Empty _) = error "Streaming.ByteString.last: empty string" 603 | last_ (Go m) = m >>= last_ 604 | last_ (Chunk c0 cs0) = go c0 cs0 605 | where 606 | go c (Empty _) = if B.null c 607 | then error "Streaming.ByteString.last: empty string" 608 | else return $ unsafeLast c 609 | go _ (Chunk c cs) = go c cs 610 | go x (Go m) = m >>= go x 611 | {-# INLINABLE last_ #-} 612 | 613 | -- | Extract the last element of a `ByteStream`, if possible. Suitable for use 614 | -- with `SP.mapped`: 615 | -- 616 | -- @ 617 | -- S.mapped Q.last :: Streaming (ByteStream m) m r -> Stream (Of (Maybe Word8)) m r 618 | -- @ 619 | last :: Monad m => ByteStream m r -> m (Of (Maybe Word8) r) 620 | last (Empty r) = return (Nothing :> r) 621 | last (Go m) = m >>= last 622 | last (Chunk c0 cs0) = go c0 cs0 623 | where 624 | go c (Empty r) = return (Just (unsafeLast c) :> r) 625 | go _ (Chunk c cs) = go c cs 626 | go x (Go m) = m >>= go x 627 | {-# INLINABLE last #-} 628 | 629 | -- | /O(n\/c)/ Append two `ByteString`s together. 630 | append :: Monad m => ByteStream m r -> ByteStream m s -> ByteStream m s 631 | append xs ys = dematerialize xs (const ys) Chunk Go 632 | {-# INLINE append #-} 633 | 634 | -- --------------------------------------------------------------------- 635 | -- Transformations 636 | 637 | -- | /O(n)/ 'map' @f xs@ is the ByteStream obtained by applying @f@ to each 638 | -- element of @xs@. 639 | map :: Monad m => (Word8 -> Word8) -> ByteStream m r -> ByteStream m r 640 | map f z = dematerialize z Empty (Chunk . B.map f) Go 641 | {-# INLINE map #-} 642 | 643 | -- | @'for' xs f@ applies @f@ to each chunk in the stream, and 644 | -- concatenates the resulting streams. 645 | -- 646 | -- Generalised in 0.2.4 to match @streaming@: the callback's (ignored) 647 | -- return value can be of any type. 648 | -- 649 | -- @since 0.2.3 650 | for :: Monad m => ByteStream m r -> (P.ByteString -> ByteStream m x) -> ByteStream m r 651 | for stream f = case stream of 652 | Empty r -> Empty r 653 | Chunk bs bss -> f bs *> for bss f 654 | Go m -> Go ((`for` f) <$> m) 655 | {-# INLINE for #-} 656 | 657 | -- -- | /O(n)/ 'reverse' @xs@ returns the elements of @xs@ in reverse order. 658 | -- reverse :: ByteString -> ByteString 659 | -- reverse cs0 = rev Empty cs0 660 | -- where rev a Empty = a 661 | -- rev a (Chunk c cs) = rev (Chunk (B.reverse c) a) cs 662 | -- {-# INLINE reverse #-} 663 | 664 | -- | The 'intersperse' function takes a 'Word8' and a 'ByteStream' and 665 | -- \`intersperses\' that byte between the elements of the 'ByteStream'. It is 666 | -- analogous to the intersperse function on Streams. 667 | intersperse :: Monad m => Word8 -> ByteStream m r -> ByteStream m r 668 | intersperse _ (Empty r) = Empty r 669 | intersperse w (Go m) = Go (fmap (intersperse w) m) 670 | intersperse w (Chunk c cs) | B.null c = intersperse w cs 671 | | otherwise = 672 | Chunk (B.intersperse w c) 673 | (dematerialize cs Empty (Chunk . intersperse') Go) 674 | where intersperse' :: P.ByteString -> P.ByteString 675 | intersperse' (B.PS fp o l) 676 | | l > 0 = B.unsafeCreate (2*l) $ \p' -> unsafeWithForeignPtr fp $ \p -> do 677 | poke p' w 678 | B.c_intersperse (p' `plusPtr` 1) (p `plusPtr` o) (fromIntegral l) w 679 | | otherwise = B.empty 680 | {-# INLINABLE intersperse #-} 681 | 682 | -- | 'foldr', applied to a binary operator, a starting value (typically the 683 | -- right-identity of the operator), and a ByteStream, reduces the ByteStream 684 | -- using the binary operator, from right to left. 685 | -- 686 | foldr :: Monad m => (Word8 -> a -> a) -> a -> ByteStream m () -> m a 687 | foldr k = foldrChunks (flip (B.foldr k)) 688 | {-# INLINE foldr #-} 689 | 690 | -- | 'fold_', applied to a binary operator, a starting value (typically the 691 | -- left-identity of the operator), and a ByteStream, reduces the ByteStream 692 | -- using the binary operator, from left to right. We use the style of the foldl 693 | -- library for left folds 694 | fold_ :: Monad m => (x -> Word8 -> x) -> x -> (x -> b) -> ByteStream m () -> m b 695 | fold_ step0 begin finish p0 = loop p0 begin 696 | where 697 | loop p !x = case p of 698 | Chunk bs bss -> loop bss $! B.foldl' step0 x bs 699 | Go m -> m >>= \p' -> loop p' x 700 | Empty _ -> return (finish x) 701 | {-# INLINABLE fold_ #-} 702 | 703 | -- | 'fold' keeps the return value of the left-folded bytestring. Useful for 704 | -- simultaneous folds over a segmented bytestream. 705 | fold :: Monad m => (x -> Word8 -> x) -> x -> (x -> b) -> ByteStream m r -> m (Of b r) 706 | fold step0 begin finish p0 = loop p0 begin 707 | where 708 | loop p !x = case p of 709 | Chunk bs bss -> loop bss $! B.foldl' step0 x bs 710 | Go m -> m >>= \p' -> loop p' x 711 | Empty r -> return (finish x :> r) 712 | {-# INLINABLE fold #-} 713 | 714 | -- --------------------------------------------------------------------- 715 | -- Special folds 716 | 717 | -- /O(n)/ Concatenate a list of ByteStreams. 718 | -- concat :: (Monad m) => [ByteStream m ()] -> ByteStream m () 719 | -- concat css0 = to css0 720 | -- where 721 | -- go css (Empty m') = to css 722 | -- go css (Chunk c cs) = Chunk c (go css cs) 723 | -- go css (Go m) = Go (fmap (go css) m) 724 | -- to [] = Empty () 725 | -- to (cs:css) = go css cs 726 | 727 | -- --------------------------------------------------------------------- 728 | -- Unfolds and replicates 729 | 730 | {-| @'iterate' f x@ returns an infinite ByteStream of repeated applications 731 | -- of @f@ to @x@: 732 | 733 | > iterate f x == [x, f x, f (f x), ...] 734 | 735 | >>> R.stdout $ R.take 50 $ R.iterate succ 39 736 | ()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXY 737 | >>> Q.putStrLn $ Q.take 50 $ Q.iterate succ '\'' 738 | ()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXY 739 | -} 740 | iterate :: (Word8 -> Word8) -> Word8 -> ByteStream m r 741 | iterate f = unfoldr (\x -> case f x of !x' -> Right (x', x')) 742 | {-# INLINABLE iterate #-} 743 | 744 | {- | @'repeat' x@ is an infinite ByteStream, with @x@ the value of every 745 | element. 746 | 747 | >>> R.stdout $ R.take 50 $ R.repeat 60 748 | <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 749 | >>> Q.putStrLn $ Q.take 50 $ Q.repeat 'z' 750 | zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz 751 | -} 752 | repeat :: Word8 -> ByteStream m r 753 | repeat w = cs where cs = Chunk (B.replicate BI.smallChunkSize w) cs 754 | {-# INLINABLE repeat #-} 755 | 756 | {- | 'cycle' ties a finite ByteStream into a circular one, or equivalently, 757 | the infinite repetition of the original ByteStream. For an empty bytestring 758 | (like @return 17@) it of course makes an unproductive loop 759 | 760 | >>> Q.putStrLn $ Q.take 7 $ Q.cycle "y\n" 761 | y 762 | y 763 | y 764 | y 765 | -} 766 | cycle :: Monad m => ByteStream m r -> ByteStream m s 767 | cycle = forever 768 | {-# INLINE cycle #-} 769 | 770 | -- | /O(n)/ The 'unfoldM' function is analogous to the Stream @unfoldr@. 771 | -- 'unfoldM' builds a ByteStream from a seed value. The function takes the 772 | -- element and returns 'Nothing' if it is done producing the ByteStream or 773 | -- returns @'Just' (a,b)@, in which case, @a@ is a prepending to the ByteStream 774 | -- and @b@ is used as the next element in a recursive call. 775 | unfoldM :: Monad m => (a -> Maybe (Word8, a)) -> a -> ByteStream m () 776 | unfoldM f s0 = unfoldChunk 32 s0 777 | where unfoldChunk n s = 778 | case B.unfoldrN n f s of 779 | (c, Nothing) 780 | | B.null c -> Empty () 781 | | otherwise -> Chunk c (Empty ()) 782 | (c, Just s') -> Chunk c (unfoldChunk (n*2) s') 783 | {-# INLINABLE unfoldM #-} 784 | 785 | -- | Like `unfoldM`, but yields a final @r@ when the `Word8` generation is 786 | -- complete. 787 | unfoldr :: (a -> Either r (Word8, a)) -> a -> ByteStream m r 788 | unfoldr f s0 = unfoldChunk 32 s0 789 | where unfoldChunk n s = 790 | case unfoldrNE n f s of 791 | (c, Left r) 792 | | B.null c -> Empty r 793 | | otherwise -> Chunk c (Empty r) 794 | (c, Right s') -> Chunk c (unfoldChunk (n*2) s') 795 | {-# INLINABLE unfoldr #-} 796 | 797 | -- --------------------------------------------------------------------- 798 | -- Substrings 799 | 800 | {-| /O(n\/c)/ 'take' @n@, applied to a ByteStream @xs@, returns the prefix 801 | of @xs@ of length @n@, or @xs@ itself if @n > 'length' xs@. 802 | 803 | Note that in the streaming context this drops the final return value; 804 | 'splitAt' preserves this information, and is sometimes to be preferred. 805 | 806 | >>> Q.putStrLn $ Q.take 8 $ "Is there a God?" >> return True 807 | Is there 808 | >>> Q.putStrLn $ "Is there a God?" >> return True 809 | Is there a God? 810 | True 811 | >>> rest <- Q.putStrLn $ Q.splitAt 8 $ "Is there a God?" >> return True 812 | Is there 813 | >>> Q.effects rest 814 | True 815 | -} 816 | take :: Monad m => Int64 -> ByteStream m r -> ByteStream m () 817 | take i _ | i <= 0 = Empty () 818 | take i cs0 = take' i cs0 819 | where take' 0 _ = Empty () 820 | take' _ (Empty _) = Empty () 821 | take' n (Chunk c cs) = 822 | if n < fromIntegral (B.length c) 823 | then Chunk (B.take (fromIntegral n) c) (Empty ()) 824 | else Chunk c (take' (n - fromIntegral (B.length c)) cs) 825 | take' n (Go m) = Go (fmap (take' n) m) 826 | {-# INLINABLE take #-} 827 | 828 | {-| /O(n\/c)/ 'drop' @n xs@ returns the suffix of @xs@ after the first @n@ 829 | elements, or @[]@ if @n > 'length' xs@. 830 | 831 | >>> Q.putStrLn $ Q.drop 6 "Wisconsin" 832 | sin 833 | >>> Q.putStrLn $ Q.drop 16 "Wisconsin" 834 | 835 | -} 836 | drop :: Monad m => Int64 -> ByteStream m r -> ByteStream m r 837 | drop i p | i <= 0 = p 838 | drop i cs0 = drop' i cs0 839 | where drop' 0 cs = cs 840 | drop' _ (Empty r) = Empty r 841 | drop' n (Chunk c cs) = 842 | if n < fromIntegral (B.length c) 843 | then Chunk (B.drop (fromIntegral n) c) cs 844 | else drop' (n - fromIntegral (B.length c)) cs 845 | drop' n (Go m) = Go (fmap (drop' n) m) 846 | {-# INLINABLE drop #-} 847 | 848 | {-| /O(n\/c)/ 'splitAt' @n xs@ is equivalent to @('take' n xs, 'drop' n xs)@. 849 | 850 | >>> rest <- Q.putStrLn $ Q.splitAt 3 "therapist is a danger to good hyphenation, as Knuth notes" 851 | the 852 | >>> Q.putStrLn $ Q.splitAt 19 rest 853 | rapist is a danger 854 | -} 855 | splitAt :: Monad m => Int64 -> ByteStream m r -> ByteStream m (ByteStream m r) 856 | splitAt i cs0 | i <= 0 = Empty cs0 857 | splitAt i cs0 = splitAt' i cs0 858 | where splitAt' 0 cs = Empty cs 859 | splitAt' _ (Empty r ) = Empty (Empty r) 860 | splitAt' n (Chunk c cs) = 861 | if n < fromIntegral (B.length c) 862 | then Chunk (B.take (fromIntegral n) c) $ 863 | Empty (Chunk (B.drop (fromIntegral n) c) cs) 864 | else Chunk c (splitAt' (n - fromIntegral (B.length c)) cs) 865 | splitAt' n (Go m) = Go (fmap (splitAt' n) m) 866 | {-# INLINABLE splitAt #-} 867 | 868 | -- | 'takeWhile', applied to a predicate @p@ and a ByteStream @xs@, returns the 869 | -- longest prefix (possibly empty) of @xs@ of elements that satisfy @p@. 870 | takeWhile :: Monad m => (Word8 -> Bool) -> ByteStream m r -> ByteStream m () 871 | takeWhile f cs0 = takeWhile' cs0 872 | where 873 | takeWhile' (Empty _) = Empty () 874 | takeWhile' (Go m) = Go $ fmap takeWhile' m 875 | takeWhile' (Chunk c cs) = 876 | case findIndexOrEnd (not . f) c of 877 | 0 -> Empty () 878 | n | n < B.length c -> Chunk (B.take n c) (Empty ()) 879 | | otherwise -> Chunk c (takeWhile' cs) 880 | {-# INLINABLE takeWhile #-} 881 | 882 | -- | 'dropWhile' @p xs@ returns the suffix remaining after 'takeWhile' @p xs@. 883 | dropWhile :: Monad m => (Word8 -> Bool) -> ByteStream m r -> ByteStream m r 884 | dropWhile p = drop' where 885 | drop' bs = case bs of 886 | Empty r -> Empty r 887 | Go m -> Go (fmap drop' m) 888 | Chunk c cs -> case findIndexOrEnd (not . p) c of 889 | 0 -> Chunk c cs 890 | n | n < B.length c -> Chunk (B.drop n c) cs 891 | | otherwise -> drop' cs 892 | {-# INLINABLE dropWhile #-} 893 | 894 | -- | 'break' @p@ is equivalent to @'span' ('not' . p)@. 895 | break :: Monad m => (Word8 -> Bool) -> ByteStream m r -> ByteStream m (ByteStream m r) 896 | break f cs0 = break' cs0 897 | where break' (Empty r) = Empty (Empty r) 898 | break' (Chunk c cs) = 899 | case findIndexOrEnd f c of 900 | 0 -> Empty (Chunk c cs) 901 | n | n < B.length c -> Chunk (B.take n c) $ 902 | Empty (Chunk (B.drop n c) cs) 903 | | otherwise -> Chunk c (break' cs) 904 | break' (Go m) = Go (fmap break' m) 905 | {-# INLINABLE break #-} 906 | 907 | -- | 'span' @p xs@ breaks the ByteStream into two segments. It is equivalent to 908 | -- @('takeWhile' p xs, 'dropWhile' p xs)@. 909 | span :: Monad m => (Word8 -> Bool) -> ByteStream m r -> ByteStream m (ByteStream m r) 910 | span p = break (not . p) 911 | {-# INLINE span #-} 912 | 913 | -- | /O(n)/ Splits a 'ByteStream' into components delimited by separators, where 914 | -- the predicate returns True for a separator element. The resulting components 915 | -- do not contain the separators. Two adjacent separators result in an empty 916 | -- component in the output. eg. 917 | -- 918 | -- > splitWith (=='a') "aabbaca" == ["","","bb","c",""] 919 | -- > splitWith (=='a') [] == [] 920 | splitWith :: Monad m => (Word8 -> Bool) -> ByteStream m r -> Stream (ByteStream m) m r 921 | splitWith _ (Empty r) = Return r 922 | splitWith p (Go m) = Effect $ fmap (splitWith p) m 923 | splitWith p (Chunk c0 cs0) = comb [] (B.splitWith p c0) cs0 924 | where 925 | -- comb :: [P.ByteString] -> [P.ByteString] -> ByteString -> [ByteString] 926 | -- comb acc (s:[]) (Empty r) = Step (revChunks (s:acc) (Return r)) 927 | comb acc [s] (Empty r) = Step $ L.foldl' (flip Chunk) 928 | (Empty (Return r)) 929 | (s:acc) 930 | comb acc [s] (Chunk c cs) = comb (s:acc) (B.splitWith p c) cs 931 | comb acc b (Go m) = Effect (fmap (comb acc b) m) 932 | comb acc (s:ss) cs = Step $ L.foldl' (flip Chunk) 933 | (Empty (comb [] ss cs)) 934 | (s:acc) 935 | comb acc [] (Empty r) = Step $ L.foldl' (flip Chunk) 936 | (Empty (Return r)) 937 | acc 938 | comb acc [] (Chunk c cs) = comb acc (B.splitWith p c) cs 939 | -- comb acc (s:ss) cs = Step (revChunks (s:acc) (comb [] ss cs)) 940 | 941 | {-# INLINABLE splitWith #-} 942 | 943 | -- | /O(n)/ Break a 'ByteStream' into pieces separated by the byte 944 | -- argument, consuming the delimiter. I.e. 945 | -- 946 | -- > split '\n' "a\nb\nd\ne" == ["a","b","d","e"] 947 | -- > split 'a' "aXaXaXa" == ["","X","X","X",""] 948 | -- > split 'x' "x" == ["",""] 949 | -- 950 | -- and 951 | -- 952 | -- > intercalate [c] . split c == id 953 | -- > split == splitWith . (==) 954 | -- 955 | -- As for all splitting functions in this library, this function does not copy 956 | -- the substrings, it just constructs new 'ByteStream's that are slices of the 957 | -- original. 958 | split :: Monad m => Word8 -> ByteStream m r -> Stream (ByteStream m) m r 959 | split w = loop 960 | where 961 | loop !x = case x of 962 | Empty r -> Return r 963 | Go m -> Effect $ fmap loop m 964 | Chunk c0 cs0 -> comb [] (B.split w c0) cs0 965 | comb !acc [] (Empty r) = Step $ revChunks acc (Return r) 966 | comb acc [] (Chunk c cs) = comb acc (B.split w c) cs 967 | comb !acc [s] (Empty r) = Step $ revChunks (s:acc) (Return r) 968 | comb acc [s] (Chunk c cs) = comb (s:acc) (B.split w c) cs 969 | comb acc b (Go m) = Effect (fmap (comb acc b) m) 970 | comb acc (s:ss) cs = Step $ revChunks (s:acc) (comb [] ss cs) 971 | {-# INLINABLE split #-} 972 | 973 | -- | The 'group' function takes a ByteStream and returns a list of ByteStreams 974 | -- such that the concatenation of the result is equal to the argument. Moreover, 975 | -- each sublist in the result contains only equal elements. For example, 976 | -- 977 | -- > group "Mississippi" = ["M","i","ss","i","ss","i","pp","i"] 978 | -- 979 | -- It is a special case of 'groupBy', which allows the programmer to supply 980 | -- their own equality test. 981 | group :: Monad m => ByteStream m r -> Stream (ByteStream m) m r 982 | group = go 983 | where 984 | go (Empty r) = Return r 985 | go (Go m) = Effect $ fmap go m 986 | go (Chunk c cs) 987 | | B.length c == 1 = Step $ to [c] (B.unsafeHead c) cs 988 | | otherwise = Step $ to [B.unsafeTake 1 c] (B.unsafeHead c) (Chunk (B.unsafeTail c) cs) 989 | 990 | to acc !_ (Empty r) = revNonEmptyChunks acc (Empty (Return r)) 991 | to acc !w (Go m) = Go $ to acc w <$> m 992 | to acc !w (Chunk c cs) = case findIndexOrEnd (/= w) c of 993 | 0 -> revNonEmptyChunks acc (Empty (go (Chunk c cs))) 994 | n | n == B.length c -> to (B.unsafeTake n c : acc) w cs 995 | | otherwise -> revNonEmptyChunks (B.unsafeTake n c : acc) (Empty (go (Chunk (B.unsafeDrop n c) cs))) 996 | {-# INLINABLE group #-} 997 | 998 | -- | The 'groupBy' function is a generalized version of 'group'. 999 | groupBy :: Monad m => (Word8 -> Word8 -> Bool) -> ByteStream m r -> Stream (ByteStream m) m r 1000 | groupBy rel = go 1001 | where 1002 | -- go :: ByteStream m r -> Stream (ByteStream m) m r 1003 | go (Empty r) = Return r 1004 | go (Go m) = Effect $ fmap go m 1005 | go (Chunk c cs) 1006 | | B.length c == 1 = Step $ to [c] (B.unsafeHead c) cs 1007 | | otherwise = Step $ to [B.unsafeTake 1 c] (B.unsafeHead c) (Chunk (B.unsafeTail c) cs) 1008 | 1009 | -- to :: [B.ByteString] -> Word8 -> ByteStream m r -> ByteStream m (Stream (ByteStream m) m r) 1010 | to acc !_ (Empty r) = revNonEmptyChunks acc (Empty (Return r)) 1011 | to acc !w (Go m) = Go $ to acc w <$> m 1012 | to acc !w (Chunk c cs) = case findIndexOrEnd (not . rel w) c of 1013 | 0 -> revNonEmptyChunks acc (Empty (go (Chunk c cs))) 1014 | n | n == B.length c -> to (B.unsafeTake n c : acc) w cs 1015 | | otherwise -> revNonEmptyChunks (B.unsafeTake n c : acc) (Empty (go (Chunk (B.unsafeDrop n c) cs))) 1016 | {-# INLINABLE groupBy #-} 1017 | 1018 | -- | /O(n)/ The 'intercalate' function takes a 'ByteStream' and a list of 1019 | -- 'ByteStream's and concatenates the list after interspersing the first 1020 | -- argument between each element of the list. 1021 | intercalate :: Monad m => ByteStream m () -> Stream (ByteStream m) m r -> ByteStream m r 1022 | intercalate s = loop 1023 | where 1024 | loop (Return r) = Empty r 1025 | loop (Effect m) = Go $ fmap loop m 1026 | loop (Step bs) = bs >>= \case 1027 | Return r -> Empty r -- not between final substream and stream end 1028 | x -> s >> loop x 1029 | {-# INLINABLE intercalate #-} 1030 | 1031 | -- | Returns the number of times its argument appears in the `ByteStream`. 1032 | -- 1033 | -- > count = length . elemIndices 1034 | count_ :: Monad m => Word8 -> ByteStream m r -> m Int 1035 | count_ w = fmap (\(n :> _) -> n) . foldlChunks (\n c -> n + fromIntegral (B.count w c)) 0 1036 | {-# INLINE count_ #-} 1037 | 1038 | -- | Returns the number of times its argument appears in the `ByteStream`. 1039 | -- Suitable for use with `SP.mapped`: 1040 | -- 1041 | -- @ 1042 | -- S.mapped (Q.count 37) :: Stream (Q.ByteStream m) m r -> Stream (Of Int) m r 1043 | -- @ 1044 | count :: Monad m => Word8 -> ByteStream m r -> m (Of Int r) 1045 | count w cs = foldlChunks (\n c -> n + fromIntegral (B.count w c)) 0 cs 1046 | {-# INLINE count #-} 1047 | 1048 | -- --------------------------------------------------------------------- 1049 | -- Searching ByteStreams 1050 | 1051 | -- | /O(n)/ 'filter', applied to a predicate and a ByteStream, returns a 1052 | -- ByteStream containing those characters that satisfy the predicate. 1053 | filter :: Monad m => (Word8 -> Bool) -> ByteStream m r -> ByteStream m r 1054 | filter p s = go s 1055 | where 1056 | go (Empty r ) = Empty r 1057 | go (Chunk x xs) = consChunk (B.filter p x) (go xs) 1058 | go (Go m) = Go (fmap go m) 1059 | -- should inspect for null 1060 | {-# INLINABLE filter #-} 1061 | 1062 | -- --------------------------------------------------------------------- 1063 | -- ByteStream IO 1064 | -- 1065 | -- Rule for when to close: is it expected to read the whole file? 1066 | -- If so, close when done. 1067 | -- 1068 | 1069 | -- | Read entire handle contents /lazily/ into a 'ByteStream'. Chunks are read 1070 | -- on demand, in at most @k@-sized chunks. It does not block waiting for a whole 1071 | -- @k@-sized chunk, so if less than @k@ bytes are available then they will be 1072 | -- returned immediately as a smaller chunk. 1073 | -- 1074 | -- Note: the 'Handle' should be placed in binary mode with 1075 | -- 'System.IO.hSetBinaryMode' for 'hGetContentsN' to work correctly. 1076 | hGetContentsN :: MonadIO m => Int -> Handle -> ByteStream m () 1077 | hGetContentsN k h = loop -- TODO close on exceptions 1078 | where 1079 | loop = do 1080 | c <- liftIO (B.hGetSome h k) 1081 | -- only blocks if there is no data available 1082 | if B.null c 1083 | then Empty () 1084 | else Chunk c loop 1085 | {-# INLINABLE hGetContentsN #-} -- very effective inline pragma 1086 | 1087 | -- | Read @n@ bytes into a 'ByteStream', directly from the specified 'Handle', 1088 | -- in chunks of size @k@. 1089 | hGetN :: MonadIO m => Int -> Handle -> Int -> ByteStream m () 1090 | hGetN k h n | n > 0 = readChunks n 1091 | where 1092 | readChunks !i = Go $ do 1093 | c <- liftIO $ B.hGet h (min k i) 1094 | case B.length c of 1095 | 0 -> return $ Empty () 1096 | m -> return $ Chunk c (readChunks (i - m)) 1097 | hGetN _ _ 0 = Empty () 1098 | hGetN _ h n = liftIO $ illegalBufferSize h "hGet" n -- <--- REPAIR !!! 1099 | {-# INLINABLE hGetN #-} 1100 | 1101 | -- | hGetNonBlockingN is similar to 'hGetContentsN', except that it will never 1102 | -- block waiting for data to become available, instead it returns only whatever 1103 | -- data is available. Chunks are read on demand, in @k@-sized chunks. 1104 | hGetNonBlockingN :: MonadIO m => Int -> Handle -> Int -> ByteStream m () 1105 | hGetNonBlockingN k h n | n > 0 = readChunks n 1106 | where 1107 | readChunks !i = Go $ do 1108 | c <- liftIO $ B.hGetNonBlocking h (min k i) 1109 | case B.length c of 1110 | 0 -> return (Empty ()) 1111 | m -> return (Chunk c (readChunks (i - m))) 1112 | hGetNonBlockingN _ _ 0 = Empty () 1113 | hGetNonBlockingN _ h n = liftIO $ illegalBufferSize h "hGetNonBlocking" n 1114 | {-# INLINABLE hGetNonBlockingN #-} 1115 | 1116 | illegalBufferSize :: Handle -> String -> Int -> IO a 1117 | illegalBufferSize handle fn sz = 1118 | ioError (mkIOError illegalOperationErrorType msg (Just handle) Nothing) 1119 | --TODO: System.IO uses InvalidArgument here, but it's not exported :-( 1120 | where 1121 | msg = fn ++ ": illegal ByteStream size " ++ showsPrec 9 sz [] 1122 | {-# INLINABLE illegalBufferSize #-} 1123 | 1124 | -- | Read entire handle contents /lazily/ into a 'ByteStream'. Chunks are read 1125 | -- on demand, using the default chunk size. 1126 | -- 1127 | -- Note: the 'Handle' should be placed in binary mode with 1128 | -- 'System.IO.hSetBinaryMode' for 'hGetContents' to work correctly. 1129 | hGetContents :: MonadIO m => Handle -> ByteStream m () 1130 | hGetContents = hGetContentsN defaultChunkSize 1131 | {-# INLINE hGetContents #-} 1132 | 1133 | -- | Pipes-style nomenclature for 'hGetContents'. 1134 | fromHandle :: MonadIO m => Handle -> ByteStream m () 1135 | fromHandle = hGetContents 1136 | {-# INLINE fromHandle #-} 1137 | 1138 | -- | Pipes-style nomenclature for 'getContents'. 1139 | stdin :: MonadIO m => ByteStream m () 1140 | stdin = hGetContents IO.stdin 1141 | {-# INLINE stdin #-} 1142 | 1143 | -- | Read @n@ bytes into a 'ByteStream', directly from the specified 'Handle'. 1144 | hGet :: MonadIO m => Handle -> Int -> ByteStream m () 1145 | hGet = hGetN defaultChunkSize 1146 | {-# INLINE hGet #-} 1147 | 1148 | -- | hGetNonBlocking is similar to 'hGet', except that it will never block 1149 | -- waiting for data to become available, instead it returns only whatever data 1150 | -- is available. If there is no data available to be read, 'hGetNonBlocking' 1151 | -- returns 'empty'. 1152 | -- 1153 | -- Note: on Windows and with Haskell implementation other than GHC, this 1154 | -- function does not work correctly; it behaves identically to 'hGet'. 1155 | hGetNonBlocking :: MonadIO m => Handle -> Int -> ByteStream m () 1156 | hGetNonBlocking = hGetNonBlockingN defaultChunkSize 1157 | {-# INLINE hGetNonBlocking #-} 1158 | 1159 | -- | Write a 'ByteStream' to a file. Use 1160 | -- 'Control.Monad.Trans.ResourceT.runResourceT' to ensure that the handle is 1161 | -- closed. 1162 | -- 1163 | -- >>> :set -XOverloadedStrings 1164 | -- >>> runResourceT $ Q.writeFile "hello.txt" "Hello world.\nGoodbye world.\n" 1165 | -- >>> :! cat "hello.txt" 1166 | -- Hello world. 1167 | -- Goodbye world. 1168 | -- >>> runResourceT $ Q.writeFile "hello2.txt" $ Q.readFile "hello.txt" 1169 | -- >>> :! cat hello2.txt 1170 | -- Hello world. 1171 | -- Goodbye world. 1172 | writeFile :: MonadResource m => FilePath -> ByteStream m r -> m r 1173 | writeFile f str = do 1174 | (key, handle) <- allocate (openBinaryFile f WriteMode) hClose 1175 | r <- hPut handle str 1176 | release key 1177 | return r 1178 | {-# INLINE writeFile #-} 1179 | 1180 | -- | Read an entire file into a chunked @'ByteStream' IO ()@. The handle will be 1181 | -- held open until EOF is encountered. The block governed by 1182 | -- 'Control.Monad.Trans.Resource.runResourceT' will end with the closing of any 1183 | -- handles opened. 1184 | -- 1185 | -- >>> :! cat hello.txt 1186 | -- Hello world. 1187 | -- Goodbye world. 1188 | -- >>> runResourceT $ Q.stdout $ Q.readFile "hello.txt" 1189 | -- Hello world. 1190 | -- Goodbye world. 1191 | readFile :: MonadResource m => FilePath -> ByteStream m () 1192 | readFile f = bracketByteString (openBinaryFile f ReadMode) hClose hGetContents 1193 | {-# INLINE readFile #-} 1194 | 1195 | -- | Append a 'ByteStream' to a file. Use 1196 | -- 'Control.Monad.Trans.ResourceT.runResourceT' to ensure that the handle is 1197 | -- closed. 1198 | -- 1199 | -- >>> runResourceT $ Q.writeFile "hello.txt" "Hello world.\nGoodbye world.\n" 1200 | -- >>> runResourceT $ Q.stdout $ Q.readFile "hello.txt" 1201 | -- Hello world. 1202 | -- Goodbye world. 1203 | -- >>> runResourceT $ Q.appendFile "hello.txt" "sincerely yours,\nArthur\n" 1204 | -- >>> runResourceT $ Q.stdout $ Q.readFile "hello.txt" 1205 | -- Hello world. 1206 | -- Goodbye world. 1207 | -- sincerely yours, 1208 | -- Arthur 1209 | appendFile :: MonadResource m => FilePath -> ByteStream m r -> m r 1210 | appendFile f str = do 1211 | (key, handle) <- allocate (openBinaryFile f AppendMode) hClose 1212 | r <- hPut handle str 1213 | release key 1214 | return r 1215 | {-# INLINE appendFile #-} 1216 | 1217 | -- | Equivalent to @hGetContents stdin@. Will read /lazily/. 1218 | getContents :: MonadIO m => ByteStream m () 1219 | getContents = hGetContents IO.stdin 1220 | {-# INLINE getContents #-} 1221 | 1222 | -- | Outputs a 'ByteStream' to the specified 'Handle'. 1223 | hPut :: MonadIO m => Handle -> ByteStream m r -> m r 1224 | hPut h cs = dematerialize cs return (\x y -> liftIO (B.hPut h x) >> y) (>>= id) 1225 | {-# INLINE hPut #-} 1226 | 1227 | -- | Pipes nomenclature for 'hPut'. 1228 | toHandle :: MonadIO m => Handle -> ByteStream m r -> m r 1229 | toHandle = hPut 1230 | {-# INLINE toHandle #-} 1231 | 1232 | -- | Pipes-style nomenclature for @putStr@. 1233 | stdout :: MonadIO m => ByteStream m r -> m r 1234 | stdout = hPut IO.stdout 1235 | {-# INLINE stdout #-} 1236 | 1237 | -- -- | Similar to 'hPut' except that it will never block. Instead it returns 1238 | -- any tail that did not get written. This tail may be 'empty' in the case that 1239 | -- the whole string was written, or the whole original string if nothing was 1240 | -- written. Partial writes are also possible. 1241 | -- 1242 | -- Note: on Windows and with Haskell implementation other than GHC, this 1243 | -- function does not work correctly; it behaves identically to 'hPut'. 1244 | -- 1245 | -- hPutNonBlocking :: MonadIO m => Handle -> ByteStream m r -> ByteStream m r 1246 | -- hPutNonBlocking _ (Empty r) = Empty r 1247 | -- hPutNonBlocking h (Go m) = Go $ fmap (hPutNonBlocking h) m 1248 | -- hPutNonBlocking h bs@(Chunk c cs) = do 1249 | -- c' <- lift $ B.hPutNonBlocking h c 1250 | -- case B.length c' of 1251 | -- l' | l' == B.length c -> hPutNonBlocking h cs 1252 | -- 0 -> bs 1253 | -- _ -> Chunk c' cs 1254 | -- {-# INLINABLE hPutNonBlocking #-} 1255 | 1256 | -- | A synonym for @hPut@, for compatibility 1257 | -- 1258 | -- hPutStr :: Handle -> ByteStream IO r -> IO r 1259 | -- hPutStr = hPut 1260 | -- 1261 | -- -- | Write a ByteStream to stdout 1262 | -- putStr :: ByteStream IO r -> IO r 1263 | -- putStr = hPut IO.stdout 1264 | 1265 | -- | The interact function takes a function of type @ByteStream -> ByteStream@ 1266 | -- as its argument. The entire input from the standard input device is passed to 1267 | -- this function as its argument, and the resulting string is output on the 1268 | -- standard output device. 1269 | -- 1270 | -- > interact morph = stdout (morph stdin) 1271 | interact :: (ByteStream IO () -> ByteStream IO r) -> IO r 1272 | interact f = stdout (f stdin) 1273 | {-# INLINE interact #-} 1274 | 1275 | -- -- --------------------------------------------------------------------- 1276 | -- -- Internal utilities 1277 | 1278 | -- | Used in `group` and `groupBy`. 1279 | revNonEmptyChunks :: [P.ByteString] -> ByteStream m r -> ByteStream m r 1280 | revNonEmptyChunks = L.foldl' (\f bs -> Chunk bs . f) id 1281 | {-# INLINE revNonEmptyChunks #-} 1282 | 1283 | -- | Reverse a list of possibly-empty chunks into a lazy ByteString. 1284 | revChunks :: Monad m => [P.ByteString] -> r -> ByteStream m r 1285 | revChunks cs r = L.foldl' (flip Chunk) (Empty r) cs 1286 | {-# INLINE revChunks #-} 1287 | 1288 | -- | Zip a list and a stream-of-byte-streams together. 1289 | zipWithStream 1290 | :: Monad m 1291 | => (forall x . a -> ByteStream m x -> ByteStream m x) 1292 | -> [a] 1293 | -> Stream (ByteStream m) m r 1294 | -> Stream (ByteStream m) m r 1295 | zipWithStream op zs = loop zs 1296 | where 1297 | loop [] !ls = loop zs ls 1298 | loop a@(x:xs) ls = case ls of 1299 | Return r -> Return r 1300 | Step fls -> Step $ fmap (loop xs) (op x fls) 1301 | Effect mls -> Effect $ fmap (loop a) mls 1302 | {-# INLINABLE zipWithStream #-} 1303 | 1304 | -- | Take a builder constructed otherwise and convert it to a genuine streaming 1305 | -- bytestring. 1306 | -- 1307 | -- >>> Q.putStrLn $ Q.toStreamingByteString $ stringUtf8 "哈斯克尔" <> stringUtf8 " " <> integerDec 98 1308 | -- 哈斯克尔 98 1309 | -- 1310 | -- shows 1311 | -- its performance is indistinguishable from @toLazyByteString@ 1312 | toStreamingByteString :: MonadIO m => Builder -> ByteStream m () 1313 | toStreamingByteString = toStreamingByteStringWith 1314 | (safeStrategy BI.smallChunkSize BI.defaultChunkSize) 1315 | {-# INLINE toStreamingByteString #-} 1316 | 1317 | -- | Take a builder and convert it to a genuine streaming bytestring, using a 1318 | -- specific allocation strategy. 1319 | toStreamingByteStringWith :: MonadIO m => AllocationStrategy -> Builder -> ByteStream m () 1320 | toStreamingByteStringWith strategy builder0 = do 1321 | cios <- liftIO (buildStepToCIOS strategy (runBuilder builder0)) 1322 | let loop cios0 = case cios0 of 1323 | Yield1 bs io -> Chunk bs $ do 1324 | cios1 <- liftIO io 1325 | loop cios1 1326 | Finished buf r -> trimmedChunkFromBuffer buf (Empty r) 1327 | trimmedChunkFromBuffer buffer k 1328 | | B.null bs = k 1329 | | 2 * B.length bs < bufferSize buffer = Chunk (B.copy bs) k 1330 | | otherwise = Chunk bs k 1331 | where 1332 | bs = byteStringFromBuffer buffer 1333 | loop cios 1334 | {-# INLINABLE toStreamingByteStringWith #-} 1335 | {-# SPECIALIZE toStreamingByteStringWith :: AllocationStrategy -> Builder -> ByteStream IO () #-} 1336 | 1337 | -- | Concatenate a stream of builders (not a streaming bytestring!) into a 1338 | -- single builder. 1339 | -- 1340 | -- >>> let aa = yield (integerDec 10000) >> yield (string8 " is a number.") >> yield (char8 '\n') 1341 | -- >>> hPutBuilder IO.stdout $ concatBuilders aa 1342 | -- 10000 is a number. 1343 | concatBuilders :: Stream (Of Builder) IO () -> Builder 1344 | concatBuilders p = builder $ \bstep r -> do 1345 | case p of 1346 | Return _ -> runBuilderWith mempty bstep r 1347 | Step (b :> rest) -> runBuilderWith (b `mappend` concatBuilders rest) bstep r 1348 | Effect m -> m >>= \p' -> runBuilderWith (concatBuilders p') bstep r 1349 | {-# INLINABLE concatBuilders #-} 1350 | 1351 | -- | A simple construction of a builder from a 'ByteString'. 1352 | -- 1353 | -- >>> let aaa = "10000 is a number\n" :: Q.ByteString IO () 1354 | -- >>> hPutBuilder IO.stdout $ toBuilder aaa 1355 | -- 10000 is a number 1356 | toBuilder :: ByteStream IO () -> Builder 1357 | toBuilder = concatBuilders . SP.map byteString . toChunks 1358 | {-# INLINABLE toBuilder #-} 1359 | -------------------------------------------------------------------------------- /lib/Streaming/ByteString/Char8.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE BangPatterns #-} 2 | {-# LANGUAGE CPP #-} 3 | {-# LANGUAGE MultiWayIf #-} 4 | {-# LANGUAGE OverloadedStrings #-} 5 | {-# LANGUAGE RankNTypes #-} 6 | {-# LANGUAGE ScopedTypeVariables #-} 7 | {-# LANGUAGE ViewPatterns #-} 8 | 9 | -- | 10 | -- Module : Streaming.ByteString.Char8 11 | -- Copyright : (c) Don Stewart 2006 12 | -- (c) Duncan Coutts 2006-2011 13 | -- (c) Michael Thompson 2015 14 | -- License : BSD-style 15 | -- 16 | -- This library emulates "Data.ByteString.Lazy.Char8" but includes a monadic 17 | -- element and thus at certain points uses a `Stream`/@FreeT@ type in place of 18 | -- lists. See the documentation for "Streaming.ByteString" and the examples 19 | -- of of use to implement simple shell operations 20 | -- . Examples of use 21 | -- with @http-client@, @attoparsec@, @aeson@, @zlib@ etc. can be found in the 22 | -- 'streaming-utils' library. 23 | 24 | module Streaming.ByteString.Char8 25 | ( -- * The @ByteStream@ type 26 | ByteStream 27 | , ByteString 28 | 29 | -- * Introducing and eliminating 'ByteStream's 30 | , empty 31 | , pack 32 | , unpack 33 | , string 34 | , unlines 35 | , unwords 36 | , singleton 37 | , fromChunks 38 | , fromLazy 39 | , fromStrict 40 | , toChunks 41 | , toLazy 42 | , toLazy_ 43 | , toStrict 44 | , toStrict_ 45 | , effects 46 | , copy 47 | , drained 48 | , mwrap 49 | 50 | -- * Transforming ByteStreams 51 | , map 52 | , intercalate 53 | , intersperse 54 | 55 | -- * Basic interface 56 | , cons 57 | , cons' 58 | , snoc 59 | , append 60 | , filter 61 | , head 62 | , head_ 63 | , last 64 | , last_ 65 | , null 66 | , null_ 67 | , nulls 68 | , testNull 69 | , uncons 70 | , nextChar 71 | , skipSomeWS 72 | 73 | -- * Substrings 74 | -- ** Breaking strings 75 | , break 76 | , drop 77 | , dropWhile 78 | , group 79 | , groupBy 80 | , span 81 | , splitAt 82 | , splitWith 83 | , take 84 | , takeWhile 85 | 86 | -- ** Breaking into many substrings 87 | , split 88 | , lines 89 | , lineSplit 90 | , words 91 | 92 | -- ** Special folds 93 | , concat 94 | , denull 95 | 96 | -- * Builders 97 | , toStreamingByteString 98 | 99 | , toStreamingByteStringWith 100 | 101 | , toBuilder 102 | , concatBuilders 103 | 104 | -- * Building ByteStreams 105 | -- ** Infinite ByteStreams 106 | , repeat 107 | , iterate 108 | , cycle 109 | 110 | -- ** Unfolding ByteStreams 111 | , unfoldr 112 | , unfoldM 113 | , reread 114 | 115 | -- * Folds, including support for `Control.Foldl` 116 | -- , foldr 117 | , fold 118 | , fold_ 119 | , length 120 | , length_ 121 | , count 122 | , count_ 123 | , readInt 124 | 125 | -- * I\/O with 'ByteStream's 126 | -- ** Standard input and output 127 | , getContents 128 | , stdin 129 | , stdout 130 | , interact 131 | , putStr 132 | , putStrLn 133 | 134 | -- ** Files 135 | , readFile 136 | , writeFile 137 | , appendFile 138 | 139 | -- ** I\/O with Handles 140 | , fromHandle 141 | , toHandle 142 | , hGet 143 | , hGetContents 144 | , hGetContentsN 145 | , hGetN 146 | , hGetNonBlocking 147 | , hGetNonBlockingN 148 | , hPut 149 | -- , hPutNonBlocking 150 | 151 | -- * Simple chunkwise operations 152 | , unconsChunk 153 | , nextChunk 154 | , chunk 155 | , foldrChunks 156 | , foldlChunks 157 | , chunkFold 158 | , chunkFoldM 159 | , chunkMap 160 | , chunkMapM 161 | , chunkMapM_ 162 | 163 | -- * Etc. 164 | , dematerialize 165 | , materialize 166 | , distribute 167 | , zipWithStream 168 | ) where 169 | 170 | import Prelude hiding 171 | (all, any, appendFile, break, concat, concatMap, cycle, drop, dropWhile, 172 | elem, filter, foldl, foldl1, foldr, foldr1, getContents, getLine, head, 173 | init, interact, iterate, last, length, lines, map, maximum, minimum, 174 | notElem, null, putStr, putStrLn, readFile, repeat, replicate, reverse, 175 | scanl, scanl1, scanr, scanr1, span, splitAt, tail, take, takeWhile, 176 | unlines, unwords, unzip, words, writeFile, zip, zipWith) 177 | import qualified Prelude 178 | 179 | import qualified Data.ByteString as B 180 | import qualified Data.ByteString.Char8 as Char8 181 | import Data.ByteString.Internal (c2w, w2c) 182 | import qualified Data.ByteString.Internal as B 183 | import qualified Data.ByteString.Unsafe as B 184 | 185 | import Streaming hiding (concats, distribute, unfold) 186 | import Streaming.Internal (Stream(..)) 187 | import qualified Streaming.Prelude as SP 188 | 189 | import qualified Streaming.ByteString as Q 190 | import Streaming.ByteString.Internal 191 | 192 | import Streaming.ByteString 193 | (append, appendFile, concat, concatBuilders, cycle, denull, distribute, 194 | drained, drop, effects, empty, fromChunks, fromHandle, fromLazy, 195 | fromStrict, getContents, group, hGet, hGetContents, hGetContentsN, hGetN, 196 | hGetNonBlocking, hGetNonBlockingN, hPut, interact, intercalate, length, 197 | length_, nextChunk, null, null_, nulls, readFile, splitAt, stdin, stdout, 198 | take, testNull, toBuilder, toChunks, toHandle, toLazy, toLazy_, 199 | toStreamingByteString, toStreamingByteStringWith, toStrict, toStrict_, 200 | unconsChunk, writeFile, zipWithStream) 201 | 202 | import Data.Bits ((.&.)) 203 | import Data.Word (Word8) 204 | import Foreign.Ptr 205 | import Foreign.Storable 206 | import qualified System.IO as IO 207 | 208 | -- | Given a stream of bytes, produce a vanilla `Stream` of characters. 209 | unpack :: Monad m => ByteStream m r -> Stream (Of Char) m r 210 | unpack bs = case bs of 211 | Empty r -> Return r 212 | Go m -> Effect (fmap unpack m) 213 | Chunk c cs -> unpackAppendCharsLazy c (unpack cs) 214 | where 215 | unpackAppendCharsLazy :: B.ByteString -> Stream (Of Char) m r -> Stream (Of Char) m r 216 | unpackAppendCharsLazy (B.PS fp off len) xs 217 | | len <= 100 = unpackAppendCharsStrict (B.PS fp off len) xs 218 | | otherwise = unpackAppendCharsStrict (B.PS fp off 100) remainder 219 | where 220 | remainder = unpackAppendCharsLazy (B.PS fp (off+100) (len-100)) xs 221 | 222 | unpackAppendCharsStrict :: B.ByteString -> Stream (Of Char) m r -> Stream (Of Char) m r 223 | unpackAppendCharsStrict (B.PS fp off len) xs = 224 | B.accursedUnutterablePerformIO $ unsafeWithForeignPtr fp $ \base -> do 225 | loop (base `plusPtr` (off-1)) (base `plusPtr` (off-1+len)) xs 226 | where 227 | loop !sentinal !p acc 228 | | p == sentinal = return acc 229 | | otherwise = do x <- peek p 230 | loop sentinal (p `plusPtr` (-1)) (Step (B.w2c x :> acc)) 231 | {-# INLINABLE unpack #-} 232 | 233 | -- | /O(n)/ Convert a stream of separate characters into a packed byte stream. 234 | pack :: Monad m => Stream (Of Char) m r -> ByteStream m r 235 | pack = fromChunks 236 | . mapped (fmap (\(str :> r) -> Char8.pack str :> r) . SP.toList) 237 | . chunksOf 32 238 | {-# INLINABLE pack #-} 239 | 240 | -- | /O(1)/ Cons a 'Char' onto a byte stream. 241 | cons :: Monad m => Char -> ByteStream m r -> ByteStream m r 242 | cons c = Q.cons (c2w c) 243 | {-# INLINE cons #-} 244 | 245 | -- | /O(1)/ Yield a 'Char' as a minimal 'ByteStream' 246 | singleton :: Monad m => Char -> ByteStream m () 247 | singleton = Q.singleton . c2w 248 | {-# INLINE singleton #-} 249 | 250 | -- | /O(1)/ Unlike 'cons', 'cons\'' is 251 | -- strict in the ByteString that we are consing onto. More precisely, it forces 252 | -- the head and the first chunk. It does this because, for space efficiency, it 253 | -- may coalesce the new byte onto the first \'chunk\' rather than starting a 254 | -- new \'chunk\'. 255 | -- 256 | -- So that means you can't use a lazy recursive contruction like this: 257 | -- 258 | -- > let xs = cons\' c xs in xs 259 | -- 260 | -- You can however use 'cons', as well as 'repeat' and 'cycle', to build 261 | -- infinite lazy ByteStreams. 262 | -- 263 | cons' :: Char -> ByteStream m r -> ByteStream m r 264 | cons' c (Chunk bs bss) | B.length bs < 16 = Chunk (B.cons (c2w c) bs) bss 265 | cons' c cs = Chunk (B.singleton (c2w c)) cs 266 | {-# INLINE cons' #-} 267 | -- 268 | -- | /O(n\/c)/ Append a byte to the end of a 'ByteStream' 269 | snoc :: Monad m => ByteStream m r -> Char -> ByteStream m r 270 | snoc cs = Q.snoc cs . c2w 271 | {-# INLINE snoc #-} 272 | 273 | -- | /O(1)/ Extract the first element of a ByteStream, which must be non-empty. 274 | head_ :: Monad m => ByteStream m r -> m Char 275 | head_ = fmap w2c . Q.head_ 276 | {-# INLINE head_ #-} 277 | 278 | -- | /O(1)/ Extract the first element of a ByteStream, if possible. Suitable for 279 | -- use with `SP.mapped`: 280 | -- 281 | -- @ 282 | -- S.mapped Q.head :: Stream (Q.ByteStream m) m r -> Stream (Of (Maybe Char)) m r 283 | -- @ 284 | head :: Monad m => ByteStream m r -> m (Of (Maybe Char) r) 285 | head = fmap (\(m:>r) -> fmap w2c m :> r) . Q.head 286 | {-# INLINE head #-} 287 | 288 | -- | /O(n\/c)/ Extract the last element of a ByteStream, which must be finite 289 | -- and non-empty. 290 | last_ :: Monad m => ByteStream m r -> m Char 291 | last_ = fmap w2c . Q.last_ 292 | {-# INLINE last_ #-} 293 | 294 | -- | Extract the last element of a `ByteStream`, if possible. Suitable for use 295 | -- with `SP.mapped`: 296 | -- 297 | -- @ 298 | -- S.mapped Q.last :: Streaming (ByteStream m) m r -> Stream (Of (Maybe Char)) m r 299 | -- @ 300 | last :: Monad m => ByteStream m r -> m (Of (Maybe Char) r) 301 | last = fmap (\(m:>r) -> fmap w2c m :> r) . Q.last 302 | {-# INLINE last #-} 303 | 304 | -- | The 'groupBy' function is a generalized version of 'group'. 305 | groupBy :: Monad m => (Char -> Char -> Bool) -> ByteStream m r -> Stream (ByteStream m) m r 306 | groupBy rel = Q.groupBy (\w w' -> rel (w2c w) (w2c w')) 307 | {-# INLINE groupBy #-} 308 | 309 | -- | /O(1)/ Extract the head and tail of a 'ByteStream', or its return value if 310 | -- it is empty. This is the \'natural\' uncons for an effectful byte stream. 311 | uncons :: Monad m => ByteStream m r -> m (Either r (Char, ByteStream m r)) 312 | uncons (Chunk c@(B.length -> len) cs) 313 | | len > 0 = let !h = w2c $ B.unsafeHead c 314 | !t = if len > 1 then Chunk (B.unsafeTail c) cs else cs 315 | in return $ Right (h, t) 316 | | otherwise = uncons cs 317 | uncons (Go m) = m >>= uncons 318 | uncons (Empty r) = return (Left r) 319 | {-# INLINABLE uncons #-} 320 | 321 | -- | The same as `uncons`, will be removed in the next version. 322 | nextChar :: Monad m => ByteStream m r -> m (Either r (Char, ByteStream m r)) 323 | nextChar = uncons 324 | {-# INLINABLE nextChar #-} 325 | {-# DEPRECATED nextChar "Use uncons instead." #-} 326 | 327 | -- --------------------------------------------------------------------- 328 | -- Transformations 329 | 330 | -- | /O(n)/ 'map' @f xs@ is the ByteStream obtained by applying @f@ to each 331 | -- element of @xs@. 332 | map :: Monad m => (Char -> Char) -> ByteStream m r -> ByteStream m r 333 | map f = Q.map (c2w . f . w2c) 334 | {-# INLINE map #-} 335 | 336 | -- | The 'intersperse' function takes a 'Char' and a 'ByteStream' and 337 | -- \`intersperses\' that byte between the elements of the 'ByteStream'. 338 | -- It is analogous to the intersperse function on Streams. 339 | intersperse :: Monad m => Char -> ByteStream m r -> ByteStream m r 340 | intersperse c = Q.intersperse (c2w c) 341 | {-# INLINE intersperse #-} 342 | 343 | -- -- --------------------------------------------------------------------- 344 | -- -- Reducing 'ByteStream's 345 | 346 | -- | 'fold_' keeps the return value of the left-folded bytestring. Useful for 347 | -- simultaneous folds over a segmented bytestream. 348 | fold_ :: Monad m => (x -> Char -> x) -> x -> (x -> b) -> ByteStream m () -> m b 349 | fold_ step begin done p0 = loop p0 begin 350 | where 351 | loop p !x = case p of 352 | Chunk bs bss -> loop bss $! Char8.foldl' step x bs 353 | Go m -> m >>= \p' -> loop p' x 354 | Empty _ -> return (done x) 355 | {-# INLINABLE fold_ #-} 356 | 357 | -- | Like `fold_`, but suitable for use with `S.mapped`. 358 | fold :: Monad m => (x -> Char -> x) -> x -> (x -> b) -> ByteStream m r -> m (Of b r) 359 | fold step begin done p0 = loop p0 begin 360 | where 361 | loop p !x = case p of 362 | Chunk bs bss -> loop bss $! Char8.foldl' step x bs 363 | Go m -> m >>= \p' -> loop p' x 364 | Empty r -> return (done x :> r) 365 | {-# INLINABLE fold #-} 366 | 367 | -- --------------------------------------------------------------------- 368 | -- Unfolds and replicates 369 | 370 | -- | @'iterate' f x@ returns an infinite ByteStream of repeated applications 371 | -- of @f@ to @x@: 372 | -- 373 | -- > iterate f x == [x, f x, f (f x), ...] 374 | iterate :: (Char -> Char) -> Char -> ByteStream m r 375 | iterate f c = Q.iterate (c2w . f . w2c) (c2w c) 376 | {-# INLINE iterate #-} 377 | 378 | -- | @'repeat' x@ is an infinite ByteStream, with @x@ the value of every 379 | -- element. 380 | repeat :: Char -> ByteStream m r 381 | repeat = Q.repeat . c2w 382 | {-# INLINE repeat #-} 383 | 384 | -- | 'cycle' ties a finite ByteStream into a circular one, or equivalently, 385 | -- the infinite repetition of the original ByteStream. 386 | -- 387 | -- | /O(n)/ The 'unfoldM' function is analogous to the Stream \'unfoldr\'. 388 | -- 'unfoldM' builds a ByteStream from a seed value. The function takes the 389 | -- element and returns 'Nothing' if it is done producing the ByteStream or 390 | -- returns 'Just' @(a,b)@, in which case, @a@ is a prepending to the ByteStream 391 | -- and @b@ is used as the next element in a recursive call. 392 | unfoldM :: Monad m => (a -> Maybe (Char, a)) -> a -> ByteStream m () 393 | unfoldM f = Q.unfoldM go where 394 | go a = case f a of 395 | Nothing -> Nothing 396 | Just (c,a') -> Just (c2w c, a') 397 | {-# INLINE unfoldM #-} 398 | 399 | -- | Given some pure process that produces characters, generate a stream of 400 | -- bytes. The @r@ produced by the final `Left` will be the return value at the 401 | -- end of the stream. Note also that the `Char` values will be truncated to 402 | -- 8-bits. 403 | unfoldr :: (a -> Either r (Char, a)) -> a -> ByteStream m r 404 | unfoldr step = Q.unfoldr (either Left (\(c,a) -> Right (c2w c,a)) . step) 405 | {-# INLINE unfoldr #-} 406 | 407 | -- | 'takeWhile', applied to a predicate @p@ and a ByteStream @xs@, 408 | -- returns the longest prefix (possibly empty) of @xs@ of elements that 409 | -- satisfy @p@. 410 | takeWhile :: Monad m => (Char -> Bool) -> ByteStream m r -> ByteStream m () 411 | takeWhile f = Q.takeWhile (f . w2c) 412 | {-# INLINE takeWhile #-} 413 | 414 | -- | 'dropWhile' @p xs@ returns the suffix remaining after 'takeWhile' @p xs@. 415 | dropWhile :: Monad m => (Char -> Bool) -> ByteStream m r -> ByteStream m r 416 | dropWhile f = Q.dropWhile (f . w2c) 417 | {-# INLINE dropWhile #-} 418 | 419 | -- | 'break' @p@ is equivalent to @'span' ('not' . p)@. 420 | break :: Monad m => (Char -> Bool) -> ByteStream m r -> ByteStream m (ByteStream m r) 421 | break f = Q.break (f . w2c) 422 | {-# INLINE break #-} 423 | 424 | -- | 'span' @p xs@ breaks the ByteStream into two segments. It is 425 | -- equivalent to @('takeWhile' p xs, 'dropWhile' p xs)@ 426 | span :: Monad m => (Char -> Bool) -> ByteStream m r -> ByteStream m (ByteStream m r) 427 | span p = break (not . p) 428 | {-# INLINE span #-} 429 | 430 | -- | Like `split`, but you can supply your own splitting predicate. 431 | splitWith :: Monad m => (Char -> Bool) -> ByteStream m r -> Stream (ByteStream m) m r 432 | splitWith f = Q.splitWith (f . w2c) 433 | {-# INLINE splitWith #-} 434 | 435 | {- | /O(n)/ Break a 'ByteStream' into pieces separated by the byte 436 | argument, consuming the delimiter. I.e. 437 | 438 | > split '\n' "a\nb\nd\ne" == ["a","b","d","e"] 439 | > split 'a' "aXaXaXa" == ["","X","X","X",""] 440 | > split 'x' "x" == ["",""] 441 | 442 | and 443 | 444 | > intercalate [c] . split c == id 445 | > split == splitWith . (==) 446 | 447 | As for all splitting functions in this library, this function does not copy the 448 | substrings, it just constructs new 'ByteStream's that are slices of the 449 | original. 450 | 451 | >>> Q.stdout $ Q.unlines $ Q.split 'n' "banana peel" 452 | ba 453 | a 454 | a peel 455 | -} 456 | split :: Monad m => Char -> ByteStream m r -> Stream (ByteStream m) m r 457 | split c = Q.split (c2w c) 458 | {-# INLINE split #-} 459 | 460 | -- -- --------------------------------------------------------------------- 461 | -- -- Searching ByteStreams 462 | 463 | -- | /O(n)/ 'filter', applied to a predicate and a ByteStream, 464 | -- returns a ByteStream containing those characters that satisfy the 465 | -- predicate. 466 | filter :: Monad m => (Char -> Bool) -> ByteStream m r -> ByteStream m r 467 | filter p = Q.filter (p . w2c) 468 | {-# INLINE filter #-} 469 | 470 | -- | 'lines' turns a ByteStream into a connected stream of ByteStreams at divide 471 | -- at newline characters. The resulting strings do not contain newlines. This is 472 | -- the genuinely streaming 'lines' which only breaks chunks, and thus never 473 | -- increases the use of memory. 474 | -- 475 | -- Because 'ByteStream's are usually read in binary mode, with no line ending 476 | -- conversion, this function recognizes both @\\n@ and @\\r\\n@ endings 477 | -- (regardless of the current platform). 478 | lines :: forall m r . Monad m => ByteStream m r -> Stream (ByteStream m) m r 479 | lines text0 = loop1 text0 480 | where 481 | loop1 :: ByteStream m r -> Stream (ByteStream m) m r 482 | loop1 text = 483 | case text of 484 | Empty r -> Return r 485 | Go m -> Effect $ fmap loop1 m 486 | Chunk c cs 487 | | B.null c -> loop1 cs 488 | | otherwise -> Step (loop2 False text) 489 | loop2 :: Bool -> ByteStream m r -> ByteStream m (Stream (ByteStream m) m r) 490 | loop2 prevCr text = 491 | case text of 492 | Empty r -> if prevCr 493 | then Chunk (B.singleton 13) (Empty (Return r)) 494 | else Empty (Return r) 495 | Go m -> Go $ fmap (loop2 prevCr) m 496 | Chunk c cs -> 497 | case B.elemIndex 10 c of 498 | Nothing -> if B.null c 499 | then loop2 prevCr cs 500 | else if unsafeLast c == 13 501 | then Chunk (unsafeInit c) (loop2 True cs) 502 | else Chunk c (loop2 False cs) 503 | Just i -> do 504 | let prefixLength = 505 | if i >= 1 && B.unsafeIndex c (i-1) == 13 -- \r\n (dos) 506 | then i-1 507 | else i 508 | rest = 509 | if B.length c > i+1 510 | then Chunk (B.drop (i+1) c) cs 511 | else cs 512 | result = Chunk (B.unsafeTake prefixLength c) (Empty (loop1 rest)) 513 | if i > 0 && prevCr 514 | then Chunk (B.singleton 13) result 515 | else result 516 | {-# INLINABLE lines #-} 517 | 518 | -- | The 'unlines' function restores line breaks between layers. 519 | -- 520 | -- Note that this is not a perfect inverse of 'lines': 521 | -- 522 | -- * @'lines' . 'unlines'@ can produce more strings than there were if some of 523 | -- the \"lines\" had embedded newlines. 524 | -- 525 | -- * @'unlines' . 'lines'@ will replace @\\r\\n@ with @\\n@. 526 | unlines :: Monad m => Stream (ByteStream m) m r -> ByteStream m r 527 | unlines = loop where 528 | loop str = case str of 529 | Return r -> Empty r 530 | Step bstr -> do 531 | st <- bstr 532 | cons' '\n' $ unlines st 533 | Effect m -> Go (fmap unlines m) 534 | {-# INLINABLE unlines #-} 535 | 536 | -- | 'words' breaks a byte stream up into a succession of byte streams 537 | -- corresponding to words, breaking on 'Char's representing white space. This is 538 | -- the genuinely streaming 'words'. A function that returns individual strict 539 | -- bytestrings would concatenate even infinitely long words like @cycle "y"@ in 540 | -- memory. When the stream is known to not contain unreasonably long words, you 541 | -- can write @mapped toStrict . words@ or the like, if strict bytestrings are 542 | -- needed. 543 | words :: Monad m => ByteStream m r -> Stream (ByteStream m) m r 544 | words = filtered . Q.splitWith w8IsSpace 545 | where 546 | filtered stream = case stream of 547 | Return r -> Return r 548 | Effect m -> Effect (fmap filtered m) 549 | Step bs -> Effect $ bs_loop bs 550 | bs_loop bs = case bs of 551 | Empty r -> return $ filtered r 552 | Go m -> m >>= bs_loop 553 | Chunk b bs' -> if B.null b 554 | then bs_loop bs' 555 | else return $ Step $ Chunk b (fmap filtered bs') 556 | {-# INLINABLE words #-} 557 | 558 | -- | The 'unwords' function is analogous to the 'unlines' function, on words. 559 | unwords :: Monad m => Stream (ByteStream m) m r -> ByteStream m r 560 | unwords = intercalate (singleton ' ') 561 | {-# INLINE unwords #-} 562 | 563 | 564 | {- | 'lineSplit' turns a ByteStream into a connected stream of ByteStreams at 565 | divide after a fixed number of newline characters. 566 | Unlike most of the string splitting functions in this library, 567 | this function preserves newlines characters. 568 | 569 | Like 'lines', this function properly handles both @\\n@ and @\\r\\n@ 570 | endings regardless of the current platform. It does not support @\\r@ or 571 | @\\n\\r@ line endings. 572 | 573 | >>> let planets = ["Mercury","Venus","Earth","Mars","Saturn","Jupiter","Neptune","Uranus"] 574 | >>> S.mapsM_ (\x -> putStrLn "Chunk" >> Q.putStrLn x) $ Q.lineSplit 3 $ Q.string $ L.unlines planets 575 | Chunk 576 | Mercury 577 | Venus 578 | Earth 579 | 580 | Chunk 581 | Mars 582 | Saturn 583 | Jupiter 584 | 585 | Chunk 586 | Neptune 587 | Uranus 588 | 589 | Since all characters originally present in the stream are preserved, 590 | this function satisfies the following law: 591 | 592 | > Ɐ n bs. concat (lineSplit n bs) ≅ bs 593 | -} 594 | lineSplit :: forall m r. Monad m 595 | => Int -- ^ number of lines per group 596 | -> ByteStream m r -- ^ stream of bytes 597 | -> Stream (ByteStream m) m r 598 | lineSplit !n0 text0 = loop1 text0 599 | where 600 | n :: Int 601 | !n = max n0 1 602 | loop1 :: ByteStream m r -> Stream (ByteStream m) m r 603 | loop1 text = 604 | case text of 605 | Empty r -> Return r 606 | Go m -> Effect $ fmap loop1 m 607 | Chunk c cs 608 | | B.null c -> loop1 cs 609 | | otherwise -> Step (loop2 0 text) 610 | loop2 :: Int -> ByteStream m r -> ByteStream m (Stream (ByteStream m) m r) 611 | loop2 !counter text = 612 | case text of 613 | Empty r -> Empty (Return r) 614 | Go m -> Go $ fmap (loop2 counter) m 615 | Chunk c cs -> 616 | case nthNewLine c (n - counter) of 617 | Left !i -> Chunk c (loop2 (counter + i) cs) 618 | Right !l -> Chunk (B.unsafeTake l c) 619 | $ Empty $ loop1 $! Chunk (B.unsafeDrop l c) cs 620 | {-# INLINABLE lineSplit #-} 621 | 622 | -- | Return either how many newlines a strict bytestring chunk contains, if 623 | -- fewer than the number requested, or, else the total length of the requested 624 | -- number of lines within the bytestring (equivalently, i.e. the start index of 625 | -- the first /unwanted line/). 626 | nthNewLine :: B.ByteString -- input chunk 627 | -> Int -- remaining number of newlines wanted 628 | -> Either Int Int -- Left count, else Right length 629 | nthNewLine (B.PS fp off len) targetLines = 630 | B.accursedUnutterablePerformIO $ unsafeWithForeignPtr fp $ \base -> 631 | loop (base `plusPtr` off) targetLines 0 len 632 | where 633 | loop :: Ptr Word8 -> Int -> Int -> Int -> IO (Either Int Int) 634 | loop !_ 0 !startIx !_ = return $ Right startIx 635 | loop !p !linesNeeded !startIx !bytesLeft = do 636 | q <- B.memchr p newline $ fromIntegral bytesLeft 637 | if q == nullPtr 638 | then return $ Left $! targetLines - linesNeeded 639 | else let !pnext = q `plusPtr` 1 640 | !skip = pnext `minusPtr` p 641 | !snext = startIx + skip 642 | !bytes = bytesLeft - skip 643 | in loop pnext (linesNeeded - 1) snext bytes 644 | 645 | newline :: Word8 646 | newline = 10 647 | {-# INLINE newline #-} 648 | 649 | -- | Promote a vanilla `String` into a stream. 650 | -- 651 | -- /Note:/ Each `Char` is truncated to 8 bits. 652 | string :: String -> ByteStream m () 653 | string = chunk . B.pack . Prelude.map B.c2w 654 | {-# INLINE string #-} 655 | 656 | -- | Returns the number of times its argument appears in the `ByteStream`. 657 | count_ :: Monad m => Char -> ByteStream m r -> m Int 658 | count_ c = Q.count_ (c2w c) 659 | {-# INLINE count_ #-} 660 | 661 | -- | Returns the number of times its argument appears in the `ByteStream`. 662 | -- Suitable for use with `SP.mapped`: 663 | -- 664 | -- @ 665 | -- S.mapped (Q.count \'a\') :: Stream (Q.ByteStream m) m r -> Stream (Of Int) m r 666 | -- @ 667 | count :: Monad m => Char -> ByteStream m r -> m (Of Int r) 668 | count c = Q.count (c2w c) 669 | {-# INLINE count #-} 670 | 671 | -- | Print a stream of bytes to STDOUT. 672 | putStr :: MonadIO m => ByteStream m r -> m r 673 | putStr = hPut IO.stdout 674 | {-# INLINE putStr #-} 675 | 676 | -- | Print a stream of bytes to STDOUT, ending with a final @\n@. 677 | -- 678 | -- /Note:/ The final @\n@ is not added atomically, and in certain multi-threaded 679 | -- scenarios might not appear where expected. 680 | putStrLn :: MonadIO m => ByteStream m r -> m r 681 | putStrLn bs = hPut IO.stdout (snoc bs '\n') 682 | {-# INLINE putStrLn #-} 683 | 684 | -- | Bounds for Word# multiplication by 10 without overflow, and 685 | -- absolute values of Int bounds. 686 | intmaxWord, intminWord, intmaxQuot10, intmaxRem10, intminQuot10, intminRem10 :: Word 687 | intmaxWord = fromIntegral (maxBound :: Int) 688 | intminWord = fromIntegral (negate (minBound :: Int)) 689 | (intmaxQuot10, intmaxRem10) = intmaxWord `quotRem` 10 690 | (intminQuot10, intminRem10) = intminWord `quotRem` 10 691 | 692 | -- Predicate to test whether a 'Word8' value is either ASCII whitespace, 693 | -- or a unicode NBSP (U+00A0). Optimised for ASCII text, with spaces 694 | -- as the most frequent whitespace characters. 695 | w8IsSpace :: Word8 -> Bool 696 | w8IsSpace = \ !w8 -> 697 | -- Avoid the cost of narrowing arithmetic results to Word8, 698 | -- the conversion from Word8 to Word is free. 699 | let w :: Word 700 | !w = fromIntegral w8 701 | in w .&. 0x50 == 0 -- Quick non-wsp filter 702 | && w - 0x21 > 0x7e -- 2nd non-wsp filter 703 | && ( w == 0x20 -- SP 704 | || w - 0x09 < 5 -- HT, NL, VT, FF, CR 705 | || w == 0xa0 ) -- NBSP 706 | {-# INLINE w8IsSpace #-} 707 | 708 | -- | Try to position the stream at the next non-whitespace input, by 709 | -- skipping leading whitespace. Only a /reasonable/ quantity of 710 | -- whitespace will be skipped before giving up and returning the rest 711 | -- of the stream with any remaining whitespace. Limiting the amount of 712 | -- whitespace consumed is a safety mechanism to avoid looping forever 713 | -- on a never-ending stream of whitespace from an untrusted source. 714 | -- For unconditional dropping of all leading whitespace, use `dropWhile` 715 | -- with a suitable predicate. 716 | skipSomeWS :: Monad m => ByteStream m r -> ByteStream m r 717 | {-# INLINE skipSomeWS #-} 718 | skipSomeWS = go 0 719 | where 720 | go !n (Chunk c cs) 721 | | k <- B.dropWhile w8IsSpace c 722 | , not $ B.null k = Chunk k cs 723 | | n' <- n + B.length c 724 | , n' < defaultChunkSize = go n' cs 725 | | otherwise = cs 726 | go !n (Go m) = Go $ go n <$> m 727 | go _ r = r 728 | 729 | -- | Try to read an 'Int' value from the 'ByteString', returning 730 | -- @m (Compose (Just val :> str))@ on success, where @val@ is the value 731 | -- read and @str@ is the rest of the input stream. If the stream of 732 | -- digits decodes to a value larger than can be represented by an 'Int', 733 | -- the returned value will be @m (Compose (Nothing :> str))@, where the 734 | -- content of @str@ is the same as the original stream, but some of the 735 | -- monadic effects may already have taken place, so the original stream 736 | -- MUST NOT be used. To read the remaining data, you MUST use the 737 | -- returned @str@. 738 | -- 739 | -- This function will not read an /unreasonably/ long stream of leading 740 | -- zero digits when trying to decode a number. When reading the first 741 | -- non-zero digit would require requesting a new chunk and ~32KB of 742 | -- leading zeros have already been read, the conversion is aborted and 743 | -- 'Nothing' is returned, along with the overly long run of leading 744 | -- zeros (and any initial explicit plus or minus sign). 745 | -- 746 | -- 'readInt' does not ignore leading whitespace, the value must start 747 | -- immediately at the beginning of the input stream. Use 'skipSomeWS' 748 | -- if you want to skip a /reasonable/ quantity of leading whitespace. 749 | -- 750 | -- ==== __Example__ 751 | -- >>> getCompose <$> (readInt . skipSomeWS) stream >>= \case 752 | -- >>> Just n :> rest -> print n >> gladly rest 753 | -- >>> Nothing :> rest -> sadly rest 754 | -- 755 | readInt :: Monad m 756 | => ByteStream m r 757 | -> m (Compose (Of (Maybe Int)) (ByteStream m) r) 758 | {-# INLINABLE readInt #-} 759 | readInt = start 760 | where 761 | nada str = return $! Compose $ Nothing :> str 762 | 763 | start bs@(Chunk c cs) 764 | | B.null c = start cs 765 | | w <- B.unsafeHead c 766 | = if | w - 0x30 <= 9 -> readDec True Nothing bs 767 | | let rest = Chunk (B.tail c) cs 768 | -> if | w == 0x2b -> readDec True (Just w) rest 769 | | w == 0x2d -> readDec False (Just w) rest 770 | | otherwise -> nada bs 771 | start (Go m) = m >>= start 772 | start bs@(Empty _) = nada bs 773 | 774 | -- | Read an 'Int' without overflow. If an overflow is about to take 775 | -- place or no number is found, the original input is recovered from any 776 | -- initial explicit sign, the accumulated pre-overflow value and the 777 | -- number of digits consumed prior to overflow detection. 778 | -- 779 | -- In order to avoid reading an unreasonable number of zero bytes before 780 | -- ultimately reporting an overflow, a limit of ~32kB is imposed on the 781 | -- number of bytes to read before giving up on /unreasonably long/ input 782 | -- that is padded with so many zeros, that it could only be a memory 783 | -- exhaustion attack. Callers who want to trim very long runs of 784 | -- zeros could note the sign, and skip leading zeros before calling 785 | -- function. Few if any should want that. 786 | {-# INLINE readDec #-} 787 | readDec !positive signByte = loop 0 0 788 | where 789 | loop !nbytes !acc = \ str -> case str of 790 | Empty _ -> result nbytes acc str 791 | Go m -> m >>= loop nbytes acc 792 | Chunk c cs 793 | | !l <- B.length c 794 | , l > 0 -> case accumWord acc c of 795 | (0, !_, !inrange) 796 | | inrange 797 | -- no more digits found 798 | -> result nbytes acc str 799 | | otherwise 800 | -- Overlow on first digit of chunk 801 | -> overflow nbytes acc str 802 | (!n, !a, !inrange) 803 | | False <- inrange 804 | -- result out of 'Int' range 805 | -> overflow nbytes acc str 806 | | n < l, !t <- B.drop n c 807 | -- input not entirely digits 808 | -> result (nbytes + n) a $ Chunk t cs 809 | | a > 0 || nbytes + n < defaultChunkSize 810 | -- if all zeros, not yet too many 811 | -> loop (nbytes + n) a cs 812 | | otherwise 813 | -- too many zeros, bail out with sign 814 | -> overflow nbytes acc str 815 | | otherwise 816 | -- skip empty segment 817 | -> loop nbytes acc cs 818 | 819 | -- | Process as many digits as we can, returning the additional 820 | -- number of digits found, the updated accumulater, and whether 821 | -- the input decimal did not overflow prior to processing all 822 | -- the provided digits (end of input or non-digit encountered). 823 | accumWord acc (B.PS fp off len) = 824 | B.accursedUnutterablePerformIO $ do 825 | unsafeWithForeignPtr fp $ \p -> do 826 | let ptr = p `plusPtr` off 827 | end = ptr `plusPtr` len 828 | x@(!_, !_, !_) <- if positive 829 | then digits intmaxQuot10 intmaxRem10 end ptr 0 acc 830 | else digits intminQuot10 intminRem10 end ptr 0 acc 831 | return x 832 | where 833 | digits !maxq !maxr !e !ptr = go ptr 834 | where 835 | go :: Ptr Word8 -> Int -> Word -> IO (Int, Word, Bool) 836 | go !p !b !a | p == e = return (b, a, True) 837 | go !p !b !a = do 838 | !byte <- peek p 839 | let !w = byte - 0x30 840 | !d = fromIntegral w 841 | if | w > 9 842 | -- No more digits 843 | -> return (b, a, True) 844 | | a < maxq 845 | -- Look for more 846 | -> go (p `plusPtr` 1) (b + 1) (a * 10 + d) 847 | | a > maxq 848 | -- overflow 849 | -> return (b, a, False) 850 | | d <= maxr 851 | -- Ideally this will be the last digit 852 | -> go (p `plusPtr` 1) (b + 1) (a * 10 + d) 853 | | otherwise 854 | -- overflow 855 | -> return (b, a, False) 856 | 857 | -- | Plausible success, provided we got at least one digit! 858 | result !nbytes !acc str 859 | | nbytes > 0, !i <- w2int acc = return $! Compose $ Just i :> str 860 | | otherwise = overflow nbytes acc str -- just the sign perhaps? 861 | 862 | -- This assumes that @negate . fromIntegral@ correctly produces 863 | -- @minBound :: Int@ when given its positive 'Word' value as an 864 | -- input. This is true in both 2s-complement and 1s-complement 865 | -- arithmetic, so seems like a safe bet. Tests cover this case, 866 | -- though the CI may not run on sufficiently exotic CPUs. 867 | w2int !n | positive = fromIntegral n 868 | | otherwise = negate $! fromIntegral n 869 | 870 | -- | Reconstruct any consumed input, and report failure 871 | overflow 0 _ str = case signByte of 872 | Nothing -> return $ Compose $ Nothing :> str 873 | Just w -> return $ Compose $ Nothing :> Chunk (B.singleton w) str 874 | overflow !nbytes !acc str = 875 | let !c = overflowBytes nbytes acc 876 | in return $! Compose $ Nothing :> Chunk c str 877 | 878 | -- | Reconstruct an @nbytes@-byte prefix consisting of digits 879 | -- from the accumulated value @acc@, with sufficiently many 880 | -- leading zeros to match the original input length. This 881 | -- relies on decimal numbers (leading zeros aside) having a 882 | -- unique representation. Doing this for potentially mixed-case 883 | -- hexadecimal input would require holding on to the input data, 884 | -- which would noticeably hurt performance. 885 | overflowBytes :: Int -> Word -> B.ByteString 886 | overflowBytes !nbytes !acc = 887 | B.unsafeCreate (nbytes + signlen) $ \p -> do 888 | let end = p `plusPtr` (signlen - 1) 889 | ptr = p `plusPtr` (nbytes + signlen - 1) 890 | go end ptr acc 891 | mapM_ (poke p) signByte 892 | where 893 | signlen = if signByte == Nothing then 0 else 1 894 | 895 | go :: Ptr Word8 -> Ptr Word8 -> Word -> IO () 896 | go end !ptr !_ | end == ptr = return () 897 | go end !ptr !a = do 898 | let (q, r) = a `quotRem` 10 899 | poke ptr $ fromIntegral r + 0x30 900 | go end (ptr `plusPtr` (-1)) q 901 | -------------------------------------------------------------------------------- /lib/Streaming/ByteString/Internal.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE BangPatterns #-} 2 | {-# LANGUAGE CPP #-} 3 | {-# LANGUAGE FlexibleInstances #-} 4 | {-# LANGUAGE GADTs #-} 5 | {-# LANGUAGE MagicHash #-} 6 | {-# LANGUAGE MultiParamTypeClasses #-} 7 | {-# LANGUAGE RankNTypes #-} 8 | {-# LANGUAGE TypeOperators #-} 9 | {-# LANGUAGE UnboxedTuples #-} 10 | {-# LANGUAGE UndecidableInstances #-} 11 | {-# LANGUAGE UnliftedFFITypes #-} 12 | 13 | -- | 14 | -- Module : Streaming.ByteString.Internal 15 | -- Copyright : (c) Don Stewart 2006 16 | -- (c) Duncan Coutts 2006-2011 17 | -- (c) Michael Thompson 2015 18 | -- License : BSD-style 19 | 20 | module Streaming.ByteString.Internal 21 | ( ByteStream(..) 22 | , ByteString 23 | , consChunk 24 | , chunkOverhead 25 | , defaultChunkSize 26 | , materialize 27 | , dematerialize 28 | , foldrChunks 29 | , foldlChunks 30 | 31 | , foldrChunksM 32 | , foldlChunksM 33 | , chunkFold 34 | , chunkFoldM 35 | , chunkMap 36 | , chunkMapM 37 | , chunkMapM_ 38 | , unfoldMChunks 39 | , unfoldrChunks 40 | 41 | , packChars 42 | , packBytes 43 | , unpackBytes 44 | , chunk 45 | , smallChunkSize 46 | , mwrap 47 | , unfoldrNE 48 | , reread 49 | , unsafeLast 50 | , unsafeInit 51 | , copy 52 | , findIndexOrEnd 53 | 54 | -- * ResourceT help 55 | , bracketByteString 56 | 57 | -- * Re-export from GHC 9.0 58 | , unsafeWithForeignPtr 59 | ) where 60 | 61 | import Control.Monad 62 | import Control.Monad.Morph 63 | import Control.Monad.Trans 64 | import Prelude hiding 65 | (all, any, appendFile, break, concat, concatMap, cycle, drop, dropWhile, 66 | elem, filter, foldl, foldl1, foldr, foldr1, getContents, getLine, head, 67 | init, interact, iterate, last, length, lines, map, maximum, minimum, 68 | notElem, null, putStr, putStrLn, readFile, repeat, replicate, reverse, 69 | scanl, scanl1, scanr, scanr1, span, splitAt, tail, take, takeWhile, 70 | unlines, unzip, writeFile, zip, zipWith) 71 | import qualified Prelude 72 | 73 | #if !MIN_VERSION_base(4,11,0) 74 | import Data.Semigroup 75 | #endif 76 | 77 | import qualified Data.ByteString as B 78 | import qualified Data.ByteString.Internal as B 79 | 80 | import Streaming (Of(..)) 81 | import Streaming.Internal hiding (concats) 82 | import qualified Streaming.Prelude as SP 83 | 84 | import Data.String 85 | import Foreign.Ptr 86 | import Foreign.Storable 87 | import GHC.Types (SPEC(..)) 88 | 89 | import Data.Functor.Identity 90 | import Data.Word 91 | import GHC.Base (realWorld#) 92 | import GHC.IO (IO(IO)) 93 | import System.IO.Unsafe (unsafePerformIO) 94 | 95 | import Control.Monad.Base 96 | import Control.Monad.Catch (MonadCatch(..)) 97 | import Control.Monad.Trans.Resource 98 | 99 | #if MIN_VERSION_base(4,15,0) 100 | import GHC.ForeignPtr (unsafeWithForeignPtr) 101 | #else 102 | import Foreign.ForeignPtr (ForeignPtr, withForeignPtr) 103 | #endif 104 | 105 | #if !MIN_VERSION_base(4,15,0) 106 | -- | Synonym of 'withForeignPtr' for GHC prior to 9.0. 107 | unsafeWithForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b 108 | unsafeWithForeignPtr = withForeignPtr 109 | #endif 110 | 111 | -- | A type alias for back-compatibility. 112 | type ByteString = ByteStream 113 | {-# DEPRECATED ByteString "Use ByteStream instead." #-} 114 | 115 | -- | A space-efficient representation of a succession of 'Word8' vectors, 116 | -- supporting many efficient operations. 117 | -- 118 | -- An effectful 'ByteStream' contains 8-bit bytes, or by using the operations 119 | -- from "Streaming.ByteString.Char8" it can be interpreted as containing 120 | -- 8-bit characters. 121 | data ByteStream m r = 122 | Empty r 123 | | Chunk {-# UNPACK #-} !B.ByteString (ByteStream m r ) 124 | | Go (m (ByteStream m r )) 125 | 126 | instance Monad m => Functor (ByteStream m) where 127 | fmap f x = case x of 128 | Empty a -> Empty (f a) 129 | Chunk bs bss -> Chunk bs (fmap f bss) 130 | Go mbss -> Go (fmap (fmap f) mbss) 131 | 132 | instance Monad m => Applicative (ByteStream m) where 133 | pure = Empty 134 | {-# INLINE pure #-} 135 | bf <*> bx = do {f <- bf; x <- bx; Empty (f x)} 136 | {-# INLINE (<*>) #-} 137 | x0 *> y = loop SPEC x0 where 138 | loop !_ x = case x of -- this seems to be insanely effective 139 | Empty _ -> y 140 | Chunk a b -> Chunk a (loop SPEC b) 141 | Go m -> Go (fmap (loop SPEC) m) 142 | {-# INLINEABLE (*>) #-} 143 | 144 | instance Monad m => Monad (ByteStream m) where 145 | return = pure 146 | {-# INLINE return #-} 147 | (>>) = (*>) 148 | {-# INLINE (>>) #-} 149 | x >>= f = 150 | -- case x of 151 | -- Empty a -> f a 152 | -- Chunk bs bss -> Chunk bs (bss >>= f) 153 | -- Go mbss -> Go (fmap (>>= f) mbss) 154 | loop SPEC2 x where -- unlike >> this SPEC seems pointless 155 | loop !_ y = case y of 156 | Empty a -> f a 157 | Chunk bs bss -> Chunk bs (loop SPEC bss) 158 | Go mbss -> Go (fmap (loop SPEC) mbss) 159 | {-# INLINEABLE (>>=) #-} 160 | 161 | instance MonadIO m => MonadIO (ByteStream m) where 162 | liftIO io = Go (fmap Empty (liftIO io)) 163 | {-# INLINE liftIO #-} 164 | 165 | instance MonadTrans ByteStream where 166 | lift ma = Go $ fmap Empty ma 167 | {-# INLINE lift #-} 168 | 169 | instance MFunctor ByteStream where 170 | hoist phi bs = case bs of 171 | Empty r -> Empty r 172 | Chunk bs' rest -> Chunk bs' (hoist phi rest) 173 | Go m -> Go (phi (fmap (hoist phi) m)) 174 | {-# INLINABLE hoist #-} 175 | 176 | instance (r ~ ()) => IsString (ByteStream m r) where 177 | fromString = chunk . B.pack . Prelude.map B.c2w 178 | {-# INLINE fromString #-} 179 | 180 | instance (m ~ Identity, Show r) => Show (ByteStream m r) where 181 | show bs0 = case bs0 of -- the implementation this instance deserves ... 182 | Empty r -> "Empty (" ++ show r ++ ")" 183 | Go (Identity bs') -> "Go (Identity (" ++ show bs' ++ "))" 184 | Chunk bs'' bs -> "Chunk " ++ show bs'' ++ " (" ++ show bs ++ ")" 185 | 186 | instance (Semigroup r, Monad m) => Semigroup (ByteStream m r) where 187 | (<>) = liftM2 (<>) 188 | {-# INLINE (<>) #-} 189 | 190 | instance (Monoid r, Monad m) => Monoid (ByteStream m r) where 191 | mempty = Empty mempty 192 | {-# INLINE mempty #-} 193 | #if MIN_VERSION_base(4,11,0) 194 | mappend = (<>) 195 | #else 196 | mappend = liftM2 mappend 197 | #endif 198 | {-# INLINE mappend #-} 199 | 200 | instance (MonadBase b m) => MonadBase b (ByteStream m) where 201 | liftBase = mwrap . fmap return . liftBase 202 | {-# INLINE liftBase #-} 203 | 204 | instance (MonadThrow m) => MonadThrow (ByteStream m) where 205 | throwM = lift . throwM 206 | {-# INLINE throwM #-} 207 | 208 | instance (MonadCatch m) => MonadCatch (ByteStream m) where 209 | catch str f = go str 210 | where 211 | go p = case p of 212 | Chunk bs rest -> Chunk bs (go rest) 213 | Empty r -> Empty r 214 | Go m -> Go (catch (do 215 | p' <- m 216 | return (go p')) 217 | (return . f)) 218 | {-# INLINABLE catch #-} 219 | 220 | instance (MonadResource m) => MonadResource (ByteStream m) where 221 | liftResourceT = lift . liftResourceT 222 | {-# INLINE liftResourceT #-} 223 | 224 | -- | Like @bracket@, but specialized for `ByteString`. 225 | bracketByteString :: MonadResource m => IO a -> (a -> IO ()) -> (a -> ByteStream m b) -> ByteStream m b 226 | bracketByteString alloc free inside = do 227 | (key, seed) <- lift (allocate alloc free) 228 | clean key (inside seed) 229 | where 230 | clean key = loop where 231 | loop str = case str of 232 | Empty r -> Go (release key >> return (Empty r)) 233 | Go m -> Go (fmap loop m) 234 | Chunk bs rest -> Chunk bs (loop rest) 235 | {-# INLINABLE bracketByteString #-} 236 | 237 | -- -- ------------------------------------------------------------------------ 238 | -- 239 | -- | Smart constructor for 'Chunk'. 240 | consChunk :: B.ByteString -> ByteStream m r -> ByteStream m r 241 | consChunk c@(B.PS _ _ len) cs 242 | | len == 0 = cs 243 | | otherwise = Chunk c cs 244 | {-# INLINE consChunk #-} 245 | 246 | -- | Yield-style smart constructor for 'Chunk'. 247 | chunk :: B.ByteString -> ByteStream m () 248 | chunk bs = consChunk bs (Empty ()) 249 | {-# INLINE chunk #-} 250 | 251 | 252 | {- | Reconceive an effect that results in an effectful bytestring as an effectful bytestring. 253 | Compare Streaming.mwrap. The closest equivalent of 254 | 255 | >>> Streaming.wrap :: f (Stream f m r) -> Stream f m r 256 | 257 | is here @consChunk@. @mwrap@ is the smart constructor for the internal @Go@ constructor. 258 | -} 259 | mwrap :: m (ByteStream m r) -> ByteStream m r 260 | mwrap = Go 261 | {-# INLINE mwrap #-} 262 | 263 | -- | Construct a succession of chunks from its Church encoding (compare @GHC.Exts.build@) 264 | materialize :: (forall x . (r -> x) -> (B.ByteString -> x -> x) -> (m x -> x) -> x) -> ByteStream m r 265 | materialize phi = phi Empty Chunk Go 266 | {-# INLINE[0] materialize #-} 267 | 268 | -- | Resolve a succession of chunks into its Church encoding; this is 269 | -- not a safe operation; it is equivalent to exposing the constructors 270 | dematerialize :: Monad m 271 | => ByteStream m r 272 | -> (forall x . (r -> x) -> (B.ByteString -> x -> x) -> (m x -> x) -> x) 273 | dematerialize x0 nil cons mwrap' = loop SPEC x0 274 | where 275 | loop !_ x = case x of 276 | Empty r -> nil r 277 | Chunk b bs -> cons b (loop SPEC bs ) 278 | Go ms -> mwrap' (fmap (loop SPEC) ms) 279 | {-# INLINE [1] dematerialize #-} 280 | 281 | {-# RULES 282 | "dematerialize/materialize" forall (phi :: forall b . (r -> b) -> (B.ByteString -> b -> b) -> (m b -> b) -> b). dematerialize (materialize phi) = phi ; 283 | #-} 284 | ------------------------------------------------------------------------ 285 | 286 | -- The representation uses lists of packed chunks. When we have to convert from 287 | -- a lazy list to the chunked representation, then by default we use this 288 | -- chunk size. Some functions give you more control over the chunk size. 289 | -- 290 | -- Measurements here: 291 | -- http://www.cse.unsw.edu.au/~dons/tmp/chunksize_v_cache.png 292 | -- 293 | -- indicate that a value around 0.5 to 1 x your L2 cache is best. 294 | -- The following value assumes people have something greater than 128k, 295 | -- and need to share the cache with other programs. 296 | 297 | -- | The chunk size used for I\/O. Currently set to 32k, less the memory management overhead 298 | defaultChunkSize :: Int 299 | defaultChunkSize = 32 * k - chunkOverhead 300 | where k = 1024 301 | {-# INLINE defaultChunkSize #-} 302 | -- | The recommended chunk size. Currently set to 4k, less the memory management overhead 303 | smallChunkSize :: Int 304 | smallChunkSize = 4 * k - chunkOverhead 305 | where k = 1024 306 | {-# INLINE smallChunkSize #-} 307 | 308 | -- | The memory management overhead. Currently this is tuned for GHC only. 309 | chunkOverhead :: Int 310 | chunkOverhead = 2 * sizeOf (undefined :: Int) 311 | {-# INLINE chunkOverhead #-} 312 | 313 | -- | Packing and unpacking from lists 314 | -- packBytes' :: Monad m => [Word8] -> ByteString m () 315 | -- packBytes' cs0 = 316 | -- packChunks 32 cs0 317 | -- where 318 | -- packChunks n cs = case B.packUptoLenBytes n cs of 319 | -- (bs, []) -> Chunk bs (Empty ()) 320 | -- (bs, cs') -> Chunk bs (packChunks (min (n * 2) BI.smallChunkSize) cs') 321 | -- -- packUptoLenBytes :: Int -> [Word8] -> (ByteString, [Word8]) 322 | -- packUptoLenBytes len xs0 = 323 | -- accursedUnutterablePerformIO (createUptoN' len $ \p -> go p len xs0) 324 | -- where 325 | -- go !_ !n [] = return (len-n, []) 326 | -- go !_ !0 xs = return (len, xs) 327 | -- go !p !n (x:xs) = poke p x >> go (p `plusPtr` 1) (n-1) xs 328 | -- createUptoN' :: Int -> (Ptr Word8 -> IO (Int, a)) -> IO (B.ByteString, a) 329 | -- createUptoN' l f = do 330 | -- fp <- B.mallocByteString l 331 | -- (l', res) <- withForeignPtr fp $ \p -> f p 332 | -- assert (l' <= l) $ return (B.PS fp 0 l', res) 333 | -- {-# INLINABLE packBytes' #-} 334 | 335 | -- | Convert a `Stream` of pure `Word8` into a chunked 'ByteStream'. 336 | packBytes :: Monad m => Stream (Of Word8) m r -> ByteStream m r 337 | packBytes cs0 = do 338 | -- XXX: Why 32? It seems like a rather small chunk size, wouldn't 339 | -- smallChunkSize make a better choice? 340 | (bytes :> rest) <- lift $ SP.toList $ SP.splitAt 32 cs0 341 | case bytes of 342 | [] -> case rest of 343 | Return r -> Empty r 344 | Step as -> packBytes (Step as) -- these two pattern matches 345 | Effect m -> Go $ fmap packBytes m -- should be avoided. 346 | _ -> Chunk (B.packBytes bytes) (packBytes rest) 347 | {-# INLINABLE packBytes #-} 348 | 349 | -- | Convert a vanilla `Stream` of characters into a stream of bytes. 350 | -- 351 | -- /Note:/ Each `Char` value is truncated to 8 bits. 352 | packChars :: Monad m => Stream (Of Char) m r -> ByteStream m r 353 | packChars str = do 354 | -- XXX: Why 32? It seems like a rather small chunk size, wouldn't 355 | -- smallChunkSize make a better choice? 356 | -- 357 | -- We avoid the cost of converting the stream of Chars to a stream 358 | -- of Word8 (passed to packBytes), and instead pass the original 359 | -- `Char` arrays to 'B.packChars', which will be more efficient, 360 | -- the conversion there will be essentially free. 361 | (chars :> rest) <- lift $ SP.toList $ SP.splitAt 32 str 362 | case chars of 363 | [] -> case rest of 364 | Return r -> Empty r 365 | Step as -> packChars (Step as) -- these two pattern matches 366 | Effect m -> Go $ fmap packChars m -- should be avoided. 367 | _ -> Chunk (B.packChars chars) (packChars rest) 368 | {-# INLINABLE packChars #-} 369 | 370 | -- | The reverse of `packChars`. Given a stream of bytes, produce a `Stream` 371 | -- individual bytes. 372 | unpackBytes :: Monad m => ByteStream m r -> Stream (Of Word8) m r 373 | unpackBytes bss = dematerialize bss Return unpackAppendBytesLazy Effect 374 | where 375 | unpackAppendBytesLazy :: B.ByteString -> Stream (Of Word8) m r -> Stream (Of Word8) m r 376 | unpackAppendBytesLazy b@(B.PS fp off len) xs 377 | | len <= 100 = unpackAppendBytesStrict b xs 378 | | otherwise = unpackAppendBytesStrict (B.PS fp off 100) remainder 379 | where 380 | remainder = unpackAppendBytesLazy (B.PS fp (off+100) (len-100)) xs 381 | 382 | unpackAppendBytesStrict :: B.ByteString -> Stream (Of Word8) m r -> Stream (Of Word8) m r 383 | unpackAppendBytesStrict (B.PS fp off len) xs = 384 | B.accursedUnutterablePerformIO $ unsafeWithForeignPtr fp $ \base -> 385 | loop (base `plusPtr` (off-1)) (base `plusPtr` (off-1+len)) xs 386 | where 387 | loop !sentinel !p acc 388 | | p == sentinel = return acc 389 | | otherwise = do 390 | x <- peek p 391 | loop sentinel (p `plusPtr` (-1)) (Step (x :> acc)) 392 | {-# INLINABLE unpackBytes #-} 393 | 394 | -- | Copied from Data.ByteString.Unsafe for compatibility with older bytestring. 395 | unsafeLast :: B.ByteString -> Word8 396 | unsafeLast (B.PS x s l) = 397 | accursedUnutterablePerformIO $ unsafeWithForeignPtr x $ \p -> peekByteOff p (s+l-1) 398 | where 399 | accursedUnutterablePerformIO (IO m) = case m realWorld# of (# _, r #) -> r 400 | {-# INLINE unsafeLast #-} 401 | 402 | -- | Copied from Data.ByteString.Unsafe for compatibility with older bytestring. 403 | unsafeInit :: B.ByteString -> B.ByteString 404 | unsafeInit (B.PS ps s l) = B.PS ps s (l-1) 405 | {-# INLINE unsafeInit #-} 406 | 407 | -- | Consume the chunks of an effectful `ByteString` with a natural right fold. 408 | foldrChunks :: Monad m => (B.ByteString -> a -> a) -> a -> ByteStream m r -> m a 409 | foldrChunks step nil bs = dematerialize bs 410 | (\_ -> return nil) 411 | (fmap . step) 412 | join 413 | {-# INLINE foldrChunks #-} 414 | 415 | -- | Consume the chunks of an effectful `ByteString` with a left fold. Suitable 416 | -- for use with `SP.mapped`. 417 | foldlChunks :: Monad m => (a -> B.ByteString -> a) -> a -> ByteStream m r -> m (Of a r) 418 | foldlChunks f z = go z 419 | where go a _ | a `seq` False = undefined 420 | go a (Empty r) = return (a :> r) 421 | go a (Chunk c cs) = go (f a c) cs 422 | go a (Go m) = m >>= go a 423 | {-# INLINABLE foldlChunks #-} 424 | 425 | -- | Instead of mapping over each `Word8` or `Char`, map over each strict 426 | -- `B.ByteString` chunk in the stream. 427 | chunkMap :: Monad m => (B.ByteString -> B.ByteString) -> ByteStream m r -> ByteStream m r 428 | chunkMap f bs = dematerialize bs return (Chunk . f) Go 429 | {-# INLINE chunkMap #-} 430 | 431 | -- | Like `chunkMap`, but map effectfully. 432 | chunkMapM :: Monad m => (B.ByteString -> m B.ByteString) -> ByteStream m r -> ByteStream m r 433 | chunkMapM f bs = dematerialize bs return (\bs' bss -> Go (fmap (`Chunk` bss) (f bs'))) Go 434 | {-# INLINE chunkMapM #-} 435 | 436 | -- | Like `chunkMapM`, but discard the result of each effectful mapping. 437 | chunkMapM_ :: Monad m => (B.ByteString -> m x) -> ByteStream m r -> m r 438 | chunkMapM_ f bs = dematerialize bs return (\bs' mr -> f bs' >> mr) join 439 | {-# INLINE chunkMapM_ #-} 440 | 441 | -- | @chunkFold@ is preferable to @foldlChunks@ since it is an appropriate 442 | -- argument for @Control.Foldl.purely@ which permits many folds and sinks to be 443 | -- run simultaneously on one bytestream. 444 | chunkFold :: Monad m => (x -> B.ByteString -> x) -> x -> (x -> a) -> ByteStream m r -> m (Of a r) 445 | chunkFold step begin done = go begin 446 | where go a _ | a `seq` False = undefined 447 | go a (Empty r) = return (done a :> r) 448 | go a (Chunk c cs) = go (step a c) cs 449 | go a (Go m) = m >>= go a 450 | {-# INLINABLE chunkFold #-} 451 | 452 | -- | 'chunkFoldM' is preferable to 'foldlChunksM' since it is an appropriate 453 | -- argument for 'Control.Foldl.impurely' which permits many folds and sinks to 454 | -- be run simultaneously on one bytestream. 455 | chunkFoldM :: Monad m => (x -> B.ByteString -> m x) -> m x -> (x -> m a) -> ByteStream m r -> m (Of a r) 456 | chunkFoldM step begin done bs = begin >>= go bs 457 | where 458 | go str !x = case str of 459 | Empty r -> done x >>= \a -> return (a :> r) 460 | Chunk c cs -> step x c >>= go cs 461 | Go m -> m >>= \str' -> go str' x 462 | {-# INLINABLE chunkFoldM #-} 463 | 464 | -- | Like `foldlChunks`, but fold effectfully. Suitable for use with `SP.mapped`. 465 | foldlChunksM :: Monad m => (a -> B.ByteString -> m a) -> m a -> ByteStream m r -> m (Of a r) 466 | foldlChunksM f z bs = z >>= \a -> go a bs 467 | where 468 | go !a str = case str of 469 | Empty r -> return (a :> r) 470 | Chunk c cs -> f a c >>= \aa -> go aa cs 471 | Go m -> m >>= go a 472 | {-# INLINABLE foldlChunksM #-} 473 | 474 | -- | Consume the chunks of an effectful ByteString with a natural right monadic fold. 475 | foldrChunksM :: Monad m => (B.ByteString -> m a -> m a) -> m a -> ByteStream m r -> m a 476 | foldrChunksM step nil bs = dematerialize bs (const nil) step join 477 | {-# INLINE foldrChunksM #-} 478 | 479 | -- | Internal utility for @unfoldr@. 480 | unfoldrNE :: Int -> (a -> Either r (Word8, a)) -> a -> (B.ByteString, Either r a) 481 | unfoldrNE i f x0 482 | | i < 0 = (B.empty, Right x0) 483 | | otherwise = unsafePerformIO $ B.createAndTrim' i $ \p -> go p x0 0 484 | where 485 | go !p !x !n 486 | | n == i = return (0, n, Right x) 487 | | otherwise = case f x of 488 | Left r -> return (0, n, Left r) 489 | Right (w,x') -> do poke p w 490 | go (p `plusPtr` 1) x' (n+1) 491 | {-# INLINE unfoldrNE #-} 492 | 493 | -- | Given some continual monadic action that produces strict `B.ByteString` 494 | -- chunks, produce a stream of bytes. 495 | unfoldMChunks :: Monad m => (s -> m (Maybe (B.ByteString, s))) -> s -> ByteStream m () 496 | unfoldMChunks step = loop where 497 | loop s = Go $ do 498 | m <- step s 499 | case m of 500 | Nothing -> return (Empty ()) 501 | Just (bs,s') -> return $ Chunk bs (loop s') 502 | {-# INLINABLE unfoldMChunks #-} 503 | 504 | -- | Like `unfoldMChunks`, but feed through a final @r@ return value. 505 | unfoldrChunks :: Monad m => (s -> m (Either r (B.ByteString, s))) -> s -> ByteStream m r 506 | unfoldrChunks step = loop where 507 | loop !s = Go $ do 508 | m <- step s 509 | case m of 510 | Left r -> return (Empty r) 511 | Right (bs,s') -> return $ Chunk bs (loop s') 512 | {-# INLINABLE unfoldrChunks #-} 513 | 514 | -- | Stream chunks from something that contains @m (Maybe ByteString)@ until it 515 | -- returns 'Nothing'. 'reread' is of particular use rendering @io-streams@ input 516 | -- streams as byte streams in the present sense. 517 | -- 518 | -- > import qualified Data.ByteString as B 519 | -- > import qualified System.IO.Streams as S 520 | -- > Q.reread S.read :: S.InputStream B.ByteString -> Q.ByteStream IO () 521 | -- > Q.reread (liftIO . S.read) :: MonadIO m => S.InputStream B.ByteString -> Q.ByteStream m () 522 | -- 523 | -- The other direction here is 524 | -- 525 | -- > S.unfoldM Q.unconsChunk :: Q.ByteString IO r -> IO (S.InputStream B.ByteString) 526 | reread :: Monad m => (s -> m (Maybe B.ByteString)) -> s -> ByteStream m () 527 | reread step s = loop where 528 | loop = Go $ do 529 | m <- step s 530 | case m of 531 | Nothing -> return (Empty ()) 532 | Just a -> return (Chunk a loop) 533 | {-# INLINEABLE reread #-} 534 | 535 | {-| Make the information in a bytestring available to more than one eliminating fold, e.g. 536 | 537 | >>> Q.count 'l' $ Q.count 'o' $ Q.copy $ "hello\nworld" 538 | 3 :> (2 :> ()) 539 | 540 | >>> Q.length $ Q.count 'l' $ Q.count 'o' $ Q.copy $ Q.copy "hello\nworld" 541 | 11 :> (3 :> (2 :> ())) 542 | 543 | >>> runResourceT $ Q.writeFile "hello2.txt" $ Q.writeFile "hello1.txt" $ Q.copy $ "hello\nworld\n" 544 | >>> :! cat hello2.txt 545 | hello 546 | world 547 | >>> :! cat hello1.txt 548 | hello 549 | world 550 | 551 | This sort of manipulation could as well be acheived by combining folds - using 552 | @Control.Foldl@ for example. But any sort of manipulation can be involved in 553 | the fold. Here are a couple of trivial complications involving splitting by lines: 554 | 555 | >>> let doubleLines = Q.unlines . maps (<* Q.chunk "\n" ) . Q.lines 556 | >>> let emphasize = Q.unlines . maps (<* Q.chunk "!" ) . Q.lines 557 | >>> runResourceT $ Q.writeFile "hello2.txt" $ emphasize $ Q.writeFile "hello1.txt" $ doubleLines $ Q.copy $ "hello\nworld" 558 | >>> :! cat hello2.txt 559 | hello! 560 | world! 561 | >>> :! cat hello1.txt 562 | hello 563 | 564 | world 565 | 566 | 567 | As with the parallel operations in @Streaming.Prelude@, we have 568 | 569 | > Q.effects . Q.copy = id 570 | > hoist Q.effects . Q.copy = id 571 | 572 | The duplication does not by itself involve the copying of bytestring chunks; 573 | it just makes two references to each chunk as it arises. This does, however 574 | double the number of constructors associated with each chunk. 575 | 576 | -} 577 | copy :: Monad m => ByteStream m r -> ByteStream (ByteStream m) r 578 | copy = loop where 579 | loop str = case str of 580 | Empty r -> Empty r 581 | Go m -> Go (fmap loop (lift m)) 582 | Chunk bs rest -> Chunk bs (Go (Chunk bs (Empty (loop rest)))) 583 | {-# INLINABLE copy #-} 584 | 585 | -- | 'findIndexOrEnd' is a variant of findIndex, that returns the length of the 586 | -- string if no element is found, rather than Nothing. 587 | findIndexOrEnd :: (Word8 -> Bool) -> B.ByteString -> Int 588 | findIndexOrEnd k (B.PS x s l) = 589 | B.accursedUnutterablePerformIO $ 590 | unsafeWithForeignPtr x $ \f -> go (f `plusPtr` s) 0 591 | where 592 | go !ptr !n | n >= l = return l 593 | | otherwise = do w <- peek ptr 594 | if k w 595 | then return n 596 | else go (ptr `plusPtr` 1) (n+1) 597 | {-# INLINABLE findIndexOrEnd #-} 598 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | resolver: lts-23.8 2 | # ghc-options: 3 | # $locals: -fmax-relevant-binds=0 -funclutter-valid-hole-fits -haddock 4 | 5 | -------------------------------------------------------------------------------- /streaming-bytestring.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: >=1.10 2 | name: streaming-bytestring 3 | version: 0.3.4 4 | synopsis: Fast, effectful byte streams. 5 | description: 6 | This library enables fast and safe streaming of byte data, in either @Word8@ or 7 | @Char@ form. It is a core addition to the 8 | and avoids the usual pitfalls of combinbing lazy @ByteString@s with lazy @IO@. 9 | . 10 | We follow the philosophy shared by @streaming@ that "the best API is the one 11 | you already know". Thus this library mirrors the API of the @bytestring@ 12 | library as closely as possible. 13 | . 14 | See the module documentation and the README for more information. 15 | 16 | license: BSD3 17 | license-file: LICENSE 18 | author: michaelt 19 | maintainer: 20 | andrew.thaddeus@gmail.com, what_is_it_to_do_anything@yahoo.com, colin@fosskers.ca 21 | 22 | -- copyright: 23 | category: Data, Pipes, Streaming 24 | build-type: Simple 25 | extra-source-files: 26 | README.md 27 | CHANGELOG.md 28 | tests/sample.txt 29 | tests/groupBy.txt 30 | 31 | stability: Experimental 32 | homepage: https://github.com/haskell-streaming/streaming-bytestring 33 | bug-reports: 34 | https://github.com/haskell-streaming/streaming-bytestring/issues 35 | 36 | tested-with: 37 | GHC ==8.0.2 38 | || ==8.2.2 39 | || ==8.4.4 40 | || ==8.6.5 41 | || ==8.8.4 42 | || ==8.10.3 43 | || ==9.0.2 44 | || ==9.2.8 45 | || ==9.4.8 46 | || ==9.6.6 47 | || ==9.8.4 48 | 49 | source-repository head 50 | type: git 51 | location: https://github.com/haskell-streaming/streaming-bytestring 52 | 53 | library 54 | default-language: Haskell2010 55 | hs-source-dirs: lib 56 | ghc-options: -Wall -O2 57 | exposed-modules: 58 | Data.ByteString.Streaming 59 | Data.ByteString.Streaming.Char8 60 | Data.ByteString.Streaming.Internal 61 | Streaming.ByteString 62 | Streaming.ByteString.Char8 63 | Streaming.ByteString.Internal 64 | 65 | -- other-modules: 66 | other-extensions: 67 | BangPatterns 68 | CPP 69 | DeriveDataTypeable 70 | ForeignFunctionInterface 71 | Unsafe 72 | 73 | build-depends: 74 | base >=4.9 && <5.0 75 | , bytestring >=0.10.4 && <0.13 76 | , deepseq >=1.4 && <1.6 77 | , exceptions >=0.8 && <0.11 78 | , ghc-prim >=0.4 && <0.14 79 | , mmorph >=1.0 && <1.3 80 | , mtl >=2.2 && <2.4 81 | , resourcet >=1.1 && <1.4 82 | , streaming >=0.1.4.0 && <0.3 83 | , transformers >=0.4 && <0.7 84 | , transformers-base >=0.4 && <0.5 85 | 86 | if impl(ghc <8.0) 87 | build-depends: 88 | semigroups >=0.18 && <0.19 89 | 90 | test-suite test 91 | default-language: Haskell2010 92 | type: exitcode-stdio-1.0 93 | hs-source-dirs: tests 94 | main-is: Test.hs 95 | build-depends: 96 | base >=4.9 && <5 97 | , bytestring >=0.10.4 && <0.13 98 | , resourcet >=1.1 && <1.4 99 | , smallcheck >=1.1.1 100 | , streaming >=0.1.4.0 && <0.3 101 | , streaming-bytestring 102 | , tasty >=0.11.0.4 103 | , tasty-hunit >=0.9 104 | , tasty-smallcheck >=0.8.1 105 | , transformers >=0.3 && <0.7 106 | -------------------------------------------------------------------------------- /tests/Test.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE LambdaCase #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | 4 | module Main ( main ) where 5 | 6 | import Control.Monad.Trans.Resource (runResourceT) 7 | import qualified Data.ByteString.Char8 as B 8 | import qualified Data.ByteString.Lazy 9 | import qualified Data.ByteString.Lazy.Char8 as BL 10 | import Data.Function (on) 11 | import Data.Functor.Compose (Compose(..)) 12 | import Data.Functor.Identity 13 | import qualified Data.IORef as IOR 14 | import qualified Data.List as L 15 | import Data.String (fromString) 16 | import qualified Streaming as SM 17 | import Streaming (Of(..)) 18 | import qualified Streaming.ByteString as Q 19 | import qualified Streaming.ByteString.Char8 as Q8 20 | import qualified Streaming.ByteString.Internal as QI 21 | import qualified Streaming.Prelude as S 22 | import System.IO 23 | import Test.SmallCheck.Series 24 | import Test.Tasty 25 | import Test.Tasty.HUnit 26 | import Test.Tasty.SmallCheck 27 | import Text.Printf (printf) 28 | 29 | listOf :: Monad m => Series m a -> Series m [a] 30 | listOf a = decDepth $ 31 | pure [] \/ ((:) <$> a <~> listOf a) 32 | 33 | strSeries :: Monad m => Series m String 34 | strSeries = listOf (generate $ const ['a', 'b', '\n']) 35 | 36 | strSeriesCrlf :: Monad m => Series m String 37 | strSeriesCrlf = L.concat <$> listOf (generate $ const ["a", "b", "\r\n"]) 38 | 39 | chunksSeries :: Monad m => Series m [String] 40 | chunksSeries = listOf strSeries 41 | 42 | nats :: Monad m => Series m Int 43 | nats = generate $ \d -> [1..d] 44 | 45 | fromChunks :: [String] -> Q8.ByteStream Identity () 46 | fromChunks = Q8.fromChunks . S.each . map B.pack 47 | 48 | unix2dos :: String -> String 49 | unix2dos = concatMap $ \c -> if c == '\n' then "\r\n" else [c] 50 | 51 | unpackToString :: Q8.ByteStream Identity () -> String 52 | unpackToString = runIdentity . S.toList_ . Q8.unpack 53 | 54 | sLines :: Q8.ByteStream Identity () -> [B.ByteString] 55 | sLines 56 | = runIdentity 57 | . S.toList_ 58 | . S.mapped Q8.toStrict 59 | . Q8.lines 60 | 61 | noNullChunks :: S.Stream (Q8.ByteStream Identity) Identity () -> Bool 62 | noNullChunks = SM.streamFold (\() -> True) runIdentity go 63 | where 64 | go :: Q8.ByteStream Identity Bool -> Bool 65 | go (QI.Empty b) = b 66 | go (QI.Chunk bs sbs) = not (B.null bs) && go sbs 67 | go (QI.Go (Identity sbs)) = go sbs 68 | 69 | handleIsOpen :: Assertion 70 | handleIsOpen = do 71 | h <- openBinaryFile "tests/sample.txt" ReadMode 72 | hIsOpen h >>= assertBool "Expected file handle to be open!" 73 | l <- Q8.length_ $ Q8.hGetContents h 74 | l @?= 73 75 | hIsOpen h >>= assertBool "Still expected file handle to be open!" 76 | 77 | groupCrash :: Assertion 78 | groupCrash = do 79 | a <- runResourceT . S.sum_ . SM.mapsM Q8.length . Q8.group $ Q8.readFile "tests/groupBy.txt" 80 | a @?= 39925 81 | b <- runResourceT . S.sum_ . SM.mapsM Q8.length . Q8.groupBy (\_ _ -> True) $ Q8.readFile "tests/groupBy.txt" 82 | b @?= 39925 83 | 84 | groupCharOrder :: Assertion 85 | groupCharOrder = do 86 | a <- S.toList_ . SM.mapsM Q8.toLazy $ Q8.group $ Q8.fromLazy "1234" 87 | a @?= (["1", "2", "3", "4"] :: [BL.ByteString]) 88 | b <- S.toList_ . SM.mapsM Q8.toLazy $ Q8.group $ Q8.fromLazy "1122" 89 | b @?= (["11", "22"] :: [BL.ByteString]) 90 | 91 | groupByCharOrder :: Assertion 92 | groupByCharOrder = do 93 | -- What about when everything fits into one group? 94 | y <- S.toList_ . SM.mapsM Q8.toLazy $ Q8.groupBy (\_ _ -> True) $ Q8.fromLazy "abcd" 95 | y @?= ["abcd"] 96 | -- Prove it's not an issue with the Char-based wrapper. 97 | z <- S.toList_ . SM.mapsM Q.toLazy $ Q.groupBy (\a b -> a - 1 == b) $ Q.fromLazy "98764321" 98 | z @?= ["98", "76", "43", "21"] 99 | -- Char-based variant 100 | a <- S.toList_ . SM.mapsM Q8.toLazy $ Q8.groupBy (\a b -> succ a == b) $ Q8.fromLazy "12346789" 101 | a @?= ["12", "34", "67", "89"] 102 | b <- S.toList_ . SM.mapsM Q8.toLazy $ Q8.groupBy (on (==) (== '5')) $ Q8.fromLazy "5678" 103 | b @?= ["5", "678"] 104 | 105 | goodFindIndex :: Assertion 106 | goodFindIndex = do 107 | assertBool "Expected the length of the string" $ QI.findIndexOrEnd (const False) "1234" == 4 108 | assertBool "Expected 0" $ QI.findIndexOrEnd (const True) "1234" == 0 109 | 110 | firstI :: Assertion 111 | firstI = do 112 | l <- runResourceT 113 | . S.length_ -- IO Int 114 | . S.filter (== 'i') 115 | . S.concat -- Stream (Of Char) IO () 116 | . S.mapped Q8.head -- Stream (Of (Maybe Char)) IO () 117 | . Q8.denull -- Stream (ByteStream IO) IO () 118 | . Q8.lines -- Stream (ByteStream IO) IO () 119 | $ Q8.readFile "tests/groupBy.txt" -- ByteStream IO () 120 | l @?= 57 121 | 122 | emptyChunks :: Assertion 123 | emptyChunks = do 124 | bs <- Q.toLazy_ $ QI.chunkMap (const mempty) "bar" 125 | assertBool "Expected empty chunks" $ Data.ByteString.Lazy.null bs 126 | 127 | readIntCases :: Assertion 128 | readIntCases = do 129 | let imax = maxBound :: Int 130 | imin = minBound :: Int 131 | imax1 = fromIntegral imax + 1 :: Integer 132 | imax10 = fromIntegral imax + 10 :: Integer 133 | imin1 = fromIntegral imin - 1 :: Integer 134 | imin10 = fromIntegral imin - 10 :: Integer 135 | smax = B.pack $ show imax 136 | smin = B.pack $ show imin 137 | smax1 = B.pack $ show imax1 138 | smax10 = B.pack $ show imax10 139 | smin1 = B.pack $ show imin1 140 | smin10 = B.pack $ show imin10 141 | maxfill = QI.defaultChunkSize 142 | cnt <- IOR.newIORef 0 -- number of effects in stream. 143 | -- Empty input 144 | IOR.writeIORef cnt 1 145 | res <- Q8.readInt 146 | $ QI.Chunk "" 147 | $ addEffect cnt 148 | $ QI.Chunk "" 149 | $ QI.Empty 0 150 | check cnt res Nothing ("" :> 0) 151 | -- Basic unsigned 152 | IOR.writeIORef cnt 1 153 | res <- Q8.readInt 154 | $ QI.Chunk "123" 155 | $ addEffect cnt 156 | $ QI.Empty 1 157 | check cnt res (Just 123) ("" :> 1) 158 | -- Basic negative 159 | IOR.writeIORef cnt 2 160 | res <- Q8.readInt 161 | $ QI.Chunk "-123" 162 | $ addEffect cnt 163 | $ QI.Chunk "456+789" 164 | $ addEffect cnt 165 | $ QI.Empty 2 166 | check cnt res (Just (-123456)) ("+789" :> 2) 167 | -- minBound with leading whitespace 168 | IOR.writeIORef cnt 4 169 | res <- readIntSkip 170 | $ QI.Chunk " \t\n\v\f\r\xa0" 171 | $ addEffect cnt 172 | $ QI.Chunk (B.take 4 smin) 173 | $ addEffect cnt 174 | $ QI.Chunk (B.drop 4 smin) 175 | $ addEffect cnt 176 | $ QI.Chunk "-42" 177 | $ addEffect cnt 178 | $ QI.Empty 3 179 | check cnt res (Just imin) ("-42" :> 3) 180 | -- maxBound with leading whitespace 181 | IOR.writeIORef cnt 4 182 | res <- readIntSkip 183 | $ QI.Chunk " \t\n\v\f\r\xa0" 184 | $ addEffect cnt 185 | $ QI.Chunk (B.take 4 smax) 186 | $ addEffect cnt 187 | $ QI.Chunk (B.drop 4 smax) 188 | $ addEffect cnt 189 | $ QI.Chunk "+42" 190 | $ addEffect cnt 191 | $ QI.Empty 4 192 | check cnt res (Just imax) ("+42" :> 4) 193 | -- minbound-1 with whitespace 194 | IOR.writeIORef cnt 4 195 | res <- readIntSkip 196 | $ QI.Chunk " \t\n\v\f\r\xa0" 197 | $ addEffect cnt 198 | $ QI.Chunk (B.take 4 smin1) 199 | $ addEffect cnt 200 | $ QI.Chunk (B.drop 4 smin1) 201 | $ addEffect cnt 202 | $ QI.Chunk "" 203 | $ addEffect cnt 204 | $ QI.Empty 5 205 | check cnt res Nothing (smin1 :> 5) 206 | -- maxbound+1 with whitespace 207 | IOR.writeIORef cnt 4 208 | res <- readIntSkip 209 | $ QI.Chunk " \t\n\v\f\r\xa0" 210 | $ addEffect cnt 211 | $ QI.Chunk (B.take 4 smax1) 212 | $ addEffect cnt 213 | $ QI.Chunk (B.drop 4 smax1) 214 | $ addEffect cnt 215 | $ QI.Chunk "" 216 | $ addEffect cnt 217 | $ QI.Empty 6 218 | check cnt res Nothing (smax1 :> 6) 219 | -- maxBound with explicit plus sign 220 | IOR.writeIORef cnt 2 221 | res <- readIntSkip 222 | $ QI.Chunk " +" 223 | $ addEffect cnt 224 | $ QI.Chunk smax 225 | $ QI.Chunk "tail" 226 | $ addEffect cnt 227 | $ QI.Empty 7 228 | check cnt res (Just imax) ("tail" :> 7) 229 | -- maxBound with almost excessive leading whitepace/zeros 230 | IOR.writeIORef cnt 4 231 | res <- readIntSkip 232 | $ QI.Chunk (B.replicate (maxfill-1) ' ') 233 | $ addEffect cnt 234 | $ QI.Chunk " +" 235 | $ QI.Chunk (B.replicate (maxfill-1) '0') 236 | $ addEffect cnt 237 | $ QI.Chunk ("000000" `B.append` smax) 238 | $ addEffect cnt 239 | $ QI.Chunk "tail" 240 | $ addEffect cnt 241 | $ QI.Empty 8 242 | check cnt res (Just imax) ("tail" :> 8) 243 | -- (Exactly) too much leading whitespace 244 | IOR.writeIORef cnt 3 245 | res <- readIntSkip 246 | $ QI.Chunk (B.replicate maxfill ' ') 247 | $ addEffect cnt 248 | $ QI.Chunk " 1" 249 | $ addEffect cnt 250 | $ QI.Chunk "" 251 | $ addEffect cnt 252 | $ QI.Empty 9 253 | check cnt res Nothing (" 1" :> 9) 254 | -- (Exactly) too many leading zeros 255 | IOR.writeIORef cnt 3 256 | res <- readIntSkip 257 | $ QI.Chunk (B.replicate maxfill '0') 258 | $ addEffect cnt 259 | $ QI.Chunk "1" 260 | $ addEffect cnt 261 | $ QI.Chunk "" 262 | $ addEffect cnt 263 | $ QI.Empty 10 264 | check cnt res Nothing (B.replicate maxfill '0' `B.append` "1" :> 10) 265 | -- Bare plus 266 | IOR.writeIORef cnt 1 267 | res <- readIntSkip 268 | $ QI.Chunk " +" 269 | $ addEffect cnt 270 | $ QI.Chunk "foo" 271 | $ QI.Empty 11 272 | check cnt res Nothing ("+foo" :> 11) 273 | -- Bare minus 274 | IOR.writeIORef cnt 1 275 | res <- readIntSkip 276 | $ QI.Chunk " -" 277 | $ addEffect cnt 278 | $ QI.Chunk " bar" 279 | $ QI.Empty 12 280 | check cnt res Nothing ("- bar" :> 12) 281 | -- 282 | IOR.writeIORef cnt 1 283 | let msg = " nothing to see here move along " 284 | res <- Q8.readInt 285 | $ QI.Chunk msg 286 | $ addEffect cnt 287 | $ QI.Empty 13 288 | check cnt res Nothing (msg :> 13) 289 | -- whitespace-only input 290 | IOR.writeIORef cnt 1 291 | res <- readIntSkip 292 | $ QI.Chunk " " 293 | $ addEffect cnt 294 | $ QI.Chunk "\n" 295 | $ QI.Empty 14 296 | check cnt res Nothing ("" :> 14) 297 | -- maxbound+10 with whitespace 298 | IOR.writeIORef cnt 4 299 | res <- readIntSkip 300 | $ QI.Chunk " \t\n\v\f\r\xa0" 301 | $ addEffect cnt 302 | $ QI.Chunk (B.take 4 smax10) 303 | $ addEffect cnt 304 | $ QI.Chunk (B.drop 4 smax10) 305 | $ addEffect cnt 306 | $ QI.Chunk "" 307 | $ addEffect cnt 308 | $ QI.Empty 15 309 | check cnt res Nothing (smax10 :> 15) 310 | -- minbound-10 with whitespace 311 | IOR.writeIORef cnt 4 312 | res <- readIntSkip 313 | $ QI.Chunk " \t\n\v\f\r\xa0" 314 | $ addEffect cnt 315 | $ QI.Chunk (B.take 4 smin10) 316 | $ addEffect cnt 317 | $ QI.Chunk (B.drop 4 smin10) 318 | $ addEffect cnt 319 | $ QI.Chunk "" 320 | $ addEffect cnt 321 | $ QI.Empty 16 322 | check cnt res Nothing (smin10 :> 16) 323 | -- maxBound with cross-chunk overflow 324 | IOR.writeIORef cnt 4 325 | res <- readIntSkip 326 | $ QI.Chunk " \t\n\v\f\r\xa0" 327 | $ addEffect cnt 328 | $ QI.Chunk (B.take 4 smax) 329 | $ addEffect cnt 330 | $ QI.Chunk (B.drop 4 smax) 331 | $ addEffect cnt 332 | $ QI.Chunk "00" 333 | $ addEffect cnt 334 | $ QI.Empty 17 335 | check cnt res Nothing (smax `B.append` "00" :> 17) 336 | where 337 | -- Count down to zero from initial value 338 | readIntSkip = Q8.readInt . Q8.skipSomeWS 339 | addEffect cnt str = QI.Go $ const str <$> IOR.modifyIORef' cnt pred 340 | check :: IOR.IORef Int 341 | -> Compose (Of (Maybe Int)) (QI.ByteStream IO) Int 342 | -> Maybe Int 343 | -> Of B.ByteString Int 344 | -> Assertion 345 | check cnt (Compose (gotInt :> str)) wantInt (wantStr :> wantR ) = do 346 | ( gotStr :> gotR ) <- Q.toStrict str 347 | c <- IOR.readIORef cnt 348 | assertBool ("Correct readInt effects " ++ show wantR) $ c == 0 349 | assertBool ("Correct readInt value " ++ show wantR ++ ": " ++ show gotInt) $ gotInt == wantInt 350 | assertBool ("Correct readInt tail " ++ show wantR ++ ": " ++ show gotStr) $ gotStr == wantStr 351 | assertBool ("Correct readInt residue " ++ show wantR ++ ": " ++ show gotR) $ gotR == wantR 352 | 353 | main :: IO () 354 | main = defaultMain $ testGroup "Tests" 355 | [ testGroup "Property Tests" 356 | [ testProperty "Streaming.ByteString.Char8.lines is equivalent to Prelude.lines" $ over chunksSeries $ \chunks -> 357 | -- This only makes sure that the streaming-bytestring lines function 358 | -- matches the Prelude lines function when no carriage returns 359 | -- are present. They are not expected to have the same behavior 360 | -- with dos-style line termination. 361 | let expected = lines $ concat chunks 362 | got = (map B.unpack . sLines . fromChunks) chunks 363 | in 364 | if expected == got 365 | then Right ("" :: String) 366 | else Left (printf "Expected %s; got %s" (show expected) (show got) :: String) 367 | , testProperty "lines recognizes DOS line endings" $ over strSeries $ \str -> 368 | sLines (Q8.string $ unix2dos str) == sLines (Q8.string str) 369 | , testProperty "lines recognizes DOS line endings with tiny chunks" $ over strSeries $ \str -> 370 | sLines (mapM_ Q8.singleton $ unix2dos str) == sLines (mapM_ Q8.singleton str) 371 | , testProperty "lineSplit does not create null chunks (LF)" $ over ((,) <$> nats <~> strSeries) $ \(n,str) -> 372 | noNullChunks (Q8.lineSplit n (fromString str)) 373 | , testProperty "lineSplit does not create null chunks (CRLF)" $ over ((,) <$> nats <~> strSeriesCrlf) $ \(n,str) -> 374 | noNullChunks (Q8.lineSplit n (fromString str)) 375 | , testProperty "concat after lineSplit round trips (LF)" $ over ((,) <$> nats <~> strSeries) $ \(n,str) -> 376 | unpackToString (Q8.concat (Q8.lineSplit n (fromString str))) == str 377 | , testProperty "concat after lineSplit round trips (CRLF)" $ over ((,) <$> nats <~> strSeriesCrlf) $ \(n,str) -> 378 | unpackToString (Q8.concat (Q8.lineSplit n (fromString str))) == str 379 | , testProperty "'for' is equivalent to the one in streaming" $ over chunksSeries $ \ss -> 380 | let doubleStream b = S.each [b, b] 381 | doubleByteStream b = Q.chunk b *> Q.chunk b 382 | in unpackToString (Q.fromChunks (S.for (Q.toChunks (fromChunks ss)) doubleStream)) 383 | == unpackToString (Q.for (fromChunks ss) doubleByteStream) 384 | ] 385 | , testGroup "Unit Tests" 386 | [ testCase "hGetContents: Handle stays open" handleIsOpen 387 | , testCase "group(By): Don't crash" groupCrash 388 | , testCase "group: Char order" groupCharOrder 389 | , testCase "groupBy: Char order" groupByCharOrder 390 | , testCase "findIndexOrEnd" goodFindIndex 391 | , testCase "Stream Interop" firstI 392 | , testCase "readInt" readIntCases 393 | , testCase "toLazy_: empty chunks" emptyChunks 394 | ] 395 | ] 396 | -------------------------------------------------------------------------------- /tests/groupBy.txt: -------------------------------------------------------------------------------- 1 | This is a test file, larger than 32kb, which is designed to trigger a (hopefully 2 | now fixed) bug in `group` and `groupBy`. Well, here goes. 3 | 4 | Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis 5 | facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta 6 | vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. 7 | Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis 8 | varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, 9 | ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur 10 | vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna 11 | orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis 12 | est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. 13 | 14 | Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis 15 | facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta 16 | vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. 17 | Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis 18 | varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, 19 | ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur 20 | vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna 21 | orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis 22 | est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. 23 | 24 | Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis 25 | facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta 26 | vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. 27 | Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis 28 | varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, 29 | ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur 30 | vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna 31 | orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis 32 | est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. 33 | 34 | Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis 35 | facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta 36 | vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. 37 | Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis 38 | varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, 39 | ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur 40 | vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna 41 | orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis 42 | est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. 43 | 44 | Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis 45 | facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta 46 | vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. 47 | Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis 48 | varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, 49 | ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur 50 | vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna 51 | orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis 52 | est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. 53 | 54 | Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis 55 | facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta 56 | vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. 57 | Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis 58 | varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, 59 | ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur 60 | vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna 61 | orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis 62 | est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. 63 | 64 | Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis 65 | facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta 66 | vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. 67 | Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis 68 | varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, 69 | ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur 70 | vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna 71 | orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis 72 | est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. 73 | 74 | Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis 75 | facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta 76 | vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. 77 | Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis 78 | varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, 79 | ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur 80 | vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna 81 | orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis 82 | est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. 83 | 84 | Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis 85 | facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta 86 | vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. 87 | Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis 88 | varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, 89 | ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur 90 | vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna 91 | orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis 92 | est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. 93 | 94 | Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis 95 | facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta 96 | vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. 97 | Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis 98 | varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, 99 | ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur 100 | vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna 101 | orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis 102 | est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. 103 | 104 | Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis 105 | facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta 106 | vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. 107 | Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis 108 | varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, 109 | ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur 110 | vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna 111 | orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis 112 | est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. 113 | 114 | Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis 115 | facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta 116 | vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. 117 | Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis 118 | varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, 119 | ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur 120 | vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna 121 | orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis 122 | est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. 123 | 124 | Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis 125 | facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta 126 | vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. 127 | Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis 128 | varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, 129 | ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur 130 | vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna 131 | orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis 132 | est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. 133 | 134 | Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis 135 | facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta 136 | vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. 137 | Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis 138 | varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, 139 | ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur 140 | vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna 141 | orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis 142 | est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. 143 | 144 | Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis 145 | facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta 146 | vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. 147 | Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis 148 | varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, 149 | ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur 150 | vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna 151 | orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis 152 | est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. 153 | 154 | Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis 155 | facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta 156 | vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. 157 | Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis 158 | varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, 159 | ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur 160 | vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna 161 | orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis 162 | est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. 163 | 164 | Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis 165 | facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta 166 | vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. 167 | Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis 168 | varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, 169 | ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur 170 | vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna 171 | orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis 172 | est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. 173 | 174 | Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis 175 | facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta 176 | vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. 177 | Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis 178 | varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, 179 | ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur 180 | vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna 181 | orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis 182 | est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. 183 | 184 | Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis 185 | facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta 186 | vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. 187 | Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis 188 | varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, 189 | ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur 190 | vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna 191 | orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis 192 | est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. 193 | 194 | Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis 195 | facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta 196 | vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. 197 | Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis 198 | varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, 199 | ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur 200 | vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna 201 | orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis 202 | est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. 203 | 204 | Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis 205 | facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta 206 | vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. 207 | Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis 208 | varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, 209 | ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur 210 | vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna 211 | orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis 212 | est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. 213 | 214 | Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis 215 | facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta 216 | vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. 217 | Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis 218 | varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, 219 | ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur 220 | vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna 221 | orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis 222 | est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. 223 | 224 | Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis 225 | facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta 226 | vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. 227 | Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis 228 | varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, 229 | ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur 230 | vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna 231 | orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis 232 | est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. 233 | 234 | Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis 235 | facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta 236 | vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. 237 | Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis 238 | varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, 239 | ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur 240 | vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna 241 | orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis 242 | est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. 243 | 244 | Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis 245 | facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta 246 | vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. 247 | Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis 248 | varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, 249 | ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur 250 | vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna 251 | orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis 252 | est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. 253 | 254 | Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis 255 | facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta 256 | vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. 257 | Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis 258 | varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, 259 | ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur 260 | vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna 261 | orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis 262 | est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. 263 | 264 | Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis 265 | facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta 266 | vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. 267 | Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis 268 | varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, 269 | ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur 270 | vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna 271 | orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis 272 | est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. 273 | 274 | Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis 275 | facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta 276 | vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. 277 | Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis 278 | varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, 279 | ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur 280 | vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna 281 | orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis 282 | est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. 283 | 284 | Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis 285 | facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta 286 | vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. 287 | Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis 288 | varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, 289 | ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur 290 | vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna 291 | orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis 292 | est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. 293 | 294 | Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis 295 | facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta 296 | vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. 297 | Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis 298 | varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, 299 | ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur 300 | vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna 301 | orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis 302 | est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. 303 | 304 | Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis 305 | facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta 306 | vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. 307 | Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis 308 | varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, 309 | ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur 310 | vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna 311 | orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis 312 | est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. 313 | 314 | Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis 315 | facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta 316 | vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. 317 | Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis 318 | varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, 319 | ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur 320 | vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna 321 | orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis 322 | est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. 323 | 324 | Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis 325 | facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta 326 | vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. 327 | Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis 328 | varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, 329 | ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur 330 | vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna 331 | orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis 332 | est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. 333 | 334 | Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis 335 | facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta 336 | vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. 337 | Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis 338 | varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, 339 | ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur 340 | vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna 341 | orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis 342 | est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. 343 | 344 | Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis 345 | facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta 346 | vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. 347 | Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis 348 | varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, 349 | ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur 350 | vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna 351 | orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis 352 | est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. 353 | 354 | Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis 355 | facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta 356 | vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. 357 | Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis 358 | varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, 359 | ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur 360 | vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna 361 | orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis 362 | est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. 363 | 364 | Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis 365 | facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta 366 | vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. 367 | Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis 368 | varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, 369 | ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur 370 | vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna 371 | orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis 372 | est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. 373 | 374 | Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis 375 | facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta 376 | vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. 377 | Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis 378 | varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, 379 | ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur 380 | vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna 381 | orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis 382 | est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. 383 | 384 | Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis 385 | facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta 386 | vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. 387 | Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis 388 | varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, 389 | ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur 390 | vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna 391 | orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis 392 | est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. 393 | 394 | Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis 395 | facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta 396 | vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. 397 | Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis 398 | varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, 399 | ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur 400 | vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna 401 | orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis 402 | est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. 403 | 404 | Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis 405 | facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta 406 | vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. 407 | Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis 408 | varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, 409 | ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur 410 | vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna 411 | orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis 412 | est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. 413 | 414 | Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis 415 | facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta 416 | vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. 417 | Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis 418 | varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, 419 | ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur 420 | vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna 421 | orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis 422 | est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. 423 | 424 | Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis 425 | facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta 426 | vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. 427 | Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis 428 | varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, 429 | ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur 430 | vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna 431 | orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis 432 | est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. 433 | 434 | Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis 435 | facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta 436 | vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. 437 | Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis 438 | varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, 439 | ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur 440 | vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna 441 | orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis 442 | est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. 443 | 444 | Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis 445 | facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta 446 | vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. 447 | Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis 448 | varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, 449 | ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur 450 | vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna 451 | orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis 452 | est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. 453 | 454 | Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis 455 | facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta 456 | vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. 457 | Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis 458 | varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, 459 | ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur 460 | vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna 461 | orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis 462 | est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. 463 | 464 | Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis 465 | facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta 466 | vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. 467 | Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis 468 | varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, 469 | ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur 470 | vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna 471 | orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis 472 | est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. 473 | 474 | Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis 475 | facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta 476 | vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. 477 | Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis 478 | varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, 479 | ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur 480 | vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna 481 | orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis 482 | est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. 483 | 484 | Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis 485 | facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta 486 | vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. 487 | Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis 488 | varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, 489 | ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur 490 | vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna 491 | orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis 492 | est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. 493 | 494 | Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis 495 | facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta 496 | vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. 497 | Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis 498 | varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, 499 | ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur 500 | vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna 501 | orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis 502 | est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. 503 | 504 | Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis 505 | facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta 506 | vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. 507 | Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis 508 | varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, 509 | ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur 510 | vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna 511 | orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis 512 | est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. 513 | 514 | Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis 515 | facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta 516 | vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. 517 | Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis 518 | varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, 519 | ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur 520 | vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna 521 | orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis 522 | est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. 523 | 524 | Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis 525 | facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta 526 | vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. 527 | Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis 528 | varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, 529 | ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur 530 | vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna 531 | orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis 532 | est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. 533 | 534 | Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis 535 | facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta 536 | vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. 537 | Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis 538 | varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, 539 | ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur 540 | vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna 541 | orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis 542 | est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. 543 | 544 | Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis 545 | facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta 546 | vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. 547 | Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis 548 | varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, 549 | ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur 550 | vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna 551 | orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis 552 | est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. 553 | 554 | Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis 555 | facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta 556 | vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. 557 | Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis 558 | varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, 559 | ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur 560 | vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna 561 | orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis 562 | est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. 563 | 564 | Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis 565 | facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta 566 | vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. 567 | Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis 568 | varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, 569 | ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur 570 | vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna 571 | orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis 572 | est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. 573 | -------------------------------------------------------------------------------- /tests/sample.txt: -------------------------------------------------------------------------------- 1 | This is 2 | a file 3 | with some text 4 | in it. 5 | Will everything 6 | stream as 7 | expected? 8 | -------------------------------------------------------------------------------- /upload.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | set -e 3 | 4 | if [ "$#" -ne 1 ]; then 5 | echo "Usage: scripts/hackage-docs.sh HACKAGE_USER" 6 | exit 1 7 | fi 8 | 9 | user=$1 10 | 11 | cabal_file=$(find . -maxdepth 1 -name "*.cabal" -print -quit) 12 | if [ ! -f "$cabal_file" ]; then 13 | echo "Run this script in the top-level package directory" 14 | exit 1 15 | fi 16 | 17 | pkg=$(awk -F ":[[:space:]]*" 'tolower($1)=="name" { print $2 }' < "$cabal_file") 18 | ver=$(awk -F ":[[:space:]]*" 'tolower($1)=="version" { print $2 }' < "$cabal_file") 19 | 20 | if [ -z "$pkg" ]; then 21 | echo "Unable to determine package name" 22 | exit 1 23 | fi 24 | 25 | if [ -z "$ver" ]; then 26 | echo "Unable to determine package version" 27 | exit 1 28 | fi 29 | 30 | echo "Detected package: $pkg-$ver" 31 | 32 | dir=$(mktemp -d build-docs.XXXXXX) 33 | trap 'rm -r "$dir"' EXIT 34 | 35 | cabal haddock --hyperlink-source --html-location='/package/$pkg-$version/docs' --contents-location='/package/$pkg-$version' 36 | 37 | cp -R dist/doc/html/$pkg/ $dir/$pkg-$ver-docs 38 | 39 | tar cvz -C $dir --format=ustar -f $dir/$pkg-$ver-docs.tar.gz $pkg-$ver-docs 40 | 41 | curl -X PUT \ 42 | -H 'Content-Type: application/x-tar' \ 43 | -H 'Content-Encoding: gzip' \ 44 | -u "$user" \ 45 | --data-binary "@$dir/$pkg-$ver-docs.tar.gz" \ 46 | "https://hackage.haskell.org/package/$pkg-$ver/docs" 47 | --------------------------------------------------------------------------------