diff --git a/benchmarks/haskell/Benchmarks.hs b/benchmarks/haskell/Benchmarks.hs --- a/benchmarks/haskell/Benchmarks.hs +++ b/benchmarks/haskell/Benchmarks.hs @@ -10,6 +10,7 @@ import System.IO #ifdef mingw32_HOST_OS +import System.IO.Temp (emptySystemTempFile) import System.Directory (removeFile) #endif @@ -40,11 +41,11 @@ mkSink :: IO (FilePath, Handle) mkSink = do #ifdef mingw32_HOST_OS - (sinkFn, sink) <- openTempFile "." "dev.null" + sinkFn <- emptySystemTempFile "dev.null" #else let sinkFn = "/dev/null" - sink <- openFile sinkFn WriteMode #endif + sink <- openFile sinkFn WriteMode hSetEncoding sink utf8 pure (sinkFn, sink) diff --git a/benchmarks/haskell/Benchmarks/FileWrite.hs b/benchmarks/haskell/Benchmarks/FileWrite.hs --- a/benchmarks/haskell/Benchmarks/FileWrite.hs +++ b/benchmarks/haskell/Benchmarks/FileWrite.hs @@ -15,11 +15,10 @@ import Control.DeepSeq (NFData, deepseq) import Data.Bifunctor (first) import Data.List (intercalate, intersperse) -import Data.Semigroup ((<>)) import Data.String (fromString) import Data.Text (StrictText) import Data.Text.Internal.Lazy (LazyText, defaultChunkSize) -import System.IO (Handle, Newline(CRLF,LF), NewlineMode(NewlineMode), BufferMode(NoBuffering,LineBuffering,BlockBuffering), hSetBuffering, hSetNewlineMode) +import System.IO (Handle, Newline(CRLF,LF), NewlineMode(NewlineMode), BufferMode(..), hSetBuffering, hSetNewlineMode) import Test.Tasty.Bench (Benchmark, bgroup, bench, whnfAppIO) import qualified Data.Text as T import qualified Data.Text.IO as T @@ -112,11 +111,15 @@ #endif where - lazy, lazyNewlines, lazySmallChunks, lazySmallChunksNewlines :: (String, StrictText -> LazyText) + lazy, lazyNewlines :: (String, StrictText -> LazyText) lazy = ("lazy", L.fromChunks . T.chunksOf defaultChunkSize) lazyNewlines = ("lazy many newlines", snd lazy . snd strictNewlines) + +#ifdef ExtendedBenchmarks + lazySmallChunks, lazySmallChunksNewlines :: (String, StrictText -> LazyText) lazySmallChunks = ("lazy small chunks", L.fromChunks . T.chunksOf 10) lazySmallChunksNewlines = ("lazy small chunks many newlines", snd lazySmallChunks . snd strictNewlines) +#endif strict, strictNewlines :: (String, StrictText -> StrictText) strict = ("strict", id) diff --git a/benchmarks/haskell/Benchmarks/Micro.hs b/benchmarks/haskell/Benchmarks/Micro.hs --- a/benchmarks/haskell/Benchmarks/Micro.hs +++ b/benchmarks/haskell/Benchmarks/Micro.hs @@ -2,6 +2,7 @@ module Benchmarks.Micro (benchmark) where +import qualified Data.List.NonEmpty as NE import qualified Data.Text.Lazy as TL import qualified Data.Text as T import Test.Tasty.Bench (Benchmark, Benchmarkable, bgroup, bcompareWithin, bench, nf) @@ -9,7 +10,7 @@ benchmark :: Benchmark benchmark = bgroup "Micro" [ blinear "lazy-inits--last" 500000 2 0.1 $ \len -> - nf (last . TL.inits) (chunks len) + nf (NE.last . TL.initsNE) (chunks len) , blinear "lazy-inits--map-take1" 500000 2 0.1 $ \len -> nf (map (TL.take 1) . TL.inits) (chunks len) ] diff --git a/benchmarks/haskell/Benchmarks/Programs/Fold.hs b/benchmarks/haskell/Benchmarks/Programs/Fold.hs --- a/benchmarks/haskell/Benchmarks/Programs/Fold.hs +++ b/benchmarks/haskell/Benchmarks/Programs/Fold.hs @@ -17,8 +17,9 @@ ( benchmark ) where -import Data.List (foldl') +import Data.Foldable (Foldable(..)) import Data.List (intersperse) +import Prelude hiding (Foldable(..)) import System.IO (Handle) import Test.Tasty.Bench (Benchmark, bench, whnfIO) import qualified Data.Text as T @@ -29,7 +30,7 @@ benchmark :: FilePath -> Handle -> Benchmark benchmark i o = - bench "Fold" $ whnfIO $ T.readFile i >>= TL.hPutStr o . fold 80 + bench "Fold" $ whnfIO $ T.readFile i >>= TL.hPutStr o . foldText 80 -- | We represent a paragraph by a word list -- @@ -37,8 +38,8 @@ -- | Fold a text -- -fold :: Int -> T.Text -> TL.Text -fold maxWidth = TLB.toLazyText . mconcat . +foldText :: Int -> T.Text -> TL.Text +foldText maxWidth = TLB.toLazyText . mconcat . intersperse "\n\n" . map (foldParagraph maxWidth) . paragraphs -- | Fold a paragraph diff --git a/benchmarks/haskell/Benchmarks/Pure.hs b/benchmarks/haskell/Benchmarks/Pure.hs --- a/benchmarks/haskell/Benchmarks/Pure.hs +++ b/benchmarks/haskell/Benchmarks/Pure.hs @@ -26,6 +26,8 @@ import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Builder as TB import qualified Data.Text.Lazy.Encoding as TL +import Data.Semigroup +import Data.List.NonEmpty (NonEmpty((:|))) data Env = Env { bsa :: !BS.ByteString @@ -83,6 +85,14 @@ [ benchT $ nf T.concat tl , benchTL $ nf TL.concat tll ] + , bgroup "sconcat" + [ benchT $ nf sconcat (T.empty :| tl) + , benchTL $ nf sconcat (TL.empty :| tll) + ] + , bgroup "stimes" + [ benchT $ nf (stimes (10 :: Int)) ta + , benchTL $ nf (stimes (10 :: Int)) tla + ] , bgroup "cons" [ benchT $ nf (T.cons c) ta , benchTL $ nf (TL.cons c) tla @@ -207,6 +217,14 @@ , bgroup "zipWith" [ benchT $ nf (T.zipWith min tb) ta , benchTL $ nf (TL.zipWith min tlb) tla + ] + , bgroup "length . unpack" -- length should fuse with unpack + [ benchT $ nf (L.length . T.unpack) ta + , benchTL $ nf (L.length . TL.unpack) tla + ] + , bgroup "length . drop 1 . unpack" -- no list fusion because of drop 1 + [ benchT $ nf (L.length . L.drop 1 . T.unpack) ta + , benchTL $ nf (L.length . L.drop 1 . TL.unpack) tla ] , bgroup "length" [ bgroup "cons" diff --git a/benchmarks/haskell/Benchmarks/ReadNumbers.hs b/benchmarks/haskell/Benchmarks/ReadNumbers.hs --- a/benchmarks/haskell/Benchmarks/ReadNumbers.hs +++ b/benchmarks/haskell/Benchmarks/ReadNumbers.hs @@ -21,8 +21,9 @@ , benchmark ) where +import Data.Foldable (Foldable(..)) +import Prelude hiding (Foldable(..)) import Test.Tasty.Bench (Benchmark, bgroup, bench, whnf) -import Data.List (foldl') import qualified Data.Text as T import qualified Data.Text.IO as T import qualified Data.Text.Lazy as TL diff --git a/benchmarks/haskell/Benchmarks/WordFrequencies.hs b/benchmarks/haskell/Benchmarks/WordFrequencies.hs --- a/benchmarks/haskell/Benchmarks/WordFrequencies.hs +++ b/benchmarks/haskell/Benchmarks/WordFrequencies.hs @@ -13,9 +13,10 @@ , benchmark ) where -import Test.Tasty.Bench (Benchmark, bench, bgroup, whnf) -import Data.List (foldl') +import Data.Foldable (Foldable(..)) import Data.Map (Map) +import Prelude hiding (Foldable(..)) +import Test.Tasty.Bench (Benchmark, bench, bgroup, whnf) import qualified Data.Map as M import qualified Data.Text as T import qualified Data.Text.IO as T diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,380 +1,392 @@ -### 2.1.2 - -* [Update case mappings for Unicode 16.0](https://github.com/haskell/text/pull/618) - -* [Add type synonym for lazy builders. Deprecated `StrictBuilder` for `StrictTextBuilder`](https://github.com/haskell/text/pull/581) - -* [Add `initsNE` and `tailsNE`](https://github.com/haskell/text/pull/558) - -* [Add `foldlM'`](https://github.com/haskell/text/pull/543) - -* [Add `Data.Text.Foreign.peekCString`](https://github.com/haskell/text/pull/599) - -* [Add `Data.Text.show` and `Data.Text.Lazy.show`](https://github.com/haskell/text/pull/608) - -* [Add pattern synonyms `Empty`, `(:<)`, and `(:>)`](https://github.com/haskell/text/pull/619) - -* [Improve precision of `Data.Text.Read.rational`](https://github.com/haskell/text/pull/565) - -* [`Data.Text.IO.Utf8`: use `B.putStrLn` instead of `B.putStr t >> B.putStr "\n"`](https://github.com/haskell/text/pull/579) - -* [`Data.Text.IO` and `Data.Text.Lazy.IO`: Make `putStrLn` more atomic with line or block buffering](https://github.com/haskell/text/pull/600) - -* [Integrate UTF-8 `hPutStr` to standard `hPutStr`](https://github.com/haskell/text/pull/589) - -* [Serialise `Text` without going through `ByteString`](https://github.com/haskell/text/pull/617) - -* [Make `splitAt` strict in its first argument, even if input is empty](https://github.com/haskell/text/pull/575) - -* [Improve lazy performance of `Data.Text.Lazy.inits`](https://github.com/haskell/text/pull/572) - -* [Implement `Data.Text.unpack` and `Data.Text.toTitle` directly, without streaming](https://github.com/haskell/text/pull/611) - -* [Make `fromString` `INLINEABLE` instead of `INLINE`](https://github.com/haskell/text/pull/571) to reduce the size of generated code. - -### 2.1.1 - -* Add pure Haskell implementations as an alternative to C-based ones, - suitable for JavaScript backend. - -* [Add type synonyms for lazy and strict text flavours](https://github.com/haskell/text/pull/547) - -* [Share empty `Text` values](https://github.com/haskell/text/pull/493) - -* [Fix bug in `isValidUtf8ByteArray`](https://github.com/haskell/text/pull/553) - -* [Optimize the implementation of `Data.Text.concat`](https://github.com/haskell/text/pull/551) - -* [Fix `filter/filter` rules for `Text` and lazy `Text`](https://github.com/haskell/text/pull/560) - -### 2.1 - -* [Switch `Data.Text.Array` to `Data.Array.Byte`](https://github.com/haskell/text/pull/474) - -* [Add `Text.IO.Utf8` module](https://github.com/haskell/text/pull/503) - -* [Expose UTF-8 validation functions from internal module](https://github.com/haskell/text/pull/483) - -* [Fix handling of incomplete input in stream decoders](https://github.com/haskell/text/pull/527) - -* [Fix handling of invalid bytes in stream decoders](https://github.com/haskell/text/pull/528) - -* [Make Lift Text work under RebindableSyntax](https://github.com/haskell/text/pull/534) - -### 2.0.2 - -* [Add decoding functions in `Data.Text.Encoding` that allow - more control for error handling and for how to allocate text](https://github.com/haskell/text/pull/448). Thanks to David Sledge! - * `decodeASCIIPrefix` - * `decodeUtf8Chunk` - * `decodeUtf8More` - * `Utf8ValidState` - * `startUtf8ValidState` - * `StrictBuilder` - * `strictBuilderToText` - * `textToStrictBuilder` - * `validateUtf8Chunk` - * `validateUtf8More` - -* [Fix quadratic slowdown when decoding invalid UTF-8 bytestrings](https://github.com/haskell/text/issues/495) - -* [Add `isAscii :: Text -> Bool`](https://github.com/haskell/text/issues/497) - -* [Add `decodeASCII' :: ByteString -> Maybe Text`](https://github.com/haskell/text/issues/499) - -* Add internal module `Data.Text.Internal.StrictBuilder` - -* Add internal module `Data.Text.Internal.Encoding` - -* Add `Data.Text.Internal.Encoding.Utf8.updateDecoderState` and export `utf8{Accept,Reject}State` from the same module. - -* [Speed up case conversions](https://github.com/haskell/text/pull/460) - -* [Reduce code bloat for literal strings](https://github.com/haskell/text/pull/468) - -* [Remove support for GHC 8.0](https://github.com/haskell/text/pull/485) - -### 2.0.1 - -* Improve portability of C and C++ code. -* [Make `Lift` instance more efficient](https://github.com/haskell/text/pull/413) -* [Make `toCaseFold` idempotent](https://github.com/haskell/text/pull/402) -* [Add `fromPtr0`](https://github.com/haskell/text/pull/423) -* [Add `Data.Text.foldr'`](https://github.com/haskell/text/pull/436) -* [Add `withCString`](https://github.com/haskell/text/pull/431) -* [Add `spanM` and `spanEndM`](https://github.com/haskell/text/pull/437) - -### 2.0 - -* [Switch internal representation of text from UTF-16 to UTF-8](https://github.com/haskell/text/pull/365): - * Functions in `Data.Text.Array` now operate over arrays of `Word8` instead of `Word16`. - * Rename constructors of `Array` and `MArray` to `ByteArray` and `MutableByteArray`. - * Rename functions and types in `Data.Text.Foreign` to reflect switch - from `Word16` to `Word8`. - * Rename slicing functions in `Data.Text.Unsafe` to reflect switch - from `Word16` to `Word8`. - * Rename `Data.Text.Internal.Unsafe.Char.unsafeChr` to `unsafeChr16`. - * Change semantics and order of arguments of `Data.Text.Array.copyI`: - pass length, not end offset. - * Extend `Data.Text.Internal.Encoding.Utf8` to provide more UTF-8 related routines. - * Extend interface of `Data.Text.Array` with more utility functions. - * Add `instance Show Data.Text.Unsafe.Iter`. - * Add `Data.Text.measureOff`. - * Extend `Data.Text.Unsafe` with `iterArray` and `reverseIterArray`. - * Export `Data.Text.Internal.Lazy.equal`. - * Export `Data.Text.Internal.append`. - * Add `Data.Text.Internal.Private.spanAscii_`. - * Replacement characters in `decodeUtf8With` are no longer limited to Basic Multilingual Plane. -* [Disable implicit fusion rules](https://github.com/haskell/text/pull/348) -* [Add `Data.Text.Encoding.decodeUtf8Lenient`](https://github.com/haskell/text/pull/342) -* [Remove `Data.Text.Internal.Unsafe.Shift`](https://github.com/haskell/text/pull/343) -* [Remove `Data.Text.Internal.Functions`](https://github.com/haskell/text/pull/354) -* [Bring type of `Data.Text.Unsafe.reverseIter` in line with `iter`](https://github.com/haskell/text/pull/355) -* [Add `instance Bounded FPFormat`](https://github.com/haskell/text/pull/355) -* [Add HasCallStack to partial functions](https://github.com/haskell/text/pull/388) - -### 1.2.5.0 - -* [Support sized primitives from GHC 9.2](https://github.com/haskell/text/pull/305) -* [Allow `template-haskell-2.18.0.0`](https://github.com/haskell/text/pull/320) -* [Add `elem :: Char -> Text -> Bool` to `Data.Text` and `Data.Text.Lazy`](https://github.com/haskell/text/pull/274) -* [Replace surrogate code points in `Data.Text.Internal.Builder.{singleton,fromString}`](https://github.com/haskell/text/pull/281) -* [Use `unsafeWithForeignPtr` when available](https://github.com/haskell/text/pull/325) -* [Use vectorized CPU instructions for decoding and encoding](https://github.com/haskell/text/pull/302) -* [Regenerate case mapping in accordance to Unicode 13.0](https://github.com/haskell/text/pull/334) -* [Fix UTF-8 decoding of lazy bytestrings](https://github.com/haskell/text/pull/333) - -### 1.2.4.1 - -* Support `template-haskell-2.17.0.0` -* Support `bytestring-0.11` -* Add `take . drop` related RULE - -### 1.2.4.0 - -* Add TH `Lift` instances for `Data.Text.Text` and `Data.Text.Lazy.Text` (gh-232) - -* Update Haddock documentation to better reflect fusion eligibility; improve fusion - rules for `takeWhileEnd` and `length` (gh-241, ghc-202) - -* Optimise `Data.Text.replicate`. Rather than calling `memcpy` `n` times, - call it only `O(log n)` times on chunks of increasing size. The total - asymptotic complexity remains `O(nm)`. (gh-209) - -* Support `base-4.13.0.0` - -### 1.2.3.1 - -* Make `decodeUtf8With` fail explicitly for unsupported non-BMP - replacement characters instead silent undefined behaviour (gh-213) - -* Fix termination condition for file reads via `Data.Text.IO` - operations (gh-223) - -* A serious correctness issue affecting uses of `take` and `drop` with - negative counts has been fixed (gh-227) - -* A bug in the case-mapping functions resulting in unreasonably large - allocations with large arguments has been fixed (gh-221) - -### 1.2.3.0 - -* Spec compliance: `toCaseFold` now follows the Unicode 9.0 spec - (updated from 8.0). - -* Bug fix: the lazy `takeWhileEnd` function violated the - [lazy text invariant](https://github.com/bos/text/blob/1.2.3.0/Data/Text/Internal/Lazy.hs#L51) - (gh-184). - -* Bug fix: Fixed usage of size hints causing incorrect behavior (gh-197). - -* New function: `unsnoc` (gh-173). - -* Reduce memory overhead in `encodeUTF8` (gh-194). - -* Improve UTF-8 decoder error-recovery (gh-182). - -* Minor documentation improvements (`@since` annotations, more - examples, clarifications). - -#### 1.2.2.2 - -* The `toTitle` function now correctly handles letters that - immediately follow punctuation. Before, `"there's"` would turn into - `"There'S"`. Now, it becomes `"There's"`. - -* The implementation of unstreaming is faster, resulting in operations - such as `map` and `intersperse` speeding up by up to 30%, with - smaller code generated. - -* The optimised length comparison function is now more likely to be - used after some rewrite rule tweaking. - -* Bug fix: an off-by-one bug in `takeEnd` is fixed. - -* Bug fix: a logic error in `takeWord16` is fixed. - -#### 1.2.2.1 - -* The switch to `integer-pure` in 1.2.2.0 was apparently mistaken. - The build flag has been renamed accordingly. Your army of diligent - maintainers apologizes for the churn. - -* Spec compliance: `toCaseFold` now follows the Unicode 8.0 spec - (updated from 7.0) - -* An STG lint error has been fixed - -### 1.2.2.0 - -* The `integer-simple` package, upon which this package optionally - depended, has been replaced with `integer-pure`. The build flag has - been renamed accordingly. - -* Bug fix: For the `Binary` instance, If UTF-8 decoding fails during a - `get`, the error is propagated via `fail` instead of an uncatchable - crash. - -* New function: `takeWhileEnd` - -* New instances for the `Text` types: - * if `base` >= 4.7: `PrintfArg` - * if `base` >= 4.9: `Semigroup` - -#### 1.2.1.3 - -* Bug fix: As it turns out, moving the literal rewrite rules to simplifier - phase 2 does not prevent competition with the `unpack` rule, which is - also active in this phase. Unfortunately this was hidden due to a silly - test environment mistake. Moving literal rules back to phase 1 finally - fixes GHC Trac #10528 correctly. - -#### 1.2.1.2 - -* Bug fix: Run literal rewrite rules in simplifier phase 2. - The behavior of the simplifier changed in GHC 7.10.2, - causing these rules to fail to fire, leading to poor code generation - and long compilation times. See - [GHC Trac #10528](https://ghc.haskell.org/trac/ghc/ticket/10528). - -#### 1.2.1.1 - -* Expose unpackCString#, which you should never use. - -### 1.2.1.0 - -* Added Binary instances for both Text types. (If you have previously - been using the text-binary package to get a Binary instance, it is - now obsolete.) - -#### 1.2.0.6 - -* Fixed a space leak in UTF-8 decoding - -#### 1.2.0.5 - -* Feature parity: repeat, cycle, iterate are now implemented for lazy - Text, and the Data instance is more complete - -* Build speed: an inliner space explosion has been fixed with toCaseFold - -* Bug fix: encoding Int to a Builder would infinite-loop if the - integer-simple package was used - -* Deprecation: OnEncodeError and EncodeError are deprecated, as they - are never used - -* Internals: some types that are used internally in fusion-related - functions have moved around, been renamed, or been deleted (we don't - bump the major version if .Internal modules change) - -* Spec compliance: toCaseFold now follows the Unicode 7.0 spec - (updated from 6.3) - -#### 1.2.0.4 - -* Fixed an incompatibility with base < 4.5 - -#### 1.2.0.3 - -* Update formatRealFloat to correspond to the definition in versions - of base newer than 4.5 (https://github.com/bos/text/issues/105) - -#### 1.2.0.2 - -* Bumped lower bound on deepseq to 1.4 for compatibility with the - upcoming GHC 7.10 - -#### 1.2.0.1 - -* Fixed a buffer overflow in rendering of large Integers - (https://github.com/bos/text/issues/99) - -## 1.2.0.0 - -* Fixed an integer overflow in the replace function - (https://github.com/bos/text/issues/81) - -* Fixed a hang in lazy decodeUtf8With - (https://github.com/bos/text/issues/87) - -* Reduced codegen bloat caused by use of empty and single-character - literals - -* Added an instance of IsList for GHC 7.8 and above - -### 1.1.1.0 - -* The Data.Data instance now allows gunfold to work, via a virtual - pack constructor - -* dropEnd, takeEnd: new functions - -* Comparing the length of a Text against a number can now - short-circuit in more cases - -#### 1.1.0.1 - -* streamDecodeUtf8: fixed gh-70, did not return all unconsumed bytes - in single-byte chunks - -## 1.1.0.0 - -* encodeUtf8: Performance is improved by up to 4x. - -* encodeUtf8Builder, encodeUtf8BuilderEscaped: new functions, - available only if bytestring >= 0.10.4.0 is installed, that allow - very fast and flexible encoding of a Text value to a bytestring - Builder. - - As an example of the performance gain to be had, the - encodeUtf8BuilderEscaped function helps to double the speed of JSON - encoding in the latest version of aeson! (Note: if all you need is a - plain ByteString, encodeUtf8 is still the faster way to go.) - -* All of the internal module hierarchy is now publicly exposed. If a - module is in the .Internal hierarchy, or is documented as internal, - use at your own risk - there are no API stability guarantees for - internal modules! - -#### 1.0.0.1 - -* decodeUtf8: Fixed a regression that caused us to incorrectly - identify truncated UTF-8 as valid (gh-61) - -# 1.0.0.0 - -* Added support for Unicode 6.3.0 to case conversion functions - -* New function toTitle converts words in a string to title case - -* New functions peekCStringLen and withCStringLen simplify - interoperability with C functions - -* Added support for decoding UTF-8 in stream-friendly fashion - -* Fixed a bug in mapAccumL - -* Added trusted Haskell support - -* Removed support for GHC 6.10 (released in 2008) and older +### 2.1.3 - 2025-08-01 + +* [Fix CRLF handling in IO functions](https://github.com/haskell/text/pull/649) + +* [Change `utf8LengthByLeader` to a branching implementation](https://github.com/haskell/text/pull/635) + +* [Define `stimes 0` for lazy text](https://github.com/haskell/text/pull/641) + +* [Add implementation of `sconcat` and `stimes` for strict `Text`](https://github.com/haskell/text/pull/580) and [Fix `stimes` for strict text when size wraps around `Int`](https://github.com/haskell/text/pull/639) + +* [Allow list fusion for `unpack` over both strict and lazy `Text`](https://github.com/haskell/text/pull/629) + +### 2.1.2 + +* [Update case mappings for Unicode 16.0](https://github.com/haskell/text/pull/618) + +* [Add type synonym for lazy builders. Deprecated `StrictBuilder` for `StrictTextBuilder`](https://github.com/haskell/text/pull/581) + +* [Add `initsNE` and `tailsNE`](https://github.com/haskell/text/pull/558) + +* [Add `foldlM'`](https://github.com/haskell/text/pull/543) + +* [Add `Data.Text.Foreign.peekCString`](https://github.com/haskell/text/pull/599) + +* [Add `Data.Text.show` and `Data.Text.Lazy.show`](https://github.com/haskell/text/pull/608) + +* [Add pattern synonyms `Empty`, `(:<)`, and `(:>)`](https://github.com/haskell/text/pull/619) + +* [Improve precision of `Data.Text.Read.rational`](https://github.com/haskell/text/pull/565) + +* [`Data.Text.IO.Utf8`: use `B.putStrLn` instead of `B.putStr t >> B.putStr "\n"`](https://github.com/haskell/text/pull/579) + +* [`Data.Text.IO` and `Data.Text.Lazy.IO`: Make `putStrLn` more atomic with line or block buffering](https://github.com/haskell/text/pull/600) + +* [Integrate UTF-8 `hPutStr` to standard `hPutStr`](https://github.com/haskell/text/pull/589) + +* [Serialise `Text` without going through `ByteString`](https://github.com/haskell/text/pull/617) + +* [Make `splitAt` strict in its first argument, even if input is empty](https://github.com/haskell/text/pull/575) + +* [Improve lazy performance of `Data.Text.Lazy.inits`](https://github.com/haskell/text/pull/572) + +* [Implement `Data.Text.unpack` and `Data.Text.toTitle` directly, without streaming](https://github.com/haskell/text/pull/611) + +* [Make `fromString` `INLINEABLE` instead of `INLINE`](https://github.com/haskell/text/pull/571) to reduce the size of generated code. + +### 2.1.1 + +* Add pure Haskell implementations as an alternative to C-based ones, + suitable for JavaScript backend. + +* [Add type synonyms for lazy and strict text flavours](https://github.com/haskell/text/pull/547) + +* [Share empty `Text` values](https://github.com/haskell/text/pull/493) + +* [Fix bug in `isValidUtf8ByteArray`](https://github.com/haskell/text/pull/553) + +* [Optimize the implementation of `Data.Text.concat`](https://github.com/haskell/text/pull/551) + +* [Fix `filter/filter` rules for `Text` and lazy `Text`](https://github.com/haskell/text/pull/560) + +### 2.1 + +* [Switch `Data.Text.Array` to `Data.Array.Byte`](https://github.com/haskell/text/pull/474) + +* [Add `Text.IO.Utf8` module](https://github.com/haskell/text/pull/503) + +* [Expose UTF-8 validation functions from internal module](https://github.com/haskell/text/pull/483) + +* [Fix handling of incomplete input in stream decoders](https://github.com/haskell/text/pull/527) + +* [Fix handling of invalid bytes in stream decoders](https://github.com/haskell/text/pull/528) + +* [Make Lift Text work under RebindableSyntax](https://github.com/haskell/text/pull/534) + +### 2.0.2 + +* [Add decoding functions in `Data.Text.Encoding` that allow + more control for error handling and for how to allocate text](https://github.com/haskell/text/pull/448). Thanks to David Sledge! + * `decodeASCIIPrefix` + * `decodeUtf8Chunk` + * `decodeUtf8More` + * `Utf8ValidState` + * `startUtf8ValidState` + * `StrictBuilder` + * `strictBuilderToText` + * `textToStrictBuilder` + * `validateUtf8Chunk` + * `validateUtf8More` + +* [Fix quadratic slowdown when decoding invalid UTF-8 bytestrings](https://github.com/haskell/text/issues/495) + +* [Add `isAscii :: Text -> Bool`](https://github.com/haskell/text/issues/497) + +* [Add `decodeASCII' :: ByteString -> Maybe Text`](https://github.com/haskell/text/issues/499) + +* Add internal module `Data.Text.Internal.StrictBuilder` + +* Add internal module `Data.Text.Internal.Encoding` + +* Add `Data.Text.Internal.Encoding.Utf8.updateDecoderState` and export `utf8{Accept,Reject}State` from the same module. + +* [Speed up case conversions](https://github.com/haskell/text/pull/460) + +* [Reduce code bloat for literal strings](https://github.com/haskell/text/pull/468) + +* [Remove support for GHC 8.0](https://github.com/haskell/text/pull/485) + +### 2.0.1 + +* Improve portability of C and C++ code. +* [Make `Lift` instance more efficient](https://github.com/haskell/text/pull/413) +* [Make `toCaseFold` idempotent](https://github.com/haskell/text/pull/402) +* [Add `fromPtr0`](https://github.com/haskell/text/pull/423) +* [Add `Data.Text.foldr'`](https://github.com/haskell/text/pull/436) +* [Add `withCString`](https://github.com/haskell/text/pull/431) +* [Add `spanM` and `spanEndM`](https://github.com/haskell/text/pull/437) + +### 2.0 + +* [Switch internal representation of text from UTF-16 to UTF-8](https://github.com/haskell/text/pull/365): + * Functions in `Data.Text.Array` now operate over arrays of `Word8` instead of `Word16`. + * Rename constructors of `Array` and `MArray` to `ByteArray` and `MutableByteArray`. + * Rename functions and types in `Data.Text.Foreign` to reflect switch + from `Word16` to `Word8`. + * Rename slicing functions in `Data.Text.Unsafe` to reflect switch + from `Word16` to `Word8`. + * Rename `Data.Text.Internal.Unsafe.Char.unsafeChr` to `unsafeChr16`. + * Change semantics and order of arguments of `Data.Text.Array.copyI`: + pass length, not end offset. + * Extend `Data.Text.Internal.Encoding.Utf8` to provide more UTF-8 related routines. + * Extend interface of `Data.Text.Array` with more utility functions. + * Add `instance Show Data.Text.Unsafe.Iter`. + * Add `Data.Text.measureOff`. + * Extend `Data.Text.Unsafe` with `iterArray` and `reverseIterArray`. + * Export `Data.Text.Internal.Lazy.equal`. + * Export `Data.Text.Internal.append`. + * Add `Data.Text.Internal.Private.spanAscii_`. + * Replacement characters in `decodeUtf8With` are no longer limited to Basic Multilingual Plane. +* [Disable implicit fusion rules](https://github.com/haskell/text/pull/348) +* [Add `Data.Text.Encoding.decodeUtf8Lenient`](https://github.com/haskell/text/pull/342) +* [Remove `Data.Text.Internal.Unsafe.Shift`](https://github.com/haskell/text/pull/343) +* [Remove `Data.Text.Internal.Functions`](https://github.com/haskell/text/pull/354) +* [Bring type of `Data.Text.Unsafe.reverseIter` in line with `iter`](https://github.com/haskell/text/pull/355) +* [Add `instance Bounded FPFormat`](https://github.com/haskell/text/pull/355) +* [Add HasCallStack to partial functions](https://github.com/haskell/text/pull/388) + +### 1.2.5.0 + +* [Support sized primitives from GHC 9.2](https://github.com/haskell/text/pull/305) +* [Allow `template-haskell-2.18.0.0`](https://github.com/haskell/text/pull/320) +* [Add `elem :: Char -> Text -> Bool` to `Data.Text` and `Data.Text.Lazy`](https://github.com/haskell/text/pull/274) +* [Replace surrogate code points in `Data.Text.Internal.Builder.{singleton,fromString}`](https://github.com/haskell/text/pull/281) +* [Use `unsafeWithForeignPtr` when available](https://github.com/haskell/text/pull/325) +* [Use vectorized CPU instructions for decoding and encoding](https://github.com/haskell/text/pull/302) +* [Regenerate case mapping in accordance to Unicode 13.0](https://github.com/haskell/text/pull/334) +* [Fix UTF-8 decoding of lazy bytestrings](https://github.com/haskell/text/pull/333) + +### 1.2.4.1 + +* Support `template-haskell-2.17.0.0` +* Support `bytestring-0.11` +* Add `take . drop` related RULE + +### 1.2.4.0 + +* Add TH `Lift` instances for `Data.Text.Text` and `Data.Text.Lazy.Text` (gh-232) + +* Update Haddock documentation to better reflect fusion eligibility; improve fusion + rules for `takeWhileEnd` and `length` (gh-241, ghc-202) + +* Optimise `Data.Text.replicate`. Rather than calling `memcpy` `n` times, + call it only `O(log n)` times on chunks of increasing size. The total + asymptotic complexity remains `O(nm)`. (gh-209) + +* Support `base-4.13.0.0` + +### 1.2.3.1 + +* Make `decodeUtf8With` fail explicitly for unsupported non-BMP + replacement characters instead silent undefined behaviour (gh-213) + +* Fix termination condition for file reads via `Data.Text.IO` + operations (gh-223) + +* A serious correctness issue affecting uses of `take` and `drop` with + negative counts has been fixed (gh-227) + +* A bug in the case-mapping functions resulting in unreasonably large + allocations with large arguments has been fixed (gh-221) + +### 1.2.3.0 + +* Spec compliance: `toCaseFold` now follows the Unicode 9.0 spec + (updated from 8.0). + +* Bug fix: the lazy `takeWhileEnd` function violated the + [lazy text invariant](https://github.com/bos/text/blob/1.2.3.0/Data/Text/Internal/Lazy.hs#L51) + (gh-184). + +* Bug fix: Fixed usage of size hints causing incorrect behavior (gh-197). + +* New function: `unsnoc` (gh-173). + +* Reduce memory overhead in `encodeUTF8` (gh-194). + +* Improve UTF-8 decoder error-recovery (gh-182). + +* Minor documentation improvements (`@since` annotations, more + examples, clarifications). + +#### 1.2.2.2 + +* The `toTitle` function now correctly handles letters that + immediately follow punctuation. Before, `"there's"` would turn into + `"There'S"`. Now, it becomes `"There's"`. + +* The implementation of unstreaming is faster, resulting in operations + such as `map` and `intersperse` speeding up by up to 30%, with + smaller code generated. + +* The optimised length comparison function is now more likely to be + used after some rewrite rule tweaking. + +* Bug fix: an off-by-one bug in `takeEnd` is fixed. + +* Bug fix: a logic error in `takeWord16` is fixed. + +#### 1.2.2.1 + +* The switch to `integer-pure` in 1.2.2.0 was apparently mistaken. + The build flag has been renamed accordingly. Your army of diligent + maintainers apologizes for the churn. + +* Spec compliance: `toCaseFold` now follows the Unicode 8.0 spec + (updated from 7.0) + +* An STG lint error has been fixed + +### 1.2.2.0 + +* The `integer-simple` package, upon which this package optionally + depended, has been replaced with `integer-pure`. The build flag has + been renamed accordingly. + +* Bug fix: For the `Binary` instance, If UTF-8 decoding fails during a + `get`, the error is propagated via `fail` instead of an uncatchable + crash. + +* New function: `takeWhileEnd` + +* New instances for the `Text` types: + * if `base` >= 4.7: `PrintfArg` + * if `base` >= 4.9: `Semigroup` + +#### 1.2.1.3 + +* Bug fix: As it turns out, moving the literal rewrite rules to simplifier + phase 2 does not prevent competition with the `unpack` rule, which is + also active in this phase. Unfortunately this was hidden due to a silly + test environment mistake. Moving literal rules back to phase 1 finally + fixes GHC Trac #10528 correctly. + +#### 1.2.1.2 + +* Bug fix: Run literal rewrite rules in simplifier phase 2. + The behavior of the simplifier changed in GHC 7.10.2, + causing these rules to fail to fire, leading to poor code generation + and long compilation times. See + [GHC Trac #10528](https://ghc.haskell.org/trac/ghc/ticket/10528). + +#### 1.2.1.1 + +* Expose unpackCString#, which you should never use. + +### 1.2.1.0 + +* Added Binary instances for both Text types. (If you have previously + been using the text-binary package to get a Binary instance, it is + now obsolete.) + +#### 1.2.0.6 + +* Fixed a space leak in UTF-8 decoding + +#### 1.2.0.5 + +* Feature parity: repeat, cycle, iterate are now implemented for lazy + Text, and the Data instance is more complete + +* Build speed: an inliner space explosion has been fixed with toCaseFold + +* Bug fix: encoding Int to a Builder would infinite-loop if the + integer-simple package was used + +* Deprecation: OnEncodeError and EncodeError are deprecated, as they + are never used + +* Internals: some types that are used internally in fusion-related + functions have moved around, been renamed, or been deleted (we don't + bump the major version if .Internal modules change) + +* Spec compliance: toCaseFold now follows the Unicode 7.0 spec + (updated from 6.3) + +#### 1.2.0.4 + +* Fixed an incompatibility with base < 4.5 + +#### 1.2.0.3 + +* Update formatRealFloat to correspond to the definition in versions + of base newer than 4.5 (https://github.com/bos/text/issues/105) + +#### 1.2.0.2 + +* Bumped lower bound on deepseq to 1.4 for compatibility with the + upcoming GHC 7.10 + +#### 1.2.0.1 + +* Fixed a buffer overflow in rendering of large Integers + (https://github.com/bos/text/issues/99) + +## 1.2.0.0 + +* Fixed an integer overflow in the replace function + (https://github.com/bos/text/issues/81) + +* Fixed a hang in lazy decodeUtf8With + (https://github.com/bos/text/issues/87) + +* Reduced codegen bloat caused by use of empty and single-character + literals + +* Added an instance of IsList for GHC 7.8 and above + +### 1.1.1.0 + +* The Data.Data instance now allows gunfold to work, via a virtual + pack constructor + +* dropEnd, takeEnd: new functions + +* Comparing the length of a Text against a number can now + short-circuit in more cases + +#### 1.1.0.1 + +* streamDecodeUtf8: fixed gh-70, did not return all unconsumed bytes + in single-byte chunks + +## 1.1.0.0 + +* encodeUtf8: Performance is improved by up to 4x. + +* encodeUtf8Builder, encodeUtf8BuilderEscaped: new functions, + available only if bytestring >= 0.10.4.0 is installed, that allow + very fast and flexible encoding of a Text value to a bytestring + Builder. + + As an example of the performance gain to be had, the + encodeUtf8BuilderEscaped function helps to double the speed of JSON + encoding in the latest version of aeson! (Note: if all you need is a + plain ByteString, encodeUtf8 is still the faster way to go.) + +* All of the internal module hierarchy is now publicly exposed. If a + module is in the .Internal hierarchy, or is documented as internal, + use at your own risk - there are no API stability guarantees for + internal modules! + +#### 1.0.0.1 + +* decodeUtf8: Fixed a regression that caused us to incorrectly + identify truncated UTF-8 as valid (gh-61) + +# 1.0.0.0 + +* Added support for Unicode 6.3.0 to case conversion functions + +* New function toTitle converts words in a string to title case + +* New functions peekCStringLen and withCStringLen simplify + interoperability with C functions + +* Added support for decoding UTF-8 in stream-friendly fashion + +* Fixed a bug in mapAccumL + +* Added trusted Haskell support + +* Removed support for GHC 6.10 (released in 2008) and older diff --git a/src/Data/Text.hs b/src/Data/Text.hs --- a/src/Data/Text.hs +++ b/src/Data/Text.hs @@ -370,8 +370,21 @@ readsPrec p str = [(pack x,y) | (x,y) <- readsPrec p str] -- | @since 1.2.2.0 +-- +-- Beware: @stimes@ will crash if the given number does not fit into +-- an @Int@. instance Semigroup Text where (<>) = append + + stimes howManyTimes + | howManyTimes < 0 = P.error "Data.Text.stimes: given number is negative!" + | otherwise = + let howManyTimesInt = P.fromIntegral howManyTimes :: Int + in if P.fromIntegral howManyTimesInt == howManyTimes && howManyTimesInt >= 0 + then replicate howManyTimesInt + else P.error "Data.Text.stimes: given number does not fit into an Int!" + + sconcat = concat . NonEmptyList.toList instance Monoid Text where mempty = empty diff --git a/src/Data/Text/Encoding/Error.hs b/src/Data/Text/Encoding/Error.hs --- a/src/Data/Text/Encoding/Error.hs +++ b/src/Data/Text/Encoding/Error.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE CPP, DeriveDataTypeable #-} +{-# LANGUAGE CPP #-} {-# LANGUAGE Safe #-} -- | -- Module : Data.Text.Encoding.Error @@ -36,7 +36,6 @@ import Control.DeepSeq (NFData (..)) import Control.Exception (Exception, throw) -import Data.Typeable (Typeable) import Data.Word (Word8) import Numeric (showHex) @@ -74,7 +73,7 @@ | EncodeError String (Maybe Char) -- ^ Tried to encode a character that could not be represented -- under the given encoding, or ran out of input in mid-encode. - deriving (Eq, Typeable) + deriving (Eq) {-# DEPRECATED EncodeError "This constructor is never used, and will be removed." #-} diff --git a/src/Data/Text/Internal.hs b/src/Data/Text/Internal.hs --- a/src/Data/Text/Internal.hs +++ b/src/Data/Text/Internal.hs @@ -1,6 +1,5 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} -{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE UnboxedTuples #-} {-# OPTIONS_HADDOCK not-home #-} @@ -58,7 +57,6 @@ import Data.Bits import Data.Int (Int32, Int64) import Data.Text.Internal.Unsafe.Char (ord, unsafeWrite) -import Data.Typeable (Typeable) import qualified Data.Text.Array as A -- | A space efficient, packed, unboxed Unicode text type. @@ -66,7 +64,6 @@ {-# UNPACK #-} !A.Array -- ^ bytearray encoded as UTF-8 {-# UNPACK #-} !Int -- ^ offset in bytes (not in Char!), pointing to a start of UTF-8 sequence {-# UNPACK #-} !Int -- ^ length in bytes (not in Char!), pointing to an end of UTF-8 sequence - deriving (Typeable) -- | Type synonym for the strict flavour of 'Text'. type StrictText = Text diff --git a/src/Data/Text/Internal/Encoding/Utf8.hs b/src/Data/Text/Internal/Encoding/Utf8.hs --- a/src/Data/Text/Internal/Encoding/Utf8.hs +++ b/src/Data/Text/Internal/Encoding/Utf8.hs @@ -48,7 +48,7 @@ import Control.Exception (assert) import GHC.Stack (HasCallStack) #endif -import Data.Bits (Bits(..), FiniteBits(..)) +import Data.Bits (Bits(..)) import Data.Char (ord, chr) import GHC.Exts import GHC.Word (Word8(..)) @@ -80,22 +80,13 @@ utf8Length (C# c) = I# ((1# +# geChar# c (chr# 0x80#)) +# (geChar# c (chr# 0x800#) +# geChar# c (chr# 0x10000#))) {-# INLINE utf8Length #-} --- This is a branchless version of --- utf8LengthByLeader w --- | w < 0x80 = 1 --- | w < 0xE0 = 2 --- | w < 0xF0 = 3 --- | otherwise = 4 --- --- c `xor` I# (c# <=# 0#) is a branchless equivalent of c `max` 1. --- It is crucial to write c# <=# 0# and not c# ==# 0#, otherwise --- GHC is tempted to "optimize" by introduction of branches. - -- | @since 2.0 utf8LengthByLeader :: Word8 -> Int -utf8LengthByLeader w = c `xor` I# (c# <=# 0#) - where - !c@(I# c#) = countLeadingZeros (complement w) +utf8LengthByLeader w + | w < 0x80 = 1 + | w < 0xE0 = 2 + | w < 0xF0 = 3 + | otherwise = 4 {-# INLINE utf8LengthByLeader #-} ord2 :: diff --git a/src/Data/Text/Internal/Fusion/CaseMapping.hs b/src/Data/Text/Internal/Fusion/CaseMapping.hs --- a/src/Data/Text/Internal/Fusion/CaseMapping.hs +++ b/src/Data/Text/Internal/Fusion/CaseMapping.hs @@ -350,6 +350,7 @@ '\x0195'# -> unI64 502 '\x0199'# -> unI64 408 '\x019a'# -> unI64 573 + '\x019b'# -> unI64 42972 '\x019e'# -> unI64 544 '\x01a1'# -> unI64 416 '\x01a3'# -> unI64 418 @@ -440,6 +441,7 @@ '\x0260'# -> unI64 403 '\x0261'# -> unI64 42924 '\x0263'# -> unI64 404 + '\x0264'# -> unI64 42955 '\x0265'# -> unI64 42893 '\x0266'# -> unI64 42922 '\x0268'# -> unI64 407 @@ -776,6 +778,7 @@ '\x1c86'# -> unI64 1066 '\x1c87'# -> unI64 1122 '\x1c88'# -> unI64 42570 + '\x1c8a'# -> unI64 7305 '\x1d79'# -> unI64 42877 '\x1d7d'# -> unI64 11363 '\x1d8e'# -> unI64 42950 @@ -1272,9 +1275,11 @@ '\xa7c3'# -> unI64 42946 '\xa7c8'# -> unI64 42951 '\xa7ca'# -> unI64 42953 + '\xa7cd'# -> unI64 42956 '\xa7d1'# -> unI64 42960 '\xa7d7'# -> unI64 42966 '\xa7d9'# -> unI64 42968 + '\xa7db'# -> unI64 42970 '\xa7f6'# -> unI64 42997 '\xab53'# -> unI64 42931 '\xab70'# -> unI64 5024 @@ -1545,6 +1550,28 @@ '\x10cf0'# -> unI64 68784 '\x10cf1'# -> unI64 68785 '\x10cf2'# -> unI64 68786 + '\x10d70'# -> unI64 68944 + '\x10d71'# -> unI64 68945 + '\x10d72'# -> unI64 68946 + '\x10d73'# -> unI64 68947 + '\x10d74'# -> unI64 68948 + '\x10d75'# -> unI64 68949 + '\x10d76'# -> unI64 68950 + '\x10d77'# -> unI64 68951 + '\x10d78'# -> unI64 68952 + '\x10d79'# -> unI64 68953 + '\x10d7a'# -> unI64 68954 + '\x10d7b'# -> unI64 68955 + '\x10d7c'# -> unI64 68956 + '\x10d7d'# -> unI64 68957 + '\x10d7e'# -> unI64 68958 + '\x10d7f'# -> unI64 68959 + '\x10d80'# -> unI64 68960 + '\x10d81'# -> unI64 68961 + '\x10d82'# -> unI64 68962 + '\x10d83'# -> unI64 68963 + '\x10d84'# -> unI64 68964 + '\x10d85'# -> unI64 68965 '\x118c0'# -> unI64 71840 '\x118c1'# -> unI64 71841 '\x118c2'# -> unI64 71842 @@ -2243,6 +2270,7 @@ '\x13f3'# -> unI64 5115 '\x13f4'# -> unI64 5116 '\x13f5'# -> unI64 5117 + '\x1c89'# -> unI64 7306 '\x1c90'# -> unI64 4304 '\x1c91'# -> unI64 4305 '\x1c92'# -> unI64 4306 @@ -2791,9 +2819,13 @@ '\xa7c6'# -> unI64 7566 '\xa7c7'# -> unI64 42952 '\xa7c9'# -> unI64 42954 + '\xa7cb'# -> unI64 612 + '\xa7cc'# -> unI64 42957 '\xa7d0'# -> unI64 42961 '\xa7d6'# -> unI64 42967 '\xa7d8'# -> unI64 42969 + '\xa7da'# -> unI64 42971 + '\xa7dc'# -> unI64 411 '\xa7f5'# -> unI64 42998 '\xff21'# -> unI64 65345 '\xff22'# -> unI64 65346 @@ -2983,6 +3015,28 @@ '\x10cb0'# -> unI64 68848 '\x10cb1'# -> unI64 68849 '\x10cb2'# -> unI64 68850 + '\x10d50'# -> unI64 68976 + '\x10d51'# -> unI64 68977 + '\x10d52'# -> unI64 68978 + '\x10d53'# -> unI64 68979 + '\x10d54'# -> unI64 68980 + '\x10d55'# -> unI64 68981 + '\x10d56'# -> unI64 68982 + '\x10d57'# -> unI64 68983 + '\x10d58'# -> unI64 68984 + '\x10d59'# -> unI64 68985 + '\x10d5a'# -> unI64 68986 + '\x10d5b'# -> unI64 68987 + '\x10d5c'# -> unI64 68988 + '\x10d5d'# -> unI64 68989 + '\x10d5e'# -> unI64 68990 + '\x10d5f'# -> unI64 68991 + '\x10d60'# -> unI64 68992 + '\x10d61'# -> unI64 68993 + '\x10d62'# -> unI64 68994 + '\x10d63'# -> unI64 68995 + '\x10d64'# -> unI64 68996 + '\x10d65'# -> unI64 68997 '\x118a0'# -> unI64 71872 '\x118a1'# -> unI64 71873 '\x118a2'# -> unI64 71874 @@ -3311,6 +3365,7 @@ '\x0195'# -> unI64 502 '\x0199'# -> unI64 408 '\x019a'# -> unI64 573 + '\x019b'# -> unI64 42972 '\x019e'# -> unI64 544 '\x01a1'# -> unI64 416 '\x01a3'# -> unI64 418 @@ -3401,6 +3456,7 @@ '\x0260'# -> unI64 403 '\x0261'# -> unI64 42924 '\x0263'# -> unI64 404 + '\x0264'# -> unI64 42955 '\x0265'# -> unI64 42893 '\x0266'# -> unI64 42922 '\x0268'# -> unI64 407 @@ -3691,6 +3747,7 @@ '\x1c86'# -> unI64 1066 '\x1c87'# -> unI64 1122 '\x1c88'# -> unI64 42570 + '\x1c8a'# -> unI64 7305 '\x1d79'# -> unI64 42877 '\x1d7d'# -> unI64 11363 '\x1d8e'# -> unI64 42950 @@ -4214,9 +4271,11 @@ '\xa7c3'# -> unI64 42946 '\xa7c8'# -> unI64 42951 '\xa7ca'# -> unI64 42953 + '\xa7cd'# -> unI64 42956 '\xa7d1'# -> unI64 42960 '\xa7d7'# -> unI64 42966 '\xa7d9'# -> unI64 42968 + '\xa7db'# -> unI64 42970 '\xa7f6'# -> unI64 42997 '\xab53'# -> unI64 42931 '\xab70'# -> unI64 5024 @@ -4487,6 +4546,28 @@ '\x10cf0'# -> unI64 68784 '\x10cf1'# -> unI64 68785 '\x10cf2'# -> unI64 68786 + '\x10d70'# -> unI64 68944 + '\x10d71'# -> unI64 68945 + '\x10d72'# -> unI64 68946 + '\x10d73'# -> unI64 68947 + '\x10d74'# -> unI64 68948 + '\x10d75'# -> unI64 68949 + '\x10d76'# -> unI64 68950 + '\x10d77'# -> unI64 68951 + '\x10d78'# -> unI64 68952 + '\x10d79'# -> unI64 68953 + '\x10d7a'# -> unI64 68954 + '\x10d7b'# -> unI64 68955 + '\x10d7c'# -> unI64 68956 + '\x10d7d'# -> unI64 68957 + '\x10d7e'# -> unI64 68958 + '\x10d7f'# -> unI64 68959 + '\x10d80'# -> unI64 68960 + '\x10d81'# -> unI64 68961 + '\x10d82'# -> unI64 68962 + '\x10d83'# -> unI64 68963 + '\x10d84'# -> unI64 68964 + '\x10d85'# -> unI64 68965 '\x118c0'# -> unI64 71840 '\x118c1'# -> unI64 71841 '\x118c2'# -> unI64 71842 diff --git a/src/Data/Text/Internal/IO.hs b/src/Data/Text/Internal/IO.hs --- a/src/Data/Text/Internal/IO.hs +++ b/src/Data/Text/Internal/IO.hs @@ -1,306 +1,308 @@ -{-# LANGUAGE BangPatterns, RecordWildCards #-} -{-# LANGUAGE MagicHash #-} --- | --- Module : Data.Text.Internal.IO --- Copyright : (c) 2009, 2010 Bryan O'Sullivan, --- (c) 2009 Simon Marlow --- License : BSD-style --- Maintainer : bos@serpentine.com --- Stability : experimental --- Portability : GHC --- --- /Warning/: this is an internal module, and does not have a stable --- API or name. Functions in this module may not check or enforce --- preconditions expected by public modules. Use at your own risk! --- --- Low-level support for text I\/O. - -module Data.Text.Internal.IO - ( - hGetLineWith - , readChunk - , hPutStream - , hPutStr - , hPutStrLn - ) where - -import qualified Control.Exception as E -import qualified Data.ByteString as B -import Data.ByteString.Builder (hPutBuilder, charUtf8) -import Data.IORef (readIORef, writeIORef) -import Data.Text (Text) -import Data.Text.Encoding (encodeUtf8, encodeUtf8Builder) -import Data.Text.Internal.Fusion (stream, streamLn, unstream) -import Data.Text.Internal.Fusion.Types (Step(..), Stream(..)) -import Data.Text.Internal.Fusion.Size (exactSize, maxSize) -import Data.Text.Unsafe (inlinePerformIO) -import Foreign.Storable (peekElemOff) -import GHC.Exts (reallyUnsafePtrEquality#, isTrue#) -import GHC.IO.Buffer (Buffer(..), BufferState(..), CharBuffer, RawCharBuffer, - bufferAdjustL, bufferElems, charSize, emptyBuffer, - isEmptyBuffer, newCharBuffer, readCharBuf, withRawBuffer, - writeCharBuf) -import GHC.IO.Handle.Internals (ioe_EOF, readTextDevice, wantReadableHandle_, - wantWritableHandle) -import GHC.IO.Handle.Text (commitBuffer') -import GHC.IO.Handle.Types (BufferList(..), BufferMode(..), Handle__(..), Newline(..)) -import System.IO (Handle, hPutChar, utf8) -import System.IO.Error (isEOFError) -import qualified Data.Text as T - --- | Read a single line of input from a handle, constructing a list of --- decoded chunks as we go. When we're done, transform them into the --- destination type. -hGetLineWith :: ([Text] -> t) -> Handle -> IO t -hGetLineWith f h = wantReadableHandle_ "hGetLine" h go - where - go hh@Handle__{..} = readIORef haCharBuffer >>= fmap f . hGetLineLoop hh [] - -hGetLineLoop :: Handle__ -> [Text] -> CharBuffer -> IO [Text] -hGetLineLoop hh@Handle__{..} = go where - go ts buf@Buffer{ bufL=r0, bufR=w, bufRaw=raw0 } = do - let findEOL raw r | r == w = return (False, w) - | otherwise = do - (c,r') <- readCharBuf raw r - if c == '\n' - then return (True, r) - else findEOL raw r' - (eol, off) <- findEOL raw0 r0 - (t,r') <- if haInputNL == CRLF - then unpack_nl raw0 r0 off - else do t <- unpack raw0 r0 off - return (t,off) - if eol - then do writeIORef haCharBuffer (bufferAdjustL (off+1) buf) - return $ reverse (t:ts) - else do - let buf1 = bufferAdjustL r' buf - maybe_buf <- maybeFillReadBuffer hh buf1 - case maybe_buf of - -- Nothing indicates we caught an EOF, and we may have a - -- partial line to return. - Nothing -> do - -- we reached EOF. There might be a lone \r left - -- in the buffer, so check for that and - -- append it to the line if necessary. - let pre | isEmptyBuffer buf1 = T.empty - | otherwise = T.singleton '\r' - writeIORef haCharBuffer buf1{ bufL=0, bufR=0 } - let str = reverse . filter (not . T.null) $ pre:t:ts - if null str - then ioe_EOF - else return str - Just new_buf -> go (t:ts) new_buf - --- This function is lifted almost verbatim from GHC.IO.Handle.Text. -maybeFillReadBuffer :: Handle__ -> CharBuffer -> IO (Maybe CharBuffer) -maybeFillReadBuffer handle_ buf - = E.catch (Just `fmap` getSomeCharacters handle_ buf) $ \e -> - if isEOFError e - then return Nothing - else ioError e - -unpack :: RawCharBuffer -> Int -> Int -> IO Text -unpack !buf !r !w - | charSize /= 4 = sizeError "unpack" - | r >= w = return T.empty - | otherwise = withRawBuffer buf go - where - go pbuf = return $! unstream (Stream next r (exactSize (w-r))) - where - next !i | i >= w = Done - | otherwise = Yield (ix i) (i+1) - ix i = inlinePerformIO $ peekElemOff pbuf i - -unpack_nl :: RawCharBuffer -> Int -> Int -> IO (Text, Int) -unpack_nl !buf !r !w - | charSize /= 4 = sizeError "unpack_nl" - | r >= w = return (T.empty, 0) - | otherwise = withRawBuffer buf $ go - where - go pbuf = do - let !t = unstream (Stream next r (maxSize (w-r))) - w' = w - 1 - return $ if ix w' == '\r' - then (t,w') - else (t,w) - where - next !i | i >= w = Done - | c == '\r' = let i' = i + 1 - in if i' < w - then if ix i' == '\n' - then Yield '\n' (i+2) - else Yield '\n' i' - else Done - | otherwise = Yield c (i+1) - where c = ix i - ix i = inlinePerformIO $ peekElemOff pbuf i - --- This function is completely lifted from GHC.IO.Handle.Text. -getSomeCharacters :: Handle__ -> CharBuffer -> IO CharBuffer -getSomeCharacters handle_@Handle__{..} buf@Buffer{..} = - case bufferElems buf of - -- buffer empty: read some more - 0 -> {-# SCC "readTextDevice" #-} readTextDevice handle_ buf - - -- if the buffer has a single '\r' in it and we're doing newline - -- translation: read some more - 1 | haInputNL == CRLF -> do - (c,_) <- readCharBuf bufRaw bufL - if c == '\r' - then do -- shuffle the '\r' to the beginning. This is only safe - -- if we're about to call readTextDevice, otherwise it - -- would mess up flushCharBuffer. - -- See [note Buffer Flushing], GHC.IO.Handle.Types - _ <- writeCharBuf bufRaw 0 '\r' - let buf' = buf{ bufL=0, bufR=1 } - readTextDevice handle_ buf' - else do - return buf - - -- buffer has some chars in it already: just return it - _otherwise -> {-# SCC "otherwise" #-} return buf - --- | Read a single chunk of strict text from a buffer. Used by both --- the strict and lazy implementations of hGetContents. -readChunk :: Handle__ -> CharBuffer -> IO Text -readChunk hh@Handle__{..} buf = do - buf'@Buffer{..} <- getSomeCharacters hh buf - (t,r) <- if haInputNL == CRLF - then unpack_nl bufRaw bufL bufR - else do t <- unpack bufRaw bufL bufR - return (t,bufR) - writeIORef haCharBuffer (bufferAdjustL r buf') - return t - --- | Print a @Stream Char@. -hPutStream :: Handle -> Stream Char -> IO () -hPutStream h str = hPutStreamOrUtf8 h str Nothing - --- | Write a string to a handle. -hPutStr :: Handle -> Text -> IO () -hPutStr h t = hPutStreamOrUtf8 h (stream t) (Just putUtf8) - where - putUtf8 = B.hPutStr h (encodeUtf8 t) - --- | Write a string to a handle, followed by a newline. -hPutStrLn :: Handle -> Text -> IO () -hPutStrLn h t = hPutStreamOrUtf8 h (streamLn t) (Just putUtf8) - where - -- Not using B.hPutStrLn because it's not necessarily atomic: - -- https://github.com/haskell/bytestring/issues/200 - putUtf8 = hPutBuilder h (encodeUtf8Builder t <> charUtf8 '\n') - --- | 'hPutStream' with an optional special case when the output encoding is --- UTF-8 and without newline conversion. -hPutStreamOrUtf8 :: Handle -> Stream Char -> Maybe (IO ()) -> IO () --- This function is modified from GHC.IO.Handle.Text. -hPutStreamOrUtf8 h str mPutUtf8 = do - (buffer_mode, nl, isUtf8) <- - wantWritableHandle "hPutStr" h $ \h_ -> do - bmode <- getSpareBuffer h_ - return (bmode, haOutputNL h_, eqUTF8 h_) - case buffer_mode of - _ | Just putUtf8 <- mPutUtf8, nl == LF && isUtf8 -> putUtf8 - (NoBuffering, _) -> hPutChars h str - (LineBuffering, buf) -> writeLines h nl buf str - (BlockBuffering _, buf) -> writeBlocks (nl == CRLF) h buf str - - where - -- If the encoding is UTF-8, it's most likely pointer-equal to - -- 'System.IO.utf8', letting us avoid a String comparison. - -- If it is somehow UTF-8 but not pointer-equal to 'utf8', - -- we will just take a slower branch, but the result is still correct. - eqUTF8 = maybe False (\enc -> isTrue# (reallyUnsafePtrEquality# utf8 enc)) . haCodec -{-# INLINE hPutStreamOrUtf8 #-} - -hPutChars :: Handle -> Stream Char -> IO () -hPutChars h (Stream next0 s0 _len) = loop s0 - where - loop !s = case next0 s of - Done -> return () - Skip s' -> loop s' - Yield x s' -> hPutChar h x >> loop s' - --- The following functions are largely lifted from GHC.IO.Handle.Text, --- but adapted to a coinductive stream of data instead of an inductive --- list. --- --- We have several variations of more or less the same code for --- performance reasons. Splitting the original buffered write --- function into line- and block-oriented versions gave us a 2.1x --- performance improvement. Lifting out the raw/cooked newline --- handling gave a few more percent on top. - -writeLines :: Handle -> Newline -> CharBuffer -> Stream Char -> IO () -writeLines h nl buf0 (Stream next0 s0 _len) = outer s0 buf0 - where - outer s1 Buffer{bufRaw=raw, bufSize=len} = inner s1 (0::Int) - where - inner !s !n = - case next0 s of - Done -> commit n False{-no flush-} True{-release-} >> return () - Skip s' -> inner s' n - Yield x s' - | n + 1 >= len -> commit n True{-needs flush-} False >>= outer s - | x == '\n' -> do - n' <- if nl == CRLF - then do n1 <- writeCharBuf' raw len n '\r' - writeCharBuf' raw len n1 '\n' - else writeCharBuf' raw len n x - commit n' True{-needs flush-} False >>= outer s' - | otherwise -> writeCharBuf' raw len n x >>= inner s' - commit = commitBuffer h raw len - -writeBlocks :: Bool -> Handle -> CharBuffer -> Stream Char -> IO () -writeBlocks isCRLF h buf0 (Stream next0 s0 _len) = outer s0 buf0 - where - outer s1 Buffer{bufRaw=raw, bufSize=len} = inner s1 (0::Int) - where - inner !s !n = - case next0 s of - Done -> commit n False{-no flush-} True{-release-} >> return () - Skip s' -> inner s' n - Yield x s' - | isCRLF && x == '\n' && n + 1 < len -> do - n1 <- writeCharBuf' raw len n '\r' - writeCharBuf' raw len n1 '\n' >>= inner s' - | n < len -> writeCharBuf' raw len n x >>= inner s' - | otherwise -> commit n True{-needs flush-} False >>= outer s - commit = commitBuffer h raw len - --- | Only modifies the raw buffer and not the buffer attributes -writeCharBuf' :: RawCharBuffer -> Int -> Int -> Char -> IO Int -writeCharBuf' bufRaw bufSize n c = E.assert (n >= 0 && n < bufSize) $ - writeCharBuf bufRaw n c - --- This function is completely lifted from GHC.IO.Handle.Text. -getSpareBuffer :: Handle__ -> IO (BufferMode, CharBuffer) -getSpareBuffer Handle__{haCharBuffer=ref, - haBuffers=spare_ref, - haBufferMode=mode} - = do - case mode of - NoBuffering -> return (mode, error "no buffer!") - _ -> do - bufs <- readIORef spare_ref - buf <- readIORef ref - case bufs of - BufferListCons b rest -> do - writeIORef spare_ref rest - return ( mode, emptyBuffer b (bufSize buf) WriteBuffer) - BufferListNil -> do - new_buf <- newCharBuffer (bufSize buf) WriteBuffer - return (mode, new_buf) - - --- This function is modified from GHC.Internal.IO.Handle.Text. -commitBuffer :: Handle -> RawCharBuffer -> Int -> Int -> Bool -> Bool - -> IO CharBuffer -commitBuffer hdl !raw !sz !count flush release = - wantWritableHandle "commitAndReleaseBuffer" hdl $ - commitBuffer' raw sz count flush release -{-# INLINE commitBuffer #-} - -sizeError :: String -> a -sizeError loc = error $ "Data.Text.IO." ++ loc ++ ": bad internal buffer size" +{-# LANGUAGE BangPatterns, RecordWildCards #-} +{-# LANGUAGE MagicHash #-} +-- | +-- Module : Data.Text.Internal.IO +-- Copyright : (c) 2009, 2010 Bryan O'Sullivan, +-- (c) 2009 Simon Marlow +-- License : BSD-style +-- Maintainer : bos@serpentine.com +-- Stability : experimental +-- Portability : GHC +-- +-- /Warning/: this is an internal module, and does not have a stable +-- API or name. Functions in this module may not check or enforce +-- preconditions expected by public modules. Use at your own risk! +-- +-- Low-level support for text I\/O. + +module Data.Text.Internal.IO + ( + hGetLineWith + , readChunk + , hPutStream + , hPutStr + , hPutStrLn + ) where + +import qualified Control.Exception as E +import qualified Data.ByteString as B +import Data.ByteString.Builder (hPutBuilder, charUtf8) +import Data.IORef (readIORef, writeIORef) +import Data.Text (Text) +import Data.Text.Encoding (encodeUtf8, encodeUtf8Builder) +import Data.Text.Internal.Fusion (stream, streamLn, unstream) +import Data.Text.Internal.Fusion.Types (Step(..), Stream(..)) +import Data.Text.Internal.Fusion.Size (exactSize, maxSize) +import Data.Text.Unsafe (inlinePerformIO) +import Foreign.Storable (peekElemOff) +import GHC.Exts (reallyUnsafePtrEquality#, isTrue#) +import GHC.IO.Buffer (Buffer(..), BufferState(..), CharBuffer, RawCharBuffer, + bufferAdjustL, bufferElems, charSize, emptyBuffer, + isEmptyBuffer, newCharBuffer, readCharBuf, withRawBuffer, + writeCharBuf) +import GHC.IO.Handle.Internals (ioe_EOF, readTextDevice, wantReadableHandle_, + wantWritableHandle) +import GHC.IO.Handle.Text (commitBuffer') +import GHC.IO.Handle.Types (BufferList(..), BufferMode(..), Handle__(..), Newline(..)) +import System.IO (Handle, hPutChar, utf8) +import System.IO.Error (isEOFError) +import qualified Data.Text as T + +-- | Read a single line of input from a handle, constructing a list of +-- decoded chunks as we go. When we're done, transform them into the +-- destination type. +hGetLineWith :: ([Text] -> t) -> Handle -> IO t +hGetLineWith f h = wantReadableHandle_ "hGetLine" h go + where + go hh@Handle__{..} = readIORef haCharBuffer >>= fmap f . hGetLineLoop hh [] + +hGetLineLoop :: Handle__ -> [Text] -> CharBuffer -> IO [Text] +hGetLineLoop hh@Handle__{..} = go where + go ts buf@Buffer{ bufL=r0, bufR=w, bufRaw=raw0 } = do + let findEOL raw r | r == w = return (False, w) + | otherwise = do + (c,r') <- readCharBuf raw r + if c == '\n' + then return (True, r) + else findEOL raw r' + (eol, off) <- findEOL raw0 r0 + (t,r') <- if haInputNL == CRLF + then unpack_nl raw0 r0 off + else do t <- unpack raw0 r0 off + return (t,off) + if eol + then do writeIORef haCharBuffer (bufferAdjustL (off+1) buf) + return $ reverse (t:ts) + else do + let buf1 = bufferAdjustL r' buf + maybe_buf <- maybeFillReadBuffer hh buf1 + case maybe_buf of + -- Nothing indicates we caught an EOF, and we may have a + -- partial line to return. + Nothing -> do + -- we reached EOF. There might be a lone \r left + -- in the buffer, so check for that and + -- append it to the line if necessary. + let pre | isEmptyBuffer buf1 = T.empty + | otherwise = T.singleton '\r' + writeIORef haCharBuffer buf1{ bufL=0, bufR=0 } + let str = reverse . filter (not . T.null) $ pre:t:ts + if null str + then ioe_EOF + else return str + Just new_buf -> go (t:ts) new_buf + +-- This function is lifted almost verbatim from GHC.IO.Handle.Text. +maybeFillReadBuffer :: Handle__ -> CharBuffer -> IO (Maybe CharBuffer) +maybeFillReadBuffer handle_ buf + = E.catch (Just `fmap` getSomeCharacters handle_ buf) $ \e -> + if isEOFError e + then return Nothing + else ioError e + +unpack :: RawCharBuffer -> Int -> Int -> IO Text +unpack !buf !r !w + | charSize /= 4 = sizeError "unpack" + | r >= w = return T.empty + | otherwise = withRawBuffer buf go + where + go pbuf = return $! unstream (Stream next r (exactSize (w-r))) + where + next !i | i >= w = Done + | otherwise = Yield (ix i) (i+1) + ix i = inlinePerformIO $ peekElemOff pbuf i + +-- Variant of 'unpack' with CRLF decoding. If there is a trailing '\r', leave it in the buffer. +unpack_nl :: RawCharBuffer -> Int -> Int -> IO (Text, Int) +unpack_nl !buf !r !w + | charSize /= 4 = sizeError "unpack_nl" + | r >= w = return (T.empty, 0) + | otherwise = withRawBuffer buf $ go + where + go pbuf = do + let !t = unstream (Stream next r (maxSize (w-r))) + w' = w - 1 + return $ if ix w' == '\r' + then (t,w') + else (t,w) + where + next !i | i >= w = Done + | c == '\r' = let i' = i + 1 + in if i' < w + then if ix i' == '\n' + then Yield '\n' (i+2) + else Yield '\r' i' + else Done + | otherwise = Yield c (i+1) + where c = ix i + ix i = inlinePerformIO $ peekElemOff pbuf i + +-- This function is completely lifted from GHC.IO.Handle.Text. +getSomeCharacters :: Handle__ -> CharBuffer -> IO CharBuffer +getSomeCharacters handle_@Handle__{..} buf@Buffer{..} = + case bufferElems buf of + -- buffer empty: read some more + 0 -> {-# SCC "readTextDevice" #-} readTextDevice handle_ buf + + -- if the buffer has a single '\r' in it and we're doing newline + -- translation: read some more + 1 | haInputNL == CRLF -> do + (c,_) <- readCharBuf bufRaw bufL + if c == '\r' + then do -- shuffle the '\r' to the beginning. This is only safe + -- if we're about to call readTextDevice, otherwise it + -- would mess up flushCharBuffer. + -- See [note Buffer Flushing], GHC.IO.Handle.Types + _ <- writeCharBuf bufRaw 0 '\r' + let buf' = buf{ bufL=0, bufR=1 } + readTextDevice handle_ buf' + else do + return buf + + -- buffer has some chars in it already: just return it + _otherwise -> {-# SCC "otherwise" #-} return buf + +-- | Read a single chunk of strict text from a buffer. Used by both +-- the strict and lazy implementations of hGetContents. +readChunk :: Handle__ -> CharBuffer -> IO Text +readChunk hh@Handle__{..} buf = do + buf'@Buffer{..} <- getSomeCharacters hh buf + (t,r) <- if haInputNL == CRLF + then unpack_nl bufRaw bufL bufR + else do t <- unpack bufRaw bufL bufR + return (t,bufR) + writeIORef haCharBuffer (bufferAdjustL r buf') + return t + +-- | Print a @Stream Char@. +hPutStream :: Handle -> Stream Char -> IO () +hPutStream h str = hPutStreamOrUtf8 h str Nothing + +-- | Write a string to a handle. +hPutStr :: Handle -> Text -> IO () +hPutStr h t = hPutStreamOrUtf8 h (stream t) (Just putUtf8) + where + putUtf8 = B.hPutStr h (encodeUtf8 t) + +-- | Write a string to a handle, followed by a newline. +hPutStrLn :: Handle -> Text -> IO () +hPutStrLn h t = hPutStreamOrUtf8 h (streamLn t) (Just putUtf8) + where + -- Not using B.hPutStrLn because it's not necessarily atomic: + -- https://github.com/haskell/bytestring/issues/200 + putUtf8 = hPutBuilder h (encodeUtf8Builder t <> charUtf8 '\n') + +-- | 'hPutStream' with an optional special case when the output encoding is +-- UTF-8 and without newline conversion. +hPutStreamOrUtf8 :: Handle -> Stream Char -> Maybe (IO ()) -> IO () +-- This function is modified from GHC.IO.Handle.Text. +hPutStreamOrUtf8 h str mPutUtf8 = do + (buffer_mode, nl, isUtf8) <- + wantWritableHandle "hPutStr" h $ \h_ -> do + bmode <- getSpareBuffer h_ + return (bmode, haOutputNL h_, eqUTF8 h_) + case buffer_mode of + _ | Just putUtf8 <- mPutUtf8, nl == LF && isUtf8 -> putUtf8 + (NoBuffering, _) -> hPutChars h str + (LineBuffering, buf) -> writeLines h nl buf str + (BlockBuffering _, buf) -> writeBlocks (nl == CRLF) h buf str + + where + -- If the encoding is UTF-8, it's most likely pointer-equal to + -- 'System.IO.utf8', letting us avoid a String comparison. + -- If it is somehow UTF-8 but not pointer-equal to 'utf8', + -- we will just take a slower branch, but the result is still correct. + eqUTF8 = maybe False (\enc -> isTrue# (reallyUnsafePtrEquality# utf8 enc)) . haCodec +{-# INLINE hPutStreamOrUtf8 #-} + +hPutChars :: Handle -> Stream Char -> IO () +hPutChars h (Stream next0 s0 _len) = loop s0 + where + loop !s = case next0 s of + Done -> return () + Skip s' -> loop s' + Yield x s' -> hPutChar h x >> loop s' + +-- The following functions are largely lifted from GHC.IO.Handle.Text, +-- but adapted to a coinductive stream of data instead of an inductive +-- list. +-- +-- We have several variations of more or less the same code for +-- performance reasons. Splitting the original buffered write +-- function into line- and block-oriented versions gave us a 2.1x +-- performance improvement. Lifting out the raw/cooked newline +-- handling gave a few more percent on top. + +writeLines :: Handle -> Newline -> CharBuffer -> Stream Char -> IO () +writeLines h nl buf0 (Stream next0 s0 _len) = outer s0 buf0 + where + outer s1 Buffer{bufRaw=raw, bufSize=len} = inner s1 (0::Int) + where + inner !s !n = + case next0 s of + Done -> commit n False{-no flush-} True{-release-} >> return () + Skip s' -> inner s' n + Yield x s' + | n + 1 >= len -> commit n True{-needs flush-} False >>= outer s + | x == '\n' -> do + n' <- if nl == CRLF + then do n1 <- writeCharBuf' raw len n '\r' + writeCharBuf' raw len n1 '\n' + else writeCharBuf' raw len n x + commit n' True{-needs flush-} False >>= outer s' + | otherwise -> writeCharBuf' raw len n x >>= inner s' + commit = commitBuffer h raw len + +writeBlocks :: Bool -> Handle -> CharBuffer -> Stream Char -> IO () +writeBlocks isCRLF h buf0 (Stream next0 s0 _len) = outer s0 buf0 + where + outer s1 Buffer{bufRaw=raw, bufSize=len} = inner s1 (0::Int) + where + inner !s !n = + case next0 s of + Done -> commit n False{-no flush-} True{-release-} >> return () + Skip s' -> inner s' n + Yield x s' + -- Leave room for two characters for CRLF decoding + | n + 1 >= len -> commit n True{-needs flush-} False >>= outer s + | x == '\n' && isCRLF -> do + n1 <- writeCharBuf' raw len n '\r' + writeCharBuf' raw len n1 '\n' >>= inner s' + | otherwise -> writeCharBuf' raw len n x >>= inner s' + commit = commitBuffer h raw len + +-- | Only modifies the raw buffer and not the buffer attributes +writeCharBuf' :: RawCharBuffer -> Int -> Int -> Char -> IO Int +writeCharBuf' bufRaw bufSize n c = E.assert (n >= 0 && n < bufSize) $ + writeCharBuf bufRaw n c + +-- This function is completely lifted from GHC.IO.Handle.Text. +getSpareBuffer :: Handle__ -> IO (BufferMode, CharBuffer) +getSpareBuffer Handle__{haCharBuffer=ref, + haBuffers=spare_ref, + haBufferMode=mode} + = do + case mode of + NoBuffering -> return (mode, error "no buffer!") + _ -> do + bufs <- readIORef spare_ref + buf <- readIORef ref + case bufs of + BufferListCons b rest -> do + writeIORef spare_ref rest + return ( mode, emptyBuffer b (bufSize buf) WriteBuffer) + BufferListNil -> do + new_buf <- newCharBuffer (bufSize buf) WriteBuffer + return (mode, new_buf) + + +-- This function is modified from GHC.Internal.IO.Handle.Text. +commitBuffer :: Handle -> RawCharBuffer -> Int -> Int -> Bool -> Bool + -> IO CharBuffer +commitBuffer hdl !raw !sz !count flush release = + wantWritableHandle "commitAndReleaseBuffer" hdl $ + commitBuffer' raw sz count flush release +{-# INLINE commitBuffer #-} + +sizeError :: String -> a +sizeError loc = error $ "Data.Text.IO." ++ loc ++ ": bad internal buffer size" diff --git a/src/Data/Text/Internal/Lazy.hs b/src/Data/Text/Internal/Lazy.hs --- a/src/Data/Text/Internal/Lazy.hs +++ b/src/Data/Text/Internal/Lazy.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE BangPatterns, DeriveDataTypeable #-} +{-# LANGUAGE BangPatterns #-} {-# OPTIONS_HADDOCK not-home #-} -- | @@ -43,7 +43,6 @@ import Data.Bits (shiftL) import Data.Text () -import Data.Typeable (Typeable) import Foreign.Storable (sizeOf) import qualified Data.Text.Array as A import qualified Data.Text.Internal as T @@ -55,7 +54,6 @@ -- @since 2.1.2 | Chunk {-# UNPACK #-} !T.Text Text -- ^ Chunks must be non-empty, this invariant is not checked. - deriving (Typeable) -- | Type synonym for the lazy flavour of 'Text'. type LazyText = Text diff --git a/src/Data/Text/Internal/Transformation.hs b/src/Data/Text/Internal/Transformation.hs --- a/src/Data/Text/Internal/Transformation.hs +++ b/src/Data/Text/Internal/Transformation.hs @@ -36,9 +36,9 @@ Ord(..), Monad(..), pure, (+), (-), ($), (&&), (||), (==), - not, return, otherwise, fromIntegral, (/=), const) + not, return, otherwise) import Data.Bits ((.&.), shiftR, shiftL) -import Data.Char (isLetter, isSpace, ord) +import Data.Char (isLetter, isSpace) import Control.Monad.ST (ST, runST) import qualified Data.Text.Array as A import Data.Text.Internal.Encoding.Utf8 (utf8LengthByLeader, chr2, chr3, chr4) @@ -47,7 +47,7 @@ import Data.Text.Internal.Unsafe.Char (unsafeWrite, unsafeChr8) import qualified Prelude as P import Data.Text.Unsafe (Iter(..), iterArray) -import Data.Word (Word8, Word) +import Data.Word (Word8) import qualified GHC.Exts as Exts import GHC.Int (Int64(..)) diff --git a/src/Data/Text/Lazy.hs b/src/Data/Text/Lazy.hs --- a/src/Data/Text/Lazy.hs +++ b/src/Data/Text/Lazy.hs @@ -328,6 +328,13 @@ -- | @since 1.2.2.0 instance Semigroup Text where (<>) = append + stimes n _ | n < 0 = P.error "Data.Text.Lazy.stimes: given number is negative!" + stimes n a = + let nInt64 = fromIntegral n :: Int64 + len = if n == fromIntegral nInt64 && nInt64 >= 0 then nInt64 else P.maxBound + -- We clamp the length to maxBound :: Int64. + -- To tell the difference, the caller would have to skip through 2^63 chunks. + in replicate len a instance Monoid Text where mempty = empty @@ -424,7 +431,23 @@ #endif Text -> String unpack t = S.unstreamList (stream t) -{-# INLINE [1] unpack #-} +{-# NOINLINE unpack #-} + +foldrFB :: (Char -> b -> b) -> b -> Text -> b +foldrFB = foldr +{-# INLINE [0] foldrFB #-} + +-- List fusion rules for `unpack`: +-- * `unpack` rewrites to `build` up till (but not including) phase 1. `build` +-- fuses if `foldr` is applied to it. +-- * If it doesn't fuse: In phase 1, `build` inlines to give us `foldrFB (:) []` +-- and we rewrite that back to `unpack`. +-- * If it fuses: In phase 0, `foldrFB` inlines and `foldr` inlines. GHC +-- optimizes the fused code. +{-# RULES +"Text.Lazy.unpack" [~1] forall t. unpack t = Exts.build (\lcons lnil -> foldrFB lcons lnil t) +"Text.Lazy.unpackBack" [1] foldrFB (:) [] = unpack + #-} -- | /O(n)/ Convert a literal string into a Text. unpackCString# :: Addr# -> Text diff --git a/src/Data/Text/Lazy/Builder/RealFloat.hs b/src/Data/Text/Lazy/Builder/RealFloat.hs --- a/src/Data/Text/Lazy/Builder/RealFloat.hs +++ b/src/Data/Text/Lazy/Builder/RealFloat.hs @@ -1,6 +1,9 @@ {-# LANGUAGE CPP, OverloadedStrings #-} {-# LANGUAGE Trustworthy #-} +{-# OPTIONS_GHC -Wno-unrecognised-warning-flags #-} +{-# OPTIONS_GHC -Wno-x-partial #-} + -- | -- Module: Data.Text.Lazy.Builder.RealFloat -- Copyright: (c) The University of Glasgow 1994-2002 diff --git a/src/Data/Text/Lazy/Internal.hs b/src/Data/Text/Lazy/Internal.hs --- a/src/Data/Text/Lazy/Internal.hs +++ b/src/Data/Text/Lazy/Internal.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE BangPatterns, DeriveDataTypeable #-} -- | -- Module : Data.Text.Lazy.Internal -- Copyright : (c) 2013 Bryan O'Sullivan diff --git a/src/Data/Text/Show.hs b/src/Data/Text/Show.hs --- a/src/Data/Text/Show.hs +++ b/src/Data/Text/Show.hs @@ -31,6 +31,7 @@ import Data.Text.Internal.Unsafe.Char (unsafeWrite) import Data.Text.Unsafe (Iter(..), iterArray) import GHC.Exts (Ptr(..), Int(..), Addr#, indexWord8OffAddr#) +import qualified GHC.Exts as Exts import GHC.Word (Word8(..)) import qualified Data.Text.Array as A #if !MIN_VERSION_ghc_prim(0,7,0) @@ -53,12 +54,32 @@ HasCallStack => #endif Text -> String -unpack (Text arr off len) = go off +unpack t = foldrText (:) [] t +{-# NOINLINE unpack #-} + +foldrText :: (Char -> b -> b) -> b -> Text -> b +foldrText f z (Text arr off len) = go off where go !i - | i >= off + len = [] - | otherwise = let !(Iter c l) = iterArray arr i in c : go (i + l) -{-# INLINE [1] unpack #-} + | i >= off + len = z + | otherwise = let !(Iter c l) = iterArray arr i in f c (go (i + l)) +{-# INLINE foldrText #-} + +foldrTextFB :: (Char -> b -> b) -> b -> Text -> b +foldrTextFB = foldrText +{-# INLINE [0] foldrTextFB #-} + +-- List fusion rules for `unpack`: +-- * `unpack` rewrites to `build` up till (but not including) phase 1. `build` +-- fuses if `foldr` is applied to it. +-- * If it doesn't fuse: In phase 1, `build` inlines to give us +-- `foldrTextFB (:) []` and we rewrite that back to `unpack`. +-- * If it fuses: In phase 0, `foldrTextFB` inlines and `foldrText` inlines. GHC +-- optimizes the fused code. +{-# RULES +"Text.unpack" [~1] forall t. unpack t = Exts.build (\lcons lnil -> foldrTextFB lcons lnil t) +"Text.unpackBack" [1] foldrTextFB (:) [] = unpack + #-} -- | /O(n)/ Convert a null-terminated -- diff --git a/tests/Tests/Properties.hs b/tests/Tests/Properties.hs --- a/tests/Tests/Properties.hs +++ b/tests/Tests/Properties.hs @@ -17,6 +17,7 @@ import Tests.Properties.Text (testText) import Tests.Properties.Transcoding (testTranscoding) import Tests.Properties.Validate (testValidate) +import Tests.Properties.CornerCases (testCornerCases) tests :: TestTree tests = @@ -30,5 +31,6 @@ testBuilder, testLowLevel, testRead, + testCornerCases, testValidate ] diff --git a/tests/Tests/Properties/CornerCases.hs b/tests/Tests/Properties/CornerCases.hs new file mode 100644 --- /dev/null +++ b/tests/Tests/Properties/CornerCases.hs @@ -0,0 +1,39 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} + +-- | Check that the definitions that are partial crash in the expected ways or +-- return sensible defaults. +module Tests.Properties.CornerCases (testCornerCases) where + +import Control.Exception +import Data.Either +import Data.Semigroup +import Data.Text +import Test.QuickCheck +import Test.Tasty (TestTree, testGroup) +import Test.Tasty.QuickCheck (testProperty) +import Tests.QuickCheckUtils () + +testCornerCases :: TestTree +testCornerCases = + testGroup + "corner cases" + [ testGroup + "stimes" + $ let specimen = stimes :: Integer -> Text -> Text + in [ testProperty + "given a negative number, evaluate to error call" + $ \(Negative number) text -> + (ioProperty . fmap isLeft . try @ErrorCall . evaluate) $ + specimen + (fromIntegral (number :: Int)) + text + , testProperty + "given a number that does not fit into Int, evaluate to error call" + $ \(NonNegative number) text -> + (ioProperty . fmap isLeft . try @ErrorCall . evaluate) $ + specimen + (fromIntegral (number :: Int) + fromIntegral (maxBound :: Int) + 1) + text + ] + ] diff --git a/tests/Tests/Properties/Instances.hs b/tests/Tests/Properties/Instances.hs --- a/tests/Tests/Properties/Instances.hs +++ b/tests/Tests/Properties/Instances.hs @@ -7,6 +7,7 @@ ) where import Data.Binary (encode, decodeOrFail) +import Data.Semigroup import Data.String (IsString(fromString)) import Test.QuickCheck import Test.Tasty (TestTree, testGroup) @@ -37,6 +38,12 @@ tl_Show = show `eq` (show . TL.pack) t_mappend s = mappend s`eqP` (unpackS . mappend (T.pack s)) tl_mappend s = mappend s`eqP` (unpackS . mappend (TL.pack s)) +t_stimes = \ number -> eq + ((stimes :: Int -> String -> String) number . unSqrt) + (unpackS . (stimes :: Int -> T.Text -> T.Text) number . T.pack . unSqrt) +tl_stimes = \ number -> eq + ((stimes :: Int -> String -> String) number . unSqrt) + (unpackS . (stimes :: Int -> TL.Text -> TL.Text) number . TL.pack . unSqrt) t_mconcat = (mconcat . unSqrt) `eq` (unpackS . mconcat . L.map T.pack . unSqrt) tl_mconcat = (mconcat . unSqrt) `eq` (unpackS . mconcat . L.map TL.pack . unSqrt) t_mempty = mempty === (unpackS (mempty :: T.Text)) @@ -71,6 +78,8 @@ testProperty "tl_Show" tl_Show, testProperty "t_mappend" t_mappend, testProperty "tl_mappend" tl_mappend, + testProperty "t_stimes" t_stimes, + testProperty "tl_stimes" tl_stimes, testProperty "t_mconcat" t_mconcat, testProperty "tl_mconcat" tl_mconcat, testProperty "t_mempty" t_mempty, diff --git a/tests/Tests/Properties/LowLevel.hs b/tests/Tests/Properties/LowLevel.hs --- a/tests/Tests/Properties/LowLevel.hs +++ b/tests/Tests/Properties/LowLevel.hs @@ -1,164 +1,174 @@ --- | Test low-level operations - -{-# LANGUAGE CPP #-} -{-# LANGUAGE MagicHash #-} -{-# LANGUAGE ScopedTypeVariables #-} - -{-# OPTIONS_GHC -fno-warn-missing-signatures -fno-warn-unused-imports #-} - -#ifdef MIN_VERSION_tasty_inspection_testing -{-# LANGUAGE TemplateHaskell #-} -{-# OPTIONS_GHC -O -dsuppress-all -dno-suppress-type-signatures -fplugin=Test.Tasty.Inspection.Plugin #-} -#endif - -module Tests.Properties.LowLevel (testLowLevel) where - -import Prelude hiding (head, tail) -import Control.Applicative ((<$>), pure) -import Control.Exception as E (SomeException, catch, evaluate) -import Data.Int (Int32, Int64) -import Data.Text.Foreign -import Data.Text.Internal (Text(..), mul, mul32, mul64, safe) -import Data.Word (Word8, Word16, Word32) -import System.IO.Unsafe (unsafePerformIO) -import Test.Tasty (TestTree, testGroup) -import Test.Tasty.HUnit (testCase, assertEqual) -import Test.Tasty.QuickCheck (testProperty) -import Test.QuickCheck hiding ((.&.)) -import Tests.QuickCheckUtils -import Tests.Utils -import qualified Data.Text as T -import qualified Data.Text.Foreign as T -import qualified Data.Text.IO as T -import qualified Data.Text.Lazy as TL -import qualified Data.Text.Lazy.IO as TL -import qualified Data.Text.IO.Utf8 as TU -import qualified System.IO as IO - -#ifdef MIN_VERSION_tasty_inspection_testing -import Test.Tasty.Inspection (inspectObligations, hasNoTypes, doesNotUseAnyOf) -import qualified Data.Text.Internal.Fusion as S -import qualified Data.Text.Internal.Fusion.Common as S -import qualified GHC.CString as GHC -#endif - -mulRef :: (Integral a, Bounded a) => a -> a -> Maybe a -mulRef a b - | ab < bot || ab > top = Nothing - | otherwise = Just (fromIntegral ab) - where ab = fromIntegral a * fromIntegral b - top = fromIntegral (maxBound `asTypeOf` a) :: Integer - bot = fromIntegral (minBound `asTypeOf` a) :: Integer - -eval :: (a -> b -> c) -> a -> b -> Maybe c -eval f a b = unsafePerformIO $ - (Just <$> evaluate (f a b)) `E.catch` (\(_::SomeException) -> pure Nothing) - -t_mul32 :: Int32 -> Int32 -> Property -t_mul32 a b = mulRef a b === eval mul32 a b - -t_mul64 :: Int64 -> Int64 -> Property -t_mul64 a b = mulRef a b === eval mul64 a b - -t_mul :: Int -> Int -> Property -t_mul a b = mulRef a b === eval mul a b - --- Misc. - -t_dropWord8 m t = dropWord8 m t `T.isSuffixOf` t -t_takeWord8 m t = takeWord8 m t `T.isPrefixOf` t -t_take_drop_8 (Small n) t = T.append (takeWord8 n t) (dropWord8 n t) === t -t_use_from t = ioProperty $ (==t) <$> useAsPtr t fromPtr -t_use_from0 t = ioProperty $ do - let t' = t `T.snoc` '\0' - (== T.takeWhile (/= '\0') t') <$> useAsPtr t' (const . fromPtr0) - -t_peek_cstring t = T.all (/= '\0') t ==> ioProperty $ do - roundTrip <- T.withCString t T.peekCString - assertEqual "cstring" t roundTrip - -t_peek_cstring_len t = ioProperty $ do - roundTrip <- T.withCStringLen t T.peekCStringLen - assertEqual "cstring_len" t roundTrip - -t_copy t = T.copy t === t - -t_literal_length1 = assertEqual xs (length xs) byteLen - where - xs = "\0\1\0\1\0" - Text _ _ byteLen = T.pack xs -t_literal_length2 = assertEqual xs (length xs) byteLen - where - xs = "\1\2\3\4\5" - Text _ _ byteLen = T.pack xs -t_literal_surrogates = assertEqual xs (T.pack xs) (T.pack ys) - where - ys = "\xd7ff \xd800 \xdbff \xdc00 \xdfff \xe000" - xs = map safe ys - -#ifdef MIN_VERSION_tasty_inspection_testing -t_literal_foo :: Text -t_literal_foo = T.pack "foo" -#endif - --- Input and output. - --- t_put_get = write_read T.unlines T.filter put get --- where put h = withRedirect h IO.stdout . T.putStr --- get h = withRedirect h IO.stdin T.getContents --- tl_put_get = write_read TL.unlines TL.filter put get --- where put h = withRedirect h IO.stdout . TL.putStr --- get h = withRedirect h IO.stdin TL.getContents -t_write_read = write_read T.unlines T.filter T.hPutStr T.hGetContents id -tl_write_read = write_read TL.unlines TL.filter TL.hPutStr TL.hGetContents id - -t_write_read_line = write_read (T.concat . take 1) T.filter T.hPutStrLn T.hGetLine (: []) -tl_write_read_line = write_read (TL.concat . take 1) TL.filter TL.hPutStrLn TL.hGetLine (: []) - -utf8_write_read = write_read T.unlines T.filter TU.hPutStr TU.hGetContents id -utf8_write_read_line = write_read (T.concat . take 1) T.filter TU.hPutStrLn TU.hGetLine (: []) - -testLowLevel :: TestTree -testLowLevel = - testGroup "lowlevel" [ - testGroup "mul" [ - testProperty "t_mul" t_mul, - testProperty "t_mul32" t_mul32, - testProperty "t_mul64" t_mul64 - ], - - testGroup "misc" [ - testProperty "t_dropWord8" t_dropWord8, - testProperty "t_takeWord8" t_takeWord8, - testProperty "t_take_drop_8" t_take_drop_8, - testProperty "t_use_from" t_use_from, - testProperty "t_use_from0" t_use_from0, - testProperty "t_copy" t_copy, - testProperty "t_peek_cstring" t_peek_cstring, - testProperty "t_peek_cstring_len" t_peek_cstring_len, - testCase "t_literal_length1" t_literal_length1, - testCase "t_literal_length2" t_literal_length2, - testCase "t_literal_surrogates" t_literal_surrogates -#ifdef MIN_VERSION_tasty_inspection_testing - , $(inspectObligations - [ (`hasNoTypes` [''Char, ''[]]) - , (`doesNotUseAnyOf` ['T.pack, 'S.unstream, 'T.map, 'safe, 'S.streamList]) - , (`doesNotUseAnyOf` ['GHC.unpackCString#, 'GHC.unpackCStringUtf8#]) - , (`doesNotUseAnyOf` ['T.unpackCString#, 'T.unpackCStringAscii#]) - ] - 't_literal_foo) -#endif - ], - - testGroup "input-output" [ - testGroup "t_write_read" t_write_read, - testGroup "tl_write_read" tl_write_read, - testGroup "t_write_read_line" t_write_read_line, - testGroup "tl_write_read_line" tl_write_read_line, - testGroup "utf8_write_read" utf8_write_read, - testGroup "utf8_write_read_line" utf8_write_read_line - -- These tests are subject to I/O race conditions - -- testProperty "t_put_get" t_put_get, - -- testProperty "tl_put_get" tl_put_get - ] - ] +-- | Test low-level operations + +{-# LANGUAGE CPP #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +{-# OPTIONS_GHC -fno-warn-missing-signatures -fno-warn-unused-imports #-} + +#ifdef MIN_VERSION_tasty_inspection_testing +{-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_GHC -O -dsuppress-all -dno-suppress-type-signatures -fplugin=Test.Tasty.Inspection.Plugin #-} +#endif + +module Tests.Properties.LowLevel (testLowLevel) where + +import Prelude hiding (head, tail) +import Control.Applicative ((<$>), pure) +import Control.Exception as E (SomeException, catch, evaluate) +import Data.Functor.Identity (Identity(..)) +import Data.Int (Int32, Int64) +import Data.Text.Foreign +import Data.Text.Internal (Text(..), mul, mul32, mul64, safe) +import Data.Word (Word8, Word16, Word32) +import System.IO.Unsafe (unsafePerformIO) +import Test.Tasty (TestTree, testGroup) +import Test.Tasty.HUnit (testCase, assertEqual) +import Test.Tasty.QuickCheck (testProperty) +import Test.QuickCheck hiding ((.&.)) +import Tests.QuickCheckUtils +import Tests.Utils +import qualified Data.Text as T +import qualified Data.Text.Foreign as T +import qualified Data.Text.IO as T +import qualified Data.Text.Lazy as TL +import qualified Data.Text.Lazy.IO as TL +import qualified Data.Text.IO.Utf8 as TU +import qualified System.IO as IO + +#ifdef MIN_VERSION_tasty_inspection_testing +import Test.Tasty.Inspection (inspectObligations, hasNoTypes, doesNotUseAnyOf) +import qualified Data.Text.Internal.Fusion as S +import qualified Data.Text.Internal.Fusion.Common as S +import qualified GHC.CString as GHC +#endif + +mulRef :: (Integral a, Bounded a) => a -> a -> Maybe a +mulRef a b + | ab < bot || ab > top = Nothing + | otherwise = Just (fromIntegral ab) + where ab = fromIntegral a * fromIntegral b + top = fromIntegral (maxBound `asTypeOf` a) :: Integer + bot = fromIntegral (minBound `asTypeOf` a) :: Integer + +eval :: (a -> b -> c) -> a -> b -> Maybe c +eval f a b = unsafePerformIO $ + (Just <$> evaluate (f a b)) `E.catch` (\(_::SomeException) -> pure Nothing) + +t_mul32 :: Int32 -> Int32 -> Property +t_mul32 a b = mulRef a b === eval mul32 a b + +t_mul64 :: Int64 -> Int64 -> Property +t_mul64 a b = mulRef a b === eval mul64 a b + +t_mul :: Int -> Int -> Property +t_mul a b = mulRef a b === eval mul a b + +-- Misc. + +t_dropWord8 m t = dropWord8 m t `T.isSuffixOf` t +t_takeWord8 m t = takeWord8 m t `T.isPrefixOf` t +t_take_drop_8 (Small n) t = T.append (takeWord8 n t) (dropWord8 n t) === t +t_use_from t = ioProperty $ (==t) <$> useAsPtr t fromPtr +t_use_from0 t = ioProperty $ do + let t' = t `T.snoc` '\0' + (== T.takeWhile (/= '\0') t') <$> useAsPtr t' (const . fromPtr0) + +t_peek_cstring t = T.all (/= '\0') t ==> ioProperty $ do + roundTrip <- T.withCString t T.peekCString + assertEqual "cstring" t roundTrip + +t_peek_cstring_len t = ioProperty $ do + roundTrip <- T.withCStringLen t T.peekCStringLen + assertEqual "cstring_len" t roundTrip + +t_copy t = T.copy t === t + +t_literal_length1 = assertEqual xs (length xs) byteLen + where + xs = "\0\1\0\1\0" + Text _ _ byteLen = T.pack xs +t_literal_length2 = assertEqual xs (length xs) byteLen + where + xs = "\1\2\3\4\5" + Text _ _ byteLen = T.pack xs +t_literal_surrogates = assertEqual xs (T.pack xs) (T.pack ys) + where + ys = "\xd7ff \xd800 \xdbff \xdc00 \xdfff \xe000" + xs = map safe ys + +#ifdef MIN_VERSION_tasty_inspection_testing +t_literal_foo :: Text +t_literal_foo = T.pack "foo" +#endif + +-- Input and output. + +-- t_put_get = write_read T.unlines T.filter put get +-- where put h = withRedirect h IO.stdout . T.putStr +-- get h = withRedirect h IO.stdin T.getContents +-- tl_put_get = write_read TL.unlines TL.filter put get +-- where put h = withRedirect h IO.stdout . TL.putStr +-- get h = withRedirect h IO.stdin TL.getContents + +inputOutput :: TestTree +inputOutput = testGroup "input-output" [ + testProperty "t_write_read" $ write_read arbitrary shrink (T.replace "\n" "\r\n") T.hPutStr T.hGetContents, + testProperty "tl_write_read" $ write_read arbitrary shrink (TL.replace "\n" "\r\n") TL.hPutStr TL.hGetContents, + testProperty "t_write_read_line" $ write_read genTLine shrinkTLine (`T.append` "\r") T.hPutStrLn T.hGetLine, + testProperty "tl_write_read_line" $ write_read genTLLine shrinkTLLine (`TL.append` "\r") TL.hPutStrLn TL.hGetLine, + -- Note: Data.Text.IO.Utf8 does NO newline translation + testProperty "utf8_write_read" $ write_read arbitrary shrink id TU.hPutStr TU.hGetContents, + testProperty "utf8_write_read_line" $ write_read genTLine shrinkTLine id TU.hPutStrLn TU.hGetLine + -- These tests are subject to I/O race conditions + -- testProperty "t_put_get" t_put_get, + -- testProperty "tl_put_get" tl_put_get + ] + +genTLine :: Gen T.Text +genTLine = T.filter (`notElem` ("\r\n" :: String)) <$> arbitrary + +genTLLine :: Gen TL.Text +genTLLine = TL.filter (`notElem` ("\r\n" :: String)) <$> arbitrary + +shrinkTLine :: T.Text -> [T.Text] +shrinkTLine = filter (T.all (/= '\n')) . shrink + +shrinkTLLine :: TL.Text -> [TL.Text] +shrinkTLLine = filter (TL.all (/= '\n')) . shrink + +testLowLevel :: TestTree +testLowLevel = + testGroup "lowlevel" [ + testGroup "mul" [ + testProperty "t_mul" t_mul, + testProperty "t_mul32" t_mul32, + testProperty "t_mul64" t_mul64 + ], + + testGroup "misc" [ + testProperty "t_dropWord8" t_dropWord8, + testProperty "t_takeWord8" t_takeWord8, + testProperty "t_take_drop_8" t_take_drop_8, + testProperty "t_use_from" t_use_from, + testProperty "t_use_from0" t_use_from0, + testProperty "t_copy" t_copy, + testProperty "t_peek_cstring" t_peek_cstring, + testProperty "t_peek_cstring_len" t_peek_cstring_len, + testCase "t_literal_length1" t_literal_length1, + testCase "t_literal_length2" t_literal_length2, + testCase "t_literal_surrogates" t_literal_surrogates +#ifdef MIN_VERSION_tasty_inspection_testing + , $(inspectObligations + [ (`hasNoTypes` [''Char, ''[]]) + , (`doesNotUseAnyOf` ['T.pack, 'S.unstream, 'T.map, 'safe, 'S.streamList]) + , (`doesNotUseAnyOf` ['GHC.unpackCString#, 'GHC.unpackCStringUtf8#]) + , (`doesNotUseAnyOf` ['T.unpackCString#, 'T.unpackCStringAscii#]) + ] + 't_literal_foo) +#endif + ], + + inputOutput + ] diff --git a/tests/Tests/Properties/Substrings.hs b/tests/Tests/Properties/Substrings.hs --- a/tests/Tests/Properties/Substrings.hs +++ b/tests/Tests/Properties/Substrings.hs @@ -229,9 +229,8 @@ (l, []) -> [l] (l, _ : s') -> l : loop s' -t_chunksOf_same_lengths k = conjoin . map ((===k) . T.length) . ini . T.chunksOf k - where ini [] = [] - ini xs = init xs +t_chunksOf_same_lengths k = + conjoin . map ((===k) . T.length) . drop 1 . reverse . T.chunksOf k t_chunksOf_length k t = len === T.length t .||. property (k <= 0 && len == 0) where len = L.sum . L.map T.length $ T.chunksOf k t diff --git a/tests/Tests/Properties/Transcoding.hs b/tests/Tests/Properties/Transcoding.hs --- a/tests/Tests/Properties/Transcoding.hs +++ b/tests/Tests/Properties/Transcoding.hs @@ -1,7 +1,10 @@ -- | Tests for encoding and decoding {-# LANGUAGE CPP, OverloadedStrings, ScopedTypeVariables #-} -{-# OPTIONS_GHC -fno-warn-missing-signatures #-} +{-# OPTIONS_GHC -Wno-missing-signatures #-} +{-# OPTIONS_GHC -Wno-unrecognised-warning-flags #-} +{-# OPTIONS_GHC -Wno-x-partial #-} + module Tests.Properties.Transcoding ( testTranscoding ) where diff --git a/tests/Tests/QuickCheckUtils.hs b/tests/Tests/QuickCheckUtils.hs --- a/tests/Tests/QuickCheckUtils.hs +++ b/tests/Tests/QuickCheckUtils.hs @@ -1,307 +1,321 @@ --- | This module provides quickcheck utilities, e.g. arbitrary and show --- instances, and comparison functions, so we can focus on the actual properties --- in the 'Tests.Properties' module. --- -{-# LANGUAGE CPP #-} -{-# LANGUAGE DeriveFunctor #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE ScopedTypeVariables #-} - -{-# OPTIONS_GHC -fno-warn-orphans #-} - -module Tests.QuickCheckUtils - ( BigInt(..) - , NotEmpty(..) - , Sqrt(..) - , SpacyString(..) - , SkewedBool(..) - - , Precision(..) - , precision - - , DecodeErr(..) - , genDecodeErr - - , Stringy(..) - , unpack2 - , eq - , eqP - , eqPSqrt - - , write_read - ) where - -import Control.Arrow ((***)) -import Data.Bool (bool) -import Data.Char (isSpace) -import Data.Text.Foreign (I8) -import Data.Text.Lazy.Builder.RealFloat (FPFormat(..)) -import Data.Word (Word8, Word16) -import GHC.IO.Encoding.Types (TextEncoding(TextEncoding,textEncodingName)) -import Test.QuickCheck (Arbitrary(..), arbitraryUnicodeChar, arbitraryBoundedEnum, getUnicodeString, arbitrarySizedIntegral, shrinkIntegral, Property, ioProperty, discard, counterexample, scale, (.&&.), NonEmptyList(..), forAll, getPositive) -import Test.QuickCheck.Gen (Gen, choose, chooseAny, elements, frequency, listOf, oneof, resize, sized) -import Test.Tasty (TestTree, testGroup) -import Test.Tasty.QuickCheck (testProperty) -import Tests.Utils -import qualified Data.ByteString as B -import qualified Data.ByteString.Lazy as BL -import qualified Data.Text as T -import qualified Data.Text.Encoding.Error as T -import qualified Data.Text.Internal.Fusion as TF -import qualified Data.Text.Internal.Fusion.Common as TF -import qualified Data.Text.Internal.Lazy as TL -import qualified Data.Text.Internal.Lazy.Fusion as TLF -import qualified Data.Text.Lazy as TL -import qualified System.IO as IO - -genWord8 :: Gen Word8 -genWord8 = chooseAny - -genWord16 :: Gen Word16 -genWord16 = chooseAny - -instance Arbitrary I8 where - arbitrary = arbitrarySizedIntegral - shrink = shrinkIntegral - -instance Arbitrary B.ByteString where - arbitrary = B.pack `fmap` listOf genWord8 - shrink = map B.pack . shrink . B.unpack - -instance Arbitrary BL.ByteString where - arbitrary = oneof - [ BL.fromChunks <$> arbitrary - -- so that a single utf8 code point could appear split over up to 4 chunks - , BL.fromChunks . map B.singleton <$> listOf genWord8 - -- so that a code point with 4 byte long utf8 representation - -- could appear split over 3 non-singleton chunks - , (\a b c -> BL.fromChunks [a, b, c]) - <$> arbitrary - <*> ((\a b -> B.pack [a, b]) <$> genWord8 <*> genWord8) - <*> arbitrary - ] - shrink xs = BL.fromChunks <$> shrink (BL.toChunks xs) - --- | For tests that have O(n^2) running times or input sizes, resize --- their inputs to the square root of the originals. -newtype Sqrt a = Sqrt { unSqrt :: a } - deriving (Eq, Show) - -instance Arbitrary a => Arbitrary (Sqrt a) where - arbitrary = fmap Sqrt $ sized $ \n -> resize (smallish n) arbitrary - where - smallish = round . (sqrt :: Double -> Double) . fromIntegral . abs - shrink = map Sqrt . shrink . unSqrt - -instance Arbitrary T.Text where - arbitrary = do - t <- (T.pack . getUnicodeString) `fmap` scale (* 2) arbitrary - -- Generate chunks that start in the middle of their buffers. - (\i -> T.drop i t) <$> choose (0, T.length t) - shrink = map T.pack . shrink . T.unpack - -instance Arbitrary TL.Text where - arbitrary = (TL.fromChunks . map notEmpty . unSqrt) `fmap` arbitrary - shrink = map TL.pack . shrink . TL.unpack - -newtype BigInt = Big Integer - deriving (Eq, Show) - -instance Arbitrary BigInt where - arbitrary = choose (1::Int,200) >>= \e -> Big <$> choose (10^(e-1),10^e) - shrink (Big a) = [Big (a `div` 2^(l-e)) | e <- shrink l] - where l = truncate (log (fromIntegral a) / log 2 :: Double) :: Integer - -newtype NotEmpty a = NotEmpty { notEmpty :: a } - deriving (Eq, Ord, Show) - -instance Arbitrary (NotEmpty T.Text) where - arbitrary = fmap (NotEmpty . T.pack . getNonEmpty) arbitrary - shrink = fmap (NotEmpty . T.pack . getNonEmpty) - . shrink . NonEmpty . T.unpack . notEmpty - -instance Arbitrary (NotEmpty TL.Text) where - arbitrary = fmap (NotEmpty . TL.pack . getNonEmpty) arbitrary - shrink = fmap (NotEmpty . TL.pack . getNonEmpty) - . shrink . NonEmpty . TL.unpack . notEmpty - -data DecodeErr = Lenient | Ignore | Strict | Replace - deriving (Show, Eq, Bounded, Enum) - -genDecodeErr :: DecodeErr -> Gen T.OnDecodeError -genDecodeErr Lenient = return T.lenientDecode -genDecodeErr Ignore = return T.ignore -genDecodeErr Strict = return T.strictDecode -genDecodeErr Replace = (\c _ _ -> c) <$> frequency - [ (1, return Nothing) - , (50, Just <$> arbitraryUnicodeChar) - ] - -instance Arbitrary DecodeErr where - arbitrary = arbitraryBoundedEnum - -class Stringy s where - packS :: String -> s - unpackS :: s -> String - splitAtS :: Int -> s -> (s,s) - packSChunkSize :: Int -> String -> s - packSChunkSize _ = packS - -instance Stringy String where - packS = id - unpackS = id - splitAtS = splitAt - -instance Stringy (TF.Stream Char) where - packS = TF.streamList - unpackS = TF.unstreamList - splitAtS n s = (TF.take n s, TF.drop n s) - -instance Stringy T.Text where - packS = T.pack - unpackS = T.unpack - splitAtS = T.splitAt - -instance Stringy TL.Text where - packSChunkSize k = TLF.unstreamChunks k . TF.streamList - packS = TL.pack - unpackS = TL.unpack - splitAtS = ((TL.lazyInvariant *** TL.lazyInvariant) .) . - TL.splitAt . fromIntegral - -unpack2 :: (Stringy s) => (s,s) -> (String,String) -unpack2 = unpackS *** unpackS - --- Do two functions give the same answer? -eq :: (Eq a, Show a) => (t -> a) -> (t -> a) -> t -> Property -eq a b s = a s =^= b s - --- What about with the RHS packed? -eqP :: (Eq a, Show a, Stringy s) => - (String -> a) -> (s -> a) -> String -> Word8 -> Property -eqP f g s w = counterexample "orig" (f s =^= g t) .&&. - counterexample "mini" (f s =^= g mini) .&&. - counterexample "head" (f sa =^= g ta) .&&. - counterexample "tail" (f sb =^= g tb) - where t = packS s - mini = packSChunkSize 10 s - (sa,sb) = splitAt m s - (ta,tb) = splitAtS m t - l = length s - m | l == 0 = n - | otherwise = n `mod` l - n = fromIntegral w - -eqPSqrt :: (Eq a, Show a, Stringy s) => - (String -> a) -> (s -> a) -> Sqrt String -> Word8 -> Property -eqPSqrt f g s = eqP f g (unSqrt s) - -instance Arbitrary FPFormat where - arbitrary = arbitraryBoundedEnum - -newtype Precision a = Precision (Maybe Int) - deriving (Eq, Show) - -precision :: a -> Precision a -> Maybe Int -precision _ (Precision prec) = prec - -arbitraryPrecision :: Int -> Gen (Precision a) -arbitraryPrecision maxDigits = Precision <$> do - n <- choose (-1,maxDigits) - return $ if n == -1 - then Nothing - else Just n - -instance Arbitrary (Precision Float) where - arbitrary = arbitraryPrecision 11 - shrink = map Precision . shrink . precision undefined - -instance Arbitrary (Precision Double) where - arbitrary = arbitraryPrecision 22 - shrink = map Precision . shrink . precision undefined - -#if !MIN_VERSION_QuickCheck(2,14,3) -instance Arbitrary IO.Newline where - arbitrary = oneof [return IO.LF, return IO.CRLF] - -instance Arbitrary IO.NewlineMode where - arbitrary = IO.NewlineMode <$> arbitrary <*> arbitrary -#endif - -instance Arbitrary IO.BufferMode where - arbitrary = oneof [ return IO.NoBuffering, - return IO.LineBuffering, - return (IO.BlockBuffering Nothing), - (IO.BlockBuffering . Just . (+1) . fromIntegral) `fmap` - genWord16 ] - --- This test harness is complex! What property are we checking? --- --- Reading after writing a multi-line file should give the same --- results as were written. --- --- What do we vary while checking this property? --- * The lines themselves, scrubbed to contain neither CR nor LF. (By --- working with a list of lines, we ensure that the data will --- sometimes contain line endings.) --- * Newline translation mode. --- * Buffering. -write_read :: forall a b c. - (Eq a, Show a, Show c, Arbitrary c) - => ([b] -> a) - -> ((Char -> Bool) -> b -> b) - -> (IO.Handle -> a -> IO ()) - -> (IO.Handle -> IO a) - -> (c -> [b]) - -> [TestTree] -write_read unline filt writer reader modData - = encodings <&> \enc@TextEncoding {textEncodingName} -> testGroup textEncodingName - [ testProperty "NoBuffering" $ propTest enc (pure IO.NoBuffering) - , testProperty "LineBuffering" $ propTest enc (pure IO.LineBuffering) - , testProperty "BlockBuffering" $ propTest enc blockBuffering - ] - where - propTest :: TextEncoding -> Gen IO.BufferMode -> IO.NewlineMode -> c -> Property - propTest _ _ (IO.NewlineMode IO.LF IO.CRLF) _ = discard - propTest enc genBufferMode nl d = forAll genBufferMode $ \mode -> ioProperty $ withTempFile $ \_ h -> do - let ts = modData d - t = unline . map (filt (not . (`elem` "\r\n"))) $ ts - IO.hSetEncoding h enc - IO.hSetNewlineMode h nl - IO.hSetBuffering h mode - () <- writer h t - IO.hSeek h IO.AbsoluteSeek 0 - r <- reader h - let isEq = r == t - seq isEq $ pure $ counterexample (show r ++ bool " /= " " == " isEq ++ show t) isEq - - encodings = [IO.utf8, IO.utf8_bom, IO.utf16, IO.utf16le, IO.utf16be, IO.utf32, IO.utf32le, IO.utf32be] - - blockBuffering :: Gen IO.BufferMode - blockBuffering = IO.BlockBuffering <$> fmap (fmap $ min 4 . getPositive) arbitrary - --- Generate various Unicode space characters with high probability -arbitrarySpacyChar :: Gen Char -arbitrarySpacyChar = oneof - [ arbitraryUnicodeChar - , elements $ filter isSpace [minBound..maxBound] - ] - -newtype SpacyString = SpacyString { getSpacyString :: String } - deriving (Eq, Ord, Show, Read) - -instance Arbitrary SpacyString where - arbitrary = SpacyString `fmap` listOf arbitrarySpacyChar - shrink (SpacyString xs) = SpacyString `fmap` shrink xs - -newtype SkewedBool = Skewed { getSkewed :: Bool } - deriving Show - -instance Arbitrary SkewedBool where - arbitrary = Skewed <$> frequency [(1, pure False), (5, pure True)] - -(<&>) :: [a] -> (a -> b) -> [b] -(<&>) = flip fmap - +-- | This module provides quickcheck utilities, e.g. arbitrary and show +-- instances, and comparison functions, so we can focus on the actual properties +-- in the 'Tests.Properties' module. +-- +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} + +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module Tests.QuickCheckUtils + ( BigInt(..) + , NotEmpty(..) + , Sqrt(..) + , SpacyString(..) + , SkewedBool(..) + + , Precision(..) + , precision + + , DecodeErr(..) + , genDecodeErr + + , Stringy(..) + , unpack2 + , eq + , eqP + , eqPSqrt + + , write_read + ) where + +import Control.Arrow ((***)) +import Control.Monad (when) +import Data.Char (isSpace) +import Data.IORef (writeIORef) +import Data.Text.Foreign (I8) +import Data.Text.Lazy.Builder.RealFloat (FPFormat(..)) +import Data.Word (Word8, Word16) +import qualified GHC.IO.Buffer as GIO +import qualified GHC.IO.Handle.Internals as GIO +import qualified GHC.IO.Handle.Types as GIO +import GHC.IO.Encoding.Types (TextEncoding(textEncodingName)) +import Test.QuickCheck (Arbitrary(..), arbitraryUnicodeChar, arbitraryBoundedEnum, getUnicodeString, arbitrarySizedIntegral, shrinkIntegral, Property, ioProperty, counterexample, scale, (.&&.), NonEmptyList(..), forAllShrink) +import Test.QuickCheck.Gen (Gen, choose, chooseAny, elements, frequency, listOf, oneof, resize, sized) +import Tests.Utils +import qualified Data.ByteString as B +import qualified Data.ByteString.Lazy as BL +import qualified Data.Text as T +import qualified Data.Text.Encoding.Error as T +import qualified Data.Text.Internal.Fusion as TF +import qualified Data.Text.Internal.Fusion.Common as TF +import qualified Data.Text.Internal.Lazy as TL +import qualified Data.Text.Internal.Lazy.Fusion as TLF +import qualified Data.Text.Lazy as TL +import qualified System.IO as IO + +genWord8 :: Gen Word8 +genWord8 = chooseAny + +genWord16 :: Gen Word16 +genWord16 = chooseAny + +instance Arbitrary I8 where + arbitrary = arbitrarySizedIntegral + shrink = shrinkIntegral + +instance Arbitrary B.ByteString where + arbitrary = B.pack `fmap` listOf genWord8 + shrink = map B.pack . shrink . B.unpack + +instance Arbitrary BL.ByteString where + arbitrary = oneof + [ BL.fromChunks <$> arbitrary + -- so that a single utf8 code point could appear split over up to 4 chunks + , BL.fromChunks . map B.singleton <$> listOf genWord8 + -- so that a code point with 4 byte long utf8 representation + -- could appear split over 3 non-singleton chunks + , (\a b c -> BL.fromChunks [a, b, c]) + <$> arbitrary + <*> ((\a b -> B.pack [a, b]) <$> genWord8 <*> genWord8) + <*> arbitrary + ] + shrink xs = BL.fromChunks <$> shrink (BL.toChunks xs) + +-- | For tests that have O(n^2) running times or input sizes, resize +-- their inputs to the square root of the originals. +newtype Sqrt a = Sqrt { unSqrt :: a } + deriving (Eq, Show) + +instance Arbitrary a => Arbitrary (Sqrt a) where + arbitrary = fmap Sqrt $ sized $ \n -> resize (smallish n) arbitrary + where + smallish = round . (sqrt :: Double -> Double) . fromIntegral . abs + shrink = map Sqrt . shrink . unSqrt + +instance Arbitrary T.Text where + arbitrary = do + t <- (T.pack . getUnicodeString) `fmap` scale (* 2) arbitrary + -- Generate chunks that start in the middle of their buffers. + (\i -> T.drop i t) <$> choose (0, T.length t) + shrink = map T.pack . shrink . T.unpack + +instance Arbitrary TL.Text where + arbitrary = (TL.fromChunks . map notEmpty . unSqrt) `fmap` arbitrary + shrink = map TL.pack . shrink . TL.unpack + +newtype BigInt = Big Integer + deriving (Eq, Show) + +instance Arbitrary BigInt where + arbitrary = choose (1::Int,200) >>= \e -> Big <$> choose (10^(e-1),10^e) + shrink (Big a) = [Big (a `div` 2^(l-e)) | e <- shrink l] + where l = truncate (log (fromIntegral a) / log 2 :: Double) :: Integer + +newtype NotEmpty a = NotEmpty { notEmpty :: a } + deriving (Eq, Ord, Show) + +instance Arbitrary (NotEmpty T.Text) where + arbitrary = fmap (NotEmpty . T.pack . getNonEmpty) arbitrary + shrink = fmap (NotEmpty . T.pack . getNonEmpty) + . shrink . NonEmpty . T.unpack . notEmpty + +instance Arbitrary (NotEmpty TL.Text) where + arbitrary = fmap (NotEmpty . TL.pack . getNonEmpty) arbitrary + shrink = fmap (NotEmpty . TL.pack . getNonEmpty) + . shrink . NonEmpty . TL.unpack . notEmpty + +data DecodeErr = Lenient | Ignore | Strict | Replace + deriving (Show, Eq, Bounded, Enum) + +genDecodeErr :: DecodeErr -> Gen T.OnDecodeError +genDecodeErr Lenient = return T.lenientDecode +genDecodeErr Ignore = return T.ignore +genDecodeErr Strict = return T.strictDecode +genDecodeErr Replace = (\c _ _ -> c) <$> frequency + [ (1, return Nothing) + , (50, Just <$> arbitraryUnicodeChar) + ] + +instance Arbitrary DecodeErr where + arbitrary = arbitraryBoundedEnum + +class Stringy s where + packS :: String -> s + unpackS :: s -> String + splitAtS :: Int -> s -> (s,s) + packSChunkSize :: Int -> String -> s + packSChunkSize _ = packS + +instance Stringy String where + packS = id + unpackS = id + splitAtS = splitAt + +instance Stringy (TF.Stream Char) where + packS = TF.streamList + unpackS = TF.unstreamList + splitAtS n s = (TF.take n s, TF.drop n s) + +instance Stringy T.Text where + packS = T.pack + unpackS = T.unpack + splitAtS = T.splitAt + +instance Stringy TL.Text where + packSChunkSize k = TLF.unstreamChunks k . TF.streamList + packS = TL.pack + unpackS = TL.unpack + splitAtS = ((TL.lazyInvariant *** TL.lazyInvariant) .) . + TL.splitAt . fromIntegral + +unpack2 :: (Stringy s) => (s,s) -> (String,String) +unpack2 = unpackS *** unpackS + +-- Do two functions give the same answer? +eq :: (Eq a, Show a) => (t -> a) -> (t -> a) -> t -> Property +eq a b s = a s =^= b s + +-- What about with the RHS packed? +eqP :: (Eq a, Show a, Stringy s) => + (String -> a) -> (s -> a) -> String -> Word8 -> Property +eqP f g s w = counterexample "orig" (f s =^= g t) .&&. + counterexample "mini" (f s =^= g mini) .&&. + counterexample "head" (f sa =^= g ta) .&&. + counterexample "tail" (f sb =^= g tb) + where t = packS s + mini = packSChunkSize 10 s + (sa,sb) = splitAt m s + (ta,tb) = splitAtS m t + l = length s + m | l == 0 = n + | otherwise = n `mod` l + n = fromIntegral w + +eqPSqrt :: (Eq a, Show a, Stringy s) => + (String -> a) -> (s -> a) -> Sqrt String -> Word8 -> Property +eqPSqrt f g s = eqP f g (unSqrt s) + +instance Arbitrary FPFormat where + arbitrary = arbitraryBoundedEnum + +newtype Precision a = Precision (Maybe Int) + deriving (Eq, Show) + +precision :: a -> Precision a -> Maybe Int +precision _ (Precision prec) = prec + +arbitraryPrecision :: Int -> Gen (Precision a) +arbitraryPrecision maxDigits = Precision <$> do + n <- choose (-1,maxDigits) + return $ if n == -1 + then Nothing + else Just n + +instance Arbitrary (Precision Float) where + arbitrary = arbitraryPrecision 11 + shrink = map Precision . shrink . precision undefined + +instance Arbitrary (Precision Double) where + arbitrary = arbitraryPrecision 22 + shrink = map Precision . shrink . precision undefined + +#if !MIN_VERSION_QuickCheck(2,14,3) +instance Arbitrary IO.Newline where + arbitrary = oneof [return IO.LF, return IO.CRLF] + +instance Arbitrary IO.NewlineMode where + arbitrary = IO.NewlineMode <$> arbitrary <*> arbitrary +#endif + +instance Arbitrary IO.BufferMode where + arbitrary = oneof [ return IO.NoBuffering, + return IO.LineBuffering, + return (IO.BlockBuffering Nothing), + (IO.BlockBuffering . Just . (+1) . fromIntegral) `fmap` + genWord16 ] + +-- This test harness is complex! What property are we checking? +-- +-- Reading after writing a multi-line file should give the same +-- results as were written. +-- +-- What do we vary while checking this property? +-- * The lines themselves, scrubbed to contain neither CR nor LF. (By +-- working with a list of lines, we ensure that the data will +-- sometimes contain line endings.) +-- * Newline translation mode. +-- * Buffering. +write_read :: forall a. + (Eq a, Show a) + => Gen a + -> (a -> [a]) + -> (a -> a) -- ^ replace '\n' with '\r\n' (for multiline tests) or append '\r' (for single-line tests) + -> (IO.Handle -> a -> IO ()) + -> (IO.Handle -> IO a) + -> Property +write_read genTxt shrinkTxt expandNl writer reader + = forAllShrink genEncoding shrinkEncoding propTest + where + propTest :: TextEncoding -> IO.BufferMode -> Property + propTest enc mode = forAllShrink genTxt shrinkTxt $ \txt -> ioProperty $ do + file <- emptyTempFile + let with nl k = IO.withFile file IO.ReadWriteMode $ \h -> do + IO.hSetEncoding h enc + IO.hSetBuffering h mode + IO.hSetNewlineMode h nl + setSmallBuffer h + k h + -- Put a very small buffer in Handle to easily test boundary conditions in `writeBlocks` + setSmallBuffer h = GIO.withHandle_ "setSmallBuffer" h $ \h_ -> do + buf <- GIO.newCharBuffer 9 GIO.WriteBuffer + writeIORef (GIO.haCharBuffer h_) buf + readExpecting h txt' msg = do + out <- reader h + when (txt' /= out) $ error (show txt' ++ " /= " ++ show out ++ msg) + -- 'reader' may be 'hGetContents', which closes the handle + -- So we reopen a new file every time. + + -- Test with CRLF encoding + with (IO.NewlineMode IO.CRLF IO.CRLF) $ \h -> do + writer h txt + IO.hSeek h IO.AbsoluteSeek 0 + readExpecting h txt " (at location 1)" + + -- Re-read without CRLF decoding to check that we did encode CRLF correctly + with (IO.NewlineMode IO.LF IO.LF) $ \h -> do + readExpecting h (expandNl txt) " (at location 2)" + + -- Test without CRLF encoding + with (IO.NewlineMode IO.LF IO.LF) $ \h -> do + IO.hSetFileSize h 0 + writer h txt + IO.hSeek h IO.AbsoluteSeek 0 + readExpecting h txt " (at location 3)" + + genEncoding = elements [IO.utf8, IO.utf8_bom, IO.utf16, IO.utf16le, IO.utf16be, IO.utf32, IO.utf32le, IO.utf32be] + shrinkEncoding enc = if textEncodingName enc == textEncodingName IO.utf8 then [] else [IO.utf8] + +-- Generate various Unicode space characters with high probability +arbitrarySpacyChar :: Gen Char +arbitrarySpacyChar = oneof + [ arbitraryUnicodeChar + , elements $ filter isSpace [minBound..maxBound] + ] + +newtype SpacyString = SpacyString { getSpacyString :: String } + deriving (Eq, Ord, Show, Read) + +instance Arbitrary SpacyString where + arbitrary = SpacyString `fmap` listOf arbitrarySpacyChar + shrink (SpacyString xs) = SpacyString `fmap` shrink xs + +newtype SkewedBool = Skewed { getSkewed :: Bool } + deriving Show + +instance Arbitrary SkewedBool where + arbitrary = Skewed <$> frequency [(1, pure False), (5, pure True)] diff --git a/tests/Tests/Regressions.hs b/tests/Tests/Regressions.hs --- a/tests/Tests/Regressions.hs +++ b/tests/Tests/Regressions.hs @@ -1,204 +1,236 @@ --- | Regression tests for specific bugs. --- -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE MagicHash #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} - -module Tests.Regressions - ( - tests - ) where - -import Control.Exception (SomeException, handle) -import Data.Char (isLetter, chr) -import GHC.Exts (Int(..), sizeofByteArray#) -import System.IO -import Test.Tasty.HUnit (assertBool, assertEqual, assertFailure) -import qualified Data.ByteString as B -import Data.ByteString.Char8 () -import qualified Data.ByteString.Lazy as LB -import qualified Data.Text as T -import qualified Data.Text.Array as TA -import qualified Data.Text.Encoding as TE -import qualified Data.Text.Encoding.Error as E -import qualified Data.Text.Internal as T -import qualified Data.Text.Internal.Lazy.Encoding.Fusion as E -import qualified Data.Text.Internal.Lazy.Fusion as LF -import qualified Data.Text.IO as T -import qualified Data.Text.Lazy as LT -import qualified Data.Text.Lazy.Builder as TB -import qualified Data.Text.Lazy.Encoding as LE -import qualified Data.Text.Unsafe as T -import qualified Test.Tasty as F -import qualified Test.Tasty.HUnit as F -import Test.Tasty.HUnit ((@?=)) -import System.Directory (removeFile) - -import Tests.Utils (withTempFile) - --- Reported by Michael Snoyman: UTF-8 encoding a large lazy bytestring --- caused either a segfault or attempt to allocate a negative number --- of bytes. -lazy_encode_crash :: IO () -lazy_encode_crash = withTempFile $ \ _ h -> - LB.hPut h . LE.encodeUtf8 . LT.pack . replicate 100000 $ 'a' - --- Reported by Pieter Laeremans: attempting to read an incorrectly --- encoded file can result in a crash in the RTS (i.e. not merely an --- exception). -hGetContents_crash :: IO () -hGetContents_crash = do - (path, h) <- openTempFile "." "crashy.txt" - B.hPut h (B.pack [0x78, 0xc4 ,0x0a]) >> hClose h - h' <- openFile path ReadMode - hSetEncoding h' utf8 - handle (\(_::SomeException) -> return ()) $ - T.hGetContents h' >> assertFailure "T.hGetContents should crash" - hClose h' - removeFile path - --- Reported by Ian Lynagh: attempting to allocate a sufficiently large --- string (via either Array.new or Text.replicate) could result in an --- integer overflow. -replicate_crash :: IO () -replicate_crash = handle (\(_::SomeException) -> return ()) $ - T.replicate (2^power) "0123456789abcdef" `seq` - assertFailure "T.replicate should crash" - where - power | maxBound == (2147483647::Int) = 28 - | otherwise = 60 :: Int - --- Reported by John Millikin: a UTF-8 decode error handler could --- return a bogus substitution character, which we would write without --- checking. -utf8_decode_unsafe :: IO () -utf8_decode_unsafe = do - let t = TE.decodeUtf8With (\_ _ -> Just '\xdc00') "\x80" - assertBool "broken error recovery shouldn't break us" (t == "\xfffd") - --- Reported by Eric Seidel: we mishandled mapping Chars that fit in a --- single Word16 to Chars that require two. -mapAccumL_resize :: IO () -mapAccumL_resize = do - let f a _ = (a, '\65536') - count = 5 - val = T.mapAccumL f (0::Int) (T.replicate count "a") - assertEqual "mapAccumL should correctly fill buffers for four-byte results" - (0, T.replicate count "\65536") val - assertEqual "mapAccumL should correctly size buffers for four-byte results" - (count * 4) (T.lengthWord8 (snd val)) - --- See GitHub #197 -t197 :: IO () -t197 = - assertBool "length (filter (==',') \"0,00\") should be 1" (currencyParser "0,00") - where - currencyParser x = cond == 1 - where - cond = length fltr - fltr = filter (== ',') x - -t221 :: IO () -t221 = - assertEqual "toLower of large input shouldn't crash" - (T.toLower (T.replicate 200000 "0") `seq` ()) - () - -t227 :: IO () -t227 = - assertEqual "take (-3) shouldn't crash with overflow" - (T.length $ T.filter isLetter $ T.take (-3) "Hello! How are you doing today?") - 0 - -t280_fromString :: IO () -t280_fromString = - assertEqual "TB.fromString performs replacement on invalid scalar values" - (TB.toLazyText (TB.fromString "\xD800")) - (LT.pack "\xFFFD") - -t280_singleton :: IO () -t280_singleton = - assertEqual "TB.singleton performs replacement on invalid scalar values" - (TB.toLazyText (TB.singleton '\xD800')) - (LT.pack "\xFFFD") - --- See GitHub issue #301 --- This tests whether the "TEXT take . drop -> unfused" rule is applied to the --- slice function. When the slice function is fused, a new array will be --- constructed that is shorter than the original array. Without fusion the --- array remains unmodified. -t301 :: IO () -t301 = do - assertEqual "The length of the array remains the same despite slicing" - (I# (sizeofByteArray# originalArr)) - (I# (sizeofByteArray# newArr)) - - assertEqual "The new array still contains the original value" - (T.Text (TA.ByteArray newArr) originalOff originalLen) - original - where - !original@(T.Text (TA.ByteArray originalArr) originalOff originalLen) = T.pack "1234567890" - !(T.Text (TA.ByteArray newArr) _off _len) = T.take 1 $ T.drop 1 original - -t330 :: IO () -t330 = do - let decodeL = LE.decodeUtf8With E.lenientDecode - assertEqual "The lenient decoding of lazy bytestrings should not depend on how they are chunked" - (decodeL (LB.fromChunks [B.pack [194], B.pack [97, 98, 99]])) - (decodeL (LB.fromChunks [B.pack [194, 97, 98, 99]])) - --- Stream decoders should not loop on incomplete code points -t525 :: IO () -t525 = do - let decodeUtf8With onErr bs = LF.unstream (E.streamUtf8 onErr bs) - decodeUtf8With E.lenientDecode "\xC0" @?= "\65533" - LE.decodeUtf16BEWith E.lenientDecode "\0" @?= "\65533" - LE.decodeUtf16LEWith E.lenientDecode "\0" @?= "\65533" - LE.decodeUtf32BEWith E.lenientDecode "\0" @?= "\65533" - LE.decodeUtf32LEWith E.lenientDecode "\0" @?= "\65533" - --- Stream decoders skip one invalid byte at a time -t528 :: IO () -t528 = do - let decodeUtf8With onErr bs = LF.unstream (E.streamUtf8 onErr bs) - decodeUtf8With E.lenientDecode "\xC0\xF0\x90\x80\x80" @?= "\65533\65536" - LE.decodeUtf16BEWith E.lenientDecode "\xD8\xD8\x00\xDC\x00" @?= "\65533\65536" - LE.decodeUtf16LEWith E.lenientDecode "\xD8\xD8\x00\xD8\x00\xDC" @?= "\65533\65533\65536" - LE.decodeUtf32BEWith E.lenientDecode "\xFF\x00\x00\x00\x00" @?= "\65533\0" - LE.decodeUtf32LEWith E.lenientDecode "\x00\x00\xFF\x00\x00" @?= "\65533\65280" - -t529 :: IO () -t529 = do - let decode = TE.decodeUtf8With E.lenientDecode - -- https://github.com/haskell/bytestring/issues/575 - assertEqual "Data.ByteString.isValidUtf8 should work correctly" - (T.pack (chr 33 : replicate 31 (chr 0) ++ [chr 65533, chr 0])) - (decode (B.pack (33 : replicate 31 0 ++ [128, 0]))) - --- See Github #559 --- filter/filter fusion rules should apply predicates in the right order. -t559 :: IO () -t559 = do - T.filter undefined (T.filter (const False) "a") @?= "" - LT.filter undefined (LT.filter (const False) "a") @?= "" - -tests :: F.TestTree -tests = F.testGroup "Regressions" - [ F.testCase "hGetContents_crash" hGetContents_crash - , F.testCase "lazy_encode_crash" lazy_encode_crash - , F.testCase "mapAccumL_resize" mapAccumL_resize - , F.testCase "replicate_crash" replicate_crash - , F.testCase "utf8_decode_unsafe" utf8_decode_unsafe - , F.testCase "t197" t197 - , F.testCase "t221" t221 - , F.testCase "t227" t227 - , F.testCase "t280/fromString" t280_fromString - , F.testCase "t280/singleton" t280_singleton - , F.testCase "t301" t301 - , F.testCase "t330" t330 - , F.testCase "t525" t525 - , F.testCase "t528" t528 - , F.testCase "t529" t529 - , F.testCase "t559" t559 - ] +-- | Regression tests for specific bugs. +-- +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Tests.Regressions + ( + tests + ) where + +import Control.Exception (ErrorCall, SomeException, handle, evaluate, displayException, try) +import Data.Char (isLetter, chr) +import GHC.Exts (Int(..), sizeofByteArray#) +import System.IO +import System.IO.Temp (withSystemTempFile) +import Test.Tasty.HUnit (assertBool, assertEqual, assertFailure, (@?=)) +import qualified Data.ByteString as B +import Data.ByteString.Char8 () +import qualified Data.ByteString.Lazy as LB +import Data.Semigroup (stimes) +import qualified Data.Text as T +import qualified Data.Text.Array as TA +import qualified Data.Text.Encoding as TE +import qualified Data.Text.Encoding.Error as E +import qualified Data.Text.Internal as T +import qualified Data.Text.Internal.Lazy.Encoding.Fusion as E +import qualified Data.Text.Internal.Lazy.Fusion as LF +import qualified Data.Text.IO as T +import qualified Data.Text.Lazy as LT +import qualified Data.Text.Lazy.Builder as TB +import qualified Data.Text.Lazy.Encoding as LE +import qualified Data.Text.Unsafe as T +import qualified Test.Tasty as F +import qualified Test.Tasty.HUnit as F +import Tests.Utils (withTempFile) +import System.IO.Error (isFullError) + +-- Reported by Michael Snoyman: UTF-8 encoding a large lazy bytestring +-- caused either a segfault or attempt to allocate a negative number +-- of bytes. +lazy_encode_crash :: IO () +lazy_encode_crash = withTempFile $ \ _ h -> do + putRes <- try $ LB.hPut h $ LE.encodeUtf8 $ LT.pack $ replicate 100000 'a' + case putRes of + Left e + -- If disk is full (as it happens on some of our CI runners), it's not our issue, skip it + | isFullError e -> pure () + | otherwise -> assertFailure $ "hPut crashed because of " ++ displayException e + Right () -> pure () + +-- Reported by Pieter Laeremans: attempting to read an incorrectly +-- encoded file can result in a crash in the RTS (i.e. not merely an +-- exception). +hGetContents_crash :: IO () +hGetContents_crash = withSystemTempFile "crashy.txt" $ \path h -> do + putRes <- try $ B.hPut h (B.pack [0x78, 0xc4 ,0x0a]) + case putRes of + Left e + -- If disk is full (as it happens on some of our CI runners), it's not our issue, skip it + | isFullError e -> pure () + | otherwise -> assertFailure $ "hPut crashed because of " ++ displayException e + Right () -> do + hClose h + h' <- openFile path ReadMode + hSetEncoding h' utf8 + handle (\(_::SomeException) -> pure ()) $ + T.hGetContents h' >> assertFailure "T.hGetContents should crash" + hClose h' + +-- Reported by Ian Lynagh: attempting to allocate a sufficiently large +-- string (via either Array.new or Text.replicate) could result in an +-- integer overflow. +replicate_crash :: IO () +replicate_crash = handle (\(_::SomeException) -> return ()) $ + T.replicate (2^power) "0123456789abcdef" `seq` + assertFailure "T.replicate should crash" + where + power | maxBound == (2147483647::Int) = 28 + | otherwise = 60 :: Int + +-- Reported by John Millikin: a UTF-8 decode error handler could +-- return a bogus substitution character, which we would write without +-- checking. +utf8_decode_unsafe :: IO () +utf8_decode_unsafe = do + let t = TE.decodeUtf8With (\_ _ -> Just '\xdc00') "\x80" + assertBool "broken error recovery shouldn't break us" (t == "\xfffd") + +-- Reported by Eric Seidel: we mishandled mapping Chars that fit in a +-- single Word16 to Chars that require two. +mapAccumL_resize :: IO () +mapAccumL_resize = do + let f a _ = (a, '\65536') + count = 5 + val = T.mapAccumL f (0::Int) (T.replicate count "a") + assertEqual "mapAccumL should correctly fill buffers for four-byte results" + (0, T.replicate count "\65536") val + assertEqual "mapAccumL should correctly size buffers for four-byte results" + (count * 4) (T.lengthWord8 (snd val)) + +-- See GitHub #197 +t197 :: IO () +t197 = + assertBool "length (filter (==',') \"0,00\") should be 1" (currencyParser "0,00") + where + currencyParser x = cond == 1 + where + cond = length fltr + fltr = filter (== ',') x + +t221 :: IO () +t221 = + assertEqual "toLower of large input shouldn't crash" + (T.toLower (T.replicate 200000 "0") `seq` ()) + () + +t227 :: IO () +t227 = + assertEqual "take (-3) shouldn't crash with overflow" + (T.length $ T.filter isLetter $ T.take (-3) "Hello! How are you doing today?") + 0 + +t280_fromString :: IO () +t280_fromString = + assertEqual "TB.fromString performs replacement on invalid scalar values" + (TB.toLazyText (TB.fromString "\xD800")) + (LT.pack "\xFFFD") + +t280_singleton :: IO () +t280_singleton = + assertEqual "TB.singleton performs replacement on invalid scalar values" + (TB.toLazyText (TB.singleton '\xD800')) + (LT.pack "\xFFFD") + +-- See GitHub issue #301 +-- This tests whether the "TEXT take . drop -> unfused" rule is applied to the +-- slice function. When the slice function is fused, a new array will be +-- constructed that is shorter than the original array. Without fusion the +-- array remains unmodified. +t301 :: IO () +t301 = do + assertEqual "The length of the array remains the same despite slicing" + (I# (sizeofByteArray# originalArr)) + (I# (sizeofByteArray# newArr)) + + assertEqual "The new array still contains the original value" + (T.Text (TA.ByteArray newArr) originalOff originalLen) + original + where + !original@(T.Text (TA.ByteArray originalArr) originalOff originalLen) = T.pack "1234567890" + !(T.Text (TA.ByteArray newArr) _off _len) = T.take 1 $ T.drop 1 original + +t330 :: IO () +t330 = do + let decodeL = LE.decodeUtf8With E.lenientDecode + assertEqual "The lenient decoding of lazy bytestrings should not depend on how they are chunked" + (decodeL (LB.fromChunks [B.pack [194], B.pack [97, 98, 99]])) + (decodeL (LB.fromChunks [B.pack [194, 97, 98, 99]])) + +-- Stream decoders should not loop on incomplete code points +t525 :: IO () +t525 = do + let decodeUtf8With onErr bs = LF.unstream (E.streamUtf8 onErr bs) + decodeUtf8With E.lenientDecode "\xC0" @?= "\65533" + LE.decodeUtf16BEWith E.lenientDecode "\0" @?= "\65533" + LE.decodeUtf16LEWith E.lenientDecode "\0" @?= "\65533" + LE.decodeUtf32BEWith E.lenientDecode "\0" @?= "\65533" + LE.decodeUtf32LEWith E.lenientDecode "\0" @?= "\65533" + +-- Stream decoders skip one invalid byte at a time +t528 :: IO () +t528 = do + let decodeUtf8With onErr bs = LF.unstream (E.streamUtf8 onErr bs) + decodeUtf8With E.lenientDecode "\xC0\xF0\x90\x80\x80" @?= "\65533\65536" + LE.decodeUtf16BEWith E.lenientDecode "\xD8\xD8\x00\xDC\x00" @?= "\65533\65536" + LE.decodeUtf16LEWith E.lenientDecode "\xD8\xD8\x00\xD8\x00\xDC" @?= "\65533\65533\65536" + LE.decodeUtf32BEWith E.lenientDecode "\xFF\x00\x00\x00\x00" @?= "\65533\0" + LE.decodeUtf32LEWith E.lenientDecode "\x00\x00\xFF\x00\x00" @?= "\65533\65280" + +t529 :: IO () +t529 = do + let decode = TE.decodeUtf8With E.lenientDecode + -- https://github.com/haskell/bytestring/issues/575 + assertEqual "Data.ByteString.isValidUtf8 should work correctly" + (T.pack (chr 33 : replicate 31 (chr 0) ++ [chr 65533, chr 0])) + (decode (B.pack (33 : replicate 31 0 ++ [128, 0]))) + +-- See Github #559 +-- filter/filter fusion rules should apply predicates in the right order. +t559 :: IO () +t559 = do + T.filter undefined (T.filter (const False) "a") @?= "" + LT.filter undefined (LT.filter (const False) "a") @?= "" + +-- Github #633 +-- stimes checked for an `a` to `Int` to `a` roundtrip, but the `a` and `Int` values could represent different integers. +t633 :: IO () +t633 = + handle (\(_ :: ErrorCall) -> return ()) $ do + _ <- evaluate (stimes (maxBound :: Word) "a" :: T.Text) + assertFailure "should fail" + +t648 :: IO () +t648 = withTempFile $ \_ h -> do + hSetEncoding h utf8 + hSetNewlineMode h (NewlineMode LF CRLF) + hSetBuffering h (BlockBuffering $ Just 4) + let line = T.replicate 2047 "_" + T.hPutStrLn h line + hSeek h AbsoluteSeek 0 + line' <- T.hGetLine h + T.append line "\r" @?= line' + +tests :: F.TestTree +tests = F.testGroup "Regressions" + [ F.testCase "hGetContents_crash" hGetContents_crash + , F.testCase "lazy_encode_crash" lazy_encode_crash + , F.testCase "mapAccumL_resize" mapAccumL_resize + , F.testCase "replicate_crash" replicate_crash + , F.testCase "utf8_decode_unsafe" utf8_decode_unsafe + , F.testCase "t197" t197 + , F.testCase "t221" t221 + , F.testCase "t227" t227 + , F.testCase "t280/fromString" t280_fromString + , F.testCase "t280/singleton" t280_singleton + , F.testCase "t301" t301 + , F.testCase "t330" t330 + , F.testCase "t525" t525 + , F.testCase "t528" t528 + , F.testCase "t529" t529 + , F.testCase "t559" t559 + , F.testCase "t633" t633 + , F.testCase "t648" t648 + ] diff --git a/tests/Tests/Utils.hs b/tests/Tests/Utils.hs --- a/tests/Tests/Utils.hs +++ b/tests/Tests/Utils.hs @@ -1,51 +1,50 @@ --- | Miscellaneous testing utilities --- -{-# LANGUAGE ScopedTypeVariables #-} -module Tests.Utils - ( - (=^=) - , withRedirect - , withTempFile - ) where - -import Control.Exception (SomeException, bracket, bracket_, evaluate, try) -import Control.Monad (when, unless) -import GHC.IO.Handle.Internals (withHandle) -import System.Directory (removeFile) -import System.IO (Handle, hClose, hFlush, hIsOpen, hIsClosed, hIsWritable, openTempFile) -import Test.QuickCheck (Property, ioProperty, property, (===), counterexample) - --- Ensure that two potentially bottom values (in the sense of crashing --- for some inputs, not looping infinitely) either both crash, or both --- give comparable results for some input. -(=^=) :: (Eq a, Show a) => a -> a -> Property -i =^= j = ioProperty $ do - x <- try (evaluate i) - y <- try (evaluate j) - return $ case (x, y) of - (Left (_ :: SomeException), Left (_ :: SomeException)) - -> property True - (Right a, Right b) -> a === b - e -> counterexample ("Divergence: " ++ show e) $ property False -infix 4 =^= -{-# NOINLINE (=^=) #-} - -withTempFile :: (FilePath -> Handle -> IO a) -> IO a -withTempFile = bracket (openTempFile "." "crashy.txt") cleanupTemp . uncurry - where - cleanupTemp (path,h) = do - closed <- hIsClosed h - unless closed $ hClose h - removeFile path - -withRedirect :: Handle -> Handle -> IO a -> IO a -withRedirect tmp h = bracket_ swap swap - where - whenM p a = p >>= (`when` a) - swap = do - whenM (hIsOpen tmp) $ whenM (hIsWritable tmp) $ hFlush tmp - whenM (hIsOpen h) $ whenM (hIsWritable h) $ hFlush h - withHandle "spam" tmp $ \tmph -> do - hh <- withHandle "spam" h $ \hh -> - return (tmph,hh) - return (hh,()) +-- | Miscellaneous testing utilities +-- +{-# LANGUAGE ScopedTypeVariables #-} +module Tests.Utils + ( + (=^=) + , withRedirect + , withTempFile + , emptyTempFile + ) where + +import Control.Exception (SomeException, bracket_, evaluate, try) +import Control.Monad (when) +import System.IO.Temp (withSystemTempFile, emptySystemTempFile) +import GHC.IO.Handle.Internals (withHandle) +import System.IO (Handle, hFlush, hIsOpen, hIsWritable) +import Test.QuickCheck (Property, ioProperty, property, (===), counterexample) + +-- Ensure that two potentially bottom values (in the sense of crashing +-- for some inputs, not looping infinitely) either both crash, or both +-- give comparable results for some input. +(=^=) :: (Eq a, Show a) => a -> a -> Property +i =^= j = ioProperty $ do + x <- try (evaluate i) + y <- try (evaluate j) + return $ case (x, y) of + (Left (_ :: SomeException), Left (_ :: SomeException)) + -> property True + (Right a, Right b) -> a === b + e -> counterexample ("Divergence: " ++ show e) $ property False +infix 4 =^= +{-# NOINLINE (=^=) #-} + +withTempFile :: (FilePath -> Handle -> IO a) -> IO a +withTempFile = withSystemTempFile "crashy.txt" + +emptyTempFile :: IO FilePath +emptyTempFile = emptySystemTempFile "crashy.txt" + +withRedirect :: Handle -> Handle -> IO a -> IO a +withRedirect tmp h = bracket_ swap swap + where + whenM p a = p >>= (`when` a) + swap = do + whenM (hIsOpen tmp) $ whenM (hIsWritable tmp) $ hFlush tmp + whenM (hIsOpen h) $ whenM (hIsWritable h) $ hFlush h + withHandle "spam" tmp $ \tmph -> do + hh <- withHandle "spam" h $ \hh -> + return (tmph,hh) + return (hh,()) diff --git a/text.cabal b/text.cabal --- a/text.cabal +++ b/text.cabal @@ -1,365 +1,373 @@ -cabal-version: 2.2 -name: text -version: 2.1.2 - -homepage: https://github.com/haskell/text -bug-reports: https://github.com/haskell/text/issues -synopsis: An efficient packed Unicode text type. -description: - . - An efficient packed, immutable Unicode text type (both strict and - lazy). - . - The 'Text' type represents Unicode character strings, in a time and - space-efficient manner. This package provides text processing - capabilities that are optimized for performance critical use, both - in terms of large data quantities and high speed. - . - The 'Text' type provides character-encoding, type-safe case - conversion via whole-string case conversion functions (see "Data.Text"). - It also provides a range of functions for converting 'Text' values to - and from 'ByteStrings', using several standard encodings - (see "Data.Text.Encoding"). - . - Efficient locale-sensitive support for text IO is also supported - (see "Data.Text.IO"). - . - These modules are intended to be imported qualified, to avoid name - clashes with Prelude functions, e.g. - . - > import qualified Data.Text as T - . - == ICU Support - . - To use an extended and very rich family of functions for working - with Unicode text (including normalization, regular expressions, - non-standard encodings, text breaking, and locales), see - the [text-icu package](https://hackage.haskell.org/package/text-icu) - based on the well-respected and liberally - licensed [ICU library](http://site.icu-project.org/). - -license: BSD-2-Clause -license-file: LICENSE -author: Bryan O'Sullivan -maintainer: Haskell Text Team , Core Libraries Committee -copyright: 2009-2011 Bryan O'Sullivan, 2008-2009 Tom Harper, 2021 Andrew Lelechenko -category: Data, Text -build-type: Simple -tested-with: - GHC == 8.4.4 - GHC == 8.6.5 - GHC == 8.8.4 - GHC == 8.10.7 - GHC == 9.0.2 - GHC == 9.2.8 - GHC == 9.4.8 - GHC == 9.6.4 - GHC == 9.8.2 - GHC == 9.10.1 - -extra-source-files: - -- scripts/CaseFolding.txt - -- scripts/SpecialCasing.txt - README.md - changelog.md - scripts/*.hs - simdutf/LICENSE-APACHE - simdutf/LICENSE-MIT - simdutf/simdutf.h - tests/literal-rule-test.sh - tests/LiteralRuleTest.hs - -flag developer - description: operate in developer mode - default: False - manual: True - -flag simdutf - description: use simdutf library, causes Data.Text.Internal.Validate.Simd to be exposed - default: True - manual: True - -flag pure-haskell - description: Don't use text's standard C routines - NB: This feature is not fully implemented. Several C routines are still in - use. - - When this flag is true, text will use pure Haskell variants of the - routines. This is not recommended except for use with GHC's JavaScript - backend. - - This flag also disables simdutf. - - default: False - manual: True - -flag ExtendedBenchmarks - description: Runs extra benchmarks which can be very slow. - default: False - manual: True - -library - if arch(javascript) || flag(pure-haskell) - cpp-options: -DPURE_HASKELL - else - c-sources: cbits/is_ascii.c - cbits/reverse.c - cbits/utils.c - if (arch(aarch64)) - c-sources: cbits/aarch64/measure_off.c - else - c-sources: cbits/measure_off.c - - hs-source-dirs: src - - if flag(simdutf) && !(arch(javascript) || flag(pure-haskell)) - exposed-modules: Data.Text.Internal.Validate.Simd - include-dirs: simdutf - cxx-sources: simdutf/simdutf.cpp - cbits/validate_utf8.cpp - cxx-options: -std=c++17 - cpp-options: -DSIMDUTF - if impl(ghc >= 9.4) - build-depends: system-cxx-std-lib == 1.0 - elif os(darwin) || os(freebsd) - extra-libraries: c++ - elif os(openbsd) - extra-libraries: c++ c++abi pthread - elif os(windows) - -- GHC's Windows toolchain is based on clang/libc++ in GHC 9.4 and later - if impl(ghc < 9.3) - extra-libraries: stdc++ - else - extra-libraries: c++ c++abi - elif arch(wasm32) - cpp-options: -DSIMDUTF_NO_THREADS - cxx-options: -fno-exceptions - extra-libraries: c++ c++abi - else - extra-libraries: stdc++ - - -- Certain version of GHC crash on Windows, when TemplateHaskell encounters C++. - -- https://gitlab.haskell.org/ghc/ghc/-/issues/19417 - if flag(simdutf) && os(windows) && impl(ghc >= 8.8 && < 8.10.5 || == 9.0.1) - build-depends: base < 0 - - -- For GHC 8.2, 8.6.3 and 8.10.1 even TH + C crash Windows linker. - if os(windows) && impl(ghc >= 8.2 && < 8.4 || == 8.6.3 || == 8.10.1) - build-depends: base < 0 - - -- GHC 8.10 has linking issues (probably TH-related) on ARM. - if (arch(aarch64) || arch(arm)) && impl(ghc == 8.10.*) - build-depends: base < 0 - - -- Subword primitives in GHC 9.2.1 are broken on ARM platforms. - if (arch(aarch64) || arch(arm)) && impl(ghc == 9.2.1) - build-depends: base < 0 - - -- NetBSD + GHC 9.2.1 + TH + C++ does not work together. - -- https://gitlab.haskell.org/ghc/ghc/-/issues/22577 - if flag(simdutf) && os(netbsd) && impl(ghc < 9.4) - build-depends: base < 0 - - exposed-modules: - Data.Text - Data.Text.Array - Data.Text.Encoding - Data.Text.Encoding.Error - Data.Text.Foreign - Data.Text.IO - Data.Text.IO.Utf8 - Data.Text.Internal - Data.Text.Internal.ArrayUtils - Data.Text.Internal.Builder - Data.Text.Internal.Builder.Functions - Data.Text.Internal.Builder.Int.Digits - Data.Text.Internal.Builder.RealFloat.Functions - Data.Text.Internal.ByteStringCompat - Data.Text.Internal.PrimCompat - Data.Text.Internal.Encoding - Data.Text.Internal.Encoding.Fusion - Data.Text.Internal.Encoding.Fusion.Common - Data.Text.Internal.Encoding.Utf16 - Data.Text.Internal.Encoding.Utf32 - Data.Text.Internal.Encoding.Utf8 - Data.Text.Internal.Fusion - Data.Text.Internal.Fusion.CaseMapping - Data.Text.Internal.Fusion.Common - Data.Text.Internal.Fusion.Size - Data.Text.Internal.Fusion.Types - Data.Text.Internal.IO - Data.Text.Internal.Lazy - Data.Text.Internal.Lazy.Encoding.Fusion - Data.Text.Internal.Lazy.Fusion - Data.Text.Internal.Lazy.Search - Data.Text.Internal.Private - Data.Text.Internal.Read - Data.Text.Internal.Search - Data.Text.Internal.StrictBuilder - Data.Text.Internal.Unsafe - Data.Text.Internal.Unsafe.Char - Data.Text.Internal.Validate - Data.Text.Internal.Validate.Native - Data.Text.Lazy - Data.Text.Lazy.Builder - Data.Text.Lazy.Builder.Int - Data.Text.Lazy.Builder.RealFloat - Data.Text.Lazy.Encoding - Data.Text.Lazy.IO - Data.Text.Lazy.Internal - Data.Text.Lazy.Read - Data.Text.Read - Data.Text.Unsafe - - other-modules: - Data.Text.Show - Data.Text.Internal.Measure - Data.Text.Internal.Reverse - Data.Text.Internal.Transformation - Data.Text.Internal.IsAscii - - build-depends: - array >= 0.3 && < 0.6, - base >= 4.11 && < 5, - binary >= 0.5 && < 0.9, - bytestring >= 0.10.4 && < 0.13, - deepseq >= 1.1 && < 1.6, - ghc-prim >= 0.2 && < 0.12, - template-haskell >= 2.5 && < 2.23 - - if impl(ghc < 9.4) - build-depends: data-array-byte >= 0.1 && < 0.2 - - ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2 - if flag(developer) - ghc-options: -fno-ignore-asserts - cpp-options: -DASSERTS - if impl(ghc >= 9.2.2) - ghc-options: -fcheck-prim-bounds - - default-language: Haskell2010 - default-extensions: - NondecreasingIndentation - other-extensions: - BangPatterns - CPP - DeriveDataTypeable - ExistentialQuantification - ForeignFunctionInterface - GeneralizedNewtypeDeriving - MagicHash - OverloadedStrings - Rank2Types - RankNTypes - RecordWildCards - Safe - ScopedTypeVariables - TemplateHaskellQuotes - Trustworthy - TypeFamilies - UnboxedTuples - UnliftedFFITypes - -source-repository head - type: git - location: https://github.com/haskell/text - -test-suite tests - type: exitcode-stdio-1.0 - ghc-options: - -Wall -threaded -rtsopts -with-rtsopts=-N - - hs-source-dirs: tests - main-is: Tests.hs - other-modules: - Tests.Lift - Tests.Properties - Tests.Properties.Basics - Tests.Properties.Builder - Tests.Properties.Folds - Tests.Properties.Instances - Tests.Properties.LowLevel - Tests.Properties.Read - Tests.Properties.Substrings - Tests.Properties.Text - Tests.Properties.Transcoding - Tests.Properties.Validate - Tests.QuickCheckUtils - Tests.RebindableSyntaxTest - Tests.Regressions - Tests.SlowFunctions - Tests.ShareEmpty - Tests.Utils - - build-depends: - QuickCheck >= 2.12.6 && < 2.16, - base <5, - binary, - bytestring, - deepseq, - directory, - ghc-prim, - tasty, - tasty-hunit, - tasty-quickcheck, - template-haskell, - transformers, - text - if impl(ghc < 9.4) - build-depends: data-array-byte >= 0.1 && < 0.2 - -- Plugin infrastructure does not work properly in 8.6.1, and - -- ghc-9.2.1 library depends on parsec, which causes a circular dependency. - if impl(ghc >= 8.2.1 && < 8.6 || >= 8.6.2 && < 9.2 || >= 9.2.2) - build-depends: tasty-inspection-testing - - default-language: Haskell2010 - default-extensions: NondecreasingIndentation - -benchmark text-benchmarks - type: exitcode-stdio-1.0 - - ghc-options: -Wall -O2 -rtsopts "-with-rtsopts=-A32m" - if impl(ghc >= 8.6) - ghc-options: -fproc-alignment=64 - if flag(ExtendedBenchmarks) - cpp-options: -DExtendedBenchmarks - - build-depends: base, - bytestring >= 0.10.4, - containers, - deepseq, - directory, - filepath, - tasty-bench >= 0.2, - text, - transformers - - hs-source-dirs: benchmarks/haskell - main-is: Benchmarks.hs - other-modules: - Benchmarks.Builder - Benchmarks.Concat - Benchmarks.DecodeUtf8 - Benchmarks.EncodeUtf8 - Benchmarks.Equality - Benchmarks.FileRead - Benchmarks.FileWrite - Benchmarks.FoldLines - Benchmarks.Micro - Benchmarks.Multilang - Benchmarks.Programs.BigTable - Benchmarks.Programs.Cut - Benchmarks.Programs.Fold - Benchmarks.Programs.Sort - Benchmarks.Programs.StripTags - Benchmarks.Programs.Throughput - Benchmarks.Pure - Benchmarks.ReadNumbers - Benchmarks.Replace - Benchmarks.Search - Benchmarks.Stream - Benchmarks.WordFrequencies - - default-language: Haskell2010 - default-extensions: NondecreasingIndentation - other-extensions: DeriveGeneric +cabal-version: 2.2 +name: text +version: 2.1.3 + +homepage: https://github.com/haskell/text +bug-reports: https://github.com/haskell/text/issues +synopsis: An efficient packed Unicode text type. +description: + . + An efficient packed, immutable Unicode text type (both strict and + lazy). + . + The 'Text' type represents Unicode character strings, in a time and + space-efficient manner. This package provides text processing + capabilities that are optimized for performance critical use, both + in terms of large data quantities and high speed. + . + The 'Text' type provides character-encoding, type-safe case + conversion via whole-string case conversion functions (see "Data.Text"). + It also provides a range of functions for converting 'Text' values to + and from 'ByteStrings', using several standard encodings + (see "Data.Text.Encoding"). + . + Efficient locale-sensitive support for text IO is also supported + (see "Data.Text.IO"). + . + These modules are intended to be imported qualified, to avoid name + clashes with Prelude functions, e.g. + . + > import qualified Data.Text as T + . + == ICU Support + . + To use an extended and very rich family of functions for working + with Unicode text (including normalization, regular expressions, + non-standard encodings, text breaking, and locales), see + the [text-icu package](https://hackage.haskell.org/package/text-icu) + based on the well-respected and liberally + licensed [ICU library](http://site.icu-project.org/). + +license: BSD-2-Clause +license-file: LICENSE +author: Bryan O'Sullivan +maintainer: Haskell Text Team , Core Libraries Committee +copyright: 2009-2011 Bryan O'Sullivan, 2008-2009 Tom Harper, 2021 Andrew Lelechenko +category: Data, Text +build-type: Simple +tested-with: + GHC == 8.4.4 + GHC == 8.6.5 + GHC == 8.8.4 + GHC == 8.10.7 + GHC == 9.0.2 + GHC == 9.2.8 + GHC == 9.4.8 + GHC == 9.6.7 + GHC == 9.8.4 + GHC == 9.10.1 + GHC == 9.12.2 + +extra-source-files: + -- scripts/CaseFolding.txt + -- scripts/SpecialCasing.txt + README.md + changelog.md + scripts/*.hs + simdutf/LICENSE-APACHE + simdutf/LICENSE-MIT + simdutf/simdutf.h + tests/literal-rule-test.sh + tests/LiteralRuleTest.hs + +flag developer + description: operate in developer mode + default: False + manual: True + +flag simdutf + description: use simdutf library, causes Data.Text.Internal.Validate.Simd to be exposed + default: True + manual: True + +flag pure-haskell + description: Don't use text's standard C routines + NB: This feature is not fully implemented. Several C routines are still in + use. + + When this flag is true, text will use pure Haskell variants of the + routines. This is not recommended except for use with GHC's JavaScript + backend. + + This flag also disables simdutf. + + default: False + manual: True + +flag ExtendedBenchmarks + description: Runs extra benchmarks which can be very slow. + default: False + manual: True + +library + if arch(javascript) || flag(pure-haskell) + cpp-options: -DPURE_HASKELL + else + c-sources: cbits/is_ascii.c + cbits/reverse.c + cbits/utils.c + if (arch(aarch64)) + c-sources: cbits/aarch64/measure_off.c + else + c-sources: cbits/measure_off.c + + hs-source-dirs: src + + if flag(simdutf) && !(arch(javascript) || flag(pure-haskell)) + exposed-modules: Data.Text.Internal.Validate.Simd + include-dirs: simdutf + cxx-sources: simdutf/simdutf.cpp + cbits/validate_utf8.cpp + cxx-options: -std=c++17 + cpp-options: -DSIMDUTF + if impl(ghc >= 9.4) + build-depends: system-cxx-std-lib == 1.0 + elif os(darwin) || os(freebsd) + extra-libraries: c++ + elif os(openbsd) + extra-libraries: c++ c++abi pthread + elif os(windows) + -- GHC's Windows toolchain is based on clang/libc++ in GHC 9.4 and later + if impl(ghc < 9.3) + extra-libraries: stdc++ + else + extra-libraries: c++ c++abi + elif arch(wasm32) + cpp-options: -DSIMDUTF_NO_THREADS + cxx-options: -fno-exceptions + extra-libraries: c++ c++abi + else + extra-libraries: stdc++ + + -- Certain version of GHC crash on Windows, when TemplateHaskell encounters C++. + -- https://gitlab.haskell.org/ghc/ghc/-/issues/19417 + if flag(simdutf) && os(windows) && impl(ghc >= 8.8 && < 8.10.5 || == 9.0.1) + build-depends: base < 0 + + -- For GHC 8.2, 8.6.3 and 8.10.1 even TH + C crash Windows linker. + if os(windows) && impl(ghc >= 8.2 && < 8.4 || == 8.6.3 || == 8.10.1) + build-depends: base < 0 + + -- GHC 8.10 has linking issues (probably TH-related) on ARM. + if (arch(aarch64) || arch(arm)) && impl(ghc == 8.10.*) + build-depends: base < 0 + + -- Subword primitives in GHC 9.2.1 are broken on ARM platforms. + if (arch(aarch64) || arch(arm)) && impl(ghc == 9.2.1) + build-depends: base < 0 + + -- NetBSD + GHC 9.2.1 + TH + C++ does not work together. + -- https://gitlab.haskell.org/ghc/ghc/-/issues/22577 + if flag(simdutf) && os(netbsd) && impl(ghc < 9.4) + build-depends: base < 0 + + exposed-modules: + Data.Text + Data.Text.Array + Data.Text.Encoding + Data.Text.Encoding.Error + Data.Text.Foreign + Data.Text.IO + Data.Text.IO.Utf8 + Data.Text.Internal + Data.Text.Internal.ArrayUtils + Data.Text.Internal.Builder + Data.Text.Internal.Builder.Functions + Data.Text.Internal.Builder.Int.Digits + Data.Text.Internal.Builder.RealFloat.Functions + Data.Text.Internal.ByteStringCompat + Data.Text.Internal.PrimCompat + Data.Text.Internal.Encoding + Data.Text.Internal.Encoding.Fusion + Data.Text.Internal.Encoding.Fusion.Common + Data.Text.Internal.Encoding.Utf16 + Data.Text.Internal.Encoding.Utf32 + Data.Text.Internal.Encoding.Utf8 + Data.Text.Internal.Fusion + Data.Text.Internal.Fusion.CaseMapping + Data.Text.Internal.Fusion.Common + Data.Text.Internal.Fusion.Size + Data.Text.Internal.Fusion.Types + Data.Text.Internal.IO + Data.Text.Internal.Lazy + Data.Text.Internal.Lazy.Encoding.Fusion + Data.Text.Internal.Lazy.Fusion + Data.Text.Internal.Lazy.Search + Data.Text.Internal.Private + Data.Text.Internal.Read + Data.Text.Internal.Search + Data.Text.Internal.StrictBuilder + Data.Text.Internal.Unsafe + Data.Text.Internal.Unsafe.Char + Data.Text.Internal.Validate + Data.Text.Internal.Validate.Native + Data.Text.Lazy + Data.Text.Lazy.Builder + Data.Text.Lazy.Builder.Int + Data.Text.Lazy.Builder.RealFloat + Data.Text.Lazy.Encoding + Data.Text.Lazy.IO + Data.Text.Lazy.Internal + Data.Text.Lazy.Read + Data.Text.Read + Data.Text.Unsafe + + other-modules: + Data.Text.Show + Data.Text.Internal.Measure + Data.Text.Internal.Reverse + Data.Text.Internal.Transformation + Data.Text.Internal.IsAscii + + build-depends: + array >= 0.3 && < 0.6, + base >= 4.11 && < 5, + binary >= 0.5 && < 0.9, + bytestring >= 0.10.4 && < 0.13, + deepseq >= 1.1 && < 1.6, + ghc-prim >= 0.2 && < 0.15, + template-haskell >= 2.5 && < 2.25 + + if impl(ghc < 9.4) + build-depends: data-array-byte >= 0.1 && < 0.2 + + ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2 + if flag(developer) + ghc-options: -fno-ignore-asserts + cpp-options: -DASSERTS + if impl(ghc >= 9.2.2) + ghc-options: -fcheck-prim-bounds + + default-language: Haskell2010 + default-extensions: + NondecreasingIndentation + other-extensions: + BangPatterns + CPP + DeriveDataTypeable + ExistentialQuantification + ForeignFunctionInterface + GeneralizedNewtypeDeriving + MagicHash + OverloadedStrings + Rank2Types + RankNTypes + RecordWildCards + Safe + ScopedTypeVariables + TemplateHaskellQuotes + Trustworthy + TypeFamilies + UnboxedTuples + UnliftedFFITypes + +source-repository head + type: git + location: https://github.com/haskell/text + +test-suite tests + type: exitcode-stdio-1.0 + ghc-options: + -Wall -threaded -rtsopts -with-rtsopts=-N + + hs-source-dirs: tests + main-is: Tests.hs + other-modules: + Tests.Lift + Tests.Properties + Tests.Properties.Basics + Tests.Properties.Builder + Tests.Properties.Folds + Tests.Properties.Instances + Tests.Properties.LowLevel + Tests.Properties.Read + Tests.Properties.Substrings + Tests.Properties.Text + Tests.Properties.Transcoding + Tests.Properties.CornerCases + Tests.Properties.Validate + Tests.QuickCheckUtils + Tests.RebindableSyntaxTest + Tests.Regressions + Tests.SlowFunctions + Tests.ShareEmpty + Tests.Utils + + build-depends: + QuickCheck >= 2.12.6 && < 2.17, + base <5, + binary, + bytestring, + deepseq, + ghc-prim, + tasty, + tasty-hunit, + tasty-quickcheck, + template-haskell, + temporary, + transformers, + text + if impl(ghc < 9.4) + build-depends: data-array-byte >= 0.1 && < 0.2 + + -- Plugin infrastructure does not work properly in 8.6.1, and + -- ghc-9.2.1 library depends on parsec, which causes a circular dependency. + if impl(ghc >= 8.2.1 && < 8.6 || >= 8.6.2 && < 9.2 || >= 9.2.2) + build-depends: tasty-inspection-testing + + -- https://github.com/haskellari/splitmix/issues/101 + if os(openbsd) + build-depends: splitmix < 0.1.3 || > 0.1.3.1 + + default-language: Haskell2010 + default-extensions: NondecreasingIndentation + +benchmark text-benchmarks + type: exitcode-stdio-1.0 + + ghc-options: -Wall -O2 -rtsopts "-with-rtsopts=-A32m" + if impl(ghc >= 8.6) + ghc-options: -fproc-alignment=64 + if flag(ExtendedBenchmarks) + cpp-options: -DExtendedBenchmarks + + build-depends: base, + bytestring >= 0.10.4, + containers, + deepseq, + directory, + filepath, + tasty-bench >= 0.2, + temporary, + text, + transformers + + hs-source-dirs: benchmarks/haskell + main-is: Benchmarks.hs + other-modules: + Benchmarks.Builder + Benchmarks.Concat + Benchmarks.DecodeUtf8 + Benchmarks.EncodeUtf8 + Benchmarks.Equality + Benchmarks.FileRead + Benchmarks.FileWrite + Benchmarks.FoldLines + Benchmarks.Micro + Benchmarks.Multilang + Benchmarks.Programs.BigTable + Benchmarks.Programs.Cut + Benchmarks.Programs.Fold + Benchmarks.Programs.Sort + Benchmarks.Programs.StripTags + Benchmarks.Programs.Throughput + Benchmarks.Pure + Benchmarks.ReadNumbers + Benchmarks.Replace + Benchmarks.Search + Benchmarks.Stream + Benchmarks.WordFrequencies + + default-language: Haskell2010 + default-extensions: NondecreasingIndentation + other-extensions: DeriveGeneric