on facce62 help sign in
.gitignoredeleted−3
since splitsnapshots
unifiedsplit
@@ -1,3 +0,0 @@
1−dist
2−cabal-dev
3−cabal.sandbox.config
.hgignore+3−9
@@ -1,14 +1,8 @@
1−^(?:dist|benchmarks/dist|tests/coverage|tests/dist)$
1+^(?:dist|tests/benchmarks/dist|tests/tests/dist)$
2−^benchmarks/.*\.txt$
2+^tests/benchmarks/.*\.txt$
3^tests/text-testdata.tar.bz2$
3^tests/text-testdata.tar.bz2$
4^tests/(?:\.hpc|bm|qc|qc-hpc|stdio-hpc|text/test)$
4^tests/(?:\.hpc|bm|qc|qc-hpc|stdio-hpc|text/test)$
5−\.(?:aux|eventlog|h[ip]|log|[oa]|orig|prof|ps|rej|swp|tix)$
5+\.(?:aux|eventlog|h[ip]|log|[oa]|orig|prof|ps|rej|swp)$
6~$
6~$
7−
8syntax: glob
7syntax: glob
9.\#*
8.\#*
10−cabal-dev
11−cabal.sandbox.config
12−\.cabal-sandbox
13−scripts/CaseFolding.txt
14−scripts/SpecialCasing.txt
.hgtags−39
@@ -25,42 +25,3 @@ c808123a3d37f25004d2aad8f3a395acfcf9122f 0.11.0.7
25b49eebfa5673da89a23939d523c9de9edbd410b0 0.11.1.0
25b49eebfa5673da89a23939d523c9de9edbd410b0 0.11.1.0
269c820a2ecaea01bc614d8e6bccf90e57431bdcbb 0.11.1.1
269c820a2ecaea01bc614d8e6bccf90e57431bdcbb 0.11.1.1
27ed3a60ec627af6ba8af321009aa00224b3296e47 0.11.1.2
27ed3a60ec627af6ba8af321009aa00224b3296e47 0.11.1.2
28−b75d3041d275e8e76b26605b0d426a572ddf1249 0.11.1.3
29−53906ad0c7e64f6c9a5df569e7cc642579aab8fc 0.11.1.5
30−9d6d3a9690ade506897c072060eb92868e229d5c 0.11.1.6
31−5ac062eace36b333566d1676979a57039a188840 0.11.1.7
32−9f01361a73071936b6ab0bdb879f1a45cca6577a 0.11.1.8
33−5dce2a934be53e74310fedffb51d7bd3e61fa993 0.11.1.9
34−9f47a2cfc9e51fd622d7553f08ad2ac1faad0438 0.11.1.10
35−9f47a2cfc9e51fd622d7553f08ad2ac1faad0438 0.11.1.10
36−407937739e9e764f1ae0f1f9ca454c42dca38772 0.11.1.10
37−8b981edd27befa4c2dd334fcb7db22ac67e22b67 0.11.1.11
38−204da16b5098531bdf858c388e2620238ef2aa5e 0.11.1.12
39−6a3d847a56a69d0514a79cb212cb218271ad0917 0.11.1.13
40−1d2c6fa9092c6a4000b2abdd9d01f3efcd477be5 0.11.2.0
41−78219784cf3652cc662805bf2971bd62d80210a9 0.11.2.1
42−4297307ebc11ad677cfba6b40319e7e5e2c0cfee 0.11.2.3
43−7fa79662b66aade97fe49394977213fe6432942e 0.11.3.0
44−d99cd091cdf71ce807a4255f6cc509c3154f51ea 0.11.3.1
45−31f57612fd425d1bb56352ce6b79e41ce6699a45 1.0.0.0
46−7cba97c86467c1881dfced68613891f3c65561b0 1.0.0.1
47−62674a9bbc83145d1d7be28a05d456ab6bb5ff89 1.1.0.0
48−68a32d80c0829da164d1e6b3acedcc3efeda0957 1.1.0.1
49−6d863daafbf0e1289ec0a0eb9b4be2a0a9cb8d3d 1.1.1.0
50−fb7299f22449750c653ac64dee4bd63c13ea6e4c 1.1.1.1
51−eb170cb533b63534d166b5fd5344b36676adf140 1.1.1.2
52−e749e05f715d02445803f653cd3d97d5395d7c6f 1.1.1.3
53−b0dff8ca1142595bab489a768ca62e6a6805aac4 1.1.1.4
54−f8a60279237c1c28e094868740d9188dd94fcc9e 1.2.0.0
55−6231451979b2d33e28038b75f2dab19c9731f5c3 1.2.0.1
56−99a3503b4ad001fc1894e90286e96d7dea1e9195 1.2.0.2
57−47f138edf15576b9adaeed64784e30811099f202 1.2.0.3
58−0b064b0c69106bbcd13cb0099e72ae5fa2347bf0 1.2.0.4
59−8bbb3e222a0037035d893f731b0a23be449f7346 1.2.0.5
60−18c7f8e19872762b7e28ee1871e72f70ea54e3cd 1.2.0.6
61−42f751b87b4a187db93f595a8166d51746ff57d4 1.2.1.0
62−78227a84740b70dcd4cf7a65f3bcf603d87e48e2 1.2.1.1
63−40f268e6735749ef36f487e1d928eaa957bb431d 1.2.1.2
64−631fd055e27fa10983e17e9ad36d1b285b85c661 1.2.1.3
65−8221a68ed5ec37028357df9c6c25f52320e54ad9 1.2.2.0
66−ce1c5ac65eb9f5580114b4e380092b05a485e95d 1.2.2.1
Data/Text.hs+176−370
@@ -1,20 +1,15 @@
1−{-# LANGUAGE BangPatterns, CPP, MagicHash, Rank2Types, UnboxedTuples #-}
1+{-# LANGUAGE BangPatterns, CPP, Rank2Types #-}
2{-# OPTIONS_GHC -fno-warn-orphans #-}
2{-# OPTIONS_GHC -fno-warn-orphans #-}
3−#if __GLASGOW_HASKELL__ >= 702
4−{-# LANGUAGE Trustworthy #-}
5−#endif
6−#if __GLASGOW_HASKELL__ >= 708
7−{-# LANGUAGE TypeFamilies #-}
8−#endif
9
3
10-- |
4-- |
11-- Module : Data.Text
5-- Module : Data.Text
6+-- Copyright : (c) 2008, 2009 Tom Harper,
12−-- Copyright : (c) 2009, 2010, 2011, 2012 Bryan O'Sullivan,
7+-- (c) 2009, 2010 Bryan O'Sullivan,
13−-- (c) 2009 Duncan Coutts,
8+-- (c) 2009 Duncan Coutts
14−-- (c) 2008, 2009 Tom Harper
15--
9--
16-- License : BSD-style
10-- License : BSD-style
17−-- Maintainer : bos@serpentine.com
11+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
12+-- duncan@haskell.org
18-- Stability : experimental
13-- Stability : experimental
19-- Portability : GHC
14-- Portability : GHC
20--
15--
@@ -32,8 +27,8 @@
32--
27--
33-- To use an extended and very rich family of functions for working
28-- To use an extended and very rich family of functions for working
34-- with Unicode text (including normalization, regular expressions,
29-- with Unicode text (including normalization, regular expressions,
35−-- non-standard encodings, text breaking, and locales), see
30+-- non-standard encodings, text breaking, and locales), see the
36−-- <http://hackage.haskell.org/package/text-icu the text-icu package >.
31+-- @text-icu@ package: <http://hackage.haskell.org/package/text-icu>
37
32
38module Data.Text
33module Data.Text
39 (
34 (
@@ -81,7 +76,6 @@ module Data.Text
81 , toCaseFold
76 , toCaseFold
82 , toLower
77 , toLower
83 , toUpper
78 , toUpper
84− , toTitle
85
79
86 -- ** Justification
80 -- ** Justification
87 , justifyLeft
81 , justifyLeft
@@ -125,11 +119,8 @@ module Data.Text
125
119
126 -- ** Breaking strings
120 -- ** Breaking strings
127 , take
121 , take
128− , takeEnd
129 , drop
122 , drop
130− , dropEnd
131 , takeWhile
123 , takeWhile
132− , takeWhileEnd
133 , dropWhile
124 , dropWhile
134 , dropWhileEnd
125 , dropWhileEnd
135 , dropAround
126 , dropAround
@@ -176,110 +167,92 @@ module Data.Text
176 , partition
167 , partition
177
168
178 -- , findSubstring
169 -- , findSubstring
179−
170+
180 -- * Indexing
171 -- * Indexing
181 -- $index
172 -- $index
182 , index
173 , index
183 , findIndex
174 , findIndex
184 , count
175 , count
185
176
186− -- * Zipping
177+ -- * Zipping and unzipping
187 , zip
178 , zip
188 , zipWith
179 , zipWith
189
180
190 -- -* Ordered text
181 -- -* Ordered text
191 -- , sort
182 -- , sort
192−
193− -- * Low level operations
194− , copy
195− , unpackCString#
196 ) where
183 ) where
197
184
198import Prelude (Char, Bool(..), Int, Maybe(..), String,
185import Prelude (Char, Bool(..), Int, Maybe(..), String,
199 Eq(..), Ord(..), Ordering(..), (++),
186 Eq(..), Ord(..), Ordering(..), (++),
200− Read(..),
187+ Read(..), Show(..),
201− (&&), (||), (+), (-), (.), ($), ($!), (>>),
188+ (&&), (||), (+), (-), (.), ($), ($!), (>>), (*),
202− not, return, otherwise, quot)
189+ div, maxBound, not, return, otherwise)
203#if defined(HAVE_DEEPSEQ)
190#if defined(HAVE_DEEPSEQ)
204−import Control.DeepSeq (NFData(rnf))
191+import Control.DeepSeq (NFData)
205#endif
192#endif
206#if defined(ASSERTS)
193#if defined(ASSERTS)
207import Control.Exception (assert)
194import Control.Exception (assert)
208#endif
195#endif
209import Data.Char (isSpace)
196import Data.Char (isSpace)
210−import Data.Data (Data(gfoldl, toConstr, gunfold, dataTypeOf), constrIndex,
197+import Data.Data (Data(gfoldl, toConstr, gunfold, dataTypeOf))
211− Constr, mkConstr, DataType, mkDataType, Fixity(Prefix))
198+#if __GLASGOW_HASKELL__ >= 612
199+import Data.Data (mkNoRepType)
200+#else
201+import Data.Data (mkNorepType)
202+#endif
212import Control.Monad (foldM)
203import Control.Monad (foldM)
213−import Control.Monad.ST (ST)
214import qualified Data.Text.Array as A
204import qualified Data.Text.Array as A
215import qualified Data.List as L
205import qualified Data.List as L
216−import Data.Binary (Binary(get, put))
217import Data.Monoid (Monoid(..))
206import Data.Monoid (Monoid(..))
218−#if MIN_VERSION_base(4,9,0)
219−import Data.Semigroup (Semigroup(..))
220−#endif
221import Data.String (IsString(..))
207import Data.String (IsString(..))
222−import qualified Data.Text.Internal.Fusion as S
208+import qualified Data.Text.Fusion as S
223−import qualified Data.Text.Internal.Fusion.Common as S
209+import qualified Data.Text.Fusion.Common as S
224−import Data.Text.Encoding (decodeUtf8', encodeUtf8)
225−import Data.Text.Internal.Fusion (stream, reverseStream, unstream)
210+import Data.Text.Fusion (stream, reverseStream, unstream)
226−import Data.Text.Internal.Private (span_)
211+import Data.Text.Internal (Text(..), empty, firstf, safe, text, textP)
227−import Data.Text.Internal (Text(..), empty, firstf, mul, safe, text)
228−import Data.Text.Show (singleton, unpack, unpackCString#)
229import qualified Prelude as P
212import qualified Prelude as P
230import Data.Text.Unsafe (Iter(..), iter, iter_, lengthWord16, reverseIter,
213import Data.Text.Unsafe (Iter(..), iter, iter_, lengthWord16, reverseIter,
231− reverseIter_, unsafeHead, unsafeTail)
214+ unsafeHead, unsafeTail)
232−import Data.Text.Internal.Unsafe.Char (unsafeChr)
215+import Data.Text.UnsafeChar (unsafeChr)
233−import qualified Data.Text.Internal.Functions as F
216+import qualified Data.Text.Util as U
234−import qualified Data.Text.Internal.Encoding.Utf16 as U16
217+import qualified Data.Text.Encoding.Utf16 as U16
235−import Data.Text.Internal.Search (indices)
218+import Data.Text.Search (indices)
236#if defined(__HADDOCK__)
219#if defined(__HADDOCK__)
237import Data.ByteString (ByteString)
220import Data.ByteString (ByteString)
238import qualified Data.Text.Lazy as L
221import qualified Data.Text.Lazy as L
239import Data.Int (Int64)
222import Data.Int (Int64)
240#endif
223#endif
241−import GHC.Base (eqInt, neInt, gtInt, geInt, ltInt, leInt)
242−#if __GLASGOW_HASKELL__ >= 708
243−import qualified GHC.Exts as Exts
244−#endif
245−#if MIN_VERSION_base(4,7,0)
246−import Text.Printf (PrintfArg, formatArg, formatString)
247−#endif
248
224
249-- $strict
225-- $strict
250--
226--
251-- This package provides both strict and lazy 'Text' types. The
227-- This package provides both strict and lazy 'Text' types. The
252−-- strict type is provided by the "Data.Text" module, while the lazy
228+-- strict type is provided by the 'Data.Text' package, while the lazy
253−-- type is provided by the "Data.Text.Lazy" module. Internally, the
229+-- type is provided by the 'Data.Text.Lazy' package. Internally, the
254-- lazy @Text@ type consists of a list of strict chunks.
230-- lazy @Text@ type consists of a list of strict chunks.
255--
231--
256-- The strict 'Text' type requires that an entire string fit into
232-- The strict 'Text' type requires that an entire string fit into
257−-- memory at once. The lazy 'Data.Text.Lazy.Text' type is capable of
233+-- memory at once. The lazy @Text@ type is capable of streaming
258−-- streaming strings that are larger than memory using a small memory
234+-- strings that are larger than memory using a small memory footprint.
259−-- footprint. In many cases, the overhead of chunked streaming makes
235+-- In many cases, the overhead of chunked streaming makes the lazy
260−-- the lazy 'Data.Text.Lazy.Text' type slower than its strict
236+-- @Text@ type slower than its strict counterpart, but this is not
261−-- counterpart, but this is not always the case. Sometimes, the time
237+-- always the case. Sometimes, the time complexity of a function in
262−-- complexity of a function in one module may be different from the
238+-- one module may be different from the other, due to their differing
263−-- other, due to their differing internal structures.
239+-- internal structures.
264--
240--
265-- Each module provides an almost identical API, with the main
241-- Each module provides an almost identical API, with the main
266-- difference being that the strict module uses 'Int' values for
242-- difference being that the strict module uses 'Int' values for
267−-- lengths and counts, while the lazy module uses 'Data.Int.Int64'
243+-- lengths and counts, while the lazy module uses 'Int64' lengths.
268−-- lengths.
269
244
270-- $replacement
245-- $replacement
271--
246--
272-- A 'Text' value is a sequence of Unicode scalar values, as defined
247-- A 'Text' value is a sequence of Unicode scalar values, as defined
273−-- in
274−-- <http://www.unicode.org/versions/Unicode5.2.0/ch03.pdf#page=35 §3.9, definition D76 of the Unicode 5.2 standard >.
248+-- in &#xa7;3.9, definition D76 of the Unicode 5.2 standard:
249+-- <http://www.unicode.org/versions/Unicode5.2.0/ch03.pdf#page=35>. As
275−-- As such, a 'Text' cannot contain values in the range U+D800 to
250+-- such, a 'Text' cannot contain values in the range U+D800 to U+DFFF
276−-- U+DFFF inclusive. Haskell implementations admit all Unicode code
251+-- inclusive. Haskell implementations admit all Unicode code points
277−-- points
278−-- (<http://www.unicode.org/versions/Unicode5.2.0/ch03.pdf#page=13 §3.4, definition D10 >)
279−-- as 'Char' values, including code points from this invalid range.
252+-- (&#xa7;3.4, definition D10) as 'Char' values, including code points
280−-- This means that there are some 'Char' values that are not valid
253+-- from this invalid range. This means that there are some 'Char'
281−-- Unicode scalar values, and the functions in this module must handle
254+-- values that are not valid Unicode scalar values, and the functions
282−-- those cases.
255+-- in this module must handle those cases.
283--
256--
284-- Within this module, many functions construct a 'Text' from one or
257-- Within this module, many functions construct a 'Text' from one or
285-- more 'Char' values. Those functions will substitute 'Char' values
258-- more 'Char' values. Those functions will substitute 'Char' values
@@ -293,8 +266,8 @@ import Text.Printf (PrintfArg, formatArg, formatString)
293-- range U+D800 through U+DFFF are used by UTF-16 to denote surrogate
266-- range U+D800 through U+DFFF are used by UTF-16 to denote surrogate
294-- code points, and so cannot be represented. The functions replace
267-- code points, and so cannot be represented. The functions replace
295-- invalid scalar values, instead of dropping them, as a security
268-- invalid scalar values, instead of dropping them, as a security
296−-- measure. For details, see
269+-- measure. For details, see Unicode Technical Report 36, &#xa7;3.5:
297−-- <http://unicode.org/reports/tr36/#Deletion_of_Noncharacters Unicode Technical Report 36, §3.5 >.)
270+-- <http://unicode.org/reports/tr36/#Deletion_of_Noncharacters>)
298
271
299-- $fusion
272-- $fusion
300--
273--
@@ -312,11 +285,11 @@ import Text.Printf (PrintfArg, formatArg, formatString)
312-- > countChars = T.length . T.toUpper . E.decodeUtf8
285-- > countChars = T.length . T.toUpper . E.decodeUtf8
313--
286--
314-- From the type signatures involved, this looks like it should
287-- From the type signatures involved, this looks like it should
315−-- allocate one 'Data.ByteString.ByteString' value, and two 'Text'
288+-- allocate one 'ByteString' value, and two 'Text' values. However,
316−-- values. However, when a module is compiled with optimisation
289+-- when a module is compiled with optimisation enabled under GHC, the
317−-- enabled under GHC, the two intermediate 'Text' values will be
290+-- two intermediate 'Text' values will be optimised away, and the
318−-- optimised away, and the function will be compiled down to a single
291+-- function will be compiled down to a single loop over the source
319−-- loop over the source 'Data.ByteString.ByteString'.
292+-- 'ByteString'.
320--
293--
321-- Functions that can be fused by the compiler are documented with the
294-- Functions that can be fused by the compiler are documented with the
322-- phrase \"Subject to fusion\".
295-- phrase \"Subject to fusion\".
@@ -330,83 +303,46 @@ instance Eq Text where
330instance Ord Text where
303instance Ord Text where
331 compare = compareText
304 compare = compareText
332
305
306+instance Show Text where
307+ showsPrec p ps r = showsPrec p (unpack ps) r
308+
333instance Read Text where
309instance Read Text where
334 readsPrec p str = [(pack x,y) | (x,y) <- readsPrec p str]
310 readsPrec p str = [(pack x,y) | (x,y) <- readsPrec p str]
335
311
336−#if MIN_VERSION_base(4,9,0)
337−-- Semigroup orphan instances for older GHCs are provided by
338−-- 'semigroups` package
339−
340−instance Semigroup Text where
341− (<>) = append
342−#endif
343−
344instance Monoid Text where
312instance Monoid Text where
345 mempty = empty
313 mempty = empty
346−#if MIN_VERSION_base(4,9,0)
347− mappend = (<>) -- future-proof definition
348−#else
349 mappend = append
314 mappend = append
350−#endif
351 mconcat = concat
315 mconcat = concat
352
316
353instance IsString Text where
317instance IsString Text where
354 fromString = pack
318 fromString = pack
355
319
356−#if __GLASGOW_HASKELL__ >= 708
357−instance Exts.IsList Text where
358− type Item Text = Char
359− fromList = pack
360− toList = unpack
361−#endif
362−
363#if defined(HAVE_DEEPSEQ)
320#if defined(HAVE_DEEPSEQ)
364−instance NFData Text where rnf !_ = ()
321+instance NFData Text
365#endif
322#endif
366
323
367−instance Binary Text where
368− put t = put (encodeUtf8 t)
369− get = do
370− bs <- get
371− case decodeUtf8' bs of
372− P.Left exn -> P.fail (P.show exn)
373− P.Right a -> P.return a
374−
375−-- | This instance preserves data abstraction at the cost of inefficiency.
324+-- This instance preserves data abstraction at the cost of inefficiency.
376-- We omit reflection services for the sake of data abstraction.
325-- We omit reflection services for the sake of data abstraction.
326+--
327+-- This instance was created by copying the behavior of Data.Set and
328+-- Data.Map. If you feel a mistake has been made, please feel free to
329+-- submit improvements.
377--
330--
378−-- This instance was created by copying the updated behavior of
331+-- Original discussion is archived here:
379−-- @"Data.Set".@'Data.Set.Set' and @"Data.Map".@'Data.Map.Map'. If you
332+
380−-- feel a mistake has been made, please feel free to submit
333+-- "could we get a Data instance for Data.Text.Text?"
381−-- improvements.
382−--
383−-- The original discussion is archived here:
384−-- <http://groups.google.com/group/haskell-cafe/browse_thread/thread/b5bbb1b28a7e525d/0639d46852575b93 could we get a Data instance for Data.Text.Text? >
334+-- http://groups.google.com/group/haskell-cafe/browse_thread/thread/b5bbb1b28a7e525d/0639d46852575b93
385−--
386−-- The followup discussion that changed the behavior of 'Data.Set.Set'
387−-- and 'Data.Map.Map' is archived here:
388−-- <http://markmail.org/message/trovdc6zkphyi3cr#query:+page:1+mid:a46der3iacwjcf6n+state:results Proposal: Allow gunfold for Data.Map, ... >
389
335
390instance Data Text where
336instance Data Text where
391 gfoldl f z txt = z pack `f` (unpack txt)
337 gfoldl f z txt = z pack `f` (unpack txt)
392− toConstr _ = packConstr
338+ toConstr _ = P.error "Data.Text.Text.toConstr"
393− gunfold k z c = case constrIndex c of
394− 1 -> k (z pack)
395− _ -> P.error "gunfold"
339+ gunfold _ _ = P.error "Data.Text.Text.gunfold"
396− dataTypeOf _ = textDataType
340+#if __GLASGOW_HASKELL__ >= 612
397−
341+ dataTypeOf _ = mkNoRepType "Data.Text.Text"
398−#if MIN_VERSION_base(4,7,0)
342+#else
399−-- | Only defined for @base-4.7.0.0@ and later
343+ dataTypeOf _ = mkNorepType "Data.Text.Text"
400−instance PrintfArg Text where
401− formatArg txt = formatString $ unpack txt
402#endif
344#endif
403
345
404−packConstr :: Constr
405−packConstr = mkConstr textDataType "pack" [] Prefix
406−
407−textDataType :: DataType
408−textDataType = mkDataType "Data.Text.Text" [packConstr]
409−
410-- | /O(n)/ Compare two 'Text' values lexicographically.
346-- | /O(n)/ Compare two 'Text' values lexicographically.
411compareText :: Text -> Text -> Ordering
347compareText :: Text -> Text -> Ordering
412compareText ta@(Text _arrA _offA lenA) tb@(Text _arrB _offB lenB)
348compareText ta@(Text _arrA _offA lenA) tb@(Text _arrB _offB lenB)
@@ -427,9 +363,20 @@ compareText ta@(Text _arrA _offA lenA) tb@(Text _arrB _offB lenB)
427-- | /O(n)/ Convert a 'String' into a 'Text'. Subject to
363-- | /O(n)/ Convert a 'String' into a 'Text'. Subject to
428-- fusion. Performs replacement on invalid scalar values.
364-- fusion. Performs replacement on invalid scalar values.
429pack :: String -> Text
365pack :: String -> Text
430−pack = unstream . S.map safe . S.streamList
366+pack = unstream . S.streamList . L.map safe
431{-# INLINE [1] pack #-}
367{-# INLINE [1] pack #-}
432
368
369+-- | /O(n)/ Convert a Text into a String. Subject to fusion.
370+unpack :: Text -> String
371+unpack = S.unstreamList . stream
372+{-# INLINE [1] unpack #-}
373+
374+-- | /O(1)/ Convert a character into a Text. Subject to fusion.
375+-- Performs replacement on invalid scalar values.
376+singleton :: Char -> Text
377+singleton = unstream . S.singleton . safe
378+{-# INLINE [1] singleton #-}
379+
433-- -----------------------------------------------------------------------------
380-- -----------------------------------------------------------------------------
434-- * Basic functions
381-- * Basic functions
435
382
@@ -460,13 +407,12 @@ append a@(Text arr1 off1 len1) b@(Text arr2 off2 len2)
460 | otherwise = overflowError "append"
407 | otherwise = overflowError "append"
461 where
408 where
462 len = len1+len2
409 len = len1+len2
463− x :: ST s (A.MArray s)
464 x = do
410 x = do
465 arr <- A.new len
411 arr <- A.new len
466 A.copyI arr 0 arr1 off1 len1
412 A.copyI arr 0 arr1 off1 len1
467 A.copyI arr len1 arr2 off2 len
413 A.copyI arr len1 arr2 off2 len
468 return arr
414 return arr
469−{-# NOINLINE append #-}
415+{-# INLINE append #-}
470
416
471{-# RULES
417{-# RULES
472"TEXT append -> fused" [~1] forall t1 t2.
418"TEXT append -> fused" [~1] forall t1 t2.
@@ -486,8 +432,8 @@ head t = S.head (stream t)
486uncons :: Text -> Maybe (Char, Text)
432uncons :: Text -> Maybe (Char, Text)
487uncons t@(Text arr off len)
433uncons t@(Text arr off len)
488 | len <= 0 = Nothing
434 | len <= 0 = Nothing
489− | otherwise = Just $ let !(Iter c d) = iter t 0
490− in (c, text arr (off+d) (len-d))
435+ | otherwise = Just (c, textP arr (off+d) (len-d))
436+ where Iter c d = iter t 0
491{-# INLINE [1] uncons #-}
437{-# INLINE [1] uncons #-}
492
438
493-- | Lifted from Control.Arrow and specialized.
439-- | Lifted from Control.Arrow and specialized.
@@ -517,7 +463,7 @@ last (Text arr off len)
517tail :: Text -> Text
463tail :: Text -> Text
518tail t@(Text arr off len)
464tail t@(Text arr off len)
519 | len <= 0 = emptyError "tail"
465 | len <= 0 = emptyError "tail"
520− | otherwise = text arr (off+d) (len-d)
466+ | otherwise = textP arr (off+d) (len-d)
521 where d = iter_ t 0
467 where d = iter_ t 0
522{-# INLINE [1] tail #-}
468{-# INLINE [1] tail #-}
523
469
@@ -532,8 +478,8 @@ tail t@(Text arr off len)
532-- be non-empty. Subject to fusion.
478-- be non-empty. Subject to fusion.
533init :: Text -> Text
479init :: Text -> Text
534init (Text arr off len) | len <= 0 = emptyError "init"
480init (Text arr off len) | len <= 0 = emptyError "init"
535− | n >= 0xDC00 && n <= 0xDFFF = text arr off (len-2)
481+ | n >= 0xDC00 && n <= 0xDFFF = textP arr off (len-2)
536− | otherwise = text arr off (len-1)
482+ | otherwise = textP arr off (len-1)
537 where
483 where
538 n = A.unsafeIndex arr (off+len-1)
484 n = A.unsafeIndex arr (off+len-1)
539{-# INLINE [1] init #-}
485{-# INLINE [1] init #-}
@@ -572,9 +518,7 @@ isSingleton = S.isSingleton . stream
572-- Subject to fusion.
518-- Subject to fusion.
573length :: Text -> Int
519length :: Text -> Int
574length t = S.length (stream t)
520length t = S.length (stream t)
575−{-# INLINE [0] length #-}
521+{-# INLINE length #-}
576−-- length needs to be phased after the compareN/length rules otherwise
577−-- it may inline before the rules have an opportunity to fire.
578
522
579-- | /O(n)/ Compare the count of characters in a 'Text' to a number.
523-- | /O(n)/ Compare the count of characters in a 'Text' to a number.
580-- Subject to fusion.
524-- Subject to fusion.
@@ -593,32 +537,32 @@ compareLength t n = S.compareLengthI (stream t) n
593
537
594{-# RULES
538{-# RULES
595"TEXT ==N/length -> compareLength/==EQ" [~1] forall t n.
539"TEXT ==N/length -> compareLength/==EQ" [~1] forall t n.
596− eqInt (length t) n = compareLength t n == EQ
540+ (==) (length t) n = compareLength t n == EQ
597 #-}
541 #-}
598
542
599{-# RULES
543{-# RULES
600"TEXT /=N/length -> compareLength//=EQ" [~1] forall t n.
544"TEXT /=N/length -> compareLength//=EQ" [~1] forall t n.
601− neInt (length t) n = compareLength t n /= EQ
545+ (/=) (length t) n = compareLength t n /= EQ
602 #-}
546 #-}
603
547
604{-# RULES
548{-# RULES
605"TEXT <N/length -> compareLength/==LT" [~1] forall t n.
549"TEXT <N/length -> compareLength/==LT" [~1] forall t n.
606− ltInt (length t) n = compareLength t n == LT
550+ (<) (length t) n = compareLength t n == LT
607 #-}
551 #-}
608
552
609{-# RULES
553{-# RULES
610"TEXT <=N/length -> compareLength//=GT" [~1] forall t n.
554"TEXT <=N/length -> compareLength//=GT" [~1] forall t n.
611− leInt (length t) n = compareLength t n /= GT
555+ (<=) (length t) n = compareLength t n /= GT
612 #-}
556 #-}
613
557
614{-# RULES
558{-# RULES
615"TEXT >N/length -> compareLength/==GT" [~1] forall t n.
559"TEXT >N/length -> compareLength/==GT" [~1] forall t n.
616− gtInt (length t) n = compareLength t n == GT
560+ (>) (length t) n = compareLength t n == GT
617 #-}
561 #-}
618
562
619{-# RULES
563{-# RULES
620"TEXT >=N/length -> compareLength//=LT" [~1] forall t n.
564"TEXT >=N/length -> compareLength//=LT" [~1] forall t n.
621− geInt (length t) n = compareLength t n /= LT
565+ (>=) (length t) n = compareLength t n /= LT
622 #-}
566 #-}
623
567
624-- -----------------------------------------------------------------------------
568-- -----------------------------------------------------------------------------
@@ -634,7 +578,7 @@ map f t = unstream (S.map (safe . f) (stream t))
634-- 'Text's and concatenates the list after interspersing the first
578-- 'Text's and concatenates the list after interspersing the first
635-- argument between each element of the list.
579-- argument between each element of the list.
636intercalate :: Text -> [Text] -> Text
580intercalate :: Text -> [Text] -> Text
637−intercalate t = concat . (F.intersperse t)
581+intercalate t = concat . (U.intersperse t)
638{-# INLINE intercalate #-}
582{-# INLINE intercalate #-}
639
583
640-- | /O(n)/ The 'intersperse' function takes a character and places it
584-- | /O(n)/ The 'intersperse' function takes a character and places it
@@ -649,59 +593,16 @@ reverse :: Text -> Text
649reverse t = S.reverse (stream t)
593reverse t = S.reverse (stream t)
650{-# INLINE reverse #-}
594{-# INLINE reverse #-}
651
595
652−-- | /O(m+n)/ Replace every non-overlapping occurrence of @needle@ in
596+-- | /O(m+n)/ Replace every occurrence of one substring with another.
653−-- @haystack@ with @replacement@.
654−--
655−-- This function behaves as though it was defined as follows:
656−--
657−-- @
658−-- replace needle replacement haystack =
659−-- 'intercalate' replacement ('splitOn' needle haystack)
660−-- @
661−--
662−-- As this suggests, each occurrence is replaced exactly once. So if
663−-- @needle@ occurs in @replacement@, that occurrence will /not/ itself
664−-- be replaced recursively:
665−--
666−-- > replace "oo" "foo" "oo" == "foo"
667−--
668−-- In cases where several instances of @needle@ overlap, only the
669−-- first one will be replaced:
670−--
671−-- > replace "ofo" "bar" "ofofo" == "barfo"
672--
597--
673-- In (unlikely) bad cases, this function's time complexity degrades
598-- In (unlikely) bad cases, this function's time complexity degrades
674-- towards /O(n*m)/.
599-- towards /O(n*m)/.
675−replace :: Text
600+replace :: Text -- ^ Text to search for
676− -- ^ @needle@ to search for. If this string is empty, an
601+ -> Text -- ^ Replacement text
677− -- error will occur.
678− -> Text
679− -- ^ @replacement@ to replace @needle@ with.
680− -> Text
602+ -> Text -- ^ Input text
681− -- ^ @haystack@ in which to search.
682 -> Text
603 -> Text
683−replace needle@(Text _ _ neeLen)
604+replace s d = intercalate d . splitOn s
684− (Text repArr repOff repLen)
605+{-# INLINE replace #-}
685− haystack@(Text hayArr hayOff hayLen)
686− | neeLen == 0 = emptyError "replace"
687− | L.null ixs = haystack
688− | len > 0 = Text (A.run x) 0 len
689− | otherwise = empty
690− where
691− ixs = indices needle haystack
692− len = hayLen - (neeLen - repLen) `mul` L.length ixs
693− x :: ST s (A.MArray s)
694− x = do
695− marr <- A.new len
696− let loop (i:is) o d = do
697− let d0 = d + i - o
698− d1 = d0 + repLen
699− A.copyI marr d hayArr (hayOff+o) d0
700− A.copyI marr d0 repArr repOff d1
701− loop is (i + neeLen) d1
702− loop [] o d = A.copyI marr d hayArr (hayOff+o) len
703− loop ixs 0 0
704− return marr
705
606
706-- ----------------------------------------------------------------------------
607-- ----------------------------------------------------------------------------
707-- ** Case conversions (folds)
608-- ** Case conversions (folds)
@@ -720,13 +621,13 @@ replace needle@(Text _ _ neeLen)
720-- /Note/: In some languages, case conversion is a locale- and
621-- /Note/: In some languages, case conversion is a locale- and
721-- context-dependent operation. The case conversion functions in this
622-- context-dependent operation. The case conversion functions in this
722-- module are /not/ locale sensitive. Programs that require locale
623-- module are /not/ locale sensitive. Programs that require locale
723−-- sensitivity should use appropriate versions of the
624+-- sensitivity should use appropriate versions of the case mapping
625+-- functions from the @text-icu@ package:
724−-- <http://hackage.haskell.org/package/text-icu-0.6.3.7/docs/Data-Text-ICU.html#g:4 case mapping functions from the text-icu package >.
626+-- <http://hackage.haskell.org/package/text-icu>
725
627
726−-- | /O(n)/ Convert a string to folded case. Subject to fusion.
628+-- | /O(n)/ Convert a string to folded case. This function is mainly
727−--
728−-- This function is mainly useful for performing caseless (also known
629+-- useful for performing caseless (also known as case insensitive)
729−-- as case insensitive) string comparisons.
630+-- string comparisons.
730--
631--
731-- A string @x@ is a caseless match for a string @y@ if and only if:
632-- A string @x@ is a caseless match for a string @y@ if and only if:
732--
633--
@@ -741,51 +642,25 @@ replace needle@(Text _ _ neeLen)
741-- instead of itself.
642-- instead of itself.
742toCaseFold :: Text -> Text
643toCaseFold :: Text -> Text
743toCaseFold t = unstream (S.toCaseFold (stream t))
644toCaseFold t = unstream (S.toCaseFold (stream t))
744−{-# INLINE toCaseFold #-}
645+{-# INLINE [0] toCaseFold #-}
745
646
746-- | /O(n)/ Convert a string to lower case, using simple case
647-- | /O(n)/ Convert a string to lower case, using simple case
747−-- conversion. Subject to fusion.
748−--
749−-- The result string may be longer than the input string. For
648+-- conversion. The result string may be longer than the input string.
750−-- instance, \"&#x130;\" (Latin capital letter I with dot above,
649+-- For instance, \"&#x130;\" (Latin capital letter I with dot above,
751−-- U+0130) maps to the sequence \"i\" (Latin small letter i, U+0069)
650+-- U+0130) maps to the sequence \"i\" (Latin small letter i, U+0069) followed
752−-- followed by \" &#x307;\" (combining dot above, U+0307).
651+-- by \" &#x307;\" (combining dot above, U+0307).
753toLower :: Text -> Text
652toLower :: Text -> Text
754toLower t = unstream (S.toLower (stream t))
653toLower t = unstream (S.toLower (stream t))
755{-# INLINE toLower #-}
654{-# INLINE toLower #-}
756
655
757-- | /O(n)/ Convert a string to upper case, using simple case
656-- | /O(n)/ Convert a string to upper case, using simple case
758−-- conversion. Subject to fusion.
759−--
760−-- The result string may be longer than the input string. For
657+-- conversion. The result string may be longer than the input string.
761−-- instance, the German \"&#xdf;\" (eszett, U+00DF) maps to the
658+-- For instance, the German \"&#xdf;\" (eszett, U+00DF) maps to the
762-- two-letter sequence \"SS\".
659-- two-letter sequence \"SS\".
763toUpper :: Text -> Text
660toUpper :: Text -> Text
764toUpper t = unstream (S.toUpper (stream t))
661toUpper t = unstream (S.toUpper (stream t))
765{-# INLINE toUpper #-}
662{-# INLINE toUpper #-}
766
663
767−-- | /O(n)/ Convert a string to title case, using simple case
768−-- conversion. Subject to fusion.
769−--
770−-- The first letter of the input is converted to title case, as is
771−-- every subsequent letter that immediately follows a non-letter.
772−-- Every letter that immediately follows another letter is converted
773−-- to lower case.
774−--
775−-- The result string may be longer than the input string. For example,
776−-- the Latin small ligature &#xfb02; (U+FB02) is converted to the
777−-- sequence Latin capital letter F (U+0046) followed by Latin small
778−-- letter l (U+006C).
779−--
780−-- /Note/: this function does not take language or culture specific
781−-- rules into account. For instance, in English, different style
782−-- guides disagree on whether the book name \"The Hill of the Red
783−-- Fox\" is correctly title cased&#x2014;but this function will
784−-- capitalize /every/ word.
785−toTitle :: Text -> Text
786−toTitle t = unstream (S.toTitle (stream t))
787−{-# INLINE toTitle #-}
788−
789-- | /O(n)/ Left-justify a string to the given length, using the
664-- | /O(n)/ Left-justify a string to the given length, using the
790-- specified fill character on the right. Subject to fusion.
665-- specified fill character on the right. Subject to fusion.
791-- Performs replacement on invalid scalar values.
666-- Performs replacement on invalid scalar values.
@@ -836,7 +711,7 @@ center k c t
836 | otherwise = replicateChar l c `append` t `append` replicateChar r c
711 | otherwise = replicateChar l c `append` t `append` replicateChar r c
837 where len = length t
712 where len = length t
838 d = k - len
713 d = k - len
839− r = d `quot` 2
714+ r = d `div` 2
840 l = d - r
715 l = d - r
841{-# INLINE center #-}
716{-# INLINE center #-}
842
717
@@ -901,7 +776,6 @@ concat ts = case ts' of
901 where
776 where
902 ts' = L.filter (not . null) ts
777 ts' = L.filter (not . null) ts
903 len = sumP "concat" $ L.map lengthWord16 ts'
778 len = sumP "concat" $ L.map lengthWord16 ts'
904− go :: ST s (A.MArray s)
905 go = do
779 go = do
906 arr <- A.new len
780 arr <- A.new len
907 let step i (Text a o l) =
781 let step i (Text a o l) =
@@ -915,13 +789,13 @@ concatMap f = concat . foldr ((:) . f) []
915{-# INLINE concatMap #-}
789{-# INLINE concatMap #-}
916
790
917-- | /O(n)/ 'any' @p@ @t@ determines whether any character in the
791-- | /O(n)/ 'any' @p@ @t@ determines whether any character in the
918−-- 'Text' @t@ satisfies the predicate @p@. Subject to fusion.
792+-- 'Text' @t@ satisifes the predicate @p@. Subject to fusion.
919any :: (Char -> Bool) -> Text -> Bool
793any :: (Char -> Bool) -> Text -> Bool
920any p t = S.any p (stream t)
794any p t = S.any p (stream t)
921{-# INLINE any #-}
795{-# INLINE any #-}
922
796
923-- | /O(n)/ 'all' @p@ @t@ determines whether all characters in the
797-- | /O(n)/ 'all' @p@ @t@ determines whether all characters in the
924−-- 'Text' @t@ satisfy the predicate @p@. Subject to fusion.
798+-- 'Text' @t@ satisify the predicate @p@. Subject to fusion.
925all :: (Char -> Bool) -> Text -> Bool
799all :: (Char -> Bool) -> Text -> Bool
926all p t = S.all p (stream t)
800all p t = S.all p (stream t)
927{-# INLINE all #-}
801{-# INLINE all #-}
@@ -1009,13 +883,13 @@ mapAccumR f z0 = second reverse . S.mapAccumL g z0 . reverseStream
1009-- @t@ repeated @n@ times.
883-- @t@ repeated @n@ times.
1010replicate :: Int -> Text -> Text
884replicate :: Int -> Text -> Text
1011replicate n t@(Text a o l)
885replicate n t@(Text a o l)
1012− | n <= 0 || l <= 0 = empty
886+ | n <= 0 || l <= 0 = empty
1013− | n == 1 = t
887+ | n == 1 = t
1014− | isSingleton t = replicateChar n (unsafeHead t)
888+ | isSingleton t = replicateChar n (unsafeHead t)
1015− | otherwise = Text (A.run x) 0 len
889+ | n <= maxBound `div` l = Text (A.run x) 0 len
890+ | otherwise = overflowError "replicate"
1016 where
891 where
1017− len = l `mul` n
892+ len = l * n
1018− x :: ST s (A.MArray s)
1019 x = do
893 x = do
1020 arr <- A.new len
894 arr <- A.new len
1021 let loop !d !i | i >= n = return arr
895 let loop !d !i | i >= n = return arr
@@ -1066,16 +940,14 @@ take :: Int -> Text -> Text
1066take n t@(Text arr off len)
940take n t@(Text arr off len)
1067 | n <= 0 = empty
941 | n <= 0 = empty
1068 | n >= len = t
942 | n >= len = t
1069− | otherwise = text arr off (iterN n t)
943+ | otherwise = Text arr off (loop 0 0)
944+ where
945+ loop !i !cnt
946+ | i >= len || cnt >= n = i
947+ | otherwise = loop (i+d) (cnt+1)
948+ where d = iter_ t i
1070{-# INLINE [1] take #-}
949{-# INLINE [1] take #-}
1071
950
1072−iterN :: Int -> Text -> Int
1073−iterN n t@(Text _arr _off len) = loop 0 0
1074− where loop !i !cnt
1075− | i >= len || cnt >= n = i
1076− | otherwise = loop (i+d) (cnt+1)
1077− where d = iter_ t i
1078−
1079{-# RULES
951{-# RULES
1080"TEXT take -> fused" [~1] forall n t.
952"TEXT take -> fused" [~1] forall n t.
1081 take n t = unstream (S.take n (stream t))
953 take n t = unstream (S.take n (stream t))
@@ -1083,27 +955,6 @@ iterN n t@(Text _arr _off len) = loop 0 0
1083 unstream (S.take n (stream t)) = take n t
955 unstream (S.take n (stream t)) = take n t
1084 #-}
956 #-}
1085
957
1086−-- | /O(n)/ 'takeEnd' @n@ @t@ returns the suffix remaining after
1087−-- taking @n@ characters from the end of @t@.
1088−--
1089−-- Examples:
1090−--
1091−-- > takeEnd 3 "foobar" == "bar"
1092−takeEnd :: Int -> Text -> Text
1093−takeEnd n t@(Text arr off len)
1094− | n <= 0 = empty
1095− | n >= len = t
1096− | otherwise = text arr (off+i) (len-i)
1097− where i = iterNEnd n t
1098−
1099−iterNEnd :: Int -> Text -> Int
1100−iterNEnd n t@(Text _arr _off len) = loop (len-1) n
1101− where loop i !m
1102− | i <= 0 = 0
1103− | m <= 1 = i
1104− | otherwise = loop (i+d) (m-1)
1105− where d = reverseIter_ t i
1106−
1107-- | /O(n)/ 'drop' @n@, applied to a 'Text', returns the suffix of the
958-- | /O(n)/ 'drop' @n@, applied to a 'Text', returns the suffix of the
1108-- 'Text' after the first @n@ characters, or the empty 'Text' if @n@
959-- 'Text' after the first @n@ characters, or the empty 'Text' if @n@
1109-- is greater than the length of the 'Text'. Subject to fusion.
960-- is greater than the length of the 'Text'. Subject to fusion.
@@ -1111,8 +962,11 @@ drop :: Int -> Text -> Text
1111drop n t@(Text arr off len)
962drop n t@(Text arr off len)
1112 | n <= 0 = t
963 | n <= 0 = t
1113 | n >= len = empty
964 | n >= len = empty
1114− | otherwise = text arr (off+i) (len-i)
965+ | otherwise = loop 0 0
1115− where i = iterN n t
966+ where loop !i !cnt
967+ | i >= len || cnt >= n = Text arr (off+i) (len-i)
968+ | otherwise = loop (i+d) (cnt+1)
969+ where d = iter_ t i
1116{-# INLINE [1] drop #-}
970{-# INLINE [1] drop #-}
1117
971
1118{-# RULES
972{-# RULES
@@ -1122,18 +976,6 @@ drop n t@(Text arr off len)
1122 unstream (S.drop n (stream t)) = drop n t
976 unstream (S.drop n (stream t)) = drop n t
1123 #-}
977 #-}
1124
978
1125−-- | /O(n)/ 'dropEnd' @n@ @t@ returns the prefix remaining after
1126−-- dropping @n@ characters from the end of @t@.
1127−--
1128−-- Examples:
1129−--
1130−-- > dropEnd 3 "foobar" == "foo"
1131−dropEnd :: Int -> Text -> Text
1132−dropEnd n t@(Text arr off len)
1133− | n <= 0 = t
1134− | n >= len = empty
1135− | otherwise = text arr off (iterNEnd n t)
1136−
1137-- | /O(n)/ 'takeWhile', applied to a predicate @p@ and a 'Text',
979-- | /O(n)/ 'takeWhile', applied to a predicate @p@ and a 'Text',
1138-- returns the longest prefix (possibly empty) of elements that
980-- returns the longest prefix (possibly empty) of elements that
1139-- satisfy @p@. Subject to fusion.
981-- satisfy @p@. Subject to fusion.
@@ -1141,7 +983,7 @@ takeWhile :: (Char -> Bool) -> Text -> Text
1141takeWhile p t@(Text arr off len) = loop 0
983takeWhile p t@(Text arr off len) = loop 0
1142 where loop !i | i >= len = t
984 where loop !i | i >= len = t
1143 | p c = loop (i+d)
985 | p c = loop (i+d)
1144− | otherwise = text arr off i
986+ | otherwise = textP arr off i
1145 where Iter c d = iter t i
987 where Iter c d = iter t i
1146{-# INLINE [1] takeWhile #-}
988{-# INLINE [1] takeWhile #-}
1147
989
@@ -1152,27 +994,6 @@ takeWhile p t@(Text arr off len) = loop 0
1152 unstream (S.takeWhile p (stream t)) = takeWhile p t
994 unstream (S.takeWhile p (stream t)) = takeWhile p t
1153 #-}
995 #-}
1154
996
1155−-- | /O(n)/ 'takeWhileEnd', applied to a predicate @p@ and a 'Text',
1156−-- returns the longest suffix (possibly empty) of elements that
1157−-- satisfy @p@. Subject to fusion.
1158−-- Examples:
1159−--
1160−-- > takeWhileEnd (=='o') "foo" == "oo"
1161−takeWhileEnd :: (Char -> Bool) -> Text -> Text
1162−takeWhileEnd p t@(Text arr off len) = loop (len-1) len
1163− where loop !i !l | l <= 0 = t
1164− | p c = loop (i+d) (l+d)
1165− | otherwise = text arr (off+l) (len-l)
1166− where (c,d) = reverseIter t i
1167−{-# INLINE [1] takeWhileEnd #-}
1168−
1169−{-# RULES
1170−"TEXT takeWhileEnd -> fused" [~1] forall p t.
1171− takeWhileEnd p t = S.reverse (S.takeWhile p (S.reverseStream t))
1172−"TEXT takeWhileEnd -> unfused" [1] forall p t.
1173− S.reverse (S.takeWhile p (S.reverseStream t)) = takeWhileEnd p t
1174− #-}
1175−
1176-- | /O(n)/ 'dropWhile' @p@ @t@ returns the suffix remaining after
997-- | /O(n)/ 'dropWhile' @p@ @t@ returns the suffix remaining after
1177-- 'takeWhile' @p@ @t@. Subject to fusion.
998-- 'takeWhile' @p@ @t@. Subject to fusion.
1178dropWhile :: (Char -> Bool) -> Text -> Text
999dropWhile :: (Char -> Bool) -> Text -> Text
@@ -1191,9 +1012,8 @@ dropWhile p t@(Text arr off len) = loop 0 0
1191 #-}
1012 #-}
1192
1013
1193-- | /O(n)/ 'dropWhileEnd' @p@ @t@ returns the prefix remaining after
1014-- | /O(n)/ 'dropWhileEnd' @p@ @t@ returns the prefix remaining after
1194−-- dropping characters that satisfy the predicate @p@ from the end of
1015+-- dropping characters that fail the predicate @p@ from the end of
1195-- @t@. Subject to fusion.
1016-- @t@. Subject to fusion.
1196−--
1197-- Examples:
1017-- Examples:
1198--
1018--
1199-- > dropWhileEnd (=='.') "foo..." == "foo"
1019-- > dropWhileEnd (=='.') "foo..." == "foo"
@@ -1213,7 +1033,7 @@ dropWhileEnd p t@(Text arr off len) = loop (len-1) len
1213 #-}
1033 #-}
1214
1034
1215-- | /O(n)/ 'dropAround' @p@ @t@ returns the substring remaining after
1035-- | /O(n)/ 'dropAround' @p@ @t@ returns the substring remaining after
1216−-- dropping characters that satisfy the predicate @p@ from both the
1036+-- dropping characters that fail the predicate @p@ from both the
1217-- beginning and end of @t@. Subject to fusion.
1037-- beginning and end of @t@. Subject to fusion.
1218dropAround :: (Char -> Bool) -> Text -> Text
1038dropAround :: (Char -> Bool) -> Text -> Text
1219dropAround p = dropWhile p . dropWhileEnd p
1039dropAround p = dropWhile p . dropWhileEnd p
@@ -1248,16 +1068,24 @@ splitAt :: Int -> Text -> (Text, Text)
1248splitAt n t@(Text arr off len)
1068splitAt n t@(Text arr off len)
1249 | n <= 0 = (empty, t)
1069 | n <= 0 = (empty, t)
1250 | n >= len = (t, empty)
1070 | n >= len = (t, empty)
1251− | otherwise = let k = iterN n t
1071+ | otherwise = (Text arr off k, Text arr (off+k) (len-k))
1252− in (text arr off k, text arr (off+k) (len-k))
1072+ where k = loop 0 0
1073+ loop !i !cnt
1074+ | i >= len || cnt >= n = i
1075+ | otherwise = loop (i+d) (cnt+1)
1076+ where d = iter_ t i
1077+{-# INLINE splitAt #-}
1253
1078
1254-- | /O(n)/ 'span', applied to a predicate @p@ and text @t@, returns
1079-- | /O(n)/ 'span', applied to a predicate @p@ and text @t@, returns
1255-- a pair whose first element is the longest prefix (possibly empty)
1080-- a pair whose first element is the longest prefix (possibly empty)
1256-- of @t@ of elements that satisfy @p@, and whose second is the
1081-- of @t@ of elements that satisfy @p@, and whose second is the
1257-- remainder of the list.
1082-- remainder of the list.
1258span :: (Char -> Bool) -> Text -> (Text, Text)
1083span :: (Char -> Bool) -> Text -> (Text, Text)
1259−span p t = case span_ p t of
1084+span p t@(Text arr off len) = (textP arr off k, textP arr (off+k) (len-k))
1260− (# hd,tl #) -> (hd,tl)
1085+ where k = loop 0
1086+ loop !i | i >= len || not (p c) = i
1087+ | otherwise = loop (i+d)
1088+ where Iter c d = iter t i
1261{-# INLINE span #-}
1089{-# INLINE span #-}
1262
1090
1263-- | /O(n)/ 'break' is like 'span', but the prefix returned is
1091-- | /O(n)/ 'break' is like 'span', but the prefix returned is
@@ -1284,7 +1112,7 @@ findAIndexOrEnd q t@(Text _arr _off len) = go 0
1284 where go !i | i >= len || q c = i
1112 where go !i | i >= len || q c = i
1285 | otherwise = go (i+d)
1113 | otherwise = go (i+d)
1286 where Iter c d = iter t i
1114 where Iter c d = iter t i
1287−
1115+
1288-- | /O(n)/ Group characters in a string by equality.
1116-- | /O(n)/ Group characters in a string by equality.
1289group :: Text -> [Text]
1117group :: Text -> [Text]
1290group = groupBy (==)
1118group = groupBy (==)
@@ -1308,38 +1136,31 @@ tails t | null t = [empty]
1308-- copies to create substrings; they just construct new 'Text's that
1136-- copies to create substrings; they just construct new 'Text's that
1309-- are slices of the original.
1137-- are slices of the original.
1310
1138
1311−-- | /O(m+n)/ Break a 'Text' into pieces separated by the first 'Text'
1139+-- | /O(m+n)/ Break a 'Text' into pieces separated by the first
1312−-- argument (which cannot be empty), consuming the delimiter. An empty
1140+-- 'Text' argument, consuming the delimiter. An empty delimiter is
1313−-- delimiter is invalid, and will cause an error to be raised.
1141+-- invalid, and will cause an error to be raised.
1314--
1142--
1315-- Examples:
1143-- Examples:
1316--
1144--
1317-- > splitOn "\r\n" "a\r\nb\r\nd\r\ne" == ["a","b","d","e"]
1145-- > splitOn "\r\n" "a\r\nb\r\nd\r\ne" == ["a","b","d","e"]
1318-- > splitOn "aaa" "aaaXaaaXaaaXaaa" == ["","X","X","X",""]
1146-- > splitOn "aaa" "aaaXaaaXaaaXaaa" == ["","X","X","X",""]
1319-- > splitOn "x" "x" == ["",""]
1147-- > splitOn "x" "x" == ["",""]
1320−--
1148+--
1321-- and
1149-- and
1322--
1150--
1323-- > intercalate s . splitOn s == id
1151-- > intercalate s . splitOn s == id
1324-- > splitOn (singleton c) == split (==c)
1152-- > splitOn (singleton c) == split (==c)
1325--
1153--
1326−-- (Note: the string @s@ to split on above cannot be empty.)
1327−--
1328-- In (unlikely) bad cases, this function's time complexity degrades
1154-- In (unlikely) bad cases, this function's time complexity degrades
1329-- towards /O(n*m)/.
1155-- towards /O(n*m)/.
1330−splitOn :: Text
1156+splitOn :: Text -> Text -> [Text]
1331− -- ^ String to split on. If this string is empty, an error
1332− -- will occur.
1333− -> Text
1334− -- ^ Input text.
1335− -> [Text]
1336splitOn pat@(Text _ _ l) src@(Text arr off len)
1157splitOn pat@(Text _ _ l) src@(Text arr off len)
1337 | l <= 0 = emptyError "splitOn"
1158 | l <= 0 = emptyError "splitOn"
1338 | isSingleton pat = split (== unsafeHead pat) src
1159 | isSingleton pat = split (== unsafeHead pat) src
1339 | otherwise = go 0 (indices pat src)
1160 | otherwise = go 0 (indices pat src)
1340 where
1161 where
1341− go !s (x:xs) = text arr (s+off) (x-s) : go (x+l) xs
1162+ go !s (x:xs) = textP arr (s+off) (x-s) : go (x+l) xs
1342− go s _ = [text arr (s+off) (len-s)]
1163+ go s _ = [textP arr (s+off) (len-s)]
1343{-# INLINE [1] splitOn #-}
1164{-# INLINE [1] splitOn #-}
1344
1165
1345{-# RULES
1166{-# RULES
@@ -1359,7 +1180,7 @@ split _ t@(Text _off _arr 0) = [t]
1359split p t = loop t
1180split p t = loop t
1360 where loop s | null s' = [l]
1181 where loop s | null s' = [l]
1361 | otherwise = l : loop (unsafeTail s')
1182 | otherwise = l : loop (unsafeTail s')
1362− where (# l, s' #) = span_ (not . p) s
1183+ where (l, s') = break p s
1363{-# INLINE split #-}
1184{-# INLINE split #-}
1364
1185
1365-- | /O(n)/ Splits a 'Text' into components of length @k@. The last
1186-- | /O(n)/ Splits a 'Text' into components of length @k@. The last
@@ -1431,7 +1252,7 @@ breakOn pat src@(Text arr off len)
1431 | null pat = emptyError "breakOn"
1252 | null pat = emptyError "breakOn"
1432 | otherwise = case indices pat src of
1253 | otherwise = case indices pat src of
1433 [] -> (src, empty)
1254 [] -> (src, empty)
1434− (x:_) -> (text arr off x, text arr (off+x) (len-x))
1255+ (x:_) -> (textP arr off x, textP arr (off+x) (len-x))
1435{-# INLINE breakOn #-}
1256{-# INLINE breakOn #-}
1436
1257
1437-- | /O(n+m)/ Similar to 'breakOn', but searches from the end of the
1258-- | /O(n+m)/ Similar to 'breakOn', but searches from the end of the
@@ -1456,9 +1277,9 @@ breakOnEnd pat src = (reverse b, reverse a)
1456--
1277--
1457-- Examples:
1278-- Examples:
1458--
1279--
1459−-- > breakOnAll "::" ""
1280+-- > find "::" ""
1460-- > ==> []
1281-- > ==> []
1461−-- > breakOnAll "/" "a/b/c/"
1282+-- > find "/" "a/b/c/"
1462-- > ==> [("a", "/b/c/"), ("a/b", "/c/"), ("a/b/c", "/")]
1283-- > ==> [("a", "/b/c/"), ("a/b", "/c/"), ("a/b/c", "/")]
1463--
1284--
1464-- In (unlikely) bad cases, this function's time complexity degrades
1285-- In (unlikely) bad cases, this function's time complexity degrades
@@ -1473,7 +1294,7 @@ breakOnAll pat src@(Text arr off slen)
1473 | otherwise = L.map step (indices pat src)
1294 | otherwise = L.map step (indices pat src)
1474 where
1295 where
1475 step x = (chunk 0 x, chunk x (slen-x))
1296 step x = (chunk 0 x, chunk x (slen-x))
1476− chunk !n !l = text arr (n+off) l
1297+ chunk !n !l = textP arr (n+off) l
1477{-# INLINE breakOnAll #-}
1298{-# INLINE breakOnAll #-}
1478
1299
1479-------------------------------------------------------------------------------
1300-------------------------------------------------------------------------------
@@ -1493,7 +1314,7 @@ breakOnAll pat src@(Text arr off slen)
1493-- For example, suppose you have a string that you want to split on
1314-- For example, suppose you have a string that you want to split on
1494-- the substring @\"::\"@, such as @\"foo::bar::quux\"@. Instead of
1315-- the substring @\"::\"@, such as @\"foo::bar::quux\"@. Instead of
1495-- searching for the index of @\"::\"@ and taking the substrings
1316-- searching for the index of @\"::\"@ and taking the substrings
1496−-- before and after that index, you would instead use @breakOnAll \"::\"@.
1317+-- before and after that index, you would instead use @find \"::\"@.
1497
1318
1498-- | /O(n)/ 'Text' index (subscript) operator, starting from 0.
1319-- | /O(n)/ 'Text' index (subscript) operator, starting from 0.
1499index :: Text -> Int -> Char
1320index :: Text -> Int -> Char
@@ -1540,7 +1361,7 @@ countChar c t = S.countChar c (stream t)
1540-- equivalent to a pair of 'unpack' operations.
1361-- equivalent to a pair of 'unpack' operations.
1541zip :: Text -> Text -> [(Char,Char)]
1362zip :: Text -> Text -> [(Char,Char)]
1542zip a b = S.unstreamList $ S.zipWith (,) (stream a) (stream b)
1363zip a b = S.unstreamList $ S.zipWith (,) (stream a) (stream b)
1543−{-# INLINE zip #-}
1364+{-# INLINE [0] zip #-}
1544
1365
1545-- | /O(n)/ 'zipWith' generalises 'zip' by zipping with the function
1366-- | /O(n)/ 'zipWith' generalises 'zip' by zipping with the function
1546-- given as the first argument, instead of a tupling function.
1367-- given as the first argument, instead of a tupling function.
@@ -1548,7 +1369,7 @@ zip a b = S.unstreamList $ S.zipWith (,) (stream a) (stream b)
1548zipWith :: (Char -> Char -> Char) -> Text -> Text -> Text
1369zipWith :: (Char -> Char -> Char) -> Text -> Text -> Text
1549zipWith f t1 t2 = unstream (S.zipWith g (stream t1) (stream t2))
1370zipWith f t1 t2 = unstream (S.zipWith g (stream t1) (stream t2))
1550 where g a b = safe (f a b)
1371 where g a b = safe (f a b)
1551−{-# INLINE zipWith #-}
1372+{-# INLINE [0] zipWith #-}
1552
1373
1553-- | /O(n)/ Breaks a 'Text' up into a list of words, delimited by 'Char's
1374-- | /O(n)/ Breaks a 'Text' up into a list of words, delimited by 'Char's
1554-- representing white space.
1375-- representing white space.
@@ -1574,7 +1395,7 @@ lines ps | null ps = []
1574 | otherwise = h : if null t
1395 | otherwise = h : if null t
1575 then []
1396 then []
1576 else lines (unsafeTail t)
1397 else lines (unsafeTail t)
1577− where (# h,t #) = span_ (/= '\n') ps
1398+ where (h,t) = span (/= '\n') ps
1578{-# INLINE lines #-}
1399{-# INLINE lines #-}
1579
1400
1580{-
1401{-
@@ -1620,6 +1441,8 @@ isPrefixOf a@(Text _ _ alen) b@(Text _ _ blen) =
1620{-# RULES
1441{-# RULES
1621"TEXT isPrefixOf -> fused" [~1] forall s t.
1442"TEXT isPrefixOf -> fused" [~1] forall s t.
1622 isPrefixOf s t = S.isPrefixOf (stream s) (stream t)
1443 isPrefixOf s t = S.isPrefixOf (stream s) (stream t)
1444+"TEXT isPrefixOf -> unfused" [1] forall s t.
1445+ S.isPrefixOf (stream s) (stream t) = isPrefixOf s t
1623 #-}
1446 #-}
1624
1447
1625-- | /O(n)/ The 'isSuffixOf' function takes two 'Text's and returns
1448-- | /O(n)/ The 'isSuffixOf' function takes two 'Text's and returns
@@ -1673,7 +1496,7 @@ isInfixOf needle haystack
1673-- > fnordLength _ = -1
1496-- > fnordLength _ = -1
1674stripPrefix :: Text -> Text -> Maybe Text
1497stripPrefix :: Text -> Text -> Maybe Text
1675stripPrefix p@(Text _arr _off plen) t@(Text arr off len)
1498stripPrefix p@(Text _arr _off plen) t@(Text arr off len)
1676− | p `isPrefixOf` t = Just $! text arr (off+plen) (len-plen)
1499+ | p `isPrefixOf` t = Just $! textP arr (off+plen) (len-plen)
1677 | otherwise = Nothing
1500 | otherwise = Nothing
1678
1501
1679-- | /O(n)/ Find the longest non-empty common prefix of two strings
1502-- | /O(n)/ Find the longest non-empty common prefix of two strings
@@ -1693,8 +1516,8 @@ commonPrefixes t0@(Text arr0 off0 len0) t1@(Text arr1 off1 len1) = go 0 0
1693 where
1516 where
1694 go !i !j | i < len0 && j < len1 && a == b = go (i+d0) (j+d1)
1517 go !i !j | i < len0 && j < len1 && a == b = go (i+d0) (j+d1)
1695 | i > 0 = Just (Text arr0 off0 i,
1518 | i > 0 = Just (Text arr0 off0 i,
1696− text arr0 (off0+i) (len0-i),
1519+ textP arr0 (off0+i) (len0-i),
1697− text arr1 (off1+j) (len1-j))
1520+ textP arr1 (off1+j) (len1-j))
1698 | otherwise = Nothing
1521 | otherwise = Nothing
1699 where Iter a d0 = iter t0 i
1522 where Iter a d0 = iter t0 i
1700 Iter b d1 = iter t1 j
1523 Iter b d1 = iter t1 j
@@ -1719,7 +1542,7 @@ commonPrefixes t0@(Text arr0 off0 len0) t1@(Text arr1 off1 len1) = go 0 0
1719-- > quuxLength _ = -1
1542-- > quuxLength _ = -1
1720stripSuffix :: Text -> Text -> Maybe Text
1543stripSuffix :: Text -> Text -> Maybe Text
1721stripSuffix p@(Text _arr _off plen) t@(Text arr off len)
1544stripSuffix p@(Text _arr _off plen) t@(Text arr off len)
1722− | p `isSuffixOf` t = Just $! text arr off (len-plen)
1545+ | p `isSuffixOf` t = Just $! textP arr off (len-plen)
1723 | otherwise = Nothing
1546 | otherwise = Nothing
1724
1547
1725-- | Add a list of non-negative numbers. Errors out on overflow.
1548-- | Add a list of non-negative numbers. Errors out on overflow.
@@ -1736,20 +1559,3 @@ emptyError fun = P.error $ "Data.Text." ++ fun ++ ": empty input"
1736
1559
1737overflowError :: String -> a
1560overflowError :: String -> a
1738overflowError fun = P.error $ "Data.Text." ++ fun ++ ": size overflow"
1561overflowError fun = P.error $ "Data.Text." ++ fun ++ ": size overflow"
1739−
1740−-- | /O(n)/ Make a distinct copy of the given string, sharing no
1741−-- storage with the original string.
1742−--
1743−-- As an example, suppose you read a large string, of which you need
1744−-- only a small portion. If you do not use 'copy', the entire original
1745−-- array will be kept alive in memory by the smaller string. Making a
1746−-- copy \"breaks the link\" to the original array, allowing it to be
1747−-- garbage collected if there are no other live references to it.
1748−copy :: Text -> Text
1749−copy (Text arr off len) = Text (A.run go) 0 len
1750− where
1751− go :: ST s (A.MArray s)
1752− go = do
1753− marr <- A.new len
1754− A.copyI marr 0 arr off len
1755− return marr
Data/Text/Array.hs+11−23
@@ -6,7 +6,8 @@
6-- Copyright : (c) 2009, 2010, 2011 Bryan O'Sullivan
6-- Copyright : (c) 2009, 2010, 2011 Bryan O'Sullivan
7--
7--
8-- License : BSD-style
8-- License : BSD-style
9−-- Maintainer : bos@serpentine.com
9+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
10+-- duncan@haskell.org
10-- Stability : experimental
11-- Stability : experimental
11-- Portability : portable
12-- Portability : portable
12--
13--
@@ -20,13 +21,13 @@
20-- > import qualified Data.Text.Array as A
21-- > import qualified Data.Text.Array as A
21--
22--
22-- The names in this module resemble those in the 'Data.Array' family
23-- The names in this module resemble those in the 'Data.Array' family
23−-- of modules, but are shorter due to the assumption of qualified
24+-- of modules, but are shorter due to the assumption of qualifid
24-- naming.
25-- naming.
25module Data.Text.Array
26module Data.Text.Array
26 (
27 (
27 -- * Types
28 -- * Types
28− Array(Array, aBA)
29+ Array(aBA)
29− , MArray(MArray, maBA)
30+ , MArray(maBA)
30
31
31 -- * Functions
32 -- * Functions
32 , copyM
33 , copyM
@@ -59,22 +60,14 @@ if (_k_) < 0 || (_k_) >= (_len_) then error ("Data.Text.Array." ++ (_func_) ++ "
59#if defined(ASSERTS)
60#if defined(ASSERTS)
60import Control.Exception (assert)
61import Control.Exception (assert)
61#endif
62#endif
62−#if __GLASGOW_HASKELL__ >= 702
63−import Control.Monad.ST.Unsafe (unsafeIOToST)
64−#else
65import Control.Monad.ST (unsafeIOToST)
63import Control.Monad.ST (unsafeIOToST)
66−#endif
67import Data.Bits ((.&.), xor)
64import Data.Bits ((.&.), xor)
68−import Data.Text.Internal.Unsafe (inlinePerformIO)
65+import Data.Text.Unsafe.Base (inlinePerformIO)
69−import Data.Text.Internal.Unsafe.Shift (shiftL, shiftR)
66+import Data.Text.UnsafeShift (shiftL, shiftR)
70−#if __GLASGOW_HASKELL__ >= 703
71−import Foreign.C.Types (CInt(CInt), CSize(CSize))
72−#else
73import Foreign.C.Types (CInt, CSize)
67import Foreign.C.Types (CInt, CSize)
74−#endif
75import GHC.Base (ByteArray#, MutableByteArray#, Int(..),
68import GHC.Base (ByteArray#, MutableByteArray#, Int(..),
76 indexWord16Array#, newByteArray#,
69 indexWord16Array#, newByteArray#,
77− unsafeFreezeByteArray#, writeWord16Array#)
70+ unsafeCoerce#, writeWord16Array#)
78import GHC.ST (ST(..), runST)
71import GHC.ST (ST(..), runST)
79import GHC.Word (Word16(..))
72import GHC.Word (Word16(..))
80import Prelude hiding (length, read)
73import Prelude hiding (length, read)
@@ -113,7 +106,7 @@ instance IArray (MArray s) where
113-- | Create an uninitialized mutable array.
106-- | Create an uninitialized mutable array.
114new :: forall s. Int -> ST s (MArray s)
107new :: forall s. Int -> ST s (MArray s)
115new n
108new n
116− | n < 0 || n .&. highBit /= 0 = array_size_error
109+ | n < 0 || n .&. highBit /= 0 = error $ "Data.Text.Array.new: size overflow"
117 | otherwise = ST $ \s1# ->
110 | otherwise = ST $ \s1# ->
118 case newByteArray# len# s1# of
111 case newByteArray# len# s1# of
119 (# s2#, marr# #) -> (# s2#, MArray marr#
112 (# s2#, marr# #) -> (# s2#, MArray marr#
@@ -125,14 +118,10 @@ new n
125 highBit = maxBound `xor` (maxBound `shiftR` 1)
118 highBit = maxBound `xor` (maxBound `shiftR` 1)
126{-# INLINE new #-}
119{-# INLINE new #-}
127
120
128−array_size_error :: a
129−array_size_error = error "Data.Text.Array.new: size overflow"
130−
131-- | Freeze a mutable array. Do not mutate the 'MArray' afterwards!
121-- | Freeze a mutable array. Do not mutate the 'MArray' afterwards!
132unsafeFreeze :: MArray s -> ST s Array
122unsafeFreeze :: MArray s -> ST s Array
133−unsafeFreeze MArray{..} = ST $ \s1# ->
123+unsafeFreeze MArray{..} = ST $ \s# ->
134− case unsafeFreezeByteArray# maBA s1# of
124+ (# s#, Array (unsafeCoerce# maBA)
135− (# s2#, ba# #) -> (# s2#, Array ba#
136#if defined(ASSERTS)
125#if defined(ASSERTS)
137 maLen
126 maLen
138#endif
127#endif
@@ -184,7 +173,6 @@ run2 k = runST (do
184 (marr,b) <- k
173 (marr,b) <- k
185 arr <- unsafeFreeze marr
174 arr <- unsafeFreeze marr
186 return (arr,b))
175 return (arr,b))
187−{-# INLINE run2 #-}
188
176
189-- | Copy some elements of a mutable array.
177-- | Copy some elements of a mutable array.
190copyM :: MArray s -- ^ Destination
178copyM :: MArray s -- ^ Destination
Data/Text/Encoding.hs+94−313
@@ -1,16 +1,13 @@
1−{-# LANGUAGE BangPatterns, CPP, ForeignFunctionInterface, GeneralizedNewtypeDeriving, MagicHash,
1+{-# LANGUAGE BangPatterns #-}
2− UnliftedFFITypes #-}
3−#if __GLASGOW_HASKELL__ >= 702
4−{-# LANGUAGE Trustworthy #-}
5−#endif
6-- |
2-- |
7-- Module : Data.Text.Encoding
3-- Module : Data.Text.Encoding
4+-- Copyright : (c) 2008, 2009 Tom Harper,
8−-- Copyright : (c) 2009, 2010, 2011 Bryan O'Sullivan,
5+-- (c) 2009, 2010 Bryan O'Sullivan,
9−-- (c) 2009 Duncan Coutts,
6+-- (c) 2009 Duncan Coutts
10−-- (c) 2008, 2009 Tom Harper
11--
7--
12-- License : BSD-style
8-- License : BSD-style
13−-- Maintainer : bos@serpentine.com
9+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
10+-- duncan@haskell.org
14-- Stability : experimental
11-- Stability : experimental
15-- Portability : portable
12-- Portability : portable
16--
13--
@@ -25,7 +22,6 @@ module Data.Text.Encoding
25 -- * Decoding ByteStrings to Text
22 -- * Decoding ByteStrings to Text
26 -- $strict
23 -- $strict
27 decodeASCII
24 decodeASCII
28− , decodeLatin1
29 , decodeUtf8
25 , decodeUtf8
30 , decodeUtf16LE
26 , decodeUtf16LE
31 , decodeUtf16BE
27 , decodeUtf16BE
@@ -42,59 +38,33 @@ module Data.Text.Encoding
42 , decodeUtf32LEWith
38 , decodeUtf32LEWith
43 , decodeUtf32BEWith
39 , decodeUtf32BEWith
44
40
45− -- ** Stream oriented decoding
46− -- $stream
47− , streamDecodeUtf8
48− , streamDecodeUtf8With
49− , Decoding(..)
50−
51 -- * Encoding Text to ByteStrings
41 -- * Encoding Text to ByteStrings
52 , encodeUtf8
42 , encodeUtf8
53 , encodeUtf16LE
43 , encodeUtf16LE
54 , encodeUtf16BE
44 , encodeUtf16BE
55 , encodeUtf32LE
45 , encodeUtf32LE
56 , encodeUtf32BE
46 , encodeUtf32BE
57−
58− -- * Encoding Text using ByteString Builders
59− , encodeUtf8Builder
60− , encodeUtf8BuilderEscaped
61 ) where
47 ) where
62
48
63−#if __GLASGOW_HASKELL__ >= 702
64−import Control.Monad.ST.Unsafe (unsafeIOToST, unsafeSTToIO)
65−#else
66−import Control.Monad.ST (unsafeIOToST, unsafeSTToIO)
67−#endif
68−
69import Control.Exception (evaluate, try)
49import Control.Exception (evaluate, try)
70−import Control.Monad.ST (runST)
71import Data.Bits ((.&.))
50import Data.Bits ((.&.))
72import Data.ByteString as B
51import Data.ByteString as B
73−import Data.ByteString.Internal as B hiding (c2w)
52+import Data.ByteString.Internal as B
53+import Data.ByteString.Unsafe as B
74import Data.Text.Encoding.Error (OnDecodeError, UnicodeException, strictDecode)
54import Data.Text.Encoding.Error (OnDecodeError, UnicodeException, strictDecode)
75−import Data.Text.Internal (Text(..), safe, text)
55+import Data.Text.Internal (Text(..), textP)
76−import Data.Text.Internal.Private (runText)
77−import Data.Text.Internal.Unsafe.Char (ord, unsafeWrite)
56+import Data.Text.UnsafeChar (ord, unsafeWrite)
78−import Data.Text.Internal.Unsafe.Shift (shiftR)
57+import Data.Text.UnsafeShift (shiftL, shiftR)
79−import Data.Text.Show ()
58+import Data.Word (Word8)
80−import Data.Text.Unsafe (unsafeDupablePerformIO)
81−import Data.Word (Word8, Word32)
82−import Foreign.C.Types (CSize(..))
83import Foreign.ForeignPtr (withForeignPtr)
59import Foreign.ForeignPtr (withForeignPtr)
84−import Foreign.Marshal.Utils (with)
60+import Foreign.Ptr (plusPtr)
85−import Foreign.Ptr (Ptr, minusPtr, nullPtr, plusPtr)
86−import Foreign.Storable (Storable, peek, poke)
61+import Foreign.Storable (poke)
87−import GHC.Base (ByteArray#, MutableByteArray#)
62+import System.IO.Unsafe (unsafePerformIO)
88−import qualified Data.ByteString.Builder as B
89−import qualified Data.ByteString.Builder.Internal as B hiding (empty, append)
90−import qualified Data.ByteString.Builder.Prim as BP
91−import qualified Data.ByteString.Builder.Prim.Internal as BP
92import qualified Data.Text.Array as A
63import qualified Data.Text.Array as A
93−import qualified Data.Text.Internal.Encoding.Fusion as E
64+import qualified Data.Text.Encoding.Fusion as E
94−import qualified Data.Text.Internal.Encoding.Utf16 as U16
65+import qualified Data.Text.Encoding.Utf16 as U16
95−import qualified Data.Text.Internal.Fusion as F
66+import qualified Data.Text.Encoding.Utf8 as U8
96−
67+import qualified Data.Text.Fusion as F
97−#include "text_cbits.h"
98
68
99-- $strict
69-- $strict
100--
70--
@@ -109,182 +79,46 @@ import qualified Data.Text.Internal.Fusion as F
109-- 'decodeUtf8With' allows the programmer to determine what to do on a
79-- 'decodeUtf8With' allows the programmer to determine what to do on a
110-- decoding error.
80-- decoding error.
111
81
112−-- | /Deprecated/. Decode a 'ByteString' containing 7-bit ASCII
82+-- | Decode a 'ByteString' containing 7-bit ASCII encoded text.
113−-- encoded text.
114decodeASCII :: ByteString -> Text
83decodeASCII :: ByteString -> Text
115−decodeASCII = decodeUtf8
84+decodeASCII bs = F.unstream (E.streamASCII bs)
116−{-# DEPRECATED decodeASCII "Use decodeUtf8 instead" #-}
85+{-# INLINE decodeASCII #-}
117−
118−-- | Decode a 'ByteString' containing Latin-1 (aka ISO-8859-1) encoded text.
119−--
120−-- 'decodeLatin1' is semantically equivalent to
121−-- @Data.Text.pack . Data.ByteString.Char8.unpack@
122−decodeLatin1 :: ByteString -> Text
123−decodeLatin1 (PS fp off len) = text a 0 len
124− where
125− a = A.run (A.new len >>= unsafeIOToST . go)
126− go dest = withForeignPtr fp $ \ptr -> do
127− c_decode_latin1 (A.maBA dest) (ptr `plusPtr` off) (ptr `plusPtr` (off+len))
128− return dest
129
86
130-- | Decode a 'ByteString' containing UTF-8 encoded text.
87-- | Decode a 'ByteString' containing UTF-8 encoded text.
131decodeUtf8With :: OnDecodeError -> ByteString -> Text
88decodeUtf8With :: OnDecodeError -> ByteString -> Text
132−decodeUtf8With onErr (PS fp off len) = runText $ \done -> do
89+decodeUtf8With onErr bs = textP (fst a) 0 (snd a)
133− let go dest = withForeignPtr fp $ \ptr ->
134− with (0::CSize) $ \destOffPtr -> do
135− let end = ptr `plusPtr` (off + len)
136− loop curPtr = do
137− curPtr' <- c_decode_utf8 (A.maBA dest) destOffPtr curPtr end
138− if curPtr' == end
139− then do
140− n <- peek destOffPtr
141− unsafeSTToIO (done dest (fromIntegral n))
142− else do
143− x <- peek curPtr'
144− case onErr desc (Just x) of
145− Nothing -> loop $ curPtr' `plusPtr` 1
146− Just c -> do
147− destOff <- peek destOffPtr
148− w <- unsafeSTToIO $
149− unsafeWrite dest (fromIntegral destOff) (safe c)
150− poke destOffPtr (destOff + fromIntegral w)
151− loop $ curPtr' `plusPtr` 1
152− loop (ptr `plusPtr` off)
153− (unsafeIOToST . go) =<< A.new len
154− where
155− desc = "Data.Text.Internal.Encoding.decodeUtf8: Invalid UTF-8 stream"
156−{- INLINE[0] decodeUtf8With #-}
157−
158−-- $stream
159−--
160−-- The 'streamDecodeUtf8' and 'streamDecodeUtf8With' functions accept
161−-- a 'ByteString' that represents a possibly incomplete input (e.g. a
162−-- packet from a network stream) that may not end on a UTF-8 boundary.
163−--
164−-- 1. The maximal prefix of 'Text' that could be decoded from the
165−-- given input.
166−--
167−-- 2. The suffix of the 'ByteString' that could not be decoded due to
168−-- insufficient input.
169−--
170−-- 3. A function that accepts another 'ByteString'. That string will
171−-- be assumed to directly follow the string that was passed as
172−-- input to the original function, and it will in turn be decoded.
173−--
174−-- To help understand the use of these functions, consider the Unicode
175−-- string @\"hi &#9731;\"@. If encoded as UTF-8, this becomes @\"hi
176−-- \\xe2\\x98\\x83\"@; the final @\'&#9731;\'@ is encoded as 3 bytes.
177−--
178−-- Now suppose that we receive this encoded string as 3 packets that
179−-- are split up on untidy boundaries: @[\"hi \\xe2\", \"\\x98\",
180−-- \"\\x83\"]@. We cannot decode the entire Unicode string until we
181−-- have received all three packets, but we would like to make progress
182−-- as we receive each one.
183−--
184−-- @
185−-- ghci> let s0\@('Some' _ _ f0) = 'streamDecodeUtf8' \"hi \\xe2\"
186−-- ghci> s0
187−-- 'Some' \"hi \" \"\\xe2\" _
188−-- @
189−--
190−-- We use the continuation @f0@ to decode our second packet.
191−--
192−-- @
193−-- ghci> let s1\@('Some' _ _ f1) = f0 \"\\x98\"
194−-- ghci> s1
195−-- 'Some' \"\" \"\\xe2\\x98\"
196−-- @
197−--
198−-- We could not give @f0@ enough input to decode anything, so it
199−-- returned an empty string. Once we feed our second continuation @f1@
200−-- the last byte of input, it will make progress.
201−--
202−-- @
203−-- ghci> let s2\@('Some' _ _ f2) = f1 \"\\x83\"
204−-- ghci> s2
205−-- 'Some' \"\\x2603\" \"\" _
206−-- @
207−--
208−-- If given invalid input, an exception will be thrown by the function
209−-- or continuation where it is encountered.
210−
211−-- | A stream oriented decoding result.
212−data Decoding = Some Text ByteString (ByteString -> Decoding)
213−
214−instance Show Decoding where
215− showsPrec d (Some t bs _) = showParen (d > prec) $
216− showString "Some " . showsPrec prec' t .
217− showChar ' ' . showsPrec prec' bs .
218− showString " _"
219− where prec = 10; prec' = prec + 1
220−
221−newtype CodePoint = CodePoint Word32 deriving (Eq, Show, Num, Storable)
222−newtype DecoderState = DecoderState Word32 deriving (Eq, Show, Num, Storable)
223−
224−-- | Decode, in a stream oriented way, a 'ByteString' containing UTF-8
225−-- encoded text that is known to be valid.
226−--
227−-- If the input contains any invalid UTF-8 data, an exception will be
228−-- thrown (either by this function or a continuation) that cannot be
229−-- caught in pure code. For more control over the handling of invalid
230−-- data, use 'streamDecodeUtf8With'.
231−streamDecodeUtf8 :: ByteString -> Decoding
232−streamDecodeUtf8 = streamDecodeUtf8With strictDecode
233−
234−-- | Decode, in a stream oriented way, a 'ByteString' containing UTF-8
235−-- encoded text.
236−streamDecodeUtf8With :: OnDecodeError -> ByteString -> Decoding
237−streamDecodeUtf8With onErr = decodeChunk B.empty 0 0
238 where
90 where
239− -- We create a slightly larger than necessary buffer to accommodate a
91+ a = A.run2 (A.new len >>= outer 0 0)
240− -- potential surrogate pair started in the last buffer
92+ len = B.length bs
241− decodeChunk :: ByteString -> CodePoint -> DecoderState -> ByteString
93+ outer n0 m0 arr = go n0 m0
242− -> Decoding
243− decodeChunk undecoded0 codepoint0 state0 bs@(PS fp off len) =
244− runST $ (unsafeIOToST . decodeChunkToBuffer) =<< A.new (len+1)
245 where
94 where
246− decodeChunkToBuffer :: A.MArray s -> IO Decoding
95+ go !n !m = do
247− decodeChunkToBuffer dest = withForeignPtr fp $ \ptr ->
96+ let x1 = idx m
248− with (0::CSize) $ \destOffPtr ->
97+ x2 = idx (m + 1)
249− with codepoint0 $ \codepointPtr ->
98+ x3 = idx (m + 2)
250− with state0 $ \statePtr ->
99+ x4 = idx (m + 3)
251− with nullPtr $ \curPtrPtr ->
100+ idx = B.unsafeIndex bs
252− let end = ptr `plusPtr` (off + len)
101+ case undefined of
253− loop curPtr = do
102+ _| m >= len -> return (arr,n)
254− poke curPtrPtr curPtr
103+ | U8.validate1 x1 -> do
255− curPtr' <- c_decode_utf8_with_state (A.maBA dest) destOffPtr
104+ A.unsafeWrite arr n (fromIntegral x1)
256− curPtrPtr end codepointPtr statePtr
105+ go (n+1) (m+1)
257− state <- peek statePtr
106+ | m+1 < len && U8.validate2 x1 x2 -> do
258− case state of
107+ w <- unsafeWrite arr n (U8.chr2 x1 x2)
259− UTF8_REJECT -> do
108+ go (n+w) (m+2)
260− -- We encountered an encoding error
109+ | m+2 < len && U8.validate3 x1 x2 x3 -> do
261− x <- peek curPtr'
110+ w <- unsafeWrite arr n (U8.chr3 x1 x2 x3)
262− poke statePtr 0
111+ go (n+w) (m+3)
112+ | m+3 < len && U8.validate4 x1 x2 x3 x4 -> do
113+ w <- unsafeWrite arr n (U8.chr4 x1 x2 x3 x4)
114+ go (n+w) (m+4)
263− case onErr desc (Just x) of
115+ | otherwise -> case onErr desc (Just x1) of
264− Nothing -> loop $ curPtr' `plusPtr` 1
116+ Nothing -> go n (m+1)
265− Just c -> do
117+ Just c -> do
266− destOff <- peek destOffPtr
267− w <- unsafeSTToIO $
268− unsafeWrite dest (fromIntegral destOff) (safe c)
118+ w <- unsafeWrite arr n c
269− poke destOffPtr (destOff + fromIntegral w)
119+ go (n+w) (m+1)
270− loop $ curPtr' `plusPtr` 1
271−
272− _ -> do
273− -- We encountered the end of the buffer while decoding
274− n <- peek destOffPtr
275− codepoint <- peek codepointPtr
276− chunkText <- unsafeSTToIO $ do
277− arr <- A.unsafeFreeze dest
278− return $! text arr 0 (fromIntegral n)
279− lastPtr <- peek curPtrPtr
280− let left = lastPtr `minusPtr` curPtr
281− !undecoded = case state of
282− UTF8_ACCEPT -> B.empty
283− _ -> B.append undecoded0 (B.drop left bs)
284− return $ Some chunkText undecoded
285− (decodeChunk undecoded codepoint state)
286− in loop (ptr `plusPtr` off)
287− desc = "Data.Text.Internal.Encoding.streamDecodeUtf8With: Invalid UTF-8 stream"
120+ desc = "Data.Text.Encoding.decodeUtf8: Invalid UTF-8 stream"
121+{-# INLINE[0] decodeUtf8With #-}
288
122
289-- | Decode a 'ByteString' containing UTF-8 encoded text that is known
123-- | Decode a 'ByteString' containing UTF-8 encoded text that is known
290-- to be valid.
124-- to be valid.
@@ -299,93 +133,55 @@ decodeUtf8 = decodeUtf8With strictDecode
299{-# RULES "STREAM stream/decodeUtf8 fusion" [1]
133{-# RULES "STREAM stream/decodeUtf8 fusion" [1]
300 forall bs. F.stream (decodeUtf8 bs) = E.streamUtf8 strictDecode bs #-}
134 forall bs. F.stream (decodeUtf8 bs) = E.streamUtf8 strictDecode bs #-}
301
135
302−-- | Decode a 'ByteString' containing UTF-8 encoded text.
136+-- | Decode a 'ByteString' containing UTF-8 encoded text..
303--
137--
304-- If the input contains any invalid UTF-8 data, the relevant
138-- If the input contains any invalid UTF-8 data, the relevant
305-- exception will be returned, otherwise the decoded text.
139-- exception will be returned, otherwise the decoded text.
306decodeUtf8' :: ByteString -> Either UnicodeException Text
140decodeUtf8' :: ByteString -> Either UnicodeException Text
307−decodeUtf8' = unsafeDupablePerformIO . try . evaluate . decodeUtf8With strictDecode
141+decodeUtf8' = unsafePerformIO . try . evaluate . decodeUtf8With strictDecode
308{-# INLINE decodeUtf8' #-}
142{-# INLINE decodeUtf8' #-}
309
143
310−-- | Encode text to a ByteString 'B.Builder' using UTF-8 encoding.
311−encodeUtf8Builder :: Text -> B.Builder
312−encodeUtf8Builder = encodeUtf8BuilderEscaped (BP.liftFixedToBounded BP.word8)
313−
314−-- | Encode text using UTF-8 encoding and escape the ASCII characters using
315−-- a 'BP.BoundedPrim'.
316−--
317−-- Use this function is to implement efficient encoders for text-based formats
318−-- like JSON or HTML.
319−{-# INLINE encodeUtf8BuilderEscaped #-}
320−-- TODO: Extend documentation with references to source code in @blaze-html@
321−-- or @aeson@ that uses this function.
322−encodeUtf8BuilderEscaped :: BP.BoundedPrim Word8 -> Text -> B.Builder
323−encodeUtf8BuilderEscaped be =
324− -- manual eta-expansion to ensure inlining works as expected
325− \txt -> B.builder (mkBuildstep txt)
326− where
327− bound = max 4 $ BP.sizeBound be
328−
329− mkBuildstep (Text arr off len) !k =
330− outerLoop off
331− where
332− iend = off + len
333−
334− outerLoop !i0 !br@(B.BufferRange op0 ope)
335− | i0 >= iend = k br
336− | outRemaining > 0 = goPartial (i0 + min outRemaining inpRemaining)
337− -- TODO: Use a loop with an integrated bound's check if outRemaining
338− -- is smaller than 8, as this will save on divisions.
339− | otherwise = return $ B.bufferFull bound op0 (outerLoop i0)
340− where
341− outRemaining = (ope `minusPtr` op0) `div` bound
342− inpRemaining = iend - i0
343−
344− goPartial !iendTmp = go i0 op0
345− where
346− go !i !op
347− | i < iendTmp = case A.unsafeIndex arr i of
348− w | w <= 0x7F -> do
349− BP.runB be (fromIntegral w) op >>= go (i + 1)
350− | w <= 0x7FF -> do
351− poke8 0 $ (w `shiftR` 6) + 0xC0
352− poke8 1 $ (w .&. 0x3f) + 0x80
353− go (i + 1) (op `plusPtr` 2)
354− | 0xD800 <= w && w <= 0xDBFF -> do
355− let c = ord $ U16.chr2 w (A.unsafeIndex arr (i+1))
356− poke8 0 $ (c `shiftR` 18) + 0xF0
357− poke8 1 $ ((c `shiftR` 12) .&. 0x3F) + 0x80
358− poke8 2 $ ((c `shiftR` 6) .&. 0x3F) + 0x80
359− poke8 3 $ (c .&. 0x3F) + 0x80
360− go (i + 2) (op `plusPtr` 4)
361− | otherwise -> do
362− poke8 0 $ (w `shiftR` 12) + 0xE0
363− poke8 1 $ ((w `shiftR` 6) .&. 0x3F) + 0x80
364− poke8 2 $ (w .&. 0x3F) + 0x80
365− go (i + 1) (op `plusPtr` 3)
366− | otherwise =
367− outerLoop i (B.BufferRange op ope)
368− where
369− poke8 j v = poke (op `plusPtr` j) (fromIntegral v :: Word8)
370−
371-- | Encode text using UTF-8 encoding.
144-- | Encode text using UTF-8 encoding.
372encodeUtf8 :: Text -> ByteString
145encodeUtf8 :: Text -> ByteString
373−encodeUtf8 (Text arr off len)
146+encodeUtf8 (Text arr off len) = unsafePerformIO $ do
374− | len == 0 = B.empty
147+ let size0 = min len 4
375− | otherwise = unsafeDupablePerformIO $ do
148+ mallocByteString size0 >>= start size0 off 0
376− fp <- mallocByteString (len*4)
149+ where
377− withForeignPtr fp $ \ptr ->
150+ start size n0 m0 fp = withForeignPtr fp $ loop n0 m0
378− with ptr $ \destPtr -> do
151+ where
379− c_encode_utf8 destPtr (A.aBA arr) (fromIntegral off) (fromIntegral len)
152+ loop n1 m1 ptr = go n1 m1
380− newDest <- peek destPtr
153+ where
381− let utf8len = newDest `minusPtr` ptr
154+ go !n !m
382− if utf8len >= len `shiftR` 1
155+ | n-off == len = return $! PS fp 0 m
383− then return (PS fp 0 utf8len)
156+ | size-m < 4 = {-# SCC "encodeUtf8/resize" #-} do
384− else do
157+ let newSize = size `shiftL` 1
385− fp' <- mallocByteString utf8len
158+ fp' <- mallocByteString newSize
386− withForeignPtr fp' $ \ptr' -> do
387− memcpy ptr' ptr (fromIntegral utf8len)
159+ withForeignPtr fp' $ \ptr' -> memcpy ptr' ptr (fromIntegral m)
388− return (PS fp' 0 utf8len)
160+ start newSize n m fp'
161+ | otherwise = do
162+ let poke8 k v = poke (ptr `plusPtr` k) (fromIntegral v :: Word8)
163+ w = A.unsafeIndex arr n
164+ case undefined of
165+ _| w <= 0x7F -> do
166+ poke8 m w
167+ go (n+1) (m+1)
168+ | w <= 0x7FF -> do
169+ poke8 m $ (w `shiftR` 6) + 0xC0
170+ poke8 (m+1) $ (w .&. 0x3f) + 0x80
171+ go (n+1) (m+2)
172+ | 0xD800 <= w && w <= 0xDBFF -> do
173+ let c = ord $ U16.chr2 w (A.unsafeIndex arr (n+1))
174+ poke8 m $ (c `shiftR` 18) + 0xF0
175+ poke8 (m+1) $ ((c `shiftR` 12) .&. 0x3F) + 0x80
176+ poke8 (m+2) $ ((c `shiftR` 6) .&. 0x3F) + 0x80
177+ poke8 (m+3) $ (c .&. 0x3F) + 0x80
178+ go (n+2) (m+4)
179+ | otherwise -> do
180+ poke8 m $ (w `shiftR` 12) + 0xE0
181+ poke8 (m+1) $ ((w `shiftR` 6) .&. 0x3F) + 0x80
182+ poke8 (m+2) $ (w .&. 0x3F) + 0x80
183+ go (n+1) (m+3)
184+{- INLINE encodeUtf8 #-}
389
185
390-- | Decode text from little endian UTF-16 encoding.
186-- | Decode text from little endian UTF-16 encoding.
391decodeUtf16LEWith :: OnDecodeError -> ByteString -> Text
187decodeUtf16LEWith :: OnDecodeError -> ByteString -> Text
@@ -462,18 +258,3 @@ encodeUtf32LE txt = E.unstream (E.restreamUtf32LE (F.stream txt))
462encodeUtf32BE :: Text -> ByteString
258encodeUtf32BE :: Text -> ByteString
463encodeUtf32BE txt = E.unstream (E.restreamUtf32BE (F.stream txt))
259encodeUtf32BE txt = E.unstream (E.restreamUtf32BE (F.stream txt))
464{-# INLINE encodeUtf32BE #-}
260{-# INLINE encodeUtf32BE #-}
465−
466−foreign import ccall unsafe "_hs_text_decode_utf8" c_decode_utf8
467− :: MutableByteArray# s -> Ptr CSize
468− -> Ptr Word8 -> Ptr Word8 -> IO (Ptr Word8)
469−
470−foreign import ccall unsafe "_hs_text_decode_utf8_state" c_decode_utf8_with_state
471− :: MutableByteArray# s -> Ptr CSize
472− -> Ptr (Ptr Word8) -> Ptr Word8
473− -> Ptr CodePoint -> Ptr DecoderState -> IO (Ptr Word8)
474−
475−foreign import ccall unsafe "_hs_text_decode_latin1" c_decode_latin1
476− :: MutableByteArray# s -> Ptr Word8 -> Ptr Word8 -> IO ()
477−
478−foreign import ccall unsafe "_hs_text_encode_utf8" c_encode_utf8
479− :: Ptr (Ptr Word8) -> ByteArray# -> CSize -> CSize -> IO ()
Data/Text/Encoding/Error.hs+7−16
@@ -1,15 +1,11 @@
1{-# LANGUAGE CPP, DeriveDataTypeable #-}
1{-# LANGUAGE CPP, DeriveDataTypeable #-}
2−#if __GLASGOW_HASKELL__ >= 704
3−{-# LANGUAGE Safe #-}
4−#elif __GLASGOW_HASKELL__ >= 702
5−{-# LANGUAGE Trustworthy #-}
6−#endif
7-- |
2-- |
8-- Module : Data.Text.Encoding.Error
3-- Module : Data.Text.Encoding.Error
9-- Copyright : (c) Bryan O'Sullivan 2009
4-- Copyright : (c) Bryan O'Sullivan 2009
10--
5--
11-- License : BSD-style
6-- License : BSD-style
12−-- Maintainer : bos@serpentine.com
7+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
8+-- duncan@haskell.org
13-- Stability : experimental
9-- Stability : experimental
14-- Portability : GHC
10-- Portability : GHC
15--
11--
@@ -39,8 +35,11 @@ module Data.Text.Encoding.Error
39 , replace
35 , replace
40 ) where
36 ) where
41
37
42−import Control.DeepSeq (NFData (..))
38+#if __GLASGOW_HASKELL__ >= 610
43import Control.Exception (Exception, throw)
39import Control.Exception (Exception, throw)
40+#else
41+import Control.Exception.Extensible (Exception, throw)
42+#endif
44import Data.Typeable (Typeable)
43import Data.Typeable (Typeable)
45import Data.Word (Word8)
44import Data.Word (Word8)
46import Numeric (showHex)
45import Numeric (showHex)
@@ -68,7 +67,6 @@ type OnError a b = String -> Maybe a -> Maybe b
68type OnDecodeError = OnError Word8 Char
67type OnDecodeError = OnError Word8 Char
69
68
70-- | A handler for an encoding error.
69-- | A handler for an encoding error.
71−{-# DEPRECATED OnEncodeError "This exception is never used in practice, and will be removed." #-}
72type OnEncodeError = OnError Char Word8
70type OnEncodeError = OnError Char Word8
73
71
74-- | An exception type for representing Unicode encoding errors.
72-- | An exception type for representing Unicode encoding errors.
@@ -81,8 +79,6 @@ data UnicodeException =
81 -- under the given encoding, or ran out of input in mid-encode.
79 -- under the given encoding, or ran out of input in mid-encode.
82 deriving (Eq, Typeable)
80 deriving (Eq, Typeable)
83
81
84−{-# DEPRECATED EncodeError "This constructor is never used, and will be removed." #-}
85−
86showUnicodeException :: UnicodeException -> String
82showUnicodeException :: UnicodeException -> String
87showUnicodeException (DecodeError desc (Just w))
83showUnicodeException (DecodeError desc (Just w))
88 = "Cannot decode byte '\\x" ++ showHex w ("': " ++ desc)
84 = "Cannot decode byte '\\x" ++ showHex w ("': " ++ desc)
@@ -92,16 +88,12 @@ showUnicodeException (EncodeError desc (Just c))
92 = "Cannot encode character '\\x" ++ showHex (fromEnum c) ("': " ++ desc)
88 = "Cannot encode character '\\x" ++ showHex (fromEnum c) ("': " ++ desc)
93showUnicodeException (EncodeError desc Nothing)
89showUnicodeException (EncodeError desc Nothing)
94 = "Cannot encode input: " ++ desc
90 = "Cannot encode input: " ++ desc
95−
91+
96instance Show UnicodeException where
92instance Show UnicodeException where
97 show = showUnicodeException
93 show = showUnicodeException
98
94
99instance Exception UnicodeException
95instance Exception UnicodeException
100
96
101−instance NFData UnicodeException where
102− rnf (DecodeError desc w) = rnf desc `seq` rnf w `seq` ()
103− rnf (EncodeError desc c) = rnf desc `seq` rnf c `seq` ()
104−
105-- | Throw a 'UnicodeException' if decoding fails.
97-- | Throw a 'UnicodeException' if decoding fails.
106strictDecode :: OnDecodeError
98strictDecode :: OnDecodeError
107strictDecode desc c = throw (DecodeError desc c)
99strictDecode desc c = throw (DecodeError desc c)
@@ -112,7 +104,6 @@ lenientDecode :: OnDecodeError
112lenientDecode _ _ = Just '\xfffd'
104lenientDecode _ _ = Just '\xfffd'
113
105
114-- | Throw a 'UnicodeException' if encoding fails.
106-- | Throw a 'UnicodeException' if encoding fails.
115−{-# DEPRECATED strictEncode "This function always throws an exception, and will be removed." #-}
116strictEncode :: OnEncodeError
107strictEncode :: OnEncodeError
117strictEncode desc c = throw (EncodeError desc c)
108strictEncode desc c = throw (EncodeError desc c)
118
109
Data/Text/Internal/Encoding/Fusion.hs → Data/Text/Encoding/Fusion.hsrenamed+16−20
@@ -1,24 +1,21 @@
1{-# LANGUAGE BangPatterns, CPP, Rank2Types #-}
1{-# LANGUAGE BangPatterns, CPP, Rank2Types #-}
2
2
3-- |
3-- |
4−-- Module : Data.Text.Internal.Encoding.Fusion
4+-- Module : Data.Text.Encoding.Fusion
5-- Copyright : (c) Tom Harper 2008-2009,
5-- Copyright : (c) Tom Harper 2008-2009,
6-- (c) Bryan O'Sullivan 2009,
6-- (c) Bryan O'Sullivan 2009,
7-- (c) Duncan Coutts 2009
7-- (c) Duncan Coutts 2009
8--
8--
9-- License : BSD-style
9-- License : BSD-style
10−-- Maintainer : bos@serpentine.com
10+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
11+-- duncan@haskell.org
11-- Stability : experimental
12-- Stability : experimental
12-- Portability : portable
13-- Portability : portable
13--
14--
14−-- /Warning/: this is an internal module, and does not have a stable
15−-- API or name. Functions in this module may not check or enforce
16−-- preconditions expected by public modules. Use at your own risk!
17−--
18-- Fusible 'Stream'-oriented functions for converting between 'Text'
15-- Fusible 'Stream'-oriented functions for converting between 'Text'
19-- and several common encodings.
16-- and several common encodings.
20
17
21−module Data.Text.Internal.Encoding.Fusion
18+module Data.Text.Encoding.Fusion
22 (
19 (
23 -- * Streaming
20 -- * Streaming
24 streamASCII
21 streamASCII
@@ -31,28 +28,28 @@ module Data.Text.Internal.Encoding.Fusion
31 -- * Unstreaming
28 -- * Unstreaming
32 , unstream
29 , unstream
33
30
34− , module Data.Text.Internal.Encoding.Fusion.Common
31+ , module Data.Text.Encoding.Fusion.Common
35 ) where
32 ) where
36
33
37#if defined(ASSERTS)
34#if defined(ASSERTS)
38import Control.Exception (assert)
35import Control.Exception (assert)
39#endif
36#endif
40import Data.ByteString.Internal (ByteString(..), mallocByteString, memcpy)
37import Data.ByteString.Internal (ByteString(..), mallocByteString, memcpy)
41−import Data.Text.Internal.Fusion (Step(..), Stream(..))
38+import Data.Text.Fusion (Step(..), Stream(..))
42−import Data.Text.Internal.Fusion.Size
39+import Data.Text.Fusion.Size
43import Data.Text.Encoding.Error
40import Data.Text.Encoding.Error
44−import Data.Text.Internal.Encoding.Fusion.Common
41+import Data.Text.Encoding.Fusion.Common
45−import Data.Text.Internal.Unsafe.Char (unsafeChr, unsafeChr8, unsafeChr32)
42+import Data.Text.UnsafeChar (unsafeChr, unsafeChr8, unsafeChr32)
46−import Data.Text.Internal.Unsafe.Shift (shiftL, shiftR)
43+import Data.Text.UnsafeShift (shiftL, shiftR)
47import Data.Word (Word8, Word16, Word32)
44import Data.Word (Word8, Word16, Word32)
48import Foreign.ForeignPtr (withForeignPtr, ForeignPtr)
45import Foreign.ForeignPtr (withForeignPtr, ForeignPtr)
49import Foreign.Storable (pokeByteOff)
46import Foreign.Storable (pokeByteOff)
47+import System.IO.Unsafe (unsafePerformIO)
50import qualified Data.ByteString as B
48import qualified Data.ByteString as B
51import qualified Data.ByteString.Unsafe as B
49import qualified Data.ByteString.Unsafe as B
52−import qualified Data.Text.Internal.Encoding.Utf8 as U8
50+import qualified Data.Text.Encoding.Utf8 as U8
53−import qualified Data.Text.Internal.Encoding.Utf16 as U16
51+import qualified Data.Text.Encoding.Utf16 as U16
54−import qualified Data.Text.Internal.Encoding.Utf32 as U32
52+import qualified Data.Text.Encoding.Utf32 as U32
55−import Data.Text.Unsafe (unsafeDupablePerformIO)
56
53
57streamASCII :: ByteString -> Stream Char
54streamASCII :: ByteString -> Stream Char
58streamASCII bs = Stream next 0 (maxSize l)
55streamASCII bs = Stream next 0 (maxSize l)
@@ -64,7 +61,6 @@ streamASCII bs = Stream next 0 (maxSize l)
64 | otherwise = Yield (unsafeChr8 x1) (i+1)
61 | otherwise = Yield (unsafeChr8 x1) (i+1)
65 where
62 where
66 x1 = B.unsafeIndex bs i
63 x1 = B.unsafeIndex bs i
67−{-# DEPRECATED streamASCII "Do not use this function" #-}
68{-# INLINE [0] streamASCII #-}
64{-# INLINE [0] streamASCII #-}
69
65
70-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using UTF-8
66-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using UTF-8
@@ -166,7 +162,7 @@ streamUtf32LE onErr bs = Stream next 0 (maxSize (l `shiftR` 2))
166
162
167-- | /O(n)/ Convert a 'Stream' 'Word8' to a 'ByteString'.
163-- | /O(n)/ Convert a 'Stream' 'Word8' to a 'ByteString'.
168unstream :: Stream Word8 -> ByteString
164unstream :: Stream Word8 -> ByteString
169−unstream (Stream next s0 len) = unsafeDupablePerformIO $ do
165+unstream (Stream next s0 len) = unsafePerformIO $ do
170 let mlen = upperBound 4 len
166 let mlen = upperBound 4 len
171 mallocByteString mlen >>= loop mlen 0 s0
167 mallocByteString mlen >>= loop mlen 0 s0
172 where
168 where
@@ -204,5 +200,5 @@ decodeError func kind onErr mb i =
204 case onErr desc mb of
200 case onErr desc mb of
205 Nothing -> Skip i
201 Nothing -> Skip i
206 Just c -> Yield c i
202 Just c -> Yield c i
207− where desc = "Data.Text.Internal.Encoding.Fusion." ++ func ++ ": Invalid " ++
203+ where desc = "Data.Text.Encoding.Fusion." ++ func ++ ": Invalid " ++
208 kind ++ " stream"
204 kind ++ " stream"
Data/Text/Encoding/Fusion/Common.hsnew file+162
@@ -0,0 +1,162 @@
1+{-# LANGUAGE BangPatterns #-}
2+
3+-- |
4+-- Module : Data.Text.Encoding.Fusion.Common
5+-- Copyright : (c) Tom Harper 2008-2009,
6+-- (c) Bryan O'Sullivan 2009,
7+-- (c) Duncan Coutts 2009
8+--
9+-- License : BSD-style
10+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
11+-- duncan@haskell.org
12+-- Stability : experimental
13+-- Portability : portable
14+--
15+-- Fusible 'Stream'-oriented functions for converting between 'Text'
16+-- and several common encodings.
17+
18+module Data.Text.Encoding.Fusion.Common
19+ (
20+ -- * Restreaming
21+ -- Restreaming is the act of converting from one 'Stream'
22+ -- representation to another.
23+ restreamUtf8
24+ , restreamUtf16LE
25+ , restreamUtf16BE
26+ , restreamUtf32LE
27+ , restreamUtf32BE
28+ ) where
29+
30+import Data.Bits ((.&.))
31+import Data.Text.Fusion (Step(..), Stream(..))
32+import Data.Text.Fusion.Internal (M(..), S(..))
33+import Data.Text.UnsafeChar (ord)
34+import Data.Text.UnsafeShift (shiftR)
35+import Data.Word (Word8)
36+import qualified Data.Text.Encoding.Utf8 as U8
37+
38+-- | /O(n)/ Convert a Stream Char into a UTF-8 encoded Stream Word8.
39+restreamUtf8 :: Stream Char -> Stream Word8
40+restreamUtf8 (Stream next0 s0 len) =
41+ Stream next (S s0 N N N) (len*2)
42+ where
43+ {-# INLINE next #-}
44+ next (S s N N N) = case next0 s of
45+ Done -> Done
46+ Skip s' -> Skip (S s' N N N)
47+ Yield x xs
48+ | n <= 0x7F -> Yield c (S xs N N N)
49+ | n <= 0x07FF -> Yield a2 (S xs (J b2) N N)
50+ | n <= 0xFFFF -> Yield a3 (S xs (J b3) (J c3) N)
51+ | otherwise -> Yield a4 (S xs (J b4) (J c4) (J d4))
52+ where
53+ n = ord x
54+ c = fromIntegral n
55+ (a2,b2) = U8.ord2 x
56+ (a3,b3,c3) = U8.ord3 x
57+ (a4,b4,c4,d4) = U8.ord4 x
58+ next (S s (J x2) N N) = Yield x2 (S s N N N)
59+ next (S s (J x2) x3 N) = Yield x2 (S s x3 N N)
60+ next (S s (J x2) x3 x4) = Yield x2 (S s x3 x4 N)
61+ next _ = internalError "restreamUtf8"
62+{-# INLINE restreamUtf8 #-}
63+
64+restreamUtf16BE :: Stream Char -> Stream Word8
65+restreamUtf16BE (Stream next0 s0 len) =
66+ Stream next (S s0 N N N) (len*2)
67+ where
68+ {-# INLINE next #-}
69+ next (S s N N N) = case next0 s of
70+ Done -> Done
71+ Skip s' -> Skip (S s' N N N)
72+ Yield x xs
73+ | n < 0x10000 -> Yield (fromIntegral $ n `shiftR` 8) $
74+ S xs (J $ fromIntegral n) N N
75+ | otherwise -> Yield c1 $
76+ S xs (J c2) (J c3) (J c4)
77+ where
78+ n = ord x
79+ n1 = n - 0x10000
80+ c1 = fromIntegral (n1 `shiftR` 18 + 0xD8)
81+ c2 = fromIntegral (n1 `shiftR` 10)
82+ n2 = n1 .&. 0x3FF
83+ c3 = fromIntegral (n2 `shiftR` 8 + 0xDC)
84+ c4 = fromIntegral n2
85+ next (S s (J x2) N N) = Yield x2 (S s N N N)
86+ next (S s (J x2) x3 N) = Yield x2 (S s x3 N N)
87+ next (S s (J x2) x3 x4) = Yield x2 (S s x3 x4 N)
88+ next _ = internalError "restreamUtf16BE"
89+{-# INLINE restreamUtf16BE #-}
90+
91+restreamUtf16LE :: Stream Char -> Stream Word8
92+restreamUtf16LE (Stream next0 s0 len) =
93+ Stream next (S s0 N N N) (len*2)
94+ where
95+ {-# INLINE next #-}
96+ next (S s N N N) = case next0 s of
97+ Done -> Done
98+ Skip s' -> Skip (S s' N N N)
99+ Yield x xs
100+ | n < 0x10000 -> Yield (fromIntegral n) $
101+ S xs (J (fromIntegral $ shiftR n 8)) N N
102+ | otherwise -> Yield c1 $
103+ S xs (J c2) (J c3) (J c4)
104+ where
105+ n = ord x
106+ n1 = n - 0x10000
107+ c2 = fromIntegral (shiftR n1 18 + 0xD8)
108+ c1 = fromIntegral (shiftR n1 10)
109+ n2 = n1 .&. 0x3FF
110+ c4 = fromIntegral (shiftR n2 8 + 0xDC)
111+ c3 = fromIntegral n2
112+ next (S s (J x2) N N) = Yield x2 (S s N N N)
113+ next (S s (J x2) x3 N) = Yield x2 (S s x3 N N)
114+ next (S s (J x2) x3 x4) = Yield x2 (S s x3 x4 N)
115+ next _ = internalError "restreamUtf16LE"
116+{-# INLINE restreamUtf16LE #-}
117+
118+restreamUtf32BE :: Stream Char -> Stream Word8
119+restreamUtf32BE (Stream next0 s0 len) =
120+ Stream next (S s0 N N N) (len*2)
121+ where
122+ {-# INLINE next #-}
123+ next (S s N N N) = case next0 s of
124+ Done -> Done
125+ Skip s' -> Skip (S s' N N N)
126+ Yield x xs -> Yield c1 (S xs (J c2) (J c3) (J c4))
127+ where
128+ n = ord x
129+ c1 = fromIntegral $ shiftR n 24
130+ c2 = fromIntegral $ shiftR n 16
131+ c3 = fromIntegral $ shiftR n 8
132+ c4 = fromIntegral n
133+ next (S s (J x2) N N) = Yield x2 (S s N N N)
134+ next (S s (J x2) x3 N) = Yield x2 (S s x3 N N)
135+ next (S s (J x2) x3 x4) = Yield x2 (S s x3 x4 N)
136+ next _ = internalError "restreamUtf32BE"
137+{-# INLINE restreamUtf32BE #-}
138+
139+restreamUtf32LE :: Stream Char -> Stream Word8
140+restreamUtf32LE (Stream next0 s0 len) =
141+ Stream next (S s0 N N N) (len*2)
142+ where
143+ {-# INLINE next #-}
144+ next (S s N N N) = case next0 s of
145+ Done -> Done
146+ Skip s' -> Skip (S s' N N N)
147+ Yield x xs -> Yield c1 (S xs (J c2) (J c3) (J c4))
148+ where
149+ n = ord x
150+ c4 = fromIntegral $ shiftR n 24
151+ c3 = fromIntegral $ shiftR n 16
152+ c2 = fromIntegral $ shiftR n 8
153+ c1 = fromIntegral n
154+ next (S s (J x2) N N) = Yield x2 (S s N N N)
155+ next (S s (J x2) x3 N) = Yield x2 (S s x3 N N)
156+ next (S s (J x2) x3 x4) = Yield x2 (S s x3 x4 N)
157+ next _ = internalError "restreamUtf32LE"
158+{-# INLINE restreamUtf32LE #-}
159+
160+internalError :: String -> a
161+internalError func =
162+ error $ "Data.Text.Encoding.Fusion.Common." ++ func ++ ": internal error"
Data/Text/Internal/Encoding/Utf16.hs → Data/Text/Encoding/Utf16.hsrenamed+4−7
@@ -1,22 +1,19 @@
1{-# LANGUAGE MagicHash, BangPatterns #-}
1{-# LANGUAGE MagicHash, BangPatterns #-}
2
2
3-- |
3-- |
4−-- Module : Data.Text.Internal.Encoding.Utf16
4+-- Module : Data.Text.Encoding.Utf16
5-- Copyright : (c) 2008, 2009 Tom Harper,
5-- Copyright : (c) 2008, 2009 Tom Harper,
6-- (c) 2009 Bryan O'Sullivan,
6-- (c) 2009 Bryan O'Sullivan,
7-- (c) 2009 Duncan Coutts
7-- (c) 2009 Duncan Coutts
8--
8--
9-- License : BSD-style
9-- License : BSD-style
10−-- Maintainer : bos@serpentine.com
10+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
11+-- duncan@haskell.org
11-- Stability : experimental
12-- Stability : experimental
12-- Portability : GHC
13-- Portability : GHC
13--
14--
14−-- /Warning/: this is an internal module, and does not have a stable
15−-- API or name. Functions in this module may not check or enforce
16−-- preconditions expected by public modules. Use at your own risk!
17−--
18-- Basic UTF-16 validation and character manipulation.
15-- Basic UTF-16 validation and character manipulation.
19−module Data.Text.Internal.Encoding.Utf16
16+module Data.Text.Encoding.Utf16
20 (
17 (
21 chr2
18 chr2
22 , validate1
19 , validate1
Data/Text/Internal/Encoding/Utf32.hs → Data/Text/Encoding/Utf32.hsrenamed+4−7
@@ -1,20 +1,17 @@
1-- |
1-- |
2−-- Module : Data.Text.Internal.Encoding.Utf32
2+-- Module : Data.Text.Encoding.Utf32
3-- Copyright : (c) 2008, 2009 Tom Harper,
3-- Copyright : (c) 2008, 2009 Tom Harper,
4-- (c) 2009, 2010 Bryan O'Sullivan,
4-- (c) 2009, 2010 Bryan O'Sullivan,
5-- (c) 2009 Duncan Coutts
5-- (c) 2009 Duncan Coutts
6--
6--
7-- License : BSD-style
7-- License : BSD-style
8−-- Maintainer : bos@serpentine.com
8+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
9+-- duncan@haskell.org
9-- Stability : experimental
10-- Stability : experimental
10-- Portability : portable
11-- Portability : portable
11--
12--
12−-- /Warning/: this is an internal module, and does not have a stable
13−-- API or name. Functions in this module may not check or enforce
14−-- preconditions expected by public modules. Use at your own risk!
15−--
16-- Basic UTF-32 validation.
13-- Basic UTF-32 validation.
17−module Data.Text.Internal.Encoding.Utf32
14+module Data.Text.Encoding.Utf32
18 (
15 (
19 validate
16 validate
20 ) where
17 ) where
Data/Text/Internal/Encoding/Utf8.hs → Data/Text/Encoding/Utf8.hsrenamed+7−14
@@ -1,22 +1,19 @@
1{-# LANGUAGE CPP, MagicHash, BangPatterns #-}
1{-# LANGUAGE CPP, MagicHash, BangPatterns #-}
2
2
3-- |
3-- |
4−-- Module : Data.Text.Internal.Encoding.Utf8
4+-- Module : Data.Text.Encoding.Utf8
5-- Copyright : (c) 2008, 2009 Tom Harper,
5-- Copyright : (c) 2008, 2009 Tom Harper,
6-- (c) 2009, 2010 Bryan O'Sullivan,
6-- (c) 2009, 2010 Bryan O'Sullivan,
7-- (c) 2009 Duncan Coutts
7-- (c) 2009 Duncan Coutts
8--
8--
9-- License : BSD-style
9-- License : BSD-style
10−-- Maintainer : bos@serpentine.com
10+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
11+-- duncan@haskell.org
11-- Stability : experimental
12-- Stability : experimental
12-- Portability : GHC
13-- Portability : GHC
13--
14--
14−-- /Warning/: this is an internal module, and does not have a stable
15−-- API or name. Functions in this module may not check or enforce
16−-- preconditions expected by public modules. Use at your own risk!
17−--
18-- Basic UTF-8 validation and character manipulation.
15-- Basic UTF-8 validation and character manipulation.
19−module Data.Text.Internal.Encoding.Utf8
16+module Data.Text.Encoding.Utf8
20 (
17 (
21 -- Decomposition
18 -- Decomposition
22 ord2
19 ord2
@@ -33,16 +30,12 @@ module Data.Text.Internal.Encoding.Utf8
33 , validate4
30 , validate4
34 ) where
31 ) where
35
32
36−#if defined(TEST_SUITE)
37−# undef ASSERTS
38−#endif
39−
40#if defined(ASSERTS)
33#if defined(ASSERTS)
41import Control.Exception (assert)
34import Control.Exception (assert)
42#endif
35#endif
43import Data.Bits ((.&.))
36import Data.Bits ((.&.))
44−import Data.Text.Internal.Unsafe.Char (ord)
37+import Data.Text.UnsafeChar (ord)
45−import Data.Text.Internal.Unsafe.Shift (shiftR)
38+import Data.Text.UnsafeShift (shiftR)
46import GHC.Exts
39import GHC.Exts
47import GHC.Word (Word8(..))
40import GHC.Word (Word8(..))
48
41
@@ -153,7 +146,7 @@ validate3 x1 x2 x3 = validate3_1 || validate3_2 || validate3_3 || validate3_4
153validate4 :: Word8 -> Word8 -> Word8 -> Word8 -> Bool
146validate4 :: Word8 -> Word8 -> Word8 -> Word8 -> Bool
154{-# INLINE validate4 #-}
147{-# INLINE validate4 #-}
155validate4 x1 x2 x3 x4 = validate4_1 || validate4_2 || validate4_3
148validate4 x1 x2 x3 x4 = validate4_1 || validate4_2 || validate4_3
156− where
149+ where
157 validate4_1 = x1 == 0xF0 &&
150 validate4_1 = x1 == 0xF0 &&
158 between x2 0x90 0xBF &&
151 between x2 0x90 0xBF &&
159 between x3 0x80 0xBF &&
152 between x3 0x80 0xBF &&
Data/Text/Foreign.hs+4−31
@@ -4,7 +4,8 @@
4-- Copyright : (c) 2009, 2010 Bryan O'Sullivan
4-- Copyright : (c) 2009, 2010 Bryan O'Sullivan
5--
5--
6-- License : BSD-style
6-- License : BSD-style
7−-- Maintainer : bos@serpentine.com
7+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
8+-- duncan@haskell.org
8-- Stability : experimental
9-- Stability : experimental
9-- Portability : GHC
10-- Portability : GHC
10--
11--
@@ -20,9 +21,6 @@ module Data.Text.Foreign
20 , fromPtr
21 , fromPtr
21 , useAsPtr
22 , useAsPtr
22 , asForeignPtr
23 , asForeignPtr
23− -- ** Encoding as UTF-8
24− , peekCStringLen
25− , withCStringLen
26 -- * Unsafe conversion code
24 -- * Unsafe conversion code
27 , lengthWord16
25 , lengthWord16
28 , unsafeCopyToPtr
26 , unsafeCopyToPtr
@@ -35,22 +33,15 @@ module Data.Text.Foreign
35#if defined(ASSERTS)
33#if defined(ASSERTS)
36import Control.Exception (assert)
34import Control.Exception (assert)
37#endif
35#endif
38−#if __GLASGOW_HASKELL__ >= 702
39−import Control.Monad.ST.Unsafe (unsafeIOToST)
40−#else
41import Control.Monad.ST (unsafeIOToST)
36import Control.Monad.ST (unsafeIOToST)
42−#endif
43−import Data.ByteString.Unsafe (unsafePackCStringLen, unsafeUseAsCStringLen)
44−import Data.Text.Encoding (decodeUtf8, encodeUtf8)
45import Data.Text.Internal (Text(..), empty)
37import Data.Text.Internal (Text(..), empty)
46import Data.Text.Unsafe (lengthWord16)
38import Data.Text.Unsafe (lengthWord16)
39+import qualified Data.Text.Array as A
47import Data.Word (Word16)
40import Data.Word (Word16)
48−import Foreign.C.String (CStringLen)
49−import Foreign.ForeignPtr (ForeignPtr, mallocForeignPtrArray, withForeignPtr)
50import Foreign.Marshal.Alloc (allocaBytes)
41import Foreign.Marshal.Alloc (allocaBytes)
51import Foreign.Ptr (Ptr, castPtr, plusPtr)
42import Foreign.Ptr (Ptr, castPtr, plusPtr)
43+import Foreign.ForeignPtr (ForeignPtr, mallocForeignPtrArray, withForeignPtr)
52import Foreign.Storable (peek, poke)
44import Foreign.Storable (peek, poke)
53−import qualified Data.Text.Array as A
54
45
55-- $interop
46-- $interop
56--
47--
@@ -153,21 +144,3 @@ asForeignPtr t@(Text _arr _off len) = do
153 fp <- mallocForeignPtrArray len
144 fp <- mallocForeignPtrArray len
154 withForeignPtr fp $ unsafeCopyToPtr t
145 withForeignPtr fp $ unsafeCopyToPtr t
155 return (fp, I16 len)
146 return (fp, I16 len)
156−
157−-- | /O(n)/ Decode a C string with explicit length, which is assumed
158−-- to have been encoded as UTF-8. If decoding fails, a
159−-- 'UnicodeException' is thrown.
160−peekCStringLen :: CStringLen -> IO Text
161−peekCStringLen cs = do
162− bs <- unsafePackCStringLen cs
163− return $! decodeUtf8 bs
164−
165−-- | Marshal a 'Text' into a C string encoded as UTF-8 in temporary
166−-- storage, with explicit length information. The encoded string may
167−-- contain NUL bytes, and is not followed by a trailing NUL byte.
168−--
169−-- The temporary storage is freed when the subcomputation terminates
170−-- (either normally or via an exception), so the pointer to the
171−-- temporary storage must /not/ be used after this function returns.
172−withCStringLen :: Text -> (CStringLen -> IO a) -> IO a
173−withCStringLen t act = unsafeUseAsCStringLen (encodeUtf8 t) act
Data/Text/Internal/Fusion.hs → Data/Text/Fusion.hsrenamed+45−58
@@ -1,23 +1,20 @@
1{-# LANGUAGE BangPatterns, MagicHash #-}
1{-# LANGUAGE BangPatterns, MagicHash #-}
2
2
3-- |
3-- |
4−-- Module : Data.Text.Internal.Fusion
4+-- Module : Data.Text.Fusion
5-- Copyright : (c) Tom Harper 2008-2009,
5-- Copyright : (c) Tom Harper 2008-2009,
6-- (c) Bryan O'Sullivan 2009-2010,
6-- (c) Bryan O'Sullivan 2009-2010,
7-- (c) Duncan Coutts 2009
7-- (c) Duncan Coutts 2009
8--
8--
9-- License : BSD-style
9-- License : BSD-style
10−-- Maintainer : bos@serpentine.com
10+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
11+-- duncan@haskell.org
11-- Stability : experimental
12-- Stability : experimental
12-- Portability : GHC
13-- Portability : GHC
13--
14--
14−-- /Warning/: this is an internal module, and does not have a stable
15−-- API or name. Functions in this module may not check or enforce
16−-- preconditions expected by public modules. Use at your own risk!
17−--
18-- Text manipulation functions represented as fusible operations over
15-- Text manipulation functions represented as fusible operations over
19-- streams.
16-- streams.
20−module Data.Text.Internal.Fusion
17+module Data.Text.Fusion
21 (
18 (
22 -- * Types
19 -- * Types
23 Stream(..)
20 Stream(..)
@@ -54,21 +51,21 @@ import Prelude (Bool(..), Char, Maybe(..), Monad(..), Int,
54 fromIntegral, otherwise)
51 fromIntegral, otherwise)
55import Data.Bits ((.&.))
52import Data.Bits ((.&.))
56import Data.Text.Internal (Text(..))
53import Data.Text.Internal (Text(..))
57−import Data.Text.Internal.Private (runText)
58−import Data.Text.Internal.Unsafe.Char (ord, unsafeChr, unsafeWrite)
54+import Data.Text.UnsafeChar (ord, unsafeChr, unsafeWrite)
59−import Data.Text.Internal.Unsafe.Shift (shiftL, shiftR)
55+import Data.Text.UnsafeShift (shiftL, shiftR)
60import qualified Data.Text.Array as A
56import qualified Data.Text.Array as A
61−import qualified Data.Text.Internal.Fusion.Common as S
57+import qualified Data.Text.Fusion.Common as S
62−import Data.Text.Internal.Fusion.Types
58+import Data.Text.Fusion.Internal
63−import Data.Text.Internal.Fusion.Size
59+import Data.Text.Fusion.Size
64import qualified Data.Text.Internal as I
60import qualified Data.Text.Internal as I
65−import qualified Data.Text.Internal.Encoding.Utf16 as U16
61+import qualified Data.Text.Encoding.Utf16 as U16
62+import qualified Prelude as P
66
63
67default(Int)
64default(Int)
68
65
69-- | /O(n)/ Convert a 'Text' into a 'Stream Char'.
66-- | /O(n)/ Convert a 'Text' into a 'Stream Char'.
70stream :: Text -> Stream Char
67stream :: Text -> Stream Char
71−stream (Text arr off len) = Stream next off (betweenSize (len `shiftR` 1) len)
68+stream (Text arr off len) = Stream next off (maxSize len)
72 where
69 where
73 !end = off+len
70 !end = off+len
74 next !i
71 next !i
@@ -83,7 +80,7 @@ stream (Text arr off len) = Stream next off (betweenSize (len `shiftR` 1) len)
83-- | /O(n)/ Convert a 'Text' into a 'Stream Char', but iterate
80-- | /O(n)/ Convert a 'Text' into a 'Stream Char', but iterate
84-- backwards.
81-- backwards.
85reverseStream :: Text -> Stream Char
82reverseStream :: Text -> Stream Char
86−reverseStream (Text arr off len) = Stream next (off+len-1) (betweenSize (len `shiftR` 1) len)
83+reverseStream (Text arr off len) = Stream next (off+len-1) (maxSize len)
87 where
84 where
88 {-# INLINE next #-}
85 {-# INLINE next #-}
89 next !i
86 next !i
@@ -97,36 +94,26 @@ reverseStream (Text arr off len) = Stream next (off+len-1) (betweenSize (len `sh
97
94
98-- | /O(n)/ Convert a 'Stream Char' into a 'Text'.
95-- | /O(n)/ Convert a 'Stream Char' into a 'Text'.
99unstream :: Stream Char -> Text
96unstream :: Stream Char -> Text
100−unstream (Stream next0 s0 len) = runText $ \done -> do
97+unstream (Stream next0 s0 len) = I.textP (P.fst a) 0 (P.snd a)
101− -- Before encoding each char we perform a buffer realloc check assuming
98+ where
102− -- worst case encoding size of two 16-bit units for the char. Just add an
99+ a = A.run2 (A.new mlen >>= \arr -> outer arr mlen s0 0)
103− -- extra space to the buffer so that we do not end up reallocating even when
104− -- all the chars are encoded as single unit.
105− let mlen = upperBound 4 len + 1
100+ where mlen = upperBound 4 len
106− arr0 <- A.new mlen
107− let outer !arr !maxi = encode
101+ outer arr top = loop
108− where
102+ where
109− -- keep the common case loop as small as possible
103+ loop !s !i =
110− encode !si !di =
111− case next0 si of
104+ case next0 s of
112− Done -> done arr di
105+ Done -> return (arr, i)
113− Skip si' -> encode si' di
106+ Skip s' -> loop s' i
114− Yield c si'
107+ Yield x s'
115− -- simply check for the worst case
108+ | j >= top -> {-# SCC "unstream/resize" #-} do
116− | maxi < di + 1 -> realloc si di
109+ let top' = (top + 1) `shiftL` 1
117− | otherwise -> do
118− n <- unsafeWrite arr di c
119− encode si' (di + n)
120−
121− -- keep uncommon case separate from the common case code
122− {-# NOINLINE realloc #-}
123− realloc !si !di = do
124− let newlen = (maxi + 1) * 2
125− arr' <- A.new newlen
110+ arr' <- A.new top'
126− A.copyM arr' 0 arr 0 di
111+ A.copyM arr' 0 arr 0 top
127− outer arr' (newlen - 1) si di
112+ outer arr' top' s i
128−
113+ | otherwise -> do d <- unsafeWrite arr i x
129− outer arr0 (mlen - 1) s0 0
114+ loop s' (i+d)
115+ where j | ord x < 0x10000 = i
116+ | otherwise = i + 1
130{-# INLINE [0] unstream #-}
117{-# INLINE [0] unstream #-}
131{-# RULES "STREAM stream/unstream fusion" forall s. stream (unstream s) = s #-}
118{-# RULES "STREAM stream/unstream fusion" forall s. stream (unstream s) = s #-}
132
119
@@ -142,7 +129,7 @@ length = S.lengthI
142reverse :: Stream Char -> Text
129reverse :: Stream Char -> Text
143reverse (Stream next s len0)
130reverse (Stream next s len0)
144 | isEmpty len0 = I.empty
131 | isEmpty len0 = I.empty
145− | otherwise = I.text arr off' len'
132+ | otherwise = I.textP arr off' len'
146 where
133 where
147 len0' = upperBound 4 (larger len0 4)
134 len0' = upperBound 4 (larger len0 4)
148 (arr, (off', len')) = A.run2 (A.new len0' >>= loop s (len0'-1) len0')
135 (arr, (off', len')) = A.run2 (A.new len0' >>= loop s (len0'-1) len0')
@@ -176,15 +163,15 @@ reverse (Stream next s len0)
176-- | /O(n)/ Perform the equivalent of 'scanr' over a list, only with
163-- | /O(n)/ Perform the equivalent of 'scanr' over a list, only with
177-- the input and result reversed.
164-- the input and result reversed.
178reverseScanr :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char
165reverseScanr :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char
179−reverseScanr f z0 (Stream next0 s0 len) = Stream next (Scan1 z0 s0) (len+1) -- HINT maybe too low
166+reverseScanr f z0 (Stream next0 s0 len) = Stream next (S1 :*: z0 :*: s0) (len+1) -- HINT maybe too low
180 where
167 where
181 {-# INLINE next #-}
168 {-# INLINE next #-}
182− next (Scan1 z s) = Yield z (Scan2 z s)
169+ next (S1 :*: z :*: s) = Yield z (S2 :*: z :*: s)
183− next (Scan2 z s) = case next0 s of
170+ next (S2 :*: z :*: s) = case next0 s of
184− Yield x s' -> let !x' = f x z
171+ Yield x s' -> let !x' = f x z
185− in Yield x' (Scan2 x' s')
172+ in Yield x' (S2 :*: x' :*: s')
186− Skip s' -> Skip (Scan2 z s')
173+ Skip s' -> Skip (S2 :*: z :*: s')
187− Done -> Done
174+ Done -> Done
188{-# INLINE reverseScanr #-}
175{-# INLINE reverseScanr #-}
189
176
190-- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a stream from a seed
177-- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a stream from a seed
@@ -220,7 +207,7 @@ countChar = S.countCharI
220-- function to each element of a 'Text', passing an accumulating
207-- function to each element of a 'Text', passing an accumulating
221-- parameter from left to right, and returns a final 'Text'.
208-- parameter from left to right, and returns a final 'Text'.
222mapAccumL :: (a -> Char -> (a,Char)) -> a -> Stream Char -> (a, Text)
209mapAccumL :: (a -> Char -> (a,Char)) -> a -> Stream Char -> (a, Text)
223−mapAccumL f z0 (Stream next0 s0 len) = (nz, I.text na 0 nl)
210+mapAccumL f z0 (Stream next0 s0 len) = (nz,I.textP na 0 nl)
224 where
211 where
225 (na,(nz,nl)) = A.run2 (A.new mlen >>= \arr -> outer arr mlen z0 s0 0)
212 (na,(nz,nl)) = A.run2 (A.new mlen >>= \arr -> outer arr mlen z0 s0 0)
226 where mlen = upperBound 4 len
213 where mlen = upperBound 4 len
@@ -236,9 +223,9 @@ mapAccumL f z0 (Stream next0 s0 len) = (nz, I.text na 0 nl)
236 arr' <- A.new top'
223 arr' <- A.new top'
237 A.copyM arr' 0 arr 0 top
224 A.copyM arr' 0 arr 0 top
238 outer arr' top' z s i
225 outer arr' top' z s i
226+ | otherwise -> do let (z',c) = f z x
239− | otherwise -> do d <- unsafeWrite arr i c
227+ d <- unsafeWrite arr i c
240 loop z' s' (i+d)
228 loop z' s' (i+d)
241− where (z',c) = f z x
242− j | ord c < 0x10000 = i
229+ where j | ord x < 0x10000 = i
243 | otherwise = i + 1
230 | otherwise = i + 1
244{-# INLINE [0] mapAccumL #-}
231{-# INLINE [0] mapAccumL #-}
Data/Text/Internal/Fusion/CaseMapping.hs → Data/Text/Fusion/CaseMapping.hsrenamed+6−392
@@ -1,17 +1,12 @@
1{-# LANGUAGE Rank2Types #-}
1{-# LANGUAGE Rank2Types #-}
2-- AUTOMATICALLY GENERATED - DO NOT EDIT
2-- AUTOMATICALLY GENERATED - DO NOT EDIT
3−-- Generated by scripts/CaseMapping.hs
3+-- Generated by scripts/SpecialCasing.hs
4−-- CaseFolding-8.0.0.txt
5−-- Date: 2015-01-13, 18:16:36 GMT [MD]
6−-- SpecialCasing-8.0.0.txt
7−-- Date: 2014-12-16, 23:08:04 GMT [MD]
8−
9−module Data.Text.Internal.Fusion.CaseMapping where
4+module Data.Text.Fusion.CaseMapping where
10import Data.Char
5import Data.Char
11−import Data.Text.Internal.Fusion.Types
6+import Data.Text.Fusion.Internal
12
7
13upperMapping :: forall s. Char -> s -> Step (CC s) Char
8upperMapping :: forall s. Char -> s -> Step (CC s) Char
14−{-# NOINLINE upperMapping #-}
9+{-# INLINE upperMapping #-}
15-- LATIN SMALL LETTER SHARP S
10-- LATIN SMALL LETTER SHARP S
16upperMapping '\x00df' s = Yield '\x0053' (CC s '\x0053' '\x0000')
11upperMapping '\x00df' s = Yield '\x0053' (CC s '\x0053' '\x0000')
17-- LATIN SMALL LIGATURE FF
12-- LATIN SMALL LIGATURE FF
@@ -218,111 +213,12 @@ upperMapping '\x1fc7' s = Yield '\x0397' (CC s '\x0342' '\x0399')
218upperMapping '\x1ff7' s = Yield '\x03a9' (CC s '\x0342' '\x0399')
213upperMapping '\x1ff7' s = Yield '\x03a9' (CC s '\x0342' '\x0399')
219upperMapping c s = Yield (toUpper c) (CC s '\0' '\0')
214upperMapping c s = Yield (toUpper c) (CC s '\0' '\0')
220lowerMapping :: forall s. Char -> s -> Step (CC s) Char
215lowerMapping :: forall s. Char -> s -> Step (CC s) Char
221−{-# NOINLINE lowerMapping #-}
216+{-# INLINE lowerMapping #-}
222-- LATIN CAPITAL LETTER I WITH DOT ABOVE
217-- LATIN CAPITAL LETTER I WITH DOT ABOVE
223lowerMapping '\x0130' s = Yield '\x0069' (CC s '\x0307' '\x0000')
218lowerMapping '\x0130' s = Yield '\x0069' (CC s '\x0307' '\x0000')
224lowerMapping c s = Yield (toLower c) (CC s '\0' '\0')
219lowerMapping c s = Yield (toLower c) (CC s '\0' '\0')
225−titleMapping :: forall s. Char -> s -> Step (CC s) Char
226−{-# NOINLINE titleMapping #-}
227−-- LATIN SMALL LETTER SHARP S
228−titleMapping '\x00df' s = Yield '\x0053' (CC s '\x0073' '\x0000')
229−-- LATIN SMALL LIGATURE FF
230−titleMapping '\xfb00' s = Yield '\x0046' (CC s '\x0066' '\x0000')
231−-- LATIN SMALL LIGATURE FI
232−titleMapping '\xfb01' s = Yield '\x0046' (CC s '\x0069' '\x0000')
233−-- LATIN SMALL LIGATURE FL
234−titleMapping '\xfb02' s = Yield '\x0046' (CC s '\x006c' '\x0000')
235−-- LATIN SMALL LIGATURE FFI
236−titleMapping '\xfb03' s = Yield '\x0046' (CC s '\x0066' '\x0069')
237−-- LATIN SMALL LIGATURE FFL
238−titleMapping '\xfb04' s = Yield '\x0046' (CC s '\x0066' '\x006c')
239−-- LATIN SMALL LIGATURE LONG S T
240−titleMapping '\xfb05' s = Yield '\x0053' (CC s '\x0074' '\x0000')
241−-- LATIN SMALL LIGATURE ST
242−titleMapping '\xfb06' s = Yield '\x0053' (CC s '\x0074' '\x0000')
243−-- ARMENIAN SMALL LIGATURE ECH YIWN
244−titleMapping '\x0587' s = Yield '\x0535' (CC s '\x0582' '\x0000')
245−-- ARMENIAN SMALL LIGATURE MEN NOW
246−titleMapping '\xfb13' s = Yield '\x0544' (CC s '\x0576' '\x0000')
247−-- ARMENIAN SMALL LIGATURE MEN ECH
248−titleMapping '\xfb14' s = Yield '\x0544' (CC s '\x0565' '\x0000')
249−-- ARMENIAN SMALL LIGATURE MEN INI
250−titleMapping '\xfb15' s = Yield '\x0544' (CC s '\x056b' '\x0000')
251−-- ARMENIAN SMALL LIGATURE VEW NOW
252−titleMapping '\xfb16' s = Yield '\x054e' (CC s '\x0576' '\x0000')
253−-- ARMENIAN SMALL LIGATURE MEN XEH
254−titleMapping '\xfb17' s = Yield '\x0544' (CC s '\x056d' '\x0000')
255−-- LATIN SMALL LETTER N PRECEDED BY APOSTROPHE
256−titleMapping '\x0149' s = Yield '\x02bc' (CC s '\x004e' '\x0000')
257−-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND TONOS
258−titleMapping '\x0390' s = Yield '\x0399' (CC s '\x0308' '\x0301')
259−-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND TONOS
260−titleMapping '\x03b0' s = Yield '\x03a5' (CC s '\x0308' '\x0301')
261−-- LATIN SMALL LETTER J WITH CARON
262−titleMapping '\x01f0' s = Yield '\x004a' (CC s '\x030c' '\x0000')
263−-- LATIN SMALL LETTER H WITH LINE BELOW
264−titleMapping '\x1e96' s = Yield '\x0048' (CC s '\x0331' '\x0000')
265−-- LATIN SMALL LETTER T WITH DIAERESIS
266−titleMapping '\x1e97' s = Yield '\x0054' (CC s '\x0308' '\x0000')
267−-- LATIN SMALL LETTER W WITH RING ABOVE
268−titleMapping '\x1e98' s = Yield '\x0057' (CC s '\x030a' '\x0000')
269−-- LATIN SMALL LETTER Y WITH RING ABOVE
270−titleMapping '\x1e99' s = Yield '\x0059' (CC s '\x030a' '\x0000')
271−-- LATIN SMALL LETTER A WITH RIGHT HALF RING
272−titleMapping '\x1e9a' s = Yield '\x0041' (CC s '\x02be' '\x0000')
273−-- GREEK SMALL LETTER UPSILON WITH PSILI
274−titleMapping '\x1f50' s = Yield '\x03a5' (CC s '\x0313' '\x0000')
275−-- GREEK SMALL LETTER UPSILON WITH PSILI AND VARIA
276−titleMapping '\x1f52' s = Yield '\x03a5' (CC s '\x0313' '\x0300')
277−-- GREEK SMALL LETTER UPSILON WITH PSILI AND OXIA
278−titleMapping '\x1f54' s = Yield '\x03a5' (CC s '\x0313' '\x0301')
279−-- GREEK SMALL LETTER UPSILON WITH PSILI AND PERISPOMENI
280−titleMapping '\x1f56' s = Yield '\x03a5' (CC s '\x0313' '\x0342')
281−-- GREEK SMALL LETTER ALPHA WITH PERISPOMENI
282−titleMapping '\x1fb6' s = Yield '\x0391' (CC s '\x0342' '\x0000')
283−-- GREEK SMALL LETTER ETA WITH PERISPOMENI
284−titleMapping '\x1fc6' s = Yield '\x0397' (CC s '\x0342' '\x0000')
285−-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND VARIA
286−titleMapping '\x1fd2' s = Yield '\x0399' (CC s '\x0308' '\x0300')
287−-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND OXIA
288−titleMapping '\x1fd3' s = Yield '\x0399' (CC s '\x0308' '\x0301')
289−-- GREEK SMALL LETTER IOTA WITH PERISPOMENI
290−titleMapping '\x1fd6' s = Yield '\x0399' (CC s '\x0342' '\x0000')
291−-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND PERISPOMENI
292−titleMapping '\x1fd7' s = Yield '\x0399' (CC s '\x0308' '\x0342')
293−-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND VARIA
294−titleMapping '\x1fe2' s = Yield '\x03a5' (CC s '\x0308' '\x0300')
295−-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND OXIA
296−titleMapping '\x1fe3' s = Yield '\x03a5' (CC s '\x0308' '\x0301')
297−-- GREEK SMALL LETTER RHO WITH PSILI
298−titleMapping '\x1fe4' s = Yield '\x03a1' (CC s '\x0313' '\x0000')
299−-- GREEK SMALL LETTER UPSILON WITH PERISPOMENI
300−titleMapping '\x1fe6' s = Yield '\x03a5' (CC s '\x0342' '\x0000')
301−-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND PERISPOMENI
302−titleMapping '\x1fe7' s = Yield '\x03a5' (CC s '\x0308' '\x0342')
303−-- GREEK SMALL LETTER OMEGA WITH PERISPOMENI
304−titleMapping '\x1ff6' s = Yield '\x03a9' (CC s '\x0342' '\x0000')
305−-- GREEK SMALL LETTER ALPHA WITH VARIA AND YPOGEGRAMMENI
306−titleMapping '\x1fb2' s = Yield '\x1fba' (CC s '\x0345' '\x0000')
307−-- GREEK SMALL LETTER ALPHA WITH OXIA AND YPOGEGRAMMENI
308−titleMapping '\x1fb4' s = Yield '\x0386' (CC s '\x0345' '\x0000')
309−-- GREEK SMALL LETTER ETA WITH VARIA AND YPOGEGRAMMENI
310−titleMapping '\x1fc2' s = Yield '\x1fca' (CC s '\x0345' '\x0000')
311−-- GREEK SMALL LETTER ETA WITH OXIA AND YPOGEGRAMMENI
312−titleMapping '\x1fc4' s = Yield '\x0389' (CC s '\x0345' '\x0000')
313−-- GREEK SMALL LETTER OMEGA WITH VARIA AND YPOGEGRAMMENI
314−titleMapping '\x1ff2' s = Yield '\x1ffa' (CC s '\x0345' '\x0000')
315−-- GREEK SMALL LETTER OMEGA WITH OXIA AND YPOGEGRAMMENI
316−titleMapping '\x1ff4' s = Yield '\x038f' (CC s '\x0345' '\x0000')
317−-- GREEK SMALL LETTER ALPHA WITH PERISPOMENI AND YPOGEGRAMMENI
318−titleMapping '\x1fb7' s = Yield '\x0391' (CC s '\x0342' '\x0345')
319−-- GREEK SMALL LETTER ETA WITH PERISPOMENI AND YPOGEGRAMMENI
320−titleMapping '\x1fc7' s = Yield '\x0397' (CC s '\x0342' '\x0345')
321−-- GREEK SMALL LETTER OMEGA WITH PERISPOMENI AND YPOGEGRAMMENI
322−titleMapping '\x1ff7' s = Yield '\x03a9' (CC s '\x0342' '\x0345')
323−titleMapping c s = Yield (toTitle c) (CC s '\0' '\0')
324foldMapping :: forall s. Char -> s -> Step (CC s) Char
220foldMapping :: forall s. Char -> s -> Step (CC s) Char
325−{-# NOINLINE foldMapping #-}
221+{-# INLINE foldMapping #-}
326-- MICRO SIGN
222-- MICRO SIGN
327foldMapping '\x00b5' s = Yield '\x03bc' (CC s '\x0000' '\x0000')
223foldMapping '\x00b5' s = Yield '\x03bc' (CC s '\x0000' '\x0000')
328-- LATIN SMALL LETTER SHARP S
224-- LATIN SMALL LETTER SHARP S
@@ -359,18 +255,6 @@ foldMapping '\x03f1' s = Yield '\x03c1' (CC s '\x0000' '\x0000')
359foldMapping '\x03f5' s = Yield '\x03b5' (CC s '\x0000' '\x0000')
255foldMapping '\x03f5' s = Yield '\x03b5' (CC s '\x0000' '\x0000')
360-- ARMENIAN SMALL LIGATURE ECH YIWN
256-- ARMENIAN SMALL LIGATURE ECH YIWN
361foldMapping '\x0587' s = Yield '\x0565' (CC s '\x0582' '\x0000')
257foldMapping '\x0587' s = Yield '\x0565' (CC s '\x0582' '\x0000')
362−-- CHEROKEE SMALL LETTER YE
363−foldMapping '\x13f8' s = Yield '\x13f0' (CC s '\x0000' '\x0000')
364−-- CHEROKEE SMALL LETTER YI
365−foldMapping '\x13f9' s = Yield '\x13f1' (CC s '\x0000' '\x0000')
366−-- CHEROKEE SMALL LETTER YO
367−foldMapping '\x13fa' s = Yield '\x13f2' (CC s '\x0000' '\x0000')
368−-- CHEROKEE SMALL LETTER YU
369−foldMapping '\x13fb' s = Yield '\x13f3' (CC s '\x0000' '\x0000')
370−-- CHEROKEE SMALL LETTER YV
371−foldMapping '\x13fc' s = Yield '\x13f4' (CC s '\x0000' '\x0000')
372−-- CHEROKEE SMALL LETTER MV
373−foldMapping '\x13fd' s = Yield '\x13f5' (CC s '\x0000' '\x0000')
374-- LATIN SMALL LETTER H WITH LINE BELOW
258-- LATIN SMALL LETTER H WITH LINE BELOW
375foldMapping '\x1e96' s = Yield '\x0068' (CC s '\x0331' '\x0000')
259foldMapping '\x1e96' s = Yield '\x0068' (CC s '\x0331' '\x0000')
376-- LATIN SMALL LETTER T WITH DIAERESIS
260-- LATIN SMALL LETTER T WITH DIAERESIS
@@ -545,174 +429,6 @@ foldMapping '\x1ff6' s = Yield '\x03c9' (CC s '\x0342' '\x0000')
545foldMapping '\x1ff7' s = Yield '\x03c9' (CC s '\x0342' '\x03b9')
429foldMapping '\x1ff7' s = Yield '\x03c9' (CC s '\x0342' '\x03b9')
546-- GREEK CAPITAL LETTER OMEGA WITH PROSGEGRAMMENI
430-- GREEK CAPITAL LETTER OMEGA WITH PROSGEGRAMMENI
547foldMapping '\x1ffc' s = Yield '\x03c9' (CC s '\x03b9' '\x0000')
431foldMapping '\x1ffc' s = Yield '\x03c9' (CC s '\x03b9' '\x0000')
548−-- LATIN CAPITAL LETTER J WITH CROSSED-TAIL
549−foldMapping '\xa7b2' s = Yield '\x029d' (CC s '\x0000' '\x0000')
550−-- LATIN CAPITAL LETTER CHI
551−foldMapping '\xa7b3' s = Yield '\xab53' (CC s '\x0000' '\x0000')
552−-- LATIN CAPITAL LETTER BETA
553−foldMapping '\xa7b4' s = Yield '\xa7b5' (CC s '\x0000' '\x0000')
554−-- LATIN CAPITAL LETTER OMEGA
555−foldMapping '\xa7b6' s = Yield '\xa7b7' (CC s '\x0000' '\x0000')
556−-- CHEROKEE SMALL LETTER A
557−foldMapping '\xab70' s = Yield '\x13a0' (CC s '\x0000' '\x0000')
558−-- CHEROKEE SMALL LETTER E
559−foldMapping '\xab71' s = Yield '\x13a1' (CC s '\x0000' '\x0000')
560−-- CHEROKEE SMALL LETTER I
561−foldMapping '\xab72' s = Yield '\x13a2' (CC s '\x0000' '\x0000')
562−-- CHEROKEE SMALL LETTER O
563−foldMapping '\xab73' s = Yield '\x13a3' (CC s '\x0000' '\x0000')
564−-- CHEROKEE SMALL LETTER U
565−foldMapping '\xab74' s = Yield '\x13a4' (CC s '\x0000' '\x0000')
566−-- CHEROKEE SMALL LETTER V
567−foldMapping '\xab75' s = Yield '\x13a5' (CC s '\x0000' '\x0000')
568−-- CHEROKEE SMALL LETTER GA
569−foldMapping '\xab76' s = Yield '\x13a6' (CC s '\x0000' '\x0000')
570−-- CHEROKEE SMALL LETTER KA
571−foldMapping '\xab77' s = Yield '\x13a7' (CC s '\x0000' '\x0000')
572−-- CHEROKEE SMALL LETTER GE
573−foldMapping '\xab78' s = Yield '\x13a8' (CC s '\x0000' '\x0000')
574−-- CHEROKEE SMALL LETTER GI
575−foldMapping '\xab79' s = Yield '\x13a9' (CC s '\x0000' '\x0000')
576−-- CHEROKEE SMALL LETTER GO
577−foldMapping '\xab7a' s = Yield '\x13aa' (CC s '\x0000' '\x0000')
578−-- CHEROKEE SMALL LETTER GU
579−foldMapping '\xab7b' s = Yield '\x13ab' (CC s '\x0000' '\x0000')
580−-- CHEROKEE SMALL LETTER GV
581−foldMapping '\xab7c' s = Yield '\x13ac' (CC s '\x0000' '\x0000')
582−-- CHEROKEE SMALL LETTER HA
583−foldMapping '\xab7d' s = Yield '\x13ad' (CC s '\x0000' '\x0000')
584−-- CHEROKEE SMALL LETTER HE
585−foldMapping '\xab7e' s = Yield '\x13ae' (CC s '\x0000' '\x0000')
586−-- CHEROKEE SMALL LETTER HI
587−foldMapping '\xab7f' s = Yield '\x13af' (CC s '\x0000' '\x0000')
588−-- CHEROKEE SMALL LETTER HO
589−foldMapping '\xab80' s = Yield '\x13b0' (CC s '\x0000' '\x0000')
590−-- CHEROKEE SMALL LETTER HU
591−foldMapping '\xab81' s = Yield '\x13b1' (CC s '\x0000' '\x0000')
592−-- CHEROKEE SMALL LETTER HV
593−foldMapping '\xab82' s = Yield '\x13b2' (CC s '\x0000' '\x0000')
594−-- CHEROKEE SMALL LETTER LA
595−foldMapping '\xab83' s = Yield '\x13b3' (CC s '\x0000' '\x0000')
596−-- CHEROKEE SMALL LETTER LE
597−foldMapping '\xab84' s = Yield '\x13b4' (CC s '\x0000' '\x0000')
598−-- CHEROKEE SMALL LETTER LI
599−foldMapping '\xab85' s = Yield '\x13b5' (CC s '\x0000' '\x0000')
600−-- CHEROKEE SMALL LETTER LO
601−foldMapping '\xab86' s = Yield '\x13b6' (CC s '\x0000' '\x0000')
602−-- CHEROKEE SMALL LETTER LU
603−foldMapping '\xab87' s = Yield '\x13b7' (CC s '\x0000' '\x0000')
604−-- CHEROKEE SMALL LETTER LV
605−foldMapping '\xab88' s = Yield '\x13b8' (CC s '\x0000' '\x0000')
606−-- CHEROKEE SMALL LETTER MA
607−foldMapping '\xab89' s = Yield '\x13b9' (CC s '\x0000' '\x0000')
608−-- CHEROKEE SMALL LETTER ME
609−foldMapping '\xab8a' s = Yield '\x13ba' (CC s '\x0000' '\x0000')
610−-- CHEROKEE SMALL LETTER MI
611−foldMapping '\xab8b' s = Yield '\x13bb' (CC s '\x0000' '\x0000')
612−-- CHEROKEE SMALL LETTER MO
613−foldMapping '\xab8c' s = Yield '\x13bc' (CC s '\x0000' '\x0000')
614−-- CHEROKEE SMALL LETTER MU
615−foldMapping '\xab8d' s = Yield '\x13bd' (CC s '\x0000' '\x0000')
616−-- CHEROKEE SMALL LETTER NA
617−foldMapping '\xab8e' s = Yield '\x13be' (CC s '\x0000' '\x0000')
618−-- CHEROKEE SMALL LETTER HNA
619−foldMapping '\xab8f' s = Yield '\x13bf' (CC s '\x0000' '\x0000')
620−-- CHEROKEE SMALL LETTER NAH
621−foldMapping '\xab90' s = Yield '\x13c0' (CC s '\x0000' '\x0000')
622−-- CHEROKEE SMALL LETTER NE
623−foldMapping '\xab91' s = Yield '\x13c1' (CC s '\x0000' '\x0000')
624−-- CHEROKEE SMALL LETTER NI
625−foldMapping '\xab92' s = Yield '\x13c2' (CC s '\x0000' '\x0000')
626−-- CHEROKEE SMALL LETTER NO
627−foldMapping '\xab93' s = Yield '\x13c3' (CC s '\x0000' '\x0000')
628−-- CHEROKEE SMALL LETTER NU
629−foldMapping '\xab94' s = Yield '\x13c4' (CC s '\x0000' '\x0000')
630−-- CHEROKEE SMALL LETTER NV
631−foldMapping '\xab95' s = Yield '\x13c5' (CC s '\x0000' '\x0000')
632−-- CHEROKEE SMALL LETTER QUA
633−foldMapping '\xab96' s = Yield '\x13c6' (CC s '\x0000' '\x0000')
634−-- CHEROKEE SMALL LETTER QUE
635−foldMapping '\xab97' s = Yield '\x13c7' (CC s '\x0000' '\x0000')
636−-- CHEROKEE SMALL LETTER QUI
637−foldMapping '\xab98' s = Yield '\x13c8' (CC s '\x0000' '\x0000')
638−-- CHEROKEE SMALL LETTER QUO
639−foldMapping '\xab99' s = Yield '\x13c9' (CC s '\x0000' '\x0000')
640−-- CHEROKEE SMALL LETTER QUU
641−foldMapping '\xab9a' s = Yield '\x13ca' (CC s '\x0000' '\x0000')
642−-- CHEROKEE SMALL LETTER QUV
643−foldMapping '\xab9b' s = Yield '\x13cb' (CC s '\x0000' '\x0000')
644−-- CHEROKEE SMALL LETTER SA
645−foldMapping '\xab9c' s = Yield '\x13cc' (CC s '\x0000' '\x0000')
646−-- CHEROKEE SMALL LETTER S
647−foldMapping '\xab9d' s = Yield '\x13cd' (CC s '\x0000' '\x0000')
648−-- CHEROKEE SMALL LETTER SE
649−foldMapping '\xab9e' s = Yield '\x13ce' (CC s '\x0000' '\x0000')
650−-- CHEROKEE SMALL LETTER SI
651−foldMapping '\xab9f' s = Yield '\x13cf' (CC s '\x0000' '\x0000')
652−-- CHEROKEE SMALL LETTER SO
653−foldMapping '\xaba0' s = Yield '\x13d0' (CC s '\x0000' '\x0000')
654−-- CHEROKEE SMALL LETTER SU
655−foldMapping '\xaba1' s = Yield '\x13d1' (CC s '\x0000' '\x0000')
656−-- CHEROKEE SMALL LETTER SV
657−foldMapping '\xaba2' s = Yield '\x13d2' (CC s '\x0000' '\x0000')
658−-- CHEROKEE SMALL LETTER DA
659−foldMapping '\xaba3' s = Yield '\x13d3' (CC s '\x0000' '\x0000')
660−-- CHEROKEE SMALL LETTER TA
661−foldMapping '\xaba4' s = Yield '\x13d4' (CC s '\x0000' '\x0000')
662−-- CHEROKEE SMALL LETTER DE
663−foldMapping '\xaba5' s = Yield '\x13d5' (CC s '\x0000' '\x0000')
664−-- CHEROKEE SMALL LETTER TE
665−foldMapping '\xaba6' s = Yield '\x13d6' (CC s '\x0000' '\x0000')
666−-- CHEROKEE SMALL LETTER DI
667−foldMapping '\xaba7' s = Yield '\x13d7' (CC s '\x0000' '\x0000')
668−-- CHEROKEE SMALL LETTER TI
669−foldMapping '\xaba8' s = Yield '\x13d8' (CC s '\x0000' '\x0000')
670−-- CHEROKEE SMALL LETTER DO
671−foldMapping '\xaba9' s = Yield '\x13d9' (CC s '\x0000' '\x0000')
672−-- CHEROKEE SMALL LETTER DU
673−foldMapping '\xabaa' s = Yield '\x13da' (CC s '\x0000' '\x0000')
674−-- CHEROKEE SMALL LETTER DV
675−foldMapping '\xabab' s = Yield '\x13db' (CC s '\x0000' '\x0000')
676−-- CHEROKEE SMALL LETTER DLA
677−foldMapping '\xabac' s = Yield '\x13dc' (CC s '\x0000' '\x0000')
678−-- CHEROKEE SMALL LETTER TLA
679−foldMapping '\xabad' s = Yield '\x13dd' (CC s '\x0000' '\x0000')
680−-- CHEROKEE SMALL LETTER TLE
681−foldMapping '\xabae' s = Yield '\x13de' (CC s '\x0000' '\x0000')
682−-- CHEROKEE SMALL LETTER TLI
683−foldMapping '\xabaf' s = Yield '\x13df' (CC s '\x0000' '\x0000')
684−-- CHEROKEE SMALL LETTER TLO
685−foldMapping '\xabb0' s = Yield '\x13e0' (CC s '\x0000' '\x0000')
686−-- CHEROKEE SMALL LETTER TLU
687−foldMapping '\xabb1' s = Yield '\x13e1' (CC s '\x0000' '\x0000')
688−-- CHEROKEE SMALL LETTER TLV
689−foldMapping '\xabb2' s = Yield '\x13e2' (CC s '\x0000' '\x0000')
690−-- CHEROKEE SMALL LETTER TSA
691−foldMapping '\xabb3' s = Yield '\x13e3' (CC s '\x0000' '\x0000')
692−-- CHEROKEE SMALL LETTER TSE
693−foldMapping '\xabb4' s = Yield '\x13e4' (CC s '\x0000' '\x0000')
694−-- CHEROKEE SMALL LETTER TSI
695−foldMapping '\xabb5' s = Yield '\x13e5' (CC s '\x0000' '\x0000')
696−-- CHEROKEE SMALL LETTER TSO
697−foldMapping '\xabb6' s = Yield '\x13e6' (CC s '\x0000' '\x0000')
698−-- CHEROKEE SMALL LETTER TSU
699−foldMapping '\xabb7' s = Yield '\x13e7' (CC s '\x0000' '\x0000')
700−-- CHEROKEE SMALL LETTER TSV
701−foldMapping '\xabb8' s = Yield '\x13e8' (CC s '\x0000' '\x0000')
702−-- CHEROKEE SMALL LETTER WA
703−foldMapping '\xabb9' s = Yield '\x13e9' (CC s '\x0000' '\x0000')
704−-- CHEROKEE SMALL LETTER WE
705−foldMapping '\xabba' s = Yield '\x13ea' (CC s '\x0000' '\x0000')
706−-- CHEROKEE SMALL LETTER WI
707−foldMapping '\xabbb' s = Yield '\x13eb' (CC s '\x0000' '\x0000')
708−-- CHEROKEE SMALL LETTER WO
709−foldMapping '\xabbc' s = Yield '\x13ec' (CC s '\x0000' '\x0000')
710−-- CHEROKEE SMALL LETTER WU
711−foldMapping '\xabbd' s = Yield '\x13ed' (CC s '\x0000' '\x0000')
712−-- CHEROKEE SMALL LETTER WV
713−foldMapping '\xabbe' s = Yield '\x13ee' (CC s '\x0000' '\x0000')
714−-- CHEROKEE SMALL LETTER YA
715−foldMapping '\xabbf' s = Yield '\x13ef' (CC s '\x0000' '\x0000')
716-- LATIN SMALL LIGATURE FF
432-- LATIN SMALL LIGATURE FF
717foldMapping '\xfb00' s = Yield '\x0066' (CC s '\x0066' '\x0000')
433foldMapping '\xfb00' s = Yield '\x0066' (CC s '\x0066' '\x0000')
718-- LATIN SMALL LIGATURE FI
434-- LATIN SMALL LIGATURE FI
@@ -737,106 +453,4 @@ foldMapping '\xfb15' s = Yield '\x0574' (CC s '\x056b' '\x0000')
737foldMapping '\xfb16' s = Yield '\x057e' (CC s '\x0576' '\x0000')
453foldMapping '\xfb16' s = Yield '\x057e' (CC s '\x0576' '\x0000')
738-- ARMENIAN SMALL LIGATURE MEN XEH
454-- ARMENIAN SMALL LIGATURE MEN XEH
739foldMapping '\xfb17' s = Yield '\x0574' (CC s '\x056d' '\x0000')
455foldMapping '\xfb17' s = Yield '\x0574' (CC s '\x056d' '\x0000')
740−-- OLD HUNGARIAN CAPITAL LETTER A
741−foldMapping '\x10c80' s = Yield '\x10cc0' (CC s '\x0000' '\x0000')
742−-- OLD HUNGARIAN CAPITAL LETTER AA
743−foldMapping '\x10c81' s = Yield '\x10cc1' (CC s '\x0000' '\x0000')
744−-- OLD HUNGARIAN CAPITAL LETTER EB
745−foldMapping '\x10c82' s = Yield '\x10cc2' (CC s '\x0000' '\x0000')
746−-- OLD HUNGARIAN CAPITAL LETTER AMB
747−foldMapping '\x10c83' s = Yield '\x10cc3' (CC s '\x0000' '\x0000')
748−-- OLD HUNGARIAN CAPITAL LETTER EC
749−foldMapping '\x10c84' s = Yield '\x10cc4' (CC s '\x0000' '\x0000')
750−-- OLD HUNGARIAN CAPITAL LETTER ENC
751−foldMapping '\x10c85' s = Yield '\x10cc5' (CC s '\x0000' '\x0000')
752−-- OLD HUNGARIAN CAPITAL LETTER ECS
753−foldMapping '\x10c86' s = Yield '\x10cc6' (CC s '\x0000' '\x0000')
754−-- OLD HUNGARIAN CAPITAL LETTER ED
755−foldMapping '\x10c87' s = Yield '\x10cc7' (CC s '\x0000' '\x0000')
756−-- OLD HUNGARIAN CAPITAL LETTER AND
757−foldMapping '\x10c88' s = Yield '\x10cc8' (CC s '\x0000' '\x0000')
758−-- OLD HUNGARIAN CAPITAL LETTER E
759−foldMapping '\x10c89' s = Yield '\x10cc9' (CC s '\x0000' '\x0000')
760−-- OLD HUNGARIAN CAPITAL LETTER CLOSE E
761−foldMapping '\x10c8a' s = Yield '\x10cca' (CC s '\x0000' '\x0000')
762−-- OLD HUNGARIAN CAPITAL LETTER EE
763−foldMapping '\x10c8b' s = Yield '\x10ccb' (CC s '\x0000' '\x0000')
764−-- OLD HUNGARIAN CAPITAL LETTER EF
765−foldMapping '\x10c8c' s = Yield '\x10ccc' (CC s '\x0000' '\x0000')
766−-- OLD HUNGARIAN CAPITAL LETTER EG
767−foldMapping '\x10c8d' s = Yield '\x10ccd' (CC s '\x0000' '\x0000')
768−-- OLD HUNGARIAN CAPITAL LETTER EGY
769−foldMapping '\x10c8e' s = Yield '\x10cce' (CC s '\x0000' '\x0000')
770−-- OLD HUNGARIAN CAPITAL LETTER EH
771−foldMapping '\x10c8f' s = Yield '\x10ccf' (CC s '\x0000' '\x0000')
772−-- OLD HUNGARIAN CAPITAL LETTER I
773−foldMapping '\x10c90' s = Yield '\x10cd0' (CC s '\x0000' '\x0000')
774−-- OLD HUNGARIAN CAPITAL LETTER II
775−foldMapping '\x10c91' s = Yield '\x10cd1' (CC s '\x0000' '\x0000')
776−-- OLD HUNGARIAN CAPITAL LETTER EJ
777−foldMapping '\x10c92' s = Yield '\x10cd2' (CC s '\x0000' '\x0000')
778−-- OLD HUNGARIAN CAPITAL LETTER EK
779−foldMapping '\x10c93' s = Yield '\x10cd3' (CC s '\x0000' '\x0000')
780−-- OLD HUNGARIAN CAPITAL LETTER AK
781−foldMapping '\x10c94' s = Yield '\x10cd4' (CC s '\x0000' '\x0000')
782−-- OLD HUNGARIAN CAPITAL LETTER UNK
783−foldMapping '\x10c95' s = Yield '\x10cd5' (CC s '\x0000' '\x0000')
784−-- OLD HUNGARIAN CAPITAL LETTER EL
785−foldMapping '\x10c96' s = Yield '\x10cd6' (CC s '\x0000' '\x0000')
786−-- OLD HUNGARIAN CAPITAL LETTER ELY
787−foldMapping '\x10c97' s = Yield '\x10cd7' (CC s '\x0000' '\x0000')
788−-- OLD HUNGARIAN CAPITAL LETTER EM
789−foldMapping '\x10c98' s = Yield '\x10cd8' (CC s '\x0000' '\x0000')
790−-- OLD HUNGARIAN CAPITAL LETTER EN
791−foldMapping '\x10c99' s = Yield '\x10cd9' (CC s '\x0000' '\x0000')
792−-- OLD HUNGARIAN CAPITAL LETTER ENY
793−foldMapping '\x10c9a' s = Yield '\x10cda' (CC s '\x0000' '\x0000')
794−-- OLD HUNGARIAN CAPITAL LETTER O
795−foldMapping '\x10c9b' s = Yield '\x10cdb' (CC s '\x0000' '\x0000')
796−-- OLD HUNGARIAN CAPITAL LETTER OO
797−foldMapping '\x10c9c' s = Yield '\x10cdc' (CC s '\x0000' '\x0000')
798−-- OLD HUNGARIAN CAPITAL LETTER NIKOLSBURG OE
799−foldMapping '\x10c9d' s = Yield '\x10cdd' (CC s '\x0000' '\x0000')
800−-- OLD HUNGARIAN CAPITAL LETTER RUDIMENTA OE
801−foldMapping '\x10c9e' s = Yield '\x10cde' (CC s '\x0000' '\x0000')
802−-- OLD HUNGARIAN CAPITAL LETTER OEE
803−foldMapping '\x10c9f' s = Yield '\x10cdf' (CC s '\x0000' '\x0000')
804−-- OLD HUNGARIAN CAPITAL LETTER EP
805−foldMapping '\x10ca0' s = Yield '\x10ce0' (CC s '\x0000' '\x0000')
806−-- OLD HUNGARIAN CAPITAL LETTER EMP
807−foldMapping '\x10ca1' s = Yield '\x10ce1' (CC s '\x0000' '\x0000')
808−-- OLD HUNGARIAN CAPITAL LETTER ER
809−foldMapping '\x10ca2' s = Yield '\x10ce2' (CC s '\x0000' '\x0000')
810−-- OLD HUNGARIAN CAPITAL LETTER SHORT ER
811−foldMapping '\x10ca3' s = Yield '\x10ce3' (CC s '\x0000' '\x0000')
812−-- OLD HUNGARIAN CAPITAL LETTER ES
813−foldMapping '\x10ca4' s = Yield '\x10ce4' (CC s '\x0000' '\x0000')
814−-- OLD HUNGARIAN CAPITAL LETTER ESZ
815−foldMapping '\x10ca5' s = Yield '\x10ce5' (CC s '\x0000' '\x0000')
816−-- OLD HUNGARIAN CAPITAL LETTER ET
817−foldMapping '\x10ca6' s = Yield '\x10ce6' (CC s '\x0000' '\x0000')
818−-- OLD HUNGARIAN CAPITAL LETTER ENT
819−foldMapping '\x10ca7' s = Yield '\x10ce7' (CC s '\x0000' '\x0000')
820−-- OLD HUNGARIAN CAPITAL LETTER ETY
821−foldMapping '\x10ca8' s = Yield '\x10ce8' (CC s '\x0000' '\x0000')
822−-- OLD HUNGARIAN CAPITAL LETTER ECH
823−foldMapping '\x10ca9' s = Yield '\x10ce9' (CC s '\x0000' '\x0000')
824−-- OLD HUNGARIAN CAPITAL LETTER U
825−foldMapping '\x10caa' s = Yield '\x10cea' (CC s '\x0000' '\x0000')
826−-- OLD HUNGARIAN CAPITAL LETTER UU
827−foldMapping '\x10cab' s = Yield '\x10ceb' (CC s '\x0000' '\x0000')
828−-- OLD HUNGARIAN CAPITAL LETTER NIKOLSBURG UE
829−foldMapping '\x10cac' s = Yield '\x10cec' (CC s '\x0000' '\x0000')
830−-- OLD HUNGARIAN CAPITAL LETTER RUDIMENTA UE
831−foldMapping '\x10cad' s = Yield '\x10ced' (CC s '\x0000' '\x0000')
832−-- OLD HUNGARIAN CAPITAL LETTER EV
833−foldMapping '\x10cae' s = Yield '\x10cee' (CC s '\x0000' '\x0000')
834−-- OLD HUNGARIAN CAPITAL LETTER EZ
835−foldMapping '\x10caf' s = Yield '\x10cef' (CC s '\x0000' '\x0000')
836−-- OLD HUNGARIAN CAPITAL LETTER EZS
837−foldMapping '\x10cb0' s = Yield '\x10cf0' (CC s '\x0000' '\x0000')
838−-- OLD HUNGARIAN CAPITAL LETTER ENT-SHAPED SIGN
839−foldMapping '\x10cb1' s = Yield '\x10cf1' (CC s '\x0000' '\x0000')
840−-- OLD HUNGARIAN CAPITAL LETTER US
841−foldMapping '\x10cb2' s = Yield '\x10cf2' (CC s '\x0000' '\x0000')
842foldMapping c s = Yield (toLower c) (CC s '\0' '\0')
456foldMapping c s = Yield (toLower c) (CC s '\0' '\0')
Data/Text/Internal/Fusion/Common.hs → Data/Text/Fusion/Common.hsrenamed+89−153
@@ -1,26 +1,22 @@
1−{-# LANGUAGE BangPatterns, MagicHash, Rank2Types #-}
1+{-# LANGUAGE BangPatterns, Rank2Types #-}
2-- |
2-- |
3−-- Module : Data.Text.Internal.Fusion.Common
3+-- Module : Data.Text.Fusion.Common
4−-- Copyright : (c) Bryan O'Sullivan 2009, 2012
4+-- Copyright : (c) Bryan O'Sullivan 2009
5--
5--
6-- License : BSD-style
6-- License : BSD-style
7−-- Maintainer : bos@serpentine.com
7+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
8+-- duncan@haskell.org
8-- Stability : experimental
9-- Stability : experimental
9-- Portability : GHC
10-- Portability : GHC
10--
11--
11−-- /Warning/: this is an internal module, and does not have a stable
12−-- API or name. Functions in this module may not check or enforce
13−-- preconditions expected by public modules. Use at your own risk!
14−--
15-- Common stream fusion functionality for text.
12-- Common stream fusion functionality for text.
16
13
17−module Data.Text.Internal.Fusion.Common
14+module Data.Text.Fusion.Common
18 (
15 (
19 -- * Creation and elimination
16 -- * Creation and elimination
20 singleton
17 singleton
21 , streamList
18 , streamList
22 , unstreamList
19 , unstreamList
23− , streamCString#
24
20
25 -- * Basic interface
21 -- * Basic interface
26 , cons
22 , cons
@@ -45,7 +41,6 @@ module Data.Text.Internal.Fusion.Common
45 -- $case
41 -- $case
46 , toCaseFold
42 , toCaseFold
47 , toLower
43 , toLower
48− , toTitle
49 , toUpper
44 , toUpper
50
45
51 -- ** Justification
46 -- ** Justification
@@ -71,6 +66,9 @@ module Data.Text.Internal.Fusion.Common
71 -- ** Scans
66 -- ** Scans
72 , scanl
67 , scanl
73
68
69+ -- ** Accumulating maps
70+ -- , mapAccumL
71+
74 -- ** Generation and unfolding
72 -- ** Generation and unfolding
75 , replicateCharI
73 , replicateCharI
76 , replicateI
74 , replicateI
@@ -106,21 +104,16 @@ import Prelude (Bool(..), Char, Eq(..), Int, Integral, Maybe(..),
106 (&&), fromIntegral, otherwise)
104 (&&), fromIntegral, otherwise)
107import qualified Data.List as L
105import qualified Data.List as L
108import qualified Prelude as P
106import qualified Prelude as P
109−import Data.Bits (shiftL)
110−import Data.Char (isLetter)
111import Data.Int (Int64)
107import Data.Int (Int64)
112−import Data.Text.Internal.Fusion.Types
108+import Data.Text.Fusion.Internal
113−import Data.Text.Internal.Fusion.CaseMapping (foldMapping, lowerMapping, titleMapping,
109+import Data.Text.Fusion.CaseMapping (foldMapping, lowerMapping, upperMapping)
114− upperMapping)
115−import Data.Text.Internal.Fusion.Size
110+import Data.Text.Fusion.Size
116−import GHC.Prim (Addr#, chr#, indexCharOffAddr#, ord#)
117−import GHC.Types (Char(..), Int(..))
118
111
119singleton :: Char -> Stream Char
112singleton :: Char -> Stream Char
120singleton c = Stream next False 1
113singleton c = Stream next False 1
121 where next False = Yield c True
114 where next False = Yield c True
122 next True = Done
115 next True = Done
123−{-# INLINE [0] singleton #-}
116+{-# INLINE singleton #-}
124
117
125streamList :: [a] -> Stream a
118streamList :: [a] -> Stream a
126{-# INLINE [0] streamList #-}
119{-# INLINE [0] streamList #-}
@@ -138,35 +131,6 @@ unstreamList (Stream next s0 _len) = unfold s0
138
131
139{-# RULES "STREAM streamList/unstreamList fusion" forall s. streamList (unstreamList s) = s #-}
132{-# RULES "STREAM streamList/unstreamList fusion" forall s. streamList (unstreamList s) = s #-}
140
133
141−-- | Stream the UTF-8-like packed encoding used by GHC to represent
142−-- constant strings in generated code.
143−--
144−-- This encoding uses the byte sequence "\xc0\x80" to represent NUL,
145−-- and the string is NUL-terminated.
146−streamCString# :: Addr# -> Stream Char
147−streamCString# addr = Stream step 0 unknownSize
148− where
149− step !i
150− | b == 0 = Done
151− | b <= 0x7f = Yield (C# b#) (i+1)
152− | b <= 0xdf = let !c = chr $ ((b-0xc0) `shiftL` 6) + next 1
153− in Yield c (i+2)
154− | b <= 0xef = let !c = chr $ ((b-0xe0) `shiftL` 12) +
155− (next 1 `shiftL` 6) +
156− next 2
157− in Yield c (i+3)
158− | otherwise = let !c = chr $ ((b-0xf0) `shiftL` 18) +
159− (next 1 `shiftL` 12) +
160− (next 2 `shiftL` 6) +
161− next 3
162− in Yield c (i+4)
163− where b = I# (ord# b#)
164− next n = I# (ord# (at# (i+n))) - 0x80
165− !b# = at# i
166− at# (I# i#) = indexCharOffAddr# addr i#
167− chr (I# i#) = C# (chr# i#)
168−{-# INLINE [0] streamCString# #-}
169−
170-- ----------------------------------------------------------------------------
134-- ----------------------------------------------------------------------------
171-- * Basic stream functions
135-- * Basic stream functions
172
136
@@ -175,7 +139,7 @@ data C s = C0 !s
175
139
176-- | /O(n)/ Adds a character to the front of a Stream Char.
140-- | /O(n)/ Adds a character to the front of a Stream Char.
177cons :: Char -> Stream Char -> Stream Char
141cons :: Char -> Stream Char -> Stream Char
178−cons !w (Stream next0 s0 len) = Stream next (C1 s0) (len+1)
142+cons w (Stream next0 s0 len) = Stream next (C1 s0) (len+1)
179 where
143 where
180 next (C1 s) = Yield w (C0 s)
144 next (C1 s) = Yield w (C0 s)
181 next (C0 s) = case next0 s of
145 next (C0 s) = case next0 s of
@@ -184,9 +148,6 @@ cons !w (Stream next0 s0 len) = Stream next (C1 s0) (len+1)
184 Yield x s' -> Yield x (C0 s')
148 Yield x s' -> Yield x (C0 s')
185{-# INLINE [0] cons #-}
149{-# INLINE [0] cons #-}
186
150
187−data Snoc a = N
188− | J !a
189−
190-- | /O(n)/ Adds a character to the end of a stream.
151-- | /O(n)/ Adds a character to the end of a stream.
191snoc :: Stream Char -> Char -> Stream Char
152snoc :: Stream Char -> Char -> Stream Char
192snoc (Stream next0 xs0 len) w = Stream next (J xs0) (len+1)
153snoc (Stream next0 xs0 len) w = Stream next (J xs0) (len+1)
@@ -224,13 +185,9 @@ head (Stream next s0 _len) = loop_head s0
224 loop_head !s = case next s of
185 loop_head !s = case next s of
225 Yield x _ -> x
186 Yield x _ -> x
226 Skip s' -> loop_head s'
187 Skip s' -> loop_head s'
227− Done -> head_empty
188+ Done -> streamError "head" "Empty stream"
228{-# INLINE [0] head #-}
189{-# INLINE [0] head #-}
229
190
230−head_empty :: a
231−head_empty = streamError "head" "Empty stream"
232−{-# NOINLINE head_empty #-}
233−
234-- | /O(1)/ Returns the first character and remainder of a 'Stream
191-- | /O(1)/ Returns the first character and remainder of a 'Stream
235-- Char', or 'Nothing' if empty. Subject to array fusion.
192-- Char', or 'Nothing' if empty. Subject to array fusion.
236uncons :: Stream Char -> Maybe (Char, Stream Char)
193uncons :: Stream Char -> Maybe (Char, Stream Char)
@@ -315,13 +272,12 @@ lengthI (Stream next s0 _len) = loop_length 0 s0
315--
272--
316-- This function gives the same answer as comparing against the result
273-- This function gives the same answer as comparing against the result
317-- of 'lengthI', but can short circuit if the count of characters is
274-- of 'lengthI', but can short circuit if the count of characters is
318−-- greater than the number or if the stream can't possibly be as long
319−-- as the number supplied, and hence be more efficient.
275+-- greater than the number, and hence be more efficient.
320compareLengthI :: Integral a => Stream Char -> a -> Ordering
276compareLengthI :: Integral a => Stream Char -> a -> Ordering
321−compareLengthI (Stream next s0 len) n =
277+compareLengthI (Stream next s0 len) n =
322− case compareSize len (fromIntegral n) of
278+ case exactly len of
323− Just o -> o
324 Nothing -> loop_cmp 0 s0
279 Nothing -> loop_cmp 0 s0
280+ Just i -> compare (fromIntegral i) n
325 where
281 where
326 loop_cmp !z s = case next s of
282 loop_cmp !z s = case next s of
327 Done -> compare z n
283 Done -> compare z n
@@ -439,54 +395,17 @@ toLower :: Stream Char -> Stream Char
439toLower = caseConvert lowerMapping
395toLower = caseConvert lowerMapping
440{-# INLINE [0] toLower #-}
396{-# INLINE [0] toLower #-}
441
397
442−-- | /O(n)/ Convert a string to title case, using simple case
443−-- conversion.
444−--
445−-- The first letter of the input is converted to title case, as is
446−-- every subsequent letter that immediately follows a non-letter.
447−-- Every letter that immediately follows another letter is converted
448−-- to lower case.
449−--
450−-- The result string may be longer than the input string. For example,
451−-- the Latin small ligature &#xfb02; (U+FB02) is converted to the
452−-- sequence Latin capital letter F (U+0046) followed by Latin small
453−-- letter l (U+006C).
454−--
455−-- /Note/: this function does not take language or culture specific
456−-- rules into account. For instance, in English, different style
457−-- guides disagree on whether the book name \"The Hill of the Red
458−-- Fox\" is correctly title cased&#x2014;but this function will
459−-- capitalize /every/ word.
460−toTitle :: Stream Char -> Stream Char
461−toTitle (Stream next0 s0 len) = Stream next (CC (False :*: s0) '\0' '\0') len
462− where
463− next (CC (letter :*: s) '\0' _) =
464− case next0 s of
465− Done -> Done
466− Skip s' -> Skip (CC (letter :*: s') '\0' '\0')
467− Yield c s'
468− | letter' -> if letter
469− then lowerMapping c (letter' :*: s')
470− else titleMapping c (letter' :*: s')
471− | otherwise -> Yield c (CC (letter' :*: s') '\0' '\0')
472− where letter' = isLetter c
473− next (CC s a b) = Yield a (CC s b '\0')
474−{-# INLINE [0] toTitle #-}
475−
476−data Justify i s = Just1 !i !s
477− | Just2 !i !s
478−
479justifyLeftI :: Integral a => a -> Char -> Stream Char -> Stream Char
398justifyLeftI :: Integral a => a -> Char -> Stream Char -> Stream Char
480justifyLeftI k c (Stream next0 s0 len) =
399justifyLeftI k c (Stream next0 s0 len) =
481− Stream next (Just1 0 s0) (larger (fromIntegral k) len)
400+ Stream next (s0 :*: S1 :*: 0) (larger (fromIntegral k) len)
482 where
401 where
483− next (Just1 n s) =
402+ next (s :*: S1 :*: n) =
484 case next0 s of
403 case next0 s of
485− Done -> next (Just2 n s)
404+ Done -> next (s :*: S2 :*: n)
486− Skip s' -> Skip (Just1 n s')
405+ Skip s' -> Skip (s' :*: S1 :*: n)
487− Yield x s' -> Yield x (Just1 (n+1) s')
406+ Yield x s' -> Yield x (s' :*: S1 :*: n+1)
488− next (Just2 n s)
407+ next (s :*: S2 :*: n)
489− | n < k = Yield c (Just2 (n+1) s)
408+ | n < k = Yield c (s :*: S2 :*: n+1)
490 | otherwise = Done
409 | otherwise = Done
491 {-# INLINE next #-}
410 {-# INLINE next #-}
492{-# INLINE [0] justifyLeftI #-}
411{-# INLINE [0] justifyLeftI #-}
@@ -593,7 +512,7 @@ concatMap f = foldr (append . f) empty
593{-# INLINE [0] concatMap #-}
512{-# INLINE [0] concatMap #-}
594
513
595-- | /O(n)/ any @p @xs determines if any character in the stream
514-- | /O(n)/ any @p @xs determines if any character in the stream
596−-- @xs@ satisfies the predicate @p@.
515+-- @xs@ satisifes the predicate @p@.
597any :: (Char -> Bool) -> Stream Char -> Bool
516any :: (Char -> Bool) -> Stream Char -> Bool
598any p (Stream next0 s0 _len) = loop_any s0
517any p (Stream next0 s0 _len) = loop_any s0
599 where
518 where
@@ -605,7 +524,7 @@ any p (Stream next0 s0 _len) = loop_any s0
605{-# INLINE [0] any #-}
524{-# INLINE [0] any #-}
606
525
607-- | /O(n)/ all @p @xs determines if all characters in the 'Text'
526-- | /O(n)/ all @p @xs determines if all characters in the 'Text'
608−-- @xs@ satisfy the predicate @p@.
527+-- @xs@ satisify the predicate @p@.
609all :: (Char -> Bool) -> Stream Char -> Bool
528all :: (Char -> Bool) -> Stream Char -> Bool
610all p (Stream next0 s0 _len) = loop_all s0
529all p (Stream next0 s0 _len) = loop_all s0
611 where
530 where
@@ -654,27 +573,50 @@ minimum (Stream next0 s0 _len) = loop0_minimum s0
654-- * Building streams
573-- * Building streams
655
574
656scanl :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char
575scanl :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char
657−scanl f z0 (Stream next0 s0 len) = Stream next (Scan1 z0 s0) (len+1) -- HINT maybe too low
576+scanl f z0 (Stream next0 s0 len) = Stream next (S1 :*: z0 :*: s0) (len+1) -- HINT maybe too low
658 where
577 where
659 {-# INLINE next #-}
578 {-# INLINE next #-}
660− next (Scan1 z s) = Yield z (Scan2 z s)
579+ next (S1 :*: z :*: s) = Yield z (S2 :*: z :*: s)
661− next (Scan2 z s) = case next0 s of
580+ next (S2 :*: z :*: s) = case next0 s of
662− Yield x s' -> let !x' = f z x
581+ Yield x s' -> let !x' = f z x
663− in Yield x' (Scan2 x' s')
582+ in Yield x' (S2 :*: x' :*: s')
664− Skip s' -> Skip (Scan2 z s')
583+ Skip s' -> Skip (S2 :*: z :*: s')
665− Done -> Done
584+ Done -> Done
666{-# INLINE [0] scanl #-}
585{-# INLINE [0] scanl #-}
667
586
587+-- -----------------------------------------------------------------------------
588+-- ** Accumulating maps
589+
590+{-
591+-- | /O(n)/ Like a combination of 'map' and 'foldl'. Applies a
592+-- function to each element of a stream, passing an accumulating
593+-- parameter from left to right, and returns a final stream.
594+--
595+-- /Note/: Unlike the version over lists, this function does not
596+-- return a final value for the accumulator, because the nature of
597+-- streams precludes it.
598+mapAccumL :: (a -> b -> (a,b)) -> a -> Stream b -> Stream b
599+mapAccumL f z0 (Stream next0 s0 len) = Stream next (s0 :*: z0) len -- HINT depends on f
600+ where
601+ {-# INLINE next #-}
602+ next (s :*: z) = case next0 s of
603+ Yield x s' -> let (z',y) = f z x
604+ in Yield y (s' :*: z')
605+ Skip s' -> Skip (s' :*: z)
606+ Done -> Done
607+{-# INLINE [0] mapAccumL #-}
608+-}
609+
668-- -----------------------------------------------------------------------------
610-- -----------------------------------------------------------------------------
669-- ** Generating and unfolding streams
611-- ** Generating and unfolding streams
670
612
671replicateCharI :: Integral a => a -> Char -> Stream Char
613replicateCharI :: Integral a => a -> Char -> Stream Char
672−replicateCharI !n !c
614+replicateCharI n c
673 | n < 0 = empty
615 | n < 0 = empty
674 | otherwise = Stream next 0 (fromIntegral n) -- HINT maybe too low
616 | otherwise = Stream next 0 (fromIntegral n) -- HINT maybe too low
675 where
617 where
676− next !i | i >= n = Done
618+ next i | i >= n = Done
677− | otherwise = Yield c (i + 1)
619+ | otherwise = Yield c (i + 1)
678{-# INLINE [0] replicateCharI #-}
620{-# INLINE [0] replicateCharI #-}
679
621
680data RI s = RI !s {-# UNPACK #-} !Int64
622data RI s = RI !s {-# UNPACK #-} !Int64
@@ -739,27 +681,24 @@ take n0 (Stream next0 s0 len) =
739 Yield x s' -> Yield x ((n-1) :*: s')
681 Yield x s' -> Yield x ((n-1) :*: s')
740{-# INLINE [0] take #-}
682{-# INLINE [0] take #-}
741
683
742−data Drop a s = NS !s
743− | JS !a !s
744−
745-- | /O(n)/ drop n, applied to a stream, returns the suffix of the
684-- | /O(n)/ drop n, applied to a stream, returns the suffix of the
746-- stream after the first @n@ characters, or the empty stream if @n@
685-- stream after the first @n@ characters, or the empty stream if @n@
747-- is greater than the length of the stream.
686-- is greater than the length of the stream.
748drop :: Integral a => a -> Stream Char -> Stream Char
687drop :: Integral a => a -> Stream Char -> Stream Char
749drop n0 (Stream next0 s0 len) =
688drop n0 (Stream next0 s0 len) =
750− Stream next (JS n0 s0) (len - fromIntegral (max 0 n0))
689+ Stream next (J n0 :*: s0) (len - fromIntegral (max 0 n0))
751 where
690 where
752 {-# INLINE next #-}
691 {-# INLINE next #-}
753− next (JS n s)
692+ next (J n :*: s)
754− | n <= 0 = Skip (NS s)
693+ | n <= 0 = Skip (N :*: s)
755 | otherwise = case next0 s of
694 | otherwise = case next0 s of
756 Done -> Done
695 Done -> Done
757− Skip s' -> Skip (JS n s')
696+ Skip s' -> Skip (J n :*: s')
758− Yield _ s' -> Skip (JS (n-1) s')
697+ Yield _ s' -> Skip (J (n-1) :*: s')
759− next (NS s) = case next0 s of
698+ next (N :*: s) = case next0 s of
760 Done -> Done
699 Done -> Done
761− Skip s' -> Skip (NS s')
700+ Skip s' -> Skip (N :*: s')
762− Yield x s' -> Yield x (NS s')
701+ Yield x s' -> Yield x (N :*: s')
763{-# INLINE [0] drop #-}
702{-# INLINE [0] drop #-}
764
703
765-- | takeWhile, applied to a predicate @p@ and a stream, returns the
704-- | takeWhile, applied to a predicate @p@ and a stream, returns the
@@ -777,18 +716,18 @@ takeWhile p (Stream next0 s0 len) = Stream next s0 len -- HINT maybe too high
777
716
778-- | dropWhile @p @xs returns the suffix remaining after takeWhile @p @xs.
717-- | dropWhile @p @xs returns the suffix remaining after takeWhile @p @xs.
779dropWhile :: (Char -> Bool) -> Stream Char -> Stream Char
718dropWhile :: (Char -> Bool) -> Stream Char -> Stream Char
780−dropWhile p (Stream next0 s0 len) = Stream next (L s0) len -- HINT maybe too high
719+dropWhile p (Stream next0 s0 len) = Stream next (S1 :*: s0) len -- HINT maybe too high
781 where
720 where
782 {-# INLINE next #-}
721 {-# INLINE next #-}
783− next (L s) = case next0 s of
722+ next (S1 :*: s) = case next0 s of
784 Done -> Done
723 Done -> Done
785− Skip s' -> Skip (L s')
724+ Skip s' -> Skip (S1 :*: s')
786− Yield x s' | p x -> Skip (L s')
725+ Yield x s' | p x -> Skip (S1 :*: s')
787− | otherwise -> Yield x (R s')
726+ | otherwise -> Yield x (S2 :*: s')
788− next (R s) = case next0 s of
727+ next (S2 :*: s) = case next0 s of
789 Done -> Done
728 Done -> Done
790− Skip s' -> Skip (R s')
729+ Skip s' -> Skip (S2 :*: s')
791− Yield x s' -> Yield x (R s')
730+ Yield x s' -> Yield x (S2 :*: s')
792{-# INLINE [0] dropWhile #-}
731{-# INLINE [0] dropWhile #-}
793
732
794-- | /O(n)/ The 'isPrefixOf' function takes two 'Stream's and returns
733-- | /O(n)/ The 'isPrefixOf' function takes two 'Stream's and returns
@@ -804,6 +743,7 @@ isPrefixOf (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)
804 loop (Yield x1 s1') (Yield x2 s2') = x1 == x2 &&
743 loop (Yield x1 s1') (Yield x2 s2') = x1 == x2 &&
805 loop (next1 s1') (next2 s2')
744 loop (next1 s1') (next2 s2')
806{-# INLINE [0] isPrefixOf #-}
745{-# INLINE [0] isPrefixOf #-}
746+{-# SPECIALISE isPrefixOf :: Stream Char -> Stream Char -> Bool #-}
807
747
808-- ----------------------------------------------------------------------------
748-- ----------------------------------------------------------------------------
809-- * Searching
749-- * Searching
@@ -895,25 +835,21 @@ findIndicesI p (Stream next s0 _len) = loop_findIndex 0 s0
895-------------------------------------------------------------------------------
835-------------------------------------------------------------------------------
896-- * Zipping
836-- * Zipping
897
837
898−-- | Strict triple.
899−data Zip a b m = Z1 !a !b
900− | Z2 !a !b !m
901−
902-- | zipWith generalises 'zip' by zipping with the function given as
838-- | zipWith generalises 'zip' by zipping with the function given as
903-- the first argument, instead of a tupling function.
839-- the first argument, instead of a tupling function.
904zipWith :: (a -> a -> b) -> Stream a -> Stream a -> Stream b
840zipWith :: (a -> a -> b) -> Stream a -> Stream a -> Stream b
905zipWith f (Stream next0 sa0 len1) (Stream next1 sb0 len2) =
841zipWith f (Stream next0 sa0 len1) (Stream next1 sb0 len2) =
906− Stream next (Z1 sa0 sb0) (smaller len1 len2)
842+ Stream next (sa0 :*: sb0 :*: N) (smaller len1 len2)
907 where
843 where
908− next (Z1 sa sb) = case next0 sa of
844+ next (sa :*: sb :*: N) = case next0 sa of
909− Done -> Done
845+ Done -> Done
910− Skip sa' -> Skip (Z1 sa' sb)
846+ Skip sa' -> Skip (sa' :*: sb :*: N)
911− Yield a sa' -> Skip (Z2 sa' sb a)
847+ Yield a sa' -> Skip (sa' :*: sb :*: J a)
912−
848+
913− next (Z2 sa' sb a) = case next1 sb of
849+ next (sa' :*: sb :*: J a) = case next1 sb of
914− Done -> Done
850+ Done -> Done
915− Skip sb' -> Skip (Z2 sa' sb' a)
851+ Skip sb' -> Skip (sa' :*: sb' :*: J a)
916− Yield b sb' -> Yield (f a b) (Z1 sa' sb')
852+ Yield b sb' -> Yield (f a b) (sa' :*: sb' :*: N)
917{-# INLINE [0] zipWith #-}
853{-# INLINE [0] zipWith #-}
918
854
919-- | /O(n)/ The 'countCharI' function returns the number of times the
855-- | /O(n)/ The 'countCharI' function returns the number of times the
@@ -929,7 +865,7 @@ countCharI a (Stream next s0 _len) = loop 0 s0
929{-# INLINE [0] countCharI #-}
865{-# INLINE [0] countCharI #-}
930
866
931streamError :: String -> String -> a
867streamError :: String -> String -> a
932−streamError func msg = P.error $ "Data.Text.Internal.Fusion.Common." ++ func ++ ": " ++ msg
868+streamError func msg = P.error $ "Data.Text.Fusion.Common." ++ func ++ ": " ++ msg
933
869
934emptyError :: String -> a
870emptyError :: String -> a
935emptyError func = internalError func "Empty input"
871emptyError func = internalError func "Empty input"
Data/Text/Internal/Fusion/Types.hs → Data/Text/Fusion/Internal.hsrenamed+23−24
@@ -1,56 +1,53 @@
1{-# LANGUAGE BangPatterns, ExistentialQuantification #-}
1{-# LANGUAGE BangPatterns, ExistentialQuantification #-}
2-- |
2-- |
3−-- Module : Data.Text.Internal.Fusion.Types
3+-- Module : Data.Text.Fusion.Internal
4-- Copyright : (c) Tom Harper 2008-2009,
4-- Copyright : (c) Tom Harper 2008-2009,
5-- (c) Bryan O'Sullivan 2009,
5-- (c) Bryan O'Sullivan 2009,
6−-- (c) Duncan Coutts 2009,
6+-- (c) Duncan Coutts 2009
7−-- (c) Jasper Van der Jeugt 2011
8--
7--
9-- License : BSD-style
8-- License : BSD-style
10−-- Maintainer : bos@serpentine.com
9+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
10+-- duncan@haskell.org
11-- Stability : experimental
11-- Stability : experimental
12-- Portability : GHC
12-- Portability : GHC
13--
13--
14−-- /Warning/: this is an internal module, and does not have a stable
15−-- API or name. Functions in this module may not check or enforce
16−-- preconditions expected by public modules. Use at your own risk!
17−--
18-- Core stream fusion functionality for text.
14-- Core stream fusion functionality for text.
19
15
20−module Data.Text.Internal.Fusion.Types
16+module Data.Text.Fusion.Internal
21 (
17 (
22 CC(..)
18 CC(..)
19+ , M(..)
20+ , M8
23 , PairS(..)
21 , PairS(..)
24− , Scan(..)
22+ , S(..)
25− , RS(..)
26 , Step(..)
23 , Step(..)
27 , Stream(..)
24 , Stream(..)
25+ , Switch(..)
28 , empty
26 , empty
29 ) where
27 ) where
30
28
31−import Data.Text.Internal.Fusion.Size
29+import Data.Text.Fusion.Size
32import Data.Word (Word8)
30import Data.Word (Word8)
33
31
34-- | Specialised tuple for case conversion.
32-- | Specialised tuple for case conversion.
35data CC s = CC !s {-# UNPACK #-} !Char {-# UNPACK #-} !Char
33data CC s = CC !s {-# UNPACK #-} !Char {-# UNPACK #-} !Char
36
34
35+-- | Specialised, strict Maybe-like type.
36+data M a = N
37+ | J !a
38+
39+type M8 = M Word8
40+
37−-- | Restreaming state.
41+-- Restreaming state.
38−data RS s
42+data S s = S !s !M8 !M8 !M8
39− = RS0 !s
40− | RS1 !s {-# UNPACK #-} !Word8
41− | RS2 !s {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8
42− | RS3 !s {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8
43
43
44−-- | Strict pair.
44+infixl 2 :*:
45data PairS a b = !a :*: !b
45data PairS a b = !a :*: !b
46 -- deriving (Eq, Ord, Show)
46 -- deriving (Eq, Ord, Show)
47−infixl 2 :*:
48
47
49−-- | An intermediate result in a scan.
48+-- | Allow a function over a stream to switch between two states.
50−data Scan s = Scan1 {-# UNPACK #-} !Char !s
49+data Switch = S1 | S2
51− | Scan2 {-# UNPACK #-} !Char !s
52
50
53−-- | Intermediate result in a processing pipeline.
54data Step s a = Done
51data Step s a = Done
55 | Skip !s
52 | Skip !s
56 | Yield !a !s
53 | Yield !a !s
@@ -99,6 +96,7 @@ eq (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)
99 loop (Yield x1 s1') (Yield x2 s2') = x1 == x2 &&
96 loop (Yield x1 s1') (Yield x2 s2') = x1 == x2 &&
100 loop (next1 s1') (next2 s2')
97 loop (next1 s1') (next2 s2')
101{-# INLINE [0] eq #-}
98{-# INLINE [0] eq #-}
99+{-# SPECIALISE eq :: Stream Char -> Stream Char -> Bool #-}
102
100
103cmp :: (Ord a) => Stream a -> Stream a -> Ordering
101cmp :: (Ord a) => Stream a -> Stream a -> Ordering
104cmp (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)
102cmp (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)
@@ -114,6 +112,7 @@ cmp (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)
114 EQ -> loop (next1 s1') (next2 s2')
112 EQ -> loop (next1 s1') (next2 s2')
115 other -> other
113 other -> other
116{-# INLINE [0] cmp #-}
114{-# INLINE [0] cmp #-}
115+{-# SPECIALISE cmp :: Stream Char -> Stream Char -> Ordering #-}
117
116
118-- | The empty stream.
117-- | The empty stream.
119empty :: Stream a
118empty :: Stream a
Data/Text/Fusion/Size.hsnew file+146
@@ -0,0 +1,146 @@
1+{-# LANGUAGE CPP #-}
2+{-# OPTIONS_GHC -fno-warn-missing-methods #-}
3+-- |
4+-- Module : Data.Text.Fusion.Internal
5+-- Copyright : (c) Roman Leshchinskiy 2008,
6+-- (c) Bryan O'Sullivan 2009
7+--
8+-- License : BSD-style
9+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
10+-- duncan@haskell.org
11+-- Stability : experimental
12+-- Portability : portable
13+--
14+-- Size hints.
15+
16+module Data.Text.Fusion.Size
17+ (
18+ Size
19+ , exactly
20+ , exactSize
21+ , maxSize
22+ , unknownSize
23+ , smaller
24+ , larger
25+ , upperBound
26+ , isEmpty
27+ ) where
28+
29+#if defined(ASSERTS)
30+import Control.Exception (assert)
31+#endif
32+
33+data Size = Exact {-# UNPACK #-} !Int -- ^ Exact size.
34+ | Max {-# UNPACK #-} !Int -- ^ Upper bound on size.
35+ | Unknown -- ^ Unknown size.
36+ deriving (Eq, Show)
37+
38+exactly :: Size -> Maybe Int
39+exactly (Exact n) = Just n
40+exactly _ = Nothing
41+{-# INLINE exactly #-}
42+
43+exactSize :: Int -> Size
44+exactSize n =
45+#if defined(ASSERTS)
46+ assert (n >= 0)
47+#endif
48+ Exact n
49+{-# INLINE exactSize #-}
50+
51+maxSize :: Int -> Size
52+maxSize n =
53+#if defined(ASSERTS)
54+ assert (n >= 0)
55+#endif
56+ Max n
57+{-# INLINE maxSize #-}
58+
59+unknownSize :: Size
60+unknownSize = Unknown
61+{-# INLINE unknownSize #-}
62+
63+instance Num Size where
64+ (+) = addSize
65+ (-) = subtractSize
66+ (*) = mulSize
67+
68+ fromInteger = f where f = Exact . fromInteger
69+ {-# INLINE f #-}
70+
71+add :: Int -> Int -> Int
72+add m n | mn > 0 = mn
73+ | otherwise = overflowError
74+ where mn = m + n
75+{-# INLINE add #-}
76+
77+addSize :: Size -> Size -> Size
78+addSize (Exact m) (Exact n) = Exact (add m n)
79+addSize (Exact m) (Max n) = Max (add m n)
80+addSize (Max m) (Exact n) = Max (add m n)
81+addSize (Max m) (Max n) = Max (add m n)
82+addSize _ _ = Unknown
83+{-# INLINE addSize #-}
84+
85+subtractSize :: Size -> Size -> Size
86+subtractSize (Exact m) (Exact n) = Exact (max (m-n) 0)
87+subtractSize (Exact m) (Max _) = Max m
88+subtractSize (Max m) (Exact n) = Max (max (m-n) 0)
89+subtractSize a@(Max _) (Max _) = a
90+subtractSize a@(Max _) Unknown = a
91+subtractSize _ _ = Unknown
92+{-# INLINE subtractSize #-}
93+
94+mul :: Int -> Int -> Int
95+mul m n
96+ | m <= maxBound `div` n = m * n
97+ | otherwise = overflowError
98+{-# INLINE mul #-}
99+
100+mulSize :: Size -> Size -> Size
101+mulSize (Exact m) (Exact n) = Exact (mul m n)
102+mulSize (Exact m) (Max n) = Max (mul m n)
103+mulSize (Max m) (Exact n) = Max (mul m n)
104+mulSize (Max m) (Max n) = Max (mul m n)
105+mulSize _ _ = Unknown
106+{-# INLINE mulSize #-}
107+
108+-- | Minimum of two size hints.
109+smaller :: Size -> Size -> Size
110+smaller (Exact m) (Exact n) = Exact (m `min` n)
111+smaller (Exact m) (Max n) = Max (m `min` n)
112+smaller (Exact m) Unknown = Max m
113+smaller (Max m) (Exact n) = Max (m `min` n)
114+smaller (Max m) (Max n) = Max (m `min` n)
115+smaller a@(Max _) Unknown = a
116+smaller Unknown (Exact n) = Max n
117+smaller Unknown (Max n) = Max n
118+smaller Unknown Unknown = Unknown
119+{-# INLINE smaller #-}
120+
121+-- | Maximum of two size hints.
122+larger :: Size -> Size -> Size
123+larger (Exact m) (Exact n) = Exact (m `max` n)
124+larger a@(Exact m) b@(Max n) | m >= n = a
125+ | otherwise = b
126+larger a@(Max m) b@(Exact n) | n >= m = b
127+ | otherwise = a
128+larger (Max m) (Max n) = Max (m `max` n)
129+larger _ _ = Unknown
130+{-# INLINE larger #-}
131+
132+-- | Compute the maximum size from a size hint, if possible.
133+upperBound :: Int -> Size -> Int
134+upperBound _ (Exact n) = n
135+upperBound _ (Max n) = n
136+upperBound k _ = k
137+{-# INLINE upperBound #-}
138+
139+isEmpty :: Size -> Bool
140+isEmpty (Exact n) = n <= 0
141+isEmpty (Max n) = n <= 0
142+isEmpty _ = False
143+{-# INLINE isEmpty #-}
144+
145+overflowError :: Int
146+overflowError = error "Data.Text.Fusion.Size: size overflow"
Data/Text/IO.hs+38−42
@@ -1,7 +1,4 @@
1{-# LANGUAGE BangPatterns, CPP, RecordWildCards, ScopedTypeVariables #-}
1{-# LANGUAGE BangPatterns, CPP, RecordWildCards, ScopedTypeVariables #-}
2−#if __GLASGOW_HASKELL__ >= 702
3−{-# LANGUAGE Trustworthy #-}
4−#endif
5-- |
2-- |
6-- Module : Data.Text.IO
3-- Module : Data.Text.IO
7-- Copyright : (c) 2009, 2010 Bryan O'Sullivan,
4-- Copyright : (c) 2009, 2010 Bryan O'Sullivan,
@@ -19,7 +16,7 @@
19module Data.Text.IO
16module Data.Text.IO
20 (
17 (
21 -- * Performance
18 -- * Performance
22− -- $performance
19+ -- $performance
23
20
24 -- * Locale support
21 -- * Locale support
25 -- $locale
22 -- $locale
@@ -29,7 +26,6 @@ module Data.Text.IO
29 , appendFile
26 , appendFile
30 -- * Operations on handles
27 -- * Operations on handles
31 , hGetContents
28 , hGetContents
32− , hGetChunk
33 , hGetLine
29 , hGetLine
34 , hPutStr
30 , hPutStr
35 , hPutStrLn
31 , hPutStrLn
@@ -42,17 +38,21 @@ module Data.Text.IO
42 ) where
38 ) where
43
39
44import Data.Text (Text)
40import Data.Text (Text)
45−import Prelude hiding (appendFile, getContents, getLine, interact,
41+import Prelude hiding (appendFile, catch, getContents, getLine, interact,
46 putStr, putStrLn, readFile, writeFile)
42 putStr, putStrLn, readFile, writeFile)
47import System.IO (Handle, IOMode(..), hPutChar, openFile, stdin, stdout,
43import System.IO (Handle, IOMode(..), hPutChar, openFile, stdin, stdout,
48 withFile)
44 withFile)
45+#if __GLASGOW_HASKELL__ <= 610
46+import qualified Data.ByteString.Char8 as B
47+import Data.Text.Encoding (decodeUtf8, encodeUtf8)
48+#else
49−import qualified Control.Exception as E
49+import Control.Exception (catch, throwIO)
50import Control.Monad (liftM2, when)
50import Control.Monad (liftM2, when)
51import Data.IORef (readIORef, writeIORef)
51import Data.IORef (readIORef, writeIORef)
52import qualified Data.Text as T
52import qualified Data.Text as T
53−import Data.Text.Internal.Fusion (stream)
53+import Data.Text.Fusion (stream)
54−import Data.Text.Internal.Fusion.Types (Step(..), Stream(..))
54+import Data.Text.Fusion.Internal (Step(..), Stream(..))
55−import Data.Text.Internal.IO (hGetLineWith, readChunk)
55+import Data.Text.IO.Internal (hGetLineWith, readChunk)
56import GHC.IO.Buffer (Buffer(..), BufferState(..), CharBufElem, CharBuffer,
56import GHC.IO.Buffer (Buffer(..), BufferState(..), CharBufElem, CharBuffer,
57 RawCharBuffer, emptyBuffer, isEmptyBuffer, newCharBuffer,
57 RawCharBuffer, emptyBuffer, isEmptyBuffer, newCharBuffer,
58 writeCharBuf)
58 writeCharBuf)
@@ -64,6 +64,7 @@ import GHC.IO.Handle.Types (BufferList(..), BufferMode(..), Handle__(..),
64 HandleType(..), Newline(..))
64 HandleType(..), Newline(..))
65import System.IO (hGetBuffering, hFileSize, hSetBuffering, hTell)
65import System.IO (hGetBuffering, hFileSize, hSetBuffering, hTell)
66import System.IO.Error (isEOFError)
66import System.IO.Error (isEOFError)
67+#endif
67
68
68-- $performance
69-- $performance
69-- #performance#
70-- #performance#
@@ -96,30 +97,6 @@ writeFile p = withFile p WriteMode . flip hPutStr
96appendFile :: FilePath -> Text -> IO ()
97appendFile :: FilePath -> Text -> IO ()
97appendFile p = withFile p AppendMode . flip hPutStr
98appendFile p = withFile p AppendMode . flip hPutStr
98
99
99−catchError :: String -> Handle -> Handle__ -> IOError -> IO Text
100−catchError caller h Handle__{..} err
101− | isEOFError err = do
102− buf <- readIORef haCharBuffer
103− return $ if isEmptyBuffer buf
104− then T.empty
105− else T.singleton '\r'
106− | otherwise = E.throwIO (augmentIOError err caller h)
107−
108−-- | /Experimental./ Read a single chunk of strict text from a
109−-- 'Handle'. The size of the chunk depends on the amount of input
110−-- currently buffered.
111−--
112−-- This function blocks only if there is no data available, and EOF
113−-- has not yet been reached. Once EOF is reached, this function
114−-- returns an empty string instead of throwing an exception.
115−hGetChunk :: Handle -> IO Text
116−hGetChunk h = wantReadableHandle "hGetChunk" h readSingleChunk
117− where
118− readSingleChunk hh@Handle__{..} = do
119− buf <- readIORef haCharBuffer
120− t <- readChunk hh buf `E.catch` catchError "hGetChunk" h hh
121− return (hh, t)
122−
123-- | Read the remaining contents of a 'Handle' as a string. The
100-- | Read the remaining contents of a 'Handle' as a string. The
124-- 'Handle' is closed once the contents have been read, or if an
101-- 'Handle' is closed once the contents have been read, or if an
125-- exception is thrown.
102-- exception is thrown.
@@ -132,21 +109,31 @@ hGetChunk h = wantReadableHandle "hGetChunk" h readSingleChunk
132-- result to construct its result. For files more than a half of
109-- result to construct its result. For files more than a half of
133-- available RAM in size, this may result in memory exhaustion.
110-- available RAM in size, this may result in memory exhaustion.
134hGetContents :: Handle -> IO Text
111hGetContents :: Handle -> IO Text
112+#if __GLASGOW_HASKELL__ <= 610
113+hGetContents = fmap decodeUtf8 . B.hGetContents
114+#else
135hGetContents h = do
115hGetContents h = do
136 chooseGoodBuffering h
116 chooseGoodBuffering h
137 wantReadableHandle "hGetContents" h readAll
117 wantReadableHandle "hGetContents" h readAll
138 where
118 where
139 readAll hh@Handle__{..} = do
119 readAll hh@Handle__{..} = do
120+ let catchError e
121+ | isEOFError e = do
122+ buf <- readIORef haCharBuffer
123+ return $ if isEmptyBuffer buf
124+ then T.empty
125+ else T.singleton '\r'
126+ | otherwise = throwIO (augmentIOError e "hGetContents" h)
140− let readChunks = do
127+ readChunks = do
141 buf <- readIORef haCharBuffer
128 buf <- readIORef haCharBuffer
142− t <- readChunk hh buf `E.catch` catchError "hGetContents" h hh
129+ t <- readChunk hh buf `catch` catchError
143 if T.null t
130 if T.null t
144 then return [t]
131 then return [t]
145 else (t:) `fmap` readChunks
132 else (t:) `fmap` readChunks
146 ts <- readChunks
133 ts <- readChunks
147 (hh', _) <- hClose_help hh
134 (hh', _) <- hClose_help hh
148 return (hh'{haType=ClosedHandle}, T.concat ts)
135 return (hh'{haType=ClosedHandle}, T.concat ts)
149−
136+
150-- | Use a more efficient buffer size if we're reading in
137-- | Use a more efficient buffer size if we're reading in
151-- block-buffered mode with the default buffer size. When we can
138-- block-buffered mode with the default buffer size. When we can
152-- determine the size of the handle we're reading, set the buffer size
139-- determine the size of the handle we're reading, set the buffer size
@@ -157,22 +144,30 @@ chooseGoodBuffering h = do
157 bufMode <- hGetBuffering h
144 bufMode <- hGetBuffering h
158 case bufMode of
145 case bufMode of
159 BlockBuffering Nothing -> do
146 BlockBuffering Nothing -> do
160− d <- E.catch (liftM2 (-) (hFileSize h) (hTell h)) $ \(e::IOException) ->
147+ d <- catch (liftM2 (-) (hFileSize h) (hTell h)) $ \(e::IOException) ->
161 if ioe_type e == InappropriateType
148 if ioe_type e == InappropriateType
162 then return 16384 -- faster than the 2KB default
149 then return 16384 -- faster than the 2KB default
163− else E.throwIO e
150+ else throwIO e
164 when (d > 0) . hSetBuffering h . BlockBuffering . Just . fromIntegral $ d
151 when (d > 0) . hSetBuffering h . BlockBuffering . Just . fromIntegral $ d
165 _ -> return ()
152 _ -> return ()
153+#endif
166
154
167-- | Read a single line from a handle.
155-- | Read a single line from a handle.
168hGetLine :: Handle -> IO Text
156hGetLine :: Handle -> IO Text
157+#if __GLASGOW_HASKELL__ <= 610
158+hGetLine = fmap decodeUtf8 . B.hGetLine
159+#else
169hGetLine = hGetLineWith T.concat
160hGetLine = hGetLineWith T.concat
161+#endif
170
162
171-- | Write a string to a handle.
163-- | Write a string to a handle.
172hPutStr :: Handle -> Text -> IO ()
164hPutStr :: Handle -> Text -> IO ()
165+#if __GLASGOW_HASKELL__ <= 610
166+hPutStr h = B.hPutStr h . encodeUtf8
167+#else
173-- This function is lifted almost verbatim from GHC.IO.Handle.Text.
168-- This function is lifted almost verbatim from GHC.IO.Handle.Text.
174hPutStr h t = do
169hPutStr h t = do
175− (buffer_mode, nl) <-
170+ (buffer_mode, nl) <-
176 wantWritableHandle "hPutStr" h $ \h_ -> do
171 wantWritableHandle "hPutStr" h $ \h_ -> do
177 bmode <- getSpareBuffer h_
172 bmode <- getSpareBuffer h_
178 return (bmode, haOutputNL h_)
173 return (bmode, haOutputNL h_)
@@ -254,7 +249,7 @@ writeBlocksRaw h buf0 (Stream next0 s0 _len) = outer s0 buf0
254
249
255-- This function is completely lifted from GHC.IO.Handle.Text.
250-- This function is completely lifted from GHC.IO.Handle.Text.
256getSpareBuffer :: Handle__ -> IO (BufferMode, CharBuffer)
251getSpareBuffer :: Handle__ -> IO (BufferMode, CharBuffer)
257−getSpareBuffer Handle__{haCharBuffer=ref,
252+getSpareBuffer Handle__{haCharBuffer=ref,
258 haBuffers=spare_ref,
253 haBuffers=spare_ref,
259 haBufferMode=mode}
254 haBufferMode=mode}
260 = do
255 = do
@@ -275,10 +270,11 @@ getSpareBuffer Handle__{haCharBuffer=ref,
275-- This function is completely lifted from GHC.IO.Handle.Text.
270-- This function is completely lifted from GHC.IO.Handle.Text.
276commitBuffer :: Handle -> RawCharBuffer -> Int -> Int -> Bool -> Bool
271commitBuffer :: Handle -> RawCharBuffer -> Int -> Int -> Bool -> Bool
277 -> IO CharBuffer
272 -> IO CharBuffer
278−commitBuffer hdl !raw !sz !count flush release =
273+commitBuffer hdl !raw !sz !count flush release =
279 wantWritableHandle "commitAndReleaseBuffer" hdl $
274 wantWritableHandle "commitAndReleaseBuffer" hdl $
280 commitBuffer' raw sz count flush release
275 commitBuffer' raw sz count flush release
281{-# INLINE commitBuffer #-}
276{-# INLINE commitBuffer #-}
277+#endif
282
278
283-- | Write a string to a handle, followed by a newline.
279-- | Write a string to a handle, followed by a newline.
284hPutStrLn :: Handle -> Text -> IO ()
280hPutStrLn :: Handle -> Text -> IO ()
Data/Text/Internal/IO.hs → Data/Text/IO/Internal.hsrenamed+14−13
@@ -1,6 +1,6 @@
1{-# LANGUAGE BangPatterns, CPP, RecordWildCards #-}
1{-# LANGUAGE BangPatterns, CPP, RecordWildCards #-}
2-- |
2-- |
3−-- Module : Data.Text.Internal.IO
3+-- Module : Data.Text.IO.Internal
4-- Copyright : (c) 2009, 2010 Bryan O'Sullivan,
4-- Copyright : (c) 2009, 2010 Bryan O'Sullivan,
5-- (c) 2009 Simon Marlow
5-- (c) 2009 Simon Marlow
6-- License : BSD-style
6-- License : BSD-style
@@ -8,24 +8,23 @@
8-- Stability : experimental
8-- Stability : experimental
9-- Portability : GHC
9-- Portability : GHC
10--
10--
11−-- /Warning/: this is an internal module, and does not have a stable
12−-- API or name. Functions in this module may not check or enforce
13−-- preconditions expected by public modules. Use at your own risk!
14−--
15-- Low-level support for text I\/O.
11-- Low-level support for text I\/O.
16
12
17−module Data.Text.Internal.IO
13+module Data.Text.IO.Internal
18 (
14 (
15+#if __GLASGOW_HASKELL__ >= 612
19 hGetLineWith
16 hGetLineWith
20 , readChunk
17 , readChunk
18+#endif
21 ) where
19 ) where
22
20
21+#if __GLASGOW_HASKELL__ >= 612
23−import qualified Control.Exception as E
22+import Control.Exception (catch)
24import Data.IORef (readIORef, writeIORef)
23import Data.IORef (readIORef, writeIORef)
25import Data.Text (Text)
24import Data.Text (Text)
26−import Data.Text.Internal.Fusion (unstream)
25+import Data.Text.Fusion (unstream)
27−import Data.Text.Internal.Fusion.Types (Step(..), Stream(..))
26+import Data.Text.Fusion.Internal (Step(..), Stream(..))
28−import Data.Text.Internal.Fusion.Size (exactSize, maxSize)
27+import Data.Text.Fusion.Size (exactSize, maxSize)
29import Data.Text.Unsafe (inlinePerformIO)
28import Data.Text.Unsafe (inlinePerformIO)
30import Foreign.Storable (peekElemOff)
29import Foreign.Storable (peekElemOff)
31import GHC.IO.Buffer (Buffer(..), CharBuffer, RawCharBuffer, bufferAdjustL,
30import GHC.IO.Buffer (Buffer(..), CharBuffer, RawCharBuffer, bufferAdjustL,
@@ -33,6 +32,7 @@ import GHC.IO.Buffer (Buffer(..), CharBuffer, RawCharBuffer, bufferAdjustL,
33 withRawBuffer, writeCharBuf)
32 withRawBuffer, writeCharBuf)
34import GHC.IO.Handle.Internals (ioe_EOF, readTextDevice, wantReadableHandle_)
33import GHC.IO.Handle.Internals (ioe_EOF, readTextDevice, wantReadableHandle_)
35import GHC.IO.Handle.Types (Handle__(..), Newline(..))
34import GHC.IO.Handle.Types (Handle__(..), Newline(..))
35+import Prelude hiding (catch)
36import System.IO (Handle)
36import System.IO (Handle)
37import System.IO.Error (isEOFError)
37import System.IO.Error (isEOFError)
38import qualified Data.Text as T
38import qualified Data.Text as T
@@ -84,9 +84,9 @@ hGetLineLoop hh@Handle__{..} = go where
84-- This function is lifted almost verbatim from GHC.IO.Handle.Text.
84-- This function is lifted almost verbatim from GHC.IO.Handle.Text.
85maybeFillReadBuffer :: Handle__ -> CharBuffer -> IO (Maybe CharBuffer)
85maybeFillReadBuffer :: Handle__ -> CharBuffer -> IO (Maybe CharBuffer)
86maybeFillReadBuffer handle_ buf
86maybeFillReadBuffer handle_ buf
87− = E.catch (Just `fmap` getSomeCharacters handle_ buf) $ \e ->
87+ = catch (Just `fmap` getSomeCharacters handle_ buf) $ \e ->
88− if isEOFError e
88+ if isEOFError e
89− then return Nothing
89+ then return Nothing
90 else ioError e
90 else ioError e
91
91
92unpack :: RawCharBuffer -> Int -> Int -> IO Text
92unpack :: RawCharBuffer -> Int -> Int -> IO Text
@@ -164,3 +164,4 @@ readChunk hh@Handle__{..} buf = do
164
164
165sizeError :: String -> a
165sizeError :: String -> a
166sizeError loc = error $ "Data.Text.IO." ++ loc ++ ": bad internal buffer size"
166sizeError loc = error $ "Data.Text.IO." ++ loc ++ ": bad internal buffer size"
167+#endif
Data/Text/Internal.hs+17−102
@@ -1,5 +1,4 @@
1−{-# LANGUAGE CPP, DeriveDataTypeable, UnboxedTuples #-}
1+{-# LANGUAGE CPP, DeriveDataTypeable #-}
2−{-# OPTIONS_HADDOCK not-home #-}
3
2
4-- |
3-- |
5-- Module : Data.Text.Internal
4-- Module : Data.Text.Internal
@@ -8,7 +7,8 @@
8-- (c) 2009 Duncan Coutts
7-- (c) 2009 Duncan Coutts
9--
8--
10-- License : BSD-style
9-- License : BSD-style
11−-- Maintainer : bos@serpentine.com
10+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
11+-- duncan@haskell.org
12-- Stability : experimental
12-- Stability : experimental
13-- Portability : GHC
13-- Portability : GHC
14--
14--
@@ -20,14 +20,9 @@
20-- with the internals, as the functions here do just about nothing to
20-- with the internals, as the functions here do just about nothing to
21-- preserve data invariants. You have been warned!
21-- preserve data invariants. You have been warned!
22
22
23−#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)
24−#include "MachDeps.h"
25−#endif
26−
27module Data.Text.Internal
23module Data.Text.Internal
28 (
24 (
29 -- * Types
25 -- * Types
30− -- $internals
31 Text(..)
26 Text(..)
32 -- * Construction
27 -- * Construction
33 , text
28 , text
@@ -36,13 +31,8 @@ module Data.Text.Internal
36 , safe
31 , safe
37 -- * Code that must be here for accessibility
32 -- * Code that must be here for accessibility
38 , empty
33 , empty
39− , empty_
40 -- * Utilities
34 -- * Utilities
41 , firstf
35 , firstf
42− -- * Checked multiplication
43− , mul
44− , mul32
45− , mul64
46 -- * Debugging
36 -- * Debugging
47 , showText
37 , showText
48 ) where
38 ) where
@@ -50,22 +40,21 @@ module Data.Text.Internal
50#if defined(ASSERTS)
40#if defined(ASSERTS)
51import Control.Exception (assert)
41import Control.Exception (assert)
52#endif
42#endif
53−import Data.Bits
43+import Data.Bits ((.&.))
54−import Data.Int (Int32, Int64)
55−import Data.Text.Internal.Unsafe.Char (ord)
56−import Data.Typeable (Typeable)
57import qualified Data.Text.Array as A
44import qualified Data.Text.Array as A
45+import Data.Text.UnsafeChar (ord)
46+import Data.Typeable (Typeable)
58
47
59-- | A space efficient, packed, unboxed Unicode text type.
48-- | A space efficient, packed, unboxed Unicode text type.
60data Text = Text
49data Text = Text
61− {-# UNPACK #-} !A.Array -- payload (Word16 elements)
50+ {-# UNPACK #-} !A.Array -- payload
62− {-# UNPACK #-} !Int -- offset (units of Word16, not Char)
51+ {-# UNPACK #-} !Int -- offset
63− {-# UNPACK #-} !Int -- length (units of Word16, not Char)
52+ {-# UNPACK #-} !Int -- length
64 deriving (Typeable)
53 deriving (Typeable)
65
54
66-- | Smart constructor.
55-- | Smart constructor.
67−text_ :: A.Array -> Int -> Int -> Text
56+text :: A.Array -> Int -> Int -> Text
68−text_ arr off len =
57+text arr off len =
69#if defined(ASSERTS)
58#if defined(ASSERTS)
70 let c = A.unsafeIndex arr off
59 let c = A.unsafeIndex arr off
71 alen = A.length arr
60 alen = A.length arr
@@ -75,28 +64,19 @@ text_ arr off len =
75 assert (len == 0 || c < 0xDC00 || c > 0xDFFF) $
64 assert (len == 0 || c < 0xDC00 || c > 0xDFFF) $
76#endif
65#endif
77 Text arr off len
66 Text arr off len
78−{-# INLINE text_ #-}
67+{-# INLINE text #-}
79
68
80-- | /O(1)/ The empty 'Text'.
69-- | /O(1)/ The empty 'Text'.
81empty :: Text
70empty :: Text
82empty = Text A.empty 0 0
71empty = Text A.empty 0 0
83{-# INLINE [1] empty #-}
72{-# INLINE [1] empty #-}
84
73
85−-- | A non-inlined version of 'empty'.
86−empty_ :: Text
87−empty_ = Text A.empty 0 0
88−{-# NOINLINE empty_ #-}
89−
90-- | Construct a 'Text' without invisibly pinning its byte array in
74-- | Construct a 'Text' without invisibly pinning its byte array in
91-- memory if its length has dwindled to zero.
75-- memory if its length has dwindled to zero.
92−text :: A.Array -> Int -> Int -> Text
93−text arr off len | len == 0 = empty
94− | otherwise = text_ arr off len
95−{-# INLINE text #-}
96−
97textP :: A.Array -> Int -> Int -> Text
76textP :: A.Array -> Int -> Int -> Text
98−{-# DEPRECATED textP "Use text instead" #-}
77+textP arr off len | len == 0 = empty
99−textP = text
78+ | otherwise = text arr off len
79+{-# INLINE textP #-}
100
80
101-- | A useful 'show'-like function for debugging purposes.
81-- | A useful 'show'-like function for debugging purposes.
102showText :: Text -> String
82showText :: Text -> String
@@ -110,79 +90,14 @@ showText (Text arr off len) =
110-- scalar values, but are unfortunately admitted as valid 'Char'
90-- scalar values, but are unfortunately admitted as valid 'Char'
111-- values by Haskell. They cannot be represented in a 'Text'. This
91-- values by Haskell. They cannot be represented in a 'Text'. This
112-- function remaps those code points to the Unicode replacement
92-- function remaps those code points to the Unicode replacement
113−-- character (U+FFFD, \'&#xfffd;\'), and leaves other code points
93+-- character \"&#xfffd;\", and leaves other code points unchanged.
114−-- unchanged.
115safe :: Char -> Char
94safe :: Char -> Char
116safe c
95safe c
117 | ord c .&. 0x1ff800 /= 0xd800 = c
96 | ord c .&. 0x1ff800 /= 0xd800 = c
118 | otherwise = '\xfffd'
97 | otherwise = '\xfffd'
119−{-# INLINE [0] safe #-}
98+{-# INLINE safe #-}
120
99
121-- | Apply a function to the first element of an optional pair.
100-- | Apply a function to the first element of an optional pair.
122firstf :: (a -> c) -> Maybe (a,b) -> Maybe (c,b)
101firstf :: (a -> c) -> Maybe (a,b) -> Maybe (c,b)
123firstf f (Just (a, b)) = Just (f a, b)
102firstf f (Just (a, b)) = Just (f a, b)
124firstf _ Nothing = Nothing
103firstf _ Nothing = Nothing
125−
126−-- | Checked multiplication. Calls 'error' if the result would
127−-- overflow.
128−mul :: Int -> Int -> Int
129−#if WORD_SIZE_IN_BITS == 64
130−mul a b = fromIntegral $ fromIntegral a `mul64` fromIntegral b
131−#else
132−mul a b = fromIntegral $ fromIntegral a `mul32` fromIntegral b
133−#endif
134−{-# INLINE mul #-}
135−infixl 7 `mul`
136−
137−-- | Checked multiplication. Calls 'error' if the result would
138−-- overflow.
139−mul64 :: Int64 -> Int64 -> Int64
140−mul64 a b
141− | a >= 0 && b >= 0 = mul64_ a b
142− | a >= 0 = -mul64_ a (-b)
143− | b >= 0 = -mul64_ (-a) b
144− | otherwise = mul64_ (-a) (-b)
145−{-# INLINE mul64 #-}
146−infixl 7 `mul64`
147−
148−mul64_ :: Int64 -> Int64 -> Int64
149−mul64_ a b
150− | ahi > 0 && bhi > 0 = error "overflow"
151− | top > 0x7fffffff = error "overflow"
152− | total < 0 = error "overflow"
153− | otherwise = total
154− where (# ahi, alo #) = (# a `shiftR` 32, a .&. 0xffffffff #)
155− (# bhi, blo #) = (# b `shiftR` 32, b .&. 0xffffffff #)
156− top = ahi * blo + alo * bhi
157− total = (top `shiftL` 32) + alo * blo
158−{-# INLINE mul64_ #-}
159−
160−-- | Checked multiplication. Calls 'error' if the result would
161−-- overflow.
162−mul32 :: Int32 -> Int32 -> Int32
163−mul32 a b = case fromIntegral a * fromIntegral b of
164− ab | ab < min32 || ab > max32 -> error "overflow"
165− | otherwise -> fromIntegral ab
166− where min32 = -0x80000000 :: Int64
167− max32 = 0x7fffffff
168−{-# INLINE mul32 #-}
169−infixl 7 `mul32`
170−
171−-- $internals
172−--
173−-- Internally, the 'Text' type is represented as an array of 'Word16'
174−-- UTF-16 code units. The offset and length fields in the constructor
175−-- are in these units, /not/ units of 'Char'.
176−--
177−-- Invariants that all functions must maintain:
178−--
179−-- * Since the 'Text' type uses UTF-16 internally, it cannot represent
180−-- characters in the reserved surrogate code point range U+D800 to
181−-- U+DFFF. To maintain this invariant, the 'safe' function maps
182−-- 'Char' values in this range to the replacement character (U+FFFD,
183−-- \'&#xfffd;\').
184−--
185−-- * A leading (or \"high\") surrogate code unit (0xD800–0xDBFF) must
186−-- always be followed by a trailing (or \"low\") surrogate code unit
187−-- (0xDC00-0xDFFF). A trailing surrogate code unit must always be
188−-- preceded by a leading surrogate code unit.
Data/Text/Internal/Builder.hsdeleted−329
@@ -1,329 +0,0 @@
1−{-# LANGUAGE BangPatterns, CPP, Rank2Types #-}
2−{-# OPTIONS_HADDOCK not-home #-}
3−
4−-----------------------------------------------------------------------------
5−-- |
6−-- Module : Data.Text.Internal.Builder
7−-- Copyright : (c) 2013 Bryan O'Sullivan
8−-- (c) 2010 Johan Tibell
9−-- License : BSD-style (see LICENSE)
10−--
11−-- Maintainer : Johan Tibell <johan.tibell@gmail.com>
12−-- Stability : experimental
13−-- Portability : portable to Hugs and GHC
14−--
15−-- /Warning/: this is an internal module, and does not have a stable
16−-- API or name. Functions in this module may not check or enforce
17−-- preconditions expected by public modules. Use at your own risk!
18−--
19−-- Efficient construction of lazy @Text@ values. The principal
20−-- operations on a @Builder@ are @singleton@, @fromText@, and
21−-- @fromLazyText@, which construct new builders, and 'mappend', which
22−-- concatenates two builders.
23−--
24−-- To get maximum performance when building lazy @Text@ values using a
25−-- builder, associate @mappend@ calls to the right. For example,
26−-- prefer
27−--
28−-- > singleton 'a' `mappend` (singleton 'b' `mappend` singleton 'c')
29−--
30−-- to
31−--
32−-- > singleton 'a' `mappend` singleton 'b' `mappend` singleton 'c'
33−--
34−-- as the latter associates @mappend@ to the left.
35−--
36−-----------------------------------------------------------------------------
37−
38−module Data.Text.Internal.Builder
39− ( -- * Public API
40− -- ** The Builder type
41− Builder
42− , toLazyText
43− , toLazyTextWith
44−
45− -- ** Constructing Builders
46− , singleton
47− , fromText
48− , fromLazyText
49− , fromString
50−
51− -- ** Flushing the buffer state
52− , flush
53−
54− -- * Internal functions
55− , append'
56− , ensureFree
57− , writeN
58− ) where
59−
60−import Control.Monad.ST (ST, runST)
61−import Data.Monoid (Monoid(..))
62−#if MIN_VERSION_base(4,9,0)
63−import Data.Semigroup (Semigroup(..))
64−#endif
65−import Data.Text.Internal (Text(..))
66−import Data.Text.Internal.Lazy (smallChunkSize)
67−import Data.Text.Unsafe (inlineInterleaveST)
68−import Data.Text.Internal.Unsafe.Char (unsafeWrite)
69−import Prelude hiding (map, putChar)
70−
71−import qualified Data.String as String
72−import qualified Data.Text as S
73−import qualified Data.Text.Array as A
74−import qualified Data.Text.Lazy as L
75−
76−------------------------------------------------------------------------
77−
78−-- | A @Builder@ is an efficient way to build lazy @Text@ values.
79−-- There are several functions for constructing builders, but only one
80−-- to inspect them: to extract any data, you have to turn them into
81−-- lazy @Text@ values using @toLazyText@.
82−--
83−-- Internally, a builder constructs a lazy @Text@ by filling arrays
84−-- piece by piece. As each buffer is filled, it is \'popped\' off, to
85−-- become a new chunk of the resulting lazy @Text@. All this is
86−-- hidden from the user of the @Builder@.
87−newtype Builder = Builder {
88− -- Invariant (from Data.Text.Lazy):
89− -- The lists include no null Texts.
90− runBuilder :: forall s. (Buffer s -> ST s [S.Text])
91− -> Buffer s
92− -> ST s [S.Text]
93− }
94−
95−#if MIN_VERSION_base(4,9,0)
96−instance Semigroup Builder where
97− (<>) = append
98− {-# INLINE (<>) #-}
99−#endif
100−
101−instance Monoid Builder where
102− mempty = empty
103− {-# INLINE mempty #-}
104−#if MIN_VERSION_base(4,9,0)
105− mappend = (<>) -- future-proof definition
106−#else
107− mappend = append
108−#endif
109− {-# INLINE mappend #-}
110− mconcat = foldr mappend Data.Monoid.mempty
111− {-# INLINE mconcat #-}
112−
113−instance String.IsString Builder where
114− fromString = fromString
115− {-# INLINE fromString #-}
116−
117−instance Show Builder where
118− show = show . toLazyText
119−
120−instance Eq Builder where
121− a == b = toLazyText a == toLazyText b
122−
123−instance Ord Builder where
124− a <= b = toLazyText a <= toLazyText b
125−
126−------------------------------------------------------------------------
127−
128−-- | /O(1)./ The empty @Builder@, satisfying
129−--
130−-- * @'toLazyText' 'empty' = 'L.empty'@
131−--
132−empty :: Builder
133−empty = Builder (\ k buf -> k buf)
134−{-# INLINE empty #-}
135−
136−-- | /O(1)./ A @Builder@ taking a single character, satisfying
137−--
138−-- * @'toLazyText' ('singleton' c) = 'L.singleton' c@
139−--
140−singleton :: Char -> Builder
141−singleton c = writeAtMost 2 $ \ marr o -> unsafeWrite marr o c
142−{-# INLINE singleton #-}
143−
144−------------------------------------------------------------------------
145−
146−-- | /O(1)./ The concatenation of two builders, an associative
147−-- operation with identity 'empty', satisfying
148−--
149−-- * @'toLazyText' ('append' x y) = 'L.append' ('toLazyText' x) ('toLazyText' y)@
150−--
151−append :: Builder -> Builder -> Builder
152−append (Builder f) (Builder g) = Builder (f . g)
153−{-# INLINE [0] append #-}
154−
155−-- TODO: Experiment to find the right threshold.
156−copyLimit :: Int
157−copyLimit = 128
158−
159−-- This function attempts to merge small @Text@ values instead of
160−-- treating each value as its own chunk. We may not always want this.
161−
162−-- | /O(1)./ A @Builder@ taking a 'S.Text', satisfying
163−--
164−-- * @'toLazyText' ('fromText' t) = 'L.fromChunks' [t]@
165−--
166−fromText :: S.Text -> Builder
167−fromText t@(Text arr off l)
168− | S.null t = empty
169− | l <= copyLimit = writeN l $ \marr o -> A.copyI marr o arr off (l+o)
170− | otherwise = flush `append` mapBuilder (t :)
171−{-# INLINE [1] fromText #-}
172−
173−{-# RULES
174−"fromText/pack" forall s .
175− fromText (S.pack s) = fromString s
176− #-}
177−
178−-- | /O(1)./ A Builder taking a @String@, satisfying
179−--
180−-- * @'toLazyText' ('fromString' s) = 'L.fromChunks' [S.pack s]@
181−--
182−fromString :: String -> Builder
183−fromString str = Builder $ \k (Buffer p0 o0 u0 l0) ->
184− let loop !marr !o !u !l [] = k (Buffer marr o u l)
185− loop marr o u l s@(c:cs)
186− | l <= 1 = do
187− arr <- A.unsafeFreeze marr
188− let !t = Text arr o u
189− marr' <- A.new chunkSize
190− ts <- inlineInterleaveST (loop marr' 0 0 chunkSize s)
191− return $ t : ts
192− | otherwise = do
193− n <- unsafeWrite marr (o+u) c
194− loop marr o (u+n) (l-n) cs
195− in loop p0 o0 u0 l0 str
196− where
197− chunkSize = smallChunkSize
198−{-# INLINE fromString #-}
199−
200−-- | /O(1)./ A @Builder@ taking a lazy @Text@, satisfying
201−--
202−-- * @'toLazyText' ('fromLazyText' t) = t@
203−--
204−fromLazyText :: L.Text -> Builder
205−fromLazyText ts = flush `append` mapBuilder (L.toChunks ts ++)
206−{-# INLINE fromLazyText #-}
207−
208−------------------------------------------------------------------------
209−
210−-- Our internal buffer type
211−data Buffer s = Buffer {-# UNPACK #-} !(A.MArray s)
212− {-# UNPACK #-} !Int -- offset
213− {-# UNPACK #-} !Int -- used units
214− {-# UNPACK #-} !Int -- length left
215−
216−------------------------------------------------------------------------
217−
218−-- | /O(n)./ Extract a lazy @Text@ from a @Builder@ with a default
219−-- buffer size. The construction work takes place if and when the
220−-- relevant part of the lazy @Text@ is demanded.
221−toLazyText :: Builder -> L.Text
222−toLazyText = toLazyTextWith smallChunkSize
223−
224−-- | /O(n)./ Extract a lazy @Text@ from a @Builder@, using the given
225−-- size for the initial buffer. The construction work takes place if
226−-- and when the relevant part of the lazy @Text@ is demanded.
227−--
228−-- If the initial buffer is too small to hold all data, subsequent
229−-- buffers will be the default buffer size.
230−toLazyTextWith :: Int -> Builder -> L.Text
231−toLazyTextWith chunkSize m = L.fromChunks (runST $
232− newBuffer chunkSize >>= runBuilder (m `append` flush) (const (return [])))
233−
234−-- | /O(1)./ Pop the strict @Text@ we have constructed so far, if any,
235−-- yielding a new chunk in the result lazy @Text@.
236−flush :: Builder
237−flush = Builder $ \ k buf@(Buffer p o u l) ->
238− if u == 0
239− then k buf
240− else do arr <- A.unsafeFreeze p
241− let !b = Buffer p (o+u) 0 l
242− !t = Text arr o u
243− ts <- inlineInterleaveST (k b)
244− return $! t : ts
245−{-# INLINE [1] flush #-}
246−-- defer inlining so that flush/flush rule may fire.
247−
248−------------------------------------------------------------------------
249−
250−-- | Sequence an ST operation on the buffer
251−withBuffer :: (forall s. Buffer s -> ST s (Buffer s)) -> Builder
252−withBuffer f = Builder $ \k buf -> f buf >>= k
253−{-# INLINE withBuffer #-}
254−
255−-- | Get the size of the buffer
256−withSize :: (Int -> Builder) -> Builder
257−withSize f = Builder $ \ k buf@(Buffer _ _ _ l) ->
258− runBuilder (f l) k buf
259−{-# INLINE withSize #-}
260−
261−-- | Map the resulting list of texts.
262−mapBuilder :: ([S.Text] -> [S.Text]) -> Builder
263−mapBuilder f = Builder (fmap f .)
264−
265−------------------------------------------------------------------------
266−
267−-- | Ensure that there are at least @n@ many elements available.
268−ensureFree :: Int -> Builder
269−ensureFree !n = withSize $ \ l ->
270− if n <= l
271− then empty
272− else flush `append'` withBuffer (const (newBuffer (max n smallChunkSize)))
273−{-# INLINE [0] ensureFree #-}
274−
275−writeAtMost :: Int -> (forall s. A.MArray s -> Int -> ST s Int) -> Builder
276−writeAtMost n f = ensureFree n `append'` withBuffer (writeBuffer f)
277−{-# INLINE [0] writeAtMost #-}
278−
279−-- | Ensure that @n@ many elements are available, and then use @f@ to
280−-- write some elements into the memory.
281−writeN :: Int -> (forall s. A.MArray s -> Int -> ST s ()) -> Builder
282−writeN n f = writeAtMost n (\ p o -> f p o >> return n)
283−{-# INLINE writeN #-}
284−
285−writeBuffer :: (A.MArray s -> Int -> ST s Int) -> Buffer s -> ST s (Buffer s)
286−writeBuffer f (Buffer p o u l) = do
287− n <- f p (o+u)
288− return $! Buffer p o (u+n) (l-n)
289−{-# INLINE writeBuffer #-}
290−
291−newBuffer :: Int -> ST s (Buffer s)
292−newBuffer size = do
293− arr <- A.new size
294− return $! Buffer arr 0 0 size
295−{-# INLINE newBuffer #-}
296−
297−------------------------------------------------------------------------
298−-- Some nice rules for Builder
299−
300−-- This function makes GHC understand that 'writeN' and 'ensureFree'
301−-- are *not* recursive in the precense of the rewrite rules below.
302−-- This is not needed with GHC 7+.
303−append' :: Builder -> Builder -> Builder
304−append' (Builder f) (Builder g) = Builder (f . g)
305−{-# INLINE append' #-}
306−
307−{-# RULES
308−
309−"append/writeAtMost" forall a b (f::forall s. A.MArray s -> Int -> ST s Int)
310− (g::forall s. A.MArray s -> Int -> ST s Int) ws.
311− append (writeAtMost a f) (append (writeAtMost b g) ws) =
312− append (writeAtMost (a+b) (\marr o -> f marr o >>= \ n ->
313− g marr (o+n) >>= \ m ->
314− let s = n+m in s `seq` return s)) ws
315−
316−"writeAtMost/writeAtMost" forall a b (f::forall s. A.MArray s -> Int -> ST s Int)
317− (g::forall s. A.MArray s -> Int -> ST s Int).
318− append (writeAtMost a f) (writeAtMost b g) =
319− writeAtMost (a+b) (\marr o -> f marr o >>= \ n ->
320− g marr (o+n) >>= \ m ->
321− let s = n+m in s `seq` return s)
322−
323−"ensureFree/ensureFree" forall a b .
324− append (ensureFree a) (ensureFree b) = ensureFree (max a b)
325−
326−"flush/flush"
327− append flush flush = flush
328−
329− #-}
Data/Text/Internal/Builder/Int/Digits.hsdeleted−26
@@ -1,26 +0,0 @@
1−{-# LANGUAGE OverloadedStrings #-}
2−
3−-- Module: Data.Text.Internal.Builder.Int.Digits
4−-- Copyright: (c) 2013 Bryan O'Sullivan
5−-- License: BSD-style
6−-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>
7−-- Stability: experimental
8−-- Portability: portable
9−--
10−-- /Warning/: this is an internal module, and does not have a stable
11−-- API or name. Functions in this module may not check or enforce
12−-- preconditions expected by public modules. Use at your own risk!
13−--
14−-- This module exists because the C preprocessor does things that we
15−-- shall not speak of when confronted with Haskell multiline strings.
16−
17−module Data.Text.Internal.Builder.Int.Digits (digits) where
18−
19−import Data.ByteString.Char8 (ByteString)
20−
21−digits :: ByteString
22−digits = "0001020304050607080910111213141516171819\
23− \2021222324252627282930313233343536373839\
24− \4041424344454647484950515253545556575859\
25− \6061626364656667686970717273747576777879\
26− \8081828384858687888990919293949596979899"
Data/Text/Internal/Builder/RealFloat/Functions.hsdeleted−57
@@ -1,57 +0,0 @@
1−{-# LANGUAGE CPP #-}
2−
3−-- |
4−-- Module: Data.Text.Internal.Builder.RealFloat.Functions
5−-- Copyright: (c) The University of Glasgow 1994-2002
6−-- License: see libraries/base/LICENSE
7−--
8−-- /Warning/: this is an internal module, and does not have a stable
9−-- API or name. Functions in this module may not check or enforce
10−-- preconditions expected by public modules. Use at your own risk!
11−
12−module Data.Text.Internal.Builder.RealFloat.Functions
13− (
14− roundTo
15− ) where
16−
17−roundTo :: Int -> [Int] -> (Int,[Int])
18−
19−#if MIN_VERSION_base(4,6,0)
20−
21−roundTo d is =
22− case f d True is of
23− x@(0,_) -> x
24− (1,xs) -> (1, 1:xs)
25− _ -> error "roundTo: bad Value"
26− where
27− b2 = base `quot` 2
28−
29− f n _ [] = (0, replicate n 0)
30− f 0 e (x:xs) | x == b2 && e && all (== 0) xs = (0, []) -- Round to even when at exactly half the base
31− | otherwise = (if x >= b2 then 1 else 0, [])
32− f n _ (i:xs)
33− | i' == base = (1,0:ds)
34− | otherwise = (0,i':ds)
35− where
36− (c,ds) = f (n-1) (even i) xs
37− i' = c + i
38− base = 10
39−
40−#else
41−
42−roundTo d is =
43− case f d is of
44− x@(0,_) -> x
45− (1,xs) -> (1, 1:xs)
46− _ -> error "roundTo: bad Value"
47− where
48− f n [] = (0, replicate n 0)
49− f 0 (x:_) = (if x >= 5 then 1 else 0, [])
50− f n (i:xs)
51− | i' == 10 = (1,0:ds)
52− | otherwise = (0,i':ds)
53− where
54− (c,ds) = f (n-1) xs
55− i' = c + i
56−
57−#endif
Data/Text/Internal/Encoding/Fusion/Common.hsdeleted−123
@@ -1,123 +0,0 @@
1−{-# LANGUAGE BangPatterns #-}
2−
3−-- |
4−-- Module : Data.Text.Internal.Encoding.Fusion.Common
5−-- Copyright : (c) Tom Harper 2008-2009,
6−-- (c) Bryan O'Sullivan 2009,
7−-- (c) Duncan Coutts 2009,
8−-- (c) Jasper Van der Jeugt 2011
9−--
10−-- License : BSD-style
11−-- Maintainer : bos@serpentine.com
12−-- Stability : experimental
13−-- Portability : portable
14−--
15−-- /Warning/: this is an internal module, and does not have a stable
16−-- API or name. Use at your own risk!
17−--
18−-- Fusible 'Stream'-oriented functions for converting between 'Text'
19−-- and several common encodings.
20−
21−module Data.Text.Internal.Encoding.Fusion.Common
22− (
23− -- * Restreaming
24− -- Restreaming is the act of converting from one 'Stream'
25− -- representation to another.
26− restreamUtf16LE
27− , restreamUtf16BE
28− , restreamUtf32LE
29− , restreamUtf32BE
30− ) where
31−
32−import Data.Bits ((.&.))
33−import Data.Text.Internal.Fusion (Step(..), Stream(..))
34−import Data.Text.Internal.Fusion.Types (RS(..))
35−import Data.Text.Internal.Unsafe.Char (ord)
36−import Data.Text.Internal.Unsafe.Shift (shiftR)
37−import Data.Word (Word8)
38−
39−restreamUtf16BE :: Stream Char -> Stream Word8
40−restreamUtf16BE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)
41− where
42− next (RS0 s) = case next0 s of
43− Done -> Done
44− Skip s' -> Skip (RS0 s')
45− Yield x s'
46− | n < 0x10000 -> Yield (fromIntegral $ n `shiftR` 8) $
47− RS1 s' (fromIntegral n)
48− | otherwise -> Yield c1 $ RS3 s' c2 c3 c4
49− where
50− n = ord x
51− n1 = n - 0x10000
52− c1 = fromIntegral (n1 `shiftR` 18 + 0xD8)
53− c2 = fromIntegral (n1 `shiftR` 10)
54− n2 = n1 .&. 0x3FF
55− c3 = fromIntegral (n2 `shiftR` 8 + 0xDC)
56− c4 = fromIntegral n2
57− next (RS1 s x2) = Yield x2 (RS0 s)
58− next (RS2 s x2 x3) = Yield x2 (RS1 s x3)
59− next (RS3 s x2 x3 x4) = Yield x2 (RS2 s x3 x4)
60− {-# INLINE next #-}
61−{-# INLINE restreamUtf16BE #-}
62−
63−restreamUtf16LE :: Stream Char -> Stream Word8
64−restreamUtf16LE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)
65− where
66− next (RS0 s) = case next0 s of
67− Done -> Done
68− Skip s' -> Skip (RS0 s')
69− Yield x s'
70− | n < 0x10000 -> Yield (fromIntegral n) $
71− RS1 s' (fromIntegral $ shiftR n 8)
72− | otherwise -> Yield c1 $ RS3 s' c2 c3 c4
73− where
74− n = ord x
75− n1 = n - 0x10000
76− c2 = fromIntegral (shiftR n1 18 + 0xD8)
77− c1 = fromIntegral (shiftR n1 10)
78− n2 = n1 .&. 0x3FF
79− c4 = fromIntegral (shiftR n2 8 + 0xDC)
80− c3 = fromIntegral n2
81− next (RS1 s x2) = Yield x2 (RS0 s)
82− next (RS2 s x2 x3) = Yield x2 (RS1 s x3)
83− next (RS3 s x2 x3 x4) = Yield x2 (RS2 s x3 x4)
84− {-# INLINE next #-}
85−{-# INLINE restreamUtf16LE #-}
86−
87−restreamUtf32BE :: Stream Char -> Stream Word8
88−restreamUtf32BE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)
89− where
90− next (RS0 s) = case next0 s of
91− Done -> Done
92− Skip s' -> Skip (RS0 s')
93− Yield x s' -> Yield c1 (RS3 s' c2 c3 c4)
94− where
95− n = ord x
96− c1 = fromIntegral $ shiftR n 24
97− c2 = fromIntegral $ shiftR n 16
98− c3 = fromIntegral $ shiftR n 8
99− c4 = fromIntegral n
100− next (RS1 s x2) = Yield x2 (RS0 s)
101− next (RS2 s x2 x3) = Yield x2 (RS1 s x3)
102− next (RS3 s x2 x3 x4) = Yield x2 (RS2 s x3 x4)
103− {-# INLINE next #-}
104−{-# INLINE restreamUtf32BE #-}
105−
106−restreamUtf32LE :: Stream Char -> Stream Word8
107−restreamUtf32LE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)
108− where
109− next (RS0 s) = case next0 s of
110− Done -> Done
111− Skip s' -> Skip (RS0 s')
112− Yield x s' -> Yield c1 (RS3 s' c2 c3 c4)
113− where
114− n = ord x
115− c4 = fromIntegral $ shiftR n 24
116− c3 = fromIntegral $ shiftR n 16
117− c2 = fromIntegral $ shiftR n 8
118− c1 = fromIntegral n
119− next (RS1 s x2) = Yield x2 (RS0 s)
120− next (RS2 s x2 x3) = Yield x2 (RS1 s x3)
121− next (RS3 s x2 x3 x4) = Yield x2 (RS2 s x3 x4)
122− {-# INLINE next #-}
123−{-# INLINE restreamUtf32LE #-}
Data/Text/Internal/Fusion/Size.hsdeleted−157
@@ -1,157 +0,0 @@
1−{-# LANGUAGE CPP #-}
2−{-# OPTIONS_GHC -fno-warn-missing-methods #-}
3−-- |
4−-- Module : Data.Text.Internal.Fusion.Internal
5−-- Copyright : (c) Roman Leshchinskiy 2008,
6−-- (c) Bryan O'Sullivan 2009
7−--
8−-- License : BSD-style
9−-- Maintainer : bos@serpentine.com
10−-- Stability : experimental
11−-- Portability : portable
12−--
13−-- /Warning/: this is an internal module, and does not have a stable
14−-- API or name. Functions in this module may not check or enforce
15−-- preconditions expected by public modules. Use at your own risk!
16−--
17−-- Size hints.
18−
19−module Data.Text.Internal.Fusion.Size
20− (
21− Size
22− , exactly
23− , exactSize
24− , maxSize
25− , betweenSize
26− , unknownSize
27− , smaller
28− , larger
29− , upperBound
30− , lowerBound
31− , compareSize
32− , isEmpty
33− ) where
34−
35−import Data.Text.Internal (mul)
36−#if defined(ASSERTS)
37−import Control.Exception (assert)
38−#endif
39−
40−data Size = Between {-# UNPACK #-} !Int {-# UNPACK #-} !Int -- ^ Lower and upper bounds on size.
41− | Unknown -- ^ Unknown size.
42− deriving (Eq, Show)
43−
44−exactly :: Size -> Maybe Int
45−exactly (Between na nb) | na == nb = Just na
46−exactly _ = Nothing
47−{-# INLINE exactly #-}
48−
49−exactSize :: Int -> Size
50−exactSize n =
51−#if defined(ASSERTS)
52− assert (n >= 0)
53−#endif
54− Between n n
55−{-# INLINE exactSize #-}
56−
57−maxSize :: Int -> Size
58−maxSize n =
59−#if defined(ASSERTS)
60− assert (n >= 0)
61−#endif
62− Between 0 n
63−{-# INLINE maxSize #-}
64−
65−betweenSize :: Int -> Int -> Size
66−betweenSize m n =
67−#if defined(ASSERTS)
68− assert (m >= 0)
69− assert (n >= m)
70−#endif
71− Between m n
72−{-# INLINE betweenSize #-}
73−
74−unknownSize :: Size
75−unknownSize = Unknown
76−{-# INLINE unknownSize #-}
77−
78−instance Num Size where
79− (+) = addSize
80− (-) = subtractSize
81− (*) = mulSize
82−
83− fromInteger = f where f = exactSize . fromInteger
84− {-# INLINE f #-}
85−
86−add :: Int -> Int -> Int
87−add m n | mn >= 0 = mn
88− | otherwise = overflowError
89− where mn = m + n
90−{-# INLINE add #-}
91−
92−addSize :: Size -> Size -> Size
93−addSize (Between ma mb) (Between na nb) = Between (add ma na) (add mb nb)
94−addSize _ _ = Unknown
95−{-# INLINE addSize #-}
96−
97−subtractSize :: Size -> Size -> Size
98−subtractSize (Between ma mb) (Between na nb) = Between (max (ma-nb) 0) (max (mb-na) 0)
99−subtractSize a@(Between 0 _) Unknown = a
100−subtractSize (Between _ mb) Unknown = Between 0 mb
101−subtractSize _ _ = Unknown
102−{-# INLINE subtractSize #-}
103−
104−mulSize :: Size -> Size -> Size
105−mulSize (Between ma mb) (Between na nb) = Between (mul ma na) (mul mb nb)
106−mulSize _ _ = Unknown
107−{-# INLINE mulSize #-}
108−
109−-- | Minimum of two size hints.
110−smaller :: Size -> Size -> Size
111−smaller a@(Between ma mb) b@(Between na nb)
112− | mb <= na = a
113− | nb <= ma = b
114− | otherwise = Between (ma `min` na) (mb `min` nb)
115−smaller a@(Between 0 _) Unknown = a
116−smaller (Between _ mb) Unknown = Between 0 mb
117−smaller Unknown b@(Between 0 _) = b
118−smaller Unknown (Between _ nb) = Between 0 nb
119−smaller Unknown Unknown = Unknown
120−{-# INLINE smaller #-}
121−
122−-- | Maximum of two size hints.
123−larger :: Size -> Size -> Size
124−larger a@(Between ma mb) b@(Between na nb)
125− | ma >= nb = a
126− | na >= mb = b
127− | otherwise = Between (ma `max` na) (mb `max` nb)
128−larger _ _ = Unknown
129−{-# INLINE larger #-}
130−
131−-- | Compute the maximum size from a size hint, if possible.
132−upperBound :: Int -> Size -> Int
133−upperBound _ (Between _ n) = n
134−upperBound k _ = k
135−{-# INLINE upperBound #-}
136−
137−-- | Compute the maximum size from a size hint, if possible.
138−lowerBound :: Int -> Size -> Int
139−lowerBound _ (Between n _) = n
140−lowerBound k _ = k
141−{-# INLINE lowerBound #-}
142−
143−compareSize :: Size -> Int -> Maybe Ordering
144−compareSize (Between ma mb) n
145− | mb < n = Just LT
146− | ma > n = Just GT
147− | ma == n && mb == n = Just EQ
148−compareSize _ _ = Nothing
149−
150−
151−isEmpty :: Size -> Bool
152−isEmpty (Between _ n) = n <= 0
153−isEmpty _ = False
154−{-# INLINE isEmpty #-}
155−
156−overflowError :: Int
157−overflowError = error "Data.Text.Internal.Fusion.Size: size overflow"
Data/Text/Internal/Lazy.hsdeleted−119
@@ -1,119 +0,0 @@
1−{-# LANGUAGE BangPatterns, DeriveDataTypeable #-}
2−{-# OPTIONS_HADDOCK not-home #-}
3−
4−-- |
5−-- Module : Data.Text.Internal.Lazy
6−-- Copyright : (c) 2009, 2010 Bryan O'Sullivan
7−--
8−-- License : BSD-style
9−-- Maintainer : bos@serpentine.com
10−-- Stability : experimental
11−-- Portability : GHC
12−--
13−-- /Warning/: this is an internal module, and does not have a stable
14−-- API or name. Functions in this module may not check or enforce
15−-- preconditions expected by public modules. Use at your own risk!
16−--
17−-- A module containing private 'Text' internals. This exposes the
18−-- 'Text' representation and low level construction functions.
19−-- Modules which extend the 'Text' system may need to use this module.
20−
21−module Data.Text.Internal.Lazy
22− (
23− Text(..)
24− , chunk
25− , empty
26− , foldrChunks
27− , foldlChunks
28− -- * Data type invariant and abstraction functions
29−
30− -- $invariant
31− , strictInvariant
32− , lazyInvariant
33− , showStructure
34−
35− -- * Chunk allocation sizes
36− , defaultChunkSize
37− , smallChunkSize
38− , chunkOverhead
39− ) where
40−
41−import Data.Text ()
42−import Data.Text.Internal.Unsafe.Shift (shiftL)
43−import Data.Typeable (Typeable)
44−import Foreign.Storable (sizeOf)
45−import qualified Data.Text.Internal as T
46−
47−data Text = Empty
48− | Chunk {-# UNPACK #-} !T.Text Text
49− deriving (Typeable)
50−
51−-- $invariant
52−--
53−-- The data type invariant for lazy 'Text': Every 'Text' is either 'Empty' or
54−-- consists of non-null 'T.Text's. All functions must preserve this,
55−-- and the QC properties must check this.
56−
57−-- | Check the invariant strictly.
58−strictInvariant :: Text -> Bool
59−strictInvariant Empty = True
60−strictInvariant x@(Chunk (T.Text _ _ len) cs)
61− | len > 0 = strictInvariant cs
62− | otherwise = error $ "Data.Text.Lazy: invariant violation: "
63− ++ showStructure x
64−
65−-- | Check the invariant lazily.
66−lazyInvariant :: Text -> Text
67−lazyInvariant Empty = Empty
68−lazyInvariant x@(Chunk c@(T.Text _ _ len) cs)
69− | len > 0 = Chunk c (lazyInvariant cs)
70− | otherwise = error $ "Data.Text.Lazy: invariant violation: "
71− ++ showStructure x
72−
73−-- | Display the internal structure of a lazy 'Text'.
74−showStructure :: Text -> String
75−showStructure Empty = "Empty"
76−showStructure (Chunk t Empty) = "Chunk " ++ show t ++ " Empty"
77−showStructure (Chunk t ts) =
78− "Chunk " ++ show t ++ " (" ++ showStructure ts ++ ")"
79−
80−-- | Smart constructor for 'Chunk'. Guarantees the data type invariant.
81−chunk :: T.Text -> Text -> Text
82−{-# INLINE chunk #-}
83−chunk t@(T.Text _ _ len) ts | len == 0 = ts
84− | otherwise = Chunk t ts
85−
86−-- | Smart constructor for 'Empty'.
87−empty :: Text
88−{-# INLINE [0] empty #-}
89−empty = Empty
90−
91−-- | Consume the chunks of a lazy 'Text' with a natural right fold.
92−foldrChunks :: (T.Text -> a -> a) -> a -> Text -> a
93−foldrChunks f z = go
94− where go Empty = z
95− go (Chunk c cs) = f c (go cs)
96−{-# INLINE foldrChunks #-}
97−
98−-- | Consume the chunks of a lazy 'Text' with a strict, tail-recursive,
99−-- accumulating left fold.
100−foldlChunks :: (a -> T.Text -> a) -> a -> Text -> a
101−foldlChunks f z = go z
102− where go !a Empty = a
103− go !a (Chunk c cs) = go (f a c) cs
104−{-# INLINE foldlChunks #-}
105−
106−-- | Currently set to 16 KiB, less the memory management overhead.
107−defaultChunkSize :: Int
108−defaultChunkSize = 16384 - chunkOverhead
109−{-# INLINE defaultChunkSize #-}
110−
111−-- | Currently set to 128 bytes, less the memory management overhead.
112−smallChunkSize :: Int
113−smallChunkSize = 128 - chunkOverhead
114−{-# INLINE smallChunkSize #-}
115−
116−-- | The memory management overhead. Currently this is tuned for GHC only.
117−chunkOverhead :: Int
118−chunkOverhead = sizeOf (undefined :: Int) `shiftL` 1
119−{-# INLINE chunkOverhead #-}
Data/Text/Internal/Private.hsdeleted−37
@@ -1,37 +0,0 @@
1−{-# LANGUAGE BangPatterns, Rank2Types, UnboxedTuples #-}
2−
3−-- |
4−-- Module : Data.Text.Internal.Private
5−-- Copyright : (c) 2011 Bryan O'Sullivan
6−--
7−-- License : BSD-style
8−-- Maintainer : bos@serpentine.com
9−-- Stability : experimental
10−-- Portability : GHC
11−
12−module Data.Text.Internal.Private
13− (
14− runText
15− , span_
16− ) where
17−
18−import Control.Monad.ST (ST, runST)
19−import Data.Text.Internal (Text(..), text)
20−import Data.Text.Unsafe (Iter(..), iter)
21−import qualified Data.Text.Array as A
22−
23−span_ :: (Char -> Bool) -> Text -> (# Text, Text #)
24−span_ p t@(Text arr off len) = (# hd,tl #)
25− where hd = text arr off k
26− tl = text arr (off+k) (len-k)
27− !k = loop 0
28− loop !i | i < len && p c = loop (i+d)
29− | otherwise = i
30− where Iter c d = iter t i
31−{-# INLINE span_ #-}
32−
33−runText :: (forall s. (A.MArray s -> Int -> ST s Text) -> ST s Text) -> Text
34−runText act = runST (act $ \ !marr !len -> do
35− arr <- A.unsafeFreeze marr
36− return $! text arr 0 len)
37−{-# INLINE runText #-}
Data/Text/Internal/Read.hsdeleted−62
@@ -1,62 +0,0 @@
1−-- |
2−-- Module : Data.Text.Internal.Read
3−-- Copyright : (c) 2014 Bryan O'Sullivan
4−--
5−-- License : BSD-style
6−-- Maintainer : bos@serpentine.com
7−-- Stability : experimental
8−-- Portability : GHC
9−--
10−-- Common internal functions for reading textual data.
11−module Data.Text.Internal.Read
12− (
13− IReader
14− , IParser(..)
15− , T(..)
16− , digitToInt
17− , hexDigitToInt
18− , perhaps
19− ) where
20−
21−import Control.Applicative as App (Applicative(..))
22−import Control.Arrow (first)
23−import Control.Monad (ap)
24−import Data.Char (ord)
25−
26−type IReader t a = t -> Either String (a,t)
27−
28−newtype IParser t a = P {
29− runP :: IReader t a
30− }
31−
32−instance Functor (IParser t) where
33− fmap f m = P $ fmap (first f) . runP m
34−
35−instance Applicative (IParser t) where
36− pure a = P $ \t -> Right (a,t)
37− {-# INLINE pure #-}
38− (<*>) = ap
39−
40−instance Monad (IParser t) where
41− return = App.pure
42− m >>= k = P $ \t -> case runP m t of
43− Left err -> Left err
44− Right (a,t') -> runP (k a) t'
45− {-# INLINE (>>=) #-}
46− fail msg = P $ \_ -> Left msg
47−
48−data T = T !Integer !Int
49−
50−perhaps :: a -> IParser t a -> IParser t a
51−perhaps def m = P $ \t -> case runP m t of
52− Left _ -> Right (def,t)
53− r@(Right _) -> r
54−
55−hexDigitToInt :: Char -> Int
56−hexDigitToInt c
57− | c >= '0' && c <= '9' = ord c - ord '0'
58− | c >= 'a' && c <= 'f' = ord c - (ord 'a' - 10)
59− | otherwise = ord c - (ord 'A' - 10)
60−
61−digitToInt :: Char -> Int
62−digitToInt c = ord c - ord '0'
Data/Text/Lazy.hs+59−276
@@ -1,18 +1,12 @@
1{-# OPTIONS_GHC -fno-warn-orphans #-}
1{-# OPTIONS_GHC -fno-warn-orphans #-}
2−{-# LANGUAGE BangPatterns, MagicHash, CPP #-}
2+{-# LANGUAGE BangPatterns, CPP #-}
3−#if __GLASGOW_HASKELL__ >= 702
4−{-# LANGUAGE Trustworthy #-}
5−#endif
6−#if __GLASGOW_HASKELL__ >= 708
7−{-# LANGUAGE TypeFamilies #-}
8−#endif
9−
10-- |
3-- |
11-- Module : Data.Text.Lazy
4-- Module : Data.Text.Lazy
12−-- Copyright : (c) 2009, 2010, 2012 Bryan O'Sullivan
5+-- Copyright : (c) 2009, 2010 Bryan O'Sullivan
13--
6--
14-- License : BSD-style
7-- License : BSD-style
15−-- Maintainer : bos@serpentine.com
8+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
9+-- duncan@haskell.org
16-- Stability : experimental
10-- Stability : experimental
17-- Portability : GHC
11-- Portability : GHC
18--
12--
@@ -89,7 +83,6 @@ module Data.Text.Lazy
89 , toCaseFold
83 , toCaseFold
90 , toLower
84 , toLower
91 , toUpper
85 , toUpper
92− , toTitle
93
86
94 -- ** Justification
87 -- ** Justification
95 , justifyLeft
88 , justifyLeft
@@ -125,10 +118,7 @@ module Data.Text.Lazy
125 , mapAccumR
118 , mapAccumR
126
119
127 -- ** Generation and unfolding
120 -- ** Generation and unfolding
128− , repeat
129 , replicate
121 , replicate
130− , cycle
131− , iterate
132 , unfoldr
122 , unfoldr
133 , unfoldrN
123 , unfoldrN
134
124
@@ -136,11 +126,8 @@ module Data.Text.Lazy
136
126
137 -- ** Breaking strings
127 -- ** Breaking strings
138 , take
128 , take
139− , takeEnd
140 , drop
129 , drop
141− , dropEnd
142 , takeWhile
130 , takeWhile
143− , takeWhileEnd
144 , dropWhile
131 , dropWhile
145 , dropWhileEnd
132 , dropWhileEnd
146 , dropAround
133 , dropAround
@@ -187,7 +174,7 @@ module Data.Text.Lazy
187 , partition
174 , partition
188
175
189 -- , findSubstring
176 -- , findSubstring
190−
177+
191 -- * Indexing
178 -- * Indexing
192 , index
179 , index
193 , count
180 , count
@@ -203,7 +190,7 @@ module Data.Text.Lazy
203import Prelude (Char, Bool(..), Maybe(..), String,
190import Prelude (Char, Bool(..), Maybe(..), String,
204 Eq(..), Ord(..), Ordering(..), Read(..), Show(..),
191 Eq(..), Ord(..), Ordering(..), Read(..), Show(..),
205 (&&), (||), (+), (-), (.), ($), (++),
192 (&&), (||), (+), (-), (.), ($), (++),
206− error, flip, fmap, fromIntegral, not, otherwise, quot)
193+ div, error, flip, fmap, fromIntegral, not, otherwise)
207import qualified Prelude as P
194import qualified Prelude as P
208#if defined(HAVE_DEEPSEQ)
195#if defined(HAVE_DEEPSEQ)
209import Control.DeepSeq (NFData(..))
196import Control.DeepSeq (NFData(..))
@@ -211,39 +198,25 @@ import Control.DeepSeq (NFData(..))
211import Data.Int (Int64)
198import Data.Int (Int64)
212import qualified Data.List as L
199import qualified Data.List as L
213import Data.Char (isSpace)
200import Data.Char (isSpace)
214−import Data.Data (Data(gfoldl, toConstr, gunfold, dataTypeOf), constrIndex,
201+import Data.Data (Data(gfoldl, toConstr, gunfold, dataTypeOf))
215− Constr, mkConstr, DataType, mkDataType, Fixity(Prefix))
202+#if __GLASGOW_HASKELL__ >= 612
216−import Data.Binary (Binary(get, put))
203+import Data.Data (mkNoRepType)
217−import Data.Monoid (Monoid(..))
204+#else
218−#if MIN_VERSION_base(4,9,0)
205+import Data.Data (mkNorepType)
219−import Data.Semigroup (Semigroup(..))
220#endif
206#endif
207+import Data.Monoid (Monoid(..))
221import Data.String (IsString(..))
208import Data.String (IsString(..))
222import qualified Data.Text as T
209import qualified Data.Text as T
223import qualified Data.Text.Internal as T
210import qualified Data.Text.Internal as T
224−import qualified Data.Text.Internal.Fusion.Common as S
211+import qualified Data.Text.Fusion.Common as S
225import qualified Data.Text.Unsafe as T
212import qualified Data.Text.Unsafe as T
226−import qualified Data.Text.Internal.Lazy.Fusion as S
213+import qualified Data.Text.Lazy.Fusion as S
227−import Data.Text.Internal.Fusion.Types (PairS(..))
214+import Data.Text.Fusion.Internal (PairS(..))
228−import Data.Text.Internal.Lazy.Fusion (stream, unstream)
215+import Data.Text.Lazy.Fusion (stream, unstream)
229−import Data.Text.Internal.Lazy (Text(..), chunk, empty, foldlChunks,
216+import Data.Text.Lazy.Internal (Text(..), chunk, empty, foldlChunks, foldrChunks)
230− foldrChunks, smallChunkSize)
231−import Data.Text.Internal (firstf, safe, text)
217+import Data.Text.Internal (firstf, safe, textP)
232−import Data.Text.Lazy.Encoding (decodeUtf8', encodeUtf8)
233−import qualified Data.Text.Internal.Functions as F
218+import qualified Data.Text.Util as U
234−import Data.Text.Internal.Lazy.Search (indices)
219+import Data.Text.Lazy.Search (indices)
235−#if __GLASGOW_HASKELL__ >= 702
236−import qualified GHC.CString as GHC
237−#else
238−import qualified GHC.Base as GHC
239−#endif
240−#if __GLASGOW_HASKELL__ >= 708
241−import qualified GHC.Exts as Exts
242−#endif
243−import GHC.Prim (Addr#)
244−#if MIN_VERSION_base(4,7,0)
245−import Text.Printf (PrintfArg, formatArg, formatString)
246−#endif
247
220
248-- $fusion
221-- $fusion
249--
222--
@@ -341,72 +314,30 @@ instance Show Text where
341instance Read Text where
314instance Read Text where
342 readsPrec p str = [(pack x,y) | (x,y) <- readsPrec p str]
315 readsPrec p str = [(pack x,y) | (x,y) <- readsPrec p str]
343
316
344−#if MIN_VERSION_base(4,9,0)
345−-- Semigroup orphan instances for older GHCs are provided by
346−-- 'semigroups` package
347−
348−instance Semigroup Text where
349− (<>) = append
350−#endif
351−
352instance Monoid Text where
317instance Monoid Text where
353 mempty = empty
318 mempty = empty
354−#if MIN_VERSION_base(4,9,0)
355− mappend = (<>) -- future-proof definition
356−#else
357 mappend = append
319 mappend = append
358−#endif
359 mconcat = concat
320 mconcat = concat
360
321
361instance IsString Text where
322instance IsString Text where
362 fromString = pack
323 fromString = pack
363
324
364−#if __GLASGOW_HASKELL__ >= 708
365−instance Exts.IsList Text where
366− type Item Text = Char
367− fromList = pack
368− toList = unpack
369−#endif
370−
371#if defined(HAVE_DEEPSEQ)
325#if defined(HAVE_DEEPSEQ)
372instance NFData Text where
326instance NFData Text where
373 rnf Empty = ()
327 rnf Empty = ()
374 rnf (Chunk _ ts) = rnf ts
328 rnf (Chunk _ ts) = rnf ts
375#endif
329#endif
376
330
377−instance Binary Text where
378− put t = put (encodeUtf8 t)
379− get = do
380− bs <- get
381− case decodeUtf8' bs of
382− P.Left exn -> P.fail (P.show exn)
383− P.Right a -> P.return a
384−
385−-- | This instance preserves data abstraction at the cost of inefficiency.
386−-- We omit reflection services for the sake of data abstraction.
387−--
388−-- This instance was created by copying the updated behavior of
389−-- @"Data.Text".@'Data.Text.Text'
390instance Data Text where
331instance Data Text where
391 gfoldl f z txt = z pack `f` (unpack txt)
332 gfoldl f z txt = z pack `f` (unpack txt)
392− toConstr _ = packConstr
333+ toConstr _ = error "Data.Text.Lazy.Text.toConstr"
393− gunfold k z c = case constrIndex c of
394− 1 -> k (z pack)
395− _ -> error "Data.Text.Lazy.Text.gunfold"
334+ gunfold _ _ = error "Data.Text.Lazy.Text.gunfold"
396− dataTypeOf _ = textDataType
335+#if __GLASGOW_HASKELL__ >= 612
397−
336+ dataTypeOf _ = mkNoRepType "Data.Text.Lazy.Text"
398−#if MIN_VERSION_base(4,7,0)
337+#else
399−-- | Only defined for @base-4.7.0.0@ and later
338+ dataTypeOf _ = mkNorepType "Data.Text.Lazy.Text"
400−instance PrintfArg Text where
401− formatArg txt = formatString $ unpack txt
402#endif
339#endif
403
340
404−packConstr :: Constr
405−packConstr = mkConstr textDataType "pack" [] Prefix
406−
407−textDataType :: DataType
408−textDataType = mkDataType "Data.Text.Lazy.Text" [packConstr]
409−
410-- | /O(n)/ Convert a 'String' into a 'Text'.
341-- | /O(n)/ Convert a 'String' into a 'Text'.
411--
342--
412-- Subject to fusion. Performs replacement on invalid scalar values.
343-- Subject to fusion. Performs replacement on invalid scalar values.
@@ -420,27 +351,6 @@ unpack :: Text -> String
420unpack t = S.unstreamList (stream t)
351unpack t = S.unstreamList (stream t)
421{-# INLINE [1] unpack #-}
352{-# INLINE [1] unpack #-}
422
353
423−-- | /O(n)/ Convert a literal string into a Text.
424−unpackCString# :: Addr# -> Text
425−unpackCString# addr# = unstream (S.streamCString# addr#)
426−{-# NOINLINE unpackCString# #-}
427−
428−{-# RULES "TEXT literal" forall a.
429− unstream (S.streamList (L.map safe (GHC.unpackCString# a)))
430− = unpackCString# a #-}
431−
432−{-# RULES "TEXT literal UTF8" forall a.
433− unstream (S.streamList (L.map safe (GHC.unpackCStringUtf8# a)))
434− = unpackCString# a #-}
435−
436−{-# RULES "LAZY TEXT empty literal"
437− unstream (S.streamList (L.map safe []))
438− = Empty #-}
439−
440−{-# RULES "LAZY TEXT empty literal" forall a.
441− unstream (S.streamList (L.map safe [a]))
442− = Chunk (T.singleton a) Empty #-}
443−
444-- | /O(1)/ Convert a character into a Text. Subject to fusion.
354-- | /O(1)/ Convert a character into a Text. Subject to fusion.
445-- Performs replacement on invalid scalar values.
355-- Performs replacement on invalid scalar values.
446singleton :: Char -> Text
356singleton :: Char -> Text
@@ -545,7 +455,7 @@ tail Empty = emptyError "tail"
545 unstream (S.tail (stream t)) = tail t
455 unstream (S.tail (stream t)) = tail t
546 #-}
456 #-}
547
457
548−-- | /O(n\/c)/ Returns all but the last character of a 'Text', which must
458+-- | /O(1)/ Returns all but the last character of a 'Text', which must
549-- be non-empty. Subject to fusion.
459-- be non-empty. Subject to fusion.
550init :: Text -> Text
460init :: Text -> Text
551init (Chunk t0 ts0) = go t0 ts0
461init (Chunk t0 ts0) = go t0 ts0
@@ -581,7 +491,7 @@ isSingleton :: Text -> Bool
581isSingleton = S.isSingleton . stream
491isSingleton = S.isSingleton . stream
582{-# INLINE isSingleton #-}
492{-# INLINE isSingleton #-}
583
493
584−-- | /O(n\/c)/ Returns the last character of a 'Text', which must be
494+-- | /O(1)/ Returns the last character of a 'Text', which must be
585-- non-empty. Subject to fusion.
495-- non-empty. Subject to fusion.
586last :: Text -> Char
496last :: Text -> Char
587last Empty = emptyError "last"
497last Empty = emptyError "last"
@@ -636,7 +546,7 @@ map f t = unstream (S.map (safe . f) (stream t))
636-- 'Text's and concatenates the list after interspersing the first
546-- 'Text's and concatenates the list after interspersing the first
637-- argument between each element of the list.
547-- argument between each element of the list.
638intercalate :: Text -> [Text] -> Text
548intercalate :: Text -> [Text] -> Text
639−intercalate t = concat . (F.intersperse t)
549+intercalate t = concat . (U.intersperse t)
640{-# INLINE intercalate #-}
550{-# INLINE intercalate #-}
641
551
642-- | /O(n)/ The 'intersperse' function takes a character and places it
552-- | /O(n)/ The 'intersperse' function takes a character and places it
@@ -696,7 +606,7 @@ center k c t
696 | otherwise = replicateChar l c `append` t `append` replicateChar r c
606 | otherwise = replicateChar l c `append` t `append` replicateChar r c
697 where len = length t
607 where len = length t
698 d = k - len
608 d = k - len
699− r = d `quot` 2
609+ r = d `div` 2
700 l = d - r
610 l = d - r
701{-# INLINE center #-}
611{-# INLINE center #-}
702
612
@@ -715,36 +625,13 @@ reverse = rev Empty
715 where rev a Empty = a
625 where rev a Empty = a
716 rev a (Chunk t ts) = rev (Chunk (T.reverse t) a) ts
626 rev a (Chunk t ts) = rev (Chunk (T.reverse t) a) ts
717
627
718−-- | /O(m+n)/ Replace every non-overlapping occurrence of @needle@ in
628+-- | /O(m+n)/ Replace every occurrence of one substring with another.
719−-- @haystack@ with @replacement@.
720−--
721−-- This function behaves as though it was defined as follows:
722−--
723−-- @
724−-- replace needle replacement haystack =
725−-- 'intercalate' replacement ('splitOn' needle haystack)
726−-- @
727−--
728−-- As this suggests, each occurrence is replaced exactly once. So if
729−-- @needle@ occurs in @replacement@, that occurrence will /not/ itself
730−-- be replaced recursively:
731−--
732−-- > replace "oo" "foo" "oo" == "foo"
733−--
734−-- In cases where several instances of @needle@ overlap, only the
735−-- first one will be replaced:
736−--
737−-- > replace "ofo" "bar" "ofofo" == "barfo"
738--
629--
739-- In (unlikely) bad cases, this function's time complexity degrades
630-- In (unlikely) bad cases, this function's time complexity degrades
740-- towards /O(n*m)/.
631-- towards /O(n*m)/.
741−replace :: Text
632+replace :: Text -- ^ Text to search for
742− -- ^ @needle@ to search for. If this string is empty, an
633+ -> Text -- ^ Replacement text
743− -- error will occur.
744− -> Text
745− -- ^ @replacement@ to replace @needle@ with.
746− -> Text
634+ -> Text -- ^ Input text
747− -- ^ @haystack@ in which to search.
748 -> Text
635 -> Text
749replace s d = intercalate d . splitOn s
636replace s d = intercalate d . splitOn s
750{-# INLINE replace #-}
637{-# INLINE replace #-}
@@ -761,10 +648,9 @@ replace s d = intercalate d . splitOn s
761-- functions may map one input character to two or three output
648-- functions may map one input character to two or three output
762-- characters.
649-- characters.
763
650
764−-- | /O(n)/ Convert a string to folded case. Subject to fusion.
651+-- | /O(n)/ Convert a string to folded case. This function is mainly
765−--
766−-- This function is mainly useful for performing caseless (or case
652+-- useful for performing caseless (or case insensitive) string
767−-- insensitive) string comparisons.
653+-- comparisons.
768--
654--
769-- A string @x@ is a caseless match for a string @y@ if and only if:
655-- A string @x@ is a caseless match for a string @y@ if and only if:
770--
656--
@@ -781,49 +667,22 @@ toCaseFold t = unstream (S.toCaseFold (stream t))
781{-# INLINE [0] toCaseFold #-}
667{-# INLINE [0] toCaseFold #-}
782
668
783-- | /O(n)/ Convert a string to lower case, using simple case
669-- | /O(n)/ Convert a string to lower case, using simple case
784−-- conversion. Subject to fusion.
785−--
786−-- The result string may be longer than the input string. For
670+-- conversion. The result string may be longer than the input string.
787−-- instance, the Latin capital letter I with dot above (U+0130) maps
671+-- For instance, the Latin capital letter I with dot above (U+0130)
788−-- to the sequence Latin small letter i (U+0069) followed by combining
672+-- maps to the sequence Latin small letter i (U+0069) followed by
789−-- dot above (U+0307).
673+-- combining dot above (U+0307).
790toLower :: Text -> Text
674toLower :: Text -> Text
791toLower t = unstream (S.toLower (stream t))
675toLower t = unstream (S.toLower (stream t))
792{-# INLINE toLower #-}
676{-# INLINE toLower #-}
793
677
794-- | /O(n)/ Convert a string to upper case, using simple case
678-- | /O(n)/ Convert a string to upper case, using simple case
795−-- conversion. Subject to fusion.
796−--
797−-- The result string may be longer than the input string. For
679+-- conversion. The result string may be longer than the input string.
798−-- instance, the German eszett (U+00DF) maps to the two-letter
680+-- For instance, the German eszett (U+00DF) maps to the two-letter
799-- sequence SS.
681-- sequence SS.
800toUpper :: Text -> Text
682toUpper :: Text -> Text
801toUpper t = unstream (S.toUpper (stream t))
683toUpper t = unstream (S.toUpper (stream t))
802{-# INLINE toUpper #-}
684{-# INLINE toUpper #-}
803
685
804−
805−-- | /O(n)/ Convert a string to title case, using simple case
806−-- conversion. Subject to fusion.
807−--
808−-- The first letter of the input is converted to title case, as is
809−-- every subsequent letter that immediately follows a non-letter.
810−-- Every letter that immediately follows another letter is converted
811−-- to lower case.
812−--
813−-- The result string may be longer than the input string. For example,
814−-- the Latin small ligature &#xfb02; (U+FB02) is converted to the
815−-- sequence Latin capital letter F (U+0046) followed by Latin small
816−-- letter l (U+006C).
817−--
818−-- /Note/: this function does not take language or culture specific
819−-- rules into account. For instance, in English, different style
820−-- guides disagree on whether the book name \"The Hill of the Red
821−-- Fox\" is correctly title cased&#x2014;but this function will
822−-- capitalize /every/ word.
823−toTitle :: Text -> Text
824−toTitle t = unstream (S.toTitle (stream t))
825−{-# INLINE toTitle #-}
826−
827-- | /O(n)/ 'foldl', applied to a binary operator, a starting value
686-- | /O(n)/ 'foldl', applied to a binary operator, a starting value
828-- (typically the left-identity of the operator), and a 'Text',
687-- (typically the left-identity of the operator), and a 'Text',
829-- reduces the 'Text' using the binary operator, from left to right.
688-- reduces the 'Text' using the binary operator, from left to right.
@@ -881,13 +740,13 @@ concatMap f = concat . foldr ((:) . f) []
881{-# INLINE concatMap #-}
740{-# INLINE concatMap #-}
882
741
883-- | /O(n)/ 'any' @p@ @t@ determines whether any character in the
742-- | /O(n)/ 'any' @p@ @t@ determines whether any character in the
884−-- 'Text' @t@ satisfies the predicate @p@. Subject to fusion.
743+-- 'Text' @t@ satisifes the predicate @p@. Subject to fusion.
885any :: (Char -> Bool) -> Text -> Bool
744any :: (Char -> Bool) -> Text -> Bool
886any p t = S.any p (stream t)
745any p t = S.any p (stream t)
887{-# INLINE any #-}
746{-# INLINE any #-}
888
747
889-- | /O(n)/ 'all' @p@ @t@ determines whether all characters in the
748-- | /O(n)/ 'all' @p@ @t@ determines whether all characters in the
890−-- 'Text' @t@ satisfy the predicate @p@. Subject to fusion.
749+-- 'Text' @t@ satisify the predicate @p@. Subject to fusion.
891all :: (Char -> Bool) -> Text -> Bool
750all :: (Char -> Bool) -> Text -> Bool
892all p t = S.all p (stream t)
751all p t = S.all p (stream t)
893{-# INLINE all #-}
752{-# INLINE all #-}
@@ -970,12 +829,6 @@ mapAccumR f = go
970 go z Empty = (z, Empty)
829 go z Empty = (z, Empty)
971{-# INLINE mapAccumR #-}
830{-# INLINE mapAccumR #-}
972
831
973−-- | @'repeat' x@ is an infinite 'Text', with @x@ the value of every
974−-- element.
975−repeat :: Char -> Text
976−repeat c = let t = Chunk (T.replicate smallChunkSize (T.singleton c)) t
977− in t
978−
979-- | /O(n*m)/ 'replicate' @n@ @t@ is a 'Text' consisting of the input
832-- | /O(n*m)/ 'replicate' @n@ @t@ is a 'Text' consisting of the input
980-- @t@ repeated @n@ times.
833-- @t@ repeated @n@ times.
981replicate :: Int64 -> Text -> Text
834replicate :: Int64 -> Text -> Text
@@ -985,22 +838,7 @@ replicate n t
985 | otherwise = concat (rep 0)
838 | otherwise = concat (rep 0)
986 where rep !i | i >= n = []
839 where rep !i | i >= n = []
987 | otherwise = t : rep (i+1)
840 | otherwise = t : rep (i+1)
988−{-# INLINE [1] replicate #-}
841+{-# INLINE replicate #-}
989−
990−-- | 'cycle' ties a finite, non-empty 'Text' into a circular one, or
991−-- equivalently, the infinite repetition of the original 'Text'.
992−cycle :: Text -> Text
993−cycle Empty = emptyError "cycle"
994−cycle t = let t' = foldrChunks Chunk t' t
995− in t'
996−
997−-- | @'iterate' f x@ returns an infinite 'Text' of repeated applications
998−-- of @f@ to @x@:
999−--
1000−-- > iterate f x == [x, f x, f (f x), ...]
1001−iterate :: (Char -> Char) -> Char -> Text
1002−iterate f c = let t c' = Chunk (T.singleton c') (t (f c'))
1003− in t c
1004
842
1005-- | /O(n)/ 'replicateChar' @n@ @c@ is a 'Text' of length @n@ with @c@ the
843-- | /O(n)/ 'replicateChar' @n@ @c@ is a 'Text' of length @n@ with @c@ the
1006-- value of every element. Subject to fusion.
844-- value of every element. Subject to fusion.
@@ -1055,22 +893,6 @@ take i t0 = take' i t0
1055 unstream (S.take n (stream t)) = take n t
893 unstream (S.take n (stream t)) = take n t
1056 #-}
894 #-}
1057
895
1058−-- | /O(n)/ 'takeEnd' @n@ @t@ returns the suffix remaining after
1059−-- taking @n@ characters from the end of @t@.
1060−--
1061−-- Examples:
1062−--
1063−-- > takeEnd 3 "foobar" == "bar"
1064−takeEnd :: Int64 -> Text -> Text
1065−takeEnd n t0
1066− | n <= 0 = empty
1067− | otherwise = takeChunk n empty . L.reverse . toChunks $ t0
1068− where takeChunk _ acc [] = acc
1069− takeChunk i acc (t:ts)
1070− | i <= l = chunk (T.takeEnd (fromIntegral i) t) acc
1071− | otherwise = takeChunk (i-l) (Chunk t acc) ts
1072− where l = fromIntegral (T.length t)
1073−
1074-- | /O(n)/ 'drop' @n@, applied to a 'Text', returns the suffix of the
896-- | /O(n)/ 'drop' @n@, applied to a 'Text', returns the suffix of the
1075-- 'Text' after the first @n@ characters, or the empty 'Text' if @n@
897-- 'Text' after the first @n@ characters, or the empty 'Text' if @n@
1076-- is greater than the length of the 'Text'. Subject to fusion.
898-- is greater than the length of the 'Text'. Subject to fusion.
@@ -1080,7 +902,7 @@ drop i t0
1080 | otherwise = drop' i t0
902 | otherwise = drop' i t0
1081 where drop' 0 ts = ts
903 where drop' 0 ts = ts
1082 drop' _ Empty = Empty
904 drop' _ Empty = Empty
1083− drop' n (Chunk t ts)
905+ drop' n (Chunk t ts)
1084 | n < len = Chunk (T.drop (fromIntegral n) t) ts
906 | n < len = Chunk (T.drop (fromIntegral n) t) ts
1085 | otherwise = drop' (n - len) ts
907 | otherwise = drop' (n - len) ts
1086 where len = fromIntegral (T.length t)
908 where len = fromIntegral (T.length t)
@@ -1093,23 +915,6 @@ drop i t0
1093 unstream (S.drop n (stream t)) = drop n t
915 unstream (S.drop n (stream t)) = drop n t
1094 #-}
916 #-}
1095
917
1096−-- | /O(n)/ 'dropEnd' @n@ @t@ returns the prefix remaining after
1097−-- dropping @n@ characters from the end of @t@.
1098−--
1099−-- Examples:
1100−--
1101−-- > dropEnd 3 "foobar" == "foo"
1102−dropEnd :: Int64 -> Text -> Text
1103−dropEnd n t0
1104− | n <= 0 = t0
1105− | otherwise = dropChunk n . L.reverse . toChunks $ t0
1106− where dropChunk _ [] = empty
1107− dropChunk m (t:ts)
1108− | m >= l = dropChunk (m-l) ts
1109− | otherwise = fromChunks . L.reverse $
1110− T.dropEnd (fromIntegral m) t : ts
1111− where l = fromIntegral (T.length t)
1112−
1113-- | /O(n)/ 'dropWords' @n@ returns the suffix with @n@ 'Word16'
918-- | /O(n)/ 'dropWords' @n@ returns the suffix with @n@ 'Word16'
1114-- values dropped, or the empty 'Text' if @n@ is greater than the
919-- values dropped, or the empty 'Text' if @n@ is greater than the
1115-- number of 'Word16' values present.
920-- number of 'Word16' values present.
@@ -1120,7 +925,7 @@ dropWords i t0
1120 where drop' 0 ts = ts
925 where drop' 0 ts = ts
1121 drop' _ Empty = Empty
926 drop' _ Empty = Empty
1122 drop' n (Chunk (T.Text arr off len) ts)
927 drop' n (Chunk (T.Text arr off len) ts)
1123− | n < len' = chunk (text arr (off+n') (len-n')) ts
928+ | n < len' = chunk (textP arr (off+n') (len-n')) ts
1124 | otherwise = drop' (n - len') ts
929 | otherwise = drop' (n - len') ts
1125 where len' = fromIntegral len
930 where len' = fromIntegral len
1126 n' = fromIntegral n
931 n' = fromIntegral n
@@ -1144,20 +949,6 @@ takeWhile p t0 = takeWhile' t0
1144"LAZY TEXT takeWhile -> unfused" [1] forall p t.
949"LAZY TEXT takeWhile -> unfused" [1] forall p t.
1145 unstream (S.takeWhile p (stream t)) = takeWhile p t
950 unstream (S.takeWhile p (stream t)) = takeWhile p t
1146 #-}
951 #-}
1147−-- | /O(n)/ 'takeWhileEnd', applied to a predicate @p@ and a 'Text',
1148−-- returns the longest suffix (possibly empty) of elements that
1149−-- satisfy @p@.
1150−-- Examples:
1151−--
1152−-- > takeWhileEnd (=='o') "foo" == "oo"
1153−takeWhileEnd :: (Char -> Bool) -> Text -> Text
1154−takeWhileEnd p = takeChunk empty . L.reverse . toChunks
1155− where takeChunk acc [] = acc
1156− takeChunk acc (t:ts) = if T.length t' < T.length t
1157− then (Chunk t' acc)
1158− else takeChunk (Chunk t' acc) ts
1159− where t' = T.takeWhileEnd p t
1160−{-# INLINE takeWhileEnd #-}
1161
952
1162-- | /O(n)/ 'dropWhile' @p@ @t@ returns the suffix remaining after
953-- | /O(n)/ 'dropWhile' @p@ @t@ returns the suffix remaining after
1163-- 'takeWhile' @p@ @t@. Subject to fusion.
954-- 'takeWhile' @p@ @t@. Subject to fusion.
@@ -1176,11 +967,9 @@ dropWhile p t0 = dropWhile' t0
1176"LAZY TEXT dropWhile -> unfused" [1] forall p t.
967"LAZY TEXT dropWhile -> unfused" [1] forall p t.
1177 unstream (S.dropWhile p (stream t)) = dropWhile p t
968 unstream (S.dropWhile p (stream t)) = dropWhile p t
1178 #-}
969 #-}
1179−
1180-- | /O(n)/ 'dropWhileEnd' @p@ @t@ returns the prefix remaining after
970-- | /O(n)/ 'dropWhileEnd' @p@ @t@ returns the prefix remaining after
1181−-- dropping characters that satisfy the predicate @p@ from the end of
971+-- dropping characters that fail the predicate @p@ from the end of
1182-- @t@.
972-- @t@.
1183−--
1184-- Examples:
973-- Examples:
1185--
974--
1186-- > dropWhileEnd (=='.') "foo..." == "foo"
975-- > dropWhileEnd (=='.') "foo..." == "foo"
@@ -1197,7 +986,7 @@ dropWhileEnd p = go
1197{-# INLINE dropWhileEnd #-}
986{-# INLINE dropWhileEnd #-}
1198
987
1199-- | /O(n)/ 'dropAround' @p@ @t@ returns the substring remaining after
988-- | /O(n)/ 'dropAround' @p@ @t@ returns the substring remaining after
1200−-- dropping characters that satisfy the predicate @p@ from both the
989+-- dropping characters that fail the predicate @p@ from both the
1201-- beginning and end of @t@. Subject to fusion.
990-- beginning and end of @t@. Subject to fusion.
1202dropAround :: (Char -> Bool) -> Text -> Text
991dropAround :: (Char -> Bool) -> Text -> Text
1203dropAround p = dropWhile p . dropWhileEnd p
992dropAround p = dropWhile p . dropWhileEnd p
@@ -1247,8 +1036,8 @@ splitAtWord _ Empty = empty :*: empty
1247splitAtWord x (Chunk c@(T.Text arr off len) cs)
1036splitAtWord x (Chunk c@(T.Text arr off len) cs)
1248 | y >= len = let h :*: t = splitAtWord (x-fromIntegral len) cs
1037 | y >= len = let h :*: t = splitAtWord (x-fromIntegral len) cs
1249 in Chunk c h :*: t
1038 in Chunk c h :*: t
1250− | otherwise = chunk (text arr off y) empty :*:
1039+ | otherwise = chunk (textP arr off y) empty :*:
1251− chunk (text arr (off+y) (len-y)) cs
1040+ chunk (textP arr (off+y) (len-y)) cs
1252 where y = fromIntegral x
1041 where y = fromIntegral x
1253
1042
1254-- | /O(n+m)/ Find the first instance of @needle@ (which must be
1043-- | /O(n+m)/ Find the first instance of @needle@ (which must be
@@ -1267,7 +1056,7 @@ splitAtWord x (Chunk c@(T.Text arr off len) cs)
1267-- > where (prefix, match) = breakOn needle haystack
1056-- > where (prefix, match) = breakOn needle haystack
1268--
1057--
1269-- If you need to break a string by a substring repeatedly (e.g. you
1058-- If you need to break a string by a substring repeatedly (e.g. you
1270−-- want to break on every instance of a substring), use 'breakOnAll'
1059+-- want to break on every instance of a substring), use 'find'
1271-- instead, as it has lower startup overhead.
1060-- instead, as it has lower startup overhead.
1272--
1061--
1273-- This function is strict in its first argument, and lazy in its
1062-- This function is strict in its first argument, and lazy in its
@@ -1392,34 +1181,28 @@ tails ts@(Chunk t ts')
1392-- copies to create substrings; they just construct new 'Text's that
1181-- copies to create substrings; they just construct new 'Text's that
1393-- are slices of the original.
1182-- are slices of the original.
1394
1183
1395−-- | /O(m+n)/ Break a 'Text' into pieces separated by the first 'Text'
1184+-- | /O(m+n)/ Break a 'Text' into pieces separated by the first
1396−-- argument (which cannot be an empty string), consuming the
1185+-- 'Text' argument, consuming the delimiter. An empty delimiter is
1397−-- delimiter. An empty delimiter is invalid, and will cause an error
1186+-- invalid, and will cause an error to be raised.
1398−-- to be raised.
1399--
1187--
1400-- Examples:
1188-- Examples:
1401--
1189--
1402-- > splitOn "\r\n" "a\r\nb\r\nd\r\ne" == ["a","b","d","e"]
1190-- > splitOn "\r\n" "a\r\nb\r\nd\r\ne" == ["a","b","d","e"]
1403-- > splitOn "aaa" "aaaXaaaXaaaXaaa" == ["","X","X","X",""]
1191-- > splitOn "aaa" "aaaXaaaXaaaXaaa" == ["","X","X","X",""]
1404-- > splitOn "x" "x" == ["",""]
1192-- > splitOn "x" "x" == ["",""]
1405−--
1193+--
1406-- and
1194-- and
1407--
1195--
1408-- > intercalate s . splitOn s == id
1196-- > intercalate s . splitOn s == id
1409-- > splitOn (singleton c) == split (==c)
1197-- > splitOn (singleton c) == split (==c)
1410--
1198--
1411−-- (Note: the string @s@ to split on above cannot be empty.)
1412−--
1413-- This function is strict in its first argument, and lazy in its
1199-- This function is strict in its first argument, and lazy in its
1414-- second.
1200-- second.
1415--
1201--
1416-- In (unlikely) bad cases, this function's time complexity degrades
1202-- In (unlikely) bad cases, this function's time complexity degrades
1417-- towards /O(n*m)/.
1203-- towards /O(n*m)/.
1418−splitOn :: Text
1204+splitOn :: Text -- ^ Text to split on
1419− -- ^ String to split on. If this string is empty, an error
1420− -- will occur.
1421− -> Text
1422− -- ^ Input text.
1205+ -> Text -- ^ Input text
1423 -> [Text]
1206 -> [Text]
1424splitOn pat src
1207splitOn pat src
1425 | null pat = emptyError "splitOn"
1208 | null pat = emptyError "splitOn"
Data/Text/Lazy/Builder.hs+272−18
@@ -1,15 +1,11 @@
1{-# LANGUAGE BangPatterns, CPP, Rank2Types #-}
1{-# LANGUAGE BangPatterns, CPP, Rank2Types #-}
2−#if __GLASGOW_HASKELL__ >= 702
3−{-# LANGUAGE Trustworthy #-}
4−#endif
5
2
6-----------------------------------------------------------------------------
3-----------------------------------------------------------------------------
7-- |
4-- |
8-- Module : Data.Text.Lazy.Builder
5-- Module : Data.Text.Lazy.Builder
9−-- Copyright : (c) 2013 Bryan O'Sullivan
10−-- (c) 2010 Johan Tibell
6+-- Copyright : (c) 2010 Johan Tibell
11−-- License : BSD-style (see LICENSE)
7+-- License : BSD3-style (see LICENSE)
12−--
8+--
13-- Maintainer : Johan Tibell <johan.tibell@gmail.com>
9-- Maintainer : Johan Tibell <johan.tibell@gmail.com>
14-- Stability : experimental
10-- Stability : experimental
15-- Portability : portable to Hugs and GHC
11-- Portability : portable to Hugs and GHC
@@ -19,9 +15,7 @@
19-- @fromLazyText@, which construct new builders, and 'mappend', which
15-- @fromLazyText@, which construct new builders, and 'mappend', which
20-- concatenates two builders.
16-- concatenates two builders.
21--
17--
22−-- To get maximum performance when building lazy @Text@ values using a
18+-- To get maximum performance when building lazy @Text@ values using a builder, associate @mappend@ calls to the right. For example, prefer
23−-- builder, associate @mappend@ calls to the right. For example,
24−-- prefer
25--
19--
26-- > singleton 'a' `mappend` (singleton 'b' `mappend` singleton 'c')
20-- > singleton 'a' `mappend` (singleton 'b' `mappend` singleton 'c')
27--
21--
@@ -29,14 +23,8 @@
29--
23--
30-- > singleton 'a' `mappend` singleton 'b' `mappend` singleton 'c'
24-- > singleton 'a' `mappend` singleton 'b' `mappend` singleton 'c'
31--
25--
32−-- as the latter associates @mappend@ to the left. Or, equivalently,
26+-- as the latter associates @mappend@ to the left.
33−-- prefer
34−--
35−-- > singleton 'a' <> singleton 'b' <> singleton 'c'
36--
27--
37−-- since the '<>' from recent versions of 'Data.Monoid' associates
38−-- to the right.
39−
40-----------------------------------------------------------------------------
28-----------------------------------------------------------------------------
41
29
42module Data.Text.Lazy.Builder
30module Data.Text.Lazy.Builder
@@ -55,4 +43,270 @@ module Data.Text.Lazy.Builder
55 , flush
43 , flush
56 ) where
44 ) where
57
45
46+import Control.Monad.ST (ST, runST)
47+import Data.Bits ((.&.))
48+import Data.Monoid (Monoid(..))
58−import Data.Text.Internal.Builder
49+import Data.Text.Internal (Text(..))
50+import Data.Text.Lazy.Internal (smallChunkSize)
51+import Data.Text.Unsafe (inlineInterleaveST)
52+import Data.Text.UnsafeChar (ord, unsafeWrite)
53+import Data.Text.UnsafeShift (shiftR)
54+import Prelude hiding (map, putChar)
55+
56+import qualified Data.String as String
57+import qualified Data.Text as S
58+import qualified Data.Text.Array as A
59+import qualified Data.Text.Lazy as L
60+
61+------------------------------------------------------------------------
62+
63+-- | A @Builder@ is an efficient way to build lazy @Text@ values.
64+-- There are several functions for constructing builders, but only one
65+-- to inspect them: to extract any data, you have to turn them into
66+-- lazy @Text@ values using @toLazyText@.
67+--
68+-- Internally, a builder constructs a lazy @Text@ by filling arrays
69+-- piece by piece. As each buffer is filled, it is \'popped\' off, to
70+-- become a new chunk of the resulting lazy @Text@. All this is
71+-- hidden from the user of the @Builder@.
72+newtype Builder = Builder {
73+ -- Invariant (from Data.Text.Lazy):
74+ -- The lists include no null Texts.
75+ runBuilder :: forall s. (Buffer s -> ST s [S.Text])
76+ -> Buffer s
77+ -> ST s [S.Text]
78+ }
79+
80+instance Monoid Builder where
81+ mempty = empty
82+ {-# INLINE mempty #-}
83+ mappend = append
84+ {-# INLINE mappend #-}
85+ mconcat = foldr mappend mempty
86+ {-# INLINE mconcat #-}
87+
88+instance String.IsString Builder where
89+ fromString = fromString
90+ {-# INLINE fromString #-}
91+
92+instance Show Builder where
93+ show = show . toLazyText
94+
95+instance Eq Builder where
96+ a == b = toLazyText a == toLazyText b
97+
98+instance Ord Builder where
99+ a <= b = toLazyText a <= toLazyText b
100+
101+------------------------------------------------------------------------
102+
103+-- | /O(1)./ The empty @Builder@, satisfying
104+--
105+-- * @'toLazyText' 'empty' = 'L.empty'@
106+--
107+empty :: Builder
108+empty = Builder (\ k buf -> k buf)
109+{-# INLINE empty #-}
110+
111+-- | /O(1)./ A @Builder@ taking a single character, satisfying
112+--
113+-- * @'toLazyText' ('singleton' c) = 'L.singleton' c@
114+--
115+singleton :: Char -> Builder
116+singleton c = writeAtMost 2 $ \ marr o ->
117+ if n < 0x10000
118+ then A.unsafeWrite marr o (fromIntegral n) >> return 1
119+ else do
120+ A.unsafeWrite marr o lo
121+ A.unsafeWrite marr (o+1) hi
122+ return 2
123+ where n = ord c
124+ m = n - 0x10000
125+ lo = fromIntegral $ (m `shiftR` 10) + 0xD800
126+ hi = fromIntegral $ (m .&. 0x3FF) + 0xDC00
127+{-# INLINE singleton #-}
128+
129+------------------------------------------------------------------------
130+
131+-- | /O(1)./ The concatenation of two builders, an associative
132+-- operation with identity 'empty', satisfying
133+--
134+-- * @'toLazyText' ('append' x y) = 'L.append' ('toLazyText' x) ('toLazyText' y)@
135+--
136+append :: Builder -> Builder -> Builder
137+append (Builder f) (Builder g) = Builder (f . g)
138+{-# INLINE [0] append #-}
139+
140+-- TODO: Experiment to find the right threshold.
141+copyLimit :: Int
142+copyLimit = 128
143+
144+-- This function attempts to merge small @Text@ values instead of
145+-- treating each value as its own chunk. We may not always want this.
146+
147+-- | /O(1)./ A @Builder@ taking a 'S.Text', satisfying
148+--
149+-- * @'toLazyText' ('fromText' t) = 'L.fromChunks' [t]@
150+--
151+fromText :: S.Text -> Builder
152+fromText t@(Text arr off l)
153+ | S.null t = empty
154+ | l <= copyLimit = writeN l $ \marr o -> A.copyI marr o arr off (l+o)
155+ | otherwise = flush `append` mapBuilder (t :)
156+{-# INLINE [1] fromText #-}
157+
158+{-# RULES
159+"fromText/pack" forall s .
160+ fromText (S.pack s) = fromString s
161+ #-}
162+
163+-- | /O(1)./ A Builder taking a @String@, satisfying
164+--
165+-- * @'toLazyText' ('fromString' s) = 'L.fromChunks' [S.pack s]@
166+--
167+fromString :: String -> Builder
168+fromString str = Builder $ \k (Buffer p0 o0 u0 l0) ->
169+ let loop !marr !o !u !l [] = k (Buffer marr o u l)
170+ loop marr o u l s@(c:cs)
171+ | l <= 1 = do
172+ arr <- A.unsafeFreeze marr
173+ let !t = Text arr o u
174+ marr' <- A.new chunkSize
175+ ts <- inlineInterleaveST (loop marr' 0 0 chunkSize s)
176+ return $ t : ts
177+ | otherwise = do
178+ n <- unsafeWrite marr (o+u) c
179+ loop marr o (u+n) (l-n) cs
180+ in loop p0 o0 u0 l0 str
181+ where
182+ chunkSize = smallChunkSize
183+{-# INLINE fromString #-}
184+
185+-- | /O(1)./ A @Builder@ taking a lazy @Text@, satisfying
186+--
187+-- * @'toLazyText' ('fromLazyText' t) = t@
188+--
189+fromLazyText :: L.Text -> Builder
190+fromLazyText ts = flush `append` mapBuilder (L.toChunks ts ++)
191+{-# INLINE fromLazyText #-}
192+
193+------------------------------------------------------------------------
194+
195+-- Our internal buffer type
196+data Buffer s = Buffer {-# UNPACK #-} !(A.MArray s)
197+ {-# UNPACK #-} !Int -- offset
198+ {-# UNPACK #-} !Int -- used units
199+ {-# UNPACK #-} !Int -- length left
200+
201+------------------------------------------------------------------------
202+
203+-- | /O(n)./ Extract a lazy @Text@ from a @Builder@ with a default
204+-- buffer size. The construction work takes place if and when the
205+-- relevant part of the lazy @Text@ is demanded.
206+toLazyText :: Builder -> L.Text
207+toLazyText = toLazyTextWith smallChunkSize
208+
209+-- | /O(n)./ Extract a lazy @Text@ from a @Builder@, using the given
210+-- size for the initial buffer. The construction work takes place if
211+-- and when the relevant part of the lazy @Text@ is demanded.
212+--
213+-- If the initial buffer is too small to hold all data, subsequent
214+-- buffers will be the default buffer size.
215+toLazyTextWith :: Int -> Builder -> L.Text
216+toLazyTextWith chunkSize m = L.fromChunks (runST $
217+ newBuffer chunkSize >>= runBuilder (m `append` flush) (const (return [])))
218+
219+-- | /O(1)./ Pop the strict @Text@ we have constructed so far, if any,
220+-- yielding a new chunk in the result lazy @Text@.
221+flush :: Builder
222+flush = Builder $ \ k buf@(Buffer p o u l) ->
223+ if u == 0
224+ then k buf
225+ else do arr <- A.unsafeFreeze p
226+ let !b = Buffer p (o+u) 0 l
227+ !t = Text arr o u
228+ ts <- inlineInterleaveST (k b)
229+ return $! t : ts
230+
231+------------------------------------------------------------------------
232+
233+-- | Sequence an ST operation on the buffer
234+withBuffer :: (forall s. Buffer s -> ST s (Buffer s)) -> Builder
235+withBuffer f = Builder $ \k buf -> f buf >>= k
236+{-# INLINE withBuffer #-}
237+
238+-- | Get the size of the buffer
239+withSize :: (Int -> Builder) -> Builder
240+withSize f = Builder $ \ k buf@(Buffer _ _ _ l) ->
241+ runBuilder (f l) k buf
242+{-# INLINE withSize #-}
243+
244+-- | Map the resulting list of texts.
245+mapBuilder :: ([S.Text] -> [S.Text]) -> Builder
246+mapBuilder f = Builder (fmap f .)
247+
248+------------------------------------------------------------------------
249+
250+-- | Ensure that there are at least @n@ many elements available.
251+ensureFree :: Int -> Builder
252+ensureFree !n = withSize $ \ l ->
253+ if n <= l
254+ then empty
255+ else flush `append'` withBuffer (const (newBuffer (max n smallChunkSize)))
256+{-# INLINE [0] ensureFree #-}
257+
258+writeAtMost :: Int -> (forall s. A.MArray s -> Int -> ST s Int) -> Builder
259+writeAtMost n f = ensureFree n `append'` withBuffer (writeBuffer f)
260+{-# INLINE [0] writeAtMost #-}
261+
262+-- | Ensure that @n@ many elements are available, and then use @f@ to
263+-- write some elements into the memory.
264+writeN :: Int -> (forall s. A.MArray s -> Int -> ST s ()) -> Builder
265+writeN n f = writeAtMost n (\ p o -> f p o >> return n)
266+{-# INLINE writeN #-}
267+
268+writeBuffer :: (A.MArray s -> Int -> ST s Int) -> Buffer s -> ST s (Buffer s)
269+writeBuffer f (Buffer p o u l) = do
270+ n <- f p (o+u)
271+ return $! Buffer p o (u+n) (l-n)
272+{-# INLINE writeBuffer #-}
273+
274+newBuffer :: Int -> ST s (Buffer s)
275+newBuffer size = do
276+ arr <- A.new size
277+ return $! Buffer arr 0 0 size
278+{-# INLINE newBuffer #-}
279+
280+------------------------------------------------------------------------
281+-- Some nice rules for Builder
282+
283+-- This function makes GHC understand that 'writeN' and 'ensureFree'
284+-- are *not* recursive in the precense of the rewrite rules below.
285+-- This is not needed with GHC 7+.
286+append' :: Builder -> Builder -> Builder
287+append' (Builder f) (Builder g) = Builder (f . g)
288+{-# INLINE append' #-}
289+
290+{-# RULES
291+
292+"append/writeAtMost" forall a b (f::forall s. A.MArray s -> Int -> ST s Int)
293+ (g::forall s. A.MArray s -> Int -> ST s Int) ws.
294+ append (writeAtMost a f) (append (writeAtMost b g) ws) =
295+ append (writeAtMost (a+b) (\marr o -> f marr o >>= \ n ->
296+ g marr (o+n) >>= \ m ->
297+ let s = n+m in s `seq` return s)) ws
298+
299+"writeAtMost/writeAtMost" forall a b (f::forall s. A.MArray s -> Int -> ST s Int)
300+ (g::forall s. A.MArray s -> Int -> ST s Int).
301+ append (writeAtMost a f) (writeAtMost b g) =
302+ writeAtMost (a+b) (\marr o -> f marr o >>= \ n ->
303+ g marr (o+n) >>= \ m ->
304+ let s = n+m in s `seq` return s)
305+
306+"ensureFree/ensureFree" forall a b .
307+ append (ensureFree a) (ensureFree b) = ensureFree (max a b)
308+
309+"flush/flush"
310+ append flush flush = flush
311+
312+ #-}
Data/Text/Internal/Builder/Functions.hs → Data/Text/Lazy/Builder/Functions.hsrenamed+3−8
@@ -1,7 +1,7 @@
1{-# LANGUAGE MagicHash #-}
1{-# LANGUAGE MagicHash #-}
2
2
3-- |
3-- |
4−-- Module : Data.Text.Internal.Builder.Functions
4+-- Module : Data.Text.Lazy.Builder.Functions
5-- Copyright : (c) 2011 MailRank, Inc.
5-- Copyright : (c) 2011 MailRank, Inc.
6--
6--
7-- License : BSD-style
7-- License : BSD-style
@@ -9,13 +9,9 @@
9-- Stability : experimental
9-- Stability : experimental
10-- Portability : GHC
10-- Portability : GHC
11--
11--
12−-- /Warning/: this is an internal module, and does not have a stable
13−-- API or name. Functions in this module may not check or enforce
14−-- preconditions expected by public modules. Use at your own risk!
15−--
16-- Useful functions and combinators.
12-- Useful functions and combinators.
17
13
18−module Data.Text.Internal.Builder.Functions
14+module Data.Text.Lazy.Builder.Functions
19 (
15 (
20 (<>)
16 (<>)
21 , i2d
17 , i2d
@@ -23,8 +19,7 @@ module Data.Text.Internal.Builder.Functions
23
19
24import Data.Monoid (mappend)
20import Data.Monoid (mappend)
25import Data.Text.Lazy.Builder (Builder)
21import Data.Text.Lazy.Builder (Builder)
26−import GHC.Base (chr#,ord#,(+#),Int(I#),Char(C#))
22+import GHC.Base
27−import Prelude ()
28
23
29-- | Unsafe conversion for decimal digits.
24-- | Unsafe conversion for decimal digits.
30{-# INLINE i2d #-}
25{-# INLINE i2d #-}
Data/Text/Lazy/Builder/Int.hs+37−147
@@ -1,13 +1,8 @@
1−{-# LANGUAGE BangPatterns, CPP, MagicHash, RankNTypes, ScopedTypeVariables,
1+{-# LANGUAGE BangPatterns, CPP, MagicHash, UnboxedTuples #-}
2− UnboxedTuples #-}
3−#if __GLASGOW_HASKELL__ >= 702
4−{-# LANGUAGE Trustworthy #-}
5−#endif
6
2
7-- Module: Data.Text.Lazy.Builder.Int
3-- Module: Data.Text.Lazy.Builder.Int
8−-- Copyright: (c) 2013 Bryan O'Sullivan
9−-- (c) 2011 MailRank, Inc.
4+-- Copyright: (c) 2011 MailRank, Inc.
10−-- License: BSD-style
5+-- License: BSD3
11-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>
6-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>
12-- Stability: experimental
7-- Stability: experimental
13-- Portability: portable
8-- Portability: portable
@@ -22,142 +17,45 @@ module Data.Text.Lazy.Builder.Int
22
17
23import Data.Int (Int8, Int16, Int32, Int64)
18import Data.Int (Int8, Int16, Int32, Int64)
24import Data.Monoid (mempty)
19import Data.Monoid (mempty)
25−import qualified Data.ByteString.Unsafe as B
26−import Data.Text.Internal.Builder.Functions ((<>), i2d)
20+import Data.Text.Lazy.Builder.Functions ((<>), i2d)
27−import Data.Text.Internal.Builder
21+import Data.Text.Lazy.Builder
28−import Data.Text.Internal.Builder.Int.Digits (digits)
29−import Data.Text.Array
30import Data.Word (Word, Word8, Word16, Word32, Word64)
22import Data.Word (Word, Word8, Word16, Word32, Word64)
31import GHC.Base (quotInt, remInt)
23import GHC.Base (quotInt, remInt)
32import GHC.Num (quotRemInteger)
24import GHC.Num (quotRemInteger)
33import GHC.Types (Int(..))
25import GHC.Types (Int(..))
34−import Control.Monad.ST
35
26
36#ifdef __GLASGOW_HASKELL__
27#ifdef __GLASGOW_HASKELL__
37−# if defined(INTEGER_GMP)
28+# if __GLASGOW_HASKELL__ < 611
38−import GHC.Integer.GMP.Internals (Integer(S#))
29+import GHC.Integer.Internals
39−# elif defined(INTEGER_SIMPLE)
40−import GHC.Integer
41# else
30# else
42−# error "You need to use either GMP or integer-simple."
31+import GHC.Integer.GMP.Internals
43# endif
32# endif
44#endif
33#endif
45
34
46−#if defined(INTEGER_GMP) || defined(INTEGER_SIMPLE)
35+#ifdef INTEGER_GMP
47# define PAIR(a,b) (# a,b #)
36# define PAIR(a,b) (# a,b #)
48#else
37#else
49# define PAIR(a,b) (a,b)
38# define PAIR(a,b) (a,b)
50#endif
39#endif
51
40
52decimal :: Integral a => a -> Builder
41decimal :: Integral a => a -> Builder
53−{-# RULES "decimal/Int8" decimal = boundedDecimal :: Int8 -> Builder #-}
42+{-# SPECIALIZE decimal :: Int -> Builder #-}
54−{-# RULES "decimal/Int" decimal = boundedDecimal :: Int -> Builder #-}
43+{-# SPECIALIZE decimal :: Int8 -> Builder #-}
55−{-# RULES "decimal/Int16" decimal = boundedDecimal :: Int16 -> Builder #-}
44+{-# SPECIALIZE decimal :: Int16 -> Builder #-}
56−{-# RULES "decimal/Int32" decimal = boundedDecimal :: Int32 -> Builder #-}
45+{-# SPECIALIZE decimal :: Int32 -> Builder #-}
57−{-# RULES "decimal/Int64" decimal = boundedDecimal :: Int64 -> Builder #-}
46+{-# SPECIALIZE decimal :: Int64 -> Builder #-}
58−{-# RULES "decimal/Word" decimal = positive :: Data.Word.Word -> Builder #-}
47+{-# SPECIALIZE decimal :: Word -> Builder #-}
59−{-# RULES "decimal/Word8" decimal = positive :: Word8 -> Builder #-}
48+{-# SPECIALIZE decimal :: Word8 -> Builder #-}
60−{-# RULES "decimal/Word16" decimal = positive :: Word16 -> Builder #-}
49+{-# SPECIALIZE decimal :: Word16 -> Builder #-}
61−{-# RULES "decimal/Word32" decimal = positive :: Word32 -> Builder #-}
50+{-# SPECIALIZE decimal :: Word32 -> Builder #-}
62−{-# RULES "decimal/Word64" decimal = positive :: Word64 -> Builder #-}
51+{-# SPECIALIZE decimal :: Word64 -> Builder #-}
63{-# RULES "decimal/Integer" decimal = integer 10 :: Integer -> Builder #-}
52{-# RULES "decimal/Integer" decimal = integer 10 :: Integer -> Builder #-}
64−decimal i = decimal' (<= -128) i
53+decimal i
65−{-# NOINLINE decimal #-}
54+ | i < 0 = singleton '-' <> go (-i)
66−
67−boundedDecimal :: (Integral a, Bounded a) => a -> Builder
68−{-# SPECIALIZE boundedDecimal :: Int -> Builder #-}
69−{-# SPECIALIZE boundedDecimal :: Int8 -> Builder #-}
70−{-# SPECIALIZE boundedDecimal :: Int16 -> Builder #-}
71−{-# SPECIALIZE boundedDecimal :: Int32 -> Builder #-}
72−{-# SPECIALIZE boundedDecimal :: Int64 -> Builder #-}
73−boundedDecimal i = decimal' (== minBound) i
74−
75−decimal' :: (Integral a) => (a -> Bool) -> a -> Builder
76−{-# INLINE decimal' #-}
77−decimal' p i
78− | i < 0 = if p i
79− then let (q, r) = i `quotRem` 10
80− qq = -q
81− !n = countDigits qq
82− in writeN (n + 2) $ \marr off -> do
83− unsafeWrite marr off minus
84− posDecimal marr (off+1) n qq
85− unsafeWrite marr (off+n+1) (i2w (-r))
86− else let j = -i
87− !n = countDigits j
88− in writeN (n + 1) $ \marr off ->
89− unsafeWrite marr off minus >> posDecimal marr (off+1) n j
90− | otherwise = positive i
91−
92−positive :: (Integral a) => a -> Builder
93−{-# SPECIALIZE positive :: Int -> Builder #-}
94−{-# SPECIALIZE positive :: Int8 -> Builder #-}
95−{-# SPECIALIZE positive :: Int16 -> Builder #-}
96−{-# SPECIALIZE positive :: Int32 -> Builder #-}
97−{-# SPECIALIZE positive :: Int64 -> Builder #-}
98−{-# SPECIALIZE positive :: Word -> Builder #-}
99−{-# SPECIALIZE positive :: Word8 -> Builder #-}
100−{-# SPECIALIZE positive :: Word16 -> Builder #-}
101−{-# SPECIALIZE positive :: Word32 -> Builder #-}
102−{-# SPECIALIZE positive :: Word64 -> Builder #-}
103−positive i
104− | i < 10 = writeN 1 $ \marr off -> unsafeWrite marr off (i2w i)
105− | otherwise = let !n = countDigits i
106− in writeN n $ \marr off -> posDecimal marr off n i
107−
108−posDecimal :: (Integral a) =>
109− forall s. MArray s -> Int -> Int -> a -> ST s ()
110−{-# INLINE posDecimal #-}
111−posDecimal marr off0 ds v0 = go (off0 + ds - 1) v0
112− where go off v
113− | v >= 100 = do
114− let (q, r) = v `quotRem` 100
115− write2 off r
116− go (off - 2) q
117− | v < 10 = unsafeWrite marr off (i2w v)
118− | otherwise = write2 off v
119− write2 off i0 = do
120− let i = fromIntegral i0; j = i + i
121− unsafeWrite marr off $ get (j + 1)
122− unsafeWrite marr (off - 1) $ get j
123− get = fromIntegral . B.unsafeIndex digits
124−
125−minus, zero :: Word16
126−{-# INLINE minus #-}
127−{-# INLINE zero #-}
128−minus = 45
129−zero = 48
130−
131−i2w :: (Integral a) => a -> Word16
132−{-# INLINE i2w #-}
133−i2w v = zero + fromIntegral v
134−
135−countDigits :: (Integral a) => a -> Int
136−{-# INLINE countDigits #-}
137−countDigits v0
138− | fromIntegral v64 == v0 = go 1 v64
139− | otherwise = goBig 1 (fromIntegral v0)
140− where v64 = fromIntegral v0
141− goBig !k (v :: Integer)
142− | v > big = goBig (k + 19) (v `quot` big)
143− | otherwise = go k (fromIntegral v)
55+ | otherwise = go i
144− big = 10000000000000000000
56+ where
145− go !k (v :: Word64)
57+ go n | n < 10 = digit n
146− | v < 10 = k
147− | v < 100 = k + 1
148− | v < 1000 = k + 2
149− | v < 1000000000000 =
150− k + if v < 100000000
151− then if v < 1000000
152− then if v < 10000
153− then 3
154− else 4 + fin v 100000
155− else 6 + fin v 10000000
156− else if v < 10000000000
157− then 8 + fin v 1000000000
158− else 10 + fin v 100000000000
159− | otherwise = go (k + 12) (v `quot` 1000000000000)
58+ | otherwise = go (n `quot` 10) <> digit (n `rem` 10)
160− fin v n = if v >= n then 1 else 0
161
59
162hexadecimal :: Integral a => a -> Builder
60hexadecimal :: Integral a => a -> Builder
163{-# SPECIALIZE hexadecimal :: Int -> Builder #-}
61{-# SPECIALIZE hexadecimal :: Int -> Builder #-}
@@ -170,23 +68,17 @@ hexadecimal :: Integral a => a -> Builder
170{-# SPECIALIZE hexadecimal :: Word16 -> Builder #-}
68{-# SPECIALIZE hexadecimal :: Word16 -> Builder #-}
171{-# SPECIALIZE hexadecimal :: Word32 -> Builder #-}
69{-# SPECIALIZE hexadecimal :: Word32 -> Builder #-}
172{-# SPECIALIZE hexadecimal :: Word64 -> Builder #-}
70{-# SPECIALIZE hexadecimal :: Word64 -> Builder #-}
173−{-# RULES "hexadecimal/Integer"
71+{-# RULES "hexadecimal/Integer" hexadecimal = integer 16 :: Integer -> Builder #-}
174− hexadecimal = hexInteger :: Integer -> Builder #-}
175hexadecimal i
72hexadecimal i
176− | i < 0 = error hexErrMsg
73+ | i < 0 = singleton '-' <> go (-i)
177 | otherwise = go i
74 | otherwise = go i
178 where
75 where
179 go n | n < 16 = hexDigit n
76 go n | n < 16 = hexDigit n
180 | otherwise = go (n `quot` 16) <> hexDigit (n `rem` 16)
77 | otherwise = go (n `quot` 16) <> hexDigit (n `rem` 16)
181−{-# NOINLINE[0] hexadecimal #-}
182−
183−hexInteger :: Integer -> Builder
184−hexInteger i
185− | i < 0 = error hexErrMsg
186− | otherwise = integer 16 i
187
78
188−hexErrMsg :: String
79+digit :: Integral a => a -> Builder
189−hexErrMsg = "Data.Text.Lazy.Builder.Int.hexadecimal: applied to negative number"
80+digit n = singleton $! i2d (fromIntegral n)
81+{-# INLINE digit #-}
190
82
191hexDigit :: Integral a => a -> Builder
83hexDigit :: Integral a => a -> Builder
192hexDigit n
84hexDigit n
@@ -194,13 +86,15 @@ hexDigit n
194 | otherwise = singleton $! toEnum (fromIntegral n + 87)
86 | otherwise = singleton $! toEnum (fromIntegral n + 87)
195{-# INLINE hexDigit #-}
87{-# INLINE hexDigit #-}
196
88
89+int :: Int -> Builder
90+int = decimal
91+{-# INLINE int #-}
92+
197data T = T !Integer !Int
93data T = T !Integer !Int
198
94
199integer :: Int -> Integer -> Builder
95integer :: Int -> Integer -> Builder
200−#ifdef INTEGER_GMP
201integer 10 (S# i#) = decimal (I# i#)
96integer 10 (S# i#) = decimal (I# i#)
202integer 16 (S# i#) = hexadecimal (I# i#)
97integer 16 (S# i#) = hexadecimal (I# i#)
203−#endif
204integer base i
98integer base i
205 | i < 0 = singleton '-' <> go (-i)
99 | i < 0 = singleton '-' <> go (-i)
206 | otherwise = go i
100 | otherwise = go i
@@ -247,16 +141,12 @@ integer base i
247 PAIR(x,y) -> pblock q <> pblock r <> putB ns
141 PAIR(x,y) -> pblock q <> pblock r <> putB ns
248 where q = fromInteger x
142 where q = fromInteger x
249 r = fromInteger y
143 r = fromInteger y
250− putB _ = Data.Monoid.mempty
144+ putB _ = mempty
251−
252− int :: Int -> Builder
253− int x | base == 10 = decimal x
254− | otherwise = hexadecimal x
255
145
256 pblock = loop maxDigits
146 pblock = loop maxDigits
257 where
147 where
258 loop !d !n
148 loop !d !n
259− | d == 1 = hexDigit n
149+ | d == 1 = digit n
260− | otherwise = loop (d-1) q <> hexDigit r
150+ | otherwise = loop (d-1) q <> digit r
261 where q = n `quotInt` base
151 where q = n `quotInt` base
262 r = n `remInt` base
152 r = n `remInt` base
Data/Text/Lazy/Builder/RealFloat.hs+3−6
@@ -1,7 +1,4 @@
1−{-# LANGUAGE CPP, OverloadedStrings #-}
1+{-# LANGUAGE OverloadedStrings #-}
2−#if __GLASGOW_HASKELL__ >= 702
3−{-# LANGUAGE Trustworthy #-}
4−#endif
5
2
6-- |
3-- |
7-- Module: Data.Text.Lazy.Builder.RealFloat
4-- Module: Data.Text.Lazy.Builder.RealFloat
@@ -19,9 +16,9 @@ module Data.Text.Lazy.Builder.RealFloat
19
16
20import Data.Array.Base (unsafeAt)
17import Data.Array.Base (unsafeAt)
21import Data.Array.IArray
18import Data.Array.IArray
22−import Data.Text.Internal.Builder.Functions ((<>), i2d)
19+import Data.Text.Lazy.Builder.Functions ((<>), i2d)
23import Data.Text.Lazy.Builder.Int (decimal)
20import Data.Text.Lazy.Builder.Int (decimal)
24−import Data.Text.Internal.Builder.RealFloat.Functions (roundTo)
21+import Data.Text.Lazy.Builder.RealFloat.Functions (roundTo)
25import Data.Text.Lazy.Builder
22import Data.Text.Lazy.Builder
26import qualified Data.Text as T
23import qualified Data.Text as T
27
24
Data/Text/Lazy/Builder/RealFloat/Functions.hsnew file+25
@@ -0,0 +1,25 @@
1+-- |
2+-- Module: Data.Text.Lazy.Builder.RealFloat.Functions
3+-- Copyright: (c) The University of Glasgow 1994-2002
4+-- License: see libraries/base/LICENSE
5+
6+module Data.Text.Lazy.Builder.RealFloat.Functions
7+ (
8+ roundTo
9+ ) where
10+
11+roundTo :: Int -> [Int] -> (Int,[Int])
12+roundTo d is =
13+ case f d is of
14+ x@(0,_) -> x
15+ (1,xs) -> (1, 1:xs)
16+ _ -> error "roundTo: bad Value"
17+ where
18+ f n [] = (0, replicate n 0)
19+ f 0 (x:_) = (if x >= 5 then 1 else 0, [])
20+ f n (i:xs)
21+ | i' == 10 = (1,0:ds)
22+ | otherwise = (0,i':ds)
23+ where
24+ (c,ds) = f (n-1) xs
25+ i' = c + i
Data/Text/Lazy/Encoding.hs+48−61
@@ -1,13 +1,11 @@
1−{-# LANGUAGE BangPatterns,CPP #-}
1+{-# LANGUAGE BangPatterns #-}
2−#if __GLASGOW_HASKELL__ >= 702
3−{-# LANGUAGE Trustworthy #-}
4−#endif
5-- |
2-- |
6-- Module : Data.Text.Lazy.Encoding
3-- Module : Data.Text.Lazy.Encoding
7-- Copyright : (c) 2009, 2010 Bryan O'Sullivan
4-- Copyright : (c) 2009, 2010 Bryan O'Sullivan
8--
5--
9-- License : BSD-style
6-- License : BSD-style
10−-- Maintainer : bos@serpentine.com
7+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
8+-- duncan@haskell.org
11-- Stability : experimental
9-- Stability : experimental
12-- Portability : portable
10-- Portability : portable
13--
11--
@@ -22,7 +20,6 @@ module Data.Text.Lazy.Encoding
22 -- * Decoding ByteStrings to Text
20 -- * Decoding ByteStrings to Text
23 -- $strict
21 -- $strict
24 decodeASCII
22 decodeASCII
25− , decodeLatin1
26 , decodeUtf8
23 , decodeUtf8
27 , decodeUtf16LE
24 , decodeUtf16LE
28 , decodeUtf16BE
25 , decodeUtf16BE
@@ -45,29 +42,21 @@ module Data.Text.Lazy.Encoding
45 , encodeUtf16BE
42 , encodeUtf16BE
46 , encodeUtf32LE
43 , encodeUtf32LE
47 , encodeUtf32BE
44 , encodeUtf32BE
48−
49− -- * Encoding Text using ByteString Builders
50− , encodeUtf8Builder
51− , encodeUtf8BuilderEscaped
52 ) where
45 ) where
53
46
54import Control.Exception (evaluate, try)
47import Control.Exception (evaluate, try)
55−import Data.Monoid (Monoid(..))
48+import Data.Bits ((.&.))
56import Data.Text.Encoding.Error (OnDecodeError, UnicodeException, strictDecode)
49import Data.Text.Encoding.Error (OnDecodeError, UnicodeException, strictDecode)
57−import Data.Text.Internal.Lazy (Text(..), chunk, empty, foldrChunks)
50+import Data.Text.Lazy.Internal (Text(..), chunk, empty, foldrChunks)
58−import Data.Word (Word8)
51+import System.IO.Unsafe (unsafePerformIO)
59import qualified Data.ByteString as S
52import qualified Data.ByteString as S
60−import qualified Data.ByteString.Builder as B
61−import qualified Data.ByteString.Builder.Extra as B (safeStrategy, toLazyByteStringWith)
62−import qualified Data.ByteString.Builder.Prim as BP
63import qualified Data.ByteString.Lazy as B
53import qualified Data.ByteString.Lazy as B
64import qualified Data.ByteString.Lazy.Internal as B
54import qualified Data.ByteString.Lazy.Internal as B
65−import qualified Data.ByteString.Unsafe as B
55+import qualified Data.ByteString.Unsafe as S
66import qualified Data.Text as T
56import qualified Data.Text as T
67import qualified Data.Text.Encoding as TE
57import qualified Data.Text.Encoding as TE
68−import qualified Data.Text.Internal.Lazy.Encoding.Fusion as E
58+import qualified Data.Text.Lazy.Encoding.Fusion as E
69−import qualified Data.Text.Internal.Lazy.Fusion as F
59+import qualified Data.Text.Lazy.Fusion as F
70−import Data.Text.Unsafe (unsafeDupablePerformIO)
71
60
72-- $strict
61-- $strict
73--
62--
@@ -82,32 +71,48 @@ import Data.Text.Unsafe (unsafeDupablePerformIO)
82-- 'decodeUtf8With' allows the programmer to determine what to do on a
71-- 'decodeUtf8With' allows the programmer to determine what to do on a
83-- decoding error.
72-- decoding error.
84
73
85−-- | /Deprecated/. Decode a 'ByteString' containing 7-bit ASCII
74+-- | Decode a 'ByteString' containing 7-bit ASCII encoded text.
86−-- encoded text.
87decodeASCII :: B.ByteString -> Text
75decodeASCII :: B.ByteString -> Text
88−decodeASCII = decodeUtf8
89−{-# DEPRECATED decodeASCII "Use decodeUtf8 instead" #-}
90−
91−-- | Decode a 'ByteString' containing Latin-1 (aka ISO-8859-1) encoded text.
92−decodeLatin1 :: B.ByteString -> Text
93−decodeLatin1 = foldr (chunk . TE.decodeLatin1) empty . B.toChunks
76+decodeASCII bs = foldr (chunk . TE.decodeASCII) empty (B.toChunks bs)
77+{-# INLINE decodeASCII #-}
94
78
95-- | Decode a 'ByteString' containing UTF-8 encoded text.
79-- | Decode a 'ByteString' containing UTF-8 encoded text.
96decodeUtf8With :: OnDecodeError -> B.ByteString -> Text
80decodeUtf8With :: OnDecodeError -> B.ByteString -> Text
97−decodeUtf8With onErr (B.Chunk b0 bs0) =
81+decodeUtf8With onErr bs0 = fast bs0
98− case TE.streamDecodeUtf8With onErr b0 of
99− TE.Some t l f -> chunk t (go f l bs0)
100 where
82 where
101− go f0 _ (B.Chunk b bs) =
83+ decode = TE.decodeUtf8With onErr
102− case f0 b of
84+ fast (B.Chunk p ps) | isComplete p = chunk (decode p) (fast ps)
103− TE.Some t l f -> chunk t (go f l bs)
85+ | otherwise = chunk (decode h) (slow t ps)
104− go _ l _
86+ where (h,t) = S.splitAt pivot p
105− | S.null l = empty
87+ pivot | at 1 = len-1
106− | otherwise = case onErr desc (Just (B.unsafeHead l)) of
88+ | at 2 = len-2
107− Nothing -> empty
89+ | otherwise = len-3
108− Just c -> Chunk (T.singleton c) Empty
90+ len = S.length p
91+ at n = len >= n && S.unsafeIndex p (len-n) .&. 0xc0 == 0xc0
92+ fast B.Empty = empty
93+ slow i bs = {-# SCC "decodeUtf8With'/slow" #-}
94+ case B.uncons bs of
95+ Just (w,bs') | isComplete i' -> chunk (decode i') (fast bs')
96+ | otherwise -> slow i' bs'
97+ where i' = S.snoc i w
98+ Nothing -> case S.uncons i of
99+ Just (j,i') ->
100+ case onErr desc (Just j) of
101+ Nothing -> slow i' bs
102+ Just c -> Chunk (T.singleton c) (slow i' bs)
103+ Nothing ->
104+ case onErr desc Nothing of
105+ Nothing -> empty
106+ Just c -> Chunk (T.singleton c) empty
107+ isComplete bs = {-# SCC "decodeUtf8With'/isComplete" #-}
108+ ix 1 .&. 0x80 == 0 ||
109+ (len >= 2 && ix 2 .&. 0xe0 == 0xc0) ||
110+ (len >= 3 && ix 3 .&. 0xf0 == 0xe0) ||
111+ (len >= 4 && ix 4 .&. 0xf8 == 0xf0)
112+ where len = S.length bs
113+ ix n = S.unsafeIndex bs (len-n)
109 desc = "Data.Text.Lazy.Encoding.decodeUtf8With: Invalid UTF-8 stream"
114 desc = "Data.Text.Lazy.Encoding.decodeUtf8With: Invalid UTF-8 stream"
110−decodeUtf8With _ _ = empty
115+{-# INLINE[0] decodeUtf8With #-}
111
116
112-- | Decode a 'ByteString' containing UTF-8 encoded text that is known
117-- | Decode a 'ByteString' containing UTF-8 encoded text that is known
113-- to be valid.
118-- to be valid.
@@ -133,7 +138,7 @@ decodeUtf8 = decodeUtf8With strictDecode
133-- input before it can return a result. If you need lazy (streaming)
138-- input before it can return a result. If you need lazy (streaming)
134-- decoding, use 'decodeUtf8With' in lenient mode.
139-- decoding, use 'decodeUtf8With' in lenient mode.
135decodeUtf8' :: B.ByteString -> Either UnicodeException Text
140decodeUtf8' :: B.ByteString -> Either UnicodeException Text
136−decodeUtf8' bs = unsafeDupablePerformIO $ do
141+decodeUtf8' bs = unsafePerformIO $ do
137 let t = decodeUtf8 bs
142 let t = decodeUtf8 bs
138 try (evaluate (rnf t `seq` t))
143 try (evaluate (rnf t `seq` t))
139 where
144 where
@@ -142,26 +147,8 @@ decodeUtf8' bs = unsafeDupablePerformIO $ do
142{-# INLINE decodeUtf8' #-}
147{-# INLINE decodeUtf8' #-}
143
148
144encodeUtf8 :: Text -> B.ByteString
149encodeUtf8 :: Text -> B.ByteString
145−encodeUtf8 Empty = B.empty
150+encodeUtf8 (Chunk c cs) = B.Chunk (TE.encodeUtf8 c) (encodeUtf8 cs)
146−encodeUtf8 lt@(Chunk t _) =
151+encodeUtf8 Empty = B.Empty
147− B.toLazyByteStringWith strategy B.empty $ encodeUtf8Builder lt
148− where
149− -- To improve our small string performance, we use a strategy that
150− -- allocates a buffer that is guaranteed to be large enough for the
151− -- encoding of the first chunk, but not larger than the default
152− -- B.smallChunkSize. We clamp the firstChunkSize to ensure that we don't
153− -- generate too large buffers which hamper streaming.
154− firstChunkSize = min B.smallChunkSize (4 * (T.length t + 1))
155− strategy = B.safeStrategy firstChunkSize B.defaultChunkSize
156−
157−encodeUtf8Builder :: Text -> B.Builder
158−encodeUtf8Builder =
159− foldrChunks (\c b -> TE.encodeUtf8Builder c `mappend` b) Data.Monoid.mempty
160−
161−{-# INLINE encodeUtf8BuilderEscaped #-}
162−encodeUtf8BuilderEscaped :: BP.BoundedPrim Word8 -> Text -> B.Builder
163−encodeUtf8BuilderEscaped prim =
164− foldrChunks (\c b -> TE.encodeUtf8BuilderEscaped prim c `mappend` b) mempty
165
152
166-- | Decode text from little endian UTF-16 encoding.
153-- | Decode text from little endian UTF-16 encoding.
167decodeUtf16LEWith :: OnDecodeError -> B.ByteString -> Text
154decodeUtf16LEWith :: OnDecodeError -> B.ByteString -> Text
Data/Text/Internal/Lazy/Encoding/Fusion.hs → Data/Text/Lazy/Encoding/Fusion.hsrenamed+14−17
@@ -5,18 +5,15 @@
5-- Copyright : (c) 2009, 2010 Bryan O'Sullivan
5-- Copyright : (c) 2009, 2010 Bryan O'Sullivan
6--
6--
7-- License : BSD-style
7-- License : BSD-style
8−-- Maintainer : bos@serpentine.com
8+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
9+-- duncan@haskell.org
9-- Stability : experimental
10-- Stability : experimental
10-- Portability : portable
11-- Portability : portable
11--
12--
12−-- /Warning/: this is an internal module, and does not have a stable
13−-- API or name. Functions in this module may not check or enforce
14−-- preconditions expected by public modules. Use at your own risk!
15−--
16-- Fusible 'Stream'-oriented functions for converting between lazy
13-- Fusible 'Stream'-oriented functions for converting between lazy
17-- 'Text' and several common encodings.
14-- 'Text' and several common encodings.
18
15
19−module Data.Text.Internal.Lazy.Encoding.Fusion
16+module Data.Text.Lazy.Encoding.Fusion
20 (
17 (
21 -- * Streaming
18 -- * Streaming
22 -- streamASCII
19 -- streamASCII
@@ -29,23 +26,23 @@ module Data.Text.Internal.Lazy.Encoding.Fusion
29 -- * Unstreaming
26 -- * Unstreaming
30 , unstream
27 , unstream
31
28
32− , module Data.Text.Internal.Encoding.Fusion.Common
29+ , module Data.Text.Encoding.Fusion.Common
33 ) where
30 ) where
34
31
35import Data.ByteString.Lazy.Internal (ByteString(..), defaultChunkSize)
32import Data.ByteString.Lazy.Internal (ByteString(..), defaultChunkSize)
36import qualified Data.ByteString as B
33import qualified Data.ByteString as B
37import qualified Data.ByteString.Unsafe as B
34import qualified Data.ByteString.Unsafe as B
38−import Data.Text.Internal.Encoding.Fusion.Common
35+import Data.Text.Encoding.Fusion.Common
39import Data.Text.Encoding.Error
36import Data.Text.Encoding.Error
40−import Data.Text.Internal.Fusion (Step(..), Stream(..))
37+import Data.Text.Fusion (Step(..), Stream(..))
41−import Data.Text.Internal.Fusion.Size
38+import Data.Text.Fusion.Size
42−import Data.Text.Internal.Unsafe.Char (unsafeChr, unsafeChr8, unsafeChr32)
39+import Data.Text.UnsafeChar (unsafeChr, unsafeChr8, unsafeChr32)
43−import Data.Text.Internal.Unsafe.Shift (shiftL)
40+import Data.Text.UnsafeShift (shiftL)
44import Data.Word (Word8, Word16, Word32)
41import Data.Word (Word8, Word16, Word32)
45−import qualified Data.Text.Internal.Encoding.Utf8 as U8
42+import qualified Data.Text.Encoding.Utf8 as U8
46−import qualified Data.Text.Internal.Encoding.Utf16 as U16
43+import qualified Data.Text.Encoding.Utf16 as U16
47−import qualified Data.Text.Internal.Encoding.Utf32 as U32
44+import qualified Data.Text.Encoding.Utf32 as U32
48−import Data.Text.Unsafe (unsafeDupablePerformIO)
45+import System.IO.Unsafe (unsafePerformIO)
49import Foreign.ForeignPtr (withForeignPtr, ForeignPtr)
46import Foreign.ForeignPtr (withForeignPtr, ForeignPtr)
50import Foreign.Storable (pokeByteOff)
47import Foreign.Storable (pokeByteOff)
51import Data.ByteString.Internal (mallocByteString, memcpy)
48import Data.ByteString.Internal (mallocByteString, memcpy)
@@ -275,7 +272,7 @@ streamUtf32LE onErr bs0 = Stream next (T bs0 S0 0) unknownSize
275-- | /O(n)/ Convert a 'Stream' 'Word8' to a lazy 'ByteString'.
272-- | /O(n)/ Convert a 'Stream' 'Word8' to a lazy 'ByteString'.
276unstreamChunks :: Int -> Stream Word8 -> ByteString
273unstreamChunks :: Int -> Stream Word8 -> ByteString
277unstreamChunks chunkSize (Stream next s0 len0) = chunk s0 (upperBound 4 len0)
274unstreamChunks chunkSize (Stream next s0 len0) = chunk s0 (upperBound 4 len0)
278− where chunk s1 len1 = unsafeDupablePerformIO $ do
275+ where chunk s1 len1 = unsafePerformIO $ do
279 let len = max 4 (min len1 chunkSize)
276 let len = max 4 (min len1 chunkSize)
280 mallocByteString len >>= loop len 0 s1
277 mallocByteString len >>= loop len 0 s1
281 where
278 where
Data/Text/Internal/Lazy/Fusion.hs → Data/Text/Lazy/Fusion.hsrenamed+31−38
@@ -4,17 +4,14 @@
4-- Copyright : (c) 2009, 2010 Bryan O'Sullivan
4-- Copyright : (c) 2009, 2010 Bryan O'Sullivan
5--
5--
6-- License : BSD-style
6-- License : BSD-style
7−-- Maintainer : bos@serpentine.com
7+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
8+-- duncan@haskell.org
8-- Stability : experimental
9-- Stability : experimental
9-- Portability : GHC
10-- Portability : GHC
10--
11--
11−-- /Warning/: this is an internal module, and does not have a stable
12−-- API or name. Functions in this module may not check or enforce
13−-- preconditions expected by public modules. Use at your own risk!
14−--
15-- Core stream fusion functionality for text.
12-- Core stream fusion functionality for text.
16
13
17−module Data.Text.Internal.Lazy.Fusion
14+module Data.Text.Lazy.Fusion
18 (
15 (
19 stream
16 stream
20 , unstream
17 , unstream
@@ -26,15 +23,14 @@ module Data.Text.Internal.Lazy.Fusion
26 ) where
23 ) where
27
24
28import Prelude hiding (length)
25import Prelude hiding (length)
29−import qualified Data.Text.Internal.Fusion.Common as S
26+import qualified Data.Text.Fusion.Common as S
30−import Control.Monad.ST (runST)
31−import Data.Text.Internal.Fusion.Types
27+import Data.Text.Fusion.Internal
32−import Data.Text.Internal.Fusion.Size (isEmpty, unknownSize)
28+import Data.Text.Fusion.Size (isEmpty, unknownSize)
33−import Data.Text.Internal.Lazy
29+import Data.Text.Lazy.Internal
34import qualified Data.Text.Internal as I
30import qualified Data.Text.Internal as I
35import qualified Data.Text.Array as A
31import qualified Data.Text.Array as A
36−import Data.Text.Internal.Unsafe.Char (unsafeWrite)
32+import Data.Text.UnsafeChar (unsafeWrite)
37−import Data.Text.Internal.Unsafe.Shift (shiftL)
33+import Data.Text.UnsafeShift (shiftL)
38import Data.Text.Unsafe (Iter(..), iter)
34import Data.Text.Unsafe (Iter(..), iter)
39import Data.Int (Int64)
35import Data.Int (Int64)
40
36
@@ -54,36 +50,33 @@ stream text = Stream next (text :*: 0) unknownSize
54-- | /O(n)/ Convert a 'Stream Char' into a 'Text', using the given
50-- | /O(n)/ Convert a 'Stream Char' into a 'Text', using the given
55-- chunk size.
51-- chunk size.
56unstreamChunks :: Int -> Stream Char -> Text
52unstreamChunks :: Int -> Stream Char -> Text
57−unstreamChunks !chunkSize (Stream next s0 len0)
53+unstreamChunks chunkSize (Stream next s0 len0)
58 | isEmpty len0 = Empty
54 | isEmpty len0 = Empty
59 | otherwise = outer s0
55 | otherwise = outer s0
60 where
56 where
61− outer so = {-# SCC "unstreamChunks/outer" #-}
57+ outer s = {-# SCC "unstreamChunks/outer" #-}
62− case next so of
58+ case next s of
63 Done -> Empty
59 Done -> Empty
64 Skip s' -> outer s'
60 Skip s' -> outer s'
65− Yield x s' -> runST $ do
61+ Yield x s' -> I.Text arr 0 len `chunk` outer s''
62+ where (arr,(s'',len)) = A.run2 fill
66− a <- A.new unknownLength
63+ fill = do a <- A.new unknownLength
67− unsafeWrite a 0 x >>= inner a unknownLength s'
64+ unsafeWrite a 0 x >>= inner a unknownLength s'
68− where unknownLength = 4
65+ unknownLength = 4
69− where
70− inner marr !len s !i
66+ inner marr len s !i
71− | i + 1 >= chunkSize = finish marr i s
67+ | i + 1 >= chunkSize = return (marr, (s,i))
72− | i + 1 >= len = {-# SCC "unstreamChunks/resize" #-} do
68+ | i + 1 >= len = {-# SCC "unstreamChunks/resize" #-} do
73− let newLen = min (len `shiftL` 1) chunkSize
69+ let newLen = min (len `shiftL` 1) chunkSize
74− marr' <- A.new newLen
70+ marr' <- A.new newLen
75− A.copyM marr' 0 marr 0 len
71+ A.copyM marr' 0 marr 0 len
76− inner marr' newLen s i
72+ inner marr' newLen s i
77− | otherwise =
73+ | otherwise =
78− {-# SCC "unstreamChunks/inner" #-}
74+ {-# SCC "unstreamChunks/inner" #-}
79− case next s of
75+ case next s of
80− Done -> finish marr i s
76+ Done -> return (marr,(s,i))
81− Skip s' -> inner marr len s' i
77+ Skip s' -> inner marr len s' i
82− Yield x s' -> do d <- unsafeWrite marr i x
78+ Yield x s' -> do d <- unsafeWrite marr i x
83− inner marr len s' (i+d)
79+ inner marr len s' (i+d)
84− finish marr len s' = do
85− arr <- A.unsafeFreeze marr
86− return (I.Text arr 0 len `Chunk` outer s')
87{-# INLINE [0] unstreamChunks #-}
80{-# INLINE [0] unstreamChunks #-}
88
81
89-- | /O(n)/ Convert a 'Stream Char' into a 'Text', using
82-- | /O(n)/ Convert a 'Stream Char' into a 'Text', using
Data/Text/Lazy/IO.hs+22−11
@@ -1,7 +1,4 @@
1{-# LANGUAGE BangPatterns, CPP, RecordWildCards #-}
1{-# LANGUAGE BangPatterns, CPP, RecordWildCards #-}
2−#if __GLASGOW_HASKELL__ >= 702
3−{-# LANGUAGE Trustworthy #-}
4−#endif
5-- |
2-- |
6-- Module : Data.Text.Lazy.IO
3-- Module : Data.Text.Lazy.IO
7-- Copyright : (c) 2009, 2010 Bryan O'Sullivan,
4-- Copyright : (c) 2009, 2010 Bryan O'Sullivan,
@@ -19,7 +16,7 @@
19module Data.Text.Lazy.IO
16module Data.Text.Lazy.IO
20 (
17 (
21 -- * Performance
18 -- * Performance
22− -- $performance
19+ -- $performance
23
20
24 -- * Locale support
21 -- * Locale support
25 -- $locale
22 -- $locale
@@ -41,17 +38,22 @@ module Data.Text.Lazy.IO
41 ) where
38 ) where
42
39
43import Data.Text.Lazy (Text)
40import Data.Text.Lazy (Text)
44−import Prelude hiding (appendFile, getContents, getLine, interact,
41+import Prelude hiding (appendFile, catch, getContents, getLine, interact,
45 putStr, putStrLn, readFile, writeFile)
42 putStr, putStrLn, readFile, writeFile)
46import System.IO (Handle, IOMode(..), hPutChar, openFile, stdin, stdout,
43import System.IO (Handle, IOMode(..), hPutChar, openFile, stdin, stdout,
47 withFile)
44 withFile)
48import qualified Data.Text.IO as T
45import qualified Data.Text.IO as T
49import qualified Data.Text.Lazy as L
46import qualified Data.Text.Lazy as L
47+#if __GLASGOW_HASKELL__ <= 610
48+import Data.Text.Lazy.Encoding (decodeUtf8)
49+import qualified Data.ByteString.Char8 as S8
50+import qualified Data.ByteString.Lazy.Char8 as L8
51+#else
50−import qualified Control.Exception as E
52+import Control.Exception (catch, throwIO)
51import Control.Monad (when)
53import Control.Monad (when)
52import Data.IORef (readIORef)
54import Data.IORef (readIORef)
53−import Data.Text.Internal.IO (hGetLineWith, readChunk)
55+import Data.Text.IO.Internal (hGetLineWith, readChunk)
54−import Data.Text.Internal.Lazy (chunk, empty)
56+import Data.Text.Lazy.Internal (chunk, empty)
55import GHC.IO.Buffer (isEmptyBuffer)
57import GHC.IO.Buffer (isEmptyBuffer)
56import GHC.IO.Exception (IOException(..), IOErrorType(..), ioException)
58import GHC.IO.Exception (IOException(..), IOErrorType(..), ioException)
57import GHC.IO.Handle.Internals (augmentIOError, hClose_help,
59import GHC.IO.Handle.Internals (augmentIOError, hClose_help,
@@ -60,6 +62,7 @@ import GHC.IO.Handle.Types (Handle__(..), HandleType(..))
60import System.IO (BufferMode(..), hGetBuffering, hSetBuffering)
62import System.IO (BufferMode(..), hGetBuffering, hSetBuffering)
61import System.IO.Error (isEOFError)
63import System.IO.Error (isEOFError)
62import System.IO.Unsafe (unsafeInterleaveIO)
64import System.IO.Unsafe (unsafeInterleaveIO)
65+#endif
63
66
64-- $performance
67-- $performance
65--
68--
@@ -93,6 +96,9 @@ appendFile p = withFile p AppendMode . flip hPutStr
93-- | Lazily read the remaining contents of a 'Handle'. The 'Handle'
96-- | Lazily read the remaining contents of a 'Handle'. The 'Handle'
94-- will be closed after the read completes, or on error.
97-- will be closed after the read completes, or on error.
95hGetContents :: Handle -> IO Text
98hGetContents :: Handle -> IO Text
99+#if __GLASGOW_HASKELL__ <= 610
100+hGetContents = fmap decodeUtf8 . L8.hGetContents
101+#else
96hGetContents h = do
102hGetContents h = do
97 chooseGoodBuffering h
103 chooseGoodBuffering h
98 wantReadableHandle "hGetContents" h $ \hh -> do
104 wantReadableHandle "hGetContents" h $ \hh -> do
@@ -113,7 +119,7 @@ lazyRead h = unsafeInterleaveIO $
113 case haType hh of
119 case haType hh of
114 ClosedHandle -> return (hh, L.empty)
120 ClosedHandle -> return (hh, L.empty)
115 SemiClosedHandle -> lazyReadBuffered h hh
121 SemiClosedHandle -> lazyReadBuffered h hh
116− _ -> ioException
122+ _ -> ioException
117 (IOError (Just h) IllegalOperation "hGetContents"
123 (IOError (Just h) IllegalOperation "hGetContents"
118 "illegal handle type" Nothing Nothing)
124 "illegal handle type" Nothing Nothing)
119
125
@@ -122,17 +128,22 @@ lazyReadBuffered h hh@Handle__{..} = do
122 buf <- readIORef haCharBuffer
128 buf <- readIORef haCharBuffer
123 (do t <- readChunk hh buf
129 (do t <- readChunk hh buf
124 ts <- lazyRead h
130 ts <- lazyRead h
125− return (hh, chunk t ts)) `E.catch` \e -> do
131+ return (hh, chunk t ts)) `catch` \e -> do
126 (hh', _) <- hClose_help hh
132 (hh', _) <- hClose_help hh
127 if isEOFError e
133 if isEOFError e
128 then return $ if isEmptyBuffer buf
134 then return $ if isEmptyBuffer buf
129 then (hh', empty)
135 then (hh', empty)
130 else (hh', L.singleton '\r')
136 else (hh', L.singleton '\r')
131− else E.throwIO (augmentIOError e "hGetContents" h)
137+ else throwIO (augmentIOError e "hGetContents" h)
138+#endif
132
139
133-- | Read a single line from a handle.
140-- | Read a single line from a handle.
134hGetLine :: Handle -> IO Text
141hGetLine :: Handle -> IO Text
142+#if __GLASGOW_HASKELL__ <= 610
143+hGetLine = fmap (decodeUtf8 . L8.fromChunks . (:[])) . S8.hGetLine
144+#else
135hGetLine = hGetLineWith L.fromChunks
145hGetLine = hGetLineWith L.fromChunks
146+#endif
136
147
137-- | Write a string to a handle.
148-- | Write a string to a handle.
138hPutStr :: Handle -> Text -> IO ()
149hPutStr :: Handle -> Text -> IO ()
Data/Text/Lazy/Internal.hs+105−7
@@ -1,20 +1,118 @@
1{-# LANGUAGE BangPatterns, DeriveDataTypeable #-}
1{-# LANGUAGE BangPatterns, DeriveDataTypeable #-}
2-- |
2-- |
3-- Module : Data.Text.Lazy.Internal
3-- Module : Data.Text.Lazy.Internal
4−-- Copyright : (c) 2013 Bryan O'Sullivan
4+-- Copyright : (c) 2009, 2010 Bryan O'Sullivan
5--
5--
6-- License : BSD-style
6-- License : BSD-style
7−-- Maintainer : bos@serpentine.com
7+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
8+-- duncan@haskell.org
8-- Stability : experimental
9-- Stability : experimental
9-- Portability : GHC
10-- Portability : GHC
11+--
12+-- A module containing private 'Text' internals. This exposes the
13+-- 'Text' representation and low level construction functions.
14+-- Modules which extend the 'Text' system may need to use this module.
10--
15--
11−-- This module has been renamed to 'Data.Text.Internal.Lazy'. This
16+-- You should not use this module unless you are determined to monkey
12−-- name for the module will be removed in the next major release.
17+-- with the internals, as the functions here do just about nothing to
18+-- preserve data invariants. You have been warned!
13
19
14module Data.Text.Lazy.Internal
20module Data.Text.Lazy.Internal
15− {-# DEPRECATED "Use Data.Text.Internal.Lazy instead" #-}
16 (
21 (
17− module Data.Text.Internal.Lazy
22+ Text(..)
23+ , chunk
24+ , empty
25+ , foldrChunks
26+ , foldlChunks
27+ -- * Data type invariant and abstraction functions
28+
29+ -- $invariant
30+ , strictInvariant
31+ , lazyInvariant
32+ , showStructure
33+
34+ -- * Chunk allocation sizes
35+ , defaultChunkSize
36+ , smallChunkSize
37+ , chunkOverhead
18 ) where
38 ) where
19
39
20−import Data.Text.Internal.Lazy
40+import Data.Text ()
41+import Data.Text.UnsafeShift (shiftL)
42+import Data.Typeable (Typeable)
43+import Foreign.Storable (sizeOf)
44+import qualified Data.Text.Internal as T
45+
46+data Text = Empty
47+ | Chunk {-# UNPACK #-} !T.Text Text
48+ deriving (Typeable)
49+
50+-- $invariant
51+--
52+-- The data type invariant for lazy 'Text': Every 'Text' is either 'Empty' or
53+-- consists of non-null 'T.Text's. All functions must preserve this,
54+-- and the QC properties must check this.
55+
56+-- | Check the invariant strictly.
57+strictInvariant :: Text -> Bool
58+strictInvariant Empty = True
59+strictInvariant x@(Chunk (T.Text _ _ len) cs)
60+ | len > 0 = strictInvariant cs
61+ | otherwise = error $ "Data.Text.Lazy: invariant violation: "
62+ ++ showStructure x
63+
64+-- | Check the invariant lazily.
65+lazyInvariant :: Text -> Text
66+lazyInvariant Empty = Empty
67+lazyInvariant x@(Chunk c@(T.Text _ _ len) cs)
68+ | len > 0 = Chunk c (lazyInvariant cs)
69+ | otherwise = error $ "Data.Text.Lazy: invariant violation: "
70+ ++ showStructure x
71+
72+-- | Display the internal structure of a lazy 'Text'.
73+showStructure :: Text -> String
74+showStructure Empty = "Empty"
75+showStructure (Chunk t Empty) = "Chunk " ++ show t ++ " Empty"
76+showStructure (Chunk t ts) =
77+ "Chunk " ++ show t ++ " (" ++ showStructure ts ++ ")"
78+
79+-- | Smart constructor for 'Chunk'. Guarantees the data type invariant.
80+chunk :: T.Text -> Text -> Text
81+{-# INLINE chunk #-}
82+chunk t@(T.Text _ _ len) ts | len == 0 = ts
83+ | otherwise = Chunk t ts
84+
85+-- | Smart constructor for 'Empty'.
86+empty :: Text
87+{-# INLINE [0] empty #-}
88+empty = Empty
89+
90+-- | Consume the chunks of a lazy 'Text' with a natural right fold.
91+foldrChunks :: (T.Text -> a -> a) -> a -> Text -> a
92+foldrChunks f z = go
93+ where go Empty = z
94+ go (Chunk c cs) = f c (go cs)
95+{-# INLINE foldrChunks #-}
96+
97+-- | Consume the chunks of a lazy 'Text' with a strict, tail-recursive,
98+-- accumulating left fold.
99+foldlChunks :: (a -> T.Text -> a) -> a -> Text -> a
100+foldlChunks f z = go z
101+ where go !a Empty = a
102+ go !a (Chunk c cs) = go (f a c) cs
103+{-# INLINE foldlChunks #-}
104+
105+-- | Currently set to 16 KiB, less the memory management overhead.
106+defaultChunkSize :: Int
107+defaultChunkSize = 16384 - chunkOverhead
108+{-# INLINE defaultChunkSize #-}
109+
110+-- | Currently set to 128 bytes, less the memory management overhead.
111+smallChunkSize :: Int
112+smallChunkSize = 128 - chunkOverhead
113+{-# INLINE smallChunkSize #-}
114+
115+-- | The memory management overhead. Currently this is tuned for GHC only.
116+chunkOverhead :: Int
117+chunkOverhead = sizeOf (undefined :: Int) `shiftL` 1
118+{-# INLINE chunkOverhead #-}
Data/Text/Lazy/Read.hs+39−40
@@ -1,16 +1,12 @@
1−{-# LANGUAGE OverloadedStrings, CPP #-}
1+{-# LANGUAGE OverloadedStrings #-}
2−#if __GLASGOW_HASKELL__ >= 704
3−{-# LANGUAGE Safe #-}
4−#elif __GLASGOW_HASKELL__ >= 702
5−{-# LANGUAGE Trustworthy #-}
6−#endif
7
2
8-- |
3-- |
9-- Module : Data.Text.Lazy.Read
4-- Module : Data.Text.Lazy.Read
10−-- Copyright : (c) 2010, 2011 Bryan O'Sullivan
5+-- Copyright : (c) 2010 Bryan O'Sullivan
11--
6--
12-- License : BSD-style
7-- License : BSD-style
13−-- Maintainer : bos@serpentine.com
8+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
9+-- duncan@haskell.org
14-- Stability : experimental
10-- Stability : experimental
15-- Portability : GHC
11-- Portability : GHC
16--
12--
@@ -26,17 +22,13 @@ module Data.Text.Lazy.Read
26 ) where
22 ) where
27
23
28import Control.Monad (liftM)
24import Control.Monad (liftM)
29−import Data.Char (isDigit, isHexDigit)
25+import Data.Char (isDigit, isHexDigit, ord)
30−import Data.Int (Int8, Int16, Int32, Int64)
31import Data.Ratio ((%))
26import Data.Ratio ((%))
32−import Data.Text.Internal.Read
33import Data.Text.Lazy as T
27import Data.Text.Lazy as T
34−import Data.Word (Word, Word8, Word16, Word32, Word64)
35
28
36-- | Read some text. If the read succeeds, return its value and the
29-- | Read some text. If the read succeeds, return its value and the
37-- remaining text, otherwise an error message.
30-- remaining text, otherwise an error message.
38−type Reader a = IReader Text a
31+type Reader a = Text -> Either String (a,Text)
39−type Parser = IParser Text
40
32
41-- | Read a decimal integer. The input must begin with at least one
33-- | Read a decimal integer. The input must begin with at least one
42-- decimal digit, and is consumed until a non-digit or end of string
34-- decimal digit, and is consumed until a non-digit or end of string
@@ -51,16 +43,7 @@ type Parser = IParser Text
51-- 'Integer' for your result type.
43-- 'Integer' for your result type.
52decimal :: Integral a => Reader a
44decimal :: Integral a => Reader a
53{-# SPECIALIZE decimal :: Reader Int #-}
45{-# SPECIALIZE decimal :: Reader Int #-}
54−{-# SPECIALIZE decimal :: Reader Int8 #-}
55−{-# SPECIALIZE decimal :: Reader Int16 #-}
56−{-# SPECIALIZE decimal :: Reader Int32 #-}
57−{-# SPECIALIZE decimal :: Reader Int64 #-}
58{-# SPECIALIZE decimal :: Reader Integer #-}
46{-# SPECIALIZE decimal :: Reader Integer #-}
59−{-# SPECIALIZE decimal :: Reader Data.Word.Word #-}
60−{-# SPECIALIZE decimal :: Reader Word8 #-}
61−{-# SPECIALIZE decimal :: Reader Word16 #-}
62−{-# SPECIALIZE decimal :: Reader Word32 #-}
63−{-# SPECIALIZE decimal :: Reader Word64 #-}
64decimal txt
47decimal txt
65 | T.null h = Left "input does not start with a digit"
48 | T.null h = Left "input does not start with a digit"
66 | otherwise = Right (T.foldl' go 0 h, t)
49 | otherwise = Right (T.foldl' go 0 h, t)
@@ -88,23 +71,23 @@ hexadecimal txt
88 where (h,t) = T.splitAt 2 txt
71 where (h,t) = T.splitAt 2 txt
89
72
90hex :: Integral a => Reader a
73hex :: Integral a => Reader a
91−{-# SPECIALIZE hexadecimal :: Reader Int #-}
74+{-# SPECIALIZE hex :: Reader Int #-}
92−{-# SPECIALIZE hexadecimal :: Reader Int8 #-}
93−{-# SPECIALIZE hexadecimal :: Reader Int16 #-}
94−{-# SPECIALIZE hexadecimal :: Reader Int32 #-}
95−{-# SPECIALIZE hexadecimal :: Reader Int64 #-}
96−{-# SPECIALIZE hexadecimal :: Reader Integer #-}
75+{-# SPECIALIZE hex :: Reader Integer #-}
97−{-# SPECIALIZE hexadecimal :: Reader Word #-}
98−{-# SPECIALIZE hexadecimal :: Reader Word8 #-}
99−{-# SPECIALIZE hexadecimal :: Reader Word16 #-}
100−{-# SPECIALIZE hexadecimal :: Reader Word32 #-}
101−{-# SPECIALIZE hexadecimal :: Reader Word64 #-}
102hex txt
76hex txt
103 | T.null h = Left "input does not start with a hexadecimal digit"
77 | T.null h = Left "input does not start with a hexadecimal digit"
104 | otherwise = Right (T.foldl' go 0 h, t)
78 | otherwise = Right (T.foldl' go 0 h, t)
105 where (h,t) = T.span isHexDigit txt
79 where (h,t) = T.span isHexDigit txt
106 go n d = (n * 16 + fromIntegral (hexDigitToInt d))
80 go n d = (n * 16 + fromIntegral (hexDigitToInt d))
107
81
82+hexDigitToInt :: Char -> Int
83+hexDigitToInt c
84+ | c >= '0' && c <= '9' = ord c - ord '0'
85+ | c >= 'a' && c <= 'f' = ord c - (ord 'a' - 10)
86+ | otherwise = ord c - (ord 'A' - 10)
87+
88+digitToInt :: Char -> Int
89+digitToInt c = ord c - ord '0'
90+
108-- | Read an optional leading sign character (@\'-\'@ or @\'+\'@) and
91-- | Read an optional leading sign character (@\'-\'@ or @\'+\'@) and
109-- apply it to the result of applying the given reader.
92-- apply it to the result of applying the given reader.
110signed :: Num a => Reader a -> Reader a
93signed :: Num a => Reader a -> Reader a
@@ -131,7 +114,7 @@ signed f = runP (signa (P f))
131--
114--
132-- >rational "3.foo" == Right (3.0, ".foo")
115-- >rational "3.foo" == Right (3.0, ".foo")
133-- >rational "3e" == Right (3.0, "e")
116-- >rational "3e" == Right (3.0, "e")
134−rational :: Fractional a => Reader a
117+rational :: RealFloat a => Reader a
135{-# SPECIALIZE rational :: Reader Double #-}
118{-# SPECIALIZE rational :: Reader Double #-}
136rational = floaty $ \real frac fracDenom -> fromRational $
119rational = floaty $ \real frac fracDenom -> fromRational $
137 real % 1 + frac % fracDenom
120 real % 1 + frac % fracDenom
@@ -155,21 +138,37 @@ double = floaty $ \real frac fracDenom ->
155
138
156signa :: Num a => Parser a -> Parser a
139signa :: Num a => Parser a -> Parser a
157{-# SPECIALIZE signa :: Parser Int -> Parser Int #-}
140{-# SPECIALIZE signa :: Parser Int -> Parser Int #-}
158−{-# SPECIALIZE signa :: Parser Int8 -> Parser Int8 #-}
159−{-# SPECIALIZE signa :: Parser Int16 -> Parser Int16 #-}
160−{-# SPECIALIZE signa :: Parser Int32 -> Parser Int32 #-}
161−{-# SPECIALIZE signa :: Parser Int64 -> Parser Int64 #-}
162{-# SPECIALIZE signa :: Parser Integer -> Parser Integer #-}
141{-# SPECIALIZE signa :: Parser Integer -> Parser Integer #-}
163signa p = do
142signa p = do
164 sign <- perhaps '+' $ char (\c -> c == '-' || c == '+')
143 sign <- perhaps '+' $ char (\c -> c == '-' || c == '+')
165 if sign == '+' then p else negate `liftM` p
144 if sign == '+' then p else negate `liftM` p
166
145
146+newtype Parser a = P {
147+ runP :: Reader a
148+ }
149+
150+instance Monad Parser where
151+ return a = P $ \t -> Right (a,t)
152+ {-# INLINE return #-}
153+ m >>= k = P $ \t -> case runP m t of
154+ Left err -> Left err
155+ Right (a,t') -> runP (k a) t'
156+ {-# INLINE (>>=) #-}
157+ fail msg = P $ \_ -> Left msg
158+
159+perhaps :: a -> Parser a -> Parser a
160+perhaps def m = P $ \t -> case runP m t of
161+ Left _ -> Right (def,t)
162+ r@(Right _) -> r
163+
167char :: (Char -> Bool) -> Parser Char
164char :: (Char -> Bool) -> Parser Char
168char p = P $ \t -> case T.uncons t of
165char p = P $ \t -> case T.uncons t of
169 Just (c,t') | p c -> Right (c,t')
166 Just (c,t') | p c -> Right (c,t')
170 _ -> Left "character does not match"
167 _ -> Left "character does not match"
171
168
169+data T = T !Integer !Int
170+
172−floaty :: Fractional a => (Integer -> Integer -> Integer -> a) -> Reader a
171+floaty :: RealFloat a => (Integer -> Integer -> Integer -> a) -> Reader a
173{-# INLINE floaty #-}
172{-# INLINE floaty #-}
174floaty f = runP $ do
173floaty f = runP $ do
175 sign <- perhaps '+' $ char (\c -> c == '-' || c == '+')
174 sign <- perhaps '+' $ char (\c -> c == '-' || c == '+')
Data/Text/Internal/Lazy/Search.hs → Data/Text/Lazy/Search.hsrenamed+9−13
@@ -5,19 +5,16 @@
5-- Copyright : (c) 2009, 2010 Bryan O'Sullivan
5-- Copyright : (c) 2009, 2010 Bryan O'Sullivan
6--
6--
7-- License : BSD-style
7-- License : BSD-style
8−-- Maintainer : bos@serpentine.com
8+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
9+-- duncan@haskell.org
9-- Stability : experimental
10-- Stability : experimental
10-- Portability : GHC
11-- Portability : GHC
11--
12--
12−-- /Warning/: this is an internal module, and does not have a stable
13−-- API or name. Functions in this module may not check or enforce
14−-- preconditions expected by public modules. Use at your own risk!
15−--
16-- Fast substring search for lazy 'Text', based on work by Boyer,
13-- Fast substring search for lazy 'Text', based on work by Boyer,
17-- Moore, Horspool, Sunday, and Lundh. Adapted from the strict
14-- Moore, Horspool, Sunday, and Lundh. Adapted from the strict
18-- implementation.
15-- implementation.
19
16
20−module Data.Text.Internal.Lazy.Search
17+module Data.Text.Lazy.Search
21 (
18 (
22 indices
19 indices
23 ) where
20 ) where
@@ -26,10 +23,10 @@ import qualified Data.Text.Array as A
26import Data.Int (Int64)
23import Data.Int (Int64)
27import Data.Word (Word16, Word64)
24import Data.Word (Word16, Word64)
28import qualified Data.Text.Internal as T
25import qualified Data.Text.Internal as T
29−import Data.Text.Internal.Fusion.Types (PairS(..))
26+import Data.Text.Fusion.Internal (PairS(..))
30−import Data.Text.Internal.Lazy (Text(..), foldlChunks)
27+import Data.Text.Lazy.Internal (Text(..), foldlChunks)
31import Data.Bits ((.|.), (.&.))
28import Data.Bits ((.|.), (.&.))
32−import Data.Text.Internal.Unsafe.Shift (shiftL)
29+import Data.Text.UnsafeShift (shiftL)
33
30
34-- | /O(n+m)/ Find the offsets of all non-overlapping indices of
31-- | /O(n+m)/ Find the offsets of all non-overlapping indices of
35-- @needle@ within @haystack@.
32-- @needle@ within @haystack@.
@@ -80,11 +77,10 @@ indices needle@(Chunk n ns) _haystack@(Chunk k ks)
80 go !(g::Int64) !i !msk !skp
77 go !(g::Int64) !i !msk !skp
81 | i >= xlast = case xs of
78 | i >= xlast = case xs of
82 Empty -> (msk .|. swizzle z) :*: skp
79 Empty -> (msk .|. swizzle z) :*: skp
83− Chunk y ys -> buildTable y ys g 0 msk' skp'
80+ Chunk y ys -> buildTable y ys g 0 msk skp
84− | otherwise = go (g+1) (i+1) msk' skp'
81+ | otherwise = go (g+1) (i+1) (msk .|. swizzle c) skp'
85 where c = A.unsafeIndex xarr (xoff+i)
82 where c = A.unsafeIndex xarr (xoff+i)
86− msk' = msk .|. swizzle c
87− skp' | c == z = nlen - g - 2
83+ skp' | c == z = nlen - fromIntegral g - 2
88 | otherwise = skp
84 | otherwise = skp
89 xlast = xlen - 1
85 xlast = xlen - 1
90 -- | Check whether an attempt to index into the haystack at the
86 -- | Check whether an attempt to index into the haystack at the
Data/Text/Read.hs+39−48
@@ -1,14 +1,12 @@
1−{-# LANGUAGE OverloadedStrings, UnboxedTuples, CPP #-}
1+{-# LANGUAGE OverloadedStrings #-}
2−#if __GLASGOW_HASKELL__ >= 702
3−{-# LANGUAGE Trustworthy #-}
4−#endif
5
2
6-- |
3-- |
7-- Module : Data.Text.Read
4-- Module : Data.Text.Read
8−-- Copyright : (c) 2010, 2011 Bryan O'Sullivan
5+-- Copyright : (c) 2010 Bryan O'Sullivan
9--
6--
10-- License : BSD-style
7-- License : BSD-style
11−-- Maintainer : bos@serpentine.com
8+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
9+-- duncan@haskell.org
12-- Stability : experimental
10-- Stability : experimental
13-- Portability : GHC
11-- Portability : GHC
14--
12--
@@ -24,18 +22,13 @@ module Data.Text.Read
24 ) where
22 ) where
25
23
26import Control.Monad (liftM)
24import Control.Monad (liftM)
27−import Data.Char (isDigit, isHexDigit)
25+import Data.Char (isDigit, isHexDigit, ord)
28−import Data.Int (Int8, Int16, Int32, Int64)
29import Data.Ratio ((%))
26import Data.Ratio ((%))
30import Data.Text as T
27import Data.Text as T
31−import Data.Text.Internal.Private (span_)
32−import Data.Text.Internal.Read
33−import Data.Word (Word, Word8, Word16, Word32, Word64)
34
28
35-- | Read some text. If the read succeeds, return its value and the
29-- | Read some text. If the read succeeds, return its value and the
36-- remaining text, otherwise an error message.
30-- remaining text, otherwise an error message.
37−type Reader a = IReader Text a
31+type Reader a = Text -> Either String (a,Text)
38−type Parser a = IParser Text a
39
32
40-- | Read a decimal integer. The input must begin with at least one
33-- | Read a decimal integer. The input must begin with at least one
41-- decimal digit, and is consumed until a non-digit or end of string
34-- decimal digit, and is consumed until a non-digit or end of string
@@ -50,20 +43,11 @@ type Parser a = IParser Text a
50-- 'Integer' for your result type.
43-- 'Integer' for your result type.
51decimal :: Integral a => Reader a
44decimal :: Integral a => Reader a
52{-# SPECIALIZE decimal :: Reader Int #-}
45{-# SPECIALIZE decimal :: Reader Int #-}
53−{-# SPECIALIZE decimal :: Reader Int8 #-}
54−{-# SPECIALIZE decimal :: Reader Int16 #-}
55−{-# SPECIALIZE decimal :: Reader Int32 #-}
56−{-# SPECIALIZE decimal :: Reader Int64 #-}
57{-# SPECIALIZE decimal :: Reader Integer #-}
46{-# SPECIALIZE decimal :: Reader Integer #-}
58−{-# SPECIALIZE decimal :: Reader Data.Word.Word #-}
59−{-# SPECIALIZE decimal :: Reader Word8 #-}
60−{-# SPECIALIZE decimal :: Reader Word16 #-}
61−{-# SPECIALIZE decimal :: Reader Word32 #-}
62−{-# SPECIALIZE decimal :: Reader Word64 #-}
63decimal txt
47decimal txt
64 | T.null h = Left "input does not start with a digit"
48 | T.null h = Left "input does not start with a digit"
65 | otherwise = Right (T.foldl' go 0 h, t)
49 | otherwise = Right (T.foldl' go 0 h, t)
66− where (# h,t #) = span_ isDigit txt
50+ where (h,t) = T.span isDigit txt
67 go n d = (n * 10 + fromIntegral (digitToInt d))
51 go n d = (n * 10 + fromIntegral (digitToInt d))
68
52
69-- | Read a hexadecimal integer, consisting of an optional leading
53-- | Read a hexadecimal integer, consisting of an optional leading
@@ -80,16 +64,7 @@ decimal txt
80-- 'Integer' for your result type.
64-- 'Integer' for your result type.
81hexadecimal :: Integral a => Reader a
65hexadecimal :: Integral a => Reader a
82{-# SPECIALIZE hexadecimal :: Reader Int #-}
66{-# SPECIALIZE hexadecimal :: Reader Int #-}
83−{-# SPECIALIZE hexadecimal :: Reader Int8 #-}
84−{-# SPECIALIZE hexadecimal :: Reader Int16 #-}
85−{-# SPECIALIZE hexadecimal :: Reader Int32 #-}
86−{-# SPECIALIZE hexadecimal :: Reader Int64 #-}
87{-# SPECIALIZE hexadecimal :: Reader Integer #-}
67{-# SPECIALIZE hexadecimal :: Reader Integer #-}
88−{-# SPECIALIZE hexadecimal :: Reader Word #-}
89−{-# SPECIALIZE hexadecimal :: Reader Word8 #-}
90−{-# SPECIALIZE hexadecimal :: Reader Word16 #-}
91−{-# SPECIALIZE hexadecimal :: Reader Word32 #-}
92−{-# SPECIALIZE hexadecimal :: Reader Word64 #-}
93hexadecimal txt
68hexadecimal txt
94 | h == "0x" || h == "0X" = hex t
69 | h == "0x" || h == "0X" = hex t
95 | otherwise = hex txt
70 | otherwise = hex txt
@@ -97,22 +72,22 @@ hexadecimal txt
97
72
98hex :: Integral a => Reader a
73hex :: Integral a => Reader a
99{-# SPECIALIZE hex :: Reader Int #-}
74{-# SPECIALIZE hex :: Reader Int #-}
100−{-# SPECIALIZE hex :: Reader Int8 #-}
101−{-# SPECIALIZE hex :: Reader Int16 #-}
102−{-# SPECIALIZE hex :: Reader Int32 #-}
103−{-# SPECIALIZE hex :: Reader Int64 #-}
104{-# SPECIALIZE hex :: Reader Integer #-}
75{-# SPECIALIZE hex :: Reader Integer #-}
105−{-# SPECIALIZE hex :: Reader Word #-}
106−{-# SPECIALIZE hex :: Reader Word8 #-}
107−{-# SPECIALIZE hex :: Reader Word16 #-}
108−{-# SPECIALIZE hex :: Reader Word32 #-}
109−{-# SPECIALIZE hex :: Reader Word64 #-}
110hex txt
76hex txt
111 | T.null h = Left "input does not start with a hexadecimal digit"
77 | T.null h = Left "input does not start with a hexadecimal digit"
112 | otherwise = Right (T.foldl' go 0 h, t)
78 | otherwise = Right (T.foldl' go 0 h, t)
113− where (# h,t #) = span_ isHexDigit txt
79+ where (h,t) = T.span isHexDigit txt
114 go n d = (n * 16 + fromIntegral (hexDigitToInt d))
80 go n d = (n * 16 + fromIntegral (hexDigitToInt d))
115
81
82+hexDigitToInt :: Char -> Int
83+hexDigitToInt c
84+ | c >= '0' && c <= '9' = ord c - ord '0'
85+ | c >= 'a' && c <= 'f' = ord c - (ord 'a' - 10)
86+ | otherwise = ord c - (ord 'A' - 10)
87+
88+digitToInt :: Char -> Int
89+digitToInt c = ord c - ord '0'
90+
116-- | Read an optional leading sign character (@\'-\'@ or @\'+\'@) and
91-- | Read an optional leading sign character (@\'-\'@ or @\'+\'@) and
117-- apply it to the result of applying the given reader.
92-- apply it to the result of applying the given reader.
118signed :: Num a => Reader a -> Reader a
93signed :: Num a => Reader a -> Reader a
@@ -139,7 +114,7 @@ signed f = runP (signa (P f))
139--
114--
140-- >rational "3.foo" == Right (3.0, ".foo")
115-- >rational "3.foo" == Right (3.0, ".foo")
141-- >rational "3e" == Right (3.0, "e")
116-- >rational "3e" == Right (3.0, "e")
142−rational :: Fractional a => Reader a
117+rational :: RealFloat a => Reader a
143{-# SPECIALIZE rational :: Reader Double #-}
118{-# SPECIALIZE rational :: Reader Double #-}
144rational = floaty $ \real frac fracDenom -> fromRational $
119rational = floaty $ \real frac fracDenom -> fromRational $
145 real % 1 + frac % fracDenom
120 real % 1 + frac % fracDenom
@@ -163,21 +138,37 @@ double = floaty $ \real frac fracDenom ->
163
138
164signa :: Num a => Parser a -> Parser a
139signa :: Num a => Parser a -> Parser a
165{-# SPECIALIZE signa :: Parser Int -> Parser Int #-}
140{-# SPECIALIZE signa :: Parser Int -> Parser Int #-}
166−{-# SPECIALIZE signa :: Parser Int8 -> Parser Int8 #-}
167−{-# SPECIALIZE signa :: Parser Int16 -> Parser Int16 #-}
168−{-# SPECIALIZE signa :: Parser Int32 -> Parser Int32 #-}
169−{-# SPECIALIZE signa :: Parser Int64 -> Parser Int64 #-}
170{-# SPECIALIZE signa :: Parser Integer -> Parser Integer #-}
141{-# SPECIALIZE signa :: Parser Integer -> Parser Integer #-}
171signa p = do
142signa p = do
172 sign <- perhaps '+' $ char (\c -> c == '-' || c == '+')
143 sign <- perhaps '+' $ char (\c -> c == '-' || c == '+')
173 if sign == '+' then p else negate `liftM` p
144 if sign == '+' then p else negate `liftM` p
174
145
146+newtype Parser a = P {
147+ runP :: Reader a
148+ }
149+
150+instance Monad Parser where
151+ return a = P $ \t -> Right (a,t)
152+ {-# INLINE return #-}
153+ m >>= k = P $ \t -> case runP m t of
154+ Left err -> Left err
155+ Right (a,t') -> runP (k a) t'
156+ {-# INLINE (>>=) #-}
157+ fail msg = P $ \_ -> Left msg
158+
159+perhaps :: a -> Parser a -> Parser a
160+perhaps def m = P $ \t -> case runP m t of
161+ Left _ -> Right (def,t)
162+ r@(Right _) -> r
163+
175char :: (Char -> Bool) -> Parser Char
164char :: (Char -> Bool) -> Parser Char
176char p = P $ \t -> case T.uncons t of
165char p = P $ \t -> case T.uncons t of
177 Just (c,t') | p c -> Right (c,t')
166 Just (c,t') | p c -> Right (c,t')
178 _ -> Left "character does not match"
167 _ -> Left "character does not match"
179
168
169+data T = T !Integer !Int
170+
180−floaty :: Fractional a => (Integer -> Integer -> Integer -> a) -> Reader a
171+floaty :: RealFloat a => (Integer -> Integer -> Integer -> a) -> Reader a
181{-# INLINE floaty #-}
172{-# INLINE floaty #-}
182floaty f = runP $ do
173floaty f = runP $ do
183 sign <- perhaps '+' $ char (\c -> c == '-' || c == '+')
174 sign <- perhaps '+' $ char (\c -> c == '-' || c == '+')
Data/Text/Internal/Search.hs → Data/Text/Search.hsrenamed+11−12
@@ -1,11 +1,12 @@
1{-# LANGUAGE BangPatterns, ScopedTypeVariables #-}
1{-# LANGUAGE BangPatterns, ScopedTypeVariables #-}
2
2
3-- |
3-- |
4−-- Module : Data.Text.Internal.Search
4+-- Module : Data.Text.Search
5-- Copyright : (c) Bryan O'Sullivan 2009
5-- Copyright : (c) Bryan O'Sullivan 2009
6--
6--
7-- License : BSD-style
7-- License : BSD-style
8−-- Maintainer : bos@serpentine.com
8+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
9+-- duncan@haskell.org
9-- Stability : experimental
10-- Stability : experimental
10-- Portability : GHC
11-- Portability : GHC
11--
12--
@@ -13,7 +14,7 @@
13-- Horspool, Sunday, and Lundh.
14-- Horspool, Sunday, and Lundh.
14--
15--
15-- References:
16-- References:
16−--
17+--
17-- * R. S. Boyer, J. S. Moore: A Fast String Searching Algorithm.
18-- * R. S. Boyer, J. S. Moore: A Fast String Searching Algorithm.
18-- Communications of the ACM, 20, 10, 762-772 (1977)
19-- Communications of the ACM, 20, 10, 762-772 (1977)
19--
20--
@@ -26,7 +27,7 @@
26-- * F. Lundh: The Fast Search Algorithm.
27-- * F. Lundh: The Fast Search Algorithm.
27-- <http://effbot.org/zone/stringlib.htm> (2006)
28-- <http://effbot.org/zone/stringlib.htm> (2006)
28
29
29−module Data.Text.Internal.Search
30+module Data.Text.Search
30 (
31 (
31 indices
32 indices
32 ) where
33 ) where
@@ -34,15 +35,13 @@ module Data.Text.Internal.Search
34import qualified Data.Text.Array as A
35import qualified Data.Text.Array as A
35import Data.Word (Word64)
36import Data.Word (Word64)
36import Data.Text.Internal (Text(..))
37import Data.Text.Internal (Text(..))
38+import Data.Text.Fusion.Internal (PairS(..))
37import Data.Bits ((.|.), (.&.))
39import Data.Bits ((.|.), (.&.))
38−import Data.Text.Internal.Unsafe.Shift (shiftL)
40+import Data.Text.UnsafeShift (shiftL)
39−
40−data T = {-# UNPACK #-} !Word64 :* {-# UNPACK #-} !Int
41
41
42-- | /O(n+m)/ Find the offsets of all non-overlapping indices of
42-- | /O(n+m)/ Find the offsets of all non-overlapping indices of
43-- @needle@ within @haystack@. The offsets returned represent
43-- @needle@ within @haystack@. The offsets returned represent
44−-- uncorrected indices in the low-level \"needle\" array, to which its
44+-- locations in the low-level array.
45−-- offset must be added.
46--
45--
47-- In (unlikely) bad cases, this algorithm's complexity degrades
46-- In (unlikely) bad cases, this algorithm's complexity degrades
48-- towards /O(n*m)/.
47-- towards /O(n*m)/.
@@ -61,8 +60,9 @@ indices _needle@(Text narr noff nlen) _haystack@(Text harr hoff hlen)
61 hindex k = A.unsafeIndex harr (hoff+k)
60 hindex k = A.unsafeIndex harr (hoff+k)
62 hindex' k | k == hlen = 0
61 hindex' k | k == hlen = 0
63 | otherwise = A.unsafeIndex harr (hoff+k)
62 | otherwise = A.unsafeIndex harr (hoff+k)
63+ (mask :: Word64) :*: skip = buildTable 0 0 (nlen-2)
64 buildTable !i !msk !skp
64 buildTable !i !msk !skp
65− | i >= nlast = (msk .|. swizzle z) :* skp
65+ | i >= nlast = (msk .|. swizzle z) :*: skp
66 | otherwise = buildTable (i+1) (msk .|. swizzle c) skp'
66 | otherwise = buildTable (i+1) (msk .|. swizzle c) skp'
67 where c = nindex i
67 where c = nindex i
68 skp' | c == z = nlen - i - 2
68 skp' | c == z = nlen - i - 2
@@ -80,8 +80,7 @@ indices _needle@(Text narr noff nlen) _haystack@(Text harr hoff hlen)
80 delta | nextInPattern = nlen + 1
80 delta | nextInPattern = nlen + 1
81 | c == z = skip + 1
81 | c == z = skip + 1
82 | otherwise = 1
82 | otherwise = 1
83− where nextInPattern = mask .&. swizzle (hindex' (i+nlen)) == 0
83+ nextInPattern = mask .&. swizzle (hindex' (i+nlen)) == 0
84− !(mask :* skip) = buildTable 0 0 (nlen-2)
85 scanOne c = loop 0
84 scanOne c = loop 0
86 where loop !i | i >= hlen = []
85 where loop !i | i >= hlen = []
87 | hindex i == c = i : loop (i+1)
86 | hindex i == c = i : loop (i+1)
Data/Text/Show.hsdeleted−89
@@ -1,89 +0,0 @@
1−{-# LANGUAGE CPP, MagicHash #-}
2−{-# OPTIONS_GHC -fno-warn-orphans #-}
3−#if __GLASGOW_HASKELL__ >= 702
4−{-# LANGUAGE Trustworthy #-}
5−#endif
6−
7−-- |
8−-- Module : Data.Text.Show
9−-- Copyright : (c) 2009-2015 Bryan O'Sullivan
10−--
11−-- License : BSD-style
12−-- Maintainer : bos@serpentine.com
13−-- Stability : experimental
14−-- Portability : GHC
15−
16−module Data.Text.Show
17− (
18− singleton
19− , unpack
20− , unpackCString#
21− ) where
22−
23−import Control.Monad.ST (ST)
24−import Data.Text.Internal (Text(..), empty_, safe)
25−import Data.Text.Internal.Fusion (stream, unstream)
26−import Data.Text.Internal.Unsafe.Char (unsafeWrite)
27−import GHC.Prim (Addr#)
28−import qualified Data.Text.Array as A
29−import qualified Data.Text.Internal.Fusion.Common as S
30−
31−#if __GLASGOW_HASKELL__ >= 702
32−import qualified GHC.CString as GHC
33−#else
34−import qualified GHC.Base as GHC
35−#endif
36−
37−instance Show Text where
38− showsPrec p ps r = showsPrec p (unpack ps) r
39−
40−-- | /O(n)/ Convert a 'Text' into a 'String'. Subject to fusion.
41−unpack :: Text -> String
42−unpack = S.unstreamList . stream
43−{-# INLINE [1] unpack #-}
44−
45−-- | /O(n)/ Convert a literal string into a 'Text'. Subject to
46−-- fusion.
47−--
48−-- This is exposed solely for people writing GHC rewrite rules.
49−unpackCString# :: Addr# -> Text
50−unpackCString# addr# = unstream (S.streamCString# addr#)
51−{-# NOINLINE unpackCString# #-}
52−
53−{-# RULES "TEXT literal" [1] forall a.
54− unstream (S.map safe (S.streamList (GHC.unpackCString# a)))
55− = unpackCString# a #-}
56−
57−{-# RULES "TEXT literal UTF8" [1] forall a.
58− unstream (S.map safe (S.streamList (GHC.unpackCStringUtf8# a)))
59− = unpackCString# a #-}
60−
61−{-# RULES "TEXT empty literal" [1]
62− unstream (S.map safe (S.streamList []))
63− = empty_ #-}
64−
65−{-# RULES "TEXT singleton literal" [1] forall a.
66− unstream (S.map safe (S.streamList [a]))
67− = singleton_ a #-}
68−
69−-- | /O(1)/ Convert a character into a Text. Subject to fusion.
70−-- Performs replacement on invalid scalar values.
71−singleton :: Char -> Text
72−singleton = unstream . S.singleton . safe
73−{-# INLINE [1] singleton #-}
74−
75−{-# RULES "TEXT singleton" forall a.
76− unstream (S.singleton (safe a))
77− = singleton_ a #-}
78−
79−-- This is intended to reduce inlining bloat.
80−singleton_ :: Char -> Text
81−singleton_ c = Text (A.run x) 0 len
82− where x :: ST s (A.MArray s)
83− x = do arr <- A.new len
84− _ <- unsafeWrite arr 0 d
85− return arr
86− len | d < '\x10000' = 1
87− | otherwise = 2
88− d = safe c
89−{-# NOINLINE singleton_ #-}
Data/Text/Unsafe.hs+7−19
@@ -3,7 +3,8 @@
3-- Module : Data.Text.Unsafe
3-- Module : Data.Text.Unsafe
4-- Copyright : (c) 2009, 2010, 2011 Bryan O'Sullivan
4-- Copyright : (c) 2009, 2010, 2011 Bryan O'Sullivan
5-- License : BSD-style
5-- License : BSD-style
6−-- Maintainer : bos@serpentine.com
6+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
7+-- duncan@haskell.org
7-- Stability : experimental
8-- Stability : experimental
8-- Portability : portable
9-- Portability : portable
9--
10--
@@ -13,28 +14,25 @@ module Data.Text.Unsafe
13 (
14 (
14 inlineInterleaveST
15 inlineInterleaveST
15 , inlinePerformIO
16 , inlinePerformIO
16− , unsafeDupablePerformIO
17 , Iter(..)
17 , Iter(..)
18 , iter
18 , iter
19 , iter_
19 , iter_
20 , reverseIter
20 , reverseIter
21− , reverseIter_
22 , unsafeHead
21 , unsafeHead
23 , unsafeTail
22 , unsafeTail
24 , lengthWord16
23 , lengthWord16
25 , takeWord16
24 , takeWord16
26 , dropWord16
25 , dropWord16
27 ) where
26 ) where
28−
27+
29#if defined(ASSERTS)
28#if defined(ASSERTS)
30import Control.Exception (assert)
29import Control.Exception (assert)
31#endif
30#endif
32−import Data.Text.Internal.Encoding.Utf16 (chr2)
31+import Data.Text.Encoding.Utf16 (chr2)
33import Data.Text.Internal (Text(..))
32import Data.Text.Internal (Text(..))
34−import Data.Text.Internal.Unsafe (inlineInterleaveST, inlinePerformIO)
33+import Data.Text.Unsafe.Base (inlineInterleaveST, inlinePerformIO)
35−import Data.Text.Internal.Unsafe.Char (unsafeChr)
34+import Data.Text.UnsafeChar (unsafeChr)
36import qualified Data.Text.Array as A
35import qualified Data.Text.Array as A
37−import GHC.IO (unsafeDupablePerformIO)
38
36
39-- | /O(1)/ A variant of 'head' for non-empty 'Text'. 'unsafeHead'
37-- | /O(1)/ A variant of 'head' for non-empty 'Text'. 'unsafeHead'
40-- omits the check for the empty case, so there is an obligation on
38-- omits the check for the empty case, so there is an obligation on
@@ -47,7 +45,7 @@ unsafeHead (Text arr off _len)
47 n = A.unsafeIndex arr (off+1)
45 n = A.unsafeIndex arr (off+1)
48{-# INLINE unsafeHead #-}
46{-# INLINE unsafeHead #-}
49
47
50−-- | /O(1)/ A variant of 'tail' for non-empty 'Text'. 'unsafeTail'
48+-- | /O(1)/ A variant of 'tail' for non-empty 'Text'. 'unsafeHead'
51-- omits the check for the empty case, so there is an obligation on
49-- omits the check for the empty case, so there is an obligation on
52-- the programmer to provide a proof that the 'Text' is non-empty.
50-- the programmer to provide a proof that the 'Text' is non-empty.
53unsafeTail :: Text -> Text
51unsafeTail :: Text -> Text
@@ -95,16 +93,6 @@ reverseIter (Text arr off _len) i
95 k = j - 1
93 k = j - 1
96{-# INLINE reverseIter #-}
94{-# INLINE reverseIter #-}
97
95
98−-- | /O(1)/ Iterate one step backwards through a UTF-16 array,
99−-- returning the delta to add (i.e. a negative number) to give the
100−-- next offset to iterate at.
101−reverseIter_ :: Text -> Int -> Int
102−reverseIter_ (Text arr off _len) i
103− | m < 0xDC00 || m > 0xDFFF = -1
104− | otherwise = -2
105− where m = A.unsafeIndex arr (off+i)
106−{-# INLINE reverseIter_ #-}
107−
108-- | /O(1)/ Return the length of a 'Text' in units of 'Word16'. This
96-- | /O(1)/ Return the length of a 'Text' in units of 'Word16'. This
109-- is useful for sizing a target array appropriately before using
97-- is useful for sizing a target array appropriately before using
110-- 'unsafeCopyToPtr'.
98-- 'unsafeCopyToPtr'.
Data/Text/Internal/Unsafe.hs → Data/Text/Unsafe/Base.hsrenamed+11−12
@@ -1,29 +1,28 @@
1{-# LANGUAGE CPP, MagicHash, UnboxedTuples #-}
1{-# LANGUAGE CPP, MagicHash, UnboxedTuples #-}
2−{-# OPTIONS_HADDOCK not-home #-}
3−
4-- |
2-- |
5−-- Module : Data.Text.Internal.Unsafe
3+-- Module : Data.Text.Unsafe.Base
6-- Copyright : (c) 2009, 2010, 2011 Bryan O'Sullivan
4-- Copyright : (c) 2009, 2010, 2011 Bryan O'Sullivan
7-- License : BSD-style
5-- License : BSD-style
8−-- Maintainer : bos@serpentine.com
6+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
7+-- duncan@haskell.org
9-- Stability : experimental
8-- Stability : experimental
10-- Portability : portable
9-- Portability : portable
11--
10--
12−-- /Warning/: this is an internal module, and does not have a stable
13−-- API or name. Functions in this module may not check or enforce
14−-- preconditions expected by public modules. Use at your own risk!
15−--
16−-- A module containing /unsafe/ operations, for /very very careful/ use
11+-- A module containing unsafe operations, for very very careful use in
17−-- in /heavily tested/ code.
12+-- heavily tested code.
18−module Data.Text.Internal.Unsafe
13+module Data.Text.Unsafe.Base
19 (
14 (
20 inlineInterleaveST
15 inlineInterleaveST
21 , inlinePerformIO
16 , inlinePerformIO
22 ) where
17 ) where
23−
18+
24import GHC.ST (ST(..))
19import GHC.ST (ST(..))
25#if defined(__GLASGOW_HASKELL__)
20#if defined(__GLASGOW_HASKELL__)
21+# if __GLASGOW_HASKELL__ >= 611
26import GHC.IO (IO(IO))
22import GHC.IO (IO(IO))
23+# else
24+import GHC.IOBase (IO(IO))
25+# endif
27import GHC.Base (realWorld#)
26import GHC.Base (realWorld#)
28#endif
27#endif
29
28
Data/Text/Internal/Unsafe/Char.hs → Data/Text/UnsafeChar.hsrenamed+5−8
@@ -1,22 +1,19 @@
1{-# LANGUAGE CPP, MagicHash #-}
1{-# LANGUAGE CPP, MagicHash #-}
2
2
3-- |
3-- |
4−-- Module : Data.Text.Internal.Unsafe.Char
4+-- Module : Data.Text.UnsafeChar
5-- Copyright : (c) 2008, 2009 Tom Harper,
5-- Copyright : (c) 2008, 2009 Tom Harper,
6-- (c) 2009, 2010 Bryan O'Sullivan,
6-- (c) 2009, 2010 Bryan O'Sullivan,
7-- (c) 2009 Duncan Coutts
7-- (c) 2009 Duncan Coutts
8--
8--
9-- License : BSD-style
9-- License : BSD-style
10−-- Maintainer : bos@serpentine.com
10+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
11+-- duncan@haskell.org
11-- Stability : experimental
12-- Stability : experimental
12-- Portability : GHC
13-- Portability : GHC
13--
14--
14−-- /Warning/: this is an internal module, and does not have a stable
15−-- API or name. Functions in this module may not check or enforce
16−-- preconditions expected by public modules. Use at your own risk!
17−--
18-- Fast character manipulation functions.
15-- Fast character manipulation functions.
19−module Data.Text.Internal.Unsafe.Char
16+module Data.Text.UnsafeChar
20 (
17 (
21 ord
18 ord
22 , unsafeChr
19 , unsafeChr
@@ -31,7 +28,7 @@ import Control.Exception (assert)
31#endif
28#endif
32import Control.Monad.ST (ST)
29import Control.Monad.ST (ST)
33import Data.Bits ((.&.))
30import Data.Bits ((.&.))
34−import Data.Text.Internal.Unsafe.Shift (shiftR)
31+import Data.Text.UnsafeShift (shiftR)
35import GHC.Exts (Char(..), Int(..), chr#, ord#, word2Int#)
32import GHC.Exts (Char(..), Int(..), chr#, ord#, word2Int#)
36import GHC.Word (Word8(..), Word16(..), Word32(..))
33import GHC.Word (Word8(..), Word16(..), Word32(..))
37import qualified Data.Text.Array as A
34import qualified Data.Text.Array as A
Data/Text/Internal/Unsafe/Shift.hs → Data/Text/UnsafeShift.hsrenamed+4−7
@@ -1,21 +1,18 @@
1{-# LANGUAGE MagicHash #-}
1{-# LANGUAGE MagicHash #-}
2
2
3-- |
3-- |
4−-- Module : Data.Text.Internal.Unsafe.Shift
4+-- Module : Data.Text.UnsafeShift
5-- Copyright : (c) Bryan O'Sullivan 2009
5-- Copyright : (c) Bryan O'Sullivan 2009
6--
6--
7-- License : BSD-style
7-- License : BSD-style
8−-- Maintainer : bos@serpentine.com
8+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
9+-- duncan@haskell.org
9-- Stability : experimental
10-- Stability : experimental
10-- Portability : GHC
11-- Portability : GHC
11--
12--
12−-- /Warning/: this is an internal module, and does not have a stable
13−-- API or name. Functions in this module may not check or enforce
14−-- preconditions expected by public modules. Use at your own risk!
15−--
16-- Fast, unchecked bit shifting functions.
13-- Fast, unchecked bit shifting functions.
17
14
18−module Data.Text.Internal.Unsafe.Shift
15+module Data.Text.UnsafeShift
19 (
16 (
20 UnsafeShift(..)
17 UnsafeShift(..)
21 ) where
18 ) where
Data/Text/Internal/Functions.hs → Data/Text/Util.hsrenamed+2−6
@@ -1,7 +1,7 @@
1{-# LANGUAGE CPP, DeriveDataTypeable #-}
1{-# LANGUAGE CPP, DeriveDataTypeable #-}
2
2
3-- |
3-- |
4−-- Module : Data.Text.Internal.Functions
4+-- Module : Data.Text.Util
5-- Copyright : 2010 Bryan O'Sullivan
5-- Copyright : 2010 Bryan O'Sullivan
6--
6--
7-- License : BSD-style
7-- License : BSD-style
@@ -9,13 +9,9 @@
9-- Stability : experimental
9-- Stability : experimental
10-- Portability : GHC
10-- Portability : GHC
11--
11--
12−-- /Warning/: this is an internal module, and does not have a stable
13−-- API or name. Functions in this module may not check or enforce
14−-- preconditions expected by public modules. Use at your own risk!
15−--
16-- Useful functions.
12-- Useful functions.
17
13
18−module Data.Text.Internal.Functions
14+module Data.Text.Util
19 (
15 (
20 intersperse
16 intersperse
21 ) where
17 ) where
README.markdown+5−5
@@ -19,15 +19,15 @@ library to provide these facilities.
19# Get involved!
19# Get involved!
20
20
21Please report bugs via the
21Please report bugs via the
22−[github issue tracker](https://github.com/bos/text/issues).
22+[bitbucket issue tracker](http://bitbucket.org/bos/text/issues).
23
23
24−Master [git repository](https://github.com/bos/text):
24+Master [Mercurial repository](http://bitbucket.org/bos/text):
25
25
26−* `git clone git://github.com/bos/text.git`
26+* `hg clone http://bitbucket.org/bos/text`
27
27
28−There's also a [Mercurial mirror](https://bitbucket.org/bos/text):
28+There's also a [git mirror](http://github.com/bos/text):
29
29
30−* `hg clone https://bitbucket.org/bos/text`
30+* `git clone git://github.com/bos/text.git`
31
31
32(You can create and contribute changes using either Mercurial or git.)
32(You can create and contribute changes using either Mercurial or git.)
33
33
benchmarks/cbits/time_iconv.cdeleted−35
@@ -1,35 +0,0 @@
1−#include <iconv.h>
2−#include <stdlib.h>
3−#include <stdio.h>
4−#include <stdint.h>
5−
6−int time_iconv(char *srcbuf, size_t srcbufsize)
7−{
8− uint16_t *destbuf = NULL;
9− size_t destbufsize;
10− static uint16_t *origdestbuf;
11− static size_t origdestbufsize;
12− iconv_t ic = (iconv_t) -1;
13− int ret = 0;
14−
15− if (ic == (iconv_t) -1) {
16− ic = iconv_open("UTF-16LE", "UTF-8");
17− if (ic == (iconv_t) -1) {
18− ret = -1;
19− goto done;
20− }
21− }
22−
23− destbufsize = srcbufsize * sizeof(uint16_t);
24− if (destbufsize > origdestbufsize) {
25− free(origdestbuf);
26− origdestbuf = destbuf = malloc(origdestbufsize = destbufsize);
27− } else {
28− destbuf = origdestbuf;
29− }
30−
31− iconv(ic, &srcbuf, &srcbufsize, (char**) &destbuf, &destbufsize);
32−
33− done:
34− return ret;
35−}
benchmarks/haskell/Benchmarks.hsdeleted−79
@@ -1,79 +0,0 @@
1−-- | Main module to run the micro benchmarks
2−--
3−{-# LANGUAGE OverloadedStrings #-}
4−module Main
5− ( main
6− ) where
7−
8−import Criterion.Main (Benchmark, defaultMain, bgroup)
9−import System.FilePath ((</>))
10−import System.IO (IOMode (WriteMode), openFile, hSetEncoding, utf8)
11−
12−import qualified Benchmarks.Builder as Builder
13−import qualified Benchmarks.DecodeUtf8 as DecodeUtf8
14−import qualified Benchmarks.EncodeUtf8 as EncodeUtf8
15−import qualified Benchmarks.Equality as Equality
16−import qualified Benchmarks.FileRead as FileRead
17−import qualified Benchmarks.FoldLines as FoldLines
18−import qualified Benchmarks.Mul as Mul
19−import qualified Benchmarks.Pure as Pure
20−import qualified Benchmarks.ReadNumbers as ReadNumbers
21−import qualified Benchmarks.Replace as Replace
22−import qualified Benchmarks.Search as Search
23−import qualified Benchmarks.Stream as Stream
24−import qualified Benchmarks.WordFrequencies as WordFrequencies
25−
26−import qualified Benchmarks.Programs.BigTable as Programs.BigTable
27−import qualified Benchmarks.Programs.Cut as Programs.Cut
28−import qualified Benchmarks.Programs.Fold as Programs.Fold
29−import qualified Benchmarks.Programs.Sort as Programs.Sort
30−import qualified Benchmarks.Programs.StripTags as Programs.StripTags
31−import qualified Benchmarks.Programs.Throughput as Programs.Throughput
32−
33−main :: IO ()
34−main = benchmarks >>= defaultMain
35−
36−benchmarks :: IO [Benchmark]
37−benchmarks = do
38− sink <- openFile "/dev/null" WriteMode
39− hSetEncoding sink utf8
40−
41− -- Traditional benchmarks
42− bs <- sequence
43− [ Builder.benchmark
44− , DecodeUtf8.benchmark "html" (tf "libya-chinese.html")
45− , DecodeUtf8.benchmark "xml" (tf "yiwiki.xml")
46− , DecodeUtf8.benchmark "ascii" (tf "ascii.txt")
47− , DecodeUtf8.benchmark "russian" (tf "russian.txt")
48− , DecodeUtf8.benchmark "japanese" (tf "japanese.txt")
49− , EncodeUtf8.benchmark "επανάληψη 竺法蘭共譯"
50− , Equality.benchmark (tf "japanese.txt")
51− , FileRead.benchmark (tf "russian.txt")
52− , FoldLines.benchmark (tf "russian.txt")
53− , Mul.benchmark
54− , Pure.benchmark "tiny" (tf "tiny.txt")
55− , Pure.benchmark "ascii" (tf "ascii-small.txt")
56− -- , Pure.benchmark "france" (tf "france.html")
57− , Pure.benchmark "russian" (tf "russian-small.txt")
58− , Pure.benchmark "japanese" (tf "japanese.txt")
59− , ReadNumbers.benchmark (tf "numbers.txt")
60− , Replace.benchmark (tf "russian.txt") "принимая" "своем"
61− , Search.benchmark (tf "russian.txt") "принимая"
62− , Stream.benchmark (tf "russian.txt")
63− , WordFrequencies.benchmark (tf "russian.txt")
64− ]
65−
66− -- Program-like benchmarks
67− ps <- bgroup "Programs" `fmap` sequence
68− [ Programs.BigTable.benchmark sink
69− , Programs.Cut.benchmark (tf "russian.txt") sink 20 40
70− , Programs.Fold.benchmark (tf "russian.txt") sink
71− , Programs.Sort.benchmark (tf "russian.txt") sink
72− , Programs.StripTags.benchmark (tf "yiwiki.xml") sink
73− , Programs.Throughput.benchmark (tf "russian.txt") sink
74− ]
75−
76− return $ bs ++ [ps]
77− where
78− -- Location of a test file
79− tf = ("../tests/text-test-data" </>)
benchmarks/haskell/Benchmarks/Builder.hsdeleted−75
@@ -1,75 +0,0 @@
1−-- | Testing the internal builder monoid
2−--
3−-- Tested in this benchmark:
4−--
5−-- * Concatenating many small strings using a builder
6−--
7−{-# LANGUAGE OverloadedStrings #-}
8−module Benchmarks.Builder
9− ( benchmark
10− ) where
11−
12−import Criterion (Benchmark, bgroup, bench, nf)
13−import Data.Binary.Builder as B
14−import Data.ByteString.Char8 ()
15−import Data.Monoid (mconcat, mempty)
16−import qualified Blaze.ByteString.Builder as Blaze
17−import qualified Blaze.ByteString.Builder.Char.Utf8 as Blaze
18−import qualified Data.ByteString as SB
19−import qualified Data.ByteString.Lazy as LB
20−import qualified Data.Text as T
21−import qualified Data.Text.Lazy as LT
22−import qualified Data.Text.Lazy.Builder as LTB
23−import qualified Data.Text.Lazy.Builder.Int as Int
24−import Data.Int (Int64)
25−
26−benchmark :: IO Benchmark
27−benchmark = return $ bgroup "Builder"
28− [ bgroup "Comparison"
29− [ bench "LazyText" $ nf
30− (LT.length . LTB.toLazyText . mconcat . map LTB.fromText) texts
31− , bench "Binary" $ nf
32− (LB.length . B.toLazyByteString . mconcat . map B.fromByteString)
33− byteStrings
34− , bench "Blaze" $ nf
35− (LB.length . Blaze.toLazyByteString . mconcat . map Blaze.fromString)
36− strings
37− ]
38− , bgroup "Int"
39− [ bgroup "Decimal"
40− [ bgroup "Positive" .
41− flip map numbers $ \n ->
42− (bench (show (length (show n))) $ nf (LTB.toLazyText . Int.decimal) n)
43− , bgroup "Negative" .
44− flip map numbers $ \m ->
45− let n = negate m in
46− (bench (show (length (show n))) $ nf (LTB.toLazyText . Int.decimal) n)
47− , bench "Empty" $ nf LTB.toLazyText mempty
48− , bgroup "Show" .
49− flip map numbers $ \n ->
50− (bench (show (length (show n))) $ nf show n)
51− ]
52− ]
53− ]
54− where
55− numbers :: [Int64]
56− numbers = [
57− 6, 14, 500, 9688, 10654, 620735, 5608880, 37010612,
58− 731223504, 5061580596, 24596952933, 711732309084, 2845910093839,
59− 54601756118340, 735159434806159, 3619097625502435, 95777227510267124,
60− 414944309510675693, 8986407456998704019
61− ]
62−
63−texts :: [T.Text]
64−texts = take 200000 $ cycle ["foo", "λx", "由の"]
65−{-# NOINLINE texts #-}
66−
67−-- Note that the non-ascii characters will be chopped
68−byteStrings :: [SB.ByteString]
69−byteStrings = take 200000 $ cycle ["foo", "λx", "由の"]
70−{-# NOINLINE byteStrings #-}
71−
72−-- Note that the non-ascii characters will be chopped
73−strings :: [String]
74−strings = take 200000 $ cycle ["foo", "λx", "由の"]
75−{-# NOINLINE strings #-}
benchmarks/haskell/Benchmarks/FileRead.hsdeleted−33
@@ -1,33 +0,0 @@
1−-- | Benchmarks simple file reading
2−--
3−-- Tested in this benchmark:
4−--
5−-- * Reading a file from the disk
6−--
7−module Benchmarks.FileRead
8− ( benchmark
9− ) where
10−
11−import Control.Applicative ((<$>))
12−import Criterion (Benchmark, bgroup, bench, whnfIO)
13−import qualified Data.ByteString as SB
14−import qualified Data.ByteString.Lazy as LB
15−import qualified Data.Text as T
16−import qualified Data.Text.Encoding as T
17−import qualified Data.Text.IO as T
18−import qualified Data.Text.Lazy as LT
19−import qualified Data.Text.Lazy.Encoding as LT
20−import qualified Data.Text.Lazy.IO as LT
21−
22−benchmark :: FilePath -> IO Benchmark
23−benchmark p = return $ bgroup "FileRead"
24− [ bench "String" $ whnfIO $ length <$> readFile p
25− , bench "ByteString" $ whnfIO $ SB.length <$> SB.readFile p
26− , bench "LazyByteString" $ whnfIO $ LB.length <$> LB.readFile p
27− , bench "Text" $ whnfIO $ T.length <$> T.readFile p
28− , bench "LazyText" $ whnfIO $ LT.length <$> LT.readFile p
29− , bench "TextByteString" $ whnfIO $
30− (T.length . T.decodeUtf8) <$> SB.readFile p
31− , bench "LazyTextByteString" $ whnfIO $
32− (LT.length . LT.decodeUtf8) <$> LB.readFile p
33− ]
benchmarks/haskell/Benchmarks/Mul.hsdeleted−138
@@ -1,138 +0,0 @@
1−module Benchmarks.Mul (benchmark) where
2−
3−import Control.Exception (evaluate)
4−import Criterion.Main
5−import Data.Int (Int32, Int64)
6−import Data.Text.Internal (mul32, mul64)
7−import qualified Data.Vector.Unboxed as U
8−
9−oldMul :: Int64 -> Int64 -> Int64
10−oldMul m n
11− | n == 0 = 0
12− | m <= maxBound `quot` n = m * n
13− | otherwise = error "overflow"
14−
15−benchmark :: IO Benchmark
16−benchmark = do
17− _ <- evaluate testVector32
18− _ <- evaluate testVector64
19− return $ bgroup "Mul" [
20− bench "oldMul" $ whnf (U.map (uncurry oldMul)) testVector64
21− , bench "mul64" $ whnf (U.map (uncurry mul64)) testVector64
22− , bench "*64" $ whnf (U.map (uncurry (*))) testVector64
23− , bench "mul32" $ whnf (U.map (uncurry mul32)) testVector32
24− , bench "*32" $ whnf (U.map (uncurry (*))) testVector32
25− ]
26−
27−testVector64 :: U.Vector (Int64,Int64)
28−testVector64 = U.fromList [
29− (0,1248868987182846646),(169004623633872,24458),(482549039517835,7614),
30− (372,8157063115504364),(27,107095594861148252),(3,63249878517962420),
31− (4363,255694473572912),(86678474,1732634806),(1572453024,1800489338),
32− (9384523143,77053781),(49024709555,75095046),(7,43457620410239131),
33− (8,8201563008844571),(387719037,1520696708),(189869238220197,1423),
34− (46788016849611,23063),(503077742109974359,0),(104,1502010908706487),
35− (30478140346,207525518),(80961140129236192,14),(4283,368012829143675),
36− (1028719181728108146,6),(318904,5874863049591),(56724427166898,110794),
37− (234539368,31369110449),(2,251729663598178612),(103291548194451219,5),
38− (76013,5345328755566),(1769631,2980846129318),(40898,60598477385754),
39− (0,98931348893227155),(573555872156917492,3),(318821187115,4476566),
40− (11152874213584,243582),(40274276,16636653248),(127,4249988676030597),
41− (103543712111871836,5),(71,16954462148248238),(3963027173504,216570),
42− (13000,503523808916753),(17038308,20018685905),(0,510350226577891549),
43− (175898,3875698895405),(425299191292676,5651),(17223451323664536,50),
44− (61755131,14247665326),(0,1018195131697569303),(36433751497238985,20),
45− (3473607861601050,1837),(1392342328,1733971838),(225770297367,3249655),
46− (14,127545244155254102),(1751488975299136,2634),(3949208,504190668767),
47− (153329,831454434345),(1066212122928663658,2),(351224,2663633539556),
48− (344565,53388869217),(35825609350446863,54),(276011553660081475,10),
49− (1969754174790470349,3),(35,68088438338633),(506710,3247689556438),
50− (11099382291,327739909),(105787303549,32824363),(210366111,14759049409),
51− (688893241579,3102676),(8490,70047474429581),(152085,29923000251880),
52− (5046974599257095,400),(4183167795,263434071),(10089728,502781960687),
53− (44831977765,4725378),(91,8978094664238578),(30990165721,44053350),
54− (1772377,149651820860),(243420621763408572,4),(32,5790357453815138),
55− (27980806337993771,5),(47696295759774,20848),(1745874142313778,1098),
56− (46869334770121,1203),(886995283,1564424789),(40679396544,76002479),
57− (1,672849481568486995),(337656187205,3157069),(816980552858963,6003),
58− (2271434085804831543,1),(0,1934521023868747186),(6266220038281,15825),
59− (4160,107115946987394),(524,246808621791561),(0,1952519482439636339),
60− (128,2865935904539691),(1044,3211982069426297),(16000511542473,88922),
61− (1253596745404082,2226),(27041,56836278958002),(23201,49247489754471),
62− (175906590497,21252392),(185163584757182295,24),(34742225226802197,150),
63− (2363228,250824838408),(216327527109550,45),(24,81574076994520675),
64− (28559899906542,15356),(10890139774837133,511),(2293,707179303654492),
65− (2749366833,40703233),(0,4498229704622845986),(439,4962056468281937),
66− (662,1453820621089921),(16336770612459631,220),(24282989393,74239137),
67− (2724564648490195,3),(743672760,124992589),(4528103,704330948891),
68− (6050483122491561,250),(13322953,13594265152),(181794,22268101450214),
69− (25957941712,75384092),(43352,7322262295009),(32838,52609059549923),
70− (33003585202001564,2),(103019,68430142267402),(129918230800,8742978),
71− (0,2114347379589080688),(2548,905723041545274),(222745067962838382,0),
72− (1671683850790425181,1),(455,4836932776795684),(794227702827214,6620),
73− (212534135175874,1365),(96432431858,29784975),(466626763743380,3484),
74− (29793949,53041519613),(8359,309952753409844),(3908960585331901,26),
75− (45185288970365760,114),(10131829775,68110174),(58039242399640479,83),
76− (628092278238719399,6),(1,196469106875361889),(302336625,16347502444),
77− (148,3748088684181047),(1,1649096568849015456),(1019866864,2349753026),
78− (8211344830,569363306),(65647579546873,34753),(2340190,1692053129069),
79− (64263301,30758930355),(48681618072372209,110),(7074794736,47640197),
80− (249634721521,7991792),(1162917363807215,232),(7446433349,420634045),
81− (63398619383,60709817),(51359004508011,14200),(131788797028647,7072),
82− (52079887791430043,7),(7,136277667582599838),(28582879735696,50327),
83− (1404582800566278,833),(469164435,15017166943),(99567079957578263,49),
84− (1015285971,3625801566),(321504843,4104079293),(5196954,464515406632),
85− (114246832260876,7468),(8149664437,487119673),(12265299,378168974869),
86− (37711995764,30766513),(3971137243,710996152),(483120070302,603162),
87− (103009942,61645547145),(8476344625340,6987),(547948761229739,1446),
88− (42234,18624767306301),(13486714173011,58948),(4,198309153268019840),
89− (9913176974,325539248),(28246225540203,116822),(2882463945582154,18),
90− (959,25504987505398),(3,1504372236378217710),(13505229956793,374987),
91− (751661959,457611342),(27375926,36219151769),(482168869,5301952074),
92− (1,1577425863241520640),(714116235611821,1164),(904492524250310488,0),
93− (5983514941763398,68),(10759472423,23540686),(72539568471529,34919),
94− (4,176090672310337473),(938702842110356453,1),(673652445,3335287382),
95− (3111998893666122,917),(1568013,3168419765469)]
96−
97−testVector32 :: U.Vector (Int32,Int32)
98−testVector32 = U.fromList [
99− (39242,410),(0,100077553),(2206,9538),(509400240,1),(38048,6368),
100− (1789,651480),(2399,157032),(701,170017),(5241456,14),(11212,70449),
101− (1,227804876),(749687254,1),(74559,2954),(1158,147957),(410604456,1),
102− (170851,1561),(92643422,1),(6192,180509),(7,24202210),(3440,241481),
103− (5753677,5),(294327,1622),(252,4454673),(127684121,11),(28315800,30),
104− (340370905,0),(1,667887987),(592782090,1),(49023,27641),(750,290387),
105− (72886,3847),(0,301047933),(3050276,473),(1,788366142),(59457,15813),
106− (637726933,1),(1135,344317),(853616,264),(696816,493),(7038,12046),
107− (125219574,4),(803694088,1),(107081726,1),(39294,21699),(16361,38191),
108− (132561123,12),(1760,23499),(847543,484),(175687349,1),(2963,252678),
109− (6248,224553),(27596,4606),(5422922,121),(1542,485890),(131,583035),
110− (59096,4925),(3637115,132),(0,947225435),(86854,6794),(2984745,339),
111− (760129569,1),(1,68260595),(380835652,2),(430575,2579),(54514,7211),
112− (15550606,3),(9,27367402),(3007053,207),(7060988,60),(28560,27130),
113− (1355,21087),(10880,53059),(14563646,4),(461886361,1),(2,169260724),
114− (241454126,2),(406797,1),(61631630,16),(44473,5943),(63869104,12),
115− (950300,1528),(2113,62333),(120817,9358),(100261456,1),(426764723,1),
116− (119,12723684),(3,53358711),(4448071,18),(1,230278091),(238,232102),
117− (8,57316440),(42437979,10),(6769,19555),(48590,22006),(11500585,79),
118− (2808,97638),(42,26952545),(11,32104194),(23954638,1),(785427272,0),
119− (513,81379),(31333960,37),(897772,1009),(4,25679692),(103027993,12),
120− (104972702,11),(546,443401),(7,65137092),(88574269,3),(872139069,0),
121− (2,97417121),(378802603,0),(141071401,4),(22613,10575),(2191743,118),
122− (470,116119),(7062,38166),(231056,1847),(43901963,9),(2400,70640),
123− (63553,1555),(34,11249573),(815174,1820),(997894011,0),(98881794,2),
124− (5448,43132),(27956,9),(904926,1357),(112608626,3),(124,613021),
125− (282086,1966),(99,10656881),(113799,1501),(433318,2085),(442,948171),
126− (165380,1043),(28,14372905),(14880,50462),(2386,219918),(229,1797565),
127− (1174961,298),(3925,41833),(3903515,299),(15690452,111),(360860521,3),
128− (7440846,81),(2541026,507),(0,492448477),(6869,82469),(245,8322939),
129− (3503496,253),(123495298,0),(150963,2299),(33,4408482),(1,200911107),
130− (305,252121),(13,123369189),(215846,8181),(2440,65387),(776764401,1),
131− (1241172,434),(8,15493155),(81953961,6),(17884993,5),(26,6893822),
132− (0,502035190),(1,582451018),(2,514870139),(227,3625619),(49,12720258),
133− (1456769,207),(94797661,10),(234407,893),(26843,5783),(15688,24547),
134− (4091,86268),(4339448,151),(21360,6294),(397046497,2),(1227,205936),
135− (9966,21959),(160046791,1),(0,159992224),(27,24974797),(19177,29334),
136− (4136148,42),(21179785,53),(61256583,31),(385,344176),(7,11934915),
137− (1,18992566),(3488065,5),(768021,224),(36288474,7),(8624,117561),
138− (8,20341439),(5903,261475),(561,1007618),(1738,392327),(633049,1708)]
benchmarks/haskell/Benchmarks/Replace.hsdeleted−43
@@ -1,43 +0,0 @@
1−{-# LANGUAGE BangPatterns #-}
2−-- | Replace a string by another string
3−--
4−-- Tested in this benchmark:
5−--
6−-- * Search and replace of a pattern in a text
7−--
8−module Benchmarks.Replace
9− ( benchmark
10− ) where
11−
12−import Criterion (Benchmark, bgroup, bench, nf)
13−import qualified Data.ByteString.Char8 as B
14−import qualified Data.ByteString.Lazy as BL
15−import qualified Data.ByteString.Lazy.Search as BL
16−import qualified Data.ByteString.Search as B
17−import qualified Data.Text as T
18−import qualified Data.Text.Encoding as T
19−import qualified Data.Text.Lazy as TL
20−import qualified Data.Text.Lazy.Encoding as TL
21−import qualified Data.Text.Lazy.IO as TL
22−
23−benchmark :: FilePath -> String -> String -> IO Benchmark
24−benchmark fp pat sub = do
25− tl <- TL.readFile fp
26− bl <- BL.readFile fp
27− let !t = TL.toStrict tl
28− !b = T.encodeUtf8 t
29− return $ bgroup "Replace" [
30− bench "Text" $ nf (T.length . T.replace tpat tsub) t
31− , bench "ByteString" $ nf (BL.length . B.replace bpat bsub) b
32− , bench "LazyText" $ nf (TL.length . TL.replace tlpat tlsub) tl
33− , bench "LazyByteString" $ nf (BL.length . BL.replace blpat blsub) bl
34− ]
35− where
36− tpat = T.pack pat
37− tsub = T.pack sub
38− tlpat = TL.pack pat
39− tlsub = TL.pack sub
40− bpat = T.encodeUtf8 tpat
41− bsub = T.encodeUtf8 tsub
42− blpat = B.concat $ BL.toChunks $ TL.encodeUtf8 tlpat
43− blsub = B.concat $ BL.toChunks $ TL.encodeUtf8 tlsub
benchmarks/haskell/Benchmarks/Stream.hsdeleted−104
@@ -1,104 +0,0 @@
1−-- | This module contains a number of benchmarks for the different streaming
2−-- functions
3−--
4−-- Tested in this benchmark:
5−--
6−-- * Most streaming functions
7−--
8−{-# LANGUAGE BangPatterns #-}
9−{-# OPTIONS_GHC -fno-warn-orphans #-}
10−module Benchmarks.Stream
11− ( benchmark
12− ) where
13−
14−import Control.DeepSeq (NFData (..))
15−import Criterion (Benchmark, bgroup, bench, nf)
16−import Data.Text.Internal.Fusion.Types (Step (..), Stream (..))
17−import qualified Data.Text.Encoding as T
18−import qualified Data.Text.Encoding.Error as E
19−import qualified Data.Text.Internal.Encoding.Fusion as T
20−import qualified Data.Text.Internal.Encoding.Fusion.Common as F
21−import qualified Data.Text.Internal.Fusion as F
22−import qualified Data.Text.IO as T
23−import qualified Data.Text.Lazy.Encoding as TL
24−import qualified Data.Text.Internal.Lazy.Encoding.Fusion as TL
25−import qualified Data.Text.Internal.Lazy.Fusion as FL
26−import qualified Data.Text.Lazy.IO as TL
27−
28−instance NFData a => NFData (Stream a) where
29− -- Currently, this implementation does not force evaluation of the size hint
30− rnf (Stream next s0 _) = go s0
31− where
32− go !s = case next s of
33− Done -> ()
34− Skip s' -> go s'
35− Yield x s' -> rnf x `seq` go s'
36−
37−benchmark :: FilePath -> IO Benchmark
38−benchmark fp = do
39− -- Different formats
40− t <- T.readFile fp
41− let !utf8 = T.encodeUtf8 t
42− !utf16le = T.encodeUtf16LE t
43− !utf16be = T.encodeUtf16BE t
44− !utf32le = T.encodeUtf32LE t
45− !utf32be = T.encodeUtf32BE t
46−
47− -- Once again for the lazy variants
48− tl <- TL.readFile fp
49− let !utf8L = TL.encodeUtf8 tl
50− !utf16leL = TL.encodeUtf16LE tl
51− !utf16beL = TL.encodeUtf16BE tl
52− !utf32leL = TL.encodeUtf32LE tl
53− !utf32beL = TL.encodeUtf32BE tl
54−
55− -- For the functions which operate on streams
56− let !s = F.stream t
57−
58− return $ bgroup "Stream"
59−
60− -- Fusion
61− [ bgroup "stream" $
62− [ bench "Text" $ nf F.stream t
63− , bench "LazyText" $ nf FL.stream tl
64− ]
65− -- must perform exactly the same as stream above due to
66− -- stream/unstream (i.e. stream after unstream) fusion
67− , bgroup "stream-fusion" $
68− [ bench "Text" $ nf (F.stream . F.unstream . F.stream) t
69− , bench "LazyText" $ nf (FL.stream . FL.unstream . FL.stream) tl
70− ]
71− -- measure the overhead of unstream after stream
72− , bgroup "stream-unstream" $
73− [ bench "Text" $ nf (F.unstream . F.stream) t
74− , bench "LazyText" $ nf (FL.unstream . FL.stream) tl
75− ]
76−
77− -- Encoding.Fusion
78− , bgroup "streamUtf8"
79− [ bench "Text" $ nf (T.streamUtf8 E.lenientDecode) utf8
80− , bench "LazyText" $ nf (TL.streamUtf8 E.lenientDecode) utf8L
81− ]
82− , bgroup "streamUtf16LE"
83− [ bench "Text" $ nf (T.streamUtf16LE E.lenientDecode) utf16le
84− , bench "LazyText" $ nf (TL.streamUtf16LE E.lenientDecode) utf16leL
85− ]
86− , bgroup "streamUtf16BE"
87− [ bench "Text" $ nf (T.streamUtf16BE E.lenientDecode) utf16be
88− , bench "LazyText" $ nf (TL.streamUtf16BE E.lenientDecode) utf16beL
89− ]
90− , bgroup "streamUtf32LE"
91− [ bench "Text" $ nf (T.streamUtf32LE E.lenientDecode) utf32le
92− , bench "LazyText" $ nf (TL.streamUtf32LE E.lenientDecode) utf32leL
93− ]
94− , bgroup "streamUtf32BE"
95− [ bench "Text" $ nf (T.streamUtf32BE E.lenientDecode) utf32be
96− , bench "LazyText" $ nf (TL.streamUtf32BE E.lenientDecode) utf32beL
97− ]
98−
99− -- Encoding.Fusion.Common
100− , bench "restreamUtf16LE" $ nf F.restreamUtf16LE s
101− , bench "restreamUtf16BE" $ nf F.restreamUtf16BE s
102− , bench "restreamUtf32LE" $ nf F.restreamUtf32LE s
103− , bench "restreamUtf32BE" $ nf F.restreamUtf32BE s
104− ]
benchmarks/haskell/Multilang.hsdeleted−32
@@ -1,32 +0,0 @@
1−{-# LANGUAGE BangPatterns, OverloadedStrings, RankNTypes #-}
2−
3−module Main (
4− main
5− ) where
6−
7−import Control.Monad (forM_)
8−import qualified Data.ByteString as B
9−import qualified Data.Text as Text
10−import Data.Text.Encoding (decodeUtf8)
11−import Data.Text (Text)
12−import System.IO (hFlush, stdout)
13−import Timer (timer)
14−
15−type BM = Text -> ()
16−
17−bm :: forall a. (Text -> a) -> BM
18−bm f t = f t `seq` ()
19−
20−benchmarks :: [(String, Text.Text -> ())]
21−benchmarks = [
22− ("find_first", bm $ Text.isInfixOf "en:Benin")
23− , ("find_index", bm $ Text.findIndex (=='c'))
24− ]
25−
26−main :: IO ()
27−main = do
28− !contents <- decodeUtf8 `fmap` B.readFile "../tests/text-test-data/yiwiki.xml"
29− forM_ benchmarks $ \(name, bmark) -> do
30− putStr $ name ++ " "
31− hFlush stdout
32− putStrLn =<< (timer 100 contents bmark)
benchmarks/haskell/Timer.hsdeleted−30
@@ -1,30 +0,0 @@
1−{-# LANGUAGE BangPatterns #-}
2−
3−module Timer (timer) where
4−
5−import Control.Exception (evaluate)
6−import Data.Time.Clock.POSIX (getPOSIXTime)
7−import GHC.Float (FFFormat(..), formatRealFloat)
8−
9−ickyRound :: Int -> Double -> String
10−ickyRound k = formatRealFloat FFFixed (Just k)
11−
12−timer :: Int -> a -> (a -> b) -> IO String
13−timer count a0 f = do
14− let loop !k !fastest
15− | k <= 0 = return fastest
16− | otherwise = do
17− start <- getPOSIXTime
18− let inner a i
19− | i <= 0 = return ()
20− | otherwise = evaluate (f a) >> inner a (i-1)
21− inner a0 count
22− end <- getPOSIXTime
23− let elapsed = end - start
24− loop (k-1) (min fastest (elapsed / fromIntegral count))
25− t <- loop (3::Int) 1e300
26− let log10 x = log x / log 10
27− ft = realToFrac t
28− prec = round (log10 (fromIntegral count) - log10 ft)
29− return $! ickyRound prec ft
30−{-# NOINLINE timer #-}
benchmarks/python/multilang.pydeleted−50
@@ -1,50 +0,0 @@
1−#!/usr/bin/env python
2−
3−import math
4−import sys
5−import time
6−
7−def find_first():
8− cf = contents.find
9− return timer(lambda: cf("en:Benin"))
10−
11−def timer(f, count=100):
12− a = 1e300
13− def g():
14− return
15− for i in xrange(3):
16− start = time.time()
17− for j in xrange(count):
18− g()
19− a = min(a, (time.time() - start) / count)
20−
21− b = 1e300
22− for i in xrange(3):
23− start = time.time()
24− for j in xrange(count):
25− f()
26− b = min(b, (time.time() - start) / count)
27−
28− return round(b - a, int(round(math.log(count, 10) - math.log(b - a, 10))))
29−
30−contents = open('../../tests/text-test-data/yiwiki.xml', 'r').read()
31−contents = contents.decode('utf-8')
32−
33−benchmarks = (
34− find_first,
35− )
36−
37−to_run = sys.argv[1:]
38−bms = []
39−if to_run:
40− for r in to_run:
41− for b in benchmarks:
42− if b.__name__.startswith(r):
43− bms.append(b)
44−else:
45− bms = benchmarks
46−
47−for b in bms:
48− sys.stdout.write(b.__name__ + ' ')
49− sys.stdout.flush()
50− print b()
benchmarks/text-benchmarks.cabaldeleted−66
@@ -1,66 +0,0 @@
1−name: text-benchmarks
2−version: 0.0.0.0
3−synopsis: Benchmarks for the text package
4−description: Benchmarks for the text package
5−homepage: https://bitbucket.org/bos/text
6−license: BSD2
7−license-file: ../LICENSE
8−author: Jasper Van der Jeugt <jaspervdj@gmail.com>,
9− Bryan O'Sullivan <bos@serpentine.com>,
10− Tom Harper <rtomharper@googlemail.com>,
11− Duncan Coutts <duncan@haskell.org>
12−maintainer: jaspervdj@gmail.com
13−category: Text
14−build-type: Simple
15−
16−cabal-version: >=1.2
17−
18−flag bytestring-builder
19− description: Depend on the bytestring-builder package for backwards compatibility.
20− default: False
21− manual: False
22−
23−flag llvm
24− description: use LLVM
25− default: False
26− manual: True
27−
28−executable text-benchmarks
29− hs-source-dirs: haskell ..
30− c-sources: ../cbits/cbits.c
31− cbits/time_iconv.c
32− include-dirs: ../include
33− main-is: Benchmarks.hs
34− ghc-options: -Wall -O2 -rtsopts
35− if flag(llvm)
36− ghc-options: -fllvm
37− cpp-options: -DHAVE_DEEPSEQ -DINTEGER_GMP
38− build-depends: base == 4.*,
39− binary,
40− blaze-builder,
41− bytestring-lexing >= 0.5.0,
42− containers,
43− criterion >= 0.10.0.0,
44− deepseq,
45− directory,
46− filepath,
47− ghc-prim,
48− integer-gmp,
49− stringsearch,
50− utf8-string,
51− vector
52−
53− if flag(bytestring-builder)
54− build-depends: bytestring >= 0.9 && < 0.10.4,
55− bytestring-builder >= 0.10.4
56− else
57− build-depends: bytestring >= 0.10.4
58−
59−executable text-multilang
60− hs-source-dirs: haskell
61− main-is: Multilang.hs
62− ghc-options: -Wall -O2
63− build-depends: base == 4.*,
64− bytestring,
65− text,
66− time
cbits/cbits.c−298
@@ -1,15 +1,4 @@
1−/*
2− * Copyright (c) 2011 Bryan O'Sullivan <bos@serpentine.com>.
3− *
4− * Portions copyright (c) 2008-2010 Björn Höhrmann <bjoern@hoehrmann.de>.
5− *
6− * See http://bjoern.hoehrmann.de/utf-8/decoder/dfa/ for details.
7− */
8−
9#include <string.h>
1#include <string.h>
10−#include <stdint.h>
11−#include <stdio.h>
12−#include "text_cbits.h"
13
2
14void _hs_text_memcpy(void *dest, size_t doff, const void *src, size_t soff,
3void _hs_text_memcpy(void *dest, size_t doff, const void *src, size_t soff,
15 size_t n)
4 size_t n)
@@ -22,290 +11,3 @@ int _hs_text_memcmp(const void *a, size_t aoff, const void *b, size_t boff,
22{
11{
23 return memcmp(a + (aoff<<1), b + (boff<<1), n<<1);
12 return memcmp(a + (aoff<<1), b + (boff<<1), n<<1);
24}
13}
25−
26−#define UTF8_ACCEPT 0
27−#define UTF8_REJECT 12
28−
29−static const uint8_t utf8d[] = {
30− /*
31− * The first part of the table maps bytes to character classes that
32− * to reduce the size of the transition table and create bitmasks.
33− */
34− 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
35− 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
36− 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
37− 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
38− 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, 9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,
39− 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7, 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,
40− 8,8,2,2,2,2,2,2,2,2,2,2,2,2,2,2, 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,
41− 10,3,3,3,3,3,3,3,3,3,3,3,3,4,3,3, 11,6,6,6,5,8,8,8,8,8,8,8,8,8,8,8,
42−
43− /*
44− * The second part is a transition table that maps a combination of
45− * a state of the automaton and a character class to a state.
46− */
47− 0,12,24,36,60,96,84,12,12,12,48,72, 12,12,12,12,12,12,12,12,12,12,12,12,
48− 12, 0,12,12,12,12,12, 0,12, 0,12,12, 12,24,12,12,12,12,12,24,12,24,12,12,
49− 12,12,12,12,12,12,12,24,12,12,12,12, 12,24,12,12,12,12,12,12,12,24,12,12,
50− 12,12,12,12,12,12,12,36,12,36,12,12, 12,36,12,12,12,12,12,36,12,36,12,12,
51− 12,36,12,12,12,12,12,12,12,12,12,12,
52−};
53−
54−static inline uint32_t
55−decode(uint32_t *state, uint32_t* codep, uint32_t byte) {
56− uint32_t type = utf8d[byte];
57−
58− *codep = (*state != UTF8_ACCEPT) ?
59− (byte & 0x3fu) | (*codep << 6) :
60− (0xff >> type) & (byte);
61−
62− return *state = utf8d[256 + *state + type];
63−}
64−
65−/*
66− * The ISO 8859-1 (aka latin-1) code points correspond exactly to the first 256 unicode
67− * code-points, therefore we can trivially convert from a latin-1 encoded bytestring to
68− * an UTF16 array
69− */
70−void
71−_hs_text_decode_latin1(uint16_t *dest, const uint8_t *src,
72− const uint8_t *srcend)
73−{
74− const uint8_t *p = src;
75−
76−#if defined(__i386__) || defined(__x86_64__)
77− /* This optimization works on a little-endian systems by using
78− (aligned) 32-bit loads instead of 8-bit loads
79− */
80−
81− /* consume unaligned prefix */
82− while (p != srcend && (uintptr_t)p & 0x3)
83− *dest++ = *p++;
84−
85− /* iterate over 32-bit aligned loads */
86− while (p < srcend - 3) {
87− const uint32_t w = *((const uint32_t *)p);
88−
89− *dest++ = w & 0xff;
90− *dest++ = (w >> 8) & 0xff;
91− *dest++ = (w >> 16) & 0xff;
92− *dest++ = (w >> 24) & 0xff;
93−
94− p += 4;
95− }
96−#endif
97−
98− /* handle unaligned suffix */
99− while (p != srcend)
100− *dest++ = *p++;
101−}
102−
103−/*
104− * A best-effort decoder. Runs until it hits either end of input or
105− * the start of an invalid byte sequence.
106− *
107− * At exit, we update *destoff with the next offset to write to, *src
108− * with the next source location past the last one successfully
109− * decoded, and return the next source location to read from.
110− *
111− * Moreover, we expose the internal decoder state (state0 and
112− * codepoint0), allowing one to restart the decoder after it
113− * terminates (say, due to a partial codepoint).
114− *
115− * In particular, there are a few possible outcomes,
116− *
117− * 1) We decoded the buffer entirely:
118− * In this case we return srcend
119− * state0 == UTF8_ACCEPT
120− *
121− * 2) We met an invalid encoding
122− * In this case we return the address of the first invalid byte
123− * state0 == UTF8_REJECT
124− *
125− * 3) We reached the end of the buffer while decoding a codepoint
126− * In this case we return a pointer to the first byte of the partial codepoint
127− * state0 != UTF8_ACCEPT, UTF8_REJECT
128− *
129− */
130−#if defined(__GNUC__) || defined(__clang__)
131−static inline uint8_t const *
132−_hs_text_decode_utf8_int(uint16_t *const dest, size_t *destoff,
133− const uint8_t **src, const uint8_t *srcend,
134− uint32_t *codepoint0, uint32_t *state0)
135− __attribute((always_inline));
136−#endif
137−
138−static inline uint8_t const *
139−_hs_text_decode_utf8_int(uint16_t *const dest, size_t *destoff,
140− const uint8_t **src, const uint8_t *srcend,
141− uint32_t *codepoint0, uint32_t *state0)
142−{
143− uint16_t *d = dest + *destoff;
144− const uint8_t *s = *src, *last = *src;
145− uint32_t state = *state0;
146− uint32_t codepoint = *codepoint0;
147−
148− while (s < srcend) {
149−#if defined(__i386__) || defined(__x86_64__)
150− /*
151− * This code will only work on a little-endian system that
152− * supports unaligned loads.
153− *
154− * It gives a substantial speed win on data that is purely or
155− * partly ASCII (e.g. HTML), at only a slight cost on purely
156− * non-ASCII text.
157− */
158−
159− if (state == UTF8_ACCEPT) {
160− while (s < srcend - 4) {
161− codepoint = *((uint32_t *) s);
162− if ((codepoint & 0x80808080) != 0)
163− break;
164− s += 4;
165−
166− /*
167− * Tried 32-bit stores here, but the extra bit-twiddling
168− * slowed the code down.
169− */
170−
171− *d++ = (uint16_t) (codepoint & 0xff);
172− *d++ = (uint16_t) ((codepoint >> 8) & 0xff);
173− *d++ = (uint16_t) ((codepoint >> 16) & 0xff);
174− *d++ = (uint16_t) ((codepoint >> 24) & 0xff);
175− }
176− last = s;
177− }
178−#endif
179−
180− if (decode(&state, &codepoint, *s++) != UTF8_ACCEPT) {
181− if (state != UTF8_REJECT)
182− continue;
183− break;
184− }
185−
186− if (codepoint <= 0xffff)
187− *d++ = (uint16_t) codepoint;
188− else {
189− *d++ = (uint16_t) (0xD7C0 + (codepoint >> 10));
190− *d++ = (uint16_t) (0xDC00 + (codepoint & 0x3FF));
191− }
192− last = s;
193− }
194−
195− *destoff = d - dest;
196− *codepoint0 = codepoint;
197− *state0 = state;
198− *src = last;
199−
200− return s;
201−}
202−
203−uint8_t const *
204−_hs_text_decode_utf8_state(uint16_t *const dest, size_t *destoff,
205− const uint8_t **src,
206− const uint8_t *srcend,
207− uint32_t *codepoint0, uint32_t *state0)
208−{
209− uint8_t const *ret = _hs_text_decode_utf8_int(dest, destoff, src, srcend,
210− codepoint0, state0);
211− if (*state0 == UTF8_REJECT)
212− ret -=1;
213− return ret;
214−}
215−
216−/*
217− * Helper to decode buffer and discard final decoder state
218− */
219−const uint8_t *
220−_hs_text_decode_utf8(uint16_t *const dest, size_t *destoff,
221− const uint8_t *src, const uint8_t *const srcend)
222−{
223− uint32_t codepoint;
224− uint32_t state = UTF8_ACCEPT;
225− uint8_t const *ret = _hs_text_decode_utf8_int(dest, destoff, &src, srcend,
226− &codepoint, &state);
227− /* Back up if we have an incomplete or invalid encoding */
228− if (state != UTF8_ACCEPT)
229− ret -= 1;
230− return ret;
231−}
232−
233−void
234−_hs_text_encode_utf8(uint8_t **destp, const uint16_t *src, size_t srcoff,
235− size_t srclen)
236−{
237− const uint16_t *srcend;
238− uint8_t *dest = *destp;
239−
240− src += srcoff;
241− srcend = src + srclen;
242−
243− ascii:
244−#if defined(__x86_64__)
245− while (srcend - src >= 4) {
246− uint64_t w = *((uint64_t *) src);
247−
248− if (w & 0xFF80FF80FF80FF80ULL) {
249− if (!(w & 0x000000000000FF80ULL)) {
250− *dest++ = w & 0xFFFF;
251− src++;
252− if (!(w & 0x00000000FF800000ULL)) {
253− *dest++ = (w >> 16) & 0xFFFF;
254− src++;
255− if (!(w & 0x0000FF8000000000ULL)) {
256− *dest++ = (w >> 32) & 0xFFFF;
257− src++;
258− }
259− }
260− }
261− break;
262− }
263− *dest++ = w & 0xFFFF;
264− *dest++ = (w >> 16) & 0xFFFF;
265− *dest++ = (w >> 32) & 0xFFFF;
266− *dest++ = w >> 48;
267− src += 4;
268− }
269−#endif
270−
271−#if defined(__i386__)
272− while (srcend - src >= 2) {
273− uint32_t w = *((uint32_t *) src);
274−
275− if (w & 0xFF80FF80)
276− break;
277− *dest++ = w & 0xFFFF;
278− *dest++ = w >> 16;
279− src += 2;
280− }
281−#endif
282−
283− while (src < srcend) {
284− uint16_t w = *src++;
285−
286− if (w <= 0x7F) {
287− *dest++ = w;
288− /* An ASCII byte is likely to begin a run of ASCII bytes.
289− Falling back into the fast path really helps performance. */
290− goto ascii;
291− }
292− else if (w <= 0x7FF) {
293− *dest++ = (w >> 6) | 0xC0;
294− *dest++ = (w & 0x3f) | 0x80;
295− }
296− else if (w < 0xD800 || w > 0xDBFF) {
297− *dest++ = (w >> 12) | 0xE0;
298− *dest++ = ((w >> 6) & 0x3F) | 0x80;
299− *dest++ = (w & 0x3F) | 0x80;
300− } else {
301− uint32_t c = ((((uint32_t) w) - 0xD800) << 10) +
302− (((uint32_t) *src++) - 0xDC00) + 0x10000;
303− *dest++ = (c >> 18) | 0xF0;
304− *dest++ = ((c >> 12) & 0x3F) | 0x80;
305− *dest++ = ((c >> 6) & 0x3F) | 0x80;
306− *dest++ = (c & 0x3F) | 0x80;
307− }
308− }
309−
310− *destp = dest;
311−}
changelog.mddeleted−164
@@ -1,164 +0,0 @@
1−1.2.2.1
2−
3−* The switch to `integer-pure` in 1.2.2.0 was apparently mistaken.
4− The build flag has been renamed accordingly. Your army of diligent
5− maintainers apologizes for the churn.
6−
7−* Spec compliance: toCaseFold now follows the Unicode 8.0 spec
8− (updated from 7.0)
9−
10−* An STG lint error has been fixed
11−
12−1.2.2.0
13−
14−* The `integer-simple` package, upon which this package optionally
15− depended, has been replaced with `integer-pure`. The build flag has
16− been renamed accordingly.
17−
18−* Bug fix: For the `Binary` instance, If UTF-8 decoding fails during a
19− `get`, the error is propagated via `fail` instead of an uncatchable
20− crash.
21−
22−* New function: `takeWhileEnd`
23−
24−* New instances for the `Text` types:
25− * if `base` >= 4.7: `PrintfArg`
26− * if `base` >= 4.9: `Semigroup`
27−
28−1.2.1.3
29−
30−* Bug fix: As it turns out, moving the literal rewrite rules to simplifier
31− phase 2 does not prevent competition with the `unpack` rule, which is
32− also active in this phase. Unfortunately this was hidden due to a silly
33− test environment mistake. Moving literal rules back to phase 1 finally
34− fixes GHC Trac #10528 correctly.
35−
36−1.2.1.2
37−
38−* Bug fix: Run literal rewrite rules in simplifier phase 2.
39− The behavior of the simplifier changed in GHC 7.10.2,
40− causing these rules to fail to fire, leading to poor code generation
41− and long compilation times. See
42− [GHC Trac #10528](https://ghc.haskell.org/trac/ghc/ticket/10528).
43−
44−1.2.1.1
45−
46−* Expose unpackCString#, which you should never use.
47−
48−1.2.1.0
49−
50−* Added Binary instances for both Text types. (If you have previously
51− been using the text-binary package to get a Binary instance, it is
52− now obsolete.)
53−
54−1.2.0.6
55−
56−* Fixed a space leak in UTF-8 decoding
57−
58−1.2.0.5
59−
60−* Feature parity: repeat, cycle, iterate are now implemented for lazy
61− Text, and the Data instance is more complete
62−
63−* Build speed: an inliner space explosion has been fixed with toCaseFold
64−
65−* Bug fix: encoding Int to a Builder would infinite-loop if the
66− integer-simple package was used
67−
68−* Deprecation: OnEncodeError and EncodeError are deprecated, as they
69− are never used
70−
71−* Internals: some types that are used internally in fusion-related
72− functions have moved around, been renamed, or been deleted (we don't
73− bump the major version if .Internal modules change)
74−
75−* Spec compliance: toCaseFold now follows the Unicode 7.0 spec
76− (updated from 6.3)
77−
78−1.2.0.4
79−
80−* Fixed an incompatibility with base < 4.5
81−
82−1.2.0.3
83−
84−* Update formatRealFloat to correspond to the definition in versions
85− of base newer than 4.5 (https://github.com/bos/text/issues/105)
86−
87−1.2.0.2
88−
89−* Bumped lower bound on deepseq to 1.4 for compatibility with the
90− upcoming GHC 7.10
91−
92−1.2.0.1
93−
94−* Fixed a buffer overflow in rendering of large Integers
95− (https://github.com/bos/text/issues/99)
96−
97−1.2.0.0
98−
99−* Fixed an integer overflow in the replace function
100− (https://github.com/bos/text/issues/81)
101−
102−* Fixed a hang in lazy decodeUtf8With
103− (https://github.com/bos/text/issues/87)
104−
105−* Reduced codegen bloat caused by use of empty and single-character
106− literals
107−
108−* Added an instance of IsList for GHC 7.8 and above
109−
110−1.1.1.0
111−
112−* The Data.Data instance now allows gunfold to work, via a virtual
113− pack constructor
114−
115−* dropEnd, takeEnd: new functions
116−
117−* Comparing the length of a Text against a number can now
118− short-circuit in more cases
119−
120−1.1.0.1
121−
122−* streamDecodeUtf8: fixed gh-70, did not return all unconsumed bytes
123− in single-byte chunks
124−
125−1.1.0.0
126−
127−* encodeUtf8: Performance is improved by up to 4x.
128−
129−* encodeUtf8Builder, encodeUtf8BuilderEscaped: new functions,
130− available only if bytestring >= 0.10.4.0 is installed, that allow
131− very fast and flexible encoding of a Text value to a bytestring
132− Builder.
133−
134− As an example of the performance gain to be had, the
135− encodeUtf8BuilderEscaped function helps to double the speed of JSON
136− encoding in the latest version of aeson! (Note: if all you need is a
137− plain ByteString, encodeUtf8 is still the faster way to go.)
138−
139−* All of the internal module hierarchy is now publicly exposed. If a
140− module is in the .Internal hierarchy, or is documented as internal,
141− use at your own risk - there are no API stability guarantees for
142− internal modules!
143−
144−1.0.0.1
145−
146−* decodeUtf8: Fixed a regression that caused us to incorrectly
147− identify truncated UTF-8 as valid (gh-61)
148−
149−1.0.0.0
150−
151−* Added support for Unicode 6.3.0 to case conversion functions
152−
153−* New function toTitle converts words in a string to title case
154−
155−* New functions peekCStringLen and withCStringLen simplify
156− interoperability with C functionns
157−
158−* Added support for decoding UTF-8 in stream-friendly fashion
159−
160−* Fixed a bug in mapAccumL
161−
162−* Added trusted Haskell support
163−
164−* Removed support for GHC 6.10 (released in 2008) and older
include/text_cbits.hdeleted−11
@@ -1,11 +0,0 @@
1−/*
2− * Copyright (c) 2013 Bryan O'Sullivan <bos@serpentine.com>.
3− */
4−
5−#ifndef _text_cbits_h
6−#define _text_cbits_h
7−
8−#define UTF8_ACCEPT 0
9−#define UTF8_REJECT 12
10−
11−#endif
scripts/Arsec.hs+9−4
@@ -1,7 +1,6 @@
1module Arsec
1module Arsec
2 (
2 (
3− Comment
4− , comment
3+ comment
5 , semi
4 , semi
6 , showC
5 , showC
7 , unichar
6 , unichar
@@ -24,7 +23,13 @@ import Text.ParserCombinators.Parsec.Combinator hiding (optional)
24import Text.ParserCombinators.Parsec.Error
23import Text.ParserCombinators.Parsec.Error
25import Text.ParserCombinators.Parsec.Prim hiding ((<|>), many)
24import Text.ParserCombinators.Parsec.Prim hiding ((<|>), many)
26
25
27−type Comment = String
26+instance Applicative (GenParser s a) where
27+ pure = return
28+ (<*>) = ap
29+
30+instance Alternative (GenParser s a) where
31+ empty = mzero
32+ (<|>) = mplus
28
33
29unichar :: Parser Char
34unichar :: Parser Char
30unichar = chr . fst . head . readHex <$> many1 hexDigit
35unichar = chr . fst . head . readHex <$> many1 hexDigit
@@ -35,7 +40,7 @@ unichars = manyTill (unichar <* spaces) semi
35semi :: Parser ()
40semi :: Parser ()
36semi = char ';' *> spaces *> pure ()
41semi = char ';' *> spaces *> pure ()
37
42
38−comment :: Parser Comment
43+comment :: Parser String
39comment = (char '#' *> manyTill anyToken (char '\n')) <|> string "\n"
44comment = (char '#' *> manyTill anyToken (char '\n')) <|> string "\n"
40
45
41showC :: Char -> String
46showC :: Char -> String
scripts/CaseFolding.hs+7−11
@@ -4,8 +4,7 @@
4
4
5module CaseFolding
5module CaseFolding
6 (
6 (
7− CaseFolding(..)
8− , Fold(..)
7+ Fold(..)
9 , parseCF
8 , parseCF
10 , mapCF
9 , mapCF
11 ) where
10 ) where
@@ -19,25 +18,22 @@ data Fold = Fold {
19 , name :: String
18 , name :: String
20 } deriving (Eq, Ord, Show)
19 } deriving (Eq, Ord, Show)
21
20
22−data CaseFolding = CF { cfComments :: [Comment], cfFolding :: [Fold] }
21+entries :: Parser [Fold]
23− deriving (Show)
24−
25−entries :: Parser CaseFolding
26−entries = CF <$> many comment <*> many (entry <* many comment)
22+entries = many comment *> many (entry <* many comment)
27 where
23 where
28 entry = Fold <$> unichar <* semi
24 entry = Fold <$> unichar <* semi
29 <*> oneOf "CFST" <* semi
25 <*> oneOf "CFST" <* semi
30 <*> unichars
26 <*> unichars
31 <*> (string "# " *> manyTill anyToken (char '\n'))
27 <*> (string "# " *> manyTill anyToken (char '\n'))
32
28
33−parseCF :: FilePath -> IO (Either ParseError CaseFolding)
29+parseCF :: FilePath -> IO (Either ParseError [Fold])
34parseCF name = parse entries name <$> readFile name
30parseCF name = parse entries name <$> readFile name
35
31
36−mapCF :: CaseFolding -> [String]
32+mapCF :: [Fold] -> [String]
37−mapCF (CF _ ms) = typ ++ (map nice . filter p $ ms) ++ [last]
33+mapCF ms = typ ++ (map nice . filter p $ ms) ++ [last]
38 where
34 where
39 typ = ["foldMapping :: forall s. Char -> s -> Step (CC s) Char"
35 typ = ["foldMapping :: forall s. Char -> s -> Step (CC s) Char"
40− ,"{-# NOINLINE foldMapping #-}"]
36+ ,"{-# INLINE foldMapping #-}"]
41 last = "foldMapping c s = Yield (toLower c) (CC s '\\0' '\\0')"
37 last = "foldMapping c s = Yield (toLower c) (CC s '\\0' '\\0')"
42 nice c = "-- " ++ name c ++ "\n" ++
38 nice c = "-- " ++ name c ++ "\n" ++
43 "foldMapping " ++ showC (code c) ++ " s = Yield " ++ x ++ " (CC s " ++ y ++ " " ++ z ++ ")"
39 "foldMapping " ++ showC (code c) ++ " s = Yield " ++ x ++ " (CC s " ++ y ++ " " ++ z ++ ")"
scripts/CaseMapping.hs+5−11
@@ -8,7 +8,7 @@ import SpecialCasing
8main = do
8main = do
9 args <- getArgs
9 args <- getArgs
10 let oname = case args of
10 let oname = case args of
11− [] -> "../Data/Text/Internal/Fusion/CaseMapping.hs"
11+ [] -> "../Data/Text/Fusion/CaseMapping.hs"
12 [o] -> o
12 [o] -> o
13 psc <- parseSC "SpecialCasing.txt"
13 psc <- parseSC "SpecialCasing.txt"
14 pcf <- parseCF "CaseFolding.txt"
14 pcf <- parseCF "CaseFolding.txt"
@@ -19,20 +19,14 @@ main = do
19 Left err -> print err >> return undefined
19 Left err -> print err >> return undefined
20 Right ms -> return ms
20 Right ms -> return ms
21 h <- openFile oname WriteMode
21 h <- openFile oname WriteMode
22− let comments = map ("--" ++) $
23− take 2 (cfComments cfs) ++ take 2 (scComments scs)
24− mapM_ (hPutStrLn h) $
25− ["{-# LANGUAGE Rank2Types #-}"
22+ mapM_ (hPutStrLn h) ["{-# LANGUAGE Rank2Types #-}"
26 ,"-- AUTOMATICALLY GENERATED - DO NOT EDIT"
23 ,"-- AUTOMATICALLY GENERATED - DO NOT EDIT"
27− ,"-- Generated by scripts/CaseMapping.hs"] ++
24+ ,"-- Generated by scripts/SpecialCasing.hs"
28− comments ++
29− [""
30− ,"module Data.Text.Internal.Fusion.CaseMapping where"
25+ ,"module Data.Text.Fusion.CaseMapping where"
31 ,"import Data.Char"
26 ,"import Data.Char"
32− ,"import Data.Text.Internal.Fusion.Types"
27+ ,"import Data.Text.Fusion.Internal"
33 ,""]
28 ,""]
34 mapM_ (hPutStrLn h) (mapSC "upper" upper toUpper scs)
29 mapM_ (hPutStrLn h) (mapSC "upper" upper toUpper scs)
35 mapM_ (hPutStrLn h) (mapSC "lower" lower toLower scs)
30 mapM_ (hPutStrLn h) (mapSC "lower" lower toLower scs)
36− mapM_ (hPutStrLn h) (mapSC "title" title toTitle scs)
37 mapM_ (hPutStrLn h) (mapCF cfs)
31 mapM_ (hPutStrLn h) (mapCF cfs)
38 hClose h
32 hClose h
scripts/SpecialCasing.hs+7−13
@@ -4,17 +4,13 @@
4
4
5module SpecialCasing
5module SpecialCasing
6 (
6 (
7− SpecialCasing(..)
8− , Case(..)
7+ Case(..)
9 , parseSC
8 , parseSC
10 , mapSC
9 , mapSC
11 ) where
10 ) where
12
11
13import Arsec
12import Arsec
14
13
15−data SpecialCasing = SC { scComments :: [Comment], scCasing :: [Case] }
16− deriving (Show)
17−
18data Case = Case {
14data Case = Case {
19 code :: Char
15 code :: Char
20 , lower :: [Char]
16 , lower :: [Char]
@@ -24,8 +20,8 @@ data Case = Case {
24 , name :: String
20 , name :: String
25 } deriving (Eq, Ord, Show)
21 } deriving (Eq, Ord, Show)
26
22
27−entries :: Parser SpecialCasing
23+entries :: Parser [Case]
28−entries = SC <$> many comment <*> many (entry <* many comment)
24+entries = many comment *> many (entry <* many comment)
29 where
25 where
30 entry = Case <$> unichar <* semi
26 entry = Case <$> unichar <* semi
31 <*> unichars
27 <*> unichars
@@ -34,16 +30,14 @@ entries = SC <$> many comment <*> many (entry <* many comment)
34 <*> manyTill anyToken (string "# ")
30 <*> manyTill anyToken (string "# ")
35 <*> manyTill anyToken (char '\n')
31 <*> manyTill anyToken (char '\n')
36
32
37−parseSC :: FilePath -> IO (Either ParseError SpecialCasing)
33+parseSC :: FilePath -> IO (Either ParseError [Case])
38parseSC name = parse entries name <$> readFile name
34parseSC name = parse entries name <$> readFile name
39
35
40−mapSC :: String -> (Case -> String) -> (Char -> Char) -> SpecialCasing
36+mapSC :: String -> (Case -> String) -> (Char -> Char) -> [Case] -> [String]
41− -> [String]
42−mapSC which access twiddle (SC _ ms) =
37+mapSC which access twiddle ms = typ ++ (map nice . filter p $ ms) ++ [last]
43− typ ++ (map nice . filter p $ ms) ++ [last]
44 where
38 where
45 typ = [which ++ "Mapping :: forall s. Char -> s -> Step (CC s) Char"
39 typ = [which ++ "Mapping :: forall s. Char -> s -> Step (CC s) Char"
46− ,"{-# NOINLINE " ++ which ++ "Mapping #-}"]
40+ ,"{-# INLINE " ++ which ++ "Mapping #-}"]
47 last = which ++ "Mapping c s = Yield (to" ++ ucFirst which ++ " c) (CC s '\\0' '\\0')"
41 last = which ++ "Mapping c s = Yield (to" ++ ucFirst which ++ " c) (CC s '\\0' '\\0')"
48 nice c = "-- " ++ name c ++ "\n" ++
42 nice c = "-- " ++ name c ++ "\n" ++
49 which ++ "Mapping " ++ showC (code c) ++ " s = Yield " ++ x ++ " (CC s " ++ y ++ " " ++ z ++ ")"
43 which ++ "Mapping " ++ showC (code c) ++ " s = Yield " ++ x ++ " (CC s " ++ y ++ " " ++ z ++ ")"
tests-and-benchmarks.markdowndeleted−63
@@ -1,63 +0,0 @@
1−Tests and benchmarks
2−====================
3−
4−Prerequisites
5−-------------
6−
7−To run the tests and benchmarks, you will need the test data, which
8−you can clone from one of the following locations:
9−
10−* Mercurial master repository:
11− [bitbucket.org/bos/text-test-data](https://bitbucket.org/bos/text-test-data)
12−
13−* Git mirror repository:
14− [github.com/bos/text-test-data](https://github.com/bos/text-test-data)
15−
16−You should clone that repository into the `tests` subdirectory (your
17−clone must be named `text-test-data` locally), then run `make -C
18−tests/text-test-data` to uncompress the test files. Many tests and
19−benchmarks will fail if the test files are missing.
20−
21−Functional tests
22−----------------
23−
24−The functional tests are located in the `tests` subdirectory. An overview of
25−what's in that directory:
26−
27− Makefile Has targets for common tasks
28− Tests Source files of the testing code
29− scripts Various utility scripts
30− text-tests.cabal Cabal file that compiles all benchmarks
31−
32−The `text-tests.cabal` builds:
33−
34−- A copy of the text library, sharing the source code, but exposing all internal
35− modules, for testing purposes
36−- The different test suites
37−
38−To compile, run all tests, and generate a coverage report, simply use `make`.
39−
40−Benchmarks
41−----------
42−
43−The benchmarks are located in the `benchmarks` subdirectory. An overview of
44−what's in that directory:
45−
46− Makefile Has targets for common tasks
47− haskell Source files of the haskell benchmarks
48− python Python implementations of some benchmarks
49− ruby Ruby implementations of some benchmarks
50− text-benchmarks.cabal Cabal file which compiles all benchmarks
51−
52−To compile the benchmarks, navigate to the `benchmarks` subdirectory and run
53−`cabal configure && cabal build`. Then, you can run the benchmarks using:
54−
55− ./dist/build/text-benchmarks/text-benchmarks
56−
57−However, since there's quite a lot of benchmarks, you usually don't want to
58−run them all. Instead, use the `-l` flag to get a list of benchmarks:
59−
60− ./dist/build/text-benchmarks/text-benchmarks
61−
62−And run the ones you want to inspect. If you want to configure the benchmarks
63−further, the exact parameters can be changed in `Benchmarks.hs`.
tests/LiteralRuleTest.hsdeleted−21
@@ -1,21 +0,0 @@
1−{-# LANGUAGE OverloadedStrings #-}
2−
3−module LiteralRuleTest where
4−
5−import Data.Text (Text)
6−
7−-- This should produce 8 firings of the "TEXT literal" rule
8−strings :: [Text]
9−strings = [ "abstime", "aclitem", "bit", "bool", "box", "bpchar", "bytea", "char" ]
10−
11−-- This should produce 7 firings of the "TEXT literal UTF8" rule
12−utf8Strings :: [Text]
13−utf8Strings = [ "\0abstime", "\0aclitem", "\xfefe bit", "\0bool", "\0box", "\0bpchar", "\0bytea" ]
14−
15−-- This should produce 4 firings of the "TEXT empty literal" rule
16−empties :: [Text]
17−empties = [ "", "", "", "" ]
18−
19−-- This should produce 5 firings of the "TEXT empty literal" rule
20−--singletons :: [Text]
21−--singletons = [ "a", "b", "c", "d", "e" ]
tests/README.markdownnew file+57
@@ -0,0 +1,57 @@
1+Tests
2+=====
3+
4+This directory contains the tests for the Text library. To run these tests, you
5+will need the test data from:
6+
7+ http://projects.haskell.org/text/text-testdata.tar.bz2
8+
9+You should extract that archive to the same directory as this README (some tests
10+rely on this).
11+
12+There are two categories of tests: functional tests (including QuickCheck
13+properties), and benchmarks.
14+
15+Functional tests
16+----------------
17+
18+The functional tests are located in the `tests` subdirectory. An overview of
19+what's in that directory:
20+
21+ scripts Various utility scripts
22+ src Source files of the testing code
23+ text-tests.cabal Cabal file which compiles all benchmarks
24+ Makefile Has targets for common tasks
25+
26+The `text-tests.cabal` builds:
27+
28+- A copy of the text library, sharing the source code, but exposing all internal
29+ modules, for testing purposes
30+- The different test suites
31+
32+To compile, run all tests, and generate a coverage report, simply use `make`.
33+
34+Benchmarks
35+----------
36+
37+The benchmarks are located in the `benchmarks` subdirectory. An overview of
38+what's in that directory:
39+
40+ python Python implementations of some benchmarks
41+ ruby Ruby implementations of some benchmarks
42+ src Source files of the haskell benchmarks
43+ benchmarks.cabal Cabal file which compiles all benchmarks
44+ Makefile Has targets for common tasks
45+
46+To compile the benchmarks, navigate to the `benchmarks` subdirectory and run
47+`cabal configure && cabal build`. Then, you can run the benchmarks using:
48+
49+ ./dist/build/benchmarks/benchmarks
50+
51+However, since there quite a lot of benchmarks, you usually don't want to run
52+them all. Instead, use the `-l` flag to get a list of benchmarks:
53+
54+ ./dist/build/benchmarks/benchmarks
55+
56+And run the ones you want to inspect. If you want to configure the benchmarks
57+further, the exact parameters can be changed in `src/Data/Text/Benchmarks.hs`.
tests/Tests/Properties/Mul.hsdeleted−40
@@ -1,40 +0,0 @@
1−{-# LANGUAGE ScopedTypeVariables #-}
2−
3−module Tests.Properties.Mul (tests) where
4−
5−import Control.Applicative ((<$>), pure)
6−import Control.Exception as E (SomeException, catch, evaluate)
7−import Data.Int (Int32, Int64)
8−import Data.Text.Internal (mul, mul32, mul64)
9−import System.IO.Unsafe (unsafePerformIO)
10−import Test.Framework (Test)
11−import Test.Framework.Providers.QuickCheck2 (testProperty)
12−import Test.QuickCheck hiding ((.&.))
13−
14−mulRef :: (Integral a, Bounded a) => a -> a -> Maybe a
15−mulRef a b
16− | ab < bot || ab > top = Nothing
17− | otherwise = Just (fromIntegral ab)
18− where ab = fromIntegral a * fromIntegral b
19− top = fromIntegral (maxBound `asTypeOf` a) :: Integer
20− bot = fromIntegral (minBound `asTypeOf` a) :: Integer
21−
22−eval :: (a -> b -> c) -> a -> b -> Maybe c
23−eval f a b = unsafePerformIO $
24− (Just <$> evaluate (f a b)) `E.catch` (\(_::SomeException) -> pure Nothing)
25−
26−t_mul32 :: Int32 -> Int32 -> Property
27−t_mul32 a b = mulRef a b === eval mul32 a b
28−
29−t_mul64 :: Int64 -> Int64 -> Property
30−t_mul64 a b = mulRef a b === eval mul64 a b
31−
32−t_mul :: Int -> Int -> Property
33−t_mul a b = mulRef a b === eval mul a b
34−
35−tests :: [Test]
36−tests = [
37− testProperty "t_mul" t_mul
38− , testProperty "t_mul32" t_mul32
39− , testProperty "t_mul64" t_mul64
40− ]
benchmarks/.gitignore → tests/benchmarks/.gitignorerenamed

The content is the same.

benchmarks/Setup.hs → tests/benchmarks/Setup.hsrenamed

The content is the same.

benchmarks/python/.gitignore → tests/benchmarks/python/.gitignorerenamed

The content is the same.

benchmarks/python/cut.py → tests/benchmarks/python/cut.pyrenamed

The content is the same.

benchmarks/python/sort.py → tests/benchmarks/python/sort.pyrenamed

The content is the same.

benchmarks/python/strip_tags.py → tests/benchmarks/python/strip_tags.pyrenamed

The content is the same.

benchmarks/python/utils.py → tests/benchmarks/python/utils.pyrenamed

The content is the same.

benchmarks/ruby/cut.rb → tests/benchmarks/ruby/cut.rbrenamed

The content is the same.

benchmarks/ruby/fold.rb → tests/benchmarks/ruby/fold.rbrenamed

The content is the same.

benchmarks/ruby/sort.rb → tests/benchmarks/ruby/sort.rbrenamed

The content is the same.

benchmarks/ruby/strip_tags.rb → tests/benchmarks/ruby/strip_tags.rbrenamed

The content is the same.

benchmarks/ruby/utils.rb → tests/benchmarks/ruby/utils.rbrenamed

The content is the same.

tests/benchmarks/src/Data/Text/Benchmarks.hsnew file+67
@@ -0,0 +1,67 @@
1+-- | Main module to run the micro benchmarks
2+--
3+{-# LANGUAGE OverloadedStrings #-}
4+module Main
5+ ( main
6+ ) where
7+
8+import Criterion.Main (Benchmark, defaultMain, bgroup)
9+import System.FilePath ((</>))
10+import System.IO (IOMode (WriteMode), openFile, hSetEncoding, utf8)
11+
12+import qualified Data.Text.Benchmarks.Builder as Builder
13+import qualified Data.Text.Benchmarks.DecodeUtf8 as DecodeUtf8
14+import qualified Data.Text.Benchmarks.EncodeUtf8 as EncodeUtf8
15+import qualified Data.Text.Benchmarks.Equality as Equality
16+import qualified Data.Text.Benchmarks.FileRead as FileRead
17+import qualified Data.Text.Benchmarks.FoldLines as FoldLines
18+import qualified Data.Text.Benchmarks.Pure as Pure
19+import qualified Data.Text.Benchmarks.ReadNumbers as ReadNumbers
20+import qualified Data.Text.Benchmarks.Replace as Replace
21+import qualified Data.Text.Benchmarks.Search as Search
22+import qualified Data.Text.Benchmarks.WordFrequencies as WordFrequencies
23+
24+import qualified Data.Text.Benchmarks.Programs.BigTable as Programs.BigTable
25+import qualified Data.Text.Benchmarks.Programs.Cut as Programs.Cut
26+import qualified Data.Text.Benchmarks.Programs.Fold as Programs.Fold
27+import qualified Data.Text.Benchmarks.Programs.Sort as Programs.Sort
28+import qualified Data.Text.Benchmarks.Programs.StripTags as Programs.StripTags
29+import qualified Data.Text.Benchmarks.Programs.Throughput as Programs.Throughput
30+
31+main :: IO ()
32+main = benchmarks >>= defaultMain
33+
34+benchmarks :: IO [Benchmark]
35+benchmarks = do
36+ sink <- openFile "/dev/null" WriteMode
37+ hSetEncoding sink utf8
38+
39+ -- Traditional benchmarks
40+ bs <- sequence
41+ [ Builder.benchmark
42+ , DecodeUtf8.benchmark (tf "russian.txt")
43+ , EncodeUtf8.benchmark "επανάληψη 竺法蘭共譯"
44+ , Equality.benchmark (tf "japanese.txt")
45+ , FileRead.benchmark (tf "russian.txt")
46+ , FoldLines.benchmark (tf "russian.txt")
47+ , Pure.benchmark (tf "japanese.txt")
48+ , ReadNumbers.benchmark (tf "numbers.txt")
49+ , Replace.benchmark (tf "russian.txt") "принимая" "своем"
50+ , Search.benchmark (tf "russian.txt") "принимая"
51+ , WordFrequencies.benchmark (tf "russian.txt")
52+ ]
53+
54+ -- Program-like benchmarks
55+ ps <- bgroup "Programs" `fmap` sequence
56+ [ Programs.BigTable.benchmark sink
57+ , Programs.Cut.benchmark (tf "russian.txt") sink 20 40
58+ , Programs.Fold.benchmark (tf "russian.txt") sink
59+ , Programs.Sort.benchmark (tf "russian.txt") sink
60+ , Programs.StripTags.benchmark (tf "yiwiki.xml") sink
61+ , Programs.Throughput.benchmark (tf "russian.txt") sink
62+ ]
63+
64+ return $ bs ++ [ps]
65+ where
66+ -- Location of a test file
67+ tf = ("../text/test" </>)
tests/benchmarks/src/Data/Text/Benchmarks/Builder.hsnew file+48
@@ -0,0 +1,48 @@
1+-- | Testing the internal builder monoid
2+--
3+-- Tested in this benchmark:
4+--
5+-- * Concatenating many small strings using a builder
6+--
7+{-# LANGUAGE OverloadedStrings #-}
8+module Data.Text.Benchmarks.Builder
9+ ( benchmark
10+ ) where
11+
12+import Criterion (Benchmark, bgroup, bench, nf)
13+import Data.Binary.Builder as B
14+import Data.ByteString.Char8 ()
15+import Data.Monoid (mconcat)
16+import qualified Blaze.ByteString.Builder as Blaze
17+import qualified Blaze.ByteString.Builder.Char.Utf8 as Blaze
18+import qualified Data.ByteString as SB
19+import qualified Data.ByteString.Lazy as LB
20+import qualified Data.Text as T
21+import qualified Data.Text.Lazy as LT
22+import qualified Data.Text.Lazy.Builder as LTB
23+
24+benchmark :: IO Benchmark
25+benchmark = return $ bgroup "Builder"
26+ [ bench "LazyText" $ nf
27+ (LT.length . LTB.toLazyText . mconcat . map LTB.fromText) texts
28+ , bench "Binary" $ nf
29+ (LB.length . B.toLazyByteString . mconcat . map B.fromByteString)
30+ byteStrings
31+ , bench "Blaze" $ nf
32+ (LB.length . Blaze.toLazyByteString . mconcat . map Blaze.fromString)
33+ strings
34+ ]
35+
36+texts :: [T.Text]
37+texts = take 200000 $ cycle ["foo", "λx", "由の"]
38+{-# NOINLINE texts #-}
39+
40+-- Note that the non-ascii characters will be chopped
41+byteStrings :: [SB.ByteString]
42+byteStrings = take 200000 $ cycle ["foo", "λx", "由の"]
43+{-# NOINLINE byteStrings #-}
44+
45+-- Note that the non-ascii characters will be chopped
46+strings :: [String]
47+strings = take 200000 $ cycle ["foo", "λx", "由の"]
48+{-# NOINLINE strings #-}
benchmarks/haskell/Benchmarks/DecodeUtf8.hs → tests/benchmarks/src/Data/Text/Benchmarks/DecodeUtf8.hsrenamed+4−28
@@ -1,5 +1,3 @@
1−{-# LANGUAGE ForeignFunctionInterface #-}
2−
3-- | Test decoding of UTF-8
1-- | Test decoding of UTF-8
4--
2--
5-- Tested in this benchmark:
3-- Tested in this benchmark:
@@ -14,18 +12,11 @@
14--
12--
15-- The latter are used for testing stream fusion.
13-- The latter are used for testing stream fusion.
16--
14--
17−module Benchmarks.DecodeUtf8
15+module Data.Text.Benchmarks.DecodeUtf8
18 ( benchmark
16 ( benchmark
19 ) where
17 ) where
20
18
21−import Foreign.C.Types
22−import Data.ByteString.Internal (ByteString(..))
23−import Data.ByteString.Lazy.Internal (ByteString(..))
24−import Foreign.Ptr (Ptr, plusPtr)
25−import Foreign.ForeignPtr (withForeignPtr)
26−import Data.Word (Word8)
27−import qualified Criterion as C
28−import Criterion (Benchmark, bgroup, nf, whnfIO)
19+import Criterion (Benchmark, bgroup, bench, nf)
29import qualified Codec.Binary.UTF8.Generic as U8
20import qualified Codec.Binary.UTF8.Generic as U8
30import qualified Data.ByteString as B
21import qualified Data.ByteString as B
31import qualified Data.ByteString.Lazy as BL
22import qualified Data.ByteString.Lazy as BL
@@ -34,21 +25,12 @@ import qualified Data.Text.Encoding as T
34import qualified Data.Text.Lazy as TL
25import qualified Data.Text.Lazy as TL
35import qualified Data.Text.Lazy.Encoding as TL
26import qualified Data.Text.Lazy.Encoding as TL
36
27
37−benchmark :: String -> FilePath -> IO Benchmark
28+benchmark :: FilePath -> IO Benchmark
38−benchmark kind fp = do
29+benchmark fp = do
39 bs <- B.readFile fp
30 bs <- B.readFile fp
40 lbs <- BL.readFile fp
31 lbs <- BL.readFile fp
41− let bench name = C.bench (name ++ "+" ++ kind)
42− decodeStream (Chunk b0 bs0) = case T.streamDecodeUtf8 b0 of
43− T.Some t0 _ f0 -> t0 : go f0 bs0
44− where go f (Chunk b bs1) = case f b of
45− T.Some t1 _ f1 -> t1 : go f1 bs1
46− go _ _ = []
47− decodeStream _ = []
48 return $ bgroup "DecodeUtf8"
32 return $ bgroup "DecodeUtf8"
49 [ bench "Strict" $ nf T.decodeUtf8 bs
33 [ bench "Strict" $ nf T.decodeUtf8 bs
50− , bench "Stream" $ nf decodeStream lbs
51− , bench "IConv" $ whnfIO $ iconv bs
52 , bench "StrictLength" $ nf (T.length . T.decodeUtf8) bs
34 , bench "StrictLength" $ nf (T.length . T.decodeUtf8) bs
53 , bench "StrictInitLength" $ nf (T.length . T.init . T.decodeUtf8) bs
35 , bench "StrictInitLength" $ nf (T.length . T.init . T.decodeUtf8) bs
54 , bench "Lazy" $ nf TL.decodeUtf8 lbs
36 , bench "Lazy" $ nf TL.decodeUtf8 lbs
@@ -59,9 +41,3 @@ benchmark kind fp = do
59 , bench "LazyStringUtf8" $ nf U8.toString lbs
41 , bench "LazyStringUtf8" $ nf U8.toString lbs
60 , bench "LazyStringUtf8Length" $ nf (length . U8.toString) lbs
42 , bench "LazyStringUtf8Length" $ nf (length . U8.toString) lbs
61 ]
43 ]
62−
63−iconv :: B.ByteString -> IO CInt
64−iconv (PS fp off len) = withForeignPtr fp $ \ptr ->
65− time_iconv (ptr `plusPtr` off) (fromIntegral len)
66−
67−foreign import ccall unsafe time_iconv :: Ptr Word8 -> CSize -> IO CInt
benchmarks/haskell/Benchmarks/EncodeUtf8.hs → tests/benchmarks/src/Data/Text/Benchmarks/EncodeUtf8.hsrenamed+1−1
@@ -6,7 +6,7 @@
6--
6--
7-- * UTF-8 encoding it
7-- * UTF-8 encoding it
8--
8--
9−module Benchmarks.EncodeUtf8
9+module Data.Text.Benchmarks.EncodeUtf8
10 ( benchmark
10 ( benchmark
11 ) where
11 ) where
12
12
benchmarks/haskell/Benchmarks/Equality.hs → tests/benchmarks/src/Data/Text/Benchmarks/Equality.hsrenamed+1−1
@@ -5,7 +5,7 @@
5--
5--
6-- * Comparison of strings (Eq instance)
6-- * Comparison of strings (Eq instance)
7--
7--
8−module Benchmarks.Equality
8+module Data.Text.Benchmarks.Equality
9 ( benchmark
9 ( benchmark
10 ) where
10 ) where
11
11
tests/benchmarks/src/Data/Text/Benchmarks/FileRead.hsnew file+33
@@ -0,0 +1,33 @@
1+-- | Benchmarks simple file reading
2+--
3+-- Tested in this benchmark:
4+--
5+-- * Reading a file from the disk
6+--
7+module Data.Text.Benchmarks.FileRead
8+ ( benchmark
9+ ) where
10+
11+import Control.Exception (evaluate)
12+import Criterion (Benchmark, bgroup, bench)
13+import qualified Data.ByteString as SB
14+import qualified Data.ByteString.Lazy as LB
15+import qualified Data.Text as T
16+import qualified Data.Text.Encoding as T
17+import qualified Data.Text.IO as T
18+import qualified Data.Text.Lazy as LT
19+import qualified Data.Text.Lazy.Encoding as LT
20+import qualified Data.Text.Lazy.IO as LT
21+
22+benchmark :: FilePath -> IO Benchmark
23+benchmark p = return $ bgroup "FileRead"
24+ [ bench "String" $ readFile p >>= evaluate . length
25+ , bench "ByteString" $ SB.readFile p >>= evaluate . SB.length
26+ , bench "LazyByteString" $ LB.readFile p >>= evaluate . LB.length
27+ , bench "Text" $ T.readFile p >>= evaluate . T.length
28+ , bench "LazyText" $ LT.readFile p >>= evaluate . LT.length
29+ , bench "TextByteString" $
30+ SB.readFile p >>= evaluate . T.length . T.decodeUtf8
31+ , bench "LazyTextByteString" $
32+ LB.readFile p >>= evaluate . LT.length . LT.decodeUtf8
33+ ]
benchmarks/haskell/Benchmarks/FoldLines.hs → tests/benchmarks/src/Data/Text/Benchmarks/FoldLines.hsrenamed+3−3
@@ -6,11 +6,11 @@
6-- * Buffered, line-based IO
6-- * Buffered, line-based IO
7--
7--
8{-# LANGUAGE BangPatterns #-}
8{-# LANGUAGE BangPatterns #-}
9−module Benchmarks.FoldLines
9+module Data.Text.Benchmarks.FoldLines
10 ( benchmark
10 ( benchmark
11 ) where
11 ) where
12
12
13−import Criterion (Benchmark, bgroup, bench, whnfIO)
13+import Criterion (Benchmark, bgroup, bench)
14import System.IO
14import System.IO
15import qualified Data.ByteString as B
15import qualified Data.ByteString as B
16import qualified Data.Text as T
16import qualified Data.Text as T
@@ -22,7 +22,7 @@ benchmark fp = return $ bgroup "ReadLines"
22 , bench "ByteString" $ withHandle $ foldLinesB (\n _ -> n + 1) (0 :: Int)
22 , bench "ByteString" $ withHandle $ foldLinesB (\n _ -> n + 1) (0 :: Int)
23 ]
23 ]
24 where
24 where
25− withHandle f = whnfIO $ do
25+ withHandle f = do
26 h <- openFile fp ReadMode
26 h <- openFile fp ReadMode
27 hSetBuffering h (BlockBuffering (Just 16384))
27 hSetBuffering h (BlockBuffering (Just 16384))
28 x <- f h
28 x <- f h
benchmarks/haskell/Benchmarks/Programs/BigTable.hs → tests/benchmarks/src/Data/Text/Benchmarks/Programs/BigTable.hsrenamed+3−3
@@ -7,11 +7,11 @@
7-- * Writing to a handle
7-- * Writing to a handle
8--
8--
9{-# LANGUAGE OverloadedStrings #-}
9{-# LANGUAGE OverloadedStrings #-}
10−module Benchmarks.Programs.BigTable
10+module Data.Text.Benchmarks.Programs.BigTable
11 ( benchmark
11 ( benchmark
12 ) where
12 ) where
13
13
14−import Criterion (Benchmark, bench, whnfIO)
14+import Criterion (Benchmark, bench)
15import Data.Monoid (mappend, mconcat)
15import Data.Monoid (mappend, mconcat)
16import Data.Text.Lazy.Builder (Builder, fromText, toLazyText)
16import Data.Text.Lazy.Builder (Builder, fromText, toLazyText)
17import Data.Text.Lazy.IO (hPutStr)
17import Data.Text.Lazy.IO (hPutStr)
@@ -19,7 +19,7 @@ import System.IO (Handle)
19import qualified Data.Text as T
19import qualified Data.Text as T
20
20
21benchmark :: Handle -> IO Benchmark
21benchmark :: Handle -> IO Benchmark
22−benchmark sink = return $ bench "BigTable" $ whnfIO $ do
22+benchmark sink = return $ bench "BigTable" $ do
23 hPutStr sink "Content-Type: text/html\n\n<table>"
23 hPutStr sink "Content-Type: text/html\n\n<table>"
24 hPutStr sink . toLazyText . makeTable =<< rows
24 hPutStr sink . toLazyText . makeTable =<< rows
25 hPutStr sink "</table>"
25 hPutStr sink "</table>"
benchmarks/haskell/Benchmarks/Programs/Cut.hs → tests/benchmarks/src/Data/Text/Benchmarks/Programs/Cut.hsrenamed+3−3
@@ -12,11 +12,11 @@
12--
12--
13-- * Writing back to a handle
13-- * Writing back to a handle
14--
14--
15−module Benchmarks.Programs.Cut
15+module Data.Text.Benchmarks.Programs.Cut
16 ( benchmark
16 ( benchmark
17 ) where
17 ) where
18
18
19−import Criterion (Benchmark, bgroup, bench, whnfIO)
19+import Criterion (Benchmark, bgroup, bench)
20import System.IO (Handle, hPutStr)
20import System.IO (Handle, hPutStr)
21import qualified Data.ByteString as B
21import qualified Data.ByteString as B
22import qualified Data.ByteString.Char8 as BC
22import qualified Data.ByteString.Char8 as BC
@@ -40,7 +40,7 @@ benchmark p sink from to = return $ bgroup "Cut"
40 , bench' "LazyTextByteString" lazyTextByteString
40 , bench' "LazyTextByteString" lazyTextByteString
41 ]
41 ]
42 where
42 where
43− bench' n s = bench n $ whnfIO (s p sink from to)
43+ bench' n s = bench n (s p sink from to)
44
44
45string :: FilePath -> Handle -> Int -> Int -> IO ()
45string :: FilePath -> Handle -> Int -> Int -> IO ()
46string fp sink from to = do
46string fp sink from to = do
benchmarks/haskell/Benchmarks/Programs/Fold.hs → tests/benchmarks/src/Data/Text/Benchmarks/Programs/Fold.hsrenamed+3−3
@@ -13,7 +13,7 @@
13-- * Writing back to a handle
13-- * Writing back to a handle
14--
14--
15{-# LANGUAGE OverloadedStrings #-}
15{-# LANGUAGE OverloadedStrings #-}
16−module Benchmarks.Programs.Fold
16+module Data.Text.Benchmarks.Programs.Fold
17 ( benchmark
17 ( benchmark
18 ) where
18 ) where
19
19
@@ -21,7 +21,7 @@ import Data.List (foldl')
21import Data.List (intersperse)
21import Data.List (intersperse)
22import Data.Monoid (mempty, mappend, mconcat)
22import Data.Monoid (mempty, mappend, mconcat)
23import System.IO (Handle)
23import System.IO (Handle)
24−import Criterion (Benchmark, bench, whnfIO)
24+import Criterion (Benchmark, bench)
25import qualified Data.Text as T
25import qualified Data.Text as T
26import qualified Data.Text.IO as T
26import qualified Data.Text.IO as T
27import qualified Data.Text.Lazy.Builder as TLB
27import qualified Data.Text.Lazy.Builder as TLB
@@ -30,7 +30,7 @@ import qualified Data.Text.Lazy.IO as TL
30
30
31benchmark :: FilePath -> Handle -> IO Benchmark
31benchmark :: FilePath -> Handle -> IO Benchmark
32benchmark i o = return $
32benchmark i o = return $
33− bench "Fold" $ whnfIO $ T.readFile i >>= TL.hPutStr o . fold 80
33+ bench "Fold" $ T.readFile i >>= TL.hPutStr o . fold 80
34
34
35-- | We represent a paragraph by a word list
35-- | We represent a paragraph by a word list
36--
36--
benchmarks/haskell/Benchmarks/Programs/Sort.hs → tests/benchmarks/src/Data/Text/Benchmarks/Programs/Sort.hsrenamed+10−18
@@ -13,40 +13,32 @@
13-- * Writing back to a handle
13-- * Writing back to a handle
14--
14--
15{-# LANGUAGE OverloadedStrings #-}
15{-# LANGUAGE OverloadedStrings #-}
16−module Benchmarks.Programs.Sort
16+module Data.Text.Benchmarks.Programs.Sort
17 ( benchmark
17 ( benchmark
18 ) where
18 ) where
19
19
20−import Criterion (Benchmark, bgroup, bench, whnfIO)
20+import Criterion (Benchmark, bgroup, bench)
21import Data.Monoid (mconcat)
21import Data.Monoid (mconcat)
22import System.IO (Handle, hPutStr)
22import System.IO (Handle, hPutStr)
23import qualified Data.ByteString as B
23import qualified Data.ByteString as B
24−import qualified Data.ByteString.Char8 as BC
25import qualified Data.ByteString.Lazy as BL
24import qualified Data.ByteString.Lazy as BL
26import qualified Data.ByteString.Lazy.Char8 as BLC
25import qualified Data.ByteString.Lazy.Char8 as BLC
26+import qualified Data.ByteString.Char8 as BC
27import qualified Data.List as L
27import qualified Data.List as L
28import qualified Data.Text as T
28import qualified Data.Text as T
29−import qualified Data.Text.Encoding as T
30import qualified Data.Text.IO as T
29import qualified Data.Text.IO as T
31import qualified Data.Text.Lazy as TL
30import qualified Data.Text.Lazy as TL
32−import qualified Data.Text.Lazy.Builder as TLB
33−import qualified Data.Text.Lazy.Encoding as TL
34import qualified Data.Text.Lazy.IO as TL
31import qualified Data.Text.Lazy.IO as TL
32+import qualified Data.Text.Lazy.Builder as TLB
35
33
36benchmark :: FilePath -> Handle -> IO Benchmark
34benchmark :: FilePath -> Handle -> IO Benchmark
37benchmark i o = return $ bgroup "Sort"
35benchmark i o = return $ bgroup "Sort"
38− [ bench "String" $ whnfIO $ readFile i >>= hPutStr o . string
36+ [ bench "String" $ readFile i >>= hPutStr o . string
39− , bench "ByteString" $ whnfIO $ B.readFile i >>= B.hPutStr o . byteString
37+ , bench "ByteString" $ B.readFile i >>= B.hPutStr o . byteString
40− , bench "LazyByteString" $ whnfIO $
41− BL.readFile i >>= BL.hPutStr o . lazyByteString
38+ , bench "LazyByteString" $ BL.readFile i >>= BL.hPutStr o . lazyByteString
42− , bench "Text" $ whnfIO $ T.readFile i >>= T.hPutStr o . text
39+ , bench "Text" $ T.readFile i >>= T.hPutStr o . text
43− , bench "LazyText" $ whnfIO $ TL.readFile i >>= TL.hPutStr o . lazyText
40+ , bench "LazyText" $ TL.readFile i >>= TL.hPutStr o . lazyText
44− , bench "TextByteString" $ whnfIO $ B.readFile i >>=
45− B.hPutStr o . T.encodeUtf8 . text . T.decodeUtf8
46− , bench "LazyTextByteString" $ whnfIO $ BL.readFile i >>=
47− BL.hPutStr o . TL.encodeUtf8 . lazyText . TL.decodeUtf8
48− , bench "TextBuilder" $ whnfIO $ B.readFile i >>=
41+ , bench "TextBuilder" $ T.readFile i >>= TL.hPutStr o . textBuilder
49− BL.hPutStr o . TL.encodeUtf8 . textBuilder . T.decodeUtf8
50 ]
42 ]
51
43
52string :: String -> String
44string :: String -> String
benchmarks/haskell/Benchmarks/Programs/StripTags.hs → tests/benchmarks/src/Data/Text/Benchmarks/Programs/StripTags.hsrenamed+6−8
@@ -11,25 +11,23 @@
11-- * Writing back to a handle
11-- * Writing back to a handle
12--
12--
13{-# OPTIONS_GHC -fspec-constr-count=5 #-}
13{-# OPTIONS_GHC -fspec-constr-count=5 #-}
14−module Benchmarks.Programs.StripTags
14+module Data.Text.Benchmarks.Programs.StripTags
15 ( benchmark
15 ( benchmark
16 ) where
16 ) where
17−
17+
18−import Criterion (Benchmark, bgroup, bench, whnfIO)
18+import Criterion (Benchmark, bgroup, bench)
19import Data.List (mapAccumL)
19import Data.List (mapAccumL)
20import System.IO (Handle, hPutStr)
20import System.IO (Handle, hPutStr)
21import qualified Data.ByteString as B
21import qualified Data.ByteString as B
22import qualified Data.ByteString.Char8 as BC
22import qualified Data.ByteString.Char8 as BC
23import qualified Data.Text as T
23import qualified Data.Text as T
24import qualified Data.Text.Encoding as T
24import qualified Data.Text.Encoding as T
25−import qualified Data.Text.IO as T
26
25
27benchmark :: FilePath -> Handle -> IO Benchmark
26benchmark :: FilePath -> Handle -> IO Benchmark
28benchmark i o = return $ bgroup "StripTags"
27benchmark i o = return $ bgroup "StripTags"
29− [ bench "String" $ whnfIO $ readFile i >>= hPutStr o . string
28+ [ bench "String" $ readFile i >>= hPutStr o . string
30− , bench "ByteString" $ whnfIO $ B.readFile i >>= B.hPutStr o . byteString
29+ , bench "ByteString" $ B.readFile i >>= B.hPutStr o . byteString
31− , bench "Text" $ whnfIO $ T.readFile i >>= T.hPutStr o . text
30+ , bench "Text" $
32− , bench "TextByteString" $ whnfIO $
33 B.readFile i >>= B.hPutStr o . T.encodeUtf8 . text . T.decodeUtf8
31 B.readFile i >>= B.hPutStr o . T.encodeUtf8 . text . T.decodeUtf8
34 ]
32 ]
35
33
benchmarks/haskell/Benchmarks/Programs/Throughput.hs → tests/benchmarks/src/Data/Text/Benchmarks/Programs/Throughput.hsrenamed+7−13
@@ -14,28 +14,22 @@
14--
14--
15-- * Writing back to a handle
15-- * Writing back to a handle
16--
16--
17−module Benchmarks.Programs.Throughput
17+module Data.Text.Benchmarks.Programs.Throughput
18 ( benchmark
18 ( benchmark
19 ) where
19 ) where
20
20
21−import Criterion (Benchmark, bgroup, bench, whnfIO)
21+import Criterion (Benchmark, bgroup, bench)
22import System.IO (Handle, hPutStr)
22import System.IO (Handle, hPutStr)
23import qualified Data.ByteString as B
23import qualified Data.ByteString as B
24import qualified Data.ByteString.Lazy as BL
24import qualified Data.ByteString.Lazy as BL
25−import qualified Data.Text.Encoding as T
26import qualified Data.Text.IO as T
25import qualified Data.Text.IO as T
27−import qualified Data.Text.Lazy.Encoding as TL
28import qualified Data.Text.Lazy.IO as TL
26import qualified Data.Text.Lazy.IO as TL
29
27
30benchmark :: FilePath -> Handle -> IO Benchmark
28benchmark :: FilePath -> Handle -> IO Benchmark
31benchmark fp sink = return $ bgroup "Throughput"
29benchmark fp sink = return $ bgroup "Throughput"
32− [ bench "String" $ whnfIO $ readFile fp >>= hPutStr sink
30+ [ bench "String" $ readFile fp >>= hPutStr sink
33− , bench "ByteString" $ whnfIO $ B.readFile fp >>= B.hPutStr sink
31+ , bench "ByteString" $ B.readFile fp >>= B.hPutStr sink
34− , bench "LazyByteString" $ whnfIO $ BL.readFile fp >>= BL.hPutStr sink
32+ , bench "LazyByteString" $ BL.readFile fp >>= BL.hPutStr sink
35− , bench "Text" $ whnfIO $ T.readFile fp >>= T.hPutStr sink
33+ , bench "Text" $ T.readFile fp >>= T.hPutStr sink
36− , bench "LazyText" $ whnfIO $ TL.readFile fp >>= TL.hPutStr sink
34+ , bench "LazyText" $ TL.readFile fp >>= TL.hPutStr sink
37− , bench "TextByteString" $ whnfIO $
38− B.readFile fp >>= B.hPutStr sink . T.encodeUtf8 . T.decodeUtf8
39− , bench "LazyTextByteString" $ whnfIO $
40− BL.readFile fp >>= BL.hPutStr sink . TL.encodeUtf8 . TL.decodeUtf8
41 ]
35 ]
benchmarks/haskell/Benchmarks/Pure.hs → tests/benchmarks/src/Data/Text/Benchmarks/Pure.hsrenamed+10−22
@@ -4,9 +4,9 @@
4--
4--
5-- * Most pure functions defined the string types
5-- * Most pure functions defined the string types
6--
6--
7−{-# LANGUAGE BangPatterns, CPP, GADTs, MagicHash #-}
7+{-# LANGUAGE BangPatterns, GADTs, MagicHash #-}
8{-# OPTIONS_GHC -fno-warn-orphans #-}
8{-# OPTIONS_GHC -fno-warn-orphans #-}
9−module Benchmarks.Pure
9+module Data.Text.Benchmarks.Pure
10 ( benchmark
10 ( benchmark
11 ) where
11 ) where
12
12
@@ -18,6 +18,7 @@ import Data.Monoid (mappend, mempty)
18import GHC.Base (Char (..), Int (..), chr#, ord#, (+#))
18import GHC.Base (Char (..), Int (..), chr#, ord#, (+#))
19import qualified Data.ByteString.Char8 as BS
19import qualified Data.ByteString.Char8 as BS
20import qualified Data.ByteString.Lazy.Char8 as BL
20import qualified Data.ByteString.Lazy.Char8 as BL
21+import qualified Data.ByteString.Lazy.Internal as BL
21import qualified Data.ByteString.UTF8 as UTF8
22import qualified Data.ByteString.UTF8 as UTF8
22import qualified Data.List as L
23import qualified Data.List as L
23import qualified Data.Text as T
24import qualified Data.Text as T
@@ -26,8 +27,8 @@ import qualified Data.Text.Lazy as TL
26import qualified Data.Text.Lazy.Builder as TB
27import qualified Data.Text.Lazy.Builder as TB
27import qualified Data.Text.Lazy.Encoding as TL
28import qualified Data.Text.Lazy.Encoding as TL
28
29
29−benchmark :: String -> FilePath -> IO Benchmark
30+benchmark :: FilePath -> IO Benchmark
30−benchmark kind fp = do
31+benchmark fp = do
31 -- Evaluate stuff before actually running the benchmark, we don't want to
32 -- Evaluate stuff before actually running the benchmark, we don't want to
32 -- count it here.
33 -- count it here.
33
34
@@ -99,10 +100,6 @@ benchmark kind fp = do
99 , benchBSL $ nf BL.unpack bla
100 , benchBSL $ nf BL.unpack bla
100 , benchS $ nf UTF8.toString bsa
101 , benchS $ nf UTF8.toString bsa
101 ]
102 ]
102− , bgroup "decode'"
103− [ benchT $ nf T.decodeUtf8' bsa
104− , benchTL $ nf TL.decodeUtf8' bla
105− ]
106 , bgroup "drop"
103 , bgroup "drop"
107 [ benchT $ nf (T.drop (ta_len `div` 3)) ta
104 [ benchT $ nf (T.drop (ta_len `div` 3)) ta
108 , benchTL $ nf (TL.drop (tla_len `div` 3)) tla
105 , benchTL $ nf (TL.drop (tla_len `div` 3)) tla
@@ -262,13 +259,6 @@ benchmark kind fp = do
262 , benchBSL $ nf (BL.map toUpper) bla
259 , benchBSL $ nf (BL.map toUpper) bla
263 , benchS $ nf (L.map toUpper) sa
260 , benchS $ nf (L.map toUpper) sa
264 ]
261 ]
265− , bgroup "uncons"
266− [ benchT $ nf T.uncons ta
267− , benchTL $ nf TL.uncons tla
268− , benchBS $ nf BS.uncons bsa
269− , benchBSL $ nf BL.uncons bla
270− , benchS $ nf L.uncons sa
271− ]
272 , bgroup "words"
262 , bgroup "words"
273 [ benchT $ nf T.words ta
263 [ benchT $ nf T.words ta
274 , benchTL $ nf TL.words tla
264 , benchTL $ nf TL.words tla
@@ -415,11 +405,11 @@ benchmark kind fp = do
415 ]
405 ]
416 ]
406 ]
417 where
407 where
418− benchS = bench ("String+" ++ kind)
408+ benchS = bench "String"
419− benchT = bench ("Text+" ++ kind)
409+ benchT = bench "Text"
420− benchTL = bench ("LazyText+" ++ kind)
410+ benchTL = bench "LazyText"
421− benchBS = bench ("ByteString+" ++ kind)
411+ benchBS = bench "ByteString"
422− benchBSL = bench ("LazyByteString+" ++ kind)
412+ benchBSL = bench "LazyByteString"
423
413
424 c = 'й'
414 c = 'й'
425 p0 = (== c)
415 p0 = (== c)
@@ -435,13 +425,11 @@ benchmark kind fp = do
435 replicat n = concat . L.replicate n
425 replicat n = concat . L.replicate n
436 short = T.pack "short"
426 short = T.pack "short"
437
427
438−#if !MIN_VERSION_bytestring(0,10,0)
439instance NFData BS.ByteString
428instance NFData BS.ByteString
440
429
441instance NFData BL.ByteString where
430instance NFData BL.ByteString where
442 rnf BL.Empty = ()
431 rnf BL.Empty = ()
443 rnf (BL.Chunk _ ts) = rnf ts
432 rnf (BL.Chunk _ ts) = rnf ts
444−#endif
445
433
446data B where
434data B where
447 B :: NFData a => a -> B
435 B :: NFData a => a -> B
benchmarks/haskell/Benchmarks/ReadNumbers.hs → tests/benchmarks/src/Data/Text/Benchmarks/ReadNumbers.hsrenamed+7−4
@@ -16,7 +16,7 @@
16--
16--
17-- * Lexing/parsing of different numerical types
17-- * Lexing/parsing of different numerical types
18--
18--
19−module Benchmarks.ReadNumbers
19+module Data.Text.Benchmarks.ReadNumbers
20 ( benchmark
20 ( benchmark
21 ) where
21 ) where
22
22
@@ -25,7 +25,8 @@ import Data.List (foldl')
25import Numeric (readDec, readFloat, readHex)
25import Numeric (readDec, readFloat, readHex)
26import qualified Data.ByteString.Char8 as B
26import qualified Data.ByteString.Char8 as B
27import qualified Data.ByteString.Lazy.Char8 as BL
27import qualified Data.ByteString.Lazy.Char8 as BL
28−import qualified Data.ByteString.Lex.Fractional as B
28+import qualified Data.ByteString.Lex.Double as B
29+import qualified Data.ByteString.Lex.Lazy.Double as BL
29import qualified Data.Text as T
30import qualified Data.Text as T
30import qualified Data.Text.IO as T
31import qualified Data.Text.IO as T
31import qualified Data.Text.Lazy as TL
32import qualified Data.Text.Lazy as TL
@@ -62,10 +63,12 @@ benchmark fp = do
62 whnf (double . text TL.rational) tl
63 whnf (double . text TL.rational) tl
63
64
64 , bench "DecimalByteString" $ whnf (int . byteString B.readInt) b
65 , bench "DecimalByteString" $ whnf (int . byteString B.readInt) b
65− , bench "DoubleByteString" $ whnf (double . byteString B.readDecimal) b
66+ , bench "DoubleByteString" $ whnf (double . byteString B.readDouble) b
66
67
67 , bench "DecimalLazyByteString" $
68 , bench "DecimalLazyByteString" $
68 whnf (int . byteString BL.readInt) bl
69 whnf (int . byteString BL.readInt) bl
70+ , bench "DoubleLazyByteString" $
71+ whnf (double . byteString BL.readDouble) bl
69 ]
72 ]
70 where
73 where
71 -- Used for fixing types
74 -- Used for fixing types
@@ -85,7 +88,7 @@ text reader = foldl' go 1000000
85 where
88 where
86 go z t = case reader t of Left _ -> z
89 go z t = case reader t of Left _ -> z
87 Right (n, _) -> min n z
90 Right (n, _) -> min n z
88−
91+
89byteString :: (Ord a, Num a) => (t -> Maybe (a,t)) -> [t] -> a
92byteString :: (Ord a, Num a) => (t -> Maybe (a,t)) -> [t] -> a
90byteString reader = foldl' go 1000000
93byteString reader = foldl' go 1000000
91 where
94 where
tests/benchmarks/src/Data/Text/Benchmarks/Replace.hsnew file+31
@@ -0,0 +1,31 @@
1+-- | Replace a string by another string
2+--
3+-- Tested in this benchmark:
4+--
5+-- * Search and replace of a pattern in a text
6+--
7+module Data.Text.Benchmarks.Replace
8+ ( benchmark
9+ ) where
10+
11+import Criterion (Benchmark, bgroup, bench, nf)
12+import qualified Data.ByteString.Char8 as B
13+import qualified Data.ByteString.Lazy as BL
14+import qualified Data.ByteString.Lazy.Search as BL
15+import qualified Data.Text.Lazy as TL
16+import qualified Data.Text.Lazy.Encoding as TL
17+import qualified Data.Text.Lazy.IO as TL
18+
19+benchmark :: FilePath -> String -> String -> IO Benchmark
20+benchmark fp pat sub = do
21+ tl <- TL.readFile fp
22+ bl <- BL.readFile fp
23+ return $ bgroup "Replace"
24+ [ bench "LazyText" $ nf (TL.length . TL.replace tpat tsub) tl
25+ , bench "LazyByteString" $ nf (BL.length . BL.replace bpat bsub) bl
26+ ]
27+ where
28+ tpat = TL.pack pat
29+ tsub = TL.pack sub
30+ bpat = B.concat $ BL.toChunks $ TL.encodeUtf8 tpat
31+ bsub = B.concat $ BL.toChunks $ TL.encodeUtf8 tsub
benchmarks/haskell/Benchmarks/Search.hs → tests/benchmarks/src/Data/Text/Benchmarks/Search.hsrenamed+1−1
@@ -4,7 +4,7 @@
4--
4--
5-- * Searching all occurences of a pattern using library routines
5-- * Searching all occurences of a pattern using library routines
6--
6--
7−module Benchmarks.Search
7+module Data.Text.Benchmarks.Search
8 ( benchmark
8 ( benchmark
9 ) where
9 ) where
10
10
benchmarks/haskell/Benchmarks/WordFrequencies.hs → tests/benchmarks/src/Data/Text/Benchmarks/WordFrequencies.hsrenamed+1−1
@@ -8,7 +8,7 @@
8--
8--
9-- * Comparing: Eq/Ord instances
9-- * Comparing: Eq/Ord instances
10--
10--
11−module Benchmarks.WordFrequencies
11+module Data.Text.Benchmarks.WordFrequencies
12 ( benchmark
12 ( benchmark
13 ) where
13 ) where
14
14
tests/benchmarks/text-benchmarks.cabalnew file+35
@@ -0,0 +1,35 @@
1+name: text-benchmarks
2+version: 0.0.0.0
3+synopsis: Benchmarks for the text package
4+description: Benchmarks for the text package
5+homepage: https://bitbucket.org/bos/text
6+license: BSD3
7+license-file: ../../LICENSE
8+author: Jasper Van der Jeugt <jaspervdj@gmail.com>,
9+ Bryan O'Sullivan <bos@serpentine.com>,
10+ Tom Harper <rtomharper@googlemail.com>,
11+ Duncan Coutts <duncan@haskell.org>
12+maintainer: jaspervdj@gmail.com
13+category: Text
14+build-type: Simple
15+
16+cabal-version: >=1.2
17+
18+executable text-benchmarks
19+ hs-source-dirs: src ../..
20+ c-sources: ../../cbits/cbits.c
21+ main-is: Data/Text/Benchmarks.hs
22+ ghc-options: -Wall -O2
23+ cpp-options: -DHAVE_DEEPSEQ
24+ build-depends: base >= 4 && < 5,
25+ criterion >= 0.5 && < 0.6,
26+ bytestring >= 0.9 && < 0.10,
27+ deepseq >= 1.1 && < 1.2,
28+ filepath >= 1.1 && < 1.3,
29+ directory >= 1.1 && < 1.2,
30+ containers >= 0.3 && < 0.5,
31+ binary >= 0.5 && < 0.6,
32+ utf8-string >= 0.3 && < 0.4,
33+ blaze-builder >= 0.3 && < 0.4,
34+ bytestring-lexing >= 0.2 && < 0.3,
35+ stringsearch >= 0.3 && < 0.4
tests/cabal.configdeleted−6
@@ -1,6 +0,0 @@
1−-- These flags help to speed up building the test suite.
2−
3−documentation: False
4−executable-stripping: False
5−flags: developer
6−library-profiling: False
tests/literal-rule-test.shdeleted−29
@@ -1,29 +0,0 @@
1−#!/bin/bash -e
2−
3−failed=0
4−
5−function check_firings() {
6− rule=$1
7− expected=$2
8− build="ghc -O -ddump-rule-firings LiteralRuleTest.hs"
9− build="$build -i.. -I../include"
10− touch LiteralRuleTest.hs
11− echo -n "Want to see $expected firings of rule $rule... " >&2
12− firings=$($build 2>&1 | grep "Rule fired: $rule\$" | wc -l)
13− rm -f LiteralRuleTest.{o.hi}
14−
15− if [ $firings != $expected ]; then
16− echo "failed, saw $firings" >&2
17− failed=1
18− else
19− echo "pass" >&2
20− fi
21−}
22−
23−check_firings "TEXT literal" 8
24−check_firings "TEXT literal UTF8" 7
25−check_firings "TEXT empty literal" 4
26−# This is broken at the moment. "TEXT literal" rule fires instead.
27−#check_firings "TEXT singleton literal" 5
28−
29−exit $failed
tests/.ghci → tests/tests/.ghcirenamed

The content is the same.

tests/Makefile → tests/tests/Makefilerenamed+3−14
@@ -1,23 +1,12 @@
1−count = 1000
2−
3−all: coverage literal-rule-test
4−
5−literal-rule-test:
6− ./literal-rule-test.sh
7−
8coverage: build coverage/hpc_index.html
1coverage: build coverage/hpc_index.html
9
2
10−build: text-test-data
3+build:
11 cabal configure -fhpc
4 cabal configure -fhpc
12 cabal build
5 cabal build
13
6
14−text-test-data:
15− hg clone https://bitbucket.org/bos/text-test-data
16− $(MAKE) -C text-test-data
17−
18coverage/text-tests.tix:
7coverage/text-tests.tix:
19 -mkdir -p coverage
8 -mkdir -p coverage
20− ./dist/build/text-tests/text-tests -a $(count)
9+ ./dist/build/text-tests/text-tests
21 mv text-tests.tix $@
10 mv text-tests.tix $@
22
11
23coverage/text-tests-stdio.tix:
12coverage/text-tests-stdio.tix:
@@ -37,4 +26,4 @@ coverage/hpc_index.html: coverage/coverage.tix
37clean:
26clean:
38 rm -rf dist coverage .hpc
27 rm -rf dist coverage .hpc
39
28
40−.PHONY: build coverage all literal-rule-test
29+.PHONY: build coverage
tests/scripts/cover-stdio.sh → tests/tests/scripts/cover-stdio.shrenamed

The content is the same.

tests/Tests.hs → tests/tests/src/Data/Text/Tests.hsrenamed+2−2
@@ -6,8 +6,8 @@ module Main
6
6
7import Test.Framework (defaultMain)
7import Test.Framework (defaultMain)
8
8
9−import qualified Tests.Properties as Properties
9+import qualified Data.Text.Tests.Properties as Properties
10−import qualified Tests.Regressions as Regressions
10+import qualified Data.Text.Tests.Regressions as Regressions
11
11
12main :: IO ()
12main :: IO ()
13main = defaultMain [Properties.tests, Regressions.tests]
13main = defaultMain [Properties.tests, Regressions.tests]
tests/Tests/IO.hs → tests/tests/src/Data/Text/Tests/IO.hsrenamed

The content is the same.

tests/Tests/Properties.hs → tests/tests/src/Data/Text/Tests/Properties.hsrenamed+82−329
@@ -1,60 +1,54 @@
1−-- | QuickCheck properties for the text library.
1+-- | General quicktest properties for the text library
2−
2+--
3{-# LANGUAGE BangPatterns, FlexibleInstances, OverloadedStrings,
3{-# LANGUAGE BangPatterns, FlexibleInstances, OverloadedStrings,
4− ScopedTypeVariables, TypeSynonymInstances #-}
4+ ScopedTypeVariables, TypeSynonymInstances, CPP #-}
5−{-# OPTIONS_GHC -fno-enable-rewrite-rules -fno-warn-missing-signatures #-}
5+{-# OPTIONS_GHC -fno-enable-rewrite-rules #-}
6+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
6−module Tests.Properties
7+module Data.Text.Tests.Properties
7 (
8 (
8 tests
9 tests
9 ) where
10 ) where
10
11
11−import Control.Applicative ((<$>), (<*>))
12+import Test.QuickCheck
13+import Test.QuickCheck.Monadic
14+import Text.Show.Functions ()
15+
12import Control.Arrow ((***), second)
16import Control.Arrow ((***), second)
13−import Data.Bits ((.&.))
17+import Control.Exception (catch)
14import Data.Char (chr, isDigit, isHexDigit, isLower, isSpace, isUpper, ord)
18import Data.Char (chr, isDigit, isHexDigit, isLower, isSpace, isUpper, ord)
15−import Data.Int (Int8, Int16, Int32, Int64)
16import Data.Monoid (Monoid(..))
19import Data.Monoid (Monoid(..))
17−import Data.String (IsString(fromString))
20+import Data.String (fromString)
18import Data.Text.Encoding.Error
21import Data.Text.Encoding.Error
19import Data.Text.Foreign
22import Data.Text.Foreign
20−import Data.Text.Internal.Encoding.Utf8
23+import Data.Text.Fusion.Size
21−import Data.Text.Internal.Fusion.Size
22−import Data.Text.Internal.Search (indices)
23import Data.Text.Lazy.Read as TL
24import Data.Text.Lazy.Read as TL
24import Data.Text.Read as T
25import Data.Text.Read as T
26+import Data.Text.Search (indices)
25−import Data.Word (Word, Word8, Word16, Word32, Word64)
27+import Data.Word (Word8, Word16, Word32)
26−import Numeric (showEFloat, showFFloat, showGFloat, showHex)
28+import Numeric (showHex)
27−import Prelude hiding (replicate)
29+import Prelude hiding (catch, replicate)
28import Test.Framework (Test, testGroup)
30import Test.Framework (Test, testGroup)
29import Test.Framework.Providers.QuickCheck2 (testProperty)
31import Test.Framework.Providers.QuickCheck2 (testProperty)
30−import Test.QuickCheck hiding ((.&.))
31−import Test.QuickCheck.Monadic
32−import Test.QuickCheck.Property (Property(..))
33−import Tests.QuickCheckUtils
34−import Tests.Utils
35−import Text.Show.Functions ()
36−import qualified Control.Exception as Exception
37import qualified Data.Bits as Bits (shiftL, shiftR)
32import qualified Data.Bits as Bits (shiftL, shiftR)
38import qualified Data.ByteString as B
33import qualified Data.ByteString as B
39−import qualified Data.ByteString.Lazy as BL
40import qualified Data.List as L
34import qualified Data.List as L
41import qualified Data.Text as T
35import qualified Data.Text as T
42import qualified Data.Text.Encoding as E
36import qualified Data.Text.Encoding as E
37+import qualified Data.Text.Fusion as S
38+import qualified Data.Text.Fusion.Common as S
43import qualified Data.Text.IO as T
39import qualified Data.Text.IO as T
44−import qualified Data.Text.Internal.Fusion as S
45−import qualified Data.Text.Internal.Fusion.Common as S
46−import qualified Data.Text.Internal.Lazy.Fusion as SL
47−import qualified Data.Text.Internal.Lazy.Search as S (indices)
48−import qualified Data.Text.Internal.Unsafe.Shift as U
49import qualified Data.Text.Lazy as TL
40import qualified Data.Text.Lazy as TL
50import qualified Data.Text.Lazy.Builder as TB
41import qualified Data.Text.Lazy.Builder as TB
51−import qualified Data.Text.Lazy.Builder.Int as TB
52−import qualified Data.Text.Lazy.Builder.RealFloat as TB
53import qualified Data.Text.Lazy.Encoding as EL
42import qualified Data.Text.Lazy.Encoding as EL
43+import qualified Data.Text.Lazy.Fusion as SL
54import qualified Data.Text.Lazy.IO as TL
44import qualified Data.Text.Lazy.IO as TL
45+import qualified Data.Text.Lazy.Search as S (indices)
46+import qualified Data.Text.UnsafeShift as U
55import qualified System.IO as IO
47import qualified System.IO as IO
56−import qualified Tests.Properties.Mul as Mul
48+
49+import Data.Text.Tests.QuickCheckUtils
50+import Data.Text.Tests.Utils
57−import qualified Tests.SlowFunctions as Slow
51+import qualified Data.Text.Tests.SlowFunctions as Slow
58
52
59t_pack_unpack = (T.unpack . T.pack) `eq` id
53t_pack_unpack = (T.unpack . T.pack) `eq` id
60tl_pack_unpack = (TL.unpack . TL.pack) `eq` id
54tl_pack_unpack = (TL.unpack . TL.pack) `eq` id
@@ -68,20 +62,10 @@ tl_unstreamChunks x = f 11 x == f 1000 x
68tl_chunk_unchunk = (TL.fromChunks . TL.toChunks) `eq` id
62tl_chunk_unchunk = (TL.fromChunks . TL.toChunks) `eq` id
69tl_from_to_strict = (TL.fromStrict . TL.toStrict) `eq` id
63tl_from_to_strict = (TL.fromStrict . TL.toStrict) `eq` id
70
64
71−-- Note: this silently truncates code-points > 255 to 8-bit due to 'B.pack'
72−encodeL1 :: T.Text -> B.ByteString
73−encodeL1 = B.pack . map (fromIntegral . fromEnum) . T.unpack
74−encodeLazyL1 :: TL.Text -> BL.ByteString
75−encodeLazyL1 = BL.fromChunks . map encodeL1 . TL.toChunks
76−
77t_ascii t = E.decodeASCII (E.encodeUtf8 a) == a
65t_ascii t = E.decodeASCII (E.encodeUtf8 a) == a
78 where a = T.map (\c -> chr (ord c `mod` 128)) t
66 where a = T.map (\c -> chr (ord c `mod` 128)) t
79tl_ascii t = EL.decodeASCII (EL.encodeUtf8 a) == a
67tl_ascii t = EL.decodeASCII (EL.encodeUtf8 a) == a
80 where a = TL.map (\c -> chr (ord c `mod` 128)) t
68 where a = TL.map (\c -> chr (ord c `mod` 128)) t
81−t_latin1 t = E.decodeLatin1 (encodeL1 a) == a
82− where a = T.map (\c -> chr (ord c `mod` 256)) t
83−tl_latin1 t = EL.decodeLatin1 (encodeLazyL1 a) == a
84− where a = TL.map (\c -> chr (ord c `mod` 256)) t
85t_utf8 = forAll genUnicode $ (E.decodeUtf8 . E.encodeUtf8) `eq` id
69t_utf8 = forAll genUnicode $ (E.decodeUtf8 . E.encodeUtf8) `eq` id
86t_utf8' = forAll genUnicode $ (E.decodeUtf8' . E.encodeUtf8) `eq` (id . Right)
70t_utf8' = forAll genUnicode $ (E.decodeUtf8' . E.encodeUtf8) `eq` (id . Right)
87tl_utf8 = forAll genUnicode $ (EL.decodeUtf8 . EL.encodeUtf8) `eq` id
71tl_utf8 = forAll genUnicode $ (EL.decodeUtf8 . EL.encodeUtf8) `eq` id
@@ -95,88 +79,23 @@ tl_utf32LE = forAll genUnicode $ (EL.decodeUtf32LE . EL.encodeUtf32LE) `eq` id
95t_utf32BE = forAll genUnicode $ (E.decodeUtf32BE . E.encodeUtf32BE) `eq` id
79t_utf32BE = forAll genUnicode $ (E.decodeUtf32BE . E.encodeUtf32BE) `eq` id
96tl_utf32BE = forAll genUnicode $ (EL.decodeUtf32BE . EL.encodeUtf32BE) `eq` id
80tl_utf32BE = forAll genUnicode $ (EL.decodeUtf32BE . EL.encodeUtf32BE) `eq` id
97
81
98−t_utf8_incr = forAll genUnicode $ \s (Positive n) -> (recode n `eq` id) s
82+-- This is a poor attempt to ensure that the error handling paths on
99− where recode n = T.concat . map fst . feedChunksOf n E.streamDecodeUtf8 .
83+-- decode are exercised in some way. Proper testing would be rather
100− E.encodeUtf8
84+-- more involved.
101−
102−feedChunksOf :: Int -> (B.ByteString -> E.Decoding) -> B.ByteString
103− -> [(T.Text, B.ByteString)]
104−feedChunksOf n f bs
105− | B.null bs = []
106− | otherwise = let (x,y) = B.splitAt n bs
107− E.Some t b f' = f x
108− in (t,b) : feedChunksOf n f' y
109−
110−t_utf8_undecoded = forAll genUnicode $ \t ->
111− let b = E.encodeUtf8 t
112− ls = concatMap (leftover . E.encodeUtf8 . T.singleton) . T.unpack $ t
113− leftover = (++ [B.empty]) . init . tail . B.inits
114− in (map snd . feedChunksOf 1 E.streamDecodeUtf8) b == ls
115−
116−data Badness = Solo | Leading | Trailing
117− deriving (Eq, Show)
118−
119−instance Arbitrary Badness where
120− arbitrary = elements [Solo, Leading, Trailing]
121−
122−t_utf8_err :: Badness -> DecodeErr -> Property
85+t_utf8_err :: DecodeErr -> B.ByteString -> Property
123−t_utf8_err bad de = do
86+t_utf8_err (DE _ de) bs = monadicIO $ do
124− let gen = case bad of
125− Solo -> genInvalidUTF8
126− Leading -> B.append <$> genInvalidUTF8 <*> genUTF8
127− Trailing -> B.append <$> genUTF8 <*> genInvalidUTF8
128− genUTF8 = E.encodeUtf8 <$> genUnicode
129− forAll gen $ \bs -> MkProperty $ do
130− onErr <- genDecodeErr de
131− unProperty . monadicIO $ do
132− l <- run $ let len = T.length (E.decodeUtf8With onErr bs)
87+ l <- run $ let len = T.length (E.decodeUtf8With de bs)
133− in (len `seq` return (Right len)) `Exception.catch`
88+ in (len `seq` return (Right len)) `catch`
134− (\(e::UnicodeException) -> return (Left e))
89+ (\(e::UnicodeException) -> return (Left e))
135− assert $ case l of
90+ case l of
136− Left err -> length (show err) >= 0
91+ Left err -> assert $ length (show err) >= 0
137− Right _ -> de /= Strict
92+ Right n -> assert $ n >= 0
138
93
139t_utf8_err' :: B.ByteString -> Property
94t_utf8_err' :: B.ByteString -> Property
140t_utf8_err' bs = monadicIO . assert $ case E.decodeUtf8' bs of
95t_utf8_err' bs = monadicIO . assert $ case E.decodeUtf8' bs of
141 Left err -> length (show err) >= 0
96 Left err -> length (show err) >= 0
142 Right t -> T.length t >= 0
97 Right t -> T.length t >= 0
143
98
144−genInvalidUTF8 :: Gen B.ByteString
145−genInvalidUTF8 = B.pack <$> oneof [
146− -- invalid leading byte of a 2-byte sequence
147− (:) <$> choose (0xC0, 0xC1) <*> upTo 1 contByte
148− -- invalid leading byte of a 4-byte sequence
149− , (:) <$> choose (0xF5, 0xFF) <*> upTo 3 contByte
150− -- 4-byte sequence greater than U+10FFFF
151− , do k <- choose (0x11, 0x13)
152− let w0 = 0xF0 + (k `Bits.shiftR` 2)
153− w1 = 0x80 + ((k .&. 3) `Bits.shiftL` 4)
154− ([w0,w1]++) <$> vectorOf 2 contByte
155− -- continuation bytes without a start byte
156− , listOf1 contByte
157− -- short 2-byte sequence
158− , (:[]) <$> choose (0xC2, 0xDF)
159− -- short 3-byte sequence
160− , (:) <$> choose (0xE0, 0xEF) <*> upTo 1 contByte
161− -- short 4-byte sequence
162− , (:) <$> choose (0xF0, 0xF4) <*> upTo 2 contByte
163− -- overlong encoding
164− , do k <- choose (0,0xFFFF)
165− let c = chr k
166− case k of
167− _ | k < 0x80 -> oneof [ let (w,x) = ord2 c in return [w,x]
168− , let (w,x,y) = ord3 c in return [w,x,y]
169− , let (w,x,y,z) = ord4 c in return [w,x,y,z] ]
170− | k < 0x7FF -> oneof [ let (w,x,y) = ord3 c in return [w,x,y]
171− , let (w,x,y,z) = ord4 c in return [w,x,y,z] ]
172− | otherwise -> let (w,x,y,z) = ord4 c in return [w,x,y,z]
173− ]
174− where
175− contByte = (0x80 +) <$> choose (0, 0x3f)
176− upTo n gen = do
177− k <- choose (0,n)
178− vectorOf k gen
179−
180s_Eq s = (s==) `eq` ((S.streamList s==) . S.streamList)
99s_Eq s = (s==) `eq` ((S.streamList s==) . S.streamList)
181 where _types = s :: String
100 where _types = s :: String
182sf_Eq p s =
101sf_Eq p s =
@@ -197,10 +116,8 @@ t_Show = show `eq` (show . T.pack)
197tl_Show = show `eq` (show . TL.pack)
116tl_Show = show `eq` (show . TL.pack)
198t_mappend s = mappend s`eqP` (unpackS . mappend (T.pack s))
117t_mappend s = mappend s`eqP` (unpackS . mappend (T.pack s))
199tl_mappend s = mappend s`eqP` (unpackS . mappend (TL.pack s))
118tl_mappend s = mappend s`eqP` (unpackS . mappend (TL.pack s))
200−t_mconcat = unsquare $
201− mconcat `eq` (unpackS . mconcat . L.map T.pack)
119+t_mconcat = mconcat `eq` (unpackS . mconcat . L.map T.pack)
202−tl_mconcat = unsquare $
203− mconcat `eq` (unpackS . mconcat . L.map TL.pack)
120+tl_mconcat = mconcat `eq` (unpackS . mconcat . L.map TL.pack)
204t_mempty = mempty == (unpackS (mempty :: T.Text))
121t_mempty = mempty == (unpackS (mempty :: T.Text))
205tl_mempty = mempty == (unpackS (mempty :: TL.Text))
122tl_mempty = mempty == (unpackS (mempty :: TL.Text))
206t_IsString = fromString `eqP` (T.unpack . fromString)
123t_IsString = fromString `eqP` (T.unpack . fromString)
@@ -264,14 +181,11 @@ s_map_s f = map f `eqP` (unpackS . S.unstream . S.map f)
264sf_map p f = (map f . L.filter p) `eqP` (unpackS . S.map f . S.filter p)
181sf_map p f = (map f . L.filter p) `eqP` (unpackS . S.map f . S.filter p)
265t_map f = map f `eqP` (unpackS . T.map f)
182t_map f = map f `eqP` (unpackS . T.map f)
266tl_map f = map f `eqP` (unpackS . TL.map f)
183tl_map f = map f `eqP` (unpackS . TL.map f)
267−s_intercalate c = unsquare $
268− L.intercalate c `eq`
184+s_intercalate c = L.intercalate c `eq`
269 (unpackS . S.intercalate (packS c) . map packS)
185 (unpackS . S.intercalate (packS c) . map packS)
270−t_intercalate c = unsquare $
271− L.intercalate c `eq`
186+t_intercalate c = L.intercalate c `eq`
272 (unpackS . T.intercalate (packS c) . map packS)
187 (unpackS . T.intercalate (packS c) . map packS)
273−tl_intercalate c = unsquare $
274− L.intercalate c `eq`
188+tl_intercalate c = L.intercalate c `eq`
275 (unpackS . TL.intercalate (TL.pack c) . map TL.pack)
189 (unpackS . TL.intercalate (TL.pack c) . map TL.pack)
276s_intersperse c = L.intersperse c `eqP`
190s_intersperse c = L.intersperse c `eqP`
277 (unpackS . S.intersperse c)
191 (unpackS . S.intersperse c)
@@ -279,14 +193,10 @@ s_intersperse_s c = L.intersperse c `eqP`
279 (unpackS . S.unstream . S.intersperse c)
193 (unpackS . S.unstream . S.intersperse c)
280sf_intersperse p c= (L.intersperse c . L.filter p) `eqP`
194sf_intersperse p c= (L.intersperse c . L.filter p) `eqP`
281 (unpackS . S.intersperse c . S.filter p)
195 (unpackS . S.intersperse c . S.filter p)
282−t_intersperse c = unsquare $
283− L.intersperse c `eqP` (unpackS . T.intersperse c)
196+t_intersperse c = L.intersperse c `eqP` (unpackS . T.intersperse c)
284−tl_intersperse c = unsquare $
285− L.intersperse c `eqP` (unpackS . TL.intersperse c)
197+tl_intersperse c = L.intersperse c `eqP` (unpackS . TL.intersperse c)
286−t_transpose = unsquare $
287− L.transpose `eq` (map unpackS . T.transpose . map packS)
198+t_transpose = L.transpose `eq` (map unpackS . T.transpose . map packS)
288−tl_transpose = unsquare $
289− L.transpose `eq` (map unpackS . TL.transpose . map TL.pack)
199+tl_transpose = L.transpose `eq` (map unpackS . TL.transpose . map TL.pack)
290t_reverse = L.reverse `eqP` (unpackS . T.reverse)
200t_reverse = L.reverse `eqP` (unpackS . T.reverse)
291tl_reverse = L.reverse `eqP` (unpackS . TL.reverse)
201tl_reverse = L.reverse `eqP` (unpackS . TL.reverse)
292t_reverse_short n = L.reverse `eqP` (unpackS . S.reverse . shorten n . S.stream)
202t_reverse_short n = L.reverse `eqP` (unpackS . S.reverse . shorten n . S.stream)
@@ -298,7 +208,7 @@ tl_replace s d = (L.intercalate d . splitOn s) `eqP`
298
208
299splitOn :: (Eq a) => [a] -> [a] -> [[a]]
209splitOn :: (Eq a) => [a] -> [a] -> [[a]]
300splitOn pat src0
210splitOn pat src0
301− | l == 0 = error "splitOn: empty"
211+ | l == 0 = error "empty"
302 | otherwise = go src0
212 | otherwise = go src0
303 where
213 where
304 l = length pat
214 l = length pat
@@ -383,24 +293,17 @@ sf_foldr p f z = (L.foldr f z . L.filter p) `eqP` (S.foldr f z . S.filter p)
383 where _types = f :: Char -> Char -> Char
293 where _types = f :: Char -> Char -> Char
384t_foldr f z = L.foldr f z `eqP` T.foldr f z
294t_foldr f z = L.foldr f z `eqP` T.foldr f z
385 where _types = f :: Char -> Char -> Char
295 where _types = f :: Char -> Char -> Char
386−tl_foldr f z = unsquare $
387− L.foldr f z `eqP` TL.foldr f z
296+tl_foldr f z = L.foldr f z `eqP` TL.foldr f z
388 where _types = f :: Char -> Char -> Char
297 where _types = f :: Char -> Char -> Char
389−sf_foldr1 p f = unsquare $
390− (L.foldr1 f . L.filter p) `eqP` (S.foldr1 f . S.filter p)
298+sf_foldr1 p f = (L.foldr1 f . L.filter p) `eqP` (S.foldr1 f . S.filter p)
391t_foldr1 f = L.foldr1 f `eqP` T.foldr1 f
299t_foldr1 f = L.foldr1 f `eqP` T.foldr1 f
392−tl_foldr1 f = unsquare $
393− L.foldr1 f `eqP` TL.foldr1 f
300+tl_foldr1 f = L.foldr1 f `eqP` TL.foldr1 f
394
301
395−s_concat_s = unsquare $
396− L.concat `eq` (unpackS . S.unstream . S.concat . map packS)
302+s_concat_s = L.concat `eq` (unpackS . S.unstream . S.concat . map packS)
397−sf_concat p = unsquare $
398− (L.concat . map (L.filter p)) `eq`
303+sf_concat p = (L.concat . map (L.filter p)) `eq`
399 (unpackS . S.concat . map (S.filter p . packS))
304 (unpackS . S.concat . map (S.filter p . packS))
400−t_concat = unsquare $
401− L.concat `eq` (unpackS . T.concat . map packS)
305+t_concat = L.concat `eq` (unpackS . T.concat . map packS)
402−tl_concat = unsquare $
403− L.concat `eq` (unpackS . TL.concat . map TL.pack)
306+tl_concat = L.concat `eq` (unpackS . TL.concat . map TL.pack)
404sf_concatMap p f = unsquare $ (L.concatMap f . L.filter p) `eqP`
307sf_concatMap p f = unsquare $ (L.concatMap f . L.filter p) `eqP`
405 (unpackS . S.concatMap (packS . f) . S.filter p)
308 (unpackS . S.concatMap (packS . f) . S.filter p)
406t_concatMap f = unsquare $
309t_concatMap f = unsquare $
@@ -440,10 +343,6 @@ t_mapAccumR f z = L.mapAccumR f z `eqP` (second unpackS . T.mapAccumR f z)
440tl_mapAccumR f z = L.mapAccumR f z `eqP` (second unpackS . TL.mapAccumR f z)
343tl_mapAccumR f z = L.mapAccumR f z `eqP` (second unpackS . TL.mapAccumR f z)
441 where _types = f :: Int -> Char -> (Int,Char)
344 where _types = f :: Int -> Char -> (Int,Char)
442
345
443−tl_repeat n = (L.take m . L.repeat) `eq`
444− (unpackS . TL.take (fromIntegral m) . TL.repeat)
445− where m = fromIntegral (n :: Word8)
446−
447replicate n l = concat (L.replicate n l)
346replicate n l = concat (L.replicate n l)
448
347
449s_replicate n = replicate m `eq`
348s_replicate n = replicate m `eq`
@@ -455,14 +354,6 @@ tl_replicate n = replicate m `eq`
455 (unpackS . TL.replicate (fromIntegral m) . packS)
354 (unpackS . TL.replicate (fromIntegral m) . packS)
456 where m = fromIntegral (n :: Word8)
355 where m = fromIntegral (n :: Word8)
457
356
458−tl_cycle n = (L.take m . L.cycle) `eq`
459− (unpackS . TL.take (fromIntegral m) . TL.cycle . packS)
460− where m = fromIntegral (n :: Word8)
461−
462−tl_iterate f n = (L.take m . L.iterate f) `eq`
463− (unpackS . TL.take (fromIntegral m) . TL.iterate f)
464− where m = fromIntegral (n :: Word8)
465−
466unf :: Int -> Char -> Maybe (Char, Char)
357unf :: Int -> Char -> Maybe (Char, Char)
467unf n c | fromEnum c * 100 > n = Nothing
358unf n c | fromEnum c * 100 > n = Nothing
468 | otherwise = Just (c, succ c)
359 | otherwise = Just (c, succ c)
@@ -489,22 +380,14 @@ s_take_s m = L.take n `eqP` (unpackS . S.unstream . S.take n)
489sf_take p n = (L.take n . L.filter p) `eqP`
380sf_take p n = (L.take n . L.filter p) `eqP`
490 (unpackS . S.take n . S.filter p)
381 (unpackS . S.take n . S.filter p)
491t_take n = L.take n `eqP` (unpackS . T.take n)
382t_take n = L.take n `eqP` (unpackS . T.take n)
492−t_takeEnd n = (L.reverse . L.take n . L.reverse) `eqP`
493− (unpackS . T.takeEnd n)
494tl_take n = L.take n `eqP` (unpackS . TL.take (fromIntegral n))
383tl_take n = L.take n `eqP` (unpackS . TL.take (fromIntegral n))
495−tl_takeEnd n = (L.reverse . L.take (fromIntegral n) . L.reverse) `eqP`
496− (unpackS . TL.takeEnd n)
497s_drop n = L.drop n `eqP` (unpackS . S.drop n)
384s_drop n = L.drop n `eqP` (unpackS . S.drop n)
498s_drop_s m = L.drop n `eqP` (unpackS . S.unstream . S.drop n)
385s_drop_s m = L.drop n `eqP` (unpackS . S.unstream . S.drop n)
499 where n = small m
386 where n = small m
500sf_drop p n = (L.drop n . L.filter p) `eqP`
387sf_drop p n = (L.drop n . L.filter p) `eqP`
501 (unpackS . S.drop n . S.filter p)
388 (unpackS . S.drop n . S.filter p)
502t_drop n = L.drop n `eqP` (unpackS . T.drop n)
389t_drop n = L.drop n `eqP` (unpackS . T.drop n)
503−t_dropEnd n = (L.reverse . L.drop n . L.reverse) `eqP`
504− (unpackS . T.dropEnd n)
505tl_drop n = L.drop n `eqP` (unpackS . TL.drop (fromIntegral n))
390tl_drop n = L.drop n `eqP` (unpackS . TL.drop (fromIntegral n))
506−tl_dropEnd n = (L.reverse . L.drop n . L.reverse) `eqP`
507− (unpackS . TL.dropEnd (fromIntegral n))
508s_take_drop m = (L.take n . L.drop n) `eqP` (unpackS . S.take n . S.drop n)
391s_take_drop m = (L.take n . L.drop n) `eqP` (unpackS . S.take n . S.drop n)
509 where n = small m
392 where n = small m
510s_take_drop_s m = (L.take n . L.drop n) `eqP`
393s_take_drop_s m = (L.take n . L.drop n) `eqP`
@@ -516,10 +399,6 @@ sf_takeWhile q p = (L.takeWhile p . L.filter q) `eqP`
516 (unpackS . S.takeWhile p . S.filter q)
399 (unpackS . S.takeWhile p . S.filter q)
517t_takeWhile p = L.takeWhile p `eqP` (unpackS . T.takeWhile p)
400t_takeWhile p = L.takeWhile p `eqP` (unpackS . T.takeWhile p)
518tl_takeWhile p = L.takeWhile p `eqP` (unpackS . TL.takeWhile p)
401tl_takeWhile p = L.takeWhile p `eqP` (unpackS . TL.takeWhile p)
519−t_takeWhileEnd p = (L.reverse . L.takeWhile p . L.reverse) `eqP`
520− (unpackS . T.takeWhileEnd p)
521−tl_takeWhileEnd p = (L.reverse . L.takeWhile p . L.reverse) `eqP`
522− (unpackS . TL.takeWhileEnd p)
523s_dropWhile p = L.dropWhile p `eqP` (unpackS . S.dropWhile p)
402s_dropWhile p = L.dropWhile p `eqP` (unpackS . S.dropWhile p)
524s_dropWhile_s p = L.dropWhile p `eqP` (unpackS . S.unstream . S.dropWhile p)
403s_dropWhile_s p = L.dropWhile p `eqP` (unpackS . S.unstream . S.dropWhile p)
525sf_dropWhile q p = (L.dropWhile p . L.filter q) `eqP`
404sf_dropWhile q p = (L.dropWhile p . L.filter q) `eqP`
@@ -572,27 +451,24 @@ tl_groupBy p = L.groupBy p `eqP` (map unpackS . TL.groupBy p)
572t_inits = L.inits `eqP` (map unpackS . T.inits)
451t_inits = L.inits `eqP` (map unpackS . T.inits)
573tl_inits = L.inits `eqP` (map unpackS . TL.inits)
452tl_inits = L.inits `eqP` (map unpackS . TL.inits)
574t_tails = L.tails `eqP` (map unpackS . T.tails)
453t_tails = L.tails `eqP` (map unpackS . T.tails)
575−tl_tails = unsquare $
576− L.tails `eqP` (map unpackS . TL.tails)
454+tl_tails = L.tails `eqP` (map unpackS . TL.tails)
577−t_findAppendId = unsquare $ \(NotEmpty s) ts ->
455+t_findAppendId (NotEmpty s) = unsquare $ \ts ->
578 let t = T.intercalate s ts
456 let t = T.intercalate s ts
579 in all (==t) $ map (uncurry T.append) (T.breakOnAll s t)
457 in all (==t) $ map (uncurry T.append) (T.breakOnAll s t)
580−tl_findAppendId = unsquare $ \(NotEmpty s) ts ->
458+tl_findAppendId (NotEmpty s) = unsquare $ \ts ->
581 let t = TL.intercalate s ts
459 let t = TL.intercalate s ts
582 in all (==t) $ map (uncurry TL.append) (TL.breakOnAll s t)
460 in all (==t) $ map (uncurry TL.append) (TL.breakOnAll s t)
583−t_findContains = unsquare $ \(NotEmpty s) ->
584− all (T.isPrefixOf s . snd) . T.breakOnAll s . T.intercalate s
461+t_findContains (NotEmpty s) = all (T.isPrefixOf s . snd) . T.breakOnAll s .
462+ T.intercalate s
585−tl_findContains = unsquare $ \(NotEmpty s) -> all (TL.isPrefixOf s . snd) .
463+tl_findContains (NotEmpty s) = all (TL.isPrefixOf s . snd) .
586 TL.breakOnAll s . TL.intercalate s
464 TL.breakOnAll s . TL.intercalate s
587sl_filterCount c = (L.genericLength . L.filter (==c)) `eqP` SL.countChar c
465sl_filterCount c = (L.genericLength . L.filter (==c)) `eqP` SL.countChar c
588t_findCount s = (L.length . T.breakOnAll s) `eq` T.count s
466t_findCount s = (L.length . T.breakOnAll s) `eq` T.count s
589tl_findCount s = (L.genericLength . TL.breakOnAll s) `eq` TL.count s
467tl_findCount s = (L.genericLength . TL.breakOnAll s) `eq` TL.count s
590
468
591−t_splitOn_split s = unsquare $
592− (T.splitOn s `eq` Slow.splitOn s) . T.intercalate s
469+t_splitOn_split s = (T.splitOn s `eq` Slow.splitOn s) . T.intercalate s
593−tl_splitOn_split s = unsquare $
594− ((TL.splitOn (TL.fromStrict s) . TL.fromStrict) `eq`
470+tl_splitOn_split s = ((TL.splitOn (TL.fromStrict s) . TL.fromStrict) `eq`
595− (map TL.fromStrict . T.splitOn s)) . T.intercalate s
471+ (map TL.fromStrict . T.splitOn s)) . T.intercalate s
596t_splitOn_i (NotEmpty t) = id `eq` (T.intercalate t . T.splitOn t)
472t_splitOn_i (NotEmpty t) = id `eq` (T.intercalate t . T.splitOn t)
597tl_splitOn_i (NotEmpty t) = id `eq` (TL.intercalate t . TL.splitOn t)
473tl_splitOn_i (NotEmpty t) = id `eq` (TL.intercalate t . TL.splitOn t)
598
474
@@ -634,14 +510,10 @@ t_lines' = lines' `eqP` (map unpackS . T.lines')
634t_words = L.words `eqP` (map unpackS . T.words)
510t_words = L.words `eqP` (map unpackS . T.words)
635
511
636tl_words = L.words `eqP` (map unpackS . TL.words)
512tl_words = L.words `eqP` (map unpackS . TL.words)
637−t_unlines = unsquare $
638− L.unlines `eq` (unpackS . T.unlines . map packS)
513+t_unlines = L.unlines `eq` (unpackS . T.unlines . map packS)
639−tl_unlines = unsquare $
640− L.unlines `eq` (unpackS . TL.unlines . map packS)
514+tl_unlines = L.unlines `eq` (unpackS . TL.unlines . map packS)
641−t_unwords = unsquare $
642− L.unwords `eq` (unpackS . T.unwords . map packS)
515+t_unwords = L.unwords `eq` (unpackS . T.unwords . map packS)
643−tl_unwords = unsquare $
644− L.unwords `eq` (unpackS . TL.unwords . map packS)
516+tl_unwords = L.unwords `eq` (unpackS . TL.unwords . map packS)
645
517
646s_isPrefixOf s = L.isPrefixOf s `eqP`
518s_isPrefixOf s = L.isPrefixOf s `eqP`
647 (S.isPrefixOf (S.stream $ packS s) . S.stream)
519 (S.isPrefixOf (S.stream $ packS s) . S.stream)
@@ -718,9 +590,8 @@ t_indices (NotEmpty s) = Slow.indices s `eq` indices s
718tl_indices (NotEmpty s) = lazyIndices s `eq` S.indices s
590tl_indices (NotEmpty s) = lazyIndices s `eq` S.indices s
719 where lazyIndices ss t = map fromIntegral $ Slow.indices (conc ss) (conc t)
591 where lazyIndices ss t = map fromIntegral $ Slow.indices (conc ss) (conc t)
720 conc = T.concat . TL.toChunks
592 conc = T.concat . TL.toChunks
721−t_indices_occurs = unsquare $ \(NotEmpty t) ts ->
593+t_indices_occurs (NotEmpty t) ts = let s = T.intercalate t ts
722− let s = T.intercalate t ts
723− in Slow.indices t s == indices t s
594+ in Slow.indices t s == indices t s
724
595
725-- Bit shifts.
596-- Bit shifts.
726shiftL w = forAll (choose (0,width-1)) $ \k -> Bits.shiftL w k == U.shiftL w k
597shiftL w = forAll (choose (0,width-1)) $ \k -> Bits.shiftL w k == U.shiftL w k
@@ -739,76 +610,17 @@ shiftR_Word32 = shiftR :: Word32 -> Property
739
610
740-- Builder.
611-- Builder.
741
612
742−tb_singleton = id `eqP`
613+t_builderSingleton = id `eqP`
743− (unpackS . TB.toLazyText . mconcat . map TB.singleton)
614+ (unpackS . TB.toLazyText . mconcat . map TB.singleton)
744−tb_fromText = L.concat `eq` (unpackS . TB.toLazyText . mconcat .
615+t_builderFromText = L.concat `eq` (unpackS . TB.toLazyText . mconcat .
745 map (TB.fromText . packS))
616 map (TB.fromText . packS))
746−tb_associative s1 s2 s3 =
617+t_builderAssociative s1 s2 s3 =
747 TB.toLazyText (b1 `mappend` (b2 `mappend` b3)) ==
618 TB.toLazyText (b1 `mappend` (b2 `mappend` b3)) ==
748 TB.toLazyText ((b1 `mappend` b2) `mappend` b3)
619 TB.toLazyText ((b1 `mappend` b2) `mappend` b3)
749 where b1 = TB.fromText (packS s1)
620 where b1 = TB.fromText (packS s1)
750 b2 = TB.fromText (packS s2)
621 b2 = TB.fromText (packS s2)
751 b3 = TB.fromText (packS s3)
622 b3 = TB.fromText (packS s3)
752
623
753−-- Numeric builder stuff.
754−
755−tb_decimal :: (Integral a, Show a) => a -> Bool
756−tb_decimal = (TB.toLazyText . TB.decimal) `eq` (TL.pack . show)
757−
758−tb_decimal_integer (a::Integer) = tb_decimal a
759−tb_decimal_integer_big (Big a) = tb_decimal a
760−tb_decimal_int (a::Int) = tb_decimal a
761−tb_decimal_int8 (a::Int8) = tb_decimal a
762−tb_decimal_int16 (a::Int16) = tb_decimal a
763−tb_decimal_int32 (a::Int32) = tb_decimal a
764−tb_decimal_int64 (a::Int64) = tb_decimal a
765−tb_decimal_word (a::Word) = tb_decimal a
766−tb_decimal_word8 (a::Word8) = tb_decimal a
767−tb_decimal_word16 (a::Word16) = tb_decimal a
768−tb_decimal_word32 (a::Word32) = tb_decimal a
769−tb_decimal_word64 (a::Word64) = tb_decimal a
770−
771−tb_decimal_big_int (BigBounded (a::Int)) = tb_decimal a
772−tb_decimal_big_int64 (BigBounded (a::Int64)) = tb_decimal a
773−tb_decimal_big_word (BigBounded (a::Word)) = tb_decimal a
774−tb_decimal_big_word64 (BigBounded (a::Word64)) = tb_decimal a
775−
776−tb_hex :: (Integral a, Show a) => a -> Bool
777−tb_hex = (TB.toLazyText . TB.hexadecimal) `eq` (TL.pack . flip showHex "")
778−
779−tb_hexadecimal_integer (a::Integer) = tb_hex a
780−tb_hexadecimal_int (a::Int) = tb_hex a
781−tb_hexadecimal_int8 (a::Int8) = tb_hex a
782−tb_hexadecimal_int16 (a::Int16) = tb_hex a
783−tb_hexadecimal_int32 (a::Int32) = tb_hex a
784−tb_hexadecimal_int64 (a::Int64) = tb_hex a
785−tb_hexadecimal_word (a::Word) = tb_hex a
786−tb_hexadecimal_word8 (a::Word8) = tb_hex a
787−tb_hexadecimal_word16 (a::Word16) = tb_hex a
788−tb_hexadecimal_word32 (a::Word32) = tb_hex a
789−tb_hexadecimal_word64 (a::Word64) = tb_hex a
790−
791−tb_realfloat :: (RealFloat a, Show a) => a -> Bool
792−tb_realfloat = (TB.toLazyText . TB.realFloat) `eq` (TL.pack . show)
793−
794−tb_realfloat_float (a::Float) = tb_realfloat a
795−tb_realfloat_double (a::Double) = tb_realfloat a
796−
797−showFloat :: (RealFloat a) => TB.FPFormat -> Maybe Int -> a -> ShowS
798−showFloat TB.Exponent = showEFloat
799−showFloat TB.Fixed = showFFloat
800−showFloat TB.Generic = showGFloat
801−
802−tb_formatRealFloat :: (RealFloat a, Show a) =>
803− a -> TB.FPFormat -> Precision a -> Property
804−tb_formatRealFloat a fmt prec =
805− TB.formatRealFloat fmt p a ===
806− TB.fromString (showFloat fmt p a "")
807− where p = precision a prec
808−
809−tb_formatRealFloat_float (a::Float) = tb_formatRealFloat a
810−tb_formatRealFloat_double (a::Double) = tb_formatRealFloat a
811−
812-- Reading.
624-- Reading.
813
625
814t_decimal (n::Int) s =
626t_decimal (n::Int) s =
@@ -817,18 +629,16 @@ t_decimal (n::Int) s =
817tl_decimal (n::Int) s =
629tl_decimal (n::Int) s =
818 TL.signed TL.decimal (TL.pack (show n) `TL.append` t) == Right (n,t)
630 TL.signed TL.decimal (TL.pack (show n) `TL.append` t) == Right (n,t)
819 where t = TL.dropWhile isDigit s
631 where t = TL.dropWhile isDigit s
820−t_hexadecimal m s ox =
632+t_hexadecimal (n::Positive Int) s ox =
821 T.hexadecimal (T.concat [p, T.pack (showHex n ""), t]) == Right (n,t)
633 T.hexadecimal (T.concat [p, T.pack (showHex n ""), t]) == Right (n,t)
822 where t = T.dropWhile isHexDigit s
634 where t = T.dropWhile isHexDigit s
823 p = if ox then "0x" else ""
635 p = if ox then "0x" else ""
824− n = getPositive m :: Int
636+tl_hexadecimal (n::Positive Int) s ox =
825−tl_hexadecimal m s ox =
826 TL.hexadecimal (TL.concat [p, TL.pack (showHex n ""), t]) == Right (n,t)
637 TL.hexadecimal (TL.concat [p, TL.pack (showHex n ""), t]) == Right (n,t)
827 where t = TL.dropWhile isHexDigit s
638 where t = TL.dropWhile isHexDigit s
828 p = if ox then "0x" else ""
639 p = if ox then "0x" else ""
829− n = getPositive m :: Int
830
640
831−isFloaty c = c `elem` ("+-.0123456789eE" :: String)
641+isFloaty c = c `elem` "+-.0123456789eE"
832
642
833t_read_rational p tol (n::Double) s =
643t_read_rational p tol (n::Double) s =
834 case p (T.pack (show n) `T.append` t) of
644 case p (T.pack (show n) `T.append` t) of
@@ -871,8 +681,6 @@ t_take_drop_16 m t = T.append (takeWord16 n t) (dropWord16 n t) == t
871 where n = small m
681 where n = small m
872t_use_from t = monadicIO $ assert . (==t) =<< run (useAsPtr t fromPtr)
682t_use_from t = monadicIO $ assert . (==t) =<< run (useAsPtr t fromPtr)
873
683
874−t_copy t = T.copy t == t
875−
876-- Regression tests.
684-- Regression tests.
877s_filter_eq s = S.filter p t == S.streamList (filter p s)
685s_filter_eq s = S.filter p t == S.streamList (filter p s)
878 where p = (/= S.last t)
686 where p = (/= S.last t)
@@ -883,7 +691,7 @@ s_filter_eq s = S.filter p t == S.streamList (filter p s)
883-- themselves.
691-- themselves.
884shorten :: Int -> S.Stream a -> S.Stream a
692shorten :: Int -> S.Stream a -> S.Stream a
885shorten n t@(S.Stream arr off len)
693shorten n t@(S.Stream arr off len)
886− | n > 0 = S.Stream arr off (smaller (exactSize n) len)
694+ | n > 0 = S.Stream arr off (smaller (exactSize n) len)
887 | otherwise = t
695 | otherwise = t
888
696
889tests :: Test
697tests :: Test
@@ -905,12 +713,8 @@ tests =
905 testGroup "transcoding" [
713 testGroup "transcoding" [
906 testProperty "t_ascii" t_ascii,
714 testProperty "t_ascii" t_ascii,
907 testProperty "tl_ascii" tl_ascii,
715 testProperty "tl_ascii" tl_ascii,
908− testProperty "t_latin1" t_latin1,
909− testProperty "tl_latin1" tl_latin1,
910 testProperty "t_utf8" t_utf8,
716 testProperty "t_utf8" t_utf8,
911 testProperty "t_utf8'" t_utf8',
717 testProperty "t_utf8'" t_utf8',
912− testProperty "t_utf8_incr" t_utf8_incr,
913− testProperty "t_utf8_undecoded" t_utf8_undecoded,
914 testProperty "tl_utf8" tl_utf8,
718 testProperty "tl_utf8" tl_utf8,
915 testProperty "tl_utf8'" tl_utf8',
719 testProperty "tl_utf8'" tl_utf8',
916 testProperty "t_utf16LE" t_utf16LE,
720 testProperty "t_utf16LE" t_utf16LE,
@@ -1110,12 +914,9 @@ tests =
1110 ],
914 ],
1111
915
1112 testGroup "unfolds" [
916 testGroup "unfolds" [
1113− testProperty "tl_repeat" tl_repeat,
1114 testProperty "s_replicate" s_replicate,
917 testProperty "s_replicate" s_replicate,
1115 testProperty "t_replicate" t_replicate,
918 testProperty "t_replicate" t_replicate,
1116 testProperty "tl_replicate" tl_replicate,
919 testProperty "tl_replicate" tl_replicate,
1117− testProperty "tl_cycle" tl_cycle,
1118− testProperty "tl_iterate" tl_iterate,
1119 testProperty "t_unfoldr" t_unfoldr,
920 testProperty "t_unfoldr" t_unfoldr,
1120 testProperty "tl_unfoldr" tl_unfoldr,
921 testProperty "tl_unfoldr" tl_unfoldr,
1121 testProperty "t_unfoldrN" t_unfoldrN,
922 testProperty "t_unfoldrN" t_unfoldrN,
@@ -1129,16 +930,12 @@ tests =
1129 testProperty "s_take_s" s_take_s,
930 testProperty "s_take_s" s_take_s,
1130 testProperty "sf_take" sf_take,
931 testProperty "sf_take" sf_take,
1131 testProperty "t_take" t_take,
932 testProperty "t_take" t_take,
1132− testProperty "t_takeEnd" t_takeEnd,
1133 testProperty "tl_take" tl_take,
933 testProperty "tl_take" tl_take,
1134− testProperty "tl_takeEnd" tl_takeEnd,
1135 testProperty "s_drop" s_drop,
934 testProperty "s_drop" s_drop,
1136 testProperty "s_drop_s" s_drop_s,
935 testProperty "s_drop_s" s_drop_s,
1137 testProperty "sf_drop" sf_drop,
936 testProperty "sf_drop" sf_drop,
1138 testProperty "t_drop" t_drop,
937 testProperty "t_drop" t_drop,
1139− testProperty "t_dropEnd" t_dropEnd,
1140 testProperty "tl_drop" tl_drop,
938 testProperty "tl_drop" tl_drop,
1141− testProperty "tl_dropEnd" tl_dropEnd,
1142 testProperty "s_take_drop" s_take_drop,
939 testProperty "s_take_drop" s_take_drop,
1143 testProperty "s_take_drop_s" s_take_drop_s,
940 testProperty "s_take_drop_s" s_take_drop_s,
1144 testProperty "s_takeWhile" s_takeWhile,
941 testProperty "s_takeWhile" s_takeWhile,
@@ -1146,8 +943,6 @@ tests =
1146 testProperty "sf_takeWhile" sf_takeWhile,
943 testProperty "sf_takeWhile" sf_takeWhile,
1147 testProperty "t_takeWhile" t_takeWhile,
944 testProperty "t_takeWhile" t_takeWhile,
1148 testProperty "tl_takeWhile" tl_takeWhile,
945 testProperty "tl_takeWhile" tl_takeWhile,
1149− testProperty "t_takeWhileEnd" t_takeWhileEnd,
1150− testProperty "tl_takeWhileEnd" tl_takeWhileEnd,
1151 testProperty "sf_dropWhile" sf_dropWhile,
946 testProperty "sf_dropWhile" sf_dropWhile,
1152 testProperty "s_dropWhile" s_dropWhile,
947 testProperty "s_dropWhile" s_dropWhile,
1153 testProperty "s_dropWhile_s" s_dropWhile_s,
948 testProperty "s_dropWhile_s" s_dropWhile_s,
@@ -1285,46 +1080,9 @@ tests =
1285 ],
1080 ],
1286
1081
1287 testGroup "builder" [
1082 testGroup "builder" [
1288− testProperty "tb_associative" tb_associative,
1083+ testProperty "t_builderSingleton" t_builderSingleton,
1289− testGroup "decimal" [
1084+ testProperty "t_builderFromText" t_builderFromText,
1290− testProperty "tb_decimal_int" tb_decimal_int,
1085+ testProperty "t_builderAssociative" t_builderAssociative
1291− testProperty "tb_decimal_int8" tb_decimal_int8,
1292− testProperty "tb_decimal_int16" tb_decimal_int16,
1293− testProperty "tb_decimal_int32" tb_decimal_int32,
1294− testProperty "tb_decimal_int64" tb_decimal_int64,
1295− testProperty "tb_decimal_integer" tb_decimal_integer,
1296− testProperty "tb_decimal_integer_big" tb_decimal_integer_big,
1297− testProperty "tb_decimal_word" tb_decimal_word,
1298− testProperty "tb_decimal_word8" tb_decimal_word8,
1299− testProperty "tb_decimal_word16" tb_decimal_word16,
1300− testProperty "tb_decimal_word32" tb_decimal_word32,
1301− testProperty "tb_decimal_word64" tb_decimal_word64,
1302− testProperty "tb_decimal_big_int" tb_decimal_big_int,
1303− testProperty "tb_decimal_big_word" tb_decimal_big_word,
1304− testProperty "tb_decimal_big_int64" tb_decimal_big_int64,
1305− testProperty "tb_decimal_big_word64" tb_decimal_big_word64
1306− ],
1307− testGroup "hexadecimal" [
1308− testProperty "tb_hexadecimal_int" tb_hexadecimal_int,
1309− testProperty "tb_hexadecimal_int8" tb_hexadecimal_int8,
1310− testProperty "tb_hexadecimal_int16" tb_hexadecimal_int16,
1311− testProperty "tb_hexadecimal_int32" tb_hexadecimal_int32,
1312− testProperty "tb_hexadecimal_int64" tb_hexadecimal_int64,
1313− testProperty "tb_hexadecimal_integer" tb_hexadecimal_integer,
1314− testProperty "tb_hexadecimal_word" tb_hexadecimal_word,
1315− testProperty "tb_hexadecimal_word8" tb_hexadecimal_word8,
1316− testProperty "tb_hexadecimal_word16" tb_hexadecimal_word16,
1317− testProperty "tb_hexadecimal_word32" tb_hexadecimal_word32,
1318− testProperty "tb_hexadecimal_word64" tb_hexadecimal_word64
1319− ],
1320− testGroup "realfloat" [
1321− testProperty "tb_realfloat_double" tb_realfloat_double,
1322− testProperty "tb_realfloat_float" tb_realfloat_float,
1323− testProperty "tb_formatRealFloat_float" tb_formatRealFloat_float,
1324− testProperty "tb_formatRealFloat_double" tb_formatRealFloat_double
1325− ],
1326− testProperty "tb_fromText" tb_fromText,
1327− testProperty "tb_singleton" tb_singleton
1328 ],
1086 ],
1329
1087
1330 testGroup "read" [
1088 testGroup "read" [
@@ -1338,7 +1096,6 @@ tests =
1338 testProperty "tl_rational" tl_rational
1096 testProperty "tl_rational" tl_rational
1339 ],
1097 ],
1340
1098
1341− {-
1342 testGroup "input-output" [
1099 testGroup "input-output" [
1343 testProperty "t_write_read" t_write_read,
1100 testProperty "t_write_read" t_write_read,
1344 testProperty "tl_write_read" tl_write_read,
1101 testProperty "tl_write_read" tl_write_read,
@@ -1349,15 +1106,11 @@ tests =
1349 -- testProperty "t_put_get" t_put_get
1106 -- testProperty "t_put_get" t_put_get
1350 -- testProperty "tl_put_get" tl_put_get
1107 -- testProperty "tl_put_get" tl_put_get
1351 ],
1108 ],
1352− -}
1353
1109
1354 testGroup "lowlevel" [
1110 testGroup "lowlevel" [
1355 testProperty "t_dropWord16" t_dropWord16,
1111 testProperty "t_dropWord16" t_dropWord16,
1356 testProperty "t_takeWord16" t_takeWord16,
1112 testProperty "t_takeWord16" t_takeWord16,
1357 testProperty "t_take_drop_16" t_take_drop_16,
1113 testProperty "t_take_drop_16" t_take_drop_16,
1358− testProperty "t_use_from" t_use_from,
1114+ testProperty "t_use_from" t_use_from
1359− testProperty "t_copy" t_copy
1360− ],
1115+ ]
1361−
1362− testGroup "mul" Mul.tests
1363 ]
1116 ]
tests/Tests/QuickCheckUtils.hs → tests/tests/src/Data/Text/Tests/QuickCheckUtils.hsrenamed+88−111
@@ -1,100 +1,116 @@
1-- | This module provides quickcheck utilities, e.g. arbitrary and show
1-- | This module provides quickcheck utilities, e.g. arbitrary and show
2-- instances, and comparison functions, so we can focus on the actual properties
2-- instances, and comparison functions, so we can focus on the actual properties
3−-- in the 'Tests.Properties' module.
3+-- in the 'Data.Text.Tests.Properties' module.
4--
4--
5{-# LANGUAGE CPP, FlexibleInstances, TypeSynonymInstances #-}
5{-# LANGUAGE CPP, FlexibleInstances, TypeSynonymInstances #-}
6{-# OPTIONS_GHC -fno-warn-orphans #-}
6{-# OPTIONS_GHC -fno-warn-orphans #-}
7−module Tests.QuickCheckUtils
7+module Data.Text.Tests.QuickCheckUtils
8 (
8 (
9 genUnicode
9 genUnicode
10 , unsquare
10 , unsquare
11 , smallArbitrary
11 , smallArbitrary
12
12
13− , BigBounded(..)
14− , BigInt(..)
15− , NotEmpty(..)
13+ , NotEmpty (..)
16
14
17− , Small(..)
15+ , Small (..)
18 , small
16 , small
19
17
20− , Precision(..)
21− , precision
22−
23 , integralRandomR
18 , integralRandomR
24
19
25− , DecodeErr(..)
20+ , DecodeErr (..)
26− , genDecodeErr
27
21
28− , Stringy(..)
22+ , Stringy (..)
29 , eq
23 , eq
30 , eqP
24 , eqP
31
25
32− , Encoding(..)
26+ , Encoding (..)
33−
27+
34 , write_read
28 , write_read
35 ) where
29 ) where
36
30
37−import Control.Applicative ((<$>))
38import Control.Arrow (first, (***))
31import Control.Arrow (first, (***))
39import Control.DeepSeq (NFData (..), deepseq)
32import Control.DeepSeq (NFData (..), deepseq)
40import Control.Exception (bracket)
33import Control.Exception (bracket)
34+import Data.Bits ((.&.))
35+import Data.Char (chr)
36+import Data.Word (Word8, Word16)
41import Data.String (IsString, fromString)
37import Data.String (IsString, fromString)
42import Data.Text.Foreign (I16)
38import Data.Text.Foreign (I16)
43−import Data.Text.Lazy.Builder.RealFloat (FPFormat(..))
44−import Data.Word (Word8, Word16)
45import Debug.Trace (trace)
39import Debug.Trace (trace)
46−import System.Random (Random(..), RandomGen)
40+import System.Random (Random (..), RandomGen)
47−import Test.QuickCheck hiding (Fixed(..), Small (..), (.&.))
41+import Test.QuickCheck hiding ((.&.))
48import Test.QuickCheck.Monadic (assert, monadicIO, run)
42import Test.QuickCheck.Monadic (assert, monadicIO, run)
49−import Test.QuickCheck.Unicode (string)
50−import Tests.Utils
51import qualified Data.ByteString as B
43import qualified Data.ByteString as B
52import qualified Data.Text as T
44import qualified Data.Text as T
53import qualified Data.Text.Encoding.Error as T
45import qualified Data.Text.Encoding.Error as T
54−import qualified Data.Text.Internal.Fusion as TF
46+import qualified Data.Text.Fusion as TF
55−import qualified Data.Text.Internal.Fusion.Common as TF
47+import qualified Data.Text.Fusion.Common as TF
56−import qualified Data.Text.Internal.Lazy as TL
57−import qualified Data.Text.Internal.Lazy.Fusion as TLF
58import qualified Data.Text.Lazy as TL
48import qualified Data.Text.Lazy as TL
49+import qualified Data.Text.Lazy.Fusion as TLF
50+import qualified Data.Text.Lazy.Internal as TL
59import qualified System.IO as IO
51import qualified System.IO as IO
60
52
61−#if !MIN_VERSION_base(4,4,0)
62−import Data.Int (Int64)
53+import Data.Text.Tests.Utils
63−import Data.Word (Word, Word64)
64−#endif
65−
66−genUnicode :: IsString a => Gen a
67−genUnicode = fromString <$> string
68
54
69instance Random I16 where
55instance Random I16 where
70 randomR = integralRandomR
56 randomR = integralRandomR
71 random = randomR (minBound,maxBound)
57 random = randomR (minBound,maxBound)
72
58
73instance Arbitrary I16 where
59instance Arbitrary I16 where
74− arbitrary = arbitrarySizedIntegral
60+ arbitrary = choose (minBound,maxBound)
75− shrink = shrinkIntegral
76
61
77instance Arbitrary B.ByteString where
62instance Arbitrary B.ByteString where
78 arbitrary = B.pack `fmap` arbitrary
63 arbitrary = B.pack `fmap` arbitrary
79− shrink = map B.pack . shrink . B.unpack
80−
81−#if !MIN_VERSION_base(4,4,0)
82−instance Random Int64 where
83− randomR = integralRandomR
84− random = randomR (minBound,maxBound)
85−
86−instance Random Word where
87− randomR = integralRandomR
88− random = randomR (minBound,maxBound)
89
64
90−instance Random Word8 where
65+genUnicode :: IsString a => Gen a
91− randomR = integralRandomR
66+genUnicode = fmap fromString string where
92− random = randomR (minBound,maxBound)
67+ string = sized $ \n ->
93−
68+ do k <- choose (0,n)
94−instance Random Word64 where
69+ sequence [ char | _ <- [1..k] ]
95− randomR = integralRandomR
70+
96− random = randomR (minBound,maxBound)
71+ excluding :: [a -> Bool] -> Gen a -> Gen a
97−#endif
72+ excluding bad gen = loop
73+ where
74+ loop = do
75+ x <- gen
76+ if or (map ($ x) bad)
77+ then loop
78+ else return x
79+
80+ reserved = [lowSurrogate, highSurrogate, noncharacter]
81+ lowSurrogate c = c >= 0xDC00 && c <= 0xDFFF
82+ highSurrogate c = c >= 0xD800 && c <= 0xDBFF
83+ noncharacter c = masked == 0xFFFE || masked == 0xFFFF
84+ where
85+ masked = c .&. 0xFFFF
86+
87+ ascii = choose (0,0x7F)
88+ plane0 = choose (0xF0, 0xFFFF)
89+ plane1 = oneof [ choose (0x10000, 0x10FFF)
90+ , choose (0x11000, 0x11FFF)
91+ , choose (0x12000, 0x12FFF)
92+ , choose (0x13000, 0x13FFF)
93+ , choose (0x1D000, 0x1DFFF)
94+ , choose (0x1F000, 0x1FFFF)
95+ ]
96+ plane2 = oneof [ choose (0x20000, 0x20FFF)
97+ , choose (0x21000, 0x21FFF)
98+ , choose (0x22000, 0x22FFF)
99+ , choose (0x23000, 0x23FFF)
100+ , choose (0x24000, 0x24FFF)
101+ , choose (0x25000, 0x25FFF)
102+ , choose (0x26000, 0x26FFF)
103+ , choose (0x27000, 0x27FFF)
104+ , choose (0x28000, 0x28FFF)
105+ , choose (0x29000, 0x29FFF)
106+ , choose (0x2A000, 0x2AFFF)
107+ , choose (0x2B000, 0x2BFFF)
108+ , choose (0x2F000, 0x2FFFF)
109+ ]
110+ plane14 = choose (0xE0000, 0xE0FFF)
111+ planes = [ascii, plane0, plane1, plane2, plane14]
112+
113+ char = chr `fmap` excluding reserved (oneof planes)
98
114
99-- For tests that have O(n^2) running times or input sizes, resize
115-- For tests that have O(n^2) running times or input sizes, resize
100-- their inputs to the square root of the originals.
116-- their inputs to the square root of the originals.
@@ -107,25 +123,9 @@ smallArbitrary = sized $ \n -> resize (smallish n) arbitrary
107
123
108instance Arbitrary T.Text where
124instance Arbitrary T.Text where
109 arbitrary = T.pack `fmap` arbitrary
125 arbitrary = T.pack `fmap` arbitrary
110− shrink = map T.pack . shrink . T.unpack
111
126
112instance Arbitrary TL.Text where
127instance Arbitrary TL.Text where
113 arbitrary = (TL.fromChunks . map notEmpty) `fmap` smallArbitrary
128 arbitrary = (TL.fromChunks . map notEmpty) `fmap` smallArbitrary
114− shrink = map TL.pack . shrink . TL.unpack
115−
116−newtype BigInt = Big Integer
117− deriving (Eq, Show)
118−
119−instance Arbitrary BigInt where
120− arbitrary = choose (1::Int,200) >>= \e -> Big <$> choose (10^(e-1),10^e)
121− shrink (Big a) = [Big (a `div` 2^(l-e)) | e <- shrink l]
122− where l = truncate (log (fromIntegral a) / log 2 :: Double) :: Integer
123−
124−newtype BigBounded a = BigBounded a
125− deriving (Eq, Show)
126−
127−instance (Bounded a, Random a, Arbitrary a) => Arbitrary (BigBounded a) where
128− arbitrary = BigBounded <$> choose (minBound, maxBound)
129
129
130newtype NotEmpty a = NotEmpty { notEmpty :: a }
130newtype NotEmpty a = NotEmpty { notEmpty :: a }
131 deriving (Eq, Ord)
131 deriving (Eq, Ord)
@@ -138,23 +138,15 @@ instance Functor NotEmpty where
138
138
139instance Arbitrary a => Arbitrary (NotEmpty [a]) where
139instance Arbitrary a => Arbitrary (NotEmpty [a]) where
140 arbitrary = sized (\n -> NotEmpty `fmap` (choose (1,n+1) >>= vector))
140 arbitrary = sized (\n -> NotEmpty `fmap` (choose (1,n+1) >>= vector))
141− shrink = shrinkNotEmpty null
142
141
143instance Arbitrary (NotEmpty T.Text) where
142instance Arbitrary (NotEmpty T.Text) where
144 arbitrary = (fmap T.pack) `fmap` arbitrary
143 arbitrary = (fmap T.pack) `fmap` arbitrary
145− shrink = shrinkNotEmpty T.null
146
144
147instance Arbitrary (NotEmpty TL.Text) where
145instance Arbitrary (NotEmpty TL.Text) where
148 arbitrary = (fmap TL.pack) `fmap` arbitrary
146 arbitrary = (fmap TL.pack) `fmap` arbitrary
149− shrink = shrinkNotEmpty TL.null
150
147
151instance Arbitrary (NotEmpty B.ByteString) where
148instance Arbitrary (NotEmpty B.ByteString) where
152 arbitrary = (fmap B.pack) `fmap` arbitrary
149 arbitrary = (fmap B.pack) `fmap` arbitrary
153− shrink = shrinkNotEmpty B.null
154−
155−shrinkNotEmpty :: Arbitrary a => (a -> Bool) -> NotEmpty a -> [NotEmpty a]
156−shrinkNotEmpty isNull (NotEmpty xs) =
157− [ NotEmpty xs' | xs' <- shrink xs, not (isNull xs') ]
158
150
159data Small = S0 | S1 | S2 | S3 | S4 | S5 | S6 | S7
151data Small = S0 | S1 | S2 | S3 | S4 | S5 | S6 | S7
160 | S8 | S9 | S10 | S11 | S12 | S13 | S14 | S15
152 | S8 | S9 | S10 | S11 | S12 | S13 | S14 | S15
@@ -195,25 +187,23 @@ instance Random Small where
195 random = randomR (minBound,maxBound)
187 random = randomR (minBound,maxBound)
196
188
197instance Arbitrary Small where
189instance Arbitrary Small where
198− arbitrary = choose (minBound, maxBound)
190+ arbitrary = choose (minBound,maxBound)
199− shrink = shrinkIntegral
200
191
201integralRandomR :: (Integral a, RandomGen g) => (a,a) -> g -> (a,g)
192integralRandomR :: (Integral a, RandomGen g) => (a,a) -> g -> (a,g)
202integralRandomR (a,b) g = case randomR (fromIntegral a :: Integer,
193integralRandomR (a,b) g = case randomR (fromIntegral a :: Integer,
203 fromIntegral b :: Integer) g of
194 fromIntegral b :: Integer) g of
204 (x,h) -> (fromIntegral x, h)
195 (x,h) -> (fromIntegral x, h)
205
196
206−data DecodeErr = Lenient | Ignore | Strict | Replace
197+data DecodeErr = DE String T.OnDecodeError
207− deriving (Show, Eq)
208
198
209−genDecodeErr :: DecodeErr -> Gen T.OnDecodeError
199+instance Show DecodeErr where
210−genDecodeErr Lenient = return T.lenientDecode
200+ show (DE d _) = "DE " ++ d
211−genDecodeErr Ignore = return T.ignore
212−genDecodeErr Strict = return T.strictDecode
213−genDecodeErr Replace = arbitrary
214
201
215instance Arbitrary DecodeErr where
202instance Arbitrary DecodeErr where
216− arbitrary = elements [Lenient, Ignore, Strict, Replace]
203+ arbitrary = oneof [ return $ DE "lenient" T.lenientDecode
204+ , return $ DE "ignore" T.ignore
205+ , return $ DE "strict" T.strictDecode
206+ , DE "replace" `fmap` arbitrary ]
217
207
218class Stringy s where
208class Stringy s where
219 packS :: String -> s
209 packS :: String -> s
@@ -267,30 +257,6 @@ eqP f g s w = eql "orig" (f s) (g t) &&
267 | a =^= b = True
257 | a =^= b = True
268 | otherwise = trace (d ++ ": " ++ show a ++ " /= " ++ show b) False
258 | otherwise = trace (d ++ ": " ++ show a ++ " /= " ++ show b) False
269
259
270−instance Arbitrary FPFormat where
271− arbitrary = elements [Exponent, Fixed, Generic]
272−
273−newtype Precision a = Precision (Maybe Int)
274− deriving (Eq, Show)
275−
276−precision :: a -> Precision a -> Maybe Int
277−precision _ (Precision prec) = prec
278−
279−arbitraryPrecision :: Int -> Gen (Precision a)
280−arbitraryPrecision maxDigits = Precision <$> do
281− n <- choose (-1,maxDigits)
282− return $ if n == -1
283− then Nothing
284− else Just n
285−
286−instance Arbitrary (Precision Float) where
287− arbitrary = arbitraryPrecision 11
288− shrink = map Precision . shrink . precision undefined
289−
290−instance Arbitrary (Precision Double) where
291− arbitrary = arbitraryPrecision 22
292− shrink = map Precision . shrink . precision undefined
293−
294-- Work around lack of Show instance for TextEncoding.
260-- Work around lack of Show instance for TextEncoding.
295data Encoding = E String IO.TextEncoding
261data Encoding = E String IO.TextEncoding
296
262
@@ -308,6 +274,17 @@ windowsNewlineMode = IO.NewlineMode
308 { IO.inputNL = IO.CRLF, IO.outputNL = IO.CRLF
274 { IO.inputNL = IO.CRLF, IO.outputNL = IO.CRLF
309 }
275 }
310
276
277+-- Newline and NewlineMode have standard Show instance from GHC 7 onwards
278+#if __GLASGOW_HASKELL__ < 700
279+instance Show Newline where
280+ show CRLF = "CRLF"
281+ show LF = "LF"
282+
283+instance Show NewlineMode where
284+ show (NewlineMode i o) = "NewlineMode { inputNL = " ++ show i ++
285+ ", outputNL = " ++ show o ++ " }"
286+# endif
287+
311instance Arbitrary IO.NewlineMode where
288instance Arbitrary IO.NewlineMode where
312 arbitrary = oneof . map return $
289 arbitrary = oneof . map return $
313 [ IO.noNewlineTranslation, IO.universalNewlineMode, IO.nativeNewlineMode
290 [ IO.noNewlineTranslation, IO.universalNewlineMode, IO.nativeNewlineMode
@@ -343,7 +320,7 @@ write_read :: (NFData a, Eq a)
343 -> IO.BufferMode
320 -> IO.BufferMode
344 -> [a]
321 -> [a]
345 -> Property
322 -> Property
346−write_read unline filt writer reader (E _ _) nl buf ts =
323+write_read unline filt writer reader (E _ enc) nl buf ts =
347 monadicIO $ assert . (==t) =<< run act
324 monadicIO $ assert . (==t) =<< run act
348 where t = unline . map (filt (not . (`elem` "\r\n"))) $ ts
325 where t = unline . map (filt (not . (`elem` "\r\n"))) $ ts
349 act = withTempFile $ \path h -> do
326 act = withTempFile $ \path h -> do
tests/Tests/Regressions.hs → tests/tests/src/Data/Text/Tests/Regressions.hsrenamed+3−28
@@ -1,27 +1,24 @@
1-- | Regression tests for specific bugs.
1-- | Regression tests for specific bugs.
2--
2--
3{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}
3{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}
4−module Tests.Regressions
4+module Data.Text.Tests.Regressions
5 (
5 (
6 tests
6 tests
7 ) where
7 ) where
8
8
9import Control.Exception (SomeException, handle)
9import Control.Exception (SomeException, handle)
10import System.IO
10import System.IO
11−import Test.HUnit (assertBool, assertEqual, assertFailure)
11+import Test.HUnit (assertFailure)
12import qualified Data.ByteString as B
12import qualified Data.ByteString as B
13−import Data.ByteString.Char8 ()
14import qualified Data.ByteString.Lazy as LB
13import qualified Data.ByteString.Lazy as LB
15import qualified Data.Text as T
14import qualified Data.Text as T
16−import qualified Data.Text.Encoding as TE
17import qualified Data.Text.IO as T
15import qualified Data.Text.IO as T
18import qualified Data.Text.Lazy as LT
16import qualified Data.Text.Lazy as LT
19import qualified Data.Text.Lazy.Encoding as LE
17import qualified Data.Text.Lazy.Encoding as LE
20−import qualified Data.Text.Unsafe as T
21import qualified Test.Framework as F
18import qualified Test.Framework as F
22import qualified Test.Framework.Providers.HUnit as F
19import qualified Test.Framework.Providers.HUnit as F
23
20
24−import Tests.Utils (withTempFile)
21+import Data.Text.Tests.Utils (withTempFile)
25
22
26-- Reported by Michael Snoyman: UTF-8 encoding a large lazy bytestring
23-- Reported by Michael Snoyman: UTF-8 encoding a large lazy bytestring
27-- caused either a segfault or attempt to allocate a negative number
24-- caused either a segfault or attempt to allocate a negative number
@@ -52,31 +49,9 @@ replicate_crash = handle (\(_::SomeException) -> return ()) $
52 power | maxBound == (2147483647::Int) = 28
49 power | maxBound == (2147483647::Int) = 28
53 | otherwise = 60 :: Int
50 | otherwise = 60 :: Int
54
51
55−-- Reported by John Millikin: a UTF-8 decode error handler could
56−-- return a bogus substitution character, which we would write without
57−-- checking.
58−utf8_decode_unsafe :: IO ()
59−utf8_decode_unsafe = do
60− let t = TE.decodeUtf8With (\_ _ -> Just '\xdc00') "\x80"
61− assertBool "broken error recovery shouldn't break us" (t == "\xfffd")
62−
63−-- Reported by Eric Seidel: we mishandled mapping Chars that fit in a
64−-- single Word16 to Chars that require two.
65−mapAccumL_resize :: IO ()
66−mapAccumL_resize = do
67− let f a _ = (a, '\65536')
68− count = 5
69− val = T.mapAccumL f (0::Int) (T.replicate count "a")
70− assertEqual "mapAccumL should correctly fill buffers for two-word results"
71− (0, T.replicate count "\65536") val
72− assertEqual "mapAccumL should correctly size buffers for two-word results"
73− (count * 2) (T.lengthWord16 (snd val))
74−
75tests :: F.Test
52tests :: F.Test
76tests = F.testGroup "Regressions"
53tests = F.testGroup "Regressions"
77 [ F.testCase "hGetContents_crash" hGetContents_crash
54 [ F.testCase "hGetContents_crash" hGetContents_crash
78 , F.testCase "lazy_encode_crash" lazy_encode_crash
55 , F.testCase "lazy_encode_crash" lazy_encode_crash
79− , F.testCase "mapAccumL_resize" mapAccumL_resize
80 , F.testCase "replicate_crash" replicate_crash
56 , F.testCase "replicate_crash" replicate_crash
81− , F.testCase "utf8_decode_unsafe" utf8_decode_unsafe
82 ]
57 ]
tests/Tests/SlowFunctions.hs → tests/tests/src/Data/Text/Tests/SlowFunctions.hsrenamed+1−1
@@ -1,5 +1,5 @@
1{-# LANGUAGE BangPatterns #-}
1{-# LANGUAGE BangPatterns #-}
2−module Tests.SlowFunctions
2+module Data.Text.Tests.SlowFunctions
3 (
3 (
4 indices
4 indices
5 , splitOn
5 , splitOn
tests/Tests/Utils.hs → tests/tests/src/Data/Text/Tests/Utils.hsrenamed+1−1
@@ -1,7 +1,7 @@
1-- | Miscellaneous testing utilities
1-- | Miscellaneous testing utilities
2--
2--
3{-# LANGUAGE ScopedTypeVariables #-}
3{-# LANGUAGE ScopedTypeVariables #-}
4−module Tests.Utils
4+module Data.Text.Tests.Utils
5 (
5 (
6 (=^=)
6 (=^=)
7 , withRedirect
7 , withRedirect
tests/tests/text-tests.cabalnew file+124
@@ -0,0 +1,124 @@
1+name: text-tests
2+version: 0.0.0.0
3+synopsis: Functional tests for the text package
4+description: Functional tests for the text package
5+homepage: https://bitbucket.org/bos/text
6+license: BSD3
7+license-file: ../../LICENSE
8+author: Jasper Van der Jeugt <jaspervdj@gmail.com>,
9+ Bryan O'Sullivan <bos@serpentine.com>,
10+ Tom Harper <rtomharper@googlemail.com>,
11+ Duncan Coutts <duncan@haskell.org>
12+maintainer: Bryan O'Sullivan <bos@serpentine.com>
13+category: Text
14+build-type: Simple
15+
16+cabal-version: >=1.8
17+
18+flag hpc
19+ description: Enable HPC to generate coverage reports
20+ default: False
21+
22+executable text-tests
23+ hs-source-dirs: src
24+ main-is: Data/Text/Tests.hs
25+
26+ ghc-options:
27+ -Wall -threaded -O0 -rtsopts
28+
29+ if flag(hpc)
30+ ghc-options:
31+ -fhpc
32+
33+ cpp-options:
34+ -DASSERTS
35+ -DHAVE_DEEPSEQ
36+
37+ build-depends:
38+ text-tests,
39+ base >= 4 && < 5,
40+ bytestring >= 0.9 && < 0.10,
41+ deepseq >= 1.1 && < 1.2,
42+ directory >= 1.1 && < 1.2,
43+ random >= 1.0 && < 1.1,
44+ QuickCheck >= 2.4 && < 2.5,
45+ HUnit >= 1.2 && < 1.3,
46+ test-framework >= 0.4 && < 0.5,
47+ test-framework-quickcheck2 >= 0.2 && < 0.3,
48+ test-framework-hunit >= 0.2 && < 0.3
49+
50+executable text-tests-stdio
51+ hs-source-dirs: src
52+ main-is: Data/Text/Tests/IO.hs
53+
54+ ghc-options:
55+ -Wall -threaded -rtsopts
56+
57+ -- Optional HPC support
58+ if flag(hpc)
59+ ghc-options:
60+ -fhpc
61+
62+ build-depends:
63+ text-tests,
64+ base >= 4 && < 5
65+
66+library
67+ hs-source-dirs: ../..
68+ c-sources: ../../cbits/cbits.c
69+ exposed-modules:
70+ Data.Text
71+ Data.Text.Array
72+ Data.Text.Encoding
73+ Data.Text.Encoding.Error
74+ Data.Text.Foreign
75+ Data.Text.IO
76+ Data.Text.Internal
77+ Data.Text.Lazy
78+ Data.Text.Lazy.Builder
79+ Data.Text.Lazy.Builder.Int
80+ Data.Text.Lazy.Builder.RealFloat
81+ Data.Text.Lazy.Encoding
82+ Data.Text.Lazy.IO
83+ Data.Text.Lazy.Internal
84+ Data.Text.Lazy.Read
85+ Data.Text.Read
86+ Data.Text.Encoding.Fusion
87+ Data.Text.Encoding.Fusion.Common
88+ Data.Text.Encoding.Utf16
89+ Data.Text.Encoding.Utf32
90+ Data.Text.Encoding.Utf8
91+ Data.Text.Fusion
92+ Data.Text.Fusion.CaseMapping
93+ Data.Text.Fusion.Common
94+ Data.Text.Fusion.Internal
95+ Data.Text.Fusion.Size
96+ Data.Text.IO.Internal
97+ Data.Text.Lazy.Builder.Functions
98+ Data.Text.Lazy.Builder.RealFloat.Functions
99+ Data.Text.Lazy.Encoding.Fusion
100+ Data.Text.Lazy.Fusion
101+ Data.Text.Lazy.Search
102+ Data.Text.Search
103+ Data.Text.Unsafe
104+ Data.Text.Unsafe.Base
105+ Data.Text.UnsafeChar
106+ Data.Text.UnsafeShift
107+ Data.Text.Util
108+
109+ if flag(hpc)
110+ ghc-options:
111+ -fhpc
112+
113+ cpp-options:
114+ -DHAVE_DEEPSEQ
115+ -DASSERTS
116+ -DINTEGER_GMP
117+
118+ build-depends:
119+ array,
120+ base >= 4 && < 5,
121+ bytestring >= 0.9 && < 1.0,
122+ deepseq >= 1.1 && < 1.2,
123+ integer-gmp >= 0.2 && < 0.3,
124+ ghc-prim >= 0.2 && < 0.3
tests/text-tests.cabaldeleted−143
@@ -1,143 +0,0 @@
1−name: text-tests
2−version: 0.0.0.0
3−synopsis: Functional tests for the text package
4−description: Functional tests for the text package
5−homepage: https://github.com/bos/text
6−license: BSD2
7−license-file: ../LICENSE
8−author: Jasper Van der Jeugt <jaspervdj@gmail.com>,
9− Bryan O'Sullivan <bos@serpentine.com>,
10− Tom Harper <rtomharper@googlemail.com>,
11− Duncan Coutts <duncan@haskell.org>
12−maintainer: Bryan O'Sullivan <bos@serpentine.com>
13−category: Text
14−build-type: Simple
15−
16−cabal-version: >=1.8
17−
18−flag hpc
19− description: Enable HPC to generate coverage reports
20− default: False
21− manual: True
22−
23−executable text-tests
24− main-is: Tests.hs
25−
26− other-modules:
27− Tests.IO
28− Tests.Properties
29− Tests.Properties.Mul
30− Tests.QuickCheckUtils
31− Tests.Regressions
32− Tests.SlowFunctions
33− Tests.Utils
34−
35− ghc-options:
36− -Wall -threaded -O0 -rtsopts
37−
38− if flag(hpc)
39− ghc-options:
40− -fhpc
41−
42− cpp-options:
43− -DTEST_SUITE
44− -DASSERTS
45− -DHAVE_DEEPSEQ
46−
47− build-depends:
48− HUnit >= 1.2,
49− QuickCheck >= 2.7,
50− base == 4.*,
51− bytestring,
52− deepseq,
53− directory,
54− quickcheck-unicode,
55− random,
56− test-framework >= 0.4,
57− test-framework-hunit >= 0.2,
58− test-framework-quickcheck2 >= 0.2,
59− text-tests
60−
61−executable text-tests-stdio
62− main-is: Tests/IO.hs
63−
64− ghc-options:
65− -Wall -threaded -rtsopts
66−
67− -- Optional HPC support
68− if flag(hpc)
69− ghc-options:
70− -fhpc
71−
72− build-depends:
73− text-tests,
74− base >= 4 && < 5
75−
76−library
77− hs-source-dirs: ..
78− c-sources: ../cbits/cbits.c
79− include-dirs: ../include
80− ghc-options: -Wall
81− exposed-modules:
82− Data.Text
83− Data.Text.Array
84− Data.Text.Encoding
85− Data.Text.Encoding.Error
86− Data.Text.Internal.Encoding.Fusion
87− Data.Text.Internal.Encoding.Fusion.Common
88− Data.Text.Internal.Encoding.Utf16
89− Data.Text.Internal.Encoding.Utf32
90− Data.Text.Internal.Encoding.Utf8
91− Data.Text.Foreign
92− Data.Text.Internal.Fusion
93− Data.Text.Internal.Fusion.CaseMapping
94− Data.Text.Internal.Fusion.Common
95− Data.Text.Internal.Fusion.Size
96− Data.Text.Internal.Fusion.Types
97− Data.Text.IO
98− Data.Text.Internal.IO
99− Data.Text.Internal
100− Data.Text.Lazy
101− Data.Text.Lazy.Builder
102− Data.Text.Internal.Builder.Functions
103− Data.Text.Lazy.Builder.Int
104− Data.Text.Internal.Builder.Int.Digits
105− Data.Text.Internal.Builder
106− Data.Text.Lazy.Builder.RealFloat
107− Data.Text.Internal.Builder.RealFloat.Functions
108− Data.Text.Lazy.Encoding
109− Data.Text.Internal.Lazy.Encoding.Fusion
110− Data.Text.Internal.Lazy.Fusion
111− Data.Text.Lazy.IO
112− Data.Text.Internal.Lazy
113− Data.Text.Lazy.Read
114− Data.Text.Internal.Lazy.Search
115− Data.Text.Internal.Private
116− Data.Text.Read
117− Data.Text.Show
118− Data.Text.Internal.Read
119− Data.Text.Internal.Search
120− Data.Text.Unsafe
121− Data.Text.Internal.Unsafe
122− Data.Text.Internal.Unsafe.Char
123− Data.Text.Internal.Unsafe.Shift
124− Data.Text.Internal.Functions
125−
126− if flag(hpc)
127− ghc-options:
128− -fhpc
129−
130− cpp-options:
131− -DTEST_SUITE
132− -DHAVE_DEEPSEQ
133− -DASSERTS
134− -DINTEGER_GMP
135−
136− build-depends:
137− array,
138− base == 4.*,
139− binary,
140− bytestring,
141− deepseq,
142− ghc-prim,
143− integer-gmp
text.cabal+66−129
@@ -1,9 +1,9 @@
1name: text
1name: text
2−version: 1.2.2.1
2+version: 0.11.1.2
3−homepage: https://github.com/bos/text
3+homepage: https://bitbucket.org/bos/text
4−bug-reports: https://github.com/bos/text/issues
4+bug-reports: https://bitbucket.org/bos/text/issues
5synopsis: An efficient packed Unicode text type.
5synopsis: An efficient packed Unicode text type.
6−description:
6+description:
7 .
7 .
8 An efficient packed, immutable Unicode text type (both strict and
8 An efficient packed, immutable Unicode text type (both strict and
9 lazy), with a powerful loop fusion optimization framework.
9 lazy), with a powerful loop fusion optimization framework.
@@ -30,58 +30,42 @@ description:
30 non-standard encodings, text breaking, and locales), see
30 non-standard encodings, text breaking, and locales), see
31 the @text-icu@ package:
31 the @text-icu@ package:
32 <http://hackage.haskell.org/package/text-icu>
32 <http://hackage.haskell.org/package/text-icu>
33−
33+ .
34−license: BSD2
34+license: BSD3
35license-file: LICENSE
35license-file: LICENSE
36author: Bryan O'Sullivan <bos@serpentine.com>
36author: Bryan O'Sullivan <bos@serpentine.com>
37maintainer: Bryan O'Sullivan <bos@serpentine.com>
37maintainer: Bryan O'Sullivan <bos@serpentine.com>
38+ Tom Harper <rtomharper@googlemail.com>
39+ Duncan Coutts <duncan@haskell.org>
38copyright: 2009-2011 Bryan O'Sullivan, 2008-2009 Tom Harper
40copyright: 2009-2011 Bryan O'Sullivan, 2008-2009 Tom Harper
39category: Data, Text
41category: Data, Text
40build-type: Simple
42build-type: Simple
41−cabal-version: >= 1.8
43+cabal-version: >= 1.6
42extra-source-files:
44extra-source-files:
45+ README.markdown
43 -- scripts/CaseFolding.txt
46 -- scripts/CaseFolding.txt
44 -- scripts/SpecialCasing.txt
47 -- scripts/SpecialCasing.txt
45− README.markdown
46− benchmarks/Setup.hs
47− benchmarks/cbits/*.c
48− benchmarks/haskell/*.hs
49− benchmarks/haskell/Benchmarks/*.hs
50− benchmarks/haskell/Benchmarks/Programs/*.hs
51− benchmarks/python/*.py
52− benchmarks/ruby/*.rb
53− benchmarks/text-benchmarks.cabal
54− changelog.md
55− include/*.h
56 scripts/*.hs
48 scripts/*.hs
57− tests-and-benchmarks.markdown
49+ tests/README.markdown
58− tests/*.hs
50+ tests/benchmarks/Setup.hs
59− tests/.ghci
51+ tests/benchmarks/python/*.py
52+ tests/benchmarks/ruby/*.rb
53+ tests/benchmarks/src/Data/Text/*.hs
54+ tests/benchmarks/src/Data/Text/Benchmarks/*.hs
55+ tests/benchmarks/text-benchmarks.cabal
56+ tests/tests/.ghci
60− tests/Makefile
57+ tests/tests/Makefile
61− tests/Tests/*.hs
62− tests/Tests/Properties/*.hs
63− tests/cabal.config
64− tests/scripts/*.sh
58+ tests/tests/scripts/*.sh
65− tests/text-tests.cabal
59+ tests/tests/src/Data/Text/*.hs
66−
60+ tests/tests/src/Data/Text/Tests/*.hs
67−flag bytestring-builder
61+ tests/tests/text-tests.cabal
68− description: Depend on the bytestring-builder package for backwards compatibility.
69− default: False
70− manual: False
71
62
72flag developer
63flag developer
73 description: operate in developer mode
64 description: operate in developer mode
74 default: False
65 default: False
75− manual: True
76−
77−flag integer-simple
78− description: Use the simple integer library instead of GMP
79− default: False
80− manual: False
81
66
82library
67library
83− c-sources: cbits/cbits.c
68+ c-sources: cbits/cbits.c
84− include-dirs: include
85
69
86 exposed-modules:
70 exposed-modules:
87 Data.Text
71 Data.Text
@@ -91,32 +75,6 @@ library
91 Data.Text.Foreign
75 Data.Text.Foreign
92 Data.Text.IO
76 Data.Text.IO
93 Data.Text.Internal
77 Data.Text.Internal
94− Data.Text.Internal.Builder
95− Data.Text.Internal.Builder.Functions
96− Data.Text.Internal.Builder.Int.Digits
97− Data.Text.Internal.Builder.RealFloat.Functions
98− Data.Text.Internal.Encoding.Fusion
99− Data.Text.Internal.Encoding.Fusion.Common
100− Data.Text.Internal.Encoding.Utf16
101− Data.Text.Internal.Encoding.Utf32
102− Data.Text.Internal.Encoding.Utf8
103− Data.Text.Internal.Functions
104− Data.Text.Internal.Fusion
105− Data.Text.Internal.Fusion.CaseMapping
106− Data.Text.Internal.Fusion.Common
107− Data.Text.Internal.Fusion.Size
108− Data.Text.Internal.Fusion.Types
109− Data.Text.Internal.IO
110− Data.Text.Internal.Lazy
111− Data.Text.Internal.Lazy.Encoding.Fusion
112− Data.Text.Internal.Lazy.Fusion
113− Data.Text.Internal.Lazy.Search
114− Data.Text.Internal.Private
115− Data.Text.Internal.Read
116− Data.Text.Internal.Search
117− Data.Text.Internal.Unsafe
118− Data.Text.Internal.Unsafe.Char
119− Data.Text.Internal.Unsafe.Shift
120 Data.Text.Lazy
78 Data.Text.Lazy
121 Data.Text.Lazy.Builder
79 Data.Text.Lazy.Builder
122 Data.Text.Lazy.Builder.Int
80 Data.Text.Lazy.Builder.Int
@@ -126,83 +84,62 @@ library
126 Data.Text.Lazy.Internal
84 Data.Text.Lazy.Internal
127 Data.Text.Lazy.Read
85 Data.Text.Lazy.Read
128 Data.Text.Read
86 Data.Text.Read
129− Data.Text.Unsafe
130−
131 other-modules:
87 other-modules:
132− Data.Text.Show
88+ Data.Text.Encoding.Fusion
89+ Data.Text.Encoding.Fusion.Common
90+ Data.Text.Encoding.Utf16
91+ Data.Text.Encoding.Utf32
92+ Data.Text.Encoding.Utf8
93+ Data.Text.Fusion
94+ Data.Text.Fusion.CaseMapping
95+ Data.Text.Fusion.Common
96+ Data.Text.Fusion.Internal
97+ Data.Text.Fusion.Size
98+ Data.Text.IO.Internal
99+ Data.Text.Lazy.Builder.Functions
100+ Data.Text.Lazy.Builder.RealFloat.Functions
101+ Data.Text.Lazy.Encoding.Fusion
102+ Data.Text.Lazy.Fusion
103+ Data.Text.Lazy.Search
104+ Data.Text.Search
105+ Data.Text.Unsafe
106+ Data.Text.Unsafe.Base
107+ Data.Text.UnsafeChar
108+ Data.Text.UnsafeShift
109+ Data.Text.Util
133
110
134 build-depends:
111 build-depends:
135− array >= 0.3,
112+ array,
136− base >= 4.2 && < 5,
113+ base < 5,
137− binary,
114+ bytestring >= 0.9 && < 1.0
138− deepseq >= 1.1.0.0,
115+ if impl(ghc >= 6.10)
139− ghc-prim >= 0.2
140−
141− if flag(bytestring-builder)
142− build-depends: bytestring >= 0.9 && < 0.10.4,
116+ build-depends:
143− bytestring-builder >= 0.10.4
117+ ghc-prim, base >= 4, deepseq >= 1.1.0.0
118+ cpp-options: -DHAVE_DEEPSEQ
144 else
119 else
145− build-depends: bytestring >= 0.10.4
120+ build-depends: extensible-exceptions
121+ extensions: PatternSignatures
146
122
147− cpp-options: -DHAVE_DEEPSEQ
148− ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2
123+ ghc-options: -Wall -funbox-strict-fields -O2
124+ if impl(ghc >= 6.8)
125+ ghc-options: -fwarn-tabs
149 if flag(developer)
126 if flag(developer)
150 ghc-prof-options: -auto-all
127 ghc-prof-options: -auto-all
151 ghc-options: -Werror
128 ghc-options: -Werror
152 cpp-options: -DASSERTS
129 cpp-options: -DASSERTS
153
130
154− if flag(integer-simple)
131+ if impl(ghc >= 6.11)
155− cpp-options: -DINTEGER_SIMPLE
156− build-depends: integer-simple >= 0.1 && < 0.5
157− else
158 cpp-options: -DINTEGER_GMP
132 cpp-options: -DINTEGER_GMP
159− build-depends: integer-gmp >= 0.2
133+ build-depends: integer-gmp >= 0.2 && < 0.3
160−
161−test-suite tests
162− type: exitcode-stdio-1.0
163− hs-source-dirs: tests .
164− main-is: Tests.hs
165− c-sources: cbits/cbits.c
166− include-dirs: include
167−
168− ghc-options:
169− -Wall -threaded -O0 -rtsopts
170
134
171− cpp-options:
135+ if impl(ghc >= 6.9) && impl(ghc < 6.11)
172− -DASSERTS -DHAVE_DEEPSEQ -DTEST_SUITE
173−
174− build-depends:
175− HUnit >= 1.2,
176− QuickCheck >= 2.7,
177− array,
178− base,
179− binary,
180− deepseq,
181− directory,
182− ghc-prim,
183− quickcheck-unicode,
184− random,
185− test-framework >= 0.4,
186− test-framework-hunit >= 0.2,
187− test-framework-quickcheck2 >= 0.2
188−
189− if flag(bytestring-builder)
190− build-depends: bytestring >= 0.9 && < 0.10.4,
191− bytestring-builder >= 0.10.4
192− else
193− build-depends: bytestring >= 0.10.4
194−
195− if flag(integer-simple)
196− cpp-options: -DINTEGER_SIMPLE
197− build-depends: integer-simple >= 0.1 && < 0.5
198− else
199 cpp-options: -DINTEGER_GMP
136 cpp-options: -DINTEGER_GMP
200− build-depends: integer-gmp >= 0.2
137+ build-depends: integer >= 0.1 && < 0.2
201−
202−source-repository head
203− type: git
204− location: https://github.com/bos/text
205
138
206source-repository head
139source-repository head
207 type: mercurial
140 type: mercurial
208 location: https://bitbucket.org/bos/text
141 location: https://bitbucket.org/bos/text
142+
143+source-repository head
144+ type: git
145+ location: https://github.com/bos/text