on a8e021c help sign in
.gitignoredeleted−3
since splitsnapshots
unifiedsplit
@@ -1,3 +0,0 @@
1−dist
2−cabal-dev
3−cabal.sandbox.config
.hgignoredeleted−14
@@ -1,14 +0,0 @@
1−^(?:dist|benchmarks/dist|tests/coverage|tests/dist)$
2−^benchmarks/.*\.txt$
3−^tests/text-testdata.tar.bz2$
4−^tests/(?:\.hpc|bm|qc|qc-hpc|stdio-hpc|text/test)$
5−\.(?:aux|eventlog|h[ip]|log|[oa]|orig|prof|ps|rej|swp|tix)$
6−~$
7−
8−syntax: glob
9−.\#*
10−cabal-dev
11−cabal.sandbox.config
12−\.cabal-sandbox
13−scripts/CaseFolding.txt
14−scripts/SpecialCasing.txt
.hgtagsdeleted−66
@@ -1,66 +0,0 @@
1−0edd5dc96024e6c0f56f175ffa673f9178cece8c 0.9.0.0
2−1de0da99d31ba212e179d88957cf5f3b9c4facd7 0.7.0.1
3−30575507578cf04b5b1501ee23b1faa83315eb88 0.1
4−321e61f17630dbd346c1c9991831572f964b7d5a 0.4
5−34cef27f87287cd3c17d78ac99e9de2d6c8a1200 0.6
6−3cbff6d9bca135a85e428a7f6c4e15739a562b8b 0.7.1.0
7−587c8661393f83cb2b9452f6cc1d6885e52fe544 0.8.1.0
8−61c322bd5b6446255870422f854266396169a7e5 0.5
9−9adb5edd9b6407335e8772ea86036b938471fc89 0.2
10−b4fdbef1c1027a70b95c1a81747d968890acc3f6 0.3
11−de7cb0cb2a72606126c357b860bb0dbf7f145ad2 0.9.0.1
12−f2c9b1c019e3277926378d7b5a604f1c995f0202 0.7
13−f3d625f2d0730cb6adf8506a1f37762178c9aea6 0.10.0.0
14−99ea36957b1d47145d70f2ee8b13f1ddfd09245c 0.10.0.1
15−1b7889216e78b00d69b32c48782111bcd935978d 0.10.0.2
16−75157eaec6eb38574ad5c347e75c48dcb7262dee 0.11.0.0
17−0d7bc7bd77ec5a8f6d064de59d459e5eaf906b0f 0.11.0.1
18−a9d582a75dea9a4417883019d5110a35e4c07265 0.11.0.2
19−36b2a3aa661892ea25101199220383ba6d579abb 0.11.0.3
20−06e407bcdc9a3905abf9551062ecc6f92abcdde5 0.11.0.4
21−94bcf16e812f6fb49b87598673e17270f48c2bf1 0.11.0.5
22−784a32ffbec0b77adb43e9a64328db0482007309 0.11.0.6
23−c808123a3d37f25004d2aad8f3a395acfcf9122f 0.11.0.7
24−679826e742b239c5dd0c1fa4ebe98aa4bfe02a00 0.11.0.8
25−b49eebfa5673da89a23939d523c9de9edbd410b0 0.11.1.0
26−9c820a2ecaea01bc614d8e6bccf90e57431bdcbb 0.11.1.1
27−ed3a60ec627af6ba8af321009aa00224b3296e47 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+301−707
@@ -1,48 +1,29 @@
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) Tom Harper 2008-2009,
12−-- Copyright : (c) 2009, 2010, 2011, 2012 Bryan O'Sullivan,
7+-- (c) Bryan O'Sullivan 2009,
13−-- (c) 2009 Duncan Coutts,
8+-- (c) Duncan Coutts 2009
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--
21−-- A time and space-efficient implementation of Unicode text.
16+-- A time and space-efficient implementation of Unicode text using
22−-- Suitable for performance critical use, both in terms of large data
17+-- packed Word16 arrays. Suitable for performance critical use, both
23−-- quantities and high speed.
18+-- in terms of large data quantities and high speed.
24−--
25−-- /Note/: Read below the synopsis for important notes on the use of
26−-- this module.
27--
19--
28-- This module is intended to be imported @qualified@, to avoid name
20-- This module is intended to be imported @qualified@, to avoid name
29-- clashes with "Prelude" functions, e.g.
21-- clashes with "Prelude" functions, e.g.
30--
22--
31-- > import qualified Data.Text as T
23-- > import qualified Data.Text as T
32−--
33−-- To use an extended and very rich family of functions for working
34−-- with Unicode text (including normalization, regular expressions,
35−-- non-standard encodings, text breaking, and locales), see
36−-- <http://hackage.haskell.org/package/text-icu the text-icu package >.
37
24
38module Data.Text
25module Data.Text
39 (
26 (
40− -- * Strict vs lazy types
41− -- $strict
42−
43− -- * Acceptable data
44− -- $replacement
45−
46 -- * Fusion
27 -- * Fusion
47 -- $fusion
28 -- $fusion
48
29
@@ -66,7 +47,6 @@ module Data.Text
66 , init
47 , init
67 , null
48 , null
68 , length
49 , length
69− , compareLength
70
50
71 -- * Transformations
51 -- * Transformations
72 , map
52 , map
@@ -81,7 +61,6 @@ module Data.Text
81 , toCaseFold
61 , toCaseFold
82 , toLower
62 , toLower
83 , toUpper
63 , toUpper
84− , toTitle
85
64
86 -- ** Justification
65 -- ** Justification
87 , justifyLeft
66 , justifyLeft
@@ -125,11 +104,8 @@ module Data.Text
125
104
126 -- ** Breaking strings
105 -- ** Breaking strings
127 , take
106 , take
128− , takeEnd
129 , drop
107 , drop
130− , dropEnd
131 , takeWhile
108 , takeWhile
132− , takeWhileEnd
133 , dropWhile
109 , dropWhile
134 , dropWhileEnd
110 , dropWhileEnd
135 , dropAround
111 , dropAround
@@ -137,10 +113,10 @@ module Data.Text
137 , stripStart
113 , stripStart
138 , stripEnd
114 , stripEnd
139 , splitAt
115 , splitAt
140− , breakOn
116+ , spanBy
141− , breakOnEnd
142 , break
117 , break
143− , span
118+ , breakEnd
119+ , breakBy
144 , group
120 , group
145 , groupBy
121 , groupBy
146 , inits
122 , inits
@@ -148,8 +124,8 @@ module Data.Text
148
124
149 -- ** Breaking into many substrings
125 -- ** Breaking into many substrings
150 -- $split
126 -- $split
151− , splitOn
152 , split
127 , split
128+ , splitBy
153 , chunksOf
129 , chunksOf
154
130
155 -- ** Breaking into lines and words
131 -- ** Breaking into lines and words
@@ -165,308 +141,166 @@ module Data.Text
165 , isInfixOf
141 , isInfixOf
166
142
167 -- ** View patterns
143 -- ** View patterns
168− , stripPrefix
144+ , prefixed
169− , stripSuffix
145+ , suffixed
170− , commonPrefixes
171
146
172 -- * Searching
147 -- * Searching
173 , filter
148 , filter
174− , breakOnAll
175 , find
149 , find
176− , partition
150+ , findBy
151+ , partitionBy
177
152
178 -- , findSubstring
153 -- , findSubstring
179−
154+
180 -- * Indexing
155 -- * Indexing
181 -- $index
156 -- $index
182 , index
157 , index
183 , findIndex
158 , findIndex
184 , count
159 , count
185
160
186− -- * Zipping
161+ -- * Zipping and unzipping
187 , zip
162 , zip
188 , zipWith
163 , zipWith
189
164
190 -- -* Ordered text
165 -- -* Ordered text
191 -- , sort
166 -- , sort
192−
193− -- * Low level operations
194− , copy
195− , unpackCString#
196 ) where
167 ) where
197
168
198−import Prelude (Char, Bool(..), Int, Maybe(..), String,
169+import Prelude (Char, Bool(..), Functor(..), Int, Maybe(..), String,
199− Eq(..), Ord(..), Ordering(..), (++),
170+ Eq(..), Ord(..), (++),
200− Read(..),
171+ Read(..), Show(..),
201− (&&), (||), (+), (-), (.), ($), ($!), (>>),
172+ (&&), (||), (+), (-), (.), ($), ($!), (>>), (*),
202− not, return, otherwise, quot)
173+ div, error, not, return, otherwise)
203#if defined(HAVE_DEEPSEQ)
174#if defined(HAVE_DEEPSEQ)
204−import Control.DeepSeq (NFData(rnf))
175+import Control.DeepSeq (NFData)
205#endif
176#endif
206#if defined(ASSERTS)
177#if defined(ASSERTS)
207import Control.Exception (assert)
178import Control.Exception (assert)
208#endif
179#endif
209import Data.Char (isSpace)
180import Data.Char (isSpace)
210−import Data.Data (Data(gfoldl, toConstr, gunfold, dataTypeOf), constrIndex,
181+import Data.Data (Data(gfoldl, toConstr, gunfold, dataTypeOf))
211− Constr, mkConstr, DataType, mkDataType, Fixity(Prefix))
182+#if __GLASGOW_HASKELL__ >= 612
183+import Data.Data (mkNoRepType)
184+#else
185+import Data.Data (mkNorepType)
186+#endif
212import Control.Monad (foldM)
187import Control.Monad (foldM)
213import Control.Monad.ST (ST)
188import Control.Monad.ST (ST)
214import qualified Data.Text.Array as A
189import qualified Data.Text.Array as A
215import qualified Data.List as L
190import qualified Data.List as L
216−import Data.Binary (Binary(get, put))
217import Data.Monoid (Monoid(..))
191import Data.Monoid (Monoid(..))
218−#if MIN_VERSION_base(4,9,0)
219−import Data.Semigroup (Semigroup(..))
220−#endif
221import Data.String (IsString(..))
192import Data.String (IsString(..))
222−import qualified Data.Text.Internal.Fusion as S
193+import qualified Data.Text.Fusion as S
223−import qualified Data.Text.Internal.Fusion.Common as S
194+import qualified Data.Text.Fusion.Common as S
224−import Data.Text.Encoding (decodeUtf8', encodeUtf8)
225−import Data.Text.Internal.Fusion (stream, reverseStream, unstream)
195+import Data.Text.Fusion (stream, reverseStream, unstream)
226−import Data.Text.Internal.Private (span_)
196+import Data.Text.Internal (Text(..), empty, 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
197import qualified Prelude as P
230−import Data.Text.Unsafe (Iter(..), iter, iter_, lengthWord16, reverseIter,
198+import Data.Text.Unsafe (iter, iter_, reverseIter, unsafeHead, unsafeTail)
231− reverseIter_, unsafeHead, unsafeTail)
232−import Data.Text.Internal.Unsafe.Char (unsafeChr)
199+import Data.Text.UnsafeChar (unsafeChr)
233−import qualified Data.Text.Internal.Functions as F
200+import qualified Data.Text.Encoding.Utf16 as U16
234−import qualified Data.Text.Internal.Encoding.Utf16 as U16
235−import Data.Text.Internal.Search (indices)
201+import Data.Text.Search (indices)
236−#if defined(__HADDOCK__)
237−import Data.ByteString (ByteString)
238−import qualified Data.Text.Lazy as L
239−import Data.Int (Int64)
240−#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−
249−-- $strict
250−--
251−-- This package provides both strict and lazy 'Text' types. The
252−-- strict type is provided by the "Data.Text" module, while the lazy
253−-- type is provided by the "Data.Text.Lazy" module. Internally, the
254−-- lazy @Text@ type consists of a list of strict chunks.
255−--
256−-- 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
258−-- streaming strings that are larger than memory using a small memory
259−-- footprint. In many cases, the overhead of chunked streaming makes
260−-- the lazy 'Data.Text.Lazy.Text' type slower than its strict
261−-- counterpart, but this is not always the case. Sometimes, the time
262−-- complexity of a function in one module may be different from the
263−-- other, due to their differing internal structures.
264−--
265−-- Each module provides an almost identical API, with the main
266−-- difference being that the strict module uses 'Int' values for
267−-- lengths and counts, while the lazy module uses 'Data.Int.Int64'
268−-- lengths.
269−
270−-- $replacement
271−--
272−-- 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 >.
275−-- As such, a 'Text' cannot contain values in the range U+D800 to
276−-- U+DFFF inclusive. Haskell implementations admit all Unicode code
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.
280−-- This means that there are some 'Char' values that are not valid
281−-- Unicode scalar values, and the functions in this module must handle
282−-- those cases.
283−--
284−-- Within this module, many functions construct a 'Text' from one or
285−-- more 'Char' values. Those functions will substitute 'Char' values
286−-- that are not valid Unicode scalar values with the replacement
287−-- character \"&#xfffd;\" (U+FFFD). Functions that perform this
288−-- inspection and replacement are documented with the phrase
289−-- \"Performs replacement on invalid scalar values\".
290−--
291−-- (One reason for this policy of replacement is that internally, a
292−-- 'Text' value is represented as packed UTF-16 data. Values in the
293−-- 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
295−-- invalid scalar values, instead of dropping them, as a security
296−-- measure. For details, see
297−-- <http://unicode.org/reports/tr36/#Deletion_of_Noncharacters Unicode Technical Report 36, §3.5 >.)
298
202
299-- $fusion
203-- $fusion
300--
204--
301-- Most of the functions in this module are subject to /fusion/,
205-- Most of the functions in this module are subject to /fusion/,
302-- meaning that a pipeline of such functions will usually allocate at
206-- meaning that a pipeline of such functions will usually allocate at
303-- most one 'Text' value.
207-- most one 'Text' value.
304−--
305−-- As an example, consider the following pipeline:
306−--
307−-- > import Data.Text as T
308−-- > import Data.Text.Encoding as E
309−-- > import Data.ByteString (ByteString)
310−-- >
311−-- > countChars :: ByteString -> Int
312−-- > countChars = T.length . T.toUpper . E.decodeUtf8
313−--
314−-- From the type signatures involved, this looks like it should
315−-- allocate one 'Data.ByteString.ByteString' value, and two 'Text'
316−-- values. However, when a module is compiled with optimisation
317−-- enabled under GHC, the two intermediate 'Text' values will be
318−-- optimised away, and the function will be compiled down to a single
319−-- loop over the source 'Data.ByteString.ByteString'.
320−--
321−-- Functions that can be fused by the compiler are documented with the
322−-- phrase \"Subject to fusion\".
323
208
324instance Eq Text where
209instance Eq Text where
325− Text arrA offA lenA == Text arrB offB lenB
210+ t1 == t2 = stream t1 == stream t2
326− | lenA == lenB = A.equal arrA offA arrB offB lenA
327− | otherwise = False
328 {-# INLINE (==) #-}
211 {-# INLINE (==) #-}
329
212
330instance Ord Text where
213instance Ord Text where
331− compare = compareText
214+ compare t1 t2 = compare (stream t1) (stream t2)
215+ {-# INLINE compare #-}
216+
217+instance Show Text where
218+ showsPrec p ps r = showsPrec p (unpack ps) r
332
219
333instance Read Text where
220instance Read Text where
334 readsPrec p str = [(pack x,y) | (x,y) <- readsPrec p str]
221 readsPrec p str = [(pack x,y) | (x,y) <- readsPrec p str]
335
222
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
223instance Monoid Text where
345 mempty = empty
224 mempty = empty
346−#if MIN_VERSION_base(4,9,0)
347− mappend = (<>) -- future-proof definition
348−#else
349 mappend = append
225 mappend = append
350−#endif
351 mconcat = concat
226 mconcat = concat
352
227
353instance IsString Text where
228instance IsString Text where
354 fromString = pack
229 fromString = pack
355
230
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)
231#if defined(HAVE_DEEPSEQ)
364−instance NFData Text where rnf !_ = ()
232+instance NFData Text
365#endif
233#endif
366
234
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.
235+-- This instance preserves data abstraction at the cost of inefficiency.
376-- We omit reflection services for the sake of data abstraction.
236-- We omit reflection services for the sake of data abstraction.
237+--
238+-- This instance was created by copying the behavior of Data.Set and
239+-- Data.Map. If you feel a mistake has been made, please feel free to
240+-- submit improvements.
377--
241--
378−-- This instance was created by copying the updated behavior of
242+-- Original discussion is archived here:
379−-- @"Data.Set".@'Data.Set.Set' and @"Data.Map".@'Data.Map.Map'. If you
243+
380−-- feel a mistake has been made, please feel free to submit
244+-- "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? >
245+-- 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
246
390instance Data Text where
247instance Data Text where
391 gfoldl f z txt = z pack `f` (unpack txt)
248 gfoldl f z txt = z pack `f` (unpack txt)
392− toConstr _ = packConstr
249+ toConstr _ = error "Data.Text.Text.toConstr"
393− gunfold k z c = case constrIndex c of
394− 1 -> k (z pack)
395− _ -> P.error "gunfold"
250+ gunfold _ _ = error "Data.Text.Text.gunfold"
396− dataTypeOf _ = textDataType
251+#if __GLASGOW_HASKELL__ >= 612
397−
252+ dataTypeOf _ = mkNoRepType "Data.Text.Text"
398−#if MIN_VERSION_base(4,7,0)
253+#else
399−-- | Only defined for @base-4.7.0.0@ and later
254+ dataTypeOf _ = mkNorepType "Data.Text.Text"
400−instance PrintfArg Text where
401− formatArg txt = formatString $ unpack txt
402#endif
255#endif
403
256
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.
411−compareText :: Text -> Text -> Ordering
412−compareText ta@(Text _arrA _offA lenA) tb@(Text _arrB _offB lenB)
413− | lenA == 0 && lenB == 0 = EQ
414− | otherwise = go 0 0
415− where
416− go !i !j
417− | i >= lenA || j >= lenB = compare lenA lenB
418− | a < b = LT
419− | a > b = GT
420− | otherwise = go (i+di) (j+dj)
421− where Iter a di = iter ta i
422− Iter b dj = iter tb j
423−
424-- -----------------------------------------------------------------------------
257-- -----------------------------------------------------------------------------
425-- * Conversion to/from 'Text'
258-- * Conversion to/from 'Text'
426
259
427−-- | /O(n)/ Convert a 'String' into a 'Text'. Subject to
260+-- | /O(n)/ Convert a 'String' into a 'Text'. Subject to fusion.
428−-- fusion. Performs replacement on invalid scalar values.
429pack :: String -> Text
261pack :: String -> Text
430−pack = unstream . S.map safe . S.streamList
262+pack = unstream . S.streamList
431{-# INLINE [1] pack #-}
263{-# INLINE [1] pack #-}
432
264
265+-- | /O(n)/ Convert a Text into a String. Subject to fusion.
266+unpack :: Text -> String
267+unpack = S.unstreamList . stream
268+{-# INLINE [1] unpack #-}
269+
270+-- | /O(1)/ Convert a character into a Text.
271+-- Subject to fusion.
272+singleton :: Char -> Text
273+singleton = unstream . S.singleton
274+{-# INLINE [1] singleton #-}
275+
433-- -----------------------------------------------------------------------------
276-- -----------------------------------------------------------------------------
434-- * Basic functions
277-- * Basic functions
435
278
436-- | /O(n)/ Adds a character to the front of a 'Text'. This function
279-- | /O(n)/ Adds a character to the front of a 'Text'. This function
437-- is more costly than its 'List' counterpart because it requires
280-- is more costly than its 'List' counterpart because it requires
438−-- copying a new array. Subject to fusion. Performs replacement on
281+-- copying a new array. Subject to fusion.
439−-- invalid scalar values.
440cons :: Char -> Text -> Text
282cons :: Char -> Text -> Text
441−cons c t = unstream (S.cons (safe c) (stream t))
283+cons c t = unstream (S.cons c (stream t))
442{-# INLINE cons #-}
284{-# INLINE cons #-}
443
285
444−infixr 5 `cons`
445−
446-- | /O(n)/ Adds a character to the end of a 'Text'. This copies the
286-- | /O(n)/ Adds a character to the end of a 'Text'. This copies the
447-- entire array in the process, unless fused. Subject to fusion.
287-- entire array in the process, unless fused. Subject to fusion.
448−-- Performs replacement on invalid scalar values.
449snoc :: Text -> Char -> Text
288snoc :: Text -> Char -> Text
450−snoc t c = unstream (S.snoc (stream t) (safe c))
289+snoc t c = unstream (S.snoc (stream t) c)
451{-# INLINE snoc #-}
290{-# INLINE snoc #-}
452
291
453-- | /O(n)/ Appends one 'Text' to the other by copying both of them
292-- | /O(n)/ Appends one 'Text' to the other by copying both of them
454-- into a new 'Text'. Subject to fusion.
293-- into a new 'Text'. Subject to fusion.
455append :: Text -> Text -> Text
294append :: Text -> Text -> Text
456−append a@(Text arr1 off1 len1) b@(Text arr2 off2 len2)
295+append (Text arr1 off1 len1) (Text arr2 off2 len2) = Text (A.run x) 0 len
457− | len1 == 0 = b
458− | len2 == 0 = a
459− | len > 0 = Text (A.run x) 0 len
460− | otherwise = overflowError "append"
461 where
296 where
462 len = len1+len2
297 len = len1+len2
463− x :: ST s (A.MArray s)
464 x = do
298 x = do
465− arr <- A.new len
299+ arr <- A.unsafeNew len
466− A.copyI arr 0 arr1 off1 len1
300+ copy arr 0 arr1 off1 len1
467− A.copyI arr len1 arr2 off2 len
301+ copy arr len1 arr2 off2 (len1+len2)
468 return arr
302 return arr
469−{-# NOINLINE append #-}
303+{-# INLINE append #-}
470
304
471{-# RULES
305{-# RULES
472"TEXT append -> fused" [~1] forall t1 t2.
306"TEXT append -> fused" [~1] forall t1 t2.
@@ -475,6 +309,14 @@ append a@(Text arr1 off1 len1) b@(Text arr2 off2 len2)
475 unstream (S.append (stream t1) (stream t2)) = append t1 t2
309 unstream (S.append (stream t1) (stream t2)) = append t1 t2
476 #-}
310 #-}
477
311
312+copy :: forall s. A.MArray s -> Int -> A.Array -> Int -> Int
313+ -> ST s ()
314+copy dest i0 src j0 top = go i0 j0
315+ where
316+ go i j | i >= top = return ()
317+ | otherwise = do A.unsafeWrite dest i (src `A.unsafeIndex` j)
318+ go (i+1) (j+1)
319+
478-- | /O(1)/ Returns the first character of a 'Text', which must be
320-- | /O(1)/ Returns the first character of a 'Text', which must be
479-- non-empty. Subject to fusion.
321-- non-empty. Subject to fusion.
480head :: Text -> Char
322head :: Text -> Char
@@ -486,14 +328,21 @@ head t = S.head (stream t)
486uncons :: Text -> Maybe (Char, Text)
328uncons :: Text -> Maybe (Char, Text)
487uncons t@(Text arr off len)
329uncons t@(Text arr off len)
488 | len <= 0 = Nothing
330 | len <= 0 = Nothing
489− | otherwise = Just $ let !(Iter c d) = iter t 0
490− in (c, text arr (off+d) (len-d))
331+ | otherwise = Just (c, textP arr (off+d) (len-d))
332+ where (c,d) = iter t 0
491{-# INLINE [1] uncons #-}
333{-# INLINE [1] uncons #-}
492
334
493-- | Lifted from Control.Arrow and specialized.
335-- | Lifted from Control.Arrow and specialized.
494second :: (b -> c) -> (a,b) -> (a,c)
336second :: (b -> c) -> (a,b) -> (a,c)
495second f (a, b) = (a, f b)
337second f (a, b) = (a, f b)
496
338
339+{-# RULES
340+"TEXT uncons -> fused" [~1] forall t.
341+ uncons t = fmap (second unstream) (S.uncons (stream t))
342+"TEXT uncons -> unfused" [1] forall t.
343+ fmap (second unstream) (S.uncons (stream t)) = uncons t
344+ #-}
345+
497-- | /O(1)/ Returns the last character of a 'Text', which must be
346-- | /O(1)/ Returns the last character of a 'Text', which must be
498-- non-empty. Subject to fusion.
347-- non-empty. Subject to fusion.
499last :: Text -> Char
348last :: Text -> Char
@@ -517,7 +366,7 @@ last (Text arr off len)
517tail :: Text -> Text
366tail :: Text -> Text
518tail t@(Text arr off len)
367tail t@(Text arr off len)
519 | len <= 0 = emptyError "tail"
368 | len <= 0 = emptyError "tail"
520− | otherwise = text arr (off+d) (len-d)
369+ | otherwise = textP arr (off+d) (len-d)
521 where d = iter_ t 0
370 where d = iter_ t 0
522{-# INLINE [1] tail #-}
371{-# INLINE [1] tail #-}
523
372
@@ -532,8 +381,8 @@ tail t@(Text arr off len)
532-- be non-empty. Subject to fusion.
381-- be non-empty. Subject to fusion.
533init :: Text -> Text
382init :: Text -> Text
534init (Text arr off len) | len <= 0 = emptyError "init"
383init (Text arr off len) | len <= 0 = emptyError "init"
535− | n >= 0xDC00 && n <= 0xDFFF = text arr off (len-2)
384+ | n >= 0xDC00 && n <= 0xDFFF = textP arr off (len-2)
536− | otherwise = text arr off (len-1)
385+ | otherwise = textP arr off (len-1)
537 where
386 where
538 n = A.unsafeIndex arr (off+len-1)
387 n = A.unsafeIndex arr (off+len-1)
539{-# INLINE [1] init #-}
388{-# INLINE [1] init #-}
@@ -572,76 +421,27 @@ isSingleton = S.isSingleton . stream
572-- Subject to fusion.
421-- Subject to fusion.
573length :: Text -> Int
422length :: Text -> Int
574length t = S.length (stream t)
423length t = S.length (stream t)
575−{-# INLINE [0] length #-}
424+{-# 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−
579−-- | /O(n)/ Compare the count of characters in a 'Text' to a number.
580−-- Subject to fusion.
581−--
582−-- This function gives the same answer as comparing against the result
583−-- of 'length', but can short circuit if the count of characters is
584−-- greater than the number, and hence be more efficient.
585−compareLength :: Text -> Int -> Ordering
586−compareLength t n = S.compareLengthI (stream t) n
587−{-# INLINE [1] compareLength #-}
588−
589−{-# RULES
590−"TEXT compareN/length -> compareLength" [~1] forall t n.
591− compare (length t) n = compareLength t n
592− #-}
593−
594−{-# RULES
595−"TEXT ==N/length -> compareLength/==EQ" [~1] forall t n.
596− eqInt (length t) n = compareLength t n == EQ
597− #-}
598−
599−{-# RULES
600−"TEXT /=N/length -> compareLength//=EQ" [~1] forall t n.
601− neInt (length t) n = compareLength t n /= EQ
602− #-}
603−
604−{-# RULES
605−"TEXT <N/length -> compareLength/==LT" [~1] forall t n.
606− ltInt (length t) n = compareLength t n == LT
607− #-}
608−
609−{-# RULES
610−"TEXT <=N/length -> compareLength//=GT" [~1] forall t n.
611− leInt (length t) n = compareLength t n /= GT
612− #-}
613−
614−{-# RULES
615−"TEXT >N/length -> compareLength/==GT" [~1] forall t n.
616− gtInt (length t) n = compareLength t n == GT
617− #-}
618−
619−{-# RULES
620−"TEXT >=N/length -> compareLength//=LT" [~1] forall t n.
621− geInt (length t) n = compareLength t n /= LT
622− #-}
623
425
624-- -----------------------------------------------------------------------------
426-- -----------------------------------------------------------------------------
625-- * Transformations
427-- * Transformations
626-- | /O(n)/ 'map' @f@ @t@ is the 'Text' obtained by applying @f@ to
428-- | /O(n)/ 'map' @f@ @t@ is the 'Text' obtained by applying @f@ to
627−-- each element of @t@. Subject to fusion. Performs replacement on
429+-- each element of @t@. Subject to fusion.
628−-- invalid scalar values.
629map :: (Char -> Char) -> Text -> Text
430map :: (Char -> Char) -> Text -> Text
630−map f t = unstream (S.map (safe . f) (stream t))
431+map f t = unstream (S.map f (stream t))
631{-# INLINE [1] map #-}
432{-# INLINE [1] map #-}
632
433
633-- | /O(n)/ The 'intercalate' function takes a 'Text' and a list of
434-- | /O(n)/ The 'intercalate' function takes a 'Text' and a list of
634-- 'Text's and concatenates the list after interspersing the first
435-- 'Text's and concatenates the list after interspersing the first
635-- argument between each element of the list.
436-- argument between each element of the list.
636intercalate :: Text -> [Text] -> Text
437intercalate :: Text -> [Text] -> Text
637−intercalate t = concat . (F.intersperse t)
438+intercalate t = concat . (L.intersperse t)
638{-# INLINE intercalate #-}
439{-# INLINE intercalate #-}
639
440
640-- | /O(n)/ The 'intersperse' function takes a character and places it
441-- | /O(n)/ The 'intersperse' function takes a character and places it
641−-- between the characters of a 'Text'. Subject to fusion. Performs
442+-- between the characters of a 'Text'. Subject to fusion.
642−-- replacement on invalid scalar values.
643intersperse :: Char -> Text -> Text
443intersperse :: Char -> Text -> Text
644−intersperse c t = unstream (S.intersperse (safe c) (stream t))
444+intersperse c t = unstream (S.intersperse c (stream t))
645{-# INLINE intersperse #-}
445{-# INLINE intersperse #-}
646
446
647-- | /O(n)/ Reverse the characters of a string. Subject to fusion.
447-- | /O(n)/ Reverse the characters of a string. Subject to fusion.
@@ -649,59 +449,13 @@ reverse :: Text -> Text
649reverse t = S.reverse (stream t)
449reverse t = S.reverse (stream t)
650{-# INLINE reverse #-}
450{-# INLINE reverse #-}
651
451
652−-- | /O(m+n)/ Replace every non-overlapping occurrence of @needle@ in
452+-- | /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−--
673−-- In (unlikely) bad cases, this function's time complexity degrades
674−-- towards /O(n*m)/.
675−replace :: Text
453+replace :: Text -- ^ Text to search for
676− -- ^ @needle@ to search for. If this string is empty, an
454+ -> Text -- ^ Replacement text
677− -- error will occur.
678− -> Text
679− -- ^ @replacement@ to replace @needle@ with.
680− -> Text
455+ -> Text -- ^ Input text
681− -- ^ @haystack@ in which to search.
682 -> Text
456 -> Text
683−replace needle@(Text _ _ neeLen)
457+replace s d = intercalate d . split s
684− (Text repArr repOff repLen)
458+{-# 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
459
706-- ----------------------------------------------------------------------------
460-- ----------------------------------------------------------------------------
707-- ** Case conversions (folds)
461-- ** Case conversions (folds)
@@ -716,17 +470,10 @@ replace needle@(Text _ _ neeLen)
716-- case conversion rules. As a result, these functions may map one
470-- case conversion rules. As a result, these functions may map one
717-- input character to two or three output characters. For examples,
471-- input character to two or three output characters. For examples,
718-- see the documentation of each function.
472-- see the documentation of each function.
719−--
720−-- /Note/: In some languages, case conversion is a locale- and
721−-- context-dependent operation. The case conversion functions in this
722−-- module are /not/ locale sensitive. Programs that require locale
723−-- sensitivity should use appropriate versions of the
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 >.
725
473
726−-- | /O(n)/ Convert a string to folded case. Subject to fusion.
474+-- | /O(n)/ Convert a string to folded case. This function is mainly
727−--
728−-- This function is mainly useful for performing caseless (also known
475+-- useful for performing caseless (also known as case insensitive)
729−-- as case insensitive) string comparisons.
476+-- string comparisons.
730--
477--
731-- A string @x@ is a caseless match for a string @y@ if and only if:
478-- A string @x@ is a caseless match for a string @y@ if and only if:
732--
479--
@@ -741,56 +488,27 @@ replace needle@(Text _ _ neeLen)
741-- instead of itself.
488-- instead of itself.
742toCaseFold :: Text -> Text
489toCaseFold :: Text -> Text
743toCaseFold t = unstream (S.toCaseFold (stream t))
490toCaseFold t = unstream (S.toCaseFold (stream t))
744−{-# INLINE toCaseFold #-}
491+{-# INLINE [0] toCaseFold #-}
745
492
746-- | /O(n)/ Convert a string to lower case, using simple case
493-- | /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
494+-- conversion. The result string may be longer than the input string.
750−-- instance, \"&#x130;\" (Latin capital letter I with dot above,
495+-- For instance, \"&#x130;\" (Latin capital letter I with dot above,
751−-- U+0130) maps to the sequence \"i\" (Latin small letter i, U+0069)
496+-- U+0130) maps to the sequence \"i\" (Latin small letter i, U+0069) followed
752−-- followed by \" &#x307;\" (combining dot above, U+0307).
497+-- by \" &#x307;\" (combining dot above, U+0307).
753toLower :: Text -> Text
498toLower :: Text -> Text
754toLower t = unstream (S.toLower (stream t))
499toLower t = unstream (S.toLower (stream t))
755{-# INLINE toLower #-}
500{-# INLINE toLower #-}
756
501
757-- | /O(n)/ Convert a string to upper case, using simple case
502-- | /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
503+-- conversion. The result string may be longer than the input string.
761−-- instance, the German \"&#xdf;\" (eszett, U+00DF) maps to the
504+-- For instance, the German \"&#xdf;\" (eszett, U+00DF) maps to the
762-- two-letter sequence \"SS\".
505-- two-letter sequence \"SS\".
763toUpper :: Text -> Text
506toUpper :: Text -> Text
764toUpper t = unstream (S.toUpper (stream t))
507toUpper t = unstream (S.toUpper (stream t))
765{-# INLINE toUpper #-}
508{-# INLINE toUpper #-}
766
509
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
510-- | /O(n)/ Left-justify a string to the given length, using the
790−-- specified fill character on the right. Subject to fusion.
511+-- specified fill character on the right. Subject to fusion. Examples:
791−-- Performs replacement on invalid scalar values.
792−--
793−-- Examples:
794--
512--
795-- > justifyLeft 7 'x' "foo" == "fooxxxx"
513-- > justifyLeft 7 'x' "foo" == "fooxxxx"
796-- > justifyLeft 3 'x' "foobar" == "foobar"
514-- > justifyLeft 3 'x' "foobar" == "foobar"
@@ -809,10 +527,7 @@ justifyLeft k c t
809 #-}
527 #-}
810
528
811-- | /O(n)/ Right-justify a string to the given length, using the
529-- | /O(n)/ Right-justify a string to the given length, using the
812−-- specified fill character on the left. Performs replacement on
530+-- specified fill character on the left. Examples:
813−-- invalid scalar values.
814−--
815−-- Examples:
816--
531--
817-- > justifyRight 7 'x' "bar" == "xxxxbar"
532-- > justifyRight 7 'x' "bar" == "xxxxbar"
818-- > justifyRight 3 'x' "foobar" == "foobar"
533-- > justifyRight 3 'x' "foobar" == "foobar"
@@ -823,11 +538,8 @@ justifyRight k c t
823 where len = length t
538 where len = length t
824{-# INLINE justifyRight #-}
539{-# INLINE justifyRight #-}
825
540
826−-- | /O(n)/ Center a string to the given length, using the specified
541+-- | /O(n)/ Center a string to the given length, using the
827−-- fill character on either side. Performs replacement on invalid
542+-- specified fill character on either side. Examples:
828−-- scalar values.
829−--
830−-- Examples:
831--
543--
832-- > center 8 'x' "HS" = "xxxHSxxx"
544-- > center 8 'x' "HS" = "xxxHSxxx"
833center :: Int -> Char -> Text -> Text
545center :: Int -> Char -> Text -> Text
@@ -836,7 +548,7 @@ center k c t
836 | otherwise = replicateChar l c `append` t `append` replicateChar r c
548 | otherwise = replicateChar l c `append` t `append` replicateChar r c
837 where len = length t
549 where len = length t
838 d = k - len
550 d = k - len
839− r = d `quot` 2
551+ r = d `div` 2
840 l = d - r
552 l = d - r
841{-# INLINE center #-}
553{-# INLINE center #-}
842
554
@@ -854,12 +566,12 @@ transpose ts = P.map pack (L.transpose (P.map unpack ts))
854-- (typically the left-identity of the operator), and a 'Text',
566-- (typically the left-identity of the operator), and a 'Text',
855-- reduces the 'Text' using the binary operator, from left to right.
567-- reduces the 'Text' using the binary operator, from left to right.
856-- Subject to fusion.
568-- Subject to fusion.
857−foldl :: (a -> Char -> a) -> a -> Text -> a
569+foldl :: (b -> Char -> b) -> b -> Text -> b
858foldl f z t = S.foldl f z (stream t)
570foldl f z t = S.foldl f z (stream t)
859{-# INLINE foldl #-}
571{-# INLINE foldl #-}
860
572
861-- | /O(n)/ A strict version of 'foldl'. Subject to fusion.
573-- | /O(n)/ A strict version of 'foldl'. Subject to fusion.
862−foldl' :: (a -> Char -> a) -> a -> Text -> a
574+foldl' :: (b -> Char -> b) -> b -> Text -> b
863foldl' f z t = S.foldl' f z (stream t)
575foldl' f z t = S.foldl' f z (stream t)
864{-# INLINE foldl' #-}
576{-# INLINE foldl' #-}
865
577
@@ -878,12 +590,12 @@ foldl1' f t = S.foldl1' f (stream t)
878-- (typically the right-identity of the operator), and a 'Text',
590-- (typically the right-identity of the operator), and a 'Text',
879-- reduces the 'Text' using the binary operator, from right to left.
591-- reduces the 'Text' using the binary operator, from right to left.
880-- Subject to fusion.
592-- Subject to fusion.
881−foldr :: (Char -> a -> a) -> a -> Text -> a
593+foldr :: (Char -> b -> b) -> b -> Text -> b
882foldr f z t = S.foldr f z (stream t)
594foldr f z t = S.foldr f z (stream t)
883{-# INLINE foldr #-}
595{-# INLINE foldr #-}
884
596
885-- | /O(n)/ A variant of 'foldr' that has no starting value argument,
597-- | /O(n)/ A variant of 'foldr' that has no starting value argument,
886−-- and thus must be applied to a non-empty 'Text'. Subject to
598+-- and thust must be applied to a non-empty 'Text'. Subject to
887-- fusion.
599-- fusion.
888foldr1 :: (Char -> Char -> Char) -> Text -> Char
600foldr1 :: (Char -> Char -> Char) -> Text -> Char
889foldr1 f t = S.foldr1 f (stream t)
601foldr1 f t = S.foldr1 f (stream t)
@@ -894,19 +606,14 @@ foldr1 f t = S.foldr1 f (stream t)
894
606
895-- | /O(n)/ Concatenate a list of 'Text's.
607-- | /O(n)/ Concatenate a list of 'Text's.
896concat :: [Text] -> Text
608concat :: [Text] -> Text
897−concat ts = case ts' of
898− [] -> empty
899− [t] -> t
900− _ -> Text (A.run go) 0 len
609+concat ts = Text (A.run go) 0 len
901 where
610 where
902− ts' = L.filter (not . null) ts
611+ len = L.sum (L.map (\(Text _ _ l) -> l) ts)
903− len = sumP "concat" $ L.map lengthWord16 ts'
904− go :: ST s (A.MArray s)
905 go = do
612 go = do
906− arr <- A.new len
613+ arr <- A.unsafeNew len
907− let step i (Text a o l) =
908− let !j = i + l in A.copyI arr i a o j >> return j
614+ let step i (Text a o l) = let j = i + l in copy arr i a o j >> return j
909− foldM step 0 ts' >> return arr
615+ foldM step 0 ts >> return arr
616+{-# INLINE concat #-}
910
617
911-- | /O(n)/ Map a function over a 'Text' that results in a 'Text', and
618-- | /O(n)/ Map a function over a 'Text' that results in a 'Text', and
912-- concatenate the results.
619-- concatenate the results.
@@ -915,13 +622,13 @@ concatMap f = concat . foldr ((:) . f) []
915{-# INLINE concatMap #-}
622{-# INLINE concatMap #-}
916
623
917-- | /O(n)/ 'any' @p@ @t@ determines whether any character in the
624-- | /O(n)/ 'any' @p@ @t@ determines whether any character in the
918−-- 'Text' @t@ satisfies the predicate @p@. Subject to fusion.
625+-- 'Text' @t@ satisifes the predicate @p@. Subject to fusion.
919any :: (Char -> Bool) -> Text -> Bool
626any :: (Char -> Bool) -> Text -> Bool
920any p t = S.any p (stream t)
627any p t = S.any p (stream t)
921{-# INLINE any #-}
628{-# INLINE any #-}
922
629
923-- | /O(n)/ 'all' @p@ @t@ determines whether all characters in the
630-- | /O(n)/ 'all' @p@ @t@ determines whether all characters in the
924−-- 'Text' @t@ satisfy the predicate @p@. Subject to fusion.
631+-- 'Text' @t@ satisify the predicate @p@. Subject to fusion.
925all :: (Char -> Bool) -> Text -> Bool
632all :: (Char -> Bool) -> Text -> Bool
926all p t = S.all p (stream t)
633all p t = S.all p (stream t)
927{-# INLINE all #-}
634{-# INLINE all #-}
@@ -943,7 +650,6 @@ minimum t = S.minimum (stream t)
943
650
944-- | /O(n)/ 'scanl' is similar to 'foldl', but returns a list of
651-- | /O(n)/ 'scanl' is similar to 'foldl', but returns a list of
945-- successive reduced values from the left. Subject to fusion.
652-- successive reduced values from the left. Subject to fusion.
946−-- Performs replacement on invalid scalar values.
947--
653--
948-- > scanl f z [x1, x2, ...] == [z, z `f` x1, (z `f` x1) `f` x2, ...]
654-- > scanl f z [x1, x2, ...] == [z, z `f` x1, (z `f` x1) `f` x2, ...]
949--
655--
@@ -951,13 +657,11 @@ minimum t = S.minimum (stream t)
951--
657--
952-- > last (scanl f z xs) == foldl f z xs.
658-- > last (scanl f z xs) == foldl f z xs.
953scanl :: (Char -> Char -> Char) -> Char -> Text -> Text
659scanl :: (Char -> Char -> Char) -> Char -> Text -> Text
954−scanl f z t = unstream (S.scanl g z (stream t))
660+scanl f z t = unstream (S.scanl f z (stream t))
955− where g a b = safe (f a b)
956{-# INLINE scanl #-}
661{-# INLINE scanl #-}
957
662
958-- | /O(n)/ 'scanl1' is a variant of 'scanl' that has no starting
663-- | /O(n)/ 'scanl1' is a variant of 'scanl' that has no starting
959−-- value argument. Subject to fusion. Performs replacement on
664+-- value argument. Subject to fusion.
960−-- invalid scalar values.
961--
665--
962-- > scanl1 f [x1, x2, ...] == [x1, x1 `f` x2, ...]
666-- > scanl1 f [x1, x2, ...] == [x1, x1 `f` x2, ...]
963scanl1 :: (Char -> Char -> Char) -> Text -> Text
667scanl1 :: (Char -> Char -> Char) -> Text -> Text
@@ -965,42 +669,40 @@ scanl1 f t | null t = empty
965 | otherwise = scanl f (unsafeHead t) (unsafeTail t)
669 | otherwise = scanl f (unsafeHead t) (unsafeTail t)
966{-# INLINE scanl1 #-}
670{-# INLINE scanl1 #-}
967
671
968−-- | /O(n)/ 'scanr' is the right-to-left dual of 'scanl'. Performs
672+-- | /O(n)/ 'scanr' is the right-to-left dual of 'scanl'.
969−-- replacement on invalid scalar values.
970--
673--
971-- > scanr f v == reverse . scanl (flip f) v . reverse
674-- > scanr f v == reverse . scanl (flip f) v . reverse
972scanr :: (Char -> Char -> Char) -> Char -> Text -> Text
675scanr :: (Char -> Char -> Char) -> Char -> Text -> Text
973−scanr f z = S.reverse . S.reverseScanr g z . reverseStream
676+scanr f z = S.reverse . S.reverseScanr f z . reverseStream
974− where g a b = safe (f a b)
975{-# INLINE scanr #-}
677{-# INLINE scanr #-}
976
678
977-- | /O(n)/ 'scanr1' is a variant of 'scanr' that has no starting
679-- | /O(n)/ 'scanr1' is a variant of 'scanr' that has no starting
978−-- value argument. Subject to fusion. Performs replacement on
680+-- value argument. Subject to fusion.
979−-- invalid scalar values.
980scanr1 :: (Char -> Char -> Char) -> Text -> Text
681scanr1 :: (Char -> Char -> Char) -> Text -> Text
981scanr1 f t | null t = empty
682scanr1 f t | null t = empty
982 | otherwise = scanr f (last t) (init t)
683 | otherwise = scanr f (last t) (init t)
983{-# INLINE scanr1 #-}
684{-# INLINE scanr1 #-}
984
685
985−-- | /O(n)/ Like a combination of 'map' and 'foldl''. Applies a
686+-- | /O(n)/ Like a combination of 'map' and 'foldl'. Applies a
986-- function to each element of a 'Text', passing an accumulating
687-- function to each element of a 'Text', passing an accumulating
987−-- parameter from left to right, and returns a final 'Text'. Performs
688+-- parameter from left to right, and returns a final 'Text'.
988−-- replacement on invalid scalar values.
989mapAccumL :: (a -> Char -> (a,Char)) -> a -> Text -> (a, Text)
689mapAccumL :: (a -> Char -> (a,Char)) -> a -> Text -> (a, Text)
990−mapAccumL f z0 = S.mapAccumL g z0 . stream
690+mapAccumL f s t = case uncons t of
991− where g a b = second safe (f a b)
691+ Nothing -> (s, empty)
692+ Just (x, xs) -> (s'', cons y ys)
693+ where (s', y ) = f s x
992−{-# INLINE mapAccumL #-}
694+ (s'',ys) = mapAccumL f s' xs
993
695
994-- | The 'mapAccumR' function behaves like a combination of 'map' and
696-- | The 'mapAccumR' function behaves like a combination of 'map' and
995−-- a strict 'foldr'; it applies a function to each element of a
697+-- 'foldr'; it applies a function to each element of a 'Text', passing
996−-- 'Text', passing an accumulating parameter from right to left, and
698+-- an accumulating parameter from right to left, and returning a final
997−-- returning a final value of this accumulator together with the new
699+-- value of this accumulator together with the new 'Text'.
998−-- 'Text'.
999−-- Performs replacement on invalid scalar values.
1000mapAccumR :: (a -> Char -> (a,Char)) -> a -> Text -> (a, Text)
700mapAccumR :: (a -> Char -> (a,Char)) -> a -> Text -> (a, Text)
1001−mapAccumR f z0 = second reverse . S.mapAccumL g z0 . reverseStream
701+mapAccumR f s t = case uncons t of
1002− where g a b = second safe (f a b)
702+ Nothing -> (s, empty)
703+ Just (x, xs) -> (s'', cons y ys)
704+ where (s'',y ) = f s' x
1003−{-# INLINE mapAccumR #-}
705+ (s', ys) = mapAccumR f s xs
1004
706
1005-- -----------------------------------------------------------------------------
707-- -----------------------------------------------------------------------------
1006-- ** Generating and unfolding 'Text's
708-- ** Generating and unfolding 'Text's
@@ -1009,18 +711,17 @@ mapAccumR f z0 = second reverse . S.mapAccumL g z0 . reverseStream
1009-- @t@ repeated @n@ times.
711-- @t@ repeated @n@ times.
1010replicate :: Int -> Text -> Text
712replicate :: Int -> Text -> Text
1011replicate n t@(Text a o l)
713replicate n t@(Text a o l)
1012− | n <= 0 || l <= 0 = empty
714+ | n <= 0 || l <= 0 = empty
1013− | n == 1 = t
715+ | n == 1 = t
1014− | isSingleton t = replicateChar n (unsafeHead t)
716+ | isSingleton t = replicateChar n (unsafeHead t)
1015− | otherwise = Text (A.run x) 0 len
717+ | otherwise = Text (A.run x) 0 len
1016 where
718 where
1017− len = l `mul` n
719+ len = l * n
1018− x :: ST s (A.MArray s)
1019 x = do
720 x = do
1020− arr <- A.new len
721+ arr <- A.unsafeNew len
1021 let loop !d !i | i >= n = return arr
722 let loop !d !i | i >= n = return arr
1022 | otherwise = let m = d + l
723 | otherwise = let m = d + l
1023− in A.copyI arr d a o m >> loop m (i+1)
724+ in copy arr d a o m >> loop m (i+1)
1024 loop 0 0
725 loop 0 0
1025{-# INLINE [1] replicate #-}
726{-# INLINE [1] replicate #-}
1026
727
@@ -1032,7 +733,7 @@ replicate n t@(Text a o l)
1032-- | /O(n)/ 'replicateChar' @n@ @c@ is a 'Text' of length @n@ with @c@ the
733-- | /O(n)/ 'replicateChar' @n@ @c@ is a 'Text' of length @n@ with @c@ the
1033-- value of every element. Subject to fusion.
734-- value of every element. Subject to fusion.
1034replicateChar :: Int -> Char -> Text
735replicateChar :: Int -> Char -> Text
1035−replicateChar n c = unstream (S.replicateCharI n (safe c))
736+replicateChar n c = unstream (S.replicateCharI n c)
1036{-# INLINE replicateChar #-}
737{-# INLINE replicateChar #-}
1037
738
1038-- | /O(n)/, where @n@ is the length of the result. The 'unfoldr'
739-- | /O(n)/, where @n@ is the length of the result. The 'unfoldr'
@@ -1041,9 +742,9 @@ replicateChar n c = unstream (S.replicateCharI n (safe c))
1041-- returns 'Nothing' if it is done producing the 'Text', otherwise
742-- returns 'Nothing' if it is done producing the 'Text', otherwise
1042-- 'Just' @(a,b)@. In this case, @a@ is the next 'Char' in the
743-- 'Just' @(a,b)@. In this case, @a@ is the next 'Char' in the
1043-- string, and @b@ is the seed value for further production. Subject
744-- string, and @b@ is the seed value for further production. Subject
1044−-- to fusion. Performs replacement on invalid scalar values.
745+-- to fusion.
1045unfoldr :: (a -> Maybe (Char,a)) -> a -> Text
746unfoldr :: (a -> Maybe (Char,a)) -> a -> Text
1046−unfoldr f s = unstream (S.unfoldr (firstf safe . f) s)
747+unfoldr f s = unstream (S.unfoldr f s)
1047{-# INLINE unfoldr #-}
748{-# INLINE unfoldr #-}
1048
749
1049-- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a 'Text' from a seed
750-- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a 'Text' from a seed
@@ -1051,9 +752,9 @@ unfoldr f s = unstream (S.unfoldr (firstf safe . f) s)
1051-- first argument to 'unfoldrN'. This function is more efficient than
752-- first argument to 'unfoldrN'. This function is more efficient than
1052-- 'unfoldr' when the maximum length of the result is known and
753-- 'unfoldr' when the maximum length of the result is known and
1053-- correct, otherwise its performance is similar to 'unfoldr'. Subject
754-- correct, otherwise its performance is similar to 'unfoldr'. Subject
1054−-- to fusion. Performs replacement on invalid scalar values.
755+-- to fusion.
1055unfoldrN :: Int -> (a -> Maybe (Char,a)) -> a -> Text
756unfoldrN :: Int -> (a -> Maybe (Char,a)) -> a -> Text
1056−unfoldrN n f s = unstream (S.unfoldrN n (firstf safe . f) s)
757+unfoldrN n f s = unstream (S.unfoldrN n f s)
1057{-# INLINE unfoldrN #-}
758{-# INLINE unfoldrN #-}
1058
759
1059-- -----------------------------------------------------------------------------
760-- -----------------------------------------------------------------------------
@@ -1066,16 +767,14 @@ take :: Int -> Text -> Text
1066take n t@(Text arr off len)
767take n t@(Text arr off len)
1067 | n <= 0 = empty
768 | n <= 0 = empty
1068 | n >= len = t
769 | n >= len = t
1069− | otherwise = text arr off (iterN n t)
770+ | otherwise = Text arr off (loop 0 0)
771+ where
772+ loop !i !cnt
773+ | i >= len || cnt >= n = i
774+ | otherwise = loop (i+d) (cnt+1)
775+ where d = iter_ t i
1070{-# INLINE [1] take #-}
776{-# INLINE [1] take #-}
1071
777
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
778{-# RULES
1080"TEXT take -> fused" [~1] forall n t.
779"TEXT take -> fused" [~1] forall n t.
1081 take n t = unstream (S.take n (stream t))
780 take n t = unstream (S.take n (stream t))
@@ -1083,27 +782,6 @@ iterN n t@(Text _arr _off len) = loop 0 0
1083 unstream (S.take n (stream t)) = take n t
782 unstream (S.take n (stream t)) = take n t
1084 #-}
783 #-}
1085
784
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
785-- | /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@
786-- 'Text' after the first @n@ characters, or the empty 'Text' if @n@
1109-- is greater than the length of the 'Text'. Subject to fusion.
787-- is greater than the length of the 'Text'. Subject to fusion.
@@ -1111,8 +789,11 @@ drop :: Int -> Text -> Text
1111drop n t@(Text arr off len)
789drop n t@(Text arr off len)
1112 | n <= 0 = t
790 | n <= 0 = t
1113 | n >= len = empty
791 | n >= len = empty
1114− | otherwise = text arr (off+i) (len-i)
792+ | otherwise = loop 0 0
1115− where i = iterN n t
793+ where loop !i !cnt
794+ | i >= len || cnt >= n = Text arr (off+i) (len-i)
795+ | otherwise = loop (i+d) (cnt+1)
796+ where d = iter_ t i
1116{-# INLINE [1] drop #-}
797{-# INLINE [1] drop #-}
1117
798
1118{-# RULES
799{-# RULES
@@ -1122,18 +803,6 @@ drop n t@(Text arr off len)
1122 unstream (S.drop n (stream t)) = drop n t
803 unstream (S.drop n (stream t)) = drop n t
1123 #-}
804 #-}
1124
805
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',
806-- | /O(n)/ 'takeWhile', applied to a predicate @p@ and a 'Text',
1138-- returns the longest prefix (possibly empty) of elements that
807-- returns the longest prefix (possibly empty) of elements that
1139-- satisfy @p@. Subject to fusion.
808-- satisfy @p@. Subject to fusion.
@@ -1141,8 +810,8 @@ takeWhile :: (Char -> Bool) -> Text -> Text
1141takeWhile p t@(Text arr off len) = loop 0
810takeWhile p t@(Text arr off len) = loop 0
1142 where loop !i | i >= len = t
811 where loop !i | i >= len = t
1143 | p c = loop (i+d)
812 | p c = loop (i+d)
1144− | otherwise = text arr off i
813+ | otherwise = textP arr off i
1145− where Iter c d = iter t i
814+ where (c,d) = iter t i
1146{-# INLINE [1] takeWhile #-}
815{-# INLINE [1] takeWhile #-}
1147
816
1148{-# RULES
817{-# RULES
@@ -1152,27 +821,6 @@ takeWhile p t@(Text arr off len) = loop 0
1152 unstream (S.takeWhile p (stream t)) = takeWhile p t
821 unstream (S.takeWhile p (stream t)) = takeWhile p t
1153 #-}
822 #-}
1154
823
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
824-- | /O(n)/ 'dropWhile' @p@ @t@ returns the suffix remaining after
1177-- 'takeWhile' @p@ @t@. Subject to fusion.
825-- 'takeWhile' @p@ @t@. Subject to fusion.
1178dropWhile :: (Char -> Bool) -> Text -> Text
826dropWhile :: (Char -> Bool) -> Text -> Text
@@ -1180,7 +828,7 @@ dropWhile p t@(Text arr off len) = loop 0 0
1180 where loop !i !l | l >= len = empty
828 where loop !i !l | l >= len = empty
1181 | p c = loop (i+d) (l+d)
829 | p c = loop (i+d) (l+d)
1182 | otherwise = Text arr (off+i) (len-l)
830 | otherwise = Text arr (off+i) (len-l)
1183− where Iter c d = iter t i
831+ where (c,d) = iter t i
1184{-# INLINE [1] dropWhile #-}
832{-# INLINE [1] dropWhile #-}
1185
833
1186{-# RULES
834{-# RULES
@@ -1191,9 +839,8 @@ dropWhile p t@(Text arr off len) = loop 0 0
1191 #-}
839 #-}
1192
840
1193-- | /O(n)/ 'dropWhileEnd' @p@ @t@ returns the prefix remaining after
841-- | /O(n)/ 'dropWhileEnd' @p@ @t@ returns the prefix remaining after
1194−-- dropping characters that satisfy the predicate @p@ from the end of
842+-- dropping characters that fail the predicate @p@ from the end of
1195-- @t@. Subject to fusion.
843-- @t@. Subject to fusion.
1196−--
1197-- Examples:
844-- Examples:
1198--
845--
1199-- > dropWhileEnd (=='.') "foo..." == "foo"
846-- > dropWhileEnd (=='.') "foo..." == "foo"
@@ -1213,7 +860,7 @@ dropWhileEnd p t@(Text arr off len) = loop (len-1) len
1213 #-}
860 #-}
1214
861
1215-- | /O(n)/ 'dropAround' @p@ @t@ returns the substring remaining after
862-- | /O(n)/ 'dropAround' @p@ @t@ returns the substring remaining after
1216−-- dropping characters that satisfy the predicate @p@ from both the
863+-- dropping characters that fail the predicate @p@ from both the
1217-- beginning and end of @t@. Subject to fusion.
864-- beginning and end of @t@. Subject to fusion.
1218dropAround :: (Char -> Bool) -> Text -> Text
865dropAround :: (Char -> Bool) -> Text -> Text
1219dropAround p = dropWhile p . dropWhileEnd p
866dropAround p = dropWhile p . dropWhileEnd p
@@ -1248,23 +895,31 @@ splitAt :: Int -> Text -> (Text, Text)
1248splitAt n t@(Text arr off len)
895splitAt n t@(Text arr off len)
1249 | n <= 0 = (empty, t)
896 | n <= 0 = (empty, t)
1250 | n >= len = (t, empty)
897 | n >= len = (t, empty)
1251− | otherwise = let k = iterN n t
898+ | otherwise = (Text arr off k, Text arr (off+k) (len-k))
1252− in (text arr off k, text arr (off+k) (len-k))
899+ where k = loop 0 0
900+ loop !i !cnt
901+ | i >= len || cnt >= n = i
902+ | otherwise = loop (i+d) (cnt+1)
903+ where d = iter_ t i
904+{-# INLINE splitAt #-}
1253
905
1254−-- | /O(n)/ 'span', applied to a predicate @p@ and text @t@, returns
906+-- | /O(n)/ 'spanBy', applied to a predicate @p@ and text @t@, returns
1255-- a pair whose first element is the longest prefix (possibly empty)
907-- a pair whose first element is the longest prefix (possibly empty)
1256-- of @t@ of elements that satisfy @p@, and whose second is the
908-- of @t@ of elements that satisfy @p@, and whose second is the
1257-- remainder of the list.
909-- remainder of the list.
1258−span :: (Char -> Bool) -> Text -> (Text, Text)
910+spanBy :: (Char -> Bool) -> Text -> (Text, Text)
1259−span p t = case span_ p t of
911+spanBy p t@(Text arr off len) = (textP arr off k, textP arr (off+k) (len-k))
1260− (# hd,tl #) -> (hd,tl)
912+ where k = loop 0
913+ loop !i | i >= len || not (p c) = i
914+ | otherwise = loop (i+d)
915+ where (c,d) = iter t i
1261−{-# INLINE span #-}
916+{-# INLINE spanBy #-}
1262−
917+
1263−-- | /O(n)/ 'break' is like 'span', but the prefix returned is
918+-- | /O(n)/ 'breakBy' is like 'spanBy', but the prefix returned is
1264-- over elements that fail the predicate @p@.
919-- over elements that fail the predicate @p@.
1265−break :: (Char -> Bool) -> Text -> (Text, Text)
920+breakBy :: (Char -> Bool) -> Text -> (Text, Text)
1266−break p = span (not . p)
921+breakBy p = spanBy (not . p)
1267−{-# INLINE break #-}
922+{-# INLINE breakBy #-}
1268
923
1269-- | /O(n)/ Group characters in a string according to a predicate.
924-- | /O(n)/ Group characters in a string according to a predicate.
1270groupBy :: (Char -> Char -> Bool) -> Text -> [Text]
925groupBy :: (Char -> Char -> Bool) -> Text -> [Text]
@@ -1273,7 +928,7 @@ groupBy p = loop
1273 loop t@(Text arr off len)
928 loop t@(Text arr off len)
1274 | null t = []
929 | null t = []
1275 | otherwise = text arr off n : loop (text arr (off+n) (len-n))
930 | otherwise = text arr off n : loop (text arr (off+n) (len-n))
1276− where Iter c d = iter t 0
931+ where (c,d) = iter t 0
1277 n = d + findAIndexOrEnd (not . p c) (Text arr (off+d) (len-d))
932 n = d + findAIndexOrEnd (not . p c) (Text arr (off+d) (len-d))
1278
933
1279-- | Returns the /array/ index (in units of 'Word16') at which a
934-- | Returns the /array/ index (in units of 'Word16') at which a
@@ -1283,8 +938,8 @@ findAIndexOrEnd :: (Char -> Bool) -> Text -> Int
1283findAIndexOrEnd q t@(Text _arr _off len) = go 0
938findAIndexOrEnd q t@(Text _arr _off len) = go 0
1284 where go !i | i >= len || q c = i
939 where go !i | i >= len || q c = i
1285 | otherwise = go (i+d)
940 | otherwise = go (i+d)
1286− where Iter c d = iter t i
941+ where (c,d) = iter t i
1287−
942+
1288-- | /O(n)/ Group characters in a string by equality.
943-- | /O(n)/ Group characters in a string by equality.
1289group :: Text -> [Text]
944group :: Text -> [Text]
1290group = groupBy (==)
945group = groupBy (==)
@@ -1308,43 +963,36 @@ tails t | null t = [empty]
1308-- copies to create substrings; they just construct new 'Text's that
963-- copies to create substrings; they just construct new 'Text's that
1309-- are slices of the original.
964-- are slices of the original.
1310
965
1311−-- | /O(m+n)/ Break a 'Text' into pieces separated by the first 'Text'
966+-- | /O(m+n)/ Break a 'Text' into pieces separated by the first
1312−-- argument (which cannot be empty), consuming the delimiter. An empty
967+-- 'Text' argument, consuming the delimiter. An empty delimiter is
1313−-- delimiter is invalid, and will cause an error to be raised.
968+-- invalid, and will cause an error to be raised.
1314--
969--
1315-- Examples:
970-- Examples:
1316--
971--
1317−-- > splitOn "\r\n" "a\r\nb\r\nd\r\ne" == ["a","b","d","e"]
972+-- > split "\r\n" "a\r\nb\r\nd\r\ne" == ["a","b","d","e"]
1318−-- > splitOn "aaa" "aaaXaaaXaaaXaaa" == ["","X","X","X",""]
973+-- > split "aaa" "aaaXaaaXaaaXaaa" == ["","X","X","X",""]
1319−-- > splitOn "x" "x" == ["",""]
974+-- > split "x" "x" == ["",""]
1320−--
975+--
1321-- and
976-- and
1322--
977--
1323−-- > intercalate s . splitOn s == id
978+-- > intercalate s . split s == id
1324−-- > splitOn (singleton c) == split (==c)
979+-- > split (singleton c) == splitBy (==c)
1325−--
1326−-- (Note: the string @s@ to split on above cannot be empty.)
1327--
980--
1328-- In (unlikely) bad cases, this function's time complexity degrades
981-- In (unlikely) bad cases, this function's time complexity degrades
1329-- towards /O(n*m)/.
982-- towards /O(n*m)/.
1330−splitOn :: Text
983+split :: 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]
1336−splitOn pat@(Text _ _ l) src@(Text arr off len)
984+split pat@(Text _ _ l) src@(Text arr off len)
1337− | l <= 0 = emptyError "splitOn"
985+ | l <= 0 = emptyError "split"
1338− | isSingleton pat = split (== unsafeHead pat) src
986+ | isSingleton pat = splitBy (== unsafeHead pat) src
1339 | otherwise = go 0 (indices pat src)
987 | otherwise = go 0 (indices pat src)
1340 where
988 where
1341− go !s (x:xs) = text arr (s+off) (x-s) : go (x+l) xs
989+ go !s (x:xs) = textP arr (s+off) (x-s) : go (x+l) xs
1342− go s _ = [text arr (s+off) (len-s)]
990+ go s _ = [textP arr (s+off) (len-s)]
1343−{-# INLINE [1] splitOn #-}
991+{-# INLINE [1] split #-}
1344
992
1345{-# RULES
993{-# RULES
1346−"TEXT splitOn/singleton -> split/==" [~1] forall c t.
994+"TEXT split/singleton -> splitBy/==" [~1] forall c t.
1347− splitOn (singleton c) t = split (==c) t
995+ split (singleton c) t = splitBy (==c) t
1348 #-}
996 #-}
1349
997
1350-- | /O(n)/ Splits a 'Text' into components delimited by separators,
998-- | /O(n)/ Splits a 'Text' into components delimited by separators,
@@ -1352,15 +1000,15 @@ splitOn pat@(Text _ _ l) src@(Text arr off len)
1352-- resulting components do not contain the separators. Two adjacent
1000-- resulting components do not contain the separators. Two adjacent
1353-- separators result in an empty component in the output. eg.
1001-- separators result in an empty component in the output. eg.
1354--
1002--
1355−-- > split (=='a') "aabbaca" == ["","","bb","c",""]
1003+-- > splitBy (=='a') "aabbaca" == ["","","bb","c",""]
1356−-- > split (=='a') "" == [""]
1004+-- > splitBy (=='a') "" == [""]
1357−split :: (Char -> Bool) -> Text -> [Text]
1005+splitBy :: (Char -> Bool) -> Text -> [Text]
1358−split _ t@(Text _off _arr 0) = [t]
1006+splitBy _ t@(Text _off _arr 0) = [t]
1359−split p t = loop t
1007+splitBy p t = loop t
1360 where loop s | null s' = [l]
1008 where loop s | null s' = [l]
1361 | otherwise = l : loop (unsafeTail s')
1009 | otherwise = l : loop (unsafeTail s')
1362− where (# l, s' #) = span_ (not . p) s
1010+ where (l, s') = breakBy p s
1363−{-# INLINE split #-}
1011+{-# INLINE splitBy #-}
1364
1012
1365-- | /O(n)/ Splits a 'Text' into components of length @k@. The last
1013-- | /O(n)/ Splits a 'Text' into components of length @k@. The last
1366-- element may be shorter than the other chunks, depending on the
1014-- element may be shorter than the other chunks, depending on the
@@ -1382,21 +1030,21 @@ chunksOf k = go
1382-------------------------------------------------------------------------------
1030-------------------------------------------------------------------------------
1383-- ** Searching with a predicate
1031-- ** Searching with a predicate
1384
1032
1385−-- | /O(n)/ The 'find' function takes a predicate and a 'Text', and
1033+-- | /O(n)/ The 'findBy' function takes a predicate and a 'Text', and
1386−-- returns the first element matching the predicate, or 'Nothing' if
1034+-- returns the first element in matching the predicate, or 'Nothing'
1387−-- there is no such element.
1035+-- if there is no such element.
1388−find :: (Char -> Bool) -> Text -> Maybe Char
1036+findBy :: (Char -> Bool) -> Text -> Maybe Char
1389−find p t = S.findBy p (stream t)
1037+findBy p t = S.findBy p (stream t)
1390−{-# INLINE find #-}
1038+{-# INLINE findBy #-}
1391
1039
1392−-- | /O(n)/ The 'partition' function takes a predicate and a 'Text',
1040+-- | /O(n)/ The 'partitionBy' function takes a predicate and a 'Text',
1393-- and returns the pair of 'Text's with elements which do and do not
1041-- and returns the pair of 'Text's with elements which do and do not
1394-- satisfy the predicate, respectively; i.e.
1042-- satisfy the predicate, respectively; i.e.
1395--
1043--
1396−-- > partition p t == (filter p t, filter (not . p) t)
1044+-- > partitionBy p t == (filter p t, filter (not . p) t)
1397−partition :: (Char -> Bool) -> Text -> (Text, Text)
1045+partitionBy :: (Char -> Bool) -> Text -> (Text, Text)
1398−partition p t = (filter p t, filter (not . p) t)
1046+partitionBy p t = (filter p t, filter (not . p) t)
1399−{-# INLINE partition #-}
1047+{-# INLINE partitionBy #-}
1400
1048
1401-- | /O(n)/ 'filter', applied to a predicate and a 'Text',
1049-- | /O(n)/ 'filter', applied to a predicate and a 'Text',
1402-- returns a 'Text' containing those characters that satisfy the
1050-- returns a 'Text' containing those characters that satisfy the
@@ -1412,40 +1060,39 @@ filter p t = unstream (S.filter p (stream t))
1412--
1060--
1413-- Examples:
1061-- Examples:
1414--
1062--
1415−-- > breakOn "::" "a::b::c" ==> ("a", "::b::c")
1063+-- > break "::" "a::b::c" ==> ("a", "::b::c")
1416−-- > breakOn "/" "foobar" ==> ("foobar", "")
1064+-- > break "/" "foobar" ==> ("foobar", "")
1417--
1065--
1418-- Laws:
1066-- Laws:
1419--
1067--
1420-- > append prefix match == haystack
1068-- > append prefix match == haystack
1421−-- > where (prefix, match) = breakOn needle haystack
1069+-- > where (prefix, match) = break needle haystack
1422--
1070--
1423-- If you need to break a string by a substring repeatedly (e.g. you
1071-- If you need to break a string by a substring repeatedly (e.g. you
1424−-- want to break on every instance of a substring), use 'breakOnAll'
1072+-- want to break on every instance of a substring), use 'find'
1425-- instead, as it has lower startup overhead.
1073-- instead, as it has lower startup overhead.
1426--
1074--
1427-- In (unlikely) bad cases, this function's time complexity degrades
1075-- In (unlikely) bad cases, this function's time complexity degrades
1428-- towards /O(n*m)/.
1076-- towards /O(n*m)/.
1429−breakOn :: Text -> Text -> (Text, Text)
1077+break :: Text -> Text -> (Text, Text)
1430−breakOn pat src@(Text arr off len)
1078+break pat src@(Text arr off len)
1431− | null pat = emptyError "breakOn"
1079+ | null pat = emptyError "break"
1432 | otherwise = case indices pat src of
1080 | otherwise = case indices pat src of
1433 [] -> (src, empty)
1081 [] -> (src, empty)
1434− (x:_) -> (text arr off x, text arr (off+x) (len-x))
1082+ (x:_) -> (textP arr off x, textP arr (off+x) (len-x))
1435−{-# INLINE breakOn #-}
1083+{-# INLINE break #-}
1436
1084
1437−-- | /O(n+m)/ Similar to 'breakOn', but searches from the end of the
1085+-- | /O(n+m)/ Similar to 'break', but searches from the end of the string.
1438−-- string.
1439--
1086--
1440-- The first element of the returned tuple is the prefix of @haystack@
1087-- The first element of the returned tuple is the prefix of @haystack@
1441-- up to and including the last match of @needle@. The second is the
1088-- up to and including the last match of @needle@. The second is the
1442-- remainder of @haystack@, following the match.
1089-- remainder of @haystack@, following the match.
1443--
1090--
1444−-- > breakOnEnd "::" "a::b::c" ==> ("a::b::", "c")
1091+-- > breakEnd "::" "a::b::c" ==> ("a::b::", "c")
1445−breakOnEnd :: Text -> Text -> (Text, Text)
1092+breakEnd :: Text -> Text -> (Text, Text)
1446−breakOnEnd pat src = (reverse b, reverse a)
1447− where (a,b) = breakOn (reverse pat) (reverse src)
1093+breakEnd pat src = let (a,b) = break (reverse pat) (reverse src)
1094+ in (reverse b, reverse a)
1448−{-# INLINE breakOnEnd #-}
1095+{-# INLINE breakEnd #-}
1449
1096
1450-- | /O(n+m)/ Find all non-overlapping instances of @needle@ in
1097-- | /O(n+m)/ Find all non-overlapping instances of @needle@ in
1451-- @haystack@. Each element of the returned list consists of a pair:
1098-- @haystack@. Each element of the returned list consists of a pair:
@@ -1456,25 +1103,25 @@ breakOnEnd pat src = (reverse b, reverse a)
1456--
1103--
1457-- Examples:
1104-- Examples:
1458--
1105--
1459−-- > breakOnAll "::" ""
1106+-- > find "::" ""
1460-- > ==> []
1107-- > ==> []
1461−-- > breakOnAll "/" "a/b/c/"
1108+-- > find "/" "a/b/c/"
1462-- > ==> [("a", "/b/c/"), ("a/b", "/c/"), ("a/b/c", "/")]
1109-- > ==> [("a", "/b/c/"), ("a/b", "/c/"), ("a/b/c", "/")]
1463--
1110--
1464-- In (unlikely) bad cases, this function's time complexity degrades
1111-- In (unlikely) bad cases, this function's time complexity degrades
1465-- towards /O(n*m)/.
1112-- towards /O(n*m)/.
1466--
1113--
1467-- The @needle@ parameter may not be empty.
1114-- The @needle@ parameter may not be empty.
1468−breakOnAll :: Text -- ^ @needle@ to search for
1115+find :: Text -- ^ @needle@ to search for
1469− -> Text -- ^ @haystack@ in which to search
1116+ -> Text -- ^ @haystack@ in which to search
1470− -> [(Text, Text)]
1117+ -> [(Text, Text)]
1471−breakOnAll pat src@(Text arr off slen)
1118+find pat src@(Text arr off slen)
1472− | null pat = emptyError "breakOnAll"
1119+ | null pat = emptyError "find"
1473 | otherwise = L.map step (indices pat src)
1120 | otherwise = L.map step (indices pat src)
1474 where
1121 where
1475 step x = (chunk 0 x, chunk x (slen-x))
1122 step x = (chunk 0 x, chunk x (slen-x))
1476− chunk !n !l = text arr (n+off) l
1123+ chunk !n !l = textP arr (n+off) l
1477−{-# INLINE breakOnAll #-}
1124+{-# INLINE find #-}
1478
1125
1479-------------------------------------------------------------------------------
1126-------------------------------------------------------------------------------
1480-- ** Indexing 'Text's
1127-- ** Indexing 'Text's
@@ -1493,7 +1140,7 @@ breakOnAll pat src@(Text arr off slen)
1493-- For example, suppose you have a string that you want to split on
1140-- For example, suppose you have a string that you want to split on
1494-- the substring @\"::\"@, such as @\"foo::bar::quux\"@. Instead of
1141-- the substring @\"::\"@, such as @\"foo::bar::quux\"@. Instead of
1495-- searching for the index of @\"::\"@ and taking the substrings
1142-- searching for the index of @\"::\"@ and taking the substrings
1496−-- before and after that index, you would instead use @breakOnAll \"::\"@.
1143+-- before and after that index, you would instead use @find \"::\"@.
1497
1144
1498-- | /O(n)/ 'Text' index (subscript) operator, starting from 0.
1145-- | /O(n)/ 'Text' index (subscript) operator, starting from 0.
1499index :: Text -> Int -> Char
1146index :: Text -> Int -> Char
@@ -1540,15 +1187,13 @@ countChar c t = S.countChar c (stream t)
1540-- equivalent to a pair of 'unpack' operations.
1187-- equivalent to a pair of 'unpack' operations.
1541zip :: Text -> Text -> [(Char,Char)]
1188zip :: Text -> Text -> [(Char,Char)]
1542zip a b = S.unstreamList $ S.zipWith (,) (stream a) (stream b)
1189zip a b = S.unstreamList $ S.zipWith (,) (stream a) (stream b)
1543−{-# INLINE zip #-}
1190+{-# INLINE [0] zip #-}
1544
1191
1545-- | /O(n)/ 'zipWith' generalises 'zip' by zipping with the function
1192-- | /O(n)/ 'zipWith' generalises 'zip' by zipping with the function
1546-- given as the first argument, instead of a tupling function.
1193-- given as the first argument, instead of a tupling function.
1547−-- Performs replacement on invalid scalar values.
1548zipWith :: (Char -> Char -> Char) -> Text -> Text -> Text
1194zipWith :: (Char -> Char -> Char) -> Text -> Text -> Text
1549−zipWith f t1 t2 = unstream (S.zipWith g (stream t1) (stream t2))
1195+zipWith f t1 t2 = unstream (S.zipWith f (stream t1) (stream t2))
1550− where g a b = safe (f a b)
1551−{-# INLINE zipWith #-}
1196+{-# INLINE [0] zipWith #-}
1552
1197
1553-- | /O(n)/ Breaks a 'Text' up into a list of words, delimited by 'Char's
1198-- | /O(n)/ Breaks a 'Text' up into a list of words, delimited by 'Char's
1554-- representing white space.
1199-- representing white space.
@@ -1564,7 +1209,7 @@ words t@(Text arr off len) = loop 0 0
1564 then loop (start+1) (start+1)
1209 then loop (start+1) (start+1)
1565 else Text arr (start+off) (n-start) : loop (n+d) (n+d)
1210 else Text arr (start+off) (n-start) : loop (n+d) (n+d)
1566 | otherwise = loop start (n+d)
1211 | otherwise = loop start (n+d)
1567− where Iter c d = iter t n
1212+ where (c,d) = iter t n
1568{-# INLINE words #-}
1213{-# INLINE words #-}
1569
1214
1570-- | /O(n)/ Breaks a 'Text' up into a list of 'Text's at
1215-- | /O(n)/ Breaks a 'Text' up into a list of 'Text's at
@@ -1574,7 +1219,7 @@ lines ps | null ps = []
1574 | otherwise = h : if null t
1219 | otherwise = h : if null t
1575 then []
1220 then []
1576 else lines (unsafeTail t)
1221 else lines (unsafeTail t)
1577− where (# h,t #) = span_ (/= '\n') ps
1222+ where (h,t) = spanBy (/= '\n') ps
1578{-# INLINE lines #-}
1223{-# INLINE lines #-}
1579
1224
1580{-
1225{-
@@ -1611,7 +1256,8 @@ unwords = intercalate (singleton ' ')
1611{-# INLINE unwords #-}
1256{-# INLINE unwords #-}
1612
1257
1613-- | /O(n)/ The 'isPrefixOf' function takes two 'Text's and returns
1258-- | /O(n)/ The 'isPrefixOf' function takes two 'Text's and returns
1614−-- 'True' iff the first is a prefix of the second. Subject to fusion.
1259+-- 'True' iff the first is a prefix of the second. This function is
1260+-- subject to fusion.
1615isPrefixOf :: Text -> Text -> Bool
1261isPrefixOf :: Text -> Text -> Bool
1616isPrefixOf a@(Text _ _ alen) b@(Text _ _ blen) =
1262isPrefixOf a@(Text _ _ alen) b@(Text _ _ blen) =
1617 alen <= blen && S.isPrefixOf (stream a) (stream b)
1263 alen <= blen && S.isPrefixOf (stream a) (stream b)
@@ -1620,6 +1266,8 @@ isPrefixOf a@(Text _ _ alen) b@(Text _ _ blen) =
1620{-# RULES
1266{-# RULES
1621"TEXT isPrefixOf -> fused" [~1] forall s t.
1267"TEXT isPrefixOf -> fused" [~1] forall s t.
1622 isPrefixOf s t = S.isPrefixOf (stream s) (stream t)
1268 isPrefixOf s t = S.isPrefixOf (stream s) (stream t)
1269+"TEXT isPrefixOf -> unfused" [1] forall s t.
1270+ S.isPrefixOf (stream s) (stream t) = isPrefixOf s t
1623 #-}
1271 #-}
1624
1272
1625-- | /O(n)/ The 'isSuffixOf' function takes two 'Text's and returns
1273-- | /O(n)/ The 'isSuffixOf' function takes two 'Text's and returns
@@ -1653,14 +1301,13 @@ isInfixOf needle haystack
1653-------------------------------------------------------------------------------
1301-------------------------------------------------------------------------------
1654-- * View patterns
1302-- * View patterns
1655
1303
1656−-- | /O(n)/ Return the suffix of the second string if its prefix
1304+-- | /O(n)/ Returns the suffix of the second string if its prefix
1657−-- matches the entire first string.
1305+-- matches the first.
1658--
1306--
1659-- Examples:
1307-- Examples:
1660--
1308--
1661−-- > stripPrefix "foo" "foobar" == Just "bar"
1309+-- > prefixed "foo" "foobar" == Just "bar"
1662−-- > stripPrefix "" "baz" == Just "baz"
1663−-- > stripPrefix "foo" "quux" == Nothing
1310+-- > prefixed "foo" "quux" == Nothing
1664--
1311--
1665-- This is particularly useful with the @ViewPatterns@ extension to
1312-- This is particularly useful with the @ViewPatterns@ extension to
1666-- GHC, as follows:
1313-- GHC, as follows:
@@ -1669,44 +1316,20 @@ isInfixOf needle haystack
1669-- > import Data.Text as T
1316-- > import Data.Text as T
1670-- >
1317-- >
1671-- > fnordLength :: Text -> Int
1318-- > fnordLength :: Text -> Int
1672−-- > fnordLength (stripPrefix "fnord" -> Just suf) = T.length suf
1319+-- > fnordLength (prefixed "fnord" -> Just suf) = T.length suf
1673−-- > fnordLength _ = -1
1320+-- > fnordLength _ = -1
1674−stripPrefix :: Text -> Text -> Maybe Text
1321+prefixed :: Text -> Text -> Maybe Text
1675−stripPrefix p@(Text _arr _off plen) t@(Text arr off len)
1322+prefixed p@(Text _arr _off plen) t@(Text arr off len)
1676− | p `isPrefixOf` t = Just $! text arr (off+plen) (len-plen)
1323+ | p `isPrefixOf` t = Just $! textP arr (off+plen) (len-plen)
1677 | otherwise = Nothing
1324 | otherwise = Nothing
1678
1325
1679−-- | /O(n)/ Find the longest non-empty common prefix of two strings
1326+-- | /O(n)/ Returns the prefix of the second string if its suffix
1680−-- and return it, along with the suffixes of each string at which they
1327+-- matches the first.
1681−-- no longer match.
1682−--
1683−-- If the strings do not have a common prefix or either one is empty,
1684−-- this function returns 'Nothing'.
1685--
1328--
1686-- Examples:
1329-- Examples:
1687--
1330--
1688−-- > commonPrefixes "foobar" "fooquux" == Just ("foo","bar","quux")
1689−-- > commonPrefixes "veeble" "fetzer" == Nothing
1690−-- > commonPrefixes "" "baz" == Nothing
1691−commonPrefixes :: Text -> Text -> Maybe (Text,Text,Text)
1692−commonPrefixes t0@(Text arr0 off0 len0) t1@(Text arr1 off1 len1) = go 0 0
1693− where
1694− go !i !j | i < len0 && j < len1 && a == b = go (i+d0) (j+d1)
1695− | i > 0 = Just (Text arr0 off0 i,
1696− text arr0 (off0+i) (len0-i),
1697− text arr1 (off1+j) (len1-j))
1698− | otherwise = Nothing
1699− where Iter a d0 = iter t0 i
1700− Iter b d1 = iter t1 j
1701−
1702−-- | /O(n)/ Return the prefix of the second string if its suffix
1703−-- matches the entire first string.
1704−--
1705−-- Examples:
1706−--
1707−-- > stripSuffix "bar" "foobar" == Just "foo"
1331+-- > suffixed "bar" "foobar" == Just "foo"
1708−-- > stripSuffix "" "baz" == Just "baz"
1709−-- > stripSuffix "foo" "quux" == Nothing
1332+-- > suffixed "foo" "quux" == Nothing
1710--
1333--
1711-- This is particularly useful with the @ViewPatterns@ extension to
1334-- This is particularly useful with the @ViewPatterns@ extension to
1712-- GHC, as follows:
1335-- GHC, as follows:
@@ -1715,41 +1338,12 @@ commonPrefixes t0@(Text arr0 off0 len0) t1@(Text arr1 off1 len1) = go 0 0
1715-- > import Data.Text as T
1338-- > import Data.Text as T
1716-- >
1339-- >
1717-- > quuxLength :: Text -> Int
1340-- > quuxLength :: Text -> Int
1718−-- > quuxLength (stripSuffix "quux" -> Just pre) = T.length pre
1341+-- > quuxLength (suffixed "quux" -> Just pre) = T.length pre
1719−-- > quuxLength _ = -1
1342+-- > quuxLength _ = -1
1720−stripSuffix :: Text -> Text -> Maybe Text
1343+suffixed :: Text -> Text -> Maybe Text
1721−stripSuffix p@(Text _arr _off plen) t@(Text arr off len)
1344+suffixed p@(Text _arr _off plen) t@(Text arr off len)
1722− | p `isSuffixOf` t = Just $! text arr off (len-plen)
1345+ | p `isSuffixOf` t = Just $! textP arr off (len-plen)
1723 | otherwise = Nothing
1346 | otherwise = Nothing
1724
1347
1725−-- | Add a list of non-negative numbers. Errors out on overflow.
1726−sumP :: String -> [Int] -> Int
1727−sumP fun = go 0
1728− where go !a (x:xs)
1729− | ax >= 0 = go ax xs
1730− | otherwise = overflowError fun
1731− where ax = a + x
1732− go a _ = a
1733−
1734emptyError :: String -> a
1348emptyError :: String -> a
1735−emptyError fun = P.error $ "Data.Text." ++ fun ++ ": empty input"
1349+emptyError fun = P.error ("Data.Text." ++ fun ++ ": empty input")
1736−
1737−overflowError :: String -> a
1738−overflowError 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+86−133
@@ -1,12 +1,12 @@
1−{-# LANGUAGE BangPatterns, CPP, ForeignFunctionInterface, MagicHash, Rank2Types,
1+{-# LANGUAGE BangPatterns, CPP, MagicHash, Rank2Types, UnboxedTuples #-}
2− RecordWildCards, UnboxedTuples, UnliftedFFITypes #-}
3{-# OPTIONS_GHC -fno-warn-unused-matches #-}
2{-# OPTIONS_GHC -fno-warn-unused-matches #-}
4-- |
3-- |
5-- Module : Data.Text.Array
4-- Module : Data.Text.Array
6−-- Copyright : (c) 2009, 2010, 2011 Bryan O'Sullivan
5+-- Copyright : (c) Bryan O'Sullivan 2009
7--
6--
8-- License : BSD-style
7-- License : BSD-style
9−-- Maintainer : bos@serpentine.com
8+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
9+-- duncan@haskell.org
10-- Stability : experimental
10-- Stability : experimental
11-- Portability : portable
11-- Portability : portable
12--
12--
@@ -20,28 +20,25 @@
20-- > import qualified Data.Text.Array as A
20-- > import qualified Data.Text.Array as A
21--
21--
22-- The names in this module resemble those in the 'Data.Array' family
22-- The names in this module resemble those in the 'Data.Array' family
23−-- of modules, but are shorter due to the assumption of qualified
23+-- of modules, but are shorter due to the assumption of qualifid
24-- naming.
24-- naming.
25module Data.Text.Array
25module Data.Text.Array
26 (
26 (
27 -- * Types
27 -- * Types
28− Array(Array, aBA)
28+ IArray(..)
29− , MArray(MArray, maBA)
29+ , Array
30+ , MArray
30
31
31 -- * Functions
32 -- * Functions
32− , copyM
33+ , copy
33− , copyI
34 , empty
34 , empty
35− , equal
36−#if defined(ASSERTS)
37− , length
38−#endif
39 , run
35 , run
40 , run2
36 , run2
41 , toList
37 , toList
38+ , unsafeCopy
42 , unsafeFreeze
39 , unsafeFreeze
43 , unsafeIndex
40 , unsafeIndex
44− , new
41+ , unsafeNew
45 , unsafeWrite
42 , unsafeWrite
46 ) where
43 ) where
47
44
@@ -59,84 +56,59 @@ if (_k_) < 0 || (_k_) >= (_len_) then error ("Data.Text.Array." ++ (_func_) ++ "
59#if defined(ASSERTS)
56#if defined(ASSERTS)
60import Control.Exception (assert)
57import Control.Exception (assert)
61#endif
58#endif
62−#if __GLASGOW_HASKELL__ >= 702
59+import Data.Text.UnsafeShift (shiftL)
63−import Control.Monad.ST.Unsafe (unsafeIOToST)
64−#else
65−import Control.Monad.ST (unsafeIOToST)
66−#endif
67−import Data.Bits ((.&.), xor)
68−import Data.Text.Internal.Unsafe (inlinePerformIO)
69−import Data.Text.Internal.Unsafe.Shift (shiftL, shiftR)
70−#if __GLASGOW_HASKELL__ >= 703
71−import Foreign.C.Types (CInt(CInt), CSize(CSize))
72−#else
73−import Foreign.C.Types (CInt, CSize)
74−#endif
75import GHC.Base (ByteArray#, MutableByteArray#, Int(..),
60import GHC.Base (ByteArray#, MutableByteArray#, Int(..),
76 indexWord16Array#, newByteArray#,
61 indexWord16Array#, newByteArray#,
62+ readWord16Array#, unsafeCoerce#,
77− unsafeFreezeByteArray#, writeWord16Array#)
63+ writeWord16Array#)
78import GHC.ST (ST(..), runST)
64import GHC.ST (ST(..), runST)
79import GHC.Word (Word16(..))
65import GHC.Word (Word16(..))
80import Prelude hiding (length, read)
66import Prelude hiding (length, read)
81
67
82-- | Immutable array type.
68-- | Immutable array type.
83−data Array = Array {
69+data Array = Array
84− aBA :: ByteArray#
85−#if defined(ASSERTS)
86− , aLen :: {-# UNPACK #-} !Int -- length (in units of Word16, not bytes)
70+ {-# UNPACK #-} !Int -- length (in units of Word16, not bytes)
87−#endif
71+ ByteArray#
88− }
89
72
90-- | Mutable array type, for use in the ST monad.
73-- | Mutable array type, for use in the ST monad.
91−data MArray s = MArray {
74+data MArray s = MArray
92− maBA :: MutableByteArray# s
93−#if defined(ASSERTS)
94− , maLen :: {-# UNPACK #-} !Int -- length (in units of Word16, not bytes)
75+ {-# UNPACK #-} !Int -- length (in units of Word16, not bytes)
95−#endif
76+ (MutableByteArray# s)
96− }
97
77
98−#if defined(ASSERTS)
99-- | Operations supported by all arrays.
78-- | Operations supported by all arrays.
100class IArray a where
79class IArray a where
101 -- | Return the length of an array.
80 -- | Return the length of an array.
102 length :: a -> Int
81 length :: a -> Int
103
82
104instance IArray Array where
83instance IArray Array where
105− length = aLen
84+ length (Array len _ba) = len
106 {-# INLINE length #-}
85 {-# INLINE length #-}
107
86
108instance IArray (MArray s) where
87instance IArray (MArray s) where
109− length = maLen
88+ length (MArray len _ba) = len
110 {-# INLINE length #-}
89 {-# INLINE length #-}
111−#endif
90+
91+-- | Freeze a mutable array. Do not mutate the 'MArray' afterwards!
92+unsafeFreeze :: MArray s -> ST s (Array)
112
93
113-- | Create an uninitialized mutable array.
94-- | Create an uninitialized mutable array.
114−new :: forall s. Int -> ST s (MArray s)
95+unsafeNew :: forall s. Int -> ST s (MArray s)
115−new n
96+unsafeNew n =
116− | n < 0 || n .&. highBit /= 0 = array_size_error
117− | otherwise = ST $ \s1# ->
118− case newByteArray# len# s1# of
119− (# s2#, marr# #) -> (# s2#, MArray marr#
120#if defined(ASSERTS)
97#if defined(ASSERTS)
121− n
98+ assert (n >= 0) .
122#endif
99#endif
123− #)
100+ ST $ \s1# ->
124− where !(I# len#) = bytesInArray n
101+ case bytesInArray n of
125− highBit = maxBound `xor` (maxBound `shiftR` 1)
102+ len@(I# len#) ->
126−{-# INLINE new #-}
127−
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!
132−unsafeFreeze :: MArray s -> ST s Array
133−unsafeFreeze MArray{..} = ST $ \s1# ->
134− case unsafeFreezeByteArray# maBA s1# of
135− (# s2#, ba# #) -> (# s2#, Array ba#
136#if defined(ASSERTS)
103#if defined(ASSERTS)
137− maLen
104+ if len < 0 then error (show ("unsafeNew",len)) else
138#endif
105#endif
139− #)
106+ case newByteArray# len# s1# of
107+ (# s2#, marr# #) -> (# s2#, MArray n marr# #)
108+{-# INLINE unsafeNew #-}
109+
110+unsafeFreeze (MArray len mba#) = ST $ \s# ->
111+ (# s#, Array len (unsafeCoerce# mba#) #)
140{-# INLINE unsafeFreeze #-}
112{-# INLINE unsafeFreeze #-}
141
113
142-- | Indicate how many bytes would be used for an array of the given
114-- | Indicate how many bytes would be used for an array of the given
@@ -148,29 +120,39 @@ bytesInArray n = n `shiftL` 1
148-- | Unchecked read of an immutable array. May return garbage or
120-- | Unchecked read of an immutable array. May return garbage or
149-- crash on an out-of-bounds access.
121-- crash on an out-of-bounds access.
150unsafeIndex :: Array -> Int -> Word16
122unsafeIndex :: Array -> Int -> Word16
151−unsafeIndex Array{..} i@(I# i#) =
123+unsafeIndex (Array len ba#) i@(I# i#) =
152− CHECK_BOUNDS("unsafeIndex",aLen,i)
124+ CHECK_BOUNDS("unsafeIndex",len,i)
153− case indexWord16Array# aBA i# of r# -> (W16# r#)
125+ case indexWord16Array# ba# i# of r# -> (W16# r#)
154{-# INLINE unsafeIndex #-}
126{-# INLINE unsafeIndex #-}
155
127
128+-- | Unchecked read of a mutable array. May return garbage or
129+-- crash on an out-of-bounds access.
130+unsafeRead :: MArray s -> Int -> ST s Word16
131+unsafeRead (MArray len mba#) i@(I# i#) = ST $ \s# ->
132+ CHECK_BOUNDS("unsafeRead",len,i)
133+ case readWord16Array# mba# i# s# of
134+ (# s2#, r# #) -> (# s2#, W16# r# #)
135+{-# INLINE unsafeRead #-}
136+
156-- | Unchecked write of a mutable array. May return garbage or crash
137-- | Unchecked write of a mutable array. May return garbage or crash
157-- on an out-of-bounds access.
138-- on an out-of-bounds access.
158unsafeWrite :: MArray s -> Int -> Word16 -> ST s ()
139unsafeWrite :: MArray s -> Int -> Word16 -> ST s ()
159−unsafeWrite MArray{..} i@(I# i#) (W16# e#) = ST $ \s1# ->
140+unsafeWrite (MArray len marr#) i@(I# i#) (W16# e#) = ST $ \s1# ->
160− CHECK_BOUNDS("unsafeWrite",maLen,i)
141+ CHECK_BOUNDS("unsafeWrite",len,i)
161− case writeWord16Array# maBA i# e# s1# of
142+ case writeWord16Array# marr# i# e# s1# of
162 s2# -> (# s2#, () #)
143 s2# -> (# s2#, () #)
163{-# INLINE unsafeWrite #-}
144{-# INLINE unsafeWrite #-}
164
145
165-- | Convert an immutable array to a list.
146-- | Convert an immutable array to a list.
166−toList :: Array -> Int -> Int -> [Word16]
147+toList :: Array -> [Word16]
167−toList ary off len = loop 0
148+toList a = loop 0
168− where loop i | i < len = unsafeIndex ary (off+i) : loop (i+1)
149+ where loop i | i < len = unsafeIndex a i : loop (i+1)
169 | otherwise = []
150 | otherwise = []
151+ len = length a
170
152
171-- | An empty immutable array.
153-- | An empty immutable array.
172empty :: Array
154empty :: Array
173−empty = runST (new 0 >>= unsafeFreeze)
155+empty = runST (unsafeNew 0 >>= unsafeFreeze)
174
156
175-- | Run an action in the ST monad and return an immutable array of
157-- | Run an action in the ST monad and return an immutable array of
176-- its result.
158-- its result.
@@ -184,63 +166,34 @@ run2 k = runST (do
184 (marr,b) <- k
166 (marr,b) <- k
185 arr <- unsafeFreeze marr
167 arr <- unsafeFreeze marr
186 return (arr,b))
168 return (arr,b))
169+
170+-- | Copy an array in its entirety. The destination array must be at
171+-- least as big as the source.
172+copy :: MArray s -- ^ source array
173+ -> MArray s -- ^ destination array
174+ -> ST s ()
175+copy src dest
176+ | length dest >= length src = copy_loop 0
177+ | otherwise = fail "Data.Text.Array.copy: array too small"
178+ where
179+ len = length src
180+ copy_loop i
181+ | i >= len = return ()
182+ | otherwise = do unsafeRead src i >>= unsafeWrite dest i
183+ copy_loop (i+1)
187−{-# INLINE run2 #-}
184+{-# INLINE copy #-}
188−
185+
189−-- | Copy some elements of a mutable array.
186+-- | Unsafely copy the elements of an array.
190−copyM :: MArray s -- ^ Destination
187+unsafeCopy :: MArray s -> Int -> MArray s -> Int -> Int -> ST s ()
191− -> Int -- ^ Destination offset
192− -> MArray s -- ^ Source
193− -> Int -- ^ Source offset
194− -> Int -- ^ Count
195− -> ST s ()
196−copyM dest didx src sidx count
188+unsafeCopy src sidx dest didx count =
197− | count <= 0 = return ()
198− | otherwise =
199#if defined(ASSERTS)
189#if defined(ASSERTS)
200 assert (sidx + count <= length src) .
190 assert (sidx + count <= length src) .
201− assert (didx + count <= length dest) .
191+ assert (didx + count <= length dest) $
202#endif
192#endif
203− unsafeIOToST $ memcpyM (maBA dest) (fromIntegral didx)
193+ copy_loop sidx didx 0
204− (maBA src) (fromIntegral sidx)
194+ where
205− (fromIntegral count)
195+ copy_loop !i !j !c
206−{-# INLINE copyM #-}
207−
208−-- | Copy some elements of an immutable array.
209−copyI :: MArray s -- ^ Destination
210− -> Int -- ^ Destination offset
211− -> Array -- ^ Source
212− -> Int -- ^ Source offset
213− -> Int -- ^ First offset in destination /not/ to
214− -- copy (i.e. /not/ length)
215− -> ST s ()
216−copyI dest i0 src j0 top
217− | i0 >= top = return ()
196+ | c >= count = return ()
218− | otherwise = unsafeIOToST $
197+ | otherwise = do unsafeRead src i >>= unsafeWrite dest j
219− memcpyI (maBA dest) (fromIntegral i0)
198+ copy_loop (i+1) (j+1) (c+1)
220− (aBA src) (fromIntegral j0)
221− (fromIntegral (top-i0))
222−{-# INLINE copyI #-}
223−
224−-- | Compare portions of two arrays for equality. No bounds checking
225−-- is performed.
226−equal :: Array -- ^ First
227− -> Int -- ^ Offset into first
228− -> Array -- ^ Second
229− -> Int -- ^ Offset into second
230− -> Int -- ^ Count
231− -> Bool
232−equal arrA offA arrB offB count = inlinePerformIO $ do
233− i <- memcmp (aBA arrA) (fromIntegral offA)
234− (aBA arrB) (fromIntegral offB) (fromIntegral count)
235− return $! i == 0
236−{-# INLINE equal #-}
199+{-# INLINE unsafeCopy #-}
237−
238−foreign import ccall unsafe "_hs_text_memcpy" memcpyI
239− :: MutableByteArray# s -> CSize -> ByteArray# -> CSize -> CSize -> IO ()
240−
241−foreign import ccall unsafe "_hs_text_memcmp" memcmp
242− :: ByteArray# -> CSize -> ByteArray# -> CSize -> CSize -> IO CInt
243−
244−foreign import ccall unsafe "_hs_text_memcpy" memcpyM
245− :: MutableByteArray# s -> CSize -> MutableByteArray# s -> CSize -> CSize
246− -> IO ()
Data/Text/Encoding.hs+23−375
@@ -1,40 +1,30 @@
1−{-# LANGUAGE BangPatterns, CPP, ForeignFunctionInterface, GeneralizedNewtypeDeriving, MagicHash,
2− UnliftedFFITypes #-}
3−#if __GLASGOW_HASKELL__ >= 702
4−{-# LANGUAGE Trustworthy #-}
5−#endif
6-- |
1-- |
7-- Module : Data.Text.Encoding
2-- Module : Data.Text.Encoding
3+-- Copyright : (c) Tom Harper 2008-2009,
8−-- Copyright : (c) 2009, 2010, 2011 Bryan O'Sullivan,
4+-- (c) Bryan O'Sullivan 2009,
9−-- (c) 2009 Duncan Coutts,
5+-- (c) Duncan Coutts 2009
10−-- (c) 2008, 2009 Tom Harper
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 : portable
11-- Portability : portable
16--
12--
17-- Functions for converting 'Text' values to and from 'ByteString',
13-- Functions for converting 'Text' values to and from 'ByteString',
18-- using several standard encodings.
14-- using several standard encodings.
19--
15--
20−-- To gain access to a much larger family of encodings, use the
16+-- To make use of a much larger variety of encodings, use the @text-icu@
21−-- @text-icu@ package: <http://hackage.haskell.org/package/text-icu>
17+-- package.
22
18
23module Data.Text.Encoding
19module Data.Text.Encoding
24 (
20 (
25 -- * Decoding ByteStrings to Text
21 -- * Decoding ByteStrings to Text
26− -- $strict
27 decodeASCII
22 decodeASCII
28− , decodeLatin1
29 , decodeUtf8
23 , decodeUtf8
30 , decodeUtf16LE
24 , decodeUtf16LE
31 , decodeUtf16BE
25 , decodeUtf16BE
32 , decodeUtf32LE
26 , decodeUtf32LE
33 , decodeUtf32BE
27 , decodeUtf32BE
34−
35− -- ** Catchable failure
36− , decodeUtf8'
37−
38 -- ** Controllable error handling
28 -- ** Controllable error handling
39 , decodeUtf8With
29 , decodeUtf8With
40 , decodeUtf16LEWith
30 , decodeUtf16LEWith
@@ -42,350 +32,39 @@ module Data.Text.Encoding
42 , decodeUtf32LEWith
32 , decodeUtf32LEWith
43 , decodeUtf32BEWith
33 , decodeUtf32BEWith
44
34
45− -- ** Stream oriented decoding
46− -- $stream
47− , streamDecodeUtf8
48− , streamDecodeUtf8With
49− , Decoding(..)
50−
51 -- * Encoding Text to ByteStrings
35 -- * Encoding Text to ByteStrings
52 , encodeUtf8
36 , encodeUtf8
53 , encodeUtf16LE
37 , encodeUtf16LE
54 , encodeUtf16BE
38 , encodeUtf16BE
55 , encodeUtf32LE
39 , encodeUtf32LE
56 , encodeUtf32BE
40 , encodeUtf32BE
57−
58− -- * Encoding Text using ByteString Builders
59− , encodeUtf8Builder
60− , encodeUtf8BuilderEscaped
61 ) where
41 ) where
62−
42+
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−
69−import Control.Exception (evaluate, try)
70−import Control.Monad.ST (runST)
71−import Data.Bits ((.&.))
43+import Data.ByteString (ByteString)
72−import Data.ByteString as B
44+import qualified Data.Text.Fusion as F
73−import Data.ByteString.Internal as B hiding (c2w)
74−import Data.Text.Encoding.Error (OnDecodeError, UnicodeException, strictDecode)
45+import Data.Text.Encoding.Error (OnDecodeError, strictDecode)
75−import Data.Text.Internal (Text(..), safe, text)
46+import qualified Data.Text.Encoding.Fusion as E
76−import Data.Text.Internal.Private (runText)
77−import Data.Text.Internal.Unsafe.Char (ord, unsafeWrite)
78−import Data.Text.Internal.Unsafe.Shift (shiftR)
79−import Data.Text.Show ()
80−import Data.Text.Unsafe (unsafeDupablePerformIO)
81−import Data.Word (Word8, Word32)
82−import Foreign.C.Types (CSize(..))
83−import Foreign.ForeignPtr (withForeignPtr)
84−import Foreign.Marshal.Utils (with)
85−import Foreign.Ptr (Ptr, minusPtr, nullPtr, plusPtr)
86−import Foreign.Storable (Storable, peek, poke)
87−import GHC.Base (ByteArray#, MutableByteArray#)
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
92−import qualified Data.Text.Array as A
93−import qualified Data.Text.Internal.Encoding.Fusion as E
94−import qualified Data.Text.Internal.Encoding.Utf16 as U16
47+import Data.Text.Internal (Text)
95−import qualified Data.Text.Internal.Fusion as F
48+
96−
97−#include "text_cbits.h"
98−
99−-- $strict
100−--
101−-- All of the single-parameter functions for decoding bytestrings
102−-- encoded in one of the Unicode Transformation Formats (UTF) operate
103−-- in a /strict/ mode: each will throw an exception if given invalid
104−-- input.
105−--
106−-- Each function has a variant, whose name is suffixed with -'With',
107−-- that gives greater control over the handling of decoding errors.
108−-- For instance, 'decodeUtf8' will throw an exception, but
109−-- 'decodeUtf8With' allows the programmer to determine what to do on a
110−-- decoding error.
111−
112−-- | /Deprecated/. Decode a 'ByteString' containing 7-bit ASCII
49+-- | Decode a 'ByteString' containing 7-bit ASCII encoded text.
113−-- encoded text.
114decodeASCII :: ByteString -> Text
50decodeASCII :: ByteString -> Text
115−decodeASCII = decodeUtf8
51+decodeASCII bs = F.unstream (E.streamASCII bs)
116−{-# DEPRECATED decodeASCII "Use decodeUtf8 instead" #-}
52+{-# 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
53
130-- | Decode a 'ByteString' containing UTF-8 encoded text.
54-- | Decode a 'ByteString' containing UTF-8 encoded text.
131decodeUtf8With :: OnDecodeError -> ByteString -> Text
55decodeUtf8With :: OnDecodeError -> ByteString -> Text
132−decodeUtf8With onErr (PS fp off len) = runText $ \done -> do
56+decodeUtf8With onErr bs = F.unstream (E.streamUtf8 onErr bs)
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 #-}
57+{-# INLINE 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
58
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
59+-- | Decode a 'ByteString' containing UTF-8 encoded text.
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
239− -- We create a slightly larger than necessary buffer to accommodate a
240− -- potential surrogate pair started in the last buffer
241− decodeChunk :: ByteString -> CodePoint -> DecoderState -> ByteString
242− -> Decoding
243− decodeChunk undecoded0 codepoint0 state0 bs@(PS fp off len) =
244− runST $ (unsafeIOToST . decodeChunkToBuffer) =<< A.new (len+1)
245− where
246− decodeChunkToBuffer :: A.MArray s -> IO Decoding
247− decodeChunkToBuffer dest = withForeignPtr fp $ \ptr ->
248− with (0::CSize) $ \destOffPtr ->
249− with codepoint0 $ \codepointPtr ->
250− with state0 $ \statePtr ->
251− with nullPtr $ \curPtrPtr ->
252− let end = ptr `plusPtr` (off + len)
253− loop curPtr = do
254− poke curPtrPtr curPtr
255− curPtr' <- c_decode_utf8_with_state (A.maBA dest) destOffPtr
256− curPtrPtr end codepointPtr statePtr
257− state <- peek statePtr
258− case state of
259− UTF8_REJECT -> do
260− -- We encountered an encoding error
261− x <- peek curPtr'
262− poke statePtr 0
263− case onErr desc (Just x) of
264− Nothing -> loop $ curPtr' `plusPtr` 1
265− Just c -> do
266− destOff <- peek destOffPtr
267− w <- unsafeSTToIO $
268− unsafeWrite dest (fromIntegral destOff) (safe c)
269− poke destOffPtr (destOff + fromIntegral w)
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"
288−
289−-- | Decode a 'ByteString' containing UTF-8 encoded text that is known
290−-- to be valid.
291−--
292−-- If the input contains any invalid UTF-8 data, an exception will be
293−-- thrown that cannot be caught in pure code. For more control over
294−-- the handling of invalid data, use 'decodeUtf8'' or
295−-- 'decodeUtf8With'.
296decodeUtf8 :: ByteString -> Text
60decodeUtf8 :: ByteString -> Text
297decodeUtf8 = decodeUtf8With strictDecode
61decodeUtf8 = decodeUtf8With strictDecode
298−{-# INLINE[0] decodeUtf8 #-}
62+{-# INLINE decodeUtf8 #-}
299−{-# RULES "STREAM stream/decodeUtf8 fusion" [1]
300− forall bs. F.stream (decodeUtf8 bs) = E.streamUtf8 strictDecode bs #-}
301−
302−-- | Decode a 'ByteString' containing UTF-8 encoded text.
303−--
304−-- If the input contains any invalid UTF-8 data, the relevant
305−-- exception will be returned, otherwise the decoded text.
306−decodeUtf8' :: ByteString -> Either UnicodeException Text
307−decodeUtf8' = unsafeDupablePerformIO . try . evaluate . decodeUtf8With strictDecode
308−{-# INLINE decodeUtf8' #-}
309−
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
63
371-- | Encode text using UTF-8 encoding.
64-- | Encode text using UTF-8 encoding.
372encodeUtf8 :: Text -> ByteString
65encodeUtf8 :: Text -> ByteString
373−encodeUtf8 (Text arr off len)
66+encodeUtf8 txt = E.unstream (E.restreamUtf8 (F.stream txt))
374− | len == 0 = B.empty
67+{-# INLINE encodeUtf8 #-}
375− | otherwise = unsafeDupablePerformIO $ do
376− fp <- mallocByteString (len*4)
377− withForeignPtr fp $ \ptr ->
378− with ptr $ \destPtr -> do
379− c_encode_utf8 destPtr (A.aBA arr) (fromIntegral off) (fromIntegral len)
380− newDest <- peek destPtr
381− let utf8len = newDest `minusPtr` ptr
382− if utf8len >= len `shiftR` 1
383− then return (PS fp 0 utf8len)
384− else do
385− fp' <- mallocByteString utf8len
386− withForeignPtr fp' $ \ptr' -> do
387− memcpy ptr' ptr (fromIntegral utf8len)
388− return (PS fp' 0 utf8len)
389
68
390-- | Decode text from little endian UTF-16 encoding.
69-- | Decode text from little endian UTF-16 encoding.
391decodeUtf16LEWith :: OnDecodeError -> ByteString -> Text
70decodeUtf16LEWith :: OnDecodeError -> ByteString -> Text
@@ -393,10 +72,6 @@ decodeUtf16LEWith onErr bs = F.unstream (E.streamUtf16LE onErr bs)
393{-# INLINE decodeUtf16LEWith #-}
72{-# INLINE decodeUtf16LEWith #-}
394
73
395-- | Decode text from little endian UTF-16 encoding.
74-- | Decode text from little endian UTF-16 encoding.
396−--
397−-- If the input contains any invalid little endian UTF-16 data, an
398−-- exception will be thrown. For more control over the handling of
399−-- invalid data, use 'decodeUtf16LEWith'.
400decodeUtf16LE :: ByteString -> Text
75decodeUtf16LE :: ByteString -> Text
401decodeUtf16LE = decodeUtf16LEWith strictDecode
76decodeUtf16LE = decodeUtf16LEWith strictDecode
402{-# INLINE decodeUtf16LE #-}
77{-# INLINE decodeUtf16LE #-}
@@ -407,10 +82,6 @@ decodeUtf16BEWith onErr bs = F.unstream (E.streamUtf16BE onErr bs)
407{-# INLINE decodeUtf16BEWith #-}
82{-# INLINE decodeUtf16BEWith #-}
408
83
409-- | Decode text from big endian UTF-16 encoding.
84-- | Decode text from big endian UTF-16 encoding.
410−--
411−-- If the input contains any invalid big endian UTF-16 data, an
412−-- exception will be thrown. For more control over the handling of
413−-- invalid data, use 'decodeUtf16BEWith'.
414decodeUtf16BE :: ByteString -> Text
85decodeUtf16BE :: ByteString -> Text
415decodeUtf16BE = decodeUtf16BEWith strictDecode
86decodeUtf16BE = decodeUtf16BEWith strictDecode
416{-# INLINE decodeUtf16BE #-}
87{-# INLINE decodeUtf16BE #-}
@@ -431,10 +102,6 @@ decodeUtf32LEWith onErr bs = F.unstream (E.streamUtf32LE onErr bs)
431{-# INLINE decodeUtf32LEWith #-}
102{-# INLINE decodeUtf32LEWith #-}
432
103
433-- | Decode text from little endian UTF-32 encoding.
104-- | Decode text from little endian UTF-32 encoding.
434−--
435−-- If the input contains any invalid little endian UTF-32 data, an
436−-- exception will be thrown. For more control over the handling of
437−-- invalid data, use 'decodeUtf32LEWith'.
438decodeUtf32LE :: ByteString -> Text
105decodeUtf32LE :: ByteString -> Text
439decodeUtf32LE = decodeUtf32LEWith strictDecode
106decodeUtf32LE = decodeUtf32LEWith strictDecode
440{-# INLINE decodeUtf32LE #-}
107{-# INLINE decodeUtf32LE #-}
@@ -445,10 +112,6 @@ decodeUtf32BEWith onErr bs = F.unstream (E.streamUtf32BE onErr bs)
445{-# INLINE decodeUtf32BEWith #-}
112{-# INLINE decodeUtf32BEWith #-}
446
113
447-- | Decode text from big endian UTF-32 encoding.
114-- | Decode text from big endian UTF-32 encoding.
448−--
449−-- If the input contains any invalid big endian UTF-32 data, an
450−-- exception will be thrown. For more control over the handling of
451−-- invalid data, use 'decodeUtf32BEWith'.
452decodeUtf32BE :: ByteString -> Text
115decodeUtf32BE :: ByteString -> Text
453decodeUtf32BE = decodeUtf32BEWith strictDecode
116decodeUtf32BE = decodeUtf32BEWith strictDecode
454{-# INLINE decodeUtf32BE #-}
117{-# INLINE decodeUtf32BE #-}
@@ -462,18 +125,3 @@ encodeUtf32LE txt = E.unstream (E.restreamUtf32LE (F.stream txt))
462encodeUtf32BE :: Text -> ByteString
125encodeUtf32BE :: Text -> ByteString
463encodeUtf32BE txt = E.unstream (E.restreamUtf32BE (F.stream txt))
126encodeUtf32BE txt = E.unstream (E.restreamUtf32BE (F.stream txt))
464{-# INLINE encodeUtf32BE #-}
127{-# 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+11−24
@@ -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)
@@ -63,12 +62,7 @@ import Numeric (showHex)
63-- use the description provided to construct a more helpful error
62-- use the description provided to construct a more helpful error
64-- report.
63-- report.
65type OnError a b = String -> Maybe a -> Maybe b
64type OnError a b = String -> Maybe a -> Maybe b
66−
67−-- | A handler for a decoding error.
68type OnDecodeError = OnError Word8 Char
65type OnDecodeError = OnError Word8 Char
69−
70−-- | 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
66type OnEncodeError = OnError Char Word8
73
67
74-- | An exception type for representing Unicode encoding errors.
68-- | An exception type for representing Unicode encoding errors.
@@ -79,9 +73,7 @@ data UnicodeException =
79 | EncodeError String (Maybe Char)
73 | EncodeError String (Maybe Char)
80 -- ^ Tried to encode a character that could not be represented
74 -- ^ Tried to encode a character that could not be represented
81 -- under the given encoding, or ran out of input in mid-encode.
75 -- under the given encoding, or ran out of input in mid-encode.
82− deriving (Eq, Typeable)
76+ deriving (Typeable)
83−
84−{-# DEPRECATED EncodeError "This constructor is never used, and will be removed." #-}
85
77
86showUnicodeException :: UnicodeException -> String
78showUnicodeException :: UnicodeException -> String
87showUnicodeException (DecodeError desc (Just w))
79showUnicodeException (DecodeError desc (Just w))
@@ -92,28 +84,23 @@ showUnicodeException (EncodeError desc (Just c))
92 = "Cannot encode character '\\x" ++ showHex (fromEnum c) ("': " ++ desc)
84 = "Cannot encode character '\\x" ++ showHex (fromEnum c) ("': " ++ desc)
93showUnicodeException (EncodeError desc Nothing)
85showUnicodeException (EncodeError desc Nothing)
94 = "Cannot encode input: " ++ desc
86 = "Cannot encode input: " ++ desc
95−
87+
96instance Show UnicodeException where
88instance Show UnicodeException where
97 show = showUnicodeException
89 show = showUnicodeException
98
90
99instance Exception UnicodeException
91instance Exception UnicodeException
100
92
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.
93-- | Throw a 'UnicodeException' if decoding fails.
106−strictDecode :: OnDecodeError
94+strictDecode :: OnError Word8 Char
107strictDecode desc c = throw (DecodeError desc c)
95strictDecode desc c = throw (DecodeError desc c)
108
96
109-- | Replace an invalid input byte with the Unicode replacement
97-- | Replace an invalid input byte with the Unicode replacement
110-- character U+FFFD.
98-- character U+FFFD.
111−lenientDecode :: OnDecodeError
99+lenientDecode :: OnError Word8 Char
112lenientDecode _ _ = Just '\xfffd'
100lenientDecode _ _ = Just '\xfffd'
113
101
114-- | Throw a 'UnicodeException' if encoding fails.
102-- | Throw a 'UnicodeException' if encoding fails.
115−{-# DEPRECATED strictEncode "This function always throws an exception, and will be removed." #-}
116−strictEncode :: OnEncodeError
103+strictEncode :: OnError Char Word8
117strictEncode desc c = throw (EncodeError desc c)
104strictEncode desc c = throw (EncodeError desc c)
118
105
119-- | Ignore an invalid input, substituting nothing in the output.
106-- | Ignore an invalid input, substituting nothing in the output.
Data/Text/Internal/Encoding/Fusion.hs → Data/Text/Encoding/Fusion.hsrenamed+18−21
@@ -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
@@ -79,8 +75,9 @@ streamUtf8 onErr bs = Stream next 0 (maxSize l)
79 | i+1 < l && U8.validate2 x1 x2 = Yield (U8.chr2 x1 x2) (i+2)
75 | i+1 < l && U8.validate2 x1 x2 = Yield (U8.chr2 x1 x2) (i+2)
80 | i+2 < l && U8.validate3 x1 x2 x3 = Yield (U8.chr3 x1 x2 x3) (i+3)
76 | i+2 < l && U8.validate3 x1 x2 x3 = Yield (U8.chr3 x1 x2 x3) (i+3)
81 | i+3 < l && U8.validate4 x1 x2 x3 x4 = Yield (U8.chr4 x1 x2 x3 x4) (i+4)
77 | i+3 < l && U8.validate4 x1 x2 x3 x4 = Yield (U8.chr4 x1 x2 x3 x4) (i+4)
82− | otherwise = decodeError "streamUtf8" "UTF-8" onErr (Just x1) (i+1)
78+ | otherwise = decodeError "streamUtf8" "UTF-8" onErr mx (i+1)
83 where
79 where
80+ mx = if i >= l then Nothing else Just x1
84 x1 = idx i
81 x1 = idx i
85 x2 = idx (i + 1)
82 x2 = idx (i + 1)
86 x3 = idx (i + 2)
83 x3 = idx (i + 2)
@@ -166,7 +163,7 @@ streamUtf32LE onErr bs = Stream next 0 (maxSize (l `shiftR` 2))
166
163
167-- | /O(n)/ Convert a 'Stream' 'Word8' to a 'ByteString'.
164-- | /O(n)/ Convert a 'Stream' 'Word8' to a 'ByteString'.
168unstream :: Stream Word8 -> ByteString
165unstream :: Stream Word8 -> ByteString
169−unstream (Stream next s0 len) = unsafeDupablePerformIO $ do
166+unstream (Stream next s0 len) = unsafePerformIO $ do
170 let mlen = upperBound 4 len
167 let mlen = upperBound 4 len
171 mallocByteString mlen >>= loop mlen 0 s0
168 mallocByteString mlen >>= loop mlen 0 s0
172 where
169 where
@@ -204,5 +201,5 @@ decodeError func kind onErr mb i =
204 case onErr desc mb of
201 case onErr desc mb of
205 Nothing -> Skip i
202 Nothing -> Skip i
206 Just c -> Yield c i
203 Just c -> Yield c i
207− where desc = "Data.Text.Internal.Encoding.Fusion." ++ func ++ ": Invalid " ++
204+ where desc = "Data.Text.Encoding.Fusion." ++ func ++ ": Invalid " ++
208 kind ++ " stream"
205 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+9−12
@@ -1,22 +1,19 @@
1−{-# LANGUAGE MagicHash, BangPatterns #-}
1+{-# LANGUAGE MagicHash #-}
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) Tom Harper 2008-2009,
6−-- (c) 2009 Bryan O'Sullivan,
6+-- (c) Bryan O'Sullivan 2009,
7−-- (c) 2009 Duncan Coutts
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-- 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
@@ -36,7 +33,7 @@ chr2 (W16# a#) (W16# b#) = C# (chr# (upper# +# lower# +# 0x10000#))
36{-# INLINE chr2 #-}
33{-# INLINE chr2 #-}
37
34
38validate1 :: Word16 -> Bool
35validate1 :: Word16 -> Bool
39−validate1 x1 = x1 < 0xD800 || x1 > 0xDFFF
36+validate1 x1 = (x1 >= 0 && x1 < 0xD800) || x1 > 0xDFFF
40{-# INLINE validate1 #-}
37{-# INLINE validate1 #-}
41
38
42validate2 :: Word16 -> Word16 -> Bool
39validate2 :: Word16 -> Word16 -> Bool
Data/Text/Encoding/Utf32.hsnew file+23
@@ -0,0 +1,23 @@
1+-- |
2+-- Module : Data.Text.Encoding.Utf16
3+-- Copyright : (c) Tom Harper 2008-2009,
4+-- (c) Bryan O'Sullivan 2009,
5+-- (c) Duncan Coutts 2009
6+--
7+-- License : BSD-style
8+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
9+-- duncan@haskell.org
10+-- Stability : experimental
11+-- Portability : portable
12+--
13+-- Basic UTF-32 validation.
14+module Data.Text.Encoding.Utf32
15+ (
16+ validate
17+ ) where
18+
19+import Data.Word (Word32)
20+
21+validate :: Word32 -> Bool
22+validate x1 = (x1 >= 0x0 && x1 < 0xD800) || (x1 > 0xDFFF && x1 <= 0x10FFFF)
23+{-# INLINE validate #-}
Data/Text/Internal/Encoding/Utf8.hs → Data/Text/Encoding/Utf8.hsrenamed+28−30
@@ -1,22 +1,19 @@
1−{-# LANGUAGE CPP, MagicHash, BangPatterns #-}
1+{-# LANGUAGE CPP, MagicHash #-}
2
2
3-- |
3-- |
4−-- Module : Data.Text.Internal.Encoding.Utf8
4+-- Module : Data.Text.Encoding.Utf16
5−-- Copyright : (c) 2008, 2009 Tom Harper,
5+-- Copyright : (c) Tom Harper 2008-2009,
6−-- (c) 2009, 2010 Bryan O'Sullivan,
6+-- (c) Bryan O'Sullivan 2009,
7−-- (c) 2009 Duncan Coutts
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-- 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
@@ -55,7 +48,7 @@ between :: Word8 -- ^ byte to check
55between x y z = x >= y && x <= z
48between x y z = x >= y && x <= z
56{-# INLINE between #-}
49{-# INLINE between #-}
57
50
58−ord2 :: Char -> (Word8,Word8)
51+ord2 :: Char -> (Word8,Word8)
59ord2 c =
52ord2 c =
60#if defined(ASSERTS)
53#if defined(ASSERTS)
61 assert (n >= 0x80 && n <= 0x07ff)
54 assert (n >= 0x80 && n <= 0x07ff)
@@ -66,7 +59,7 @@ ord2 c =
66 x1 = fromIntegral $ (n `shiftR` 6) + 0xC0
59 x1 = fromIntegral $ (n `shiftR` 6) + 0xC0
67 x2 = fromIntegral $ (n .&. 0x3F) + 0x80
60 x2 = fromIntegral $ (n .&. 0x3F) + 0x80
68
61
69−ord3 :: Char -> (Word8,Word8,Word8)
62+ord3 :: Char -> (Word8,Word8,Word8)
70ord3 c =
63ord3 c =
71#if defined(ASSERTS)
64#if defined(ASSERTS)
72 assert (n >= 0x0800 && n <= 0xffff)
65 assert (n >= 0x0800 && n <= 0xffff)
@@ -78,7 +71,7 @@ ord3 c =
78 x2 = fromIntegral $ ((n `shiftR` 6) .&. 0x3F) + 0x80
71 x2 = fromIntegral $ ((n `shiftR` 6) .&. 0x3F) + 0x80
79 x3 = fromIntegral $ (n .&. 0x3F) + 0x80
72 x3 = fromIntegral $ (n .&. 0x3F) + 0x80
80
73
81−ord4 :: Char -> (Word8,Word8,Word8,Word8)
74+ord4 :: Char -> (Word8,Word8,Word8,Word8)
82ord4 c =
75ord4 c =
83#if defined(ASSERTS)
76#if defined(ASSERTS)
84 assert (n >= 0x10000)
77 assert (n >= 0x10000)
@@ -91,7 +84,7 @@ ord4 c =
91 x3 = fromIntegral $ ((n `shiftR` 6) .&. 0x3F) + 0x80
84 x3 = fromIntegral $ ((n `shiftR` 6) .&. 0x3F) + 0x80
92 x4 = fromIntegral $ (n .&. 0x3F) + 0x80
85 x4 = fromIntegral $ (n .&. 0x3F) + 0x80
93
86
94−chr2 :: Word8 -> Word8 -> Char
87+chr2 :: Word8 -> Word8 -> Char
95chr2 (W8# x1#) (W8# x2#) = C# (chr# (z1# +# z2#))
88chr2 (W8# x1#) (W8# x2#) = C# (chr# (z1# +# z2#))
96 where
89 where
97 !y1# = word2Int# x1#
90 !y1# = word2Int# x1#
@@ -100,7 +93,7 @@ chr2 (W8# x1#) (W8# x2#) = C# (chr# (z1# +# z2#))
100 !z2# = y2# -# 0x80#
93 !z2# = y2# -# 0x80#
101{-# INLINE chr2 #-}
94{-# INLINE chr2 #-}
102
95
103−chr3 :: Word8 -> Word8 -> Word8 -> Char
96+chr3 :: Word8 -> Word8 -> Word8 -> Char
104chr3 (W8# x1#) (W8# x2#) (W8# x3#) = C# (chr# (z1# +# z2# +# z3#))
97chr3 (W8# x1#) (W8# x2#) (W8# x3#) = C# (chr# (z1# +# z2# +# z3#))
105 where
98 where
106 !y1# = word2Int# x1#
99 !y1# = word2Int# x1#
@@ -125,17 +118,20 @@ chr4 (W8# x1#) (W8# x2#) (W8# x3#) (W8# x4#) =
125 !z4# = y4# -# 0x80#
118 !z4# = y4# -# 0x80#
126{-# INLINE chr4 #-}
119{-# INLINE chr4 #-}
127
120
128−validate1 :: Word8 -> Bool
121+validate1 :: Word8 -> Bool
129−validate1 x1 = x1 <= 0x7F
122+validate1 x1 = between x1 0x00 0x7F
130{-# INLINE validate1 #-}
123{-# INLINE validate1 #-}
131
124
132−validate2 :: Word8 -> Word8 -> Bool
125+validate2 :: Word8 -> Word8 -> Bool
133validate2 x1 x2 = between x1 0xC2 0xDF && between x2 0x80 0xBF
126validate2 x1 x2 = between x1 0xC2 0xDF && between x2 0x80 0xBF
134{-# INLINE validate2 #-}
127{-# INLINE validate2 #-}
135
128
136−validate3 :: Word8 -> Word8 -> Word8 -> Bool
129+validate3 :: Word8 -> Word8 -> Word8 -> Bool
137{-# INLINE validate3 #-}
130{-# INLINE validate3 #-}
138−validate3 x1 x2 x3 = validate3_1 || validate3_2 || validate3_3 || validate3_4
131+validate3 x1 x2 x3 = validate3_1 ||
132+ validate3_2 ||
133+ validate3_3 ||
134+ validate3_4
139 where
135 where
140 validate3_1 = (x1 == 0xE0) &&
136 validate3_1 = (x1 == 0xE0) &&
141 between x2 0xA0 0xBF &&
137 between x2 0xA0 0xBF &&
@@ -150,10 +146,12 @@ validate3 x1 x2 x3 = validate3_1 || validate3_2 || validate3_3 || validate3_4
150 between x2 0x80 0xBF &&
146 between x2 0x80 0xBF &&
151 between x3 0x80 0xBF
147 between x3 0x80 0xBF
152
148
153−validate4 :: Word8 -> Word8 -> Word8 -> Word8 -> Bool
149+validate4 :: Word8 -> Word8 -> Word8 -> Word8 -> Bool
154{-# INLINE validate4 #-}
150{-# INLINE validate4 #-}
155−validate4 x1 x2 x3 x4 = validate4_1 || validate4_2 || validate4_3
151+validate4 x1 x2 x3 x4 = validate4_1 ||
152+ validate4_2 ||
153+ validate4_3
156− where
154+ where
157 validate4_1 = x1 == 0xF0 &&
155 validate4_1 = x1 == 0xF0 &&
158 between x2 0x90 0xBF &&
156 between x2 0x90 0xBF &&
159 between x3 0x80 0xBF &&
157 between x3 0x80 0xBF &&
Data/Text/Foreign.hs+19−96
@@ -1,10 +1,11 @@
1−{-# LANGUAGE BangPatterns, CPP, GeneralizedNewtypeDeriving #-}
1+{-# LANGUAGE BangPatterns, CPP #-}
2-- |
2-- |
3-- Module : Data.Text.Foreign
3-- Module : Data.Text.Foreign
4−-- Copyright : (c) 2009, 2010 Bryan O'Sullivan
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--
@@ -15,42 +16,25 @@ module Data.Text.Foreign
15 (
16 (
16 -- * Interoperability with native code
17 -- * Interoperability with native code
17 -- $interop
18 -- $interop
18− I16
19+
19 -- * Safe conversion functions
20 -- * Safe conversion functions
20− , fromPtr
21+ fromPtr
21 , useAsPtr
22 , useAsPtr
22− , asForeignPtr
23− -- ** Encoding as UTF-8
24− , peekCStringLen
25− , withCStringLen
26 -- * Unsafe conversion code
23 -- * Unsafe conversion code
27 , lengthWord16
24 , lengthWord16
28 , unsafeCopyToPtr
25 , unsafeCopyToPtr
29− -- * Low-level manipulation
30− -- $lowlevel
31− , dropWord16
32− , takeWord16
33 ) where
26 ) where
34
27
35#if defined(ASSERTS)
28#if defined(ASSERTS)
36import Control.Exception (assert)
29import Control.Exception (assert)
37#endif
30#endif
38−#if __GLASGOW_HASKELL__ >= 702
39−import Control.Monad.ST.Unsafe (unsafeIOToST)
40−#else
41import Control.Monad.ST (unsafeIOToST)
31import 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)
32import Data.Text.Internal (Text(..), empty)
46−import Data.Text.Unsafe (lengthWord16)
33+import qualified Data.Text.Array as A
47import Data.Word (Word16)
34import Data.Word (Word16)
48−import Foreign.C.String (CStringLen)
49−import Foreign.ForeignPtr (ForeignPtr, mallocForeignPtrArray, withForeignPtr)
50import Foreign.Marshal.Alloc (allocaBytes)
35import Foreign.Marshal.Alloc (allocaBytes)
51import Foreign.Ptr (Ptr, castPtr, plusPtr)
36import Foreign.Ptr (Ptr, castPtr, plusPtr)
52import Foreign.Storable (peek, poke)
37import Foreign.Storable (peek, poke)
53−import qualified Data.Text.Array as A
54
38
55-- $interop
39-- $interop
56--
40--
@@ -65,23 +49,19 @@ import qualified Data.Text.Array as A
65-- internal representations, such as UTF-8 or UTF-32, consider using
49-- internal representations, such as UTF-8 or UTF-32, consider using
66-- the functions in the 'Data.Text.Encoding' module.
50-- the functions in the 'Data.Text.Encoding' module.
67
51
68−-- | A type representing a number of UTF-16 code units.
69−newtype I16 = I16 Int
70− deriving (Bounded, Enum, Eq, Integral, Num, Ord, Read, Real, Show)
71−
72-- | /O(n)/ Create a new 'Text' from a 'Ptr' 'Word16' by copying the
52-- | /O(n)/ Create a new 'Text' from a 'Ptr' 'Word16' by copying the
73-- contents of the array.
53-- contents of the array.
74fromPtr :: Ptr Word16 -- ^ source array
54fromPtr :: Ptr Word16 -- ^ source array
75− -> I16 -- ^ length of source array (in 'Word16' units)
55+ -> Int -- ^ length of source array (in 'Word16' units)
76 -> IO Text
56 -> IO Text
77−fromPtr _ (I16 0) = return empty
57+fromPtr _ 0 = return empty
78−fromPtr ptr (I16 len) =
58+fromPtr ptr len =
79#if defined(ASSERTS)
59#if defined(ASSERTS)
80 assert (len > 0) $
60 assert (len > 0) $
81#endif
61#endif
82 return $! Text arr 0 len
62 return $! Text arr 0 len
83 where
63 where
84− arr = A.run (A.new len >>= copy)
64+ arr = A.run (A.unsafeNew len >>= copy)
85 copy marr = loop ptr 0
65 copy marr = loop ptr 0
86 where
66 where
87 loop !p !i | i == len = return marr
67 loop !p !i | i == len = return marr
@@ -89,44 +69,12 @@ fromPtr ptr (I16 len) =
89 A.unsafeWrite marr i =<< unsafeIOToST (peek p)
69 A.unsafeWrite marr i =<< unsafeIOToST (peek p)
90 loop (p `plusPtr` 2) (i + 1)
70 loop (p `plusPtr` 2) (i + 1)
91
71
92−-- $lowlevel
72+-- | /O(1)/ Return the length of a 'Text' in units of 'Word16'. This
93−--
73+-- is useful for sizing a target array appropriately before using
94−-- Foreign functions that use UTF-16 internally may return indices in
74+-- 'unsafeCopyToPtr'.
95−-- units of 'Word16' instead of characters. These functions may
75+lengthWord16 :: Text -> Int
96−-- safely be used with such indices, as they will adjust offsets if
76+lengthWord16 (Text _arr _off len) = len
97−-- necessary to preserve the validity of a Unicode string.
77+{-# INLINE lengthWord16 #-}
98−
99−-- | /O(1)/ Return the prefix of the 'Text' of @n@ 'Word16' units in
100−-- length.
101−--
102−-- If @n@ would cause the 'Text' to end inside a surrogate pair, the
103−-- end of the prefix will be advanced by one additional 'Word16' unit
104−-- to maintain its validity.
105−takeWord16 :: I16 -> Text -> Text
106−takeWord16 (I16 n) t@(Text arr off len)
107− | n <= 0 = empty
108− | n >= len || m >= len = t
109− | otherwise = Text arr off m
110− where
111− m | w < 0xDB00 || w > 0xD8FF = n
112− | otherwise = n+1
113− w = A.unsafeIndex arr (off+n-1)
114−
115−-- | /O(1)/ Return the suffix of the 'Text', with @n@ 'Word16' units
116−-- dropped from its beginning.
117−--
118−-- If @n@ would cause the 'Text' to begin inside a surrogate pair, the
119−-- beginning of the suffix will be advanced by one additional 'Word16'
120−-- unit to maintain its validity.
121−dropWord16 :: I16 -> Text -> Text
122−dropWord16 (I16 n) t@(Text arr off len)
123− | n <= 0 = t
124− | n >= len || m >= len = empty
125− | otherwise = Text arr (off+m) (len-m)
126− where
127− m | w < 0xD800 || w > 0xDBFF = n
128− | otherwise = n+1
129− w = A.unsafeIndex arr (off+n-1)
130
78
131-- | /O(n)/ Copy a 'Text' to an array. The array is assumed to be big
79-- | /O(n)/ Copy a 'Text' to an array. The array is assumed to be big
132-- enough to hold the contents of the entire 'Text'.
80-- enough to hold the contents of the entire 'Text'.
@@ -141,33 +89,8 @@ unsafeCopyToPtr (Text arr off len) ptr = loop ptr off
141
89
142-- | /O(n)/ Perform an action on a temporary, mutable copy of a
90-- | /O(n)/ Perform an action on a temporary, mutable copy of a
143-- 'Text'. The copy is freed as soon as the action returns.
91-- 'Text'. The copy is freed as soon as the action returns.
144−useAsPtr :: Text -> (Ptr Word16 -> I16 -> IO a) -> IO a
92+useAsPtr :: Text -> (Ptr Word16 -> Int -> IO a) -> IO a
145useAsPtr t@(Text _arr _off len) action =
93useAsPtr t@(Text _arr _off len) action =
146 allocaBytes (len * 2) $ \buf -> do
94 allocaBytes (len * 2) $ \buf -> do
147 unsafeCopyToPtr t buf
95 unsafeCopyToPtr t buf
148− action (castPtr buf) (fromIntegral len)
96+ action (castPtr buf) len
149−
150−-- | /O(n)/ Make a mutable copy of a 'Text'.
151−asForeignPtr :: Text -> IO (ForeignPtr Word16, I16)
152−asForeignPtr t@(Text _arr _off len) = do
153− fp <- mallocForeignPtrArray len
154− withForeignPtr fp $ unsafeCopyToPtr t
155− 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+40−88
@@ -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,
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(..)
@@ -37,9 +34,6 @@ module Data.Text.Internal.Fusion
37 -- ** Scans
34 -- ** Scans
38 , reverseScanr
35 , reverseScanr
39
36
40− -- ** Accumulating maps
41− , mapAccumL
42−
43 -- ** Generation and unfolding
37 -- ** Generation and unfolding
44 , unfoldrN
38 , unfoldrN
45
39
@@ -54,21 +48,21 @@ import Prelude (Bool(..), Char, Maybe(..), Monad(..), Int,
54 fromIntegral, otherwise)
48 fromIntegral, otherwise)
55import Data.Bits ((.&.))
49import Data.Bits ((.&.))
56import Data.Text.Internal (Text(..))
50import Data.Text.Internal (Text(..))
57−import Data.Text.Internal.Private (runText)
58−import Data.Text.Internal.Unsafe.Char (ord, unsafeChr, unsafeWrite)
51+import Data.Text.UnsafeChar (ord, unsafeChr, unsafeWrite)
59−import Data.Text.Internal.Unsafe.Shift (shiftL, shiftR)
52+import Data.Text.UnsafeShift (shiftL, shiftR)
60import qualified Data.Text.Array as A
53import qualified Data.Text.Array as A
61−import qualified Data.Text.Internal.Fusion.Common as S
54+import qualified Data.Text.Fusion.Common as S
62−import Data.Text.Internal.Fusion.Types
55+import Data.Text.Fusion.Internal
63−import Data.Text.Internal.Fusion.Size
56+import Data.Text.Fusion.Size
64import qualified Data.Text.Internal as I
57import qualified Data.Text.Internal as I
65−import qualified Data.Text.Internal.Encoding.Utf16 as U16
58+import qualified Data.Text.Encoding.Utf16 as U16
59+import qualified Prelude as P
66
60
67default(Int)
61default(Int)
68
62
69-- | /O(n)/ Convert a 'Text' into a 'Stream Char'.
63-- | /O(n)/ Convert a 'Text' into a 'Stream Char'.
70stream :: Text -> Stream Char
64stream :: Text -> Stream Char
71−stream (Text arr off len) = Stream next off (betweenSize (len `shiftR` 1) len)
65+stream (Text arr off len) = Stream next off (maxSize len)
72 where
66 where
73 !end = off+len
67 !end = off+len
74 next !i
68 next !i
@@ -83,7 +77,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
77-- | /O(n)/ Convert a 'Text' into a 'Stream Char', but iterate
84-- backwards.
78-- backwards.
85reverseStream :: Text -> Stream Char
79reverseStream :: Text -> Stream Char
86−reverseStream (Text arr off len) = Stream next (off+len-1) (betweenSize (len `shiftR` 1) len)
80+reverseStream (Text arr off len) = Stream next (off+len-1) (maxSize len)
87 where
81 where
88 {-# INLINE next #-}
82 {-# INLINE next #-}
89 next !i
83 next !i
@@ -97,36 +91,21 @@ reverseStream (Text arr off len) = Stream next (off+len-1) (betweenSize (len `sh
97
91
98-- | /O(n)/ Convert a 'Stream Char' into a 'Text'.
92-- | /O(n)/ Convert a 'Stream Char' into a 'Text'.
99unstream :: Stream Char -> Text
93unstream :: Stream Char -> Text
100−unstream (Stream next0 s0 len) = runText $ \done -> do
94+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
95+ where
102− -- worst case encoding size of two 16-bit units for the char. Just add an
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
96+ mlen = upperBound 4 len
106− arr0 <- A.new mlen
97+ a = A.run2 (A.unsafeNew mlen >>= (\arr -> loop arr mlen s0 0))
107− let outer !arr !maxi = encode
98+ loop arr !top !s !i
108− where
99+ | i + 1 >= top = case next0 s of
109− -- keep the common case loop as small as possible
100+ Done -> return (arr, i)
110− encode !si !di =
101+ _ -> do
111− case next0 si of
102+ let top' = (top `shiftL` 1) + 1
112− Done -> done arr di
103+ arr' <- A.unsafeNew top'
113− Skip si' -> encode si' di
104+ A.copy arr arr' >> loop arr' top' s i
114− Yield c si'
105+ | otherwise = case next0 s of
115− -- simply check for the worst case
106+ Done -> return (arr, i)
116− | maxi < di + 1 -> realloc si di
107+ Skip s' -> loop arr top s' i
117− | otherwise -> do
118− n <- unsafeWrite arr di c
108+ Yield x s' -> unsafeWrite arr i x >>= loop arr top s'
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
126− A.copyM arr' 0 arr 0 di
127− outer arr' (newlen - 1) si di
128−
129− outer arr0 (mlen - 1) s0 0
130{-# INLINE [0] unstream #-}
109{-# INLINE [0] unstream #-}
131{-# RULES "STREAM stream/unstream fusion" forall s. stream (unstream s) = s #-}
110{-# RULES "STREAM stream/unstream fusion" forall s. stream (unstream s) = s #-}
132
111
@@ -142,10 +121,10 @@ length = S.lengthI
142reverse :: Stream Char -> Text
121reverse :: Stream Char -> Text
143reverse (Stream next s len0)
122reverse (Stream next s len0)
144 | isEmpty len0 = I.empty
123 | isEmpty len0 = I.empty
145− | otherwise = I.text arr off' len'
124+ | otherwise = I.textP arr off' len'
146 where
125 where
147 len0' = upperBound 4 (larger len0 4)
126 len0' = upperBound 4 (larger len0 4)
148− (arr, (off', len')) = A.run2 (A.new len0' >>= loop s (len0'-1) len0')
127+ (arr, (off', len')) = A.run2 (A.unsafeNew len0' >>= loop s (len0'-1) len0')
149 loop !s0 !i !len marr =
128 loop !s0 !i !len marr =
150 case next s0 of
129 case next s0 of
151 Done -> return (marr, (j, len-j))
130 Done -> return (marr, (j, len-j))
@@ -153,8 +132,8 @@ reverse (Stream next s len0)
153 Skip s1 -> loop s1 i len marr
132 Skip s1 -> loop s1 i len marr
154 Yield x s1 | i < least -> {-# SCC "reverse/resize" #-} do
133 Yield x s1 | i < least -> {-# SCC "reverse/resize" #-} do
155 let newLen = len `shiftL` 1
134 let newLen = len `shiftL` 1
156− marr' <- A.new newLen
135+ marr' <- A.unsafeNew newLen
157− A.copyM marr' (newLen-len) marr 0 len
136+ A.unsafeCopy marr 0 marr' (newLen-len) len
158 write s1 (len+i) newLen marr'
137 write s1 (len+i) newLen marr'
159 | otherwise -> write s1 i len marr
138 | otherwise -> write s1 i len marr
160 where n = ord x
139 where n = ord x
@@ -176,15 +155,15 @@ reverse (Stream next s len0)
176-- | /O(n)/ Perform the equivalent of 'scanr' over a list, only with
155-- | /O(n)/ Perform the equivalent of 'scanr' over a list, only with
177-- the input and result reversed.
156-- the input and result reversed.
178reverseScanr :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char
157reverseScanr :: (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
158+reverseScanr f z0 (Stream next0 s0 len) = Stream next (S1 :*: z0 :*: s0) (len+1) -- HINT maybe too low
180 where
159 where
181 {-# INLINE next #-}
160 {-# INLINE next #-}
182− next (Scan1 z s) = Yield z (Scan2 z s)
161+ next (S1 :*: z :*: s) = Yield z (S2 :*: z :*: s)
183− next (Scan2 z s) = case next0 s of
162+ next (S2 :*: z :*: s) = case next0 s of
184− Yield x s' -> let !x' = f x z
163+ Yield x s' -> let !x' = f x z
185− in Yield x' (Scan2 x' s')
164+ in Yield x' (S2 :*: x' :*: s')
186− Skip s' -> Skip (Scan2 z s')
165+ Skip s' -> Skip (S2 :*: z :*: s')
187− Done -> Done
166+ Done -> Done
188{-# INLINE reverseScanr #-}
167{-# INLINE reverseScanr #-}
189
168
190-- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a stream from a seed
169-- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a stream from a seed
@@ -215,30 +194,3 @@ findIndex = S.findIndexI
215countChar :: Char -> Stream Char -> Int
194countChar :: Char -> Stream Char -> Int
216countChar = S.countCharI
195countChar = S.countCharI
217{-# INLINE [0] countChar #-}
196{-# INLINE [0] countChar #-}
218−
219−-- | /O(n)/ Like a combination of 'map' and 'foldl''. Applies a
220−-- function to each element of a 'Text', passing an accumulating
221−-- parameter from left to right, and returns a final 'Text'.
222−mapAccumL :: (a -> Char -> (a,Char)) -> a -> Stream Char -> (a, Text)
223−mapAccumL f z0 (Stream next0 s0 len) = (nz, I.text na 0 nl)
224− where
225− (na,(nz,nl)) = A.run2 (A.new mlen >>= \arr -> outer arr mlen z0 s0 0)
226− where mlen = upperBound 4 len
227− outer arr top = loop
228− where
229− loop !z !s !i =
230− case next0 s of
231− Done -> return (arr, (z,i))
232− Skip s' -> loop z s' i
233− Yield x s'
234− | j >= top -> {-# SCC "mapAccumL/resize" #-} do
235− let top' = (top + 1) `shiftL` 1
236− arr' <- A.new top'
237− A.copyM arr' 0 arr 0 top
238− outer arr' top' z s i
239− | otherwise -> do d <- unsafeWrite arr i c
240− loop z' s' (i+d)
241− where (z',c) = f z x
242− j | ord c < 0x10000 = i
243− | otherwise = i + 1
244−{-# 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−173
@@ -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
@@ -33,7 +29,6 @@ module Data.Text.Internal.Fusion.Common
33 , init
29 , init
34 , null
30 , null
35 , lengthI
31 , lengthI
36− , compareLengthI
37 , isSingleton
32 , isSingleton
38
33
39 -- * Transformations
34 -- * Transformations
@@ -45,7 +40,6 @@ module Data.Text.Internal.Fusion.Common
45 -- $case
40 -- $case
46 , toCaseFold
41 , toCaseFold
47 , toLower
42 , toLower
48− , toTitle
49 , toUpper
43 , toUpper
50
44
51 -- ** Justification
45 -- ** Justification
@@ -71,6 +65,9 @@ module Data.Text.Internal.Fusion.Common
71 -- ** Scans
65 -- ** Scans
72 , scanl
66 , scanl
73
67
68+ -- ** Accumulating maps
69+ -- , mapAccumL
70+
74 -- ** Generation and unfolding
71 -- ** Generation and unfolding
75 , replicateCharI
72 , replicateCharI
76 , replicateI
73 , replicateI
@@ -102,25 +99,20 @@ module Data.Text.Internal.Fusion.Common
102 ) where
99 ) where
103
100
104import Prelude (Bool(..), Char, Eq(..), Int, Integral, Maybe(..),
101import Prelude (Bool(..), Char, Eq(..), Int, Integral, Maybe(..),
105− Ord(..), Ordering(..), String, (.), ($), (+), (-), (*), (++),
102+ Ord(..), String, (.), ($), (+), (-), (*), (++), (&&),
106− (&&), fromIntegral, otherwise)
103+ fromIntegral, otherwise)
107import qualified Data.List as L
104import qualified Data.List as L
108import qualified Prelude as P
105import qualified Prelude as P
109−import Data.Bits (shiftL)
110−import Data.Char (isLetter)
111import Data.Int (Int64)
106import Data.Int (Int64)
112−import Data.Text.Internal.Fusion.Types
107+import Data.Text.Fusion.Internal
113−import Data.Text.Internal.Fusion.CaseMapping (foldMapping, lowerMapping, titleMapping,
108+import Data.Text.Fusion.CaseMapping (foldMapping, lowerMapping, upperMapping)
114− upperMapping)
115−import Data.Text.Internal.Fusion.Size
109+import Data.Text.Fusion.Size
116−import GHC.Prim (Addr#, chr#, indexCharOffAddr#, ord#)
117−import GHC.Types (Char(..), Int(..))
118
110
119singleton :: Char -> Stream Char
111singleton :: Char -> Stream Char
120singleton c = Stream next False 1
112singleton c = Stream next False 1
121 where next False = Yield c True
113 where next False = Yield c True
122 next True = Done
114 next True = Done
123−{-# INLINE [0] singleton #-}
115+{-# INLINE singleton #-}
124
116
125streamList :: [a] -> Stream a
117streamList :: [a] -> Stream a
126{-# INLINE [0] streamList #-}
118{-# INLINE [0] streamList #-}
@@ -138,35 +130,6 @@ unstreamList (Stream next s0 _len) = unfold s0
138
130
139{-# RULES "STREAM streamList/unstreamList fusion" forall s. streamList (unstreamList s) = s #-}
131{-# RULES "STREAM streamList/unstreamList fusion" forall s. streamList (unstreamList s) = s #-}
140
132
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-- ----------------------------------------------------------------------------
133-- ----------------------------------------------------------------------------
171-- * Basic stream functions
134-- * Basic stream functions
172
135
@@ -175,7 +138,7 @@ data C s = C0 !s
175
138
176-- | /O(n)/ Adds a character to the front of a Stream Char.
139-- | /O(n)/ Adds a character to the front of a Stream Char.
177cons :: Char -> Stream Char -> Stream Char
140cons :: Char -> Stream Char -> Stream Char
178−cons !w (Stream next0 s0 len) = Stream next (C1 s0) (len+1)
141+cons w (Stream next0 s0 len) = Stream next (C1 s0) (len+1)
179 where
142 where
180 next (C1 s) = Yield w (C0 s)
143 next (C1 s) = Yield w (C0 s)
181 next (C0 s) = case next0 s of
144 next (C0 s) = case next0 s of
@@ -184,9 +147,6 @@ cons !w (Stream next0 s0 len) = Stream next (C1 s0) (len+1)
184 Yield x s' -> Yield x (C0 s')
147 Yield x s' -> Yield x (C0 s')
185{-# INLINE [0] cons #-}
148{-# INLINE [0] cons #-}
186
149
187−data Snoc a = N
188− | J !a
189−
190-- | /O(n)/ Adds a character to the end of a stream.
150-- | /O(n)/ Adds a character to the end of a stream.
191snoc :: Stream Char -> Char -> Stream Char
151snoc :: Stream Char -> Char -> Stream Char
192snoc (Stream next0 xs0 len) w = Stream next (J xs0) (len+1)
152snoc (Stream next0 xs0 len) w = Stream next (J xs0) (len+1)
@@ -198,8 +158,8 @@ snoc (Stream next0 xs0 len) w = Stream next (J xs0) (len+1)
198 next N = Done
158 next N = Done
199{-# INLINE [0] snoc #-}
159{-# INLINE [0] snoc #-}
200
160
201−data E l r = L !l
161+data E l r = L {-# UNPACK #-} !l
202− | R !r
162+ | R {-# UNPACK #-} !r
203
163
204-- | /O(n)/ Appends one Stream to the other.
164-- | /O(n)/ Appends one Stream to the other.
205append :: Stream Char -> Stream Char -> Stream Char
165append :: Stream Char -> Stream Char -> Stream Char
@@ -224,13 +184,9 @@ head (Stream next s0 _len) = loop_head s0
224 loop_head !s = case next s of
184 loop_head !s = case next s of
225 Yield x _ -> x
185 Yield x _ -> x
226 Skip s' -> loop_head s'
186 Skip s' -> loop_head s'
227− Done -> head_empty
187+ Done -> streamError "head" "Empty stream"
228{-# INLINE [0] head #-}
188{-# INLINE [0] head #-}
229
189
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
190-- | /O(1)/ Returns the first character and remainder of a 'Stream
235-- Char', or 'Nothing' if empty. Subject to array fusion.
191-- Char', or 'Nothing' if empty. Subject to array fusion.
236uncons :: Stream Char -> Maybe (Char, Stream Char)
192uncons :: Stream Char -> Maybe (Char, Stream Char)
@@ -310,26 +266,6 @@ lengthI (Stream next s0 _len) = loop_length 0 s0
310 Yield _ s' -> loop_length (z + 1) s'
266 Yield _ s' -> loop_length (z + 1) s'
311{-# INLINE[0] lengthI #-}
267{-# INLINE[0] lengthI #-}
312
268
313−-- | /O(n)/ Compares the count of characters in a string to a number.
314−-- Subject to fusion.
315−--
316−-- This function gives the same answer as comparing against the result
317−-- 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.
320−compareLengthI :: Integral a => Stream Char -> a -> Ordering
321−compareLengthI (Stream next s0 len) n =
322− case compareSize len (fromIntegral n) of
323− Just o -> o
324− Nothing -> loop_cmp 0 s0
325− where
326− loop_cmp !z s = case next s of
327− Done -> compare z n
328− Skip s' -> loop_cmp z s'
329− Yield _ s' | z > n -> GT
330− | otherwise -> loop_cmp (z + 1) s'
331−{-# INLINE[0] compareLengthI #-}
332−
333-- | /O(n)/ Indicate whether a string contains exactly one element.
269-- | /O(n)/ Indicate whether a string contains exactly one element.
334isSingleton :: Stream Char -> Bool
270isSingleton :: Stream Char -> Bool
335isSingleton (Stream next s0 _len) = loop 0 s0
271isSingleton (Stream next s0 _len) = loop 0 s0
@@ -439,54 +375,17 @@ toLower :: Stream Char -> Stream Char
439toLower = caseConvert lowerMapping
375toLower = caseConvert lowerMapping
440{-# INLINE [0] toLower #-}
376{-# INLINE [0] toLower #-}
441
377
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
378justifyLeftI :: Integral a => a -> Char -> Stream Char -> Stream Char
480justifyLeftI k c (Stream next0 s0 len) =
379justifyLeftI k c (Stream next0 s0 len) =
481− Stream next (Just1 0 s0) (larger (fromIntegral k) len)
380+ Stream next (s0 :*: S1 :*: 0) (larger (fromIntegral k) len)
482 where
381 where
483− next (Just1 n s) =
382+ next (s :*: S1 :*: n) =
484 case next0 s of
383 case next0 s of
485− Done -> next (Just2 n s)
384+ Done -> next (s :*: S2 :*: n)
486− Skip s' -> Skip (Just1 n s')
385+ Skip s' -> Skip (s' :*: S1 :*: n)
487− Yield x s' -> Yield x (Just1 (n+1) s')
386+ Yield x s' -> Yield x (s' :*: S1 :*: n+1)
488− next (Just2 n s)
387+ next (s :*: S2 :*: n)
489− | n < k = Yield c (Just2 (n+1) s)
388+ | n < k = Yield c (s :*: S2 :*: n+1)
490 | otherwise = Done
389 | otherwise = Done
491 {-# INLINE next #-}
390 {-# INLINE next #-}
492{-# INLINE [0] justifyLeftI #-}
391{-# INLINE [0] justifyLeftI #-}
@@ -593,7 +492,7 @@ concatMap f = foldr (append . f) empty
593{-# INLINE [0] concatMap #-}
492{-# INLINE [0] concatMap #-}
594
493
595-- | /O(n)/ any @p @xs determines if any character in the stream
494-- | /O(n)/ any @p @xs determines if any character in the stream
596−-- @xs@ satisfies the predicate @p@.
495+-- @xs@ satisifes the predicate @p@.
597any :: (Char -> Bool) -> Stream Char -> Bool
496any :: (Char -> Bool) -> Stream Char -> Bool
598any p (Stream next0 s0 _len) = loop_any s0
497any p (Stream next0 s0 _len) = loop_any s0
599 where
498 where
@@ -605,7 +504,7 @@ any p (Stream next0 s0 _len) = loop_any s0
605{-# INLINE [0] any #-}
504{-# INLINE [0] any #-}
606
505
607-- | /O(n)/ all @p @xs determines if all characters in the 'Text'
506-- | /O(n)/ all @p @xs determines if all characters in the 'Text'
608−-- @xs@ satisfy the predicate @p@.
507+-- @xs@ satisify the predicate @p@.
609all :: (Char -> Bool) -> Stream Char -> Bool
508all :: (Char -> Bool) -> Stream Char -> Bool
610all p (Stream next0 s0 _len) = loop_all s0
509all p (Stream next0 s0 _len) = loop_all s0
611 where
510 where
@@ -654,27 +553,50 @@ minimum (Stream next0 s0 _len) = loop0_minimum s0
654-- * Building streams
553-- * Building streams
655
554
656scanl :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char
555scanl :: (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
556+scanl f z0 (Stream next0 s0 len) = Stream next (S1 :*: z0 :*: s0) (len+1) -- HINT maybe too low
658 where
557 where
659 {-# INLINE next #-}
558 {-# INLINE next #-}
660− next (Scan1 z s) = Yield z (Scan2 z s)
559+ next (S1 :*: z :*: s) = Yield z (S2 :*: z :*: s)
661− next (Scan2 z s) = case next0 s of
560+ next (S2 :*: z :*: s) = case next0 s of
662− Yield x s' -> let !x' = f z x
561+ Yield x s' -> let !x' = f z x
663− in Yield x' (Scan2 x' s')
562+ in Yield x' (S2 :*: x' :*: s')
664− Skip s' -> Skip (Scan2 z s')
563+ Skip s' -> Skip (S2 :*: z :*: s')
665− Done -> Done
564+ Done -> Done
666{-# INLINE [0] scanl #-}
565{-# INLINE [0] scanl #-}
667
566
567+-- -----------------------------------------------------------------------------
568+-- ** Accumulating maps
569+
570+{-
571+-- | /O(n)/ Like a combination of 'map' and 'foldl'. Applies a
572+-- function to each element of a stream, passing an accumulating
573+-- parameter from left to right, and returns a final stream.
574+--
575+-- /Note/: Unlike the version over lists, this function does not
576+-- return a final value for the accumulator, because the nature of
577+-- streams precludes it.
578+mapAccumL :: (a -> b -> (a,b)) -> a -> Stream b -> Stream b
579+mapAccumL f z0 (Stream next0 s0 len) = Stream next (s0 :*: z0) len -- HINT depends on f
580+ where
581+ {-# INLINE next #-}
582+ next (s :*: z) = case next0 s of
583+ Yield x s' -> let (z',y) = f z x
584+ in Yield y (s' :*: z')
585+ Skip s' -> Skip (s' :*: z)
586+ Done -> Done
587+{-# INLINE [0] mapAccumL #-}
588+-}
589+
668-- -----------------------------------------------------------------------------
590-- -----------------------------------------------------------------------------
669-- ** Generating and unfolding streams
591-- ** Generating and unfolding streams
670
592
671replicateCharI :: Integral a => a -> Char -> Stream Char
593replicateCharI :: Integral a => a -> Char -> Stream Char
672−replicateCharI !n !c
594+replicateCharI n c
673 | n < 0 = empty
595 | n < 0 = empty
674 | otherwise = Stream next 0 (fromIntegral n) -- HINT maybe too low
596 | otherwise = Stream next 0 (fromIntegral n) -- HINT maybe too low
675 where
597 where
676− next !i | i >= n = Done
598+ next i | i >= n = Done
677− | otherwise = Yield c (i + 1)
599+ | otherwise = Yield c (i + 1)
678{-# INLINE [0] replicateCharI #-}
600{-# INLINE [0] replicateCharI #-}
679
601
680data RI s = RI !s {-# UNPACK #-} !Int64
602data RI s = RI !s {-# UNPACK #-} !Int64
@@ -739,27 +661,24 @@ take n0 (Stream next0 s0 len) =
739 Yield x s' -> Yield x ((n-1) :*: s')
661 Yield x s' -> Yield x ((n-1) :*: s')
740{-# INLINE [0] take #-}
662{-# INLINE [0] take #-}
741
663
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
664-- | /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@
665-- stream after the first @n@ characters, or the empty stream if @n@
747-- is greater than the length of the stream.
666-- is greater than the length of the stream.
748drop :: Integral a => a -> Stream Char -> Stream Char
667drop :: Integral a => a -> Stream Char -> Stream Char
749drop n0 (Stream next0 s0 len) =
668drop n0 (Stream next0 s0 len) =
750− Stream next (JS n0 s0) (len - fromIntegral (max 0 n0))
669+ Stream next (J n0 :*: s0) (len - fromIntegral (max 0 n0))
751 where
670 where
752 {-# INLINE next #-}
671 {-# INLINE next #-}
753− next (JS n s)
672+ next (J n :*: s)
754− | n <= 0 = Skip (NS s)
673+ | n <= 0 = Skip (N :*: s)
755 | otherwise = case next0 s of
674 | otherwise = case next0 s of
756 Done -> Done
675 Done -> Done
757− Skip s' -> Skip (JS n s')
676+ Skip s' -> Skip (J n :*: s')
758− Yield _ s' -> Skip (JS (n-1) s')
677+ Yield _ s' -> Skip (J (n-1) :*: s')
759− next (NS s) = case next0 s of
678+ next (N :*: s) = case next0 s of
760 Done -> Done
679 Done -> Done
761− Skip s' -> Skip (NS s')
680+ Skip s' -> Skip (N :*: s')
762− Yield x s' -> Yield x (NS s')
681+ Yield x s' -> Yield x (N :*: s')
763{-# INLINE [0] drop #-}
682{-# INLINE [0] drop #-}
764
683
765-- | takeWhile, applied to a predicate @p@ and a stream, returns the
684-- | takeWhile, applied to a predicate @p@ and a stream, returns the
@@ -777,18 +696,18 @@ takeWhile p (Stream next0 s0 len) = Stream next s0 len -- HINT maybe too high
777
696
778-- | dropWhile @p @xs returns the suffix remaining after takeWhile @p @xs.
697-- | dropWhile @p @xs returns the suffix remaining after takeWhile @p @xs.
779dropWhile :: (Char -> Bool) -> Stream Char -> Stream Char
698dropWhile :: (Char -> Bool) -> Stream Char -> Stream Char
780−dropWhile p (Stream next0 s0 len) = Stream next (L s0) len -- HINT maybe too high
699+dropWhile p (Stream next0 s0 len) = Stream next (S1 :*: s0) len -- HINT maybe too high
781 where
700 where
782 {-# INLINE next #-}
701 {-# INLINE next #-}
783− next (L s) = case next0 s of
702+ next (S1 :*: s) = case next0 s of
784 Done -> Done
703 Done -> Done
785− Skip s' -> Skip (L s')
704+ Skip s' -> Skip (S1 :*: s')
786− Yield x s' | p x -> Skip (L s')
705+ Yield x s' | p x -> Skip (S1 :*: s')
787− | otherwise -> Yield x (R s')
706+ | otherwise -> Yield x (S2 :*: s')
788− next (R s) = case next0 s of
707+ next (S2 :*: s) = case next0 s of
789 Done -> Done
708 Done -> Done
790− Skip s' -> Skip (R s')
709+ Skip s' -> Skip (S2 :*: s')
791− Yield x s' -> Yield x (R s')
710+ Yield x s' -> Yield x (S2 :*: s')
792{-# INLINE [0] dropWhile #-}
711{-# INLINE [0] dropWhile #-}
793
712
794-- | /O(n)/ The 'isPrefixOf' function takes two 'Stream's and returns
713-- | /O(n)/ The 'isPrefixOf' function takes two 'Stream's and returns
@@ -804,6 +723,7 @@ isPrefixOf (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)
804 loop (Yield x1 s1') (Yield x2 s2') = x1 == x2 &&
723 loop (Yield x1 s1') (Yield x2 s2') = x1 == x2 &&
805 loop (next1 s1') (next2 s2')
724 loop (next1 s1') (next2 s2')
806{-# INLINE [0] isPrefixOf #-}
725{-# INLINE [0] isPrefixOf #-}
726+{-# SPECIALISE isPrefixOf :: Stream Char -> Stream Char -> Bool #-}
807
727
808-- ----------------------------------------------------------------------------
728-- ----------------------------------------------------------------------------
809-- * Searching
729-- * Searching
@@ -895,25 +815,21 @@ findIndicesI p (Stream next s0 _len) = loop_findIndex 0 s0
895-------------------------------------------------------------------------------
815-------------------------------------------------------------------------------
896-- * Zipping
816-- * Zipping
897
817
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
818-- | zipWith generalises 'zip' by zipping with the function given as
903-- the first argument, instead of a tupling function.
819-- the first argument, instead of a tupling function.
904zipWith :: (a -> a -> b) -> Stream a -> Stream a -> Stream b
820zipWith :: (a -> a -> b) -> Stream a -> Stream a -> Stream b
905zipWith f (Stream next0 sa0 len1) (Stream next1 sb0 len2) =
821zipWith f (Stream next0 sa0 len1) (Stream next1 sb0 len2) =
906− Stream next (Z1 sa0 sb0) (smaller len1 len2)
822+ Stream next (sa0 :*: sb0 :*: N) (smaller len1 len2)
907 where
823 where
908− next (Z1 sa sb) = case next0 sa of
824+ next (sa :*: sb :*: N) = case next0 sa of
909− Done -> Done
825+ Done -> Done
910− Skip sa' -> Skip (Z1 sa' sb)
826+ Skip sa' -> Skip (sa' :*: sb :*: N)
911− Yield a sa' -> Skip (Z2 sa' sb a)
827+ Yield a sa' -> Skip (sa' :*: sb :*: J a)
912−
828+
913− next (Z2 sa' sb a) = case next1 sb of
829+ next (sa' :*: sb :*: J a) = case next1 sb of
914− Done -> Done
830+ Done -> Done
915− Skip sb' -> Skip (Z2 sa' sb' a)
831+ Skip sb' -> Skip (sa' :*: sb' :*: J a)
916− Yield b sb' -> Yield (f a b) (Z1 sa' sb')
832+ Yield b sb' -> Yield (f a b) (sa' :*: sb' :*: N)
917{-# INLINE [0] zipWith #-}
833{-# INLINE [0] zipWith #-}
918
834
919-- | /O(n)/ The 'countCharI' function returns the number of times the
835-- | /O(n)/ The 'countCharI' function returns the number of times the
@@ -929,7 +845,7 @@ countCharI a (Stream next s0 _len) = loop 0 s0
929{-# INLINE [0] countCharI #-}
845{-# INLINE [0] countCharI #-}
930
846
931streamError :: String -> String -> a
847streamError :: String -> String -> a
932−streamError func msg = P.error $ "Data.Text.Internal.Fusion.Common." ++ func ++ ": " ++ msg
848+streamError func msg = P.error $ "Data.Text.Fusion.Common." ++ func ++ ": " ++ msg
933
849
934emptyError :: String -> a
850emptyError :: String -> a
935emptyError func = internalError func "Empty input"
851emptyError func = internalError func "Empty input"
Data/Text/Internal/Fusion/Types.hs → Data/Text/Fusion/Internal.hsrenamed+26−28
@@ -1,66 +1,62 @@
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 {-# UNPACK #-} !a
38+
39+type M8 = M Word8
40+
37−-- | Restreaming state.
41+-- Restreaming state.
38−data RS s
42+data S s = S {-# UNPACK #-} !s
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+ {-# UNPACK #-} !M8 {-# UNPACK #-} !M8 {-# UNPACK #-} !M8
43
44
44−-- | Strict pair.
45−data PairS a b = !a :*: !b
46− -- deriving (Eq, Ord, Show)
47infixl 2 :*:
45infixl 2 :*:
46+data PairS a b = {-# UNPACK #-} !a :*: {-# UNPACK #-} !b
47+ deriving (Eq, Ord, Show)
48
48
49−-- | An intermediate result in a scan.
49+-- | Allow a function over a stream to switch between two states.
50−data Scan s = Scan1 {-# UNPACK #-} !Char !s
50+data Switch = S1 | S2
51− | Scan2 {-# UNPACK #-} !Char !s
52
51
53−-- | Intermediate result in a processing pipeline.
54data Step s a = Done
52data Step s a = Done
55 | Skip !s
53 | Skip !s
56 | Yield !a !s
54 | Yield !a !s
57
55
58−{-
59instance (Show a) => Show (Step s a)
56instance (Show a) => Show (Step s a)
60 where show Done = "Done"
57 where show Done = "Done"
61 show (Skip _) = "Skip"
58 show (Skip _) = "Skip"
62 show (Yield x _) = "Yield " ++ show x
59 show (Yield x _) = "Yield " ++ show x
63−-}
64
60
65instance (Eq a) => Eq (Stream a) where
61instance (Eq a) => Eq (Stream a) where
66 (==) = eq
62 (==) = eq
@@ -84,7 +80,7 @@ data Stream a =
84 forall s. Stream
80 forall s. Stream
85 (s -> Step s a) -- stepper function
81 (s -> Step s a) -- stepper function
86 !s -- current state
82 !s -- current state
87− !Size -- size hint
83+ {-# UNPACK #-} !Size -- size hint
88
84
89-- | /O(n)/ Determines if two streams are equal.
85-- | /O(n)/ Determines if two streams are equal.
90eq :: (Eq a) => Stream a -> Stream a -> Bool
86eq :: (Eq a) => Stream a -> Stream a -> Bool
@@ -99,6 +95,7 @@ eq (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)
99 loop (Yield x1 s1') (Yield x2 s2') = x1 == x2 &&
95 loop (Yield x1 s1') (Yield x2 s2') = x1 == x2 &&
100 loop (next1 s1') (next2 s2')
96 loop (next1 s1') (next2 s2')
101{-# INLINE [0] eq #-}
97{-# INLINE [0] eq #-}
98+{-# SPECIALISE eq :: Stream Char -> Stream Char -> Bool #-}
102
99
103cmp :: (Ord a) => Stream a -> Stream a -> Ordering
100cmp :: (Ord a) => Stream a -> Stream a -> Ordering
104cmp (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)
101cmp (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)
@@ -114,6 +111,7 @@ cmp (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)
114 EQ -> loop (next1 s1') (next2 s2')
111 EQ -> loop (next1 s1') (next2 s2')
115 other -> other
112 other -> other
116{-# INLINE [0] cmp #-}
113{-# INLINE [0] cmp #-}
114+{-# SPECIALISE cmp :: Stream Char -> Stream Char -> Ordering #-}
117
115
118-- | The empty stream.
116-- | The empty stream.
119empty :: Stream a
117empty :: Stream a
Data/Text/Fusion/Size.hsnew file+140
@@ -0,0 +1,140 @@
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+ , exactSize
20+ , maxSize
21+ , unknownSize
22+ , smaller
23+ , larger
24+ , toMax
25+ , upperBound
26+ , lowerBound
27+ , isEmpty
28+ ) where
29+
30+#if defined(ASSERTS)
31+import Control.Exception (assert)
32+#endif
33+
34+data Size = Exact {-# UNPACK #-} !Int -- ^ Exact size.
35+ | Max {-# UNPACK #-} !Int -- ^ Upper bound on size.
36+ | Unknown -- ^ Unknown size.
37+ deriving (Eq, Show)
38+
39+exactSize :: Int -> Size
40+exactSize n =
41+#if defined(ASSERTS)
42+ assert (n >= 0)
43+#endif
44+ Exact n
45+{-# INLINE exactSize #-}
46+
47+maxSize :: Int -> Size
48+maxSize n =
49+#if defined(ASSERTS)
50+ assert (n >= 0)
51+#endif
52+ Max n
53+{-# INLINE maxSize #-}
54+
55+unknownSize :: Size
56+unknownSize = Unknown
57+{-# INLINE unknownSize #-}
58+
59+instance Num Size where
60+ (+) = addSize
61+ (-) = subtractSize
62+ (*) = mulSize
63+
64+ fromInteger = f where f = Exact . fromInteger
65+ {-# INLINE f #-}
66+
67+addSize :: Size -> Size -> Size
68+addSize (Exact m) (Exact n) = Exact (m+n)
69+addSize (Exact m) (Max n) = Max (m+n)
70+addSize (Max m) (Exact n) = Max (m+n)
71+addSize (Max m) (Max n) = Max (m+n)
72+addSize _ _ = Unknown
73+{-# INLINE addSize #-}
74+
75+subtractSize :: Size -> Size -> Size
76+subtractSize (Exact m) (Exact n) = Exact (max (m-n) 0)
77+subtractSize (Exact m) (Max _) = Max m
78+subtractSize (Max m) (Exact n) = Max (max (m-n) 0)
79+subtractSize a@(Max _) (Max _) = a
80+subtractSize a@(Max _) Unknown = a
81+subtractSize _ _ = Unknown
82+{-# INLINE subtractSize #-}
83+
84+mulSize :: Size -> Size -> Size
85+mulSize (Exact m) (Exact n) = Exact (m*n)
86+mulSize (Exact m) (Max n) = Max (m*n)
87+mulSize (Max m) (Exact n) = Max (m*n)
88+mulSize (Max m) (Max n) = Max (m*n)
89+mulSize _ _ = Unknown
90+{-# INLINE mulSize #-}
91+
92+-- | Minimum of two size hints.
93+smaller :: Size -> Size -> Size
94+smaller (Exact m) (Exact n) = Exact (m `min` n)
95+smaller (Exact m) (Max n) = Max (m `min` n)
96+smaller (Exact m) Unknown = Max m
97+smaller (Max m) (Exact n) = Max (m `min` n)
98+smaller (Max m) (Max n) = Max (m `min` n)
99+smaller a@(Max _) Unknown = a
100+smaller Unknown (Exact n) = Max n
101+smaller Unknown (Max n) = Max n
102+smaller Unknown Unknown = Unknown
103+{-# INLINE smaller #-}
104+
105+-- | Maximum of two size hints.
106+larger :: Size -> Size -> Size
107+larger (Exact m) (Exact n) = Exact (m `max` n)
108+larger a@(Exact m) b@(Max n) | m >= n = a
109+ | otherwise = b
110+larger a@(Max m) b@(Exact n) | n >= m = b
111+ | otherwise = a
112+larger (Max m) (Max n) = Max (m `max` n)
113+larger _ _ = Unknown
114+{-# INLINE larger #-}
115+
116+-- | Convert a size hint to an upper bound.
117+toMax :: Size -> Size
118+toMax (Exact n) = Max n
119+toMax a@(Max _) = a
120+toMax Unknown = Unknown
121+{-# INLINE toMax #-}
122+
123+-- | Compute the minimum size from a size hint.
124+lowerBound :: Size -> Int
125+lowerBound (Exact n) = n
126+lowerBound _ = 0
127+{-# INLINE lowerBound #-}
128+
129+-- | Compute the maximum size from a size hint, if possible.
130+upperBound :: Int -> Size -> Int
131+upperBound _ (Exact n) = n
132+upperBound _ (Max n) = n
133+upperBound k _ = k
134+{-# INLINE upperBound #-}
135+
136+isEmpty :: Size -> Bool
137+isEmpty (Exact n) = n <= 0
138+isEmpty (Max n) = n <= 0
139+isEmpty _ = False
140+{-# INLINE isEmpty #-}
Data/Text/IO.hs+47−97
@@ -1,26 +1,17 @@
1−{-# LANGUAGE BangPatterns, CPP, RecordWildCards, ScopedTypeVariables #-}
1+{-# LANGUAGE BangPatterns, CPP, RecordWildCards #-}
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) Bryan O'Sullivan 2009,
8−-- (c) 2009 Simon Marlow
5+-- (c) Simon Marlow 2009
9-- License : BSD-style
6-- License : BSD-style
10-- Maintainer : bos@serpentine.com
7-- Maintainer : bos@serpentine.com
11-- Stability : experimental
8-- Stability : experimental
12-- Portability : GHC
9-- Portability : GHC
13--
10--
14-- Efficient locale-sensitive support for text I\/O.
11-- Efficient locale-sensitive support for text I\/O.
15−--
16−-- Skip past the synopsis for some important notes on performance and
17−-- portability across different versions of GHC.
18
12
19module Data.Text.IO
13module Data.Text.IO
20 (
14 (
21− -- * Performance
22− -- $performance
23−
24 -- * Locale support
15 -- * Locale support
25 -- $locale
16 -- $locale
26 -- * File-at-a-time operations
17 -- * File-at-a-time operations
@@ -29,7 +20,6 @@ module Data.Text.IO
29 , appendFile
20 , appendFile
30 -- * Operations on handles
21 -- * Operations on handles
31 , hGetContents
22 , hGetContents
32− , hGetChunk
33 , hGetLine
23 , hGetLine
34 , hPutStr
24 , hPutStr
35 , hPutStrLn
25 , hPutStrLn
@@ -42,44 +32,30 @@ module Data.Text.IO
42 ) where
32 ) where
43
33
44import Data.Text (Text)
34import Data.Text (Text)
45−import Prelude hiding (appendFile, getContents, getLine, interact,
35+import Prelude hiding (appendFile, getContents, getLine, interact, putStr,
46− putStr, putStrLn, readFile, writeFile)
36+ putStrLn, readFile, writeFile)
47import System.IO (Handle, IOMode(..), hPutChar, openFile, stdin, stdout,
37import System.IO (Handle, IOMode(..), hPutChar, openFile, stdin, stdout,
48 withFile)
38 withFile)
39+#if __GLASGOW_HASKELL__ <= 610
49−import qualified Control.Exception as E
40+import qualified Data.ByteString.Char8 as B
50−import Control.Monad (liftM2, when)
41+import Data.Text.Encoding (decodeUtf8, encodeUtf8)
42+#else
43+import Control.Exception (throw)
51import Data.IORef (readIORef, writeIORef)
44import Data.IORef (readIORef, writeIORef)
52import qualified Data.Text as T
45import qualified Data.Text as T
53−import Data.Text.Internal.Fusion (stream)
46+import Data.Text.Fusion (stream)
54−import Data.Text.Internal.Fusion.Types (Step(..), Stream(..))
47+import Data.Text.Fusion.Internal (Step(..), Stream(..))
55−import Data.Text.Internal.IO (hGetLineWith, readChunk)
48+import Data.Text.IO.Internal (hGetLineWith, readChunk)
56import GHC.IO.Buffer (Buffer(..), BufferState(..), CharBufElem, CharBuffer,
49import GHC.IO.Buffer (Buffer(..), BufferState(..), CharBufElem, CharBuffer,
57 RawCharBuffer, emptyBuffer, isEmptyBuffer, newCharBuffer,
50 RawCharBuffer, emptyBuffer, isEmptyBuffer, newCharBuffer,
58 writeCharBuf)
51 writeCharBuf)
59−import GHC.IO.Exception (IOException(ioe_type), IOErrorType(InappropriateType))
60import GHC.IO.Handle.Internals (augmentIOError, hClose_help, wantReadableHandle,
52import GHC.IO.Handle.Internals (augmentIOError, hClose_help, wantReadableHandle,
61 wantWritableHandle)
53 wantWritableHandle)
62import GHC.IO.Handle.Text (commitBuffer')
54import GHC.IO.Handle.Text (commitBuffer')
63import GHC.IO.Handle.Types (BufferList(..), BufferMode(..), Handle__(..),
55import GHC.IO.Handle.Types (BufferList(..), BufferMode(..), Handle__(..),
64− HandleType(..), Newline(..))
56+ Newline(..))
65−import System.IO (hGetBuffering, hFileSize, hSetBuffering, hTell)
66import System.IO.Error (isEOFError)
57import System.IO.Error (isEOFError)
67−
58+#endif
68−-- $performance
69−-- #performance#
70−--
71−-- The functions in this module obey the runtime system's locale,
72−-- character set encoding, and line ending conversion settings.
73−--
74−-- If you know in advance that you will be working with data that has
75−-- a specific encoding (e.g. UTF-8), and your application is highly
76−-- performance sensitive, you may find that it is faster to perform
77−-- I\/O with bytestrings and to encode and decode yourself than to use
78−-- the functions in this module.
79−--
80−-- Whether this will hold depends on the version of GHC you are using,
81−-- the platform you are working on, the data you are working with, and
82−-- the encodings you are using, so be sure to test for yourself.
83
59
84-- | The 'readFile' function reads a file and returns the contents of
60-- | The 'readFile' function reads a file and returns the contents of
85-- the file as a string. The entire file is read strictly, as with
61-- the file as a string. The entire file is read strictly, as with
@@ -96,30 +72,6 @@ writeFile p = withFile p WriteMode . flip hPutStr
96appendFile :: FilePath -> Text -> IO ()
72appendFile :: FilePath -> Text -> IO ()
97appendFile p = withFile p AppendMode . flip hPutStr
73appendFile p = withFile p AppendMode . flip hPutStr
98
74
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
75-- | Read the remaining contents of a 'Handle' as a string. The
124-- 'Handle' is closed once the contents have been read, or if an
76-- 'Handle' is closed once the contents have been read, or if an
125-- exception is thrown.
77-- exception is thrown.
@@ -132,47 +84,44 @@ hGetChunk h = wantReadableHandle "hGetChunk" h readSingleChunk
132-- result to construct its result. For files more than a half of
84-- result to construct its result. For files more than a half of
133-- available RAM in size, this may result in memory exhaustion.
85-- available RAM in size, this may result in memory exhaustion.
134hGetContents :: Handle -> IO Text
86hGetContents :: Handle -> IO Text
87+#if __GLASGOW_HASKELL__ <= 610
135−hGetContents h = do
88+hGetContents = fmap decodeUtf8 . B.hGetContents
136− chooseGoodBuffering h
89+#else
137− wantReadableHandle "hGetContents" h readAll
90+hGetContents h = wantReadableHandle "hGetContents" h $ \hh -> do
91+ (hh',ts) <- readAll hh
92+ return (hh',T.concat ts)
138 where
93 where
139 readAll hh@Handle__{..} = do
94 readAll hh@Handle__{..} = do
95+ buf <- readIORef haCharBuffer
140 let readChunks = do
96 let readChunks = do
141− buf <- readIORef haCharBuffer
142− t <- readChunk hh buf `E.catch` catchError "hGetContents" h hh
97+ t <- readChunk hh buf
143− if T.null t
98+ (hh',ts) <- readAll hh
144− then return [t]
99+ return (hh', t:ts)
145− else (t:) `fmap` readChunks
100+ readChunks `catch` \e -> do
146− ts <- readChunks
147− (hh', _) <- hClose_help hh
101+ (hh', _) <- hClose_help hh
148− return (hh'{haType=ClosedHandle}, T.concat ts)
102+ if isEOFError e
149−
103+ then return $ if isEmptyBuffer buf
150−-- | Use a more efficient buffer size if we're reading in
104+ then (hh', [])
151−-- block-buffered mode with the default buffer size. When we can
105+ else (hh', [T.singleton '\r'])
152−-- determine the size of the handle we're reading, set the buffer size
106+ else throw (augmentIOError e "hGetContents" h)
153−-- to that, so that we can read the entire file in one chunk.
107+#endif
154−-- Otherwise, use a buffer size of at least 16KB.
108+
155−chooseGoodBuffering :: Handle -> IO ()
156−chooseGoodBuffering h = do
157− bufMode <- hGetBuffering h
158− case bufMode of
159− BlockBuffering Nothing -> do
160− d <- E.catch (liftM2 (-) (hFileSize h) (hTell h)) $ \(e::IOException) ->
161− if ioe_type e == InappropriateType
162− then return 16384 -- faster than the 2KB default
163− else E.throwIO e
164− when (d > 0) . hSetBuffering h . BlockBuffering . Just . fromIntegral $ d
165− _ -> return ()
166−
167-- | Read a single line from a handle.
109-- | Read a single line from a handle.
168hGetLine :: Handle -> IO Text
110hGetLine :: Handle -> IO Text
111+#if __GLASGOW_HASKELL__ <= 610
112+hGetLine = fmap decodeUtf8 . B.hGetLine
113+#else
169hGetLine = hGetLineWith T.concat
114hGetLine = hGetLineWith T.concat
115+#endif
170
116
171-- | Write a string to a handle.
117-- | Write a string to a handle.
172hPutStr :: Handle -> Text -> IO ()
118hPutStr :: Handle -> Text -> IO ()
119+#if __GLASGOW_HASKELL__ <= 610
120+hPutStr h = B.hPutStr h . encodeUtf8
121+#else
173-- This function is lifted almost verbatim from GHC.IO.Handle.Text.
122-- This function is lifted almost verbatim from GHC.IO.Handle.Text.
174hPutStr h t = do
123hPutStr h t = do
175− (buffer_mode, nl) <-
124+ (buffer_mode, nl) <-
176 wantWritableHandle "hPutStr" h $ \h_ -> do
125 wantWritableHandle "hPutStr" h $ \h_ -> do
177 bmode <- getSpareBuffer h_
126 bmode <- getSpareBuffer h_
178 return (bmode, haOutputNL h_)
127 return (bmode, haOutputNL h_)
@@ -254,7 +203,7 @@ writeBlocksRaw h buf0 (Stream next0 s0 _len) = outer s0 buf0
254
203
255-- This function is completely lifted from GHC.IO.Handle.Text.
204-- This function is completely lifted from GHC.IO.Handle.Text.
256getSpareBuffer :: Handle__ -> IO (BufferMode, CharBuffer)
205getSpareBuffer :: Handle__ -> IO (BufferMode, CharBuffer)
257−getSpareBuffer Handle__{haCharBuffer=ref,
206+getSpareBuffer Handle__{haCharBuffer=ref,
258 haBuffers=spare_ref,
207 haBuffers=spare_ref,
259 haBufferMode=mode}
208 haBufferMode=mode}
260 = do
209 = do
@@ -275,10 +224,11 @@ getSpareBuffer Handle__{haCharBuffer=ref,
275-- This function is completely lifted from GHC.IO.Handle.Text.
224-- This function is completely lifted from GHC.IO.Handle.Text.
276commitBuffer :: Handle -> RawCharBuffer -> Int -> Int -> Bool -> Bool
225commitBuffer :: Handle -> RawCharBuffer -> Int -> Int -> Bool -> Bool
277 -> IO CharBuffer
226 -> IO CharBuffer
278−commitBuffer hdl !raw !sz !count flush release =
227+commitBuffer hdl !raw !sz !count flush release =
279 wantWritableHandle "commitAndReleaseBuffer" hdl $
228 wantWritableHandle "commitAndReleaseBuffer" hdl $
280 commitBuffer' raw sz count flush release
229 commitBuffer' raw sz count flush release
281{-# INLINE commitBuffer #-}
230{-# INLINE commitBuffer #-}
231+#endif
282
232
283-- | Write a string to a handle, followed by a newline.
233-- | Write a string to a handle, followed by a newline.
284hPutStrLn :: Handle -> Text -> IO ()
234hPutStrLn :: Handle -> Text -> IO ()
@@ -315,8 +265,8 @@ putStrLn = hPutStrLn stdout
315-- Beginning with GHC 6.12, text I\/O is performed using the system or
265-- Beginning with GHC 6.12, text I\/O is performed using the system or
316-- handle's current locale and line ending conventions.
266-- handle's current locale and line ending conventions.
317--
267--
318−-- Under GHC 6.10 and earlier, the system I\/O libraries do not
268+-- Under GHC 6.10 and earlier, the system I\/O libraries /do not
319−-- support locale-sensitive I\/O or line ending conversion. On these
269+-- support/ locale-sensitive I\/O or line ending conversion. On these
320-- versions of GHC, functions in this library all use UTF-8. What
270-- versions of GHC, functions in this library all use UTF-8. What
321-- does this mean in practice?
271-- does this mean in practice?
322--
272--
Data/Text/Internal/IO.hs → Data/Text/IO/Internal.hsrenamed+19−21
@@ -1,31 +1,29 @@
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) Bryan O'Sullivan 2009,
5−-- (c) 2009 Simon Marlow
5+-- (c) Simon Marlow 2009
6-- License : BSD-style
6-- License : BSD-style
7-- Maintainer : bos@serpentine.com
7-- Maintainer : bos@serpentine.com
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
23−import qualified Control.Exception as E
21+#if __GLASGOW_HASKELL__ >= 612
24import Data.IORef (readIORef, writeIORef)
22import Data.IORef (readIORef, writeIORef)
25import Data.Text (Text)
23import Data.Text (Text)
26−import Data.Text.Internal.Fusion (unstream)
24+import Data.Text.Fusion (unstream)
27−import Data.Text.Internal.Fusion.Types (Step(..), Stream(..))
25+import Data.Text.Fusion.Internal (Step(..), Stream(..))
28−import Data.Text.Internal.Fusion.Size (exactSize, maxSize)
26+import Data.Text.Fusion.Size (exactSize, maxSize)
29import Data.Text.Unsafe (inlinePerformIO)
27import Data.Text.Unsafe (inlinePerformIO)
30import Foreign.Storable (peekElemOff)
28import Foreign.Storable (peekElemOff)
31import GHC.IO.Buffer (Buffer(..), CharBuffer, RawCharBuffer, bufferAdjustL,
29import GHC.IO.Buffer (Buffer(..), CharBuffer, RawCharBuffer, bufferAdjustL,
@@ -46,8 +44,7 @@ hGetLineWith f h = wantReadableHandle_ "hGetLine" h go
46 go hh@Handle__{..} = readIORef haCharBuffer >>= fmap f . hGetLineLoop hh []
44 go hh@Handle__{..} = readIORef haCharBuffer >>= fmap f . hGetLineLoop hh []
47
45
48hGetLineLoop :: Handle__ -> [Text] -> CharBuffer -> IO [Text]
46hGetLineLoop :: Handle__ -> [Text] -> CharBuffer -> IO [Text]
49−hGetLineLoop hh@Handle__{..} = go where
50− go ts buf@Buffer{ bufL=r0, bufR=w, bufRaw=raw0 } = do
47+hGetLineLoop hh@Handle__{..} ts buf@Buffer{ bufL=r0, bufR=w, bufRaw=raw0 } = do
51 let findEOL raw r | r == w = return (False, w)
48 let findEOL raw r | r == w = return (False, w)
52 | otherwise = do
49 | otherwise = do
53 (c,r') <- readCharBuf raw r
50 (c,r') <- readCharBuf raw r
@@ -75,18 +72,18 @@ hGetLineLoop hh@Handle__{..} = go where
75 let pre | isEmptyBuffer buf1 = T.empty
72 let pre | isEmptyBuffer buf1 = T.empty
76 | otherwise = T.singleton '\r'
73 | otherwise = T.singleton '\r'
77 writeIORef haCharBuffer buf1{ bufL=0, bufR=0 }
74 writeIORef haCharBuffer buf1{ bufL=0, bufR=0 }
78− let str = reverse . filter (not . T.null) $ pre:t:ts
75+ let str = reverse $ pre:t:ts
79− if null str
76+ if all T.null str
80 then ioe_EOF
77 then ioe_EOF
81 else return str
78 else return str
82− Just new_buf -> go (t:ts) new_buf
79+ Just new_buf -> hGetLineLoop hh (t:ts) new_buf
83
80
84-- This function is lifted almost verbatim from GHC.IO.Handle.Text.
81-- This function is lifted almost verbatim from GHC.IO.Handle.Text.
85maybeFillReadBuffer :: Handle__ -> CharBuffer -> IO (Maybe CharBuffer)
82maybeFillReadBuffer :: Handle__ -> CharBuffer -> IO (Maybe CharBuffer)
86maybeFillReadBuffer handle_ buf
83maybeFillReadBuffer handle_ buf
87− = E.catch (Just `fmap` getSomeCharacters handle_ buf) $ \e ->
84+ = catch (Just `fmap` getSomeCharacters handle_ buf) $ \e ->
88− if isEOFError e
85+ if isEOFError e
89− then return Nothing
86+ then return Nothing
90 else ioError e
87 else ioError e
91
88
92unpack :: RawCharBuffer -> Int -> Int -> IO Text
89unpack :: RawCharBuffer -> Int -> Int -> IO Text
@@ -108,7 +105,7 @@ unpack_nl !buf !r !w
108 | otherwise = withRawBuffer buf $ go
105 | otherwise = withRawBuffer buf $ go
109 where
106 where
110 go pbuf = do
107 go pbuf = do
111− let !t = unstream (Stream next r (maxSize (w-r)))
108+ let t = unstream (Stream next r (maxSize (w-r)))
112 w' = w - 1
109 w' = w - 1
113 return $ if ix w' == '\r'
110 return $ if ix w' == '\r'
114 then (t,w')
111 then (t,w')
@@ -164,3 +161,4 @@ readChunk hh@Handle__{..} buf = do
164
161
165sizeError :: String -> a
162sizeError :: String -> a
166sizeError loc = error $ "Data.Text.IO." ++ loc ++ ": bad internal buffer size"
163sizeError loc = error $ "Data.Text.IO." ++ loc ++ ": bad internal buffer size"
164+#endif
Data/Text/Internal.hs+19−133
@@ -1,48 +1,29 @@
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
6−-- Copyright : (c) 2008, 2009 Tom Harper,
5+-- Copyright : (c) Tom Harper 2008-2009,
7−-- (c) 2009, 2010 Bryan O'Sullivan,
6+-- (c) Bryan O'Sullivan 2009,
8−-- (c) 2009 Duncan Coutts
7+-- (c) Duncan Coutts 2009
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--
15−-- A module containing private 'Text' internals. This exposes the
15+-- Semi-public internals. Most users should not need to use this
16−-- 'Text' representation and low level construction functions.
16+-- module.
17−-- Modules which extend the 'Text' system may need to use this module.
18−--
19−-- You should not use this module unless you are determined to monkey
20−-- with the internals, as the functions here do just about nothing to
21−-- preserve data invariants. You have been warned!
22−
23−#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)
24−#include "MachDeps.h"
25−#endif
26
17
27module Data.Text.Internal
18module Data.Text.Internal
28 (
19 (
29 -- * Types
20 -- * Types
30− -- $internals
31 Text(..)
21 Text(..)
32 -- * Construction
22 -- * Construction
33 , text
23 , text
34 , textP
24 , textP
35− -- * Safety
36− , safe
37 -- * Code that must be here for accessibility
25 -- * Code that must be here for accessibility
38 , empty
26 , empty
39− , empty_
40− -- * Utilities
41− , firstf
42− -- * Checked multiplication
43− , mul
44− , mul32
45− , mul64
46 -- * Debugging
27 -- * Debugging
47 , showText
28 , showText
48 ) where
29 ) where
@@ -50,22 +31,19 @@ module Data.Text.Internal
50#if defined(ASSERTS)
31#if defined(ASSERTS)
51import Control.Exception (assert)
32import Control.Exception (assert)
52#endif
33#endif
53−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
34import qualified Data.Text.Array as A
35+import Data.Typeable (Typeable)
58
36
59-- | A space efficient, packed, unboxed Unicode text type.
37-- | A space efficient, packed, unboxed Unicode text type.
60data Text = Text
38data Text = Text
61− {-# UNPACK #-} !A.Array -- payload (Word16 elements)
39+ {-# UNPACK #-} !A.Array -- payload
62− {-# UNPACK #-} !Int -- offset (units of Word16, not Char)
40+ {-# UNPACK #-} !Int -- offset
63− {-# UNPACK #-} !Int -- length (units of Word16, not Char)
41+ {-# UNPACK #-} !Int -- length
64 deriving (Typeable)
42 deriving (Typeable)
65
43
66-- | Smart constructor.
44-- | Smart constructor.
67−text_ :: A.Array -> Int -> Int -> Text
45+text :: A.Array -> Int -> Int -> Text
68−text_ arr off len =
46+text arr off len =
69#if defined(ASSERTS)
47#if defined(ASSERTS)
70 let c = A.unsafeIndex arr off
48 let c = A.unsafeIndex arr off
71 alen = A.length arr
49 alen = A.length arr
@@ -75,114 +53,22 @@ text_ arr off len =
75 assert (len == 0 || c < 0xDC00 || c > 0xDFFF) $
53 assert (len == 0 || c < 0xDC00 || c > 0xDFFF) $
76#endif
54#endif
77 Text arr off len
55 Text arr off len
78−{-# INLINE text_ #-}
56+{-# INLINE text #-}
79
57
80-- | /O(1)/ The empty 'Text'.
58-- | /O(1)/ The empty 'Text'.
81empty :: Text
59empty :: Text
82empty = Text A.empty 0 0
60empty = Text A.empty 0 0
83{-# INLINE [1] empty #-}
61{-# INLINE [1] empty #-}
84
62
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
63-- | Construct a 'Text' without invisibly pinning its byte array in
91-- memory if its length has dwindled to zero.
64-- 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
65textP :: A.Array -> Int -> Int -> Text
98−{-# DEPRECATED textP "Use text instead" #-}
66+textP arr off len | len == 0 = empty
99−textP = text
67+ | otherwise = text arr off len
68+{-# INLINE textP #-}
100
69
101-- | A useful 'show'-like function for debugging purposes.
70-- | A useful 'show'-like function for debugging purposes.
102showText :: Text -> String
71showText :: Text -> String
103showText (Text arr off len) =
72showText (Text arr off len) =
104− "Text " ++ show (A.toList arr off len) ++ ' ' :
73+ "Text " ++ (show . take (off+len) . A.toList) arr ++ ' ' :
105 show off ++ ' ' : show len
74 show off ++ ' ' : show len
106−
107−-- | Map a 'Char' to a 'Text'-safe value.
108−--
109−-- UTF-16 surrogate code points are not included in the set of Unicode
110−-- scalar values, but are unfortunately admitted as valid 'Char'
111−-- values by Haskell. They cannot be represented in a 'Text'. This
112−-- function remaps those code points to the Unicode replacement
113−-- character (U+FFFD, \'&#xfffd;\'), and leaves other code points
114−-- unchanged.
115−safe :: Char -> Char
116−safe c
117− | ord c .&. 0x1ff800 /= 0xd800 = c
118− | otherwise = '\xfffd'
119−{-# INLINE [0] safe #-}
120−
121−-- | Apply a function to the first element of an optional pair.
122−firstf :: (a -> c) -> Maybe (a,b) -> Maybe (c,b)
123−firstf f (Just (a, b)) = Just (f a, b)
124−firstf _ 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/Functions.hsdeleted−40
@@ -1,40 +0,0 @@
1−{-# LANGUAGE MagicHash #-}
2−
3−-- |
4−-- Module : Data.Text.Internal.Builder.Functions
5−-- Copyright : (c) 2011 MailRank, Inc.
6−--
7−-- License : BSD-style
8−-- Maintainer : bos@serpentine.com
9−-- Stability : experimental
10−-- Portability : GHC
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.
17−
18−module Data.Text.Internal.Builder.Functions
19− (
20− (<>)
21− , i2d
22− ) where
23−
24−import Data.Monoid (mappend)
25−import Data.Text.Lazy.Builder (Builder)
26−import GHC.Base (chr#,ord#,(+#),Int(I#),Char(C#))
27−import Prelude ()
28−
29−-- | Unsafe conversion for decimal digits.
30−{-# INLINE i2d #-}
31−i2d :: Int -> Char
32−i2d (I# i#) = C# (chr# (ord# '0'# +# i#))
33−
34−-- | The normal 'mappend' function with right associativity instead of
35−-- left.
36−(<>) :: Builder -> Builder -> Builder
37−(<>) = mappend
38−{-# INLINE (<>) #-}
39−
40−infixr 4 <>
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/Encoding/Utf32.hsdeleted−26
@@ -1,26 +0,0 @@
1−-- |
2−-- Module : Data.Text.Internal.Encoding.Utf32
3−-- Copyright : (c) 2008, 2009 Tom Harper,
4−-- (c) 2009, 2010 Bryan O'Sullivan,
5−-- (c) 2009 Duncan Coutts
6−--
7−-- License : BSD-style
8−-- Maintainer : bos@serpentine.com
9−-- Stability : experimental
10−-- Portability : portable
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−-- Basic UTF-32 validation.
17−module Data.Text.Internal.Encoding.Utf32
18− (
19− validate
20− ) where
21−
22−import Data.Word (Word32)
23−
24−validate :: Word32 -> Bool
25−validate x1 = x1 < 0xD800 || (x1 > 0xDFFF && x1 <= 0x10FFFF)
26−{-# INLINE validate #-}
Data/Text/Internal/Functions.hsdeleted−31
@@ -1,31 +0,0 @@
1−{-# LANGUAGE CPP, DeriveDataTypeable #-}
2−
3−-- |
4−-- Module : Data.Text.Internal.Functions
5−-- Copyright : 2010 Bryan O'Sullivan
6−--
7−-- License : BSD-style
8−-- Maintainer : bos@serpentine.com
9−-- Stability : experimental
10−-- Portability : GHC
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.
17−
18−module Data.Text.Internal.Functions
19− (
20− intersperse
21− ) where
22−
23−-- | A lazier version of Data.List.intersperse. The other version
24−-- causes space leaks!
25−intersperse :: a -> [a] -> [a]
26−intersperse _ [] = []
27−intersperse sep (x:xs) = x : go xs
28− where
29− go [] = []
30− go (y:ys) = sep : y: go ys
31−{-# INLINE intersperse #-}
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/Lazy/Encoding/Fusion.hsdeleted−324
@@ -1,324 +0,0 @@
1−{-# LANGUAGE BangPatterns, CPP, Rank2Types #-}
2−
3−-- |
4−-- Module : Data.Text.Lazy.Encoding.Fusion
5−-- Copyright : (c) 2009, 2010 Bryan O'Sullivan
6−--
7−-- License : BSD-style
8−-- Maintainer : bos@serpentine.com
9−-- Stability : experimental
10−-- Portability : portable
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−-- Fusible 'Stream'-oriented functions for converting between lazy
17−-- 'Text' and several common encodings.
18−
19−module Data.Text.Internal.Lazy.Encoding.Fusion
20− (
21− -- * Streaming
22− -- streamASCII
23− streamUtf8
24− , streamUtf16LE
25− , streamUtf16BE
26− , streamUtf32LE
27− , streamUtf32BE
28−
29− -- * Unstreaming
30− , unstream
31−
32− , module Data.Text.Internal.Encoding.Fusion.Common
33− ) where
34−
35−import Data.ByteString.Lazy.Internal (ByteString(..), defaultChunkSize)
36−import qualified Data.ByteString as B
37−import qualified Data.ByteString.Unsafe as B
38−import Data.Text.Internal.Encoding.Fusion.Common
39−import Data.Text.Encoding.Error
40−import Data.Text.Internal.Fusion (Step(..), Stream(..))
41−import Data.Text.Internal.Fusion.Size
42−import Data.Text.Internal.Unsafe.Char (unsafeChr, unsafeChr8, unsafeChr32)
43−import Data.Text.Internal.Unsafe.Shift (shiftL)
44−import Data.Word (Word8, Word16, Word32)
45−import qualified Data.Text.Internal.Encoding.Utf8 as U8
46−import qualified Data.Text.Internal.Encoding.Utf16 as U16
47−import qualified Data.Text.Internal.Encoding.Utf32 as U32
48−import Data.Text.Unsafe (unsafeDupablePerformIO)
49−import Foreign.ForeignPtr (withForeignPtr, ForeignPtr)
50−import Foreign.Storable (pokeByteOff)
51−import Data.ByteString.Internal (mallocByteString, memcpy)
52−#if defined(ASSERTS)
53−import Control.Exception (assert)
54−#endif
55−import qualified Data.ByteString.Internal as B
56−
57−data S = S0
58− | S1 {-# UNPACK #-} !Word8
59− | S2 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8
60− | S3 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8
61− | S4 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8
62−
63−data T = T !ByteString !S {-# UNPACK #-} !Int
64−
65−-- | /O(n)/ Convert a lazy 'ByteString' into a 'Stream Char', using
66−-- UTF-8 encoding.
67−streamUtf8 :: OnDecodeError -> ByteString -> Stream Char
68−streamUtf8 onErr bs0 = Stream next (T bs0 S0 0) unknownSize
69− where
70− next (T bs@(Chunk ps _) S0 i)
71− | i < len && U8.validate1 a =
72− Yield (unsafeChr8 a) (T bs S0 (i+1))
73− | i + 1 < len && U8.validate2 a b =
74− Yield (U8.chr2 a b) (T bs S0 (i+2))
75− | i + 2 < len && U8.validate3 a b c =
76− Yield (U8.chr3 a b c) (T bs S0 (i+3))
77− | i + 3 < len && U8.validate4 a b c d =
78− Yield (U8.chr4 a b c d) (T bs S0 (i+4))
79− where len = B.length ps
80− a = B.unsafeIndex ps i
81− b = B.unsafeIndex ps (i+1)
82− c = B.unsafeIndex ps (i+2)
83− d = B.unsafeIndex ps (i+3)
84− next st@(T bs s i) =
85− case s of
86− S1 a | U8.validate1 a -> Yield (unsafeChr8 a) es
87− S2 a b | U8.validate2 a b -> Yield (U8.chr2 a b) es
88− S3 a b c | U8.validate3 a b c -> Yield (U8.chr3 a b c) es
89− S4 a b c d | U8.validate4 a b c d -> Yield (U8.chr4 a b c d) es
90− _ -> consume st
91− where es = T bs S0 i
92− consume (T bs@(Chunk ps rest) s i)
93− | i >= B.length ps = consume (T rest s 0)
94− | otherwise =
95− case s of
96− S0 -> next (T bs (S1 x) (i+1))
97− S1 a -> next (T bs (S2 a x) (i+1))
98− S2 a b -> next (T bs (S3 a b x) (i+1))
99− S3 a b c -> next (T bs (S4 a b c x) (i+1))
100− S4 a b c d -> decodeError "streamUtf8" "UTF-8" onErr (Just a)
101− (T bs (S3 b c d) (i+1))
102− where x = B.unsafeIndex ps i
103− consume (T Empty S0 _) = Done
104− consume st = decodeError "streamUtf8" "UTF-8" onErr Nothing st
105−{-# INLINE [0] streamUtf8 #-}
106−
107−-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little
108−-- endian UTF-16 encoding.
109−streamUtf16LE :: OnDecodeError -> ByteString -> Stream Char
110−streamUtf16LE onErr bs0 = Stream next (T bs0 S0 0) unknownSize
111− where
112− next (T bs@(Chunk ps _) S0 i)
113− | i + 1 < len && U16.validate1 x1 =
114− Yield (unsafeChr x1) (T bs S0 (i+2))
115− | i + 3 < len && U16.validate2 x1 x2 =
116− Yield (U16.chr2 x1 x2) (T bs S0 (i+4))
117− where len = B.length ps
118− x1 = c (idx i) (idx (i + 1))
119− x2 = c (idx (i + 2)) (idx (i + 3))
120− c w1 w2 = w1 + (w2 `shiftL` 8)
121− idx = fromIntegral . B.unsafeIndex ps :: Int -> Word16
122− next st@(T bs s i) =
123− case s of
124− S2 w1 w2 | U16.validate1 (c w1 w2) ->
125− Yield (unsafeChr (c w1 w2)) es
126− S4 w1 w2 w3 w4 | U16.validate2 (c w1 w2) (c w3 w4) ->
127− Yield (U16.chr2 (c w1 w2) (c w3 w4)) es
128− _ -> consume st
129− where es = T bs S0 i
130− c :: Word8 -> Word8 -> Word16
131− c w1 w2 = fromIntegral w1 + (fromIntegral w2 `shiftL` 8)
132− consume (T bs@(Chunk ps rest) s i)
133− | i >= B.length ps = consume (T rest s 0)
134− | otherwise =
135− case s of
136− S0 -> next (T bs (S1 x) (i+1))
137− S1 w1 -> next (T bs (S2 w1 x) (i+1))
138− S2 w1 w2 -> next (T bs (S3 w1 w2 x) (i+1))
139− S3 w1 w2 w3 -> next (T bs (S4 w1 w2 w3 x) (i+1))
140− S4 w1 w2 w3 w4 -> decodeError "streamUtf16LE" "UTF-16LE" onErr (Just w1)
141− (T bs (S3 w2 w3 w4) (i+1))
142− where x = B.unsafeIndex ps i
143− consume (T Empty S0 _) = Done
144− consume st = decodeError "streamUtf16LE" "UTF-16LE" onErr Nothing st
145−{-# INLINE [0] streamUtf16LE #-}
146−
147−-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big
148−-- endian UTF-16 encoding.
149−streamUtf16BE :: OnDecodeError -> ByteString -> Stream Char
150−streamUtf16BE onErr bs0 = Stream next (T bs0 S0 0) unknownSize
151− where
152− next (T bs@(Chunk ps _) S0 i)
153− | i + 1 < len && U16.validate1 x1 =
154− Yield (unsafeChr x1) (T bs S0 (i+2))
155− | i + 3 < len && U16.validate2 x1 x2 =
156− Yield (U16.chr2 x1 x2) (T bs S0 (i+4))
157− where len = B.length ps
158− x1 = c (idx i) (idx (i + 1))
159− x2 = c (idx (i + 2)) (idx (i + 3))
160− c w1 w2 = (w1 `shiftL` 8) + w2
161− idx = fromIntegral . B.unsafeIndex ps :: Int -> Word16
162− next st@(T bs s i) =
163− case s of
164− S2 w1 w2 | U16.validate1 (c w1 w2) ->
165− Yield (unsafeChr (c w1 w2)) es
166− S4 w1 w2 w3 w4 | U16.validate2 (c w1 w2) (c w3 w4) ->
167− Yield (U16.chr2 (c w1 w2) (c w3 w4)) es
168− _ -> consume st
169− where es = T bs S0 i
170− c :: Word8 -> Word8 -> Word16
171− c w1 w2 = (fromIntegral w1 `shiftL` 8) + fromIntegral w2
172− consume (T bs@(Chunk ps rest) s i)
173− | i >= B.length ps = consume (T rest s 0)
174− | otherwise =
175− case s of
176− S0 -> next (T bs (S1 x) (i+1))
177− S1 w1 -> next (T bs (S2 w1 x) (i+1))
178− S2 w1 w2 -> next (T bs (S3 w1 w2 x) (i+1))
179− S3 w1 w2 w3 -> next (T bs (S4 w1 w2 w3 x) (i+1))
180− S4 w1 w2 w3 w4 -> decodeError "streamUtf16BE" "UTF-16BE" onErr (Just w1)
181− (T bs (S3 w2 w3 w4) (i+1))
182− where x = B.unsafeIndex ps i
183− consume (T Empty S0 _) = Done
184− consume st = decodeError "streamUtf16BE" "UTF-16BE" onErr Nothing st
185−{-# INLINE [0] streamUtf16BE #-}
186−
187−-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big
188−-- endian UTF-32 encoding.
189−streamUtf32BE :: OnDecodeError -> ByteString -> Stream Char
190−streamUtf32BE onErr bs0 = Stream next (T bs0 S0 0) unknownSize
191− where
192− next (T bs@(Chunk ps _) S0 i)
193− | i + 3 < len && U32.validate x =
194− Yield (unsafeChr32 x) (T bs S0 (i+4))
195− where len = B.length ps
196− x = shiftL x1 24 + shiftL x2 16 + shiftL x3 8 + x4
197− x1 = idx i
198− x2 = idx (i+1)
199− x3 = idx (i+2)
200− x4 = idx (i+3)
201− idx = fromIntegral . B.unsafeIndex ps :: Int -> Word32
202− next st@(T bs s i) =
203− case s of
204− S4 w1 w2 w3 w4 | U32.validate (c w1 w2 w3 w4) ->
205− Yield (unsafeChr32 (c w1 w2 w3 w4)) es
206− _ -> consume st
207− where es = T bs S0 i
208− c :: Word8 -> Word8 -> Word8 -> Word8 -> Word32
209− c w1 w2 w3 w4 = shifted
210− where
211− shifted = shiftL x1 24 + shiftL x2 16 + shiftL x3 8 + x4
212− x1 = fromIntegral w1
213− x2 = fromIntegral w2
214− x3 = fromIntegral w3
215− x4 = fromIntegral w4
216− consume (T bs@(Chunk ps rest) s i)
217− | i >= B.length ps = consume (T rest s 0)
218− | otherwise =
219− case s of
220− S0 -> next (T bs (S1 x) (i+1))
221− S1 w1 -> next (T bs (S2 w1 x) (i+1))
222− S2 w1 w2 -> next (T bs (S3 w1 w2 x) (i+1))
223− S3 w1 w2 w3 -> next (T bs (S4 w1 w2 w3 x) (i+1))
224− S4 w1 w2 w3 w4 -> decodeError "streamUtf32BE" "UTF-32BE" onErr (Just w1)
225− (T bs (S3 w2 w3 w4) (i+1))
226− where x = B.unsafeIndex ps i
227− consume (T Empty S0 _) = Done
228− consume st = decodeError "streamUtf32BE" "UTF-32BE" onErr Nothing st
229−{-# INLINE [0] streamUtf32BE #-}
230−
231−-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little
232−-- endian UTF-32 encoding.
233−streamUtf32LE :: OnDecodeError -> ByteString -> Stream Char
234−streamUtf32LE onErr bs0 = Stream next (T bs0 S0 0) unknownSize
235− where
236− next (T bs@(Chunk ps _) S0 i)
237− | i + 3 < len && U32.validate x =
238− Yield (unsafeChr32 x) (T bs S0 (i+4))
239− where len = B.length ps
240− x = shiftL x4 24 + shiftL x3 16 + shiftL x2 8 + x1
241− x1 = idx i
242− x2 = idx (i+1)
243− x3 = idx (i+2)
244− x4 = idx (i+3)
245− idx = fromIntegral . B.unsafeIndex ps :: Int -> Word32
246− next st@(T bs s i) =
247− case s of
248− S4 w1 w2 w3 w4 | U32.validate (c w1 w2 w3 w4) ->
249− Yield (unsafeChr32 (c w1 w2 w3 w4)) es
250− _ -> consume st
251− where es = T bs S0 i
252− c :: Word8 -> Word8 -> Word8 -> Word8 -> Word32
253− c w1 w2 w3 w4 = shifted
254− where
255− shifted = shiftL x4 24 + shiftL x3 16 + shiftL x2 8 + x1
256− x1 = fromIntegral w1
257− x2 = fromIntegral w2
258− x3 = fromIntegral w3
259− x4 = fromIntegral w4
260− consume (T bs@(Chunk ps rest) s i)
261− | i >= B.length ps = consume (T rest s 0)
262− | otherwise =
263− case s of
264− S0 -> next (T bs (S1 x) (i+1))
265− S1 w1 -> next (T bs (S2 w1 x) (i+1))
266− S2 w1 w2 -> next (T bs (S3 w1 w2 x) (i+1))
267− S3 w1 w2 w3 -> next (T bs (S4 w1 w2 w3 x) (i+1))
268− S4 w1 w2 w3 w4 -> decodeError "streamUtf32LE" "UTF-32LE" onErr (Just w1)
269− (T bs (S3 w2 w3 w4) (i+1))
270− where x = B.unsafeIndex ps i
271− consume (T Empty S0 _) = Done
272− consume st = decodeError "streamUtf32LE" "UTF-32LE" onErr Nothing st
273−{-# INLINE [0] streamUtf32LE #-}
274−
275−-- | /O(n)/ Convert a 'Stream' 'Word8' to a lazy 'ByteString'.
276−unstreamChunks :: Int -> Stream Word8 -> ByteString
277−unstreamChunks chunkSize (Stream next s0 len0) = chunk s0 (upperBound 4 len0)
278− where chunk s1 len1 = unsafeDupablePerformIO $ do
279− let len = max 4 (min len1 chunkSize)
280− mallocByteString len >>= loop len 0 s1
281− where
282− loop !n !off !s fp = case next s of
283− Done | off == 0 -> return Empty
284− | otherwise -> return $! Chunk (trimUp fp off) Empty
285− Skip s' -> loop n off s' fp
286− Yield x s'
287− | off == chunkSize -> do
288− let !newLen = n - off
289− return $! Chunk (trimUp fp off) (chunk s newLen)
290− | off == n -> realloc fp n off s' x
291− | otherwise -> do
292− withForeignPtr fp $ \p -> pokeByteOff p off x
293− loop n (off+1) s' fp
294− {-# NOINLINE realloc #-}
295− realloc fp n off s x = do
296− let n' = min (n+n) chunkSize
297− fp' <- copy0 fp n n'
298− withForeignPtr fp' $ \p -> pokeByteOff p off x
299− loop n' (off+1) s fp'
300− trimUp fp off = B.PS fp 0 off
301− copy0 :: ForeignPtr Word8 -> Int -> Int -> IO (ForeignPtr Word8)
302− copy0 !src !srcLen !destLen =
303−#if defined(ASSERTS)
304− assert (srcLen <= destLen) $
305−#endif
306− do
307− dest <- mallocByteString destLen
308− withForeignPtr src $ \src' ->
309− withForeignPtr dest $ \dest' ->
310− memcpy dest' src' (fromIntegral srcLen)
311− return dest
312−
313−-- | /O(n)/ Convert a 'Stream' 'Word8' to a lazy 'ByteString'.
314−unstream :: Stream Word8 -> ByteString
315−unstream = unstreamChunks defaultChunkSize
316−
317−decodeError :: forall s. String -> String -> OnDecodeError -> Maybe Word8
318− -> s -> Step s Char
319−decodeError func kind onErr mb i =
320− case onErr desc mb of
321− Nothing -> Skip i
322− Just c -> Yield c i
323− where desc = "Data.Text.Lazy.Encoding.Fusion." ++ func ++ ": Invalid " ++
324− kind ++ " stream"
Data/Text/Internal/Lazy/Fusion.hsdeleted−120
@@ -1,120 +0,0 @@
1−{-# LANGUAGE BangPatterns #-}
2−-- |
3−-- Module : Data.Text.Lazy.Fusion
4−-- Copyright : (c) 2009, 2010 Bryan O'Sullivan
5−--
6−-- License : BSD-style
7−-- Maintainer : bos@serpentine.com
8−-- Stability : experimental
9−-- Portability : GHC
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−-- Core stream fusion functionality for text.
16−
17−module Data.Text.Internal.Lazy.Fusion
18− (
19− stream
20− , unstream
21− , unstreamChunks
22− , length
23− , unfoldrN
24− , index
25− , countChar
26− ) where
27−
28−import Prelude hiding (length)
29−import qualified Data.Text.Internal.Fusion.Common as S
30−import Control.Monad.ST (runST)
31−import Data.Text.Internal.Fusion.Types
32−import Data.Text.Internal.Fusion.Size (isEmpty, unknownSize)
33−import Data.Text.Internal.Lazy
34−import qualified Data.Text.Internal as I
35−import qualified Data.Text.Array as A
36−import Data.Text.Internal.Unsafe.Char (unsafeWrite)
37−import Data.Text.Internal.Unsafe.Shift (shiftL)
38−import Data.Text.Unsafe (Iter(..), iter)
39−import Data.Int (Int64)
40−
41−default(Int64)
42−
43−-- | /O(n)/ Convert a 'Text' into a 'Stream Char'.
44−stream :: Text -> Stream Char
45−stream text = Stream next (text :*: 0) unknownSize
46− where
47− next (Empty :*: _) = Done
48− next (txt@(Chunk t@(I.Text _ _ len) ts) :*: i)
49− | i >= len = next (ts :*: 0)
50− | otherwise = Yield c (txt :*: i+d)
51− where Iter c d = iter t i
52−{-# INLINE [0] stream #-}
53−
54−-- | /O(n)/ Convert a 'Stream Char' into a 'Text', using the given
55−-- chunk size.
56−unstreamChunks :: Int -> Stream Char -> Text
57−unstreamChunks !chunkSize (Stream next s0 len0)
58− | isEmpty len0 = Empty
59− | otherwise = outer s0
60− where
61− outer so = {-# SCC "unstreamChunks/outer" #-}
62− case next so of
63− Done -> Empty
64− Skip s' -> outer s'
65− Yield x s' -> runST $ do
66− a <- A.new unknownLength
67− unsafeWrite a 0 x >>= inner a unknownLength s'
68− where unknownLength = 4
69− where
70− inner marr !len s !i
71− | i + 1 >= chunkSize = finish marr i s
72− | i + 1 >= len = {-# SCC "unstreamChunks/resize" #-} do
73− let newLen = min (len `shiftL` 1) chunkSize
74− marr' <- A.new newLen
75− A.copyM marr' 0 marr 0 len
76− inner marr' newLen s i
77− | otherwise =
78− {-# SCC "unstreamChunks/inner" #-}
79− case next s of
80− Done -> finish marr i s
81− Skip s' -> inner marr len s' i
82− Yield x s' -> do d <- unsafeWrite marr i x
83− 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 #-}
88−
89−-- | /O(n)/ Convert a 'Stream Char' into a 'Text', using
90−-- 'defaultChunkSize'.
91−unstream :: Stream Char -> Text
92−unstream = unstreamChunks defaultChunkSize
93−{-# INLINE [0] unstream #-}
94−
95−-- | /O(n)/ Returns the number of characters in a text.
96−length :: Stream Char -> Int64
97−length = S.lengthI
98−{-# INLINE[0] length #-}
99−
100−{-# RULES "LAZY STREAM stream/unstream fusion" forall s.
101− stream (unstream s) = s #-}
102−
103−-- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a stream from a seed
104−-- value. However, the length of the result is limited by the
105−-- first argument to 'unfoldrN'. This function is more efficient than
106−-- 'unfoldr' when the length of the result is known.
107−unfoldrN :: Int64 -> (a -> Maybe (Char,a)) -> a -> Stream Char
108−unfoldrN n = S.unfoldrNI n
109−{-# INLINE [0] unfoldrN #-}
110−
111−-- | /O(n)/ stream index (subscript) operator, starting from 0.
112−index :: Stream Char -> Int64 -> Char
113−index = S.indexI
114−{-# INLINE [0] index #-}
115−
116−-- | /O(n)/ The 'count' function returns the number of times the query
117−-- element appears in the given stream.
118−countChar :: Char -> Stream Char -> Int64
119−countChar = S.countCharI
120−{-# INLINE [0] countChar #-}
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/Internal/Unsafe.hsdeleted−56
@@ -1,56 +0,0 @@
1−{-# LANGUAGE CPP, MagicHash, UnboxedTuples #-}
2−{-# OPTIONS_HADDOCK not-home #-}
3−
4−-- |
5−-- Module : Data.Text.Internal.Unsafe
6−-- Copyright : (c) 2009, 2010, 2011 Bryan O'Sullivan
7−-- License : BSD-style
8−-- Maintainer : bos@serpentine.com
9−-- Stability : experimental
10−-- Portability : portable
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−-- A module containing /unsafe/ operations, for /very very careful/ use
17−-- in /heavily tested/ code.
18−module Data.Text.Internal.Unsafe
19− (
20− inlineInterleaveST
21− , inlinePerformIO
22− ) where
23−
24−import GHC.ST (ST(..))
25−#if defined(__GLASGOW_HASKELL__)
26−import GHC.IO (IO(IO))
27−import GHC.Base (realWorld#)
28−#endif
29−
30−
31−-- | Just like unsafePerformIO, but we inline it. Big performance gains as
32−-- it exposes lots of things to further inlining. /Very unsafe/. In
33−-- particular, you should do no memory allocation inside an
34−-- 'inlinePerformIO' block. On Hugs this is just @unsafePerformIO@.
35−--
36−{-# INLINE inlinePerformIO #-}
37−inlinePerformIO :: IO a -> a
38−#if defined(__GLASGOW_HASKELL__)
39−inlinePerformIO (IO m) = case m realWorld# of (# _, r #) -> r
40−#else
41−inlinePerformIO = unsafePerformIO
42−#endif
43−
44−-- | Allow an 'ST' computation to be deferred lazily. When passed an
45−-- action of type 'ST' @s@ @a@, the action will only be performed when
46−-- the value of @a@ is demanded.
47−--
48−-- This function is identical to the normal unsafeInterleaveST, but is
49−-- inlined and hence faster.
50−--
51−-- /Note/: This operation is highly unsafe, as it can introduce
52−-- externally visible non-determinism into an 'ST' action.
53−inlineInterleaveST :: ST s a -> ST s a
54−inlineInterleaveST (ST m) = ST $ \ s ->
55− let r = case m s of (# _, res #) -> res in (# s, r #)
56−{-# INLINE inlineInterleaveST #-}
Data/Text/Lazy.hs+240−649
@@ -1,56 +1,37 @@
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) Bryan O'Sullivan 2009
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--
19-- A time and space-efficient implementation of Unicode text using
13-- A time and space-efficient implementation of Unicode text using
20−-- lists of packed arrays.
21−--
22−-- /Note/: Read below the synopsis for important notes on the use of
23−-- this module.
24−--
25−-- The representation used by this module is suitable for high
14+-- lists of packed arrays. This representation is suitable for high
26-- performance use and for streaming large quantities of data. It
15-- performance use and for streaming large quantities of data. It
27-- provides a means to manipulate a large body of text without
16-- provides a means to manipulate a large body of text without
28-- requiring that the entire content be resident in memory.
17-- requiring that the entire content be resident in memory.
29--
18--
30-- Some operations, such as 'concat', 'append', 'reverse' and 'cons',
19-- Some operations, such as 'concat', 'append', 'reverse' and 'cons',
31−-- have better time complexity than their "Data.Text" equivalents, due
20+-- have better complexity than their "Data.Text" equivalents, due to
32−-- to the underlying representation being a list of chunks. For other
21+-- optimisations resulting from the list spine structure. And for
33−-- operations, lazy 'Text's are usually within a few percent of strict
22+-- other operations lazy 'Text's are usually within a few percent of
34−-- ones, but often with better heap usage if used in a streaming
23+-- strict ones, but with better heap usage. For data larger than
35−-- fashion. For data larger than available memory, or if you have
24+-- available memory, or if you have tight memory constraints, this
36−-- tight memory constraints, this module will be the only option.
25+-- module will be the only option.
37--
26--
38-- This module is intended to be imported @qualified@, to avoid name
27-- This module is intended to be imported @qualified@, to avoid name
39-- clashes with "Prelude" functions. eg.
28-- clashes with "Prelude" functions. eg.
40--
29--
41−-- > import qualified Data.Text.Lazy as L
30+-- > import qualified Data.Text.Lazy as B
42
31
43module Data.Text.Lazy
32module Data.Text.Lazy
44 (
33 (
45− -- * Fusion
46− -- $fusion
47−
48− -- * Acceptable data
49− -- $replacement
50−
51− -- * Types
52 Text
34 Text
53−
54 -- * Creation and elimination
35 -- * Creation and elimination
55 , pack
36 , pack
56 , unpack
37 , unpack
@@ -58,10 +39,6 @@ module Data.Text.Lazy
58 , empty
39 , empty
59 , fromChunks
40 , fromChunks
60 , toChunks
41 , toChunks
61− , toStrict
62− , fromStrict
63− , foldrChunks
64− , foldlChunks
65
42
66 -- * Basic interface
43 -- * Basic interface
67 , cons
44 , cons
@@ -74,7 +51,6 @@ module Data.Text.Lazy
74 , init
51 , init
75 , null
52 , null
76 , length
53 , length
77− , compareLength
78
54
79 -- * Transformations
55 -- * Transformations
80 , map
56 , map
@@ -89,7 +65,6 @@ module Data.Text.Lazy
89 , toCaseFold
65 , toCaseFold
90 , toLower
66 , toLower
91 , toUpper
67 , toUpper
92− , toTitle
93
68
94 -- ** Justification
69 -- ** Justification
95 , justifyLeft
70 , justifyLeft
@@ -125,10 +100,7 @@ module Data.Text.Lazy
125 , mapAccumR
100 , mapAccumR
126
101
127 -- ** Generation and unfolding
102 -- ** Generation and unfolding
128− , repeat
129 , replicate
103 , replicate
130− , cycle
131− , iterate
132 , unfoldr
104 , unfoldr
133 , unfoldrN
105 , unfoldrN
134
106
@@ -136,11 +108,8 @@ module Data.Text.Lazy
136
108
137 -- ** Breaking strings
109 -- ** Breaking strings
138 , take
110 , take
139− , takeEnd
140 , drop
111 , drop
141− , dropEnd
142 , takeWhile
112 , takeWhile
143− , takeWhileEnd
144 , dropWhile
113 , dropWhile
145 , dropWhileEnd
114 , dropWhileEnd
146 , dropAround
115 , dropAround
@@ -148,10 +117,10 @@ module Data.Text.Lazy
148 , stripStart
117 , stripStart
149 , stripEnd
118 , stripEnd
150 , splitAt
119 , splitAt
151− , span
120+ , spanBy
152− , breakOn
153− , breakOnEnd
154 , break
121 , break
122+ , breakEnd
123+ , breakBy
155 , group
124 , group
156 , groupBy
125 , groupBy
157 , inits
126 , inits
@@ -159,8 +128,8 @@ module Data.Text.Lazy
159
128
160 -- ** Breaking into many substrings
129 -- ** Breaking into many substrings
161 -- $split
130 -- $split
162− , splitOn
163 , split
131 , split
132+ , splitBy
164 , chunksOf
133 , chunksOf
165 -- , breakSubstring
134 -- , breakSubstring
166
135
@@ -176,18 +145,17 @@ module Data.Text.Lazy
176 , isInfixOf
145 , isInfixOf
177
146
178 -- ** View patterns
147 -- ** View patterns
179− , stripPrefix
148+ , prefixed
180− , stripSuffix
149+ , suffixed
181− , commonPrefixes
182
150
183 -- * Searching
151 -- * Searching
184 , filter
152 , filter
185 , find
153 , find
186− , breakOnAll
154+ , findBy
187− , partition
155+ , partitionBy
188
156
189 -- , findSubstring
157 -- , findSubstring
190−
158+
191 -- * Indexing
159 -- * Indexing
192 , index
160 , index
193 , count
161 , count
@@ -201,9 +169,9 @@ module Data.Text.Lazy
201 ) where
169 ) where
202
170
203import Prelude (Char, Bool(..), Maybe(..), String,
171import Prelude (Char, Bool(..), Maybe(..), String,
204− Eq(..), Ord(..), Ordering(..), Read(..), Show(..),
172+ Eq(..), Ord(..), Read(..), Show(..),
205− (&&), (||), (+), (-), (.), ($), (++),
173+ (&&), (+), (-), (.), ($), (++),
206− error, flip, fmap, fromIntegral, not, otherwise, quot)
174+ div, error, flip, fromIntegral, not, otherwise)
207import qualified Prelude as P
175import qualified Prelude as P
208#if defined(HAVE_DEEPSEQ)
176#if defined(HAVE_DEEPSEQ)
209import Control.DeepSeq (NFData(..))
177import Control.DeepSeq (NFData(..))
@@ -211,129 +179,32 @@ import Control.DeepSeq (NFData(..))
211import Data.Int (Int64)
179import Data.Int (Int64)
212import qualified Data.List as L
180import qualified Data.List as L
213import Data.Char (isSpace)
181import Data.Char (isSpace)
214−import Data.Data (Data(gfoldl, toConstr, gunfold, dataTypeOf), constrIndex,
182+import Data.Data (Data(gfoldl, toConstr, gunfold, dataTypeOf))
215− Constr, mkConstr, DataType, mkDataType, Fixity(Prefix))
183+#if __GLASGOW_HASKELL__ >= 612
216−import Data.Binary (Binary(get, put))
184+import Data.Data (mkNoRepType)
217−import Data.Monoid (Monoid(..))
185+#else
218−#if MIN_VERSION_base(4,9,0)
186+import Data.Data (mkNorepType)
219−import Data.Semigroup (Semigroup(..))
220#endif
187#endif
188+import Data.Monoid (Monoid(..))
221import Data.String (IsString(..))
189import Data.String (IsString(..))
222import qualified Data.Text as T
190import qualified Data.Text as T
223import qualified Data.Text.Internal as T
191import qualified Data.Text.Internal as T
224−import qualified Data.Text.Internal.Fusion.Common as S
192+import qualified Data.Text.Fusion.Common as S
225import qualified Data.Text.Unsafe as T
193import qualified Data.Text.Unsafe as T
226−import qualified Data.Text.Internal.Lazy.Fusion as S
194+import qualified Data.Text.Lazy.Fusion as S
227−import Data.Text.Internal.Fusion.Types (PairS(..))
195+import Data.Text.Fusion.Internal (PairS(..))
228−import Data.Text.Internal.Lazy.Fusion (stream, unstream)
196+import Data.Text.Lazy.Fusion (stream, unstream)
229−import Data.Text.Internal.Lazy (Text(..), chunk, empty, foldlChunks,
197+import Data.Text.Lazy.Internal (Text(..), chunk, empty, foldlChunks, foldrChunks)
230− foldrChunks, smallChunkSize)
231−import Data.Text.Internal (firstf, safe, text)
198+import Data.Text.Internal (textP)
232−import Data.Text.Lazy.Encoding (decodeUtf8', encodeUtf8)
233−import qualified Data.Text.Internal.Functions as F
234−import Data.Text.Internal.Lazy.Search (indices)
199+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−
248−-- $fusion
249−--
250−-- Most of the functions in this module are subject to /fusion/,
251−-- meaning that a pipeline of such functions will usually allocate at
252−-- most one 'Text' value.
253−--
254−-- As an example, consider the following pipeline:
255−--
256−-- > import Data.Text.Lazy as T
257−-- > import Data.Text.Lazy.Encoding as E
258−-- > import Data.ByteString.Lazy (ByteString)
259−-- >
260−-- > countChars :: ByteString -> Int
261−-- > countChars = T.length . T.toUpper . E.decodeUtf8
262−--
263−-- From the type signatures involved, this looks like it should
264−-- allocate one 'ByteString' value, and two 'Text' values. However,
265−-- when a module is compiled with optimisation enabled under GHC, the
266−-- two intermediate 'Text' values will be optimised away, and the
267−-- function will be compiled down to a single loop over the source
268−-- 'ByteString'.
269−--
270−-- Functions that can be fused by the compiler are documented with the
271−-- phrase \"Subject to fusion\".
272−
273−-- $replacement
274−--
275−-- A 'Text' value is a sequence of Unicode scalar values, as defined
276−-- in &#xa7;3.9, definition D76 of the Unicode 5.2 standard:
277−-- <http://www.unicode.org/versions/Unicode5.2.0/ch03.pdf#page=35>. As
278−-- such, a 'Text' cannot contain values in the range U+D800 to U+DFFF
279−-- inclusive. Haskell implementations admit all Unicode code points
280−-- (&#xa7;3.4, definition D10) as 'Char' values, including code points
281−-- from this invalid range. This means that there are some 'Char'
282−-- values that are not valid Unicode scalar values, and the functions
283−-- in this module must handle those cases.
284−--
285−-- Within this module, many functions construct a 'Text' from one or
286−-- more 'Char' values. Those functions will substitute 'Char' values
287−-- that are not valid Unicode scalar values with the replacement
288−-- character \"&#xfffd;\" (U+FFFD). Functions that perform this
289−-- inspection and replacement are documented with the phrase
290−-- \"Performs replacement on invalid scalar values\".
291−--
292−-- (One reason for this policy of replacement is that internally, a
293−-- 'Text' value is represented as packed UTF-16 data. Values in the
294−-- range U+D800 through U+DFFF are used by UTF-16 to denote surrogate
295−-- code points, and so cannot be represented. The functions replace
296−-- invalid scalar values, instead of dropping them, as a security
297−-- measure. For details, see Unicode Technical Report 36, &#xa7;3.5:
298−-- <http://unicode.org/reports/tr36#Deletion_of_Noncharacters>)
299−
300−equal :: Text -> Text -> Bool
301−equal Empty Empty = True
302−equal Empty _ = False
303−equal _ Empty = False
304−equal (Chunk a as) (Chunk b bs) =
305− case compare lenA lenB of
306− LT -> a == (T.takeWord16 lenA b) &&
307− as `equal` Chunk (T.dropWord16 lenA b) bs
308− EQ -> a == b && as `equal` bs
309− GT -> T.takeWord16 lenB a == b &&
310− Chunk (T.dropWord16 lenB a) as `equal` bs
311− where lenA = T.lengthWord16 a
312− lenB = T.lengthWord16 b
313
200
314instance Eq Text where
201instance Eq Text where
315− (==) = equal
202+ t1 == t2 = stream t1 == stream t2
316 {-# INLINE (==) #-}
203 {-# INLINE (==) #-}
317
204
318instance Ord Text where
205instance Ord Text where
319− compare = compareText
206+ compare t1 t2 = compare (stream t1) (stream t2)
320−
207+ {-# INLINE compare #-}
321−compareText :: Text -> Text -> Ordering
322−compareText Empty Empty = EQ
323−compareText Empty _ = LT
324−compareText _ Empty = GT
325−compareText (Chunk a0 as) (Chunk b0 bs) = outer a0 b0
326− where
327− outer ta@(T.Text arrA offA lenA) tb@(T.Text arrB offB lenB) = go 0 0
328− where
329− go !i !j
330− | i >= lenA = compareText as (chunk (T.Text arrB (offB+j) (lenB-j)) bs)
331− | j >= lenB = compareText (chunk (T.Text arrA (offA+i) (lenA-i)) as) bs
332− | a < b = LT
333− | a > b = GT
334− | otherwise = go (i+di) (j+dj)
335− where T.Iter a di = T.iter ta i
336− T.Iter b dj = T.iter tb j
337
208
338instance Show Text where
209instance Show Text where
339 showsPrec p ps r = showsPrec p (unpack ps) r
210 showsPrec p ps r = showsPrec p (unpack ps) r
@@ -341,108 +212,43 @@ instance Show Text where
341instance Read Text where
212instance Read Text where
342 readsPrec p str = [(pack x,y) | (x,y) <- readsPrec p str]
213 readsPrec p str = [(pack x,y) | (x,y) <- readsPrec p str]
343
214
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
215instance Monoid Text where
353 mempty = empty
216 mempty = empty
354−#if MIN_VERSION_base(4,9,0)
355− mappend = (<>) -- future-proof definition
356−#else
357 mappend = append
217 mappend = append
358−#endif
359 mconcat = concat
218 mconcat = concat
360
219
361instance IsString Text where
220instance IsString Text where
362 fromString = pack
221 fromString = pack
363
222
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)
223#if defined(HAVE_DEEPSEQ)
372instance NFData Text where
224instance NFData Text where
373 rnf Empty = ()
225 rnf Empty = ()
374 rnf (Chunk _ ts) = rnf ts
226 rnf (Chunk _ ts) = rnf ts
375#endif
227#endif
376
228
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
229instance Data Text where
391 gfoldl f z txt = z pack `f` (unpack txt)
230 gfoldl f z txt = z pack `f` (unpack txt)
392− toConstr _ = packConstr
231+ 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"
232+ gunfold _ _ = error "Data.Text.Lazy.Text.gunfold"
396− dataTypeOf _ = textDataType
233+#if __GLASGOW_HASKELL__ >= 612
397−
234+ dataTypeOf _ = mkNoRepType "Data.Text.Lazy.Text"
398−#if MIN_VERSION_base(4,7,0)
235+#else
399−-- | Only defined for @base-4.7.0.0@ and later
236+ dataTypeOf _ = mkNorepType "Data.Text.Lazy.Text"
400−instance PrintfArg Text where
401− formatArg txt = formatString $ unpack txt
402#endif
237#endif
403
238
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'.
239-- | /O(n)/ Convert a 'String' into a 'Text'.
411--
240--
412−-- Subject to fusion. Performs replacement on invalid scalar values.
241+-- This function is subject to array fusion.
413pack :: String -> Text
242pack :: String -> Text
414−pack = unstream . S.streamList . L.map safe
243+pack s = unstream (S.streamList s)
415{-# INLINE [1] pack #-}
244{-# INLINE [1] pack #-}
416
245
417-- | /O(n)/ Convert a 'Text' into a 'String'.
246-- | /O(n)/ Convert a 'Text' into a 'String'.
418−-- Subject to fusion.
247+-- Subject to array fusion.
419unpack :: Text -> String
248unpack :: Text -> String
420unpack t = S.unstreamList (stream t)
249unpack t = S.unstreamList (stream t)
421{-# INLINE [1] unpack #-}
250{-# INLINE [1] unpack #-}
422
251
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.
445−-- Performs replacement on invalid scalar values.
446singleton :: Char -> Text
252singleton :: Char -> Text
447singleton c = Chunk (T.singleton c) Empty
253singleton c = Chunk (T.singleton c) Empty
448{-# INLINE [1] singleton #-}
254{-# INLINE [1] singleton #-}
@@ -462,28 +268,10 @@ fromChunks cs = L.foldr chunk Empty cs
462toChunks :: Text -> [T.Text]
268toChunks :: Text -> [T.Text]
463toChunks cs = foldrChunks (:) [] cs
269toChunks cs = foldrChunks (:) [] cs
464
270
465−-- | /O(n)/ Convert a lazy 'Text' into a strict 'T.Text'.
466−toStrict :: Text -> T.Text
467−toStrict t = T.concat (toChunks t)
468−{-# INLINE [1] toStrict #-}
469−
470−-- | /O(c)/ Convert a strict 'T.Text' into a lazy 'Text'.
471−fromStrict :: T.Text -> Text
472−fromStrict t = chunk t Empty
473−{-# INLINE [1] fromStrict #-}
474−
475−-- -----------------------------------------------------------------------------
476−-- * Basic functions
477−
478−-- | /O(n)/ Adds a character to the front of a 'Text'. This function
479−-- is more costly than its 'List' counterpart because it requires
480−-- copying a new array. Subject to fusion.
481cons :: Char -> Text -> Text
271cons :: Char -> Text -> Text
482cons c t = Chunk (T.singleton c) t
272cons c t = Chunk (T.singleton c) t
483{-# INLINE [1] cons #-}
273{-# INLINE [1] cons #-}
484
274
485−infixr 5 `cons`
486−
487{-# RULES
275{-# RULES
488"LAZY TEXT cons -> fused" [~1] forall c t.
276"LAZY TEXT cons -> fused" [~1] forall c t.
489 cons c t = unstream (S.cons c (stream t))
277 cons c t = unstream (S.cons c (stream t))
@@ -491,8 +279,6 @@ infixr 5 `cons`
491 unstream (S.cons c (stream t)) = cons c t
279 unstream (S.cons c (stream t)) = cons c t
492 #-}
280 #-}
493
281
494−-- | /O(n)/ Adds a character to the end of a 'Text'. This copies the
495−-- entire array in the process, unless fused. Subject to fusion.
496snoc :: Text -> Char -> Text
282snoc :: Text -> Char -> Text
497snoc t c = foldrChunks Chunk (singleton c) t
283snoc t c = foldrChunks Chunk (singleton c) t
498{-# INLINE [1] snoc #-}
284{-# INLINE [1] snoc #-}
@@ -504,7 +290,8 @@ snoc t c = foldrChunks Chunk (singleton c) t
504 unstream (S.snoc (stream t) c) = snoc t c
290 unstream (S.snoc (stream t) c) = snoc t c
505 #-}
291 #-}
506
292
507−-- | /O(n\/c)/ Appends one 'Text' to another. Subject to fusion.
293+-- | /O(n\/c)/ Appends one 'Text' to another. Subject to array
294+-- fusion.
508append :: Text -> Text -> Text
295append :: Text -> Text -> Text
509append xs ys = foldrChunks Chunk ys xs
296append xs ys = foldrChunks Chunk ys xs
510{-# INLINE [1] append #-}
297{-# INLINE [1] append #-}
@@ -517,22 +304,22 @@ append xs ys = foldrChunks Chunk ys xs
517 #-}
304 #-}
518
305
519-- | /O(1)/ Returns the first character and rest of a 'Text', or
306-- | /O(1)/ Returns the first character and rest of a 'Text', or
520−-- 'Nothing' if empty. Subject to fusion.
307+-- 'Nothing' if empty. Subject to array fusion.
521uncons :: Text -> Maybe (Char, Text)
308uncons :: Text -> Maybe (Char, Text)
522−uncons Empty = Nothing
309+uncons Empty = Nothing
310+uncons (Chunk t ts) =
523−uncons (Chunk t ts) = Just (T.unsafeHead t, ts')
311+ Just (T.unsafeHead t,
524− where ts' | T.compareLength t 1 == EQ = ts
525− | otherwise = Chunk (T.unsafeTail t) ts
312+ if T.length t == 1 then ts else Chunk (T.unsafeTail t) ts)
526{-# INLINE uncons #-}
313{-# INLINE uncons #-}
527
314
528-- | /O(1)/ Returns the first character of a 'Text', which must be
315-- | /O(1)/ Returns the first character of a 'Text', which must be
529−-- non-empty. Subject to fusion.
316+-- non-empty. Subject to array fusion.
530head :: Text -> Char
317head :: Text -> Char
531head t = S.head (stream t)
318head t = S.head (stream t)
532{-# INLINE head #-}
319{-# INLINE head #-}
533
320
534-- | /O(1)/ Returns all characters after the head of a 'Text', which
321-- | /O(1)/ Returns all characters after the head of a 'Text', which
535−-- must be non-empty. Subject to fusion.
322+-- must be non-empty. Subject to array fusion.
536tail :: Text -> Text
323tail :: Text -> Text
537tail (Chunk t ts) = chunk (T.tail t) ts
324tail (Chunk t ts) = chunk (T.tail t) ts
538tail Empty = emptyError "tail"
325tail Empty = emptyError "tail"
@@ -545,8 +332,8 @@ tail Empty = emptyError "tail"
545 unstream (S.tail (stream t)) = tail t
332 unstream (S.tail (stream t)) = tail t
546 #-}
333 #-}
547
334
548−-- | /O(n\/c)/ Returns all but the last character of a 'Text', which must
335+-- | /O(1)/ Returns all but the last character of a 'Text', which must
549−-- be non-empty. Subject to fusion.
336+-- be non-empty. Subject to array fusion.
550init :: Text -> Text
337init :: Text -> Text
551init (Chunk t0 ts0) = go t0 ts0
338init (Chunk t0 ts0) = go t0 ts0
552 where go t (Chunk t' ts) = Chunk t (go t' ts)
339 where go t (Chunk t' ts) = Chunk t (go t' ts)
@@ -561,7 +348,7 @@ init Empty = emptyError "init"
561 unstream (S.init (stream t)) = init t
348 unstream (S.init (stream t)) = init t
562 #-}
349 #-}
563
350
564−-- | /O(1)/ Tests whether a 'Text' is empty or not. Subject to
351+-- | /O(1)/ Tests whether a 'Text' is empty or not. Subject to array
565-- fusion.
352-- fusion.
566null :: Text -> Bool
353null :: Text -> Bool
567null Empty = True
354null Empty = True
@@ -581,8 +368,8 @@ isSingleton :: Text -> Bool
581isSingleton = S.isSingleton . stream
368isSingleton = S.isSingleton . stream
582{-# INLINE isSingleton #-}
369{-# INLINE isSingleton #-}
583
370
584−-- | /O(n\/c)/ Returns the last character of a 'Text', which must be
371+-- | /O(1)/ Returns the last character of a 'Text', which must be
585−-- non-empty. Subject to fusion.
372+-- non-empty. Subject to array fusion.
586last :: Text -> Char
373last :: Text -> Char
587last Empty = emptyError "last"
374last Empty = emptyError "last"
588last (Chunk t ts) = go t ts
375last (Chunk t ts) = go t ts
@@ -597,8 +384,6 @@ last (Chunk t ts) = go t ts
597 S.last (stream t) = last t
384 S.last (stream t) = last t
598 #-}
385 #-}
599
386
600−-- | /O(n)/ Returns the number of characters in a 'Text'.
601−-- Subject to fusion.
602length :: Text -> Int64
387length :: Text -> Int64
603length = foldlChunks go 0
388length = foldlChunks go 0
604 where go l t = l + fromIntegral (T.length t)
389 where go l t = l + fromIntegral (T.length t)
@@ -611,46 +396,27 @@ length = foldlChunks go 0
611 S.length (stream t) = length t
396 S.length (stream t) = length t
612 #-}
397 #-}
613
398
614−-- | /O(n)/ Compare the count of characters in a 'Text' to a number.
615−-- Subject to fusion.
616−--
617−-- This function gives the same answer as comparing against the result
618−-- of 'length', but can short circuit if the count of characters is
619−-- greater than the number, and hence be more efficient.
620−compareLength :: Text -> Int64 -> Ordering
621−compareLength t n = S.compareLengthI (stream t) n
622−{-# INLINE [1] compareLength #-}
623−
624−-- We don't apply those otherwise appealing length-to-compareLength
625−-- rewrite rules here, because they can change the strictness
626−-- properties of code.
627−
628-- | /O(n)/ 'map' @f@ @t@ is the 'Text' obtained by applying @f@ to
399-- | /O(n)/ 'map' @f@ @t@ is the 'Text' obtained by applying @f@ to
629−-- each element of @t@. Subject to fusion. Performs replacement on
400+-- each element of @t@. Subject to array fusion.
630−-- invalid scalar values.
631map :: (Char -> Char) -> Text -> Text
401map :: (Char -> Char) -> Text -> Text
632−map f t = unstream (S.map (safe . f) (stream t))
402+map f t = unstream (S.map f (stream t))
633{-# INLINE [1] map #-}
403{-# INLINE [1] map #-}
634
404
635-- | /O(n)/ The 'intercalate' function takes a 'Text' and a list of
405-- | /O(n)/ The 'intercalate' function takes a 'Text' and a list of
636-- 'Text's and concatenates the list after interspersing the first
406-- 'Text's and concatenates the list after interspersing the first
637-- argument between each element of the list.
407-- argument between each element of the list.
638intercalate :: Text -> [Text] -> Text
408intercalate :: Text -> [Text] -> Text
639−intercalate t = concat . (F.intersperse t)
409+intercalate t = concat . (L.intersperse t)
640{-# INLINE intercalate #-}
410{-# INLINE intercalate #-}
641
411
642-- | /O(n)/ The 'intersperse' function takes a character and places it
412-- | /O(n)/ The 'intersperse' function takes a character and places it
643−-- between the characters of a 'Text'. Subject to fusion. Performs
413+-- between the characters of a 'Text'. Subject to array fusion.
644−-- replacement on invalid scalar values.
645−intersperse :: Char -> Text -> Text
414+intersperse :: Char -> Text -> Text
646−intersperse c t = unstream (S.intersperse (safe c) (stream t))
415+intersperse c t = unstream (S.intersperse c (stream t))
647{-# INLINE intersperse #-}
416{-# INLINE intersperse #-}
648
417
649-- | /O(n)/ Left-justify a string to the given length, using the
418-- | /O(n)/ Left-justify a string to the given length, using the
650−-- specified fill character on the right. Subject to fusion. Performs
419+-- specified fill character on the right. Subject to fusion. Examples:
651−-- replacement on invalid scalar values.
652−--
653−-- Examples:
654--
420--
655-- > justifyLeft 7 'x' "foo" == "fooxxxx"
421-- > justifyLeft 7 'x' "foo" == "fooxxxx"
656-- > justifyLeft 3 'x' "foobar" == "foobar"
422-- > justifyLeft 3 'x' "foobar" == "foobar"
@@ -669,10 +435,7 @@ justifyLeft k c t
669 #-}
435 #-}
670
436
671-- | /O(n)/ Right-justify a string to the given length, using the
437-- | /O(n)/ Right-justify a string to the given length, using the
672−-- specified fill character on the left. Performs replacement on
438+-- specified fill character on the left. Examples:
673−-- invalid scalar values.
674−--
675−-- Examples:
676--
439--
677-- > justifyRight 7 'x' "bar" == "xxxxbar"
440-- > justifyRight 7 'x' "bar" == "xxxxbar"
678-- > justifyRight 3 'x' "foobar" == "foobar"
441-- > justifyRight 3 'x' "foobar" == "foobar"
@@ -683,11 +446,8 @@ justifyRight k c t
683 where len = length t
446 where len = length t
684{-# INLINE justifyRight #-}
447{-# INLINE justifyRight #-}
685
448
686−-- | /O(n)/ Center a string to the given length, using the specified
449+-- | /O(n)/ Center a string to the given length, using the
687−-- fill character on either side. Performs replacement on invalid
450+-- specified fill character on either side. Examples:
688−-- scalar values.
689−--
690−-- Examples:
691--
451--
692-- > center 8 'x' "HS" = "xxxHSxxx"
452-- > center 8 'x' "HS" = "xxxHSxxx"
693center :: Int64 -> Char -> Text -> Text
453center :: Int64 -> Char -> Text -> Text
@@ -696,7 +456,7 @@ center k c t
696 | otherwise = replicateChar l c `append` t `append` replicateChar r c
456 | otherwise = replicateChar l c `append` t `append` replicateChar r c
697 where len = length t
457 where len = length t
698 d = k - len
458 d = k - len
699− r = d `quot` 2
459+ r = d `div` 2
700 l = d - r
460 l = d - r
701{-# INLINE center #-}
461{-# INLINE center #-}
702
462
@@ -715,38 +475,12 @@ reverse = rev Empty
715 where rev a Empty = a
475 where rev a Empty = a
716 rev a (Chunk t ts) = rev (Chunk (T.reverse t) a) ts
476 rev a (Chunk t ts) = rev (Chunk (T.reverse t) a) ts
717
477
718−-- | /O(m+n)/ Replace every non-overlapping occurrence of @needle@ in
478+-- | /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−--
739−-- In (unlikely) bad cases, this function's time complexity degrades
740−-- towards /O(n*m)/.
741−replace :: Text
479+replace :: Text -- ^ Text to search for
742− -- ^ @needle@ to search for. If this string is empty, an
480+ -> Text -- ^ Replacement text
743− -- error will occur.
744− -> Text
481+ -> Text -- ^ Input text
745− -- ^ @replacement@ to replace @needle@ with.
746 -> Text
482 -> Text
747− -- ^ @haystack@ in which to search.
748− -> Text
749−replace s d = intercalate d . splitOn s
483+replace s d = intercalate d . split s
750{-# INLINE replace #-}
484{-# INLINE replace #-}
751
485
752-- ----------------------------------------------------------------------------
486-- ----------------------------------------------------------------------------
@@ -761,10 +495,9 @@ replace s d = intercalate d . splitOn s
761-- functions may map one input character to two or three output
495-- functions may map one input character to two or three output
762-- characters.
496-- characters.
763
497
764−-- | /O(n)/ Convert a string to folded case. Subject to fusion.
498+-- | /O(n)/ Convert a string to folded case. This function is mainly
765−--
766−-- This function is mainly useful for performing caseless (or case
499+-- useful for performing caseless (or case insensitive) string
767−-- insensitive) string comparisons.
500+-- comparisons.
768--
501--
769-- A string @x@ is a caseless match for a string @y@ if and only if:
502-- A string @x@ is a caseless match for a string @y@ if and only if:
770--
503--
@@ -781,70 +514,45 @@ toCaseFold t = unstream (S.toCaseFold (stream t))
781{-# INLINE [0] toCaseFold #-}
514{-# INLINE [0] toCaseFold #-}
782
515
783-- | /O(n)/ Convert a string to lower case, using simple case
516-- | /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
517+-- conversion. The result string may be longer than the input string.
787−-- instance, the Latin capital letter I with dot above (U+0130) maps
518+-- 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
519+-- maps to the sequence Latin small letter i (U+0069) followed by
789−-- dot above (U+0307).
520+-- combining dot above (U+0307).
790toLower :: Text -> Text
521toLower :: Text -> Text
791toLower t = unstream (S.toLower (stream t))
522toLower t = unstream (S.toLower (stream t))
792{-# INLINE toLower #-}
523{-# INLINE toLower #-}
793
524
794-- | /O(n)/ Convert a string to upper case, using simple case
525-- | /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
526+-- conversion. The result string may be longer than the input string.
798−-- instance, the German eszett (U+00DF) maps to the two-letter
527+-- For instance, the German eszett (U+00DF) maps to the two-letter
799-- sequence SS.
528-- sequence SS.
800toUpper :: Text -> Text
529toUpper :: Text -> Text
801toUpper t = unstream (S.toUpper (stream t))
530toUpper t = unstream (S.toUpper (stream t))
802{-# INLINE toUpper #-}
531{-# INLINE toUpper #-}
803
532
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
533-- | /O(n)/ 'foldl', applied to a binary operator, a starting value
828-- (typically the left-identity of the operator), and a 'Text',
534-- (typically the left-identity of the operator), and a 'Text',
829-- reduces the 'Text' using the binary operator, from left to right.
535-- reduces the 'Text' using the binary operator, from left to right.
830−-- Subject to fusion.
536+-- Subject to array fusion.
831−foldl :: (a -> Char -> a) -> a -> Text -> a
537+foldl :: (b -> Char -> b) -> b -> Text -> b
832foldl f z t = S.foldl f z (stream t)
538foldl f z t = S.foldl f z (stream t)
833{-# INLINE foldl #-}
539{-# INLINE foldl #-}
834
540
835-- | /O(n)/ A strict version of 'foldl'.
541-- | /O(n)/ A strict version of 'foldl'.
836−-- Subject to fusion.
542+-- Subject to array fusion.
837−foldl' :: (a -> Char -> a) -> a -> Text -> a
543+foldl' :: (b -> Char -> b) -> b -> Text -> b
838foldl' f z t = S.foldl' f z (stream t)
544foldl' f z t = S.foldl' f z (stream t)
839{-# INLINE foldl' #-}
545{-# INLINE foldl' #-}
840
546
841-- | /O(n)/ A variant of 'foldl' that has no starting value argument,
547-- | /O(n)/ A variant of 'foldl' that has no starting value argument,
842−-- and thus must be applied to a non-empty 'Text'. Subject to fusion.
548+-- and thus must be applied to a non-empty 'Text'. Subject to array
549+-- fusion.
843foldl1 :: (Char -> Char -> Char) -> Text -> Char
550foldl1 :: (Char -> Char -> Char) -> Text -> Char
844foldl1 f t = S.foldl1 f (stream t)
551foldl1 f t = S.foldl1 f (stream t)
845{-# INLINE foldl1 #-}
552{-# INLINE foldl1 #-}
846
553
847−-- | /O(n)/ A strict version of 'foldl1'. Subject to fusion.
554+-- | /O(n)/ A strict version of 'foldl1'.
555+-- Subject to array fusion.
848foldl1' :: (Char -> Char -> Char) -> Text -> Char
556foldl1' :: (Char -> Char -> Char) -> Text -> Char
849foldl1' f t = S.foldl1' f (stream t)
557foldl1' f t = S.foldl1' f (stream t)
850{-# INLINE foldl1' #-}
558{-# INLINE foldl1' #-}
@@ -852,13 +560,13 @@ foldl1' f t = S.foldl1' f (stream t)
852-- | /O(n)/ 'foldr', applied to a binary operator, a starting value
560-- | /O(n)/ 'foldr', applied to a binary operator, a starting value
853-- (typically the right-identity of the operator), and a 'Text',
561-- (typically the right-identity of the operator), and a 'Text',
854-- reduces the 'Text' using the binary operator, from right to left.
562-- reduces the 'Text' using the binary operator, from right to left.
855−-- Subject to fusion.
563+-- Subject to array fusion.
856−foldr :: (Char -> a -> a) -> a -> Text -> a
564+foldr :: (Char -> b -> b) -> b -> Text -> b
857foldr f z t = S.foldr f z (stream t)
565foldr f z t = S.foldr f z (stream t)
858{-# INLINE foldr #-}
566{-# INLINE foldr #-}
859
567
860−-- | /O(n)/ A variant of 'foldr' that has no starting value argument,
568+-- | /O(n)/ A variant of 'foldr' that has no starting value argument, and
861−-- and thus must be applied to a non-empty 'Text'. Subject to
569+-- thust must be applied to a non-empty 'Text'. Subject to array
862-- fusion.
570-- fusion.
863foldr1 :: (Char -> Char -> Char) -> Text -> Char
571foldr1 :: (Char -> Char -> Char) -> Text -> Char
864foldr1 f t = S.foldr1 f (stream t)
572foldr1 f t = S.foldr1 f (stream t)
@@ -881,32 +589,32 @@ concatMap f = concat . foldr ((:) . f) []
881{-# INLINE concatMap #-}
589{-# INLINE concatMap #-}
882
590
883-- | /O(n)/ 'any' @p@ @t@ determines whether any character in the
591-- | /O(n)/ 'any' @p@ @t@ determines whether any character in the
884−-- 'Text' @t@ satisfies the predicate @p@. Subject to fusion.
592+-- 'Text' @t@ satisifes the predicate @p@. Subject to array fusion.
885any :: (Char -> Bool) -> Text -> Bool
593any :: (Char -> Bool) -> Text -> Bool
886any p t = S.any p (stream t)
594any p t = S.any p (stream t)
887{-# INLINE any #-}
595{-# INLINE any #-}
888
596
889-- | /O(n)/ 'all' @p@ @t@ determines whether all characters in the
597-- | /O(n)/ 'all' @p@ @t@ determines whether all characters in the
890−-- 'Text' @t@ satisfy the predicate @p@. Subject to fusion.
598+-- 'Text' @t@ satisify the predicate @p@. Subject to array fusion.
891all :: (Char -> Bool) -> Text -> Bool
599all :: (Char -> Bool) -> Text -> Bool
892all p t = S.all p (stream t)
600all p t = S.all p (stream t)
893{-# INLINE all #-}
601{-# INLINE all #-}
894
602
895-- | /O(n)/ 'maximum' returns the maximum value from a 'Text', which
603-- | /O(n)/ 'maximum' returns the maximum value from a 'Text', which
896−-- must be non-empty. Subject to fusion.
604+-- must be non-empty. Subject to array fusion.
897maximum :: Text -> Char
605maximum :: Text -> Char
898maximum t = S.maximum (stream t)
606maximum t = S.maximum (stream t)
899{-# INLINE maximum #-}
607{-# INLINE maximum #-}
900
608
901-- | /O(n)/ 'minimum' returns the minimum value from a 'Text', which
609-- | /O(n)/ 'minimum' returns the minimum value from a 'Text', which
902−-- must be non-empty. Subject to fusion.
610+-- must be non-empty. Subject to array fusion.
903minimum :: Text -> Char
611minimum :: Text -> Char
904minimum t = S.minimum (stream t)
612minimum t = S.minimum (stream t)
905{-# INLINE minimum #-}
613{-# INLINE minimum #-}
906
614
907-- | /O(n)/ 'scanl' is similar to 'foldl', but returns a list of
615-- | /O(n)/ 'scanl' is similar to 'foldl', but returns a list of
908−-- successive reduced values from the left. Subject to fusion.
616+-- successive reduced values from the left. This function is subject
909−-- Performs replacement on invalid scalar values.
617+-- to array fusion.
910--
618--
911-- > scanl f z [x1, x2, ...] == [z, z `f` x1, (z `f` x1) `f` x2, ...]
619-- > scanl f z [x1, x2, ...] == [z, z `f` x1, (z `f` x1) `f` x2, ...]
912--
620--
@@ -914,13 +622,11 @@ minimum t = S.minimum (stream t)
914--
622--
915-- > last (scanl f z xs) == foldl f z xs.
623-- > last (scanl f z xs) == foldl f z xs.
916scanl :: (Char -> Char -> Char) -> Char -> Text -> Text
624scanl :: (Char -> Char -> Char) -> Char -> Text -> Text
917−scanl f z t = unstream (S.scanl g z (stream t))
625+scanl f z t = unstream (S.scanl f z (stream t))
918− where g a b = safe (f a b)
919{-# INLINE scanl #-}
626{-# INLINE scanl #-}
920
627
921-- | /O(n)/ 'scanl1' is a variant of 'scanl' that has no starting
628-- | /O(n)/ 'scanl1' is a variant of 'scanl' that has no starting
922−-- value argument. Subject to fusion. Performs replacement on
629+-- value argument. This function is subject to array fusion.
923−-- invalid scalar values.
924--
630--
925-- > scanl1 f [x1, x2, ...] == [x1, x1 `f` x2, ...]
631-- > scanl1 f [x1, x2, ...] == [x1, x1 `f` x2, ...]
926scanl1 :: (Char -> Char -> Char) -> Text -> Text
632scanl1 :: (Char -> Char -> Char) -> Text -> Text
@@ -929,83 +635,51 @@ scanl1 f t0 = case uncons t0 of
929 Just (t,ts) -> scanl f t ts
635 Just (t,ts) -> scanl f t ts
930{-# INLINE scanl1 #-}
636{-# INLINE scanl1 #-}
931
637
932−-- | /O(n)/ 'scanr' is the right-to-left dual of 'scanl'. Performs
638+-- | /O(n)/ 'scanr' is the right-to-left dual of 'scanl'.
933−-- replacement on invalid scalar values.
934--
639--
935-- > scanr f v == reverse . scanl (flip f) v . reverse
640-- > scanr f v == reverse . scanl (flip f) v . reverse
936scanr :: (Char -> Char -> Char) -> Char -> Text -> Text
641scanr :: (Char -> Char -> Char) -> Char -> Text -> Text
937−scanr f v = reverse . scanl g v . reverse
642+scanr f v = reverse . scanl (flip f) v . reverse
938− where g a b = safe (f b a)
939
643
940-- | /O(n)/ 'scanr1' is a variant of 'scanr' that has no starting
644-- | /O(n)/ 'scanr1' is a variant of 'scanr' that has no starting
941−-- value argument. Performs replacement on invalid scalar values.
645+-- value argument.
942scanr1 :: (Char -> Char -> Char) -> Text -> Text
646scanr1 :: (Char -> Char -> Char) -> Text -> Text
943scanr1 f t | null t = empty
647scanr1 f t | null t = empty
944 | otherwise = scanr f (last t) (init t)
648 | otherwise = scanr f (last t) (init t)
945
649
946−-- | /O(n)/ Like a combination of 'map' and 'foldl''. Applies a
650+-- | /O(n)/ Like a combination of 'map' and 'foldl'. Applies a
947-- function to each element of a 'Text', passing an accumulating
651-- function to each element of a 'Text', passing an accumulating
948−-- parameter from left to right, and returns a final 'Text'. Performs
652+-- parameter from left to right, and returns a final 'Text'.
949−-- replacement on invalid scalar values.
950mapAccumL :: (a -> Char -> (a,Char)) -> a -> Text -> (a, Text)
653mapAccumL :: (a -> Char -> (a,Char)) -> a -> Text -> (a, Text)
951−mapAccumL f = go
654+mapAccumL f s t = case uncons t of
952− where
655+ Nothing -> (s, empty)
953− go z (Chunk c cs) = (z'', Chunk c' cs')
656+ Just (x, xs) -> (s'', cons y ys)
954− where (z', c') = T.mapAccumL f z c
657+ where (s', y ) = f s x
955− (z'', cs') = go z' cs
658+ (s'',ys) = mapAccumL f s' xs
956− go z Empty = (z, Empty)
957−{-# INLINE mapAccumL #-}
958
659
959-- | The 'mapAccumR' function behaves like a combination of 'map' and
660-- | The 'mapAccumR' function behaves like a combination of 'map' and
960−-- a strict 'foldr'; it applies a function to each element of a
661+-- 'foldr'; it applies a function to each element of a 'Text', passing
961−-- 'Text', passing an accumulating parameter from right to left, and
662+-- an accumulating parameter from right to left, and returning a final
962−-- returning a final value of this accumulator together with the new
663+-- value of this accumulator together with the new 'Text'.
963−-- 'Text'. Performs replacement on invalid scalar values.
964mapAccumR :: (a -> Char -> (a,Char)) -> a -> Text -> (a, Text)
664mapAccumR :: (a -> Char -> (a,Char)) -> a -> Text -> (a, Text)
965−mapAccumR f = go
665+mapAccumR f s t = case uncons t of
966− where
666+ Nothing -> (s, empty)
967− go z (Chunk c cs) = (z'', Chunk c' cs')
667+ Just (x, xs) -> (s'', cons y ys)
968− where (z'', c') = T.mapAccumR f z' c
668+ where (s'',y ) = f s' x
969− (z', cs') = go z cs
970− go z Empty = (z, Empty)
971−{-# INLINE mapAccumR #-}
669+ (s', ys) = mapAccumR f s xs
972−
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
670
979-- | /O(n*m)/ 'replicate' @n@ @t@ is a 'Text' consisting of the input
671-- | /O(n*m)/ 'replicate' @n@ @t@ is a 'Text' consisting of the input
980-- @t@ repeated @n@ times.
672-- @t@ repeated @n@ times.
981replicate :: Int64 -> Text -> Text
673replicate :: Int64 -> Text -> Text
982−replicate n t
674+replicate n t = concat (rep 0)
983− | null t || n <= 0 = empty
984− | isSingleton t = replicateChar n (head t)
985− | otherwise = concat (rep 0)
986− where rep !i | i >= n = []
675+ where rep i | i >= n = []
987− | otherwise = t : rep (i+1)
676+ | otherwise = t : rep (i+1)
988−{-# INLINE [1] replicate #-}
677+{-# 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
678
1005-- | /O(n)/ 'replicateChar' @n@ @c@ is a 'Text' of length @n@ with @c@ the
679-- | /O(n)/ 'replicateChar' @n@ @c@ is a 'Text' of length @n@ with @c@ the
1006-- value of every element. Subject to fusion.
680-- value of every element. Subject to fusion.
1007replicateChar :: Int64 -> Char -> Text
681replicateChar :: Int64 -> Char -> Text
1008−replicateChar n c = unstream (S.replicateCharI n (safe c))
682+replicateChar n c = unstream (S.replicateCharI n c)
1009{-# INLINE replicateChar #-}
683{-# INLINE replicateChar #-}
1010
684
1011{-# RULES
685{-# RULES
@@ -1018,10 +692,9 @@ replicateChar n c = unstream (S.replicateCharI n (safe c))
1018-- 'Text' from a seed value. The function takes the element and
692-- 'Text' from a seed value. The function takes the element and
1019-- returns 'Nothing' if it is done producing the 'Text', otherwise
693-- returns 'Nothing' if it is done producing the 'Text', otherwise
1020-- 'Just' @(a,b)@. In this case, @a@ is the next 'Char' in the
694-- 'Just' @(a,b)@. In this case, @a@ is the next 'Char' in the
1021−-- string, and @b@ is the seed value for further production. Performs
695+-- string, and @b@ is the seed value for further production.
1022−-- replacement on invalid scalar values.
1023−unfoldr :: (a -> Maybe (Char,a)) -> a -> Text
696+unfoldr :: (a -> Maybe (Char,a)) -> a -> Text
1024−unfoldr f s = unstream (S.unfoldr (firstf safe . f) s)
697+unfoldr f s = unstream (S.unfoldr f s)
1025{-# INLINE unfoldr #-}
698{-# INLINE unfoldr #-}
1026
699
1027-- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a 'Text' from a seed
700-- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a 'Text' from a seed
@@ -1029,9 +702,8 @@ unfoldr f s = unstream (S.unfoldr (firstf safe . f) s)
1029-- first argument to 'unfoldrN'. This function is more efficient than
702-- first argument to 'unfoldrN'. This function is more efficient than
1030-- 'unfoldr' when the maximum length of the result is known and
703-- 'unfoldr' when the maximum length of the result is known and
1031-- correct, otherwise its performance is similar to 'unfoldr'.
704-- correct, otherwise its performance is similar to 'unfoldr'.
1032−-- Performs replacement on invalid scalar values.
1033−unfoldrN :: Int64 -> (a -> Maybe (Char,a)) -> a -> Text
705+unfoldrN :: Int64 -> (a -> Maybe (Char,a)) -> a -> Text
1034−unfoldrN n f s = unstream (S.unfoldrN n (firstf safe . f) s)
706+unfoldrN n f s = unstream (S.unfoldrN n f s)
1035{-# INLINE unfoldrN #-}
707{-# INLINE unfoldrN #-}
1036
708
1037-- | /O(n)/ 'take' @n@, applied to a 'Text', returns the prefix of the
709-- | /O(n)/ 'take' @n@, applied to a 'Text', returns the prefix of the
@@ -1055,22 +727,6 @@ take i t0 = take' i t0
1055 unstream (S.take n (stream t)) = take n t
727 unstream (S.take n (stream t)) = take n t
1056 #-}
728 #-}
1057
729
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
730-- | /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@
731-- 'Text' after the first @n@ characters, or the empty 'Text' if @n@
1076-- is greater than the length of the 'Text'. Subject to fusion.
732-- is greater than the length of the 'Text'. Subject to fusion.
@@ -1080,7 +736,7 @@ drop i t0
1080 | otherwise = drop' i t0
736 | otherwise = drop' i t0
1081 where drop' 0 ts = ts
737 where drop' 0 ts = ts
1082 drop' _ Empty = Empty
738 drop' _ Empty = Empty
1083− drop' n (Chunk t ts)
739+ drop' n (Chunk t ts)
1084 | n < len = Chunk (T.drop (fromIntegral n) t) ts
740 | n < len = Chunk (T.drop (fromIntegral n) t) ts
1085 | otherwise = drop' (n - len) ts
741 | otherwise = drop' (n - len) ts
1086 where len = fromIntegral (T.length t)
742 where len = fromIntegral (T.length t)
@@ -1093,23 +749,6 @@ drop i t0
1093 unstream (S.drop n (stream t)) = drop n t
749 unstream (S.drop n (stream t)) = drop n t
1094 #-}
750 #-}
1095
751
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'
752-- | /O(n)/ 'dropWords' @n@ returns the suffix with @n@ 'Word16'
1114-- values dropped, or the empty 'Text' if @n@ is greater than the
753-- values dropped, or the empty 'Text' if @n@ is greater than the
1115-- number of 'Word16' values present.
754-- number of 'Word16' values present.
@@ -1120,14 +759,14 @@ dropWords i t0
1120 where drop' 0 ts = ts
759 where drop' 0 ts = ts
1121 drop' _ Empty = Empty
760 drop' _ Empty = Empty
1122 drop' n (Chunk (T.Text arr off len) ts)
761 drop' n (Chunk (T.Text arr off len) ts)
1123− | n < len' = chunk (text arr (off+n') (len-n')) ts
762+ | n < len' = chunk (textP arr (off+n') (len-n')) ts
1124 | otherwise = drop' (n - len') ts
763 | otherwise = drop' (n - len') ts
1125 where len' = fromIntegral len
764 where len' = fromIntegral len
1126 n' = fromIntegral n
765 n' = fromIntegral n
1127
766
1128−-- | /O(n)/ 'takeWhile', applied to a predicate @p@ and a 'Text',
767+-- | /O(n)/ 'takeWhile', applied to a predicate @p@ and a 'Text', returns
1129−-- returns the longest prefix (possibly empty) of elements that
768+-- the longest prefix (possibly empty) of elements that satisfy @p@.
1130−-- satisfy @p@. Subject to fusion.
769+-- This function is subject to array fusion.
1131takeWhile :: (Char -> Bool) -> Text -> Text
770takeWhile :: (Char -> Bool) -> Text -> Text
1132takeWhile p t0 = takeWhile' t0
771takeWhile p t0 = takeWhile' t0
1133 where takeWhile' Empty = Empty
772 where takeWhile' Empty = Empty
@@ -1144,23 +783,9 @@ takeWhile p t0 = takeWhile' t0
1144"LAZY TEXT takeWhile -> unfused" [1] forall p t.
783"LAZY TEXT takeWhile -> unfused" [1] forall p t.
1145 unstream (S.takeWhile p (stream t)) = takeWhile p t
784 unstream (S.takeWhile p (stream t)) = takeWhile p t
1146 #-}
785 #-}
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
786
1162-- | /O(n)/ 'dropWhile' @p@ @t@ returns the suffix remaining after
787-- | /O(n)/ 'dropWhile' @p@ @t@ returns the suffix remaining after
1163−-- 'takeWhile' @p@ @t@. Subject to fusion.
788+-- 'takeWhile' @p@ @t@. This function is subject to array fusion.
1164dropWhile :: (Char -> Bool) -> Text -> Text
789dropWhile :: (Char -> Bool) -> Text -> Text
1165dropWhile p t0 = dropWhile' t0
790dropWhile p t0 = dropWhile' t0
1166 where dropWhile' Empty = Empty
791 where dropWhile' Empty = Empty
@@ -1176,11 +801,9 @@ dropWhile p t0 = dropWhile' t0
1176"LAZY TEXT dropWhile -> unfused" [1] forall p t.
801"LAZY TEXT dropWhile -> unfused" [1] forall p t.
1177 unstream (S.dropWhile p (stream t)) = dropWhile p t
802 unstream (S.dropWhile p (stream t)) = dropWhile p t
1178 #-}
803 #-}
1179−
1180-- | /O(n)/ 'dropWhileEnd' @p@ @t@ returns the prefix remaining after
804-- | /O(n)/ 'dropWhileEnd' @p@ @t@ returns the prefix remaining after
1181−-- dropping characters that satisfy the predicate @p@ from the end of
805+-- dropping characters that fail the predicate @p@ from the end of
1182-- @t@.
806-- @t@.
1183−--
1184-- Examples:
807-- Examples:
1185--
808--
1186-- > dropWhileEnd (=='.') "foo..." == "foo"
809-- > dropWhileEnd (=='.') "foo..." == "foo"
@@ -1197,7 +820,7 @@ dropWhileEnd p = go
1197{-# INLINE dropWhileEnd #-}
820{-# INLINE dropWhileEnd #-}
1198
821
1199-- | /O(n)/ 'dropAround' @p@ @t@ returns the substring remaining after
822-- | /O(n)/ 'dropAround' @p@ @t@ returns the substring remaining after
1200−-- dropping characters that satisfy the predicate @p@ from both the
823+-- dropping characters that fail the predicate @p@ from both the
1201-- beginning and end of @t@. Subject to fusion.
824-- beginning and end of @t@. Subject to fusion.
1202dropAround :: (Char -> Bool) -> Text -> Text
825dropAround :: (Char -> Bool) -> Text -> Text
1203dropAround p = dropWhile p . dropWhileEnd p
826dropAround p = dropWhile p . dropWhileEnd p
@@ -1247,8 +870,8 @@ splitAtWord _ Empty = empty :*: empty
1247splitAtWord x (Chunk c@(T.Text arr off len) cs)
870splitAtWord x (Chunk c@(T.Text arr off len) cs)
1248 | y >= len = let h :*: t = splitAtWord (x-fromIntegral len) cs
871 | y >= len = let h :*: t = splitAtWord (x-fromIntegral len) cs
1249 in Chunk c h :*: t
872 in Chunk c h :*: t
1250− | otherwise = chunk (text arr off y) empty :*:
873+ | otherwise = chunk (textP arr off y) empty :*:
1251− chunk (text arr (off+y) (len-y)) cs
874+ chunk (textP arr (off+y) (len-y)) cs
1252 where y = fromIntegral x
875 where y = fromIntegral x
1253
876
1254-- | /O(n+m)/ Find the first instance of @needle@ (which must be
877-- | /O(n+m)/ Find the first instance of @needle@ (which must be
@@ -1258,16 +881,16 @@ splitAtWord x (Chunk c@(T.Text arr off len) cs)
1258--
881--
1259-- Examples:
882-- Examples:
1260--
883--
1261−-- > breakOn "::" "a::b::c" ==> ("a", "::b::c")
884+-- > break "::" "a::b::c" ==> ("a", "::b::c")
1262−-- > breakOn "/" "foobar" ==> ("foobar", "")
885+-- > break "/" "foobar" ==> ("foobar", "")
1263--
886--
1264-- Laws:
887-- Laws:
1265--
888--
1266-- > append prefix match == haystack
889-- > append prefix match == haystack
1267−-- > where (prefix, match) = breakOn needle haystack
890+-- > where (prefix, match) = break needle haystack
1268--
891--
1269-- If you need to break a string by a substring repeatedly (e.g. you
892-- 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'
893+-- want to break on every instance of a substring), use 'find'
1271-- instead, as it has lower startup overhead.
894-- instead, as it has lower startup overhead.
1272--
895--
1273-- This function is strict in its first argument, and lazy in its
896-- This function is strict in its first argument, and lazy in its
@@ -1275,25 +898,25 @@ splitAtWord x (Chunk c@(T.Text arr off len) cs)
1275--
898--
1276-- In (unlikely) bad cases, this function's time complexity degrades
899-- In (unlikely) bad cases, this function's time complexity degrades
1277-- towards /O(n*m)/.
900-- towards /O(n*m)/.
1278−breakOn :: Text -> Text -> (Text, Text)
901+break :: Text -> Text -> (Text, Text)
1279−breakOn pat src
902+break pat src
1280− | null pat = emptyError "breakOn"
903+ | null pat = emptyError "break"
1281 | otherwise = case indices pat src of
904 | otherwise = case indices pat src of
1282 [] -> (src, empty)
905 [] -> (src, empty)
1283 (x:_) -> let h :*: t = splitAtWord x src
906 (x:_) -> let h :*: t = splitAtWord x src
1284 in (h, t)
907 in (h, t)
1285
908
1286−-- | /O(n+m)/ Similar to 'breakOn', but searches from the end of the string.
909+-- | /O(n+m)/ Similar to 'break', but searches from the end of the string.
1287--
910--
1288-- The first element of the returned tuple is the prefix of @haystack@
911-- The first element of the returned tuple is the prefix of @haystack@
1289-- up to and including the last match of @needle@. The second is the
912-- up to and including the last match of @needle@. The second is the
1290-- remainder of @haystack@, following the match.
913-- remainder of @haystack@, following the match.
1291--
914--
1292−-- > breakOnEnd "::" "a::b::c" ==> ("a::b::", "c")
915+-- > breakEnd "::" "a::b::c" ==> ("a::b::", "c")
1293−breakOnEnd :: Text -> Text -> (Text, Text)
916+breakEnd :: Text -> Text -> (Text, Text)
1294−breakOnEnd pat src = let (a,b) = breakOn (reverse pat) (reverse src)
917+breakEnd pat src = let (a,b) = break (reverse pat) (reverse src)
1295 in (reverse b, reverse a)
918 in (reverse b, reverse a)
1296−{-# INLINE breakOnEnd #-}
919+{-# INLINE breakEnd #-}
1297
920
1298-- | /O(n+m)/ Find all non-overlapping instances of @needle@ in
921-- | /O(n+m)/ Find all non-overlapping instances of @needle@ in
1299-- @haystack@. Each element of the returned list consists of a pair:
922-- @haystack@. Each element of the returned list consists of a pair:
@@ -1304,9 +927,9 @@ breakOnEnd pat src = let (a,b) = breakOn (reverse pat) (reverse src)
1304--
927--
1305-- Examples:
928-- Examples:
1306--
929--
1307−-- > breakOnAll "::" ""
930+-- > find "::" ""
1308-- > ==> []
931-- > ==> []
1309−-- > breakOnAll "/" "a/b/c/"
932+-- > find "/" "a/b/c/"
1310-- > ==> [("a", "/b/c/"), ("a/b", "/c/"), ("a/b/c", "/")]
933-- > ==> [("a", "/b/c/"), ("a/b", "/c/"), ("a/b/c", "/")]
1311--
934--
1312-- This function is strict in its first argument, and lazy in its
935-- This function is strict in its first argument, and lazy in its
@@ -1316,11 +939,11 @@ breakOnEnd pat src = let (a,b) = breakOn (reverse pat) (reverse src)
1316-- towards /O(n*m)/.
939-- towards /O(n*m)/.
1317--
940--
1318-- The @needle@ parameter may not be empty.
941-- The @needle@ parameter may not be empty.
1319−breakOnAll :: Text -- ^ @needle@ to search for
942+find :: Text -- ^ @needle@ to search for
1320− -> Text -- ^ @haystack@ in which to search
943+ -> Text -- ^ @haystack@ in which to search
1321− -> [(Text, Text)]
944+ -> [(Text, Text)]
1322−breakOnAll pat src
945+find pat src
1323− | null pat = emptyError "breakOnAll"
946+ | null pat = emptyError "find"
1324 | otherwise = go 0 empty src (indices pat src)
947 | otherwise = go 0 empty src (indices pat src)
1325 where
948 where
1326 go !n p s (x:xs) = let h :*: t = splitAtWord (x-n) s
949 go !n p s (x:xs) = let h :*: t = splitAtWord (x-n) s
@@ -1328,10 +951,10 @@ breakOnAll pat src
1328 in (h',t) : go x h' t xs
951 in (h',t) : go x h' t xs
1329 go _ _ _ _ = []
952 go _ _ _ _ = []
1330
953
1331−-- | /O(n)/ 'break' is like 'span', but the prefix returned is over
954+-- | /O(n)/ 'breakBy' is like 'spanBy', but the prefix returned is over
1332-- elements that fail the predicate @p@.
955-- elements that fail the predicate @p@.
1333−break :: (Char -> Bool) -> Text -> (Text, Text)
956+breakBy :: (Char -> Bool) -> Text -> (Text, Text)
1334−break p t0 = break' t0
957+breakBy p t0 = break' t0
1335 where break' Empty = (empty, empty)
958 where break' Empty = (empty, empty)
1336 break' c@(Chunk t ts) =
959 break' c@(Chunk t ts) =
1337 case T.findIndex p t of
960 case T.findIndex p t of
@@ -1341,13 +964,13 @@ break p t0 = break' t0
1341 | otherwise -> let (a,b) = T.splitAt n t
964 | otherwise -> let (a,b) = T.splitAt n t
1342 in (Chunk a Empty, Chunk b ts)
965 in (Chunk a Empty, Chunk b ts)
1343
966
1344−-- | /O(n)/ 'span', applied to a predicate @p@ and text @t@, returns
967+-- | /O(n)/ 'spanBy', applied to a predicate @p@ and text @t@, returns
1345-- a pair whose first element is the longest prefix (possibly empty)
968-- a pair whose first element is the longest prefix (possibly empty)
1346-- of @t@ of elements that satisfy @p@, and whose second is the
969-- of @t@ of elements that satisfy @p@, and whose second is the
1347-- remainder of the list.
970-- remainder of the list.
1348−span :: (Char -> Bool) -> Text -> (Text, Text)
971+spanBy :: (Char -> Bool) -> Text -> (Text, Text)
1349−span p = break (not . p)
972+spanBy p = breakBy (not . p)
1350−{-# INLINE span #-}
973+{-# INLINE spanBy #-}
1351
974
1352-- | The 'group' function takes a 'Text' and returns a list of 'Text's
975-- | The 'group' function takes a 'Text' and returns a list of 'Text's
1353-- such that the concatenation of the result is equal to the argument.
976-- such that the concatenation of the result is equal to the argument.
@@ -1366,7 +989,7 @@ group = groupBy (==)
1366groupBy :: (Char -> Char -> Bool) -> Text -> [Text]
989groupBy :: (Char -> Char -> Bool) -> Text -> [Text]
1367groupBy _ Empty = []
990groupBy _ Empty = []
1368groupBy eq (Chunk t ts) = cons x ys : groupBy eq zs
991groupBy eq (Chunk t ts) = cons x ys : groupBy eq zs
1369− where (ys,zs) = span (eq x) xs
992+ where (ys,zs) = spanBy (eq x) xs
1370 x = T.unsafeHead t
993 x = T.unsafeHead t
1371 xs = chunk (T.unsafeTail t) ts
994 xs = chunk (T.unsafeTail t) ts
1372
995
@@ -1392,49 +1015,43 @@ tails ts@(Chunk t ts')
1392-- copies to create substrings; they just construct new 'Text's that
1015-- copies to create substrings; they just construct new 'Text's that
1393-- are slices of the original.
1016-- are slices of the original.
1394
1017
1395−-- | /O(m+n)/ Break a 'Text' into pieces separated by the first 'Text'
1018+-- | /O(m+n)/ Break a 'Text' into pieces separated by the first
1396−-- argument (which cannot be an empty string), consuming the
1019+-- 'Text' argument, consuming the delimiter. An empty delimiter is
1397−-- delimiter. An empty delimiter is invalid, and will cause an error
1020+-- invalid, and will cause an error to be raised.
1398−-- to be raised.
1399--
1021--
1400-- Examples:
1022-- Examples:
1401--
1023--
1402−-- > splitOn "\r\n" "a\r\nb\r\nd\r\ne" == ["a","b","d","e"]
1024+-- > split "\r\n" "a\r\nb\r\nd\r\ne" == ["a","b","d","e"]
1403−-- > splitOn "aaa" "aaaXaaaXaaaXaaa" == ["","X","X","X",""]
1025+-- > split "aaa" "aaaXaaaXaaaXaaa" == ["","X","X","X",""]
1404−-- > splitOn "x" "x" == ["",""]
1026+-- > split "x" "x" == ["",""]
1405−--
1027+--
1406-- and
1028-- and
1407--
1029--
1408−-- > intercalate s . splitOn s == id
1030+-- > intercalate s . split s == id
1409−-- > splitOn (singleton c) == split (==c)
1031+-- > split (singleton c) == splitBy (==c)
1410−--
1411−-- (Note: the string @s@ to split on above cannot be empty.)
1412--
1032--
1413-- This function is strict in its first argument, and lazy in its
1033-- This function is strict in its first argument, and lazy in its
1414-- second.
1034-- second.
1415--
1035--
1416-- In (unlikely) bad cases, this function's time complexity degrades
1036-- In (unlikely) bad cases, this function's time complexity degrades
1417-- towards /O(n*m)/.
1037-- towards /O(n*m)/.
1418−splitOn :: Text
1038+split :: 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.
1039+ -> Text -- ^ Input text
1423− -> [Text]
1040+ -> [Text]
1424−splitOn pat src
1041+split pat src
1425− | null pat = emptyError "splitOn"
1042+ | null pat = emptyError "split"
1426− | isSingleton pat = split (== head pat) src
1043+ | isSingleton pat = splitBy (== head pat) src
1427 | otherwise = go 0 (indices pat src) src
1044 | otherwise = go 0 (indices pat src) src
1428 where
1045 where
1429 go _ [] cs = [cs]
1046 go _ [] cs = [cs]
1430 go !i (x:xs) cs = let h :*: t = splitAtWord (x-i) cs
1047 go !i (x:xs) cs = let h :*: t = splitAtWord (x-i) cs
1431 in h : go (x+l) xs (dropWords l t)
1048 in h : go (x+l) xs (dropWords l t)
1432 l = foldlChunks (\a (T.Text _ _ b) -> a + fromIntegral b) 0 pat
1049 l = foldlChunks (\a (T.Text _ _ b) -> a + fromIntegral b) 0 pat
1433−{-# INLINE [1] splitOn #-}
1050+{-# INLINE [1] split #-}
1434
1051
1435{-# RULES
1052{-# RULES
1436−"LAZY TEXT splitOn/singleton -> split/==" [~1] forall c t.
1053+"LAZY TEXT split/singleton -> splitBy/==" [~1] forall c t.
1437− splitOn (singleton c) t = split (==c) t
1054+ split (singleton c) t = splitBy (==c) t
1438 #-}
1055 #-}
1439
1056
1440-- | /O(n)/ Splits a 'Text' into components delimited by separators,
1057-- | /O(n)/ Splits a 'Text' into components delimited by separators,
@@ -1442,16 +1059,16 @@ splitOn pat src
1442-- resulting components do not contain the separators. Two adjacent
1059-- resulting components do not contain the separators. Two adjacent
1443-- separators result in an empty component in the output. eg.
1060-- separators result in an empty component in the output. eg.
1444--
1061--
1445−-- > split (=='a') "aabbaca" == ["","","bb","c",""]
1062+-- > splitBy (=='a') "aabbaca" == ["","","bb","c",""]
1446−-- > split (=='a') [] == [""]
1063+-- > splitBy (=='a') [] == [""]
1447−split :: (Char -> Bool) -> Text -> [Text]
1064+splitBy :: (Char -> Bool) -> Text -> [Text]
1448−split _ Empty = [Empty]
1065+splitBy _ Empty = [Empty]
1449−split p (Chunk t0 ts0) = comb [] (T.split p t0) ts0
1066+splitBy p (Chunk t0 ts0) = comb [] (T.splitBy p t0) ts0
1450 where comb acc (s:[]) Empty = revChunks (s:acc) : []
1067 where comb acc (s:[]) Empty = revChunks (s:acc) : []
1451− comb acc (s:[]) (Chunk t ts) = comb (s:acc) (T.split p t) ts
1068+ comb acc (s:[]) (Chunk t ts) = comb (s:acc) (T.splitBy p t) ts
1452 comb acc (s:ss) ts = revChunks (s:acc) : comb [] ss ts
1069 comb acc (s:ss) ts = revChunks (s:acc) : comb [] ss ts
1453− comb _ [] _ = impossibleError "split"
1070+ comb _ [] _ = impossibleError "splitBy"
1454−{-# INLINE split #-}
1071+{-# INLINE splitBy #-}
1455
1072
1456-- | /O(n)/ Splits a 'Text' into components of length @k@. The last
1073-- | /O(n)/ Splits a 'Text' into components of length @k@. The last
1457-- element may be shorter than the other chunks, depending on the
1074-- element may be shorter than the other chunks, depending on the
@@ -1471,14 +1088,14 @@ chunksOf k = go
1471-- newline 'Char's. The resulting strings do not contain newlines.
1088-- newline 'Char's. The resulting strings do not contain newlines.
1472lines :: Text -> [Text]
1089lines :: Text -> [Text]
1473lines Empty = []
1090lines Empty = []
1474−lines t = let (l,t') = break ((==) '\n') t
1091+lines t = let (l,t') = breakBy ((==) '\n') t
1475 in l : if null t' then []
1092 in l : if null t' then []
1476 else lines (tail t')
1093 else lines (tail t')
1477
1094
1478-- | /O(n)/ Breaks a 'Text' up into a list of words, delimited by 'Char's
1095-- | /O(n)/ Breaks a 'Text' up into a list of words, delimited by 'Char's
1479-- representing white space.
1096-- representing white space.
1480words :: Text -> [Text]
1097words :: Text -> [Text]
1481−words = L.filter (not . null) . split isSpace
1098+words = L.filter (not . null) . splitBy isSpace
1482{-# INLINE words #-}
1099{-# INLINE words #-}
1483
1100
1484-- | /O(n)/ Joins lines, after appending a terminating newline to
1101-- | /O(n)/ Joins lines, after appending a terminating newline to
@@ -1493,7 +1110,8 @@ unwords = intercalate (singleton ' ')
1493{-# INLINE unwords #-}
1110{-# INLINE unwords #-}
1494
1111
1495-- | /O(n)/ The 'isPrefixOf' function takes two 'Text's and returns
1112-- | /O(n)/ The 'isPrefixOf' function takes two 'Text's and returns
1496−-- 'True' iff the first is a prefix of the second. Subject to fusion.
1113+-- 'True' iff the first is a prefix of the second. This function is
1114+-- subject to fusion.
1497isPrefixOf :: Text -> Text -> Bool
1115isPrefixOf :: Text -> Text -> Bool
1498isPrefixOf Empty _ = True
1116isPrefixOf Empty _ = True
1499isPrefixOf _ Empty = False
1117isPrefixOf _ Empty = False
@@ -1545,77 +1163,51 @@ isInfixOf needle haystack
1545-------------------------------------------------------------------------------
1163-------------------------------------------------------------------------------
1546-- * View patterns
1164-- * View patterns
1547
1165
1548−-- | /O(n)/ Return the suffix of the second string if its prefix
1166+-- | /O(n)/ Returns the suffix of the second string if its prefix
1549−-- matches the entire first string.
1167+-- matches the first.
1550--
1168--
1551-- Examples:
1169-- Examples:
1552--
1170--
1553−-- > stripPrefix "foo" "foobar" == Just "bar"
1171+-- > prefixed "foo" "foobar" == Just "bar"
1554−-- > stripPrefix "" "baz" == Just "baz"
1555−-- > stripPrefix "foo" "quux" == Nothing
1172+-- > prefixed "foo" "quux" == Nothing
1556--
1173--
1557-- This is particularly useful with the @ViewPatterns@ extension to
1174-- This is particularly useful with the @ViewPatterns@ extension to
1558-- GHC, as follows:
1175-- GHC, as follows:
1559--
1176--
1560-- > {-# LANGUAGE ViewPatterns #-}
1177-- > {-# LANGUAGE ViewPatterns #-}
1561−-- > import Data.Text.Lazy as T
1178+-- > import Data.Text as T
1562-- >
1179-- >
1563-- > fnordLength :: Text -> Int
1180-- > fnordLength :: Text -> Int
1564−-- > fnordLength (stripPrefix "fnord" -> Just suf) = T.length suf
1181+-- > fnordLength (prefixed "fnord" -> Just suf) = T.length suf
1565−-- > fnordLength _ = -1
1182+-- > fnordLength _ = -1
1566−stripPrefix :: Text -> Text -> Maybe Text
1183+prefixed :: Text -> Text -> Maybe Text
1567−stripPrefix p t
1184+-- Yes, this could be much more efficient.
1568− | null p = Just t
1185+prefixed p t
1569− | otherwise = case commonPrefixes p t of
1186+ | p `isPrefixOf` t = Just (drop (length p) t)
1570− Just (_,c,r) | null c -> Just r
1187+ | otherwise = Nothing
1571− _ -> Nothing
1188+
1572−
1573−-- | /O(n)/ Find the longest non-empty common prefix of two strings
1574−-- and return it, along with the suffixes of each string at which they
1575−-- no longer match.
1576−--
1577−-- If the strings do not have a common prefix or either one is empty,
1578−-- this function returns 'Nothing'.
1579−--
1580−-- Examples:
1581−--
1582−-- > commonPrefixes "foobar" "fooquux" == Just ("foo","bar","quux")
1583−-- > commonPrefixes "veeble" "fetzer" == Nothing
1584−-- > commonPrefixes "" "baz" == Nothing
1585−commonPrefixes :: Text -> Text -> Maybe (Text,Text,Text)
1586−commonPrefixes Empty _ = Nothing
1587−commonPrefixes _ Empty = Nothing
1588−commonPrefixes a0 b0 = Just (go a0 b0 [])
1589− where
1590− go t0@(Chunk x xs) t1@(Chunk y ys) ps
1591− = case T.commonPrefixes x y of
1592− Just (p,a,b)
1593− | T.null a -> go xs (chunk b ys) (p:ps)
1594− | T.null b -> go (chunk a xs) ys (p:ps)
1595− | otherwise -> (fromChunks (L.reverse (p:ps)),chunk a xs, chunk b ys)
1596− Nothing -> (fromChunks (L.reverse ps),t0,t1)
1597− go t0 t1 ps = (fromChunks (L.reverse ps),t0,t1)
1598−
1599−-- | /O(n)/ Return the prefix of the second string if its suffix
1189+-- | /O(n)/ Returns the prefix of the second string if its suffix
1600−-- matches the entire first string.
1190+-- matches the first.
1601--
1191--
1602-- Examples:
1192-- Examples:
1603--
1193--
1604−-- > stripSuffix "bar" "foobar" == Just "foo"
1194+-- > suffixed "bar" "foobar" == Just "foo"
1605−-- > stripSuffix "" "baz" == Just "baz"
1606−-- > stripSuffix "foo" "quux" == Nothing
1195+-- > suffixed "foo" "quux" == Nothing
1607--
1196--
1608-- This is particularly useful with the @ViewPatterns@ extension to
1197-- This is particularly useful with the @ViewPatterns@ extension to
1609-- GHC, as follows:
1198-- GHC, as follows:
1610--
1199--
1611-- > {-# LANGUAGE ViewPatterns #-}
1200-- > {-# LANGUAGE ViewPatterns #-}
1612−-- > import Data.Text.Lazy as T
1201+-- > import Data.Text as T
1613-- >
1202-- >
1614-- > quuxLength :: Text -> Int
1203-- > quuxLength :: Text -> Int
1615−-- > quuxLength (stripSuffix "quux" -> Just pre) = T.length pre
1204+-- > quuxLength (suffixed "quux" -> Just pre) = T.length pre
1616−-- > quuxLength _ = -1
1205+-- > quuxLength _ = -1
1617−stripSuffix :: Text -> Text -> Maybe Text
1206+suffixed :: Text -> Text -> Maybe Text
1618−stripSuffix p t = reverse `fmap` stripPrefix (reverse p) (reverse t)
1207+-- Yes, this could be much more efficient.
1208+suffixed p t
1209+ | p `isSuffixOf` t = Just (take (length t - length p) t)
1210+ | otherwise = Nothing
1619
1211
1620-- | /O(n)/ 'filter', applied to a predicate and a 'Text',
1212-- | /O(n)/ 'filter', applied to a predicate and a 'Text',
1621-- returns a 'Text' containing those characters that satisfy the
1213-- returns a 'Text' containing those characters that satisfy the
@@ -1624,21 +1216,21 @@ filter :: (Char -> Bool) -> Text -> Text
1624filter p t = unstream (S.filter p (stream t))
1216filter p t = unstream (S.filter p (stream t))
1625{-# INLINE filter #-}
1217{-# INLINE filter #-}
1626
1218
1627−-- | /O(n)/ The 'find' function takes a predicate and a 'Text', and
1219+-- | /O(n)/ The 'findBy' function takes a predicate and a 'Text', and
1628-- returns the first element in matching the predicate, or 'Nothing'
1220-- returns the first element in matching the predicate, or 'Nothing'
1629-- if there is no such element.
1221-- if there is no such element.
1630−find :: (Char -> Bool) -> Text -> Maybe Char
1222+findBy :: (Char -> Bool) -> Text -> Maybe Char
1631−find p t = S.findBy p (stream t)
1223+findBy p t = S.findBy p (stream t)
1632−{-# INLINE find #-}
1224+{-# INLINE findBy #-}
1633
1225
1634−-- | /O(n)/ The 'partition' function takes a predicate and a 'Text',
1226+-- | /O(n)/ The 'partitionBy' function takes a predicate and a 'Text',
1635-- and returns the pair of 'Text's with elements which do and do not
1227-- and returns the pair of 'Text's with elements which do and do not
1636-- satisfy the predicate, respectively; i.e.
1228-- satisfy the predicate, respectively; i.e.
1637--
1229--
1638−-- > partition p t == (filter p t, filter (not . p) t)
1230+-- > partitionBy p t == (filter p t, filter (not . p) t)
1639−partition :: (Char -> Bool) -> Text -> (Text, Text)
1231+partitionBy :: (Char -> Bool) -> Text -> (Text, Text)
1640−partition p t = (filter p t, filter (not . p) t)
1232+partitionBy p t = (filter p t, filter (not . p) t)
1641−{-# INLINE partition #-}
1233+{-# INLINE partitionBy #-}
1642
1234
1643-- | /O(n)/ 'Text' index (subscript) operator, starting from 0.
1235-- | /O(n)/ 'Text' index (subscript) operator, starting from 0.
1644index :: Text -> Int64 -> Char
1236index :: Text -> Int64 -> Char
@@ -1665,7 +1257,8 @@ count pat src
1665 #-}
1257 #-}
1666
1258
1667-- | /O(n)/ The 'countChar' function returns the number of times the
1259-- | /O(n)/ The 'countChar' function returns the number of times the
1668−-- query element appears in the given 'Text'. Subject to fusion.
1260+-- query element appears in the given 'Text'. This function is subject
1261+-- to fusion.
1669countChar :: Char -> Text -> Int64
1262countChar :: Char -> Text -> Int64
1670countChar c t = S.countChar c (stream t)
1263countChar c t = S.countChar c (stream t)
1671
1264
@@ -1679,10 +1272,8 @@ zip a b = S.unstreamList $ S.zipWith (,) (stream a) (stream b)
1679
1272
1680-- | /O(n)/ 'zipWith' generalises 'zip' by zipping with the function
1273-- | /O(n)/ 'zipWith' generalises 'zip' by zipping with the function
1681-- given as the first argument, instead of a tupling function.
1274-- given as the first argument, instead of a tupling function.
1682−-- Performs replacement on invalid scalar values.
1683zipWith :: (Char -> Char -> Char) -> Text -> Text -> Text
1275zipWith :: (Char -> Char -> Char) -> Text -> Text -> Text
1684−zipWith f t1 t2 = unstream (S.zipWith g (stream t1) (stream t2))
1276+zipWith f t1 t2 = unstream (S.zipWith f (stream t1) (stream t2))
1685− where g a b = safe (f a b)
1686{-# INLINE [0] zipWith #-}
1277{-# INLINE [0] zipWith #-}
1687
1278
1688revChunks :: [T.Text] -> Text
1279revChunks :: [T.Text] -> Text
Data/Text/Lazy/Builder.hs+300−31
@@ -1,42 +1,17 @@
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 : 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
16--
12--
17−-- Efficient construction of lazy @Text@ values. The principal
13+-- Efficient construction of lazy texts.
18−-- operations on a @Builder@ are @singleton@, @fromText@, and
19−-- @fromLazyText@, which construct new builders, and 'mappend', which
20−-- concatenates two builders.
21−--
22−-- To get maximum performance when building lazy @Text@ values using a
23−-- builder, associate @mappend@ calls to the right. For example,
24−-- prefer
25−--
26−-- > singleton 'a' `mappend` (singleton 'b' `mappend` singleton 'c')
27−--
28−-- to
29--
14--
30−-- > singleton 'a' `mappend` singleton 'b' `mappend` singleton 'c'
31−--
32−-- as the latter associates @mappend@ to the left. Or, equivalently,
33−-- prefer
34−--
35−-- > singleton 'a' <> singleton 'b' <> singleton 'c'
36−--
37−-- since the '<>' from recent versions of 'Data.Monoid' associates
38−-- to the right.
39−
40-----------------------------------------------------------------------------
15-----------------------------------------------------------------------------
41
16
42module Data.Text.Lazy.Builder
17module Data.Text.Lazy.Builder
@@ -49,10 +24,304 @@ module Data.Text.Lazy.Builder
49 , singleton
24 , singleton
50 , fromText
25 , fromText
51 , fromLazyText
26 , fromLazyText
52− , fromString
53
27
54 -- * Flushing the buffer state
28 -- * Flushing the buffer state
55 , flush
29 , flush
56 ) where
30 ) where
57
31
32+#if defined(ASSERTS)
33+import Control.Exception (assert)
34+#endif
35+import Control.Monad.ST (ST, runST)
36+import Data.Bits ((.&.))
37+import Data.Char (ord)
38+import Data.Monoid (Monoid(..))
58−import Data.Text.Internal.Builder
39+import Data.Text.Internal (Text(..))
40+import Data.Text.Lazy.Internal (smallChunkSize)
41+import Data.Text.Unsafe (inlineInterleaveST)
42+import Data.Text.UnsafeShift (shiftR)
43+import Prelude hiding (map, putChar)
44+
45+import qualified Data.String as String
46+import qualified Data.Text as S
47+import qualified Data.Text.Array as A
48+import qualified Data.Text.Lazy as L
49+
50+------------------------------------------------------------------------
51+
52+-- | A 'Builder' is an efficient way to build lazy 'L.Text's. There
53+-- are several functions for constructing 'Builder's, but only one to
54+-- inspect them: to extract any data, you have to turn them into lazy
55+-- 'L.Text's using 'toLazyText'.
56+--
57+-- Internally, a 'Builder' constructs a lazy 'L.Text' by filling byte
58+-- arrays piece by piece. As each buffer is filled, it is \'popped\'
59+-- off, to become a new chunk of the resulting lazy 'L.Text'. All
60+-- this is hidden from the user of the 'Builder'.
61+newtype Builder = Builder {
62+ -- Invariant (from Data.Text.Lazy):
63+ -- The lists include no null Texts.
64+ runBuilder :: forall s. (Buffer s -> ST s [S.Text])
65+ -> Buffer s
66+ -> ST s [S.Text]
67+ }
68+
69+instance Monoid Builder where
70+ mempty = empty
71+ {-# INLINE mempty #-}
72+ mappend = append
73+ {-# INLINE mappend #-}
74+
75+instance String.IsString Builder where
76+ fromString = fromString
77+ {-# INLINE fromString #-}
78+
79+instance Show Builder where
80+ show = L.unpack . toLazyText
81+
82+------------------------------------------------------------------------
83+
84+-- | /O(1)./ The empty Builder, satisfying
85+--
86+-- * @'toLazyText' 'empty' = 'L.empty'@
87+--
88+empty :: Builder
89+empty = Builder id
90+{-# INLINE empty #-}
91+
92+-- | /O(1)./ A Builder taking a single character, satisfying
93+--
94+-- * @'toLazyText' ('singleton' c) = 'L.singleton' c@
95+--
96+singleton :: Char -> Builder
97+singleton c = putChar c
98+{-# INLINE singleton #-}
99+
100+------------------------------------------------------------------------
101+
102+-- | /O(1)./ The concatenation of two Builders, an associative
103+-- operation with identity 'empty', satisfying
104+--
105+-- * @'toLazyText' ('append' x y) = 'L.append' ('toLazyText' x) ('toLazyText' y)@
106+--
107+append :: Builder -> Builder -> Builder
108+append (Builder f) (Builder g) = Builder (f . g)
109+{-# INLINE [0] append #-}
110+
111+-- TODO: Experiment to find the right threshold.
112+copyLimit :: Int
113+copyLimit = 128
114+
115+-- This function attempts to merge small Texts instead of treating the
116+-- text as its own chunk. We may not always want this.
117+
118+-- | /O(1)./ A Builder taking a 'S.Text', satisfying
119+--
120+-- * @'toLazyText' ('fromText' t) = 'L.fromChunks' [t]@
121+--
122+fromText :: S.Text -> Builder
123+fromText t@(Text arr off l)
124+ | S.null t = empty
125+ | l <= copyLimit = writeN l $ \marr o -> unsafeCopy arr off marr o l
126+ | otherwise = flush `append` mapBuilder (t :)
127+{-# INLINE [1] fromText #-}
128+
129+{-# RULES
130+"fromText/pack" forall s .
131+ fromText (S.pack s) = fromString s
132+ #-}
133+
134+-- | /O(1)./ A Builder taking a 'String', satisfying
135+--
136+-- * @'toLazyText' ('fromString' s) = 'L.fromChunks' [S.pack s]@
137+--
138+fromString :: String -> Builder
139+fromString str = Builder $ \k (Buffer p0 o0 u0 l0) ->
140+ let loop !marr !o !u !l [] = k (Buffer marr o u l)
141+ loop marr o u l s@(c:cs)
142+ | l <= 1 = do
143+ arr <- A.unsafeFreeze marr
144+ let !t = Text arr o u
145+ marr' <- A.unsafeNew chunkSize
146+ ts <- inlineInterleaveST (loop marr' 0 0 chunkSize s)
147+ return $ t : ts
148+ | otherwise = do
149+ n <- unsafeWrite marr (o+u) c
150+ loop marr o (u+n) (l-n) cs
151+ in loop p0 o0 u0 l0 str
152+ where
153+ chunkSize = smallChunkSize
154+{-# INLINE fromString #-}
155+
156+-- | /O(1)./ A Builder taking a lazy 'L.Text', satisfying
157+--
158+-- * @'toLazyText' ('fromLazyText' t) = t@
159+--
160+fromLazyText :: L.Text -> Builder
161+fromLazyText ts = flush `append` mapBuilder (L.toChunks ts ++)
162+{-# INLINE fromLazyText #-}
163+
164+------------------------------------------------------------------------
165+
166+-- Our internal buffer type
167+data Buffer s = Buffer {-# UNPACK #-} !(A.MArray s)
168+ {-# UNPACK #-} !Int -- offset
169+ {-# UNPACK #-} !Int -- used units
170+ {-# UNPACK #-} !Int -- length left
171+
172+------------------------------------------------------------------------
173+
174+-- | /O(n)./ Extract a lazy 'L.Text' from a 'Builder' with a default
175+-- buffer size. The construction work takes place if and when the
176+-- relevant part of the lazy 'L.Text' is demanded.
177+toLazyText :: Builder -> L.Text
178+toLazyText = toLazyTextWith smallChunkSize
179+
180+-- | /O(n)./ Extract a lazy 'L.Text' from a 'Builder', using the given
181+-- size for the initial buffer. The construction work takes place if
182+-- and when the relevant part of the lazy 'L.Text' is demanded.
183+--
184+-- If the initial buffer is too small to hold all data, subsequent
185+-- buffers will be the default buffer size.
186+toLazyTextWith :: Int -> Builder -> L.Text
187+toLazyTextWith chunkSize m = L.fromChunks . runST $
188+ newBuffer chunkSize >>= runBuilder (m `append` flush) (const (return []))
189+
190+-- | /O(1)./ Pop the 'S.Text' we have constructed so far, if any,
191+-- yielding a new chunk in the result lazy 'L.Text'.
192+flush :: Builder
193+flush = Builder $ \ k buf@(Buffer p o u l) ->
194+ if u == 0
195+ then k buf
196+ else do arr <- A.unsafeFreeze p
197+ let !b = Buffer p (o+u) 0 l
198+ !t = Text arr o u
199+ ts <- inlineInterleaveST (k b)
200+ return $! t : ts
201+
202+------------------------------------------------------------------------
203+
204+-- | Sequence an ST operation on the buffer
205+withBuffer :: (forall s. Buffer s -> ST s (Buffer s)) -> Builder
206+withBuffer f = Builder $ \k buf -> f buf >>= k
207+{-# INLINE withBuffer #-}
208+
209+-- | Get the size of the buffer
210+withSize :: (Int -> Builder) -> Builder
211+withSize f = Builder $ \ k buf@(Buffer _ _ _ l) ->
212+ runBuilder (f l) k buf
213+
214+-- | Map the resulting list of texts.
215+mapBuilder :: ([S.Text] -> [S.Text]) -> Builder
216+mapBuilder f = Builder (fmap f .)
217+
218+------------------------------------------------------------------------
219+
220+putChar :: Char -> Builder
221+putChar c
222+ | n < 0x10000 = writeN 1 $ \marr o -> A.unsafeWrite marr o (fromIntegral n)
223+ | otherwise = writeN 2 $ \marr o -> do
224+ A.unsafeWrite marr o lo
225+ A.unsafeWrite marr (o+1) hi
226+ where n = ord c
227+ m = n - 0x10000
228+ lo = fromIntegral $ (m `shiftR` 10) + 0xD800
229+ hi = fromIntegral $ (m .&. 0x3FF) + 0xDC00
230+{-# INLINE putChar #-}
231+
232+------------------------------------------------------------------------
233+
234+-- | Ensure that there are at least @n@ many elements available.
235+ensureFree :: Int -> Builder
236+ensureFree !n = withSize $ \ l ->
237+ if n <= l
238+ then empty
239+ else flush `append'` withBuffer (const (newBuffer (max n smallChunkSize)))
240+{-# INLINE [0] ensureFree #-}
241+
242+-- | Ensure that @n@ many elements are available, and then use @f@ to
243+-- write some elements into the memory.
244+writeN :: Int -> (forall s. A.MArray s -> Int -> ST s ()) -> Builder
245+writeN n f = ensureFree n `append'` withBuffer (writeNBuffer n f)
246+{-# INLINE [0] writeN #-}
247+
248+writeNBuffer :: Int -> (A.MArray s -> Int -> ST s ()) -> (Buffer s)
249+ -> ST s (Buffer s)
250+writeNBuffer n f (Buffer p o u l) = do
251+ f p (o+u)
252+ return $! Buffer p o (u+n) (l-n)
253+{-# INLINE writeNBuffer #-}
254+
255+newBuffer :: Int -> ST s (Buffer s)
256+newBuffer size = do
257+ arr <- A.unsafeNew size
258+ return $! Buffer arr 0 0 size
259+{-# INLINE newBuffer #-}
260+
261+-- | Unsafely copy the elements of an array.
262+unsafeCopy :: A.Array -> Int -> A.MArray s -> Int -> Int -> ST s ()
263+unsafeCopy src sidx dest didx count =
264+#if defined(ASSERTS)
265+ assert (sidx + count <= A.length src) .
266+ assert (didx + count <= A.length dest) $
267+#endif
268+ copy_loop sidx didx 0
269+ where
270+ copy_loop !i !j !c
271+ | c >= count = return ()
272+ | otherwise = do A.unsafeWrite dest j (A.unsafeIndex src i)
273+ copy_loop (i+1) (j+1) (c+1)
274+{-# INLINE unsafeCopy #-}
275+
276+-- Write a character to the array, starting at the specified offset
277+-- @i@. Returns the number of elements written.
278+unsafeWrite :: A.MArray s -> Int -> Char -> ST s Int
279+unsafeWrite marr i c
280+ | n < 0x10000 = do
281+#if defined(ASSERTS)
282+ assert (i >= 0) . assert (i < A.length marr) $ return ()
283+#endif
284+ A.unsafeWrite marr i (fromIntegral n)
285+ return 1
286+ | otherwise = do
287+#if defined(ASSERTS)
288+ assert (i >= 0) . assert (i < A.length marr - 1) $ return ()
289+#endif
290+ A.unsafeWrite marr i lo
291+ A.unsafeWrite marr (i+1) hi
292+ return 2
293+ where n = ord c
294+ m = n - 0x10000
295+ lo = fromIntegral $ (m `shiftR` 10) + 0xD800
296+ hi = fromIntegral $ (m .&. 0x3FF) + 0xDC00
297+{-# INLINE unsafeWrite #-}
298+
299+------------------------------------------------------------------------
300+-- Some nice rules for Builder
301+
302+-- This function makes GHC understand that 'writeN' and 'ensureFree'
303+-- are *not* recursive in the precense of the rewrite rules below.
304+-- This is not needed with GHC 6.14+.
305+append' :: Builder -> Builder -> Builder
306+append' (Builder f) (Builder g) = Builder (f . g)
307+{-# INLINE append' #-}
308+
309+{-# RULES
310+
311+"append/writeN" forall a b (f::forall s. A.MArray s -> Int -> ST s ())
312+ (g::forall s. A.MArray s -> Int -> ST s ()) ws.
313+ append (writeN a f) (append (writeN b g) ws) =
314+ append (writeN (a+b) (\marr o -> f marr o >> g marr (o+a))) ws
315+
316+"writeN/writeN" forall a b (f::forall s. A.MArray s -> Int -> ST s ())
317+ (g::forall s. A.MArray s -> Int -> ST s ()).
318+ append (writeN a f) (writeN b g) =
319+ writeN (a+b) (\marr o -> f marr o >> g marr (o+a))
320+
321+"ensureFree/ensureFree" forall a b .
322+ append (ensureFree a) (ensureFree b) = ensureFree (max a b)
323+
324+"flush/flush"
325+ append flush flush = flush
326+
327+ #-}
Data/Text/Lazy/Builder/Int.hsdeleted−262
@@ -1,262 +0,0 @@
1−{-# LANGUAGE BangPatterns, CPP, MagicHash, RankNTypes, ScopedTypeVariables,
2− UnboxedTuples #-}
3−#if __GLASGOW_HASKELL__ >= 702
4−{-# LANGUAGE Trustworthy #-}
5−#endif
6−
7−-- Module: Data.Text.Lazy.Builder.Int
8−-- Copyright: (c) 2013 Bryan O'Sullivan
9−-- (c) 2011 MailRank, Inc.
10−-- License: BSD-style
11−-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>
12−-- Stability: experimental
13−-- Portability: portable
14−--
15−-- Efficiently write an integral value to a 'Builder'.
16−
17−module Data.Text.Lazy.Builder.Int
18− (
19− decimal
20− , hexadecimal
21− ) where
22−
23−import Data.Int (Int8, Int16, Int32, Int64)
24−import Data.Monoid (mempty)
25−import qualified Data.ByteString.Unsafe as B
26−import Data.Text.Internal.Builder.Functions ((<>), i2d)
27−import Data.Text.Internal.Builder
28−import Data.Text.Internal.Builder.Int.Digits (digits)
29−import Data.Text.Array
30−import Data.Word (Word, Word8, Word16, Word32, Word64)
31−import GHC.Base (quotInt, remInt)
32−import GHC.Num (quotRemInteger)
33−import GHC.Types (Int(..))
34−import Control.Monad.ST
35−
36−#ifdef __GLASGOW_HASKELL__
37−# if defined(INTEGER_GMP)
38−import GHC.Integer.GMP.Internals (Integer(S#))
39−# elif defined(INTEGER_SIMPLE)
40−import GHC.Integer
41−# else
42−# error "You need to use either GMP or integer-simple."
43−# endif
44−#endif
45−
46−#if defined(INTEGER_GMP) || defined(INTEGER_SIMPLE)
47−# define PAIR(a,b) (# a,b #)
48−#else
49−# define PAIR(a,b) (a,b)
50−#endif
51−
52−decimal :: Integral a => a -> Builder
53−{-# RULES "decimal/Int8" decimal = boundedDecimal :: Int8 -> Builder #-}
54−{-# RULES "decimal/Int" decimal = boundedDecimal :: Int -> Builder #-}
55−{-# RULES "decimal/Int16" decimal = boundedDecimal :: Int16 -> Builder #-}
56−{-# RULES "decimal/Int32" decimal = boundedDecimal :: Int32 -> Builder #-}
57−{-# RULES "decimal/Int64" decimal = boundedDecimal :: Int64 -> Builder #-}
58−{-# RULES "decimal/Word" decimal = positive :: Data.Word.Word -> Builder #-}
59−{-# RULES "decimal/Word8" decimal = positive :: Word8 -> Builder #-}
60−{-# RULES "decimal/Word16" decimal = positive :: Word16 -> Builder #-}
61−{-# RULES "decimal/Word32" decimal = positive :: Word32 -> Builder #-}
62−{-# RULES "decimal/Word64" decimal = positive :: Word64 -> Builder #-}
63−{-# RULES "decimal/Integer" decimal = integer 10 :: Integer -> Builder #-}
64−decimal i = decimal' (<= -128) i
65−{-# NOINLINE decimal #-}
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)
144− big = 10000000000000000000
145− go !k (v :: Word64)
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)
160− fin v n = if v >= n then 1 else 0
161−
162−hexadecimal :: Integral a => a -> Builder
163−{-# SPECIALIZE hexadecimal :: Int -> Builder #-}
164−{-# SPECIALIZE hexadecimal :: Int8 -> Builder #-}
165−{-# SPECIALIZE hexadecimal :: Int16 -> Builder #-}
166−{-# SPECIALIZE hexadecimal :: Int32 -> Builder #-}
167−{-# SPECIALIZE hexadecimal :: Int64 -> Builder #-}
168−{-# SPECIALIZE hexadecimal :: Word -> Builder #-}
169−{-# SPECIALIZE hexadecimal :: Word8 -> Builder #-}
170−{-# SPECIALIZE hexadecimal :: Word16 -> Builder #-}
171−{-# SPECIALIZE hexadecimal :: Word32 -> Builder #-}
172−{-# SPECIALIZE hexadecimal :: Word64 -> Builder #-}
173−{-# RULES "hexadecimal/Integer"
174− hexadecimal = hexInteger :: Integer -> Builder #-}
175−hexadecimal i
176− | i < 0 = error hexErrMsg
177− | otherwise = go i
178− where
179− go n | n < 16 = hexDigit n
180− | 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−
188−hexErrMsg :: String
189−hexErrMsg = "Data.Text.Lazy.Builder.Int.hexadecimal: applied to negative number"
190−
191−hexDigit :: Integral a => a -> Builder
192−hexDigit n
193− | n <= 9 = singleton $! i2d (fromIntegral n)
194− | otherwise = singleton $! toEnum (fromIntegral n + 87)
195−{-# INLINE hexDigit #-}
196−
197−data T = T !Integer !Int
198−
199−integer :: Int -> Integer -> Builder
200−#ifdef INTEGER_GMP
201−integer 10 (S# i#) = decimal (I# i#)
202−integer 16 (S# i#) = hexadecimal (I# i#)
203−#endif
204−integer base i
205− | i < 0 = singleton '-' <> go (-i)
206− | otherwise = go i
207− where
208− go n | n < maxInt = int (fromInteger n)
209− | otherwise = putH (splitf (maxInt * maxInt) n)
210−
211− splitf p n
212− | p > n = [n]
213− | otherwise = splith p (splitf (p*p) n)
214−
215− splith p (n:ns) = case n `quotRemInteger` p of
216− PAIR(q,r) | q > 0 -> q : r : splitb p ns
217− | otherwise -> r : splitb p ns
218− splith _ _ = error "splith: the impossible happened."
219−
220− splitb p (n:ns) = case n `quotRemInteger` p of
221− PAIR(q,r) -> q : r : splitb p ns
222− splitb _ _ = []
223−
224− T maxInt10 maxDigits10 =
225− until ((>mi) . (*10) . fstT) (\(T n d) -> T (n*10) (d+1)) (T 10 1)
226− where mi = fromIntegral (maxBound :: Int)
227− T maxInt16 maxDigits16 =
228− until ((>mi) . (*16) . fstT) (\(T n d) -> T (n*16) (d+1)) (T 16 1)
229− where mi = fromIntegral (maxBound :: Int)
230−
231− fstT (T a _) = a
232−
233− maxInt | base == 10 = maxInt10
234− | otherwise = maxInt16
235− maxDigits | base == 10 = maxDigits10
236− | otherwise = maxDigits16
237−
238− putH (n:ns) = case n `quotRemInteger` maxInt of
239− PAIR(x,y)
240− | q > 0 -> int q <> pblock r <> putB ns
241− | otherwise -> int r <> putB ns
242− where q = fromInteger x
243− r = fromInteger y
244− putH _ = error "putH: the impossible happened"
245−
246− putB (n:ns) = case n `quotRemInteger` maxInt of
247− PAIR(x,y) -> pblock q <> pblock r <> putB ns
248− where q = fromInteger x
249− r = fromInteger y
250− putB _ = Data.Monoid.mempty
251−
252− int :: Int -> Builder
253− int x | base == 10 = decimal x
254− | otherwise = hexadecimal x
255−
256− pblock = loop maxDigits
257− where
258− loop !d !n
259− | d == 1 = hexDigit n
260− | otherwise = loop (d-1) q <> hexDigit r
261− where q = n `quotInt` base
262− r = n `remInt` base
Data/Text/Lazy/Builder/RealFloat.hsdeleted−242
@@ -1,242 +0,0 @@
1−{-# LANGUAGE CPP, OverloadedStrings #-}
2−#if __GLASGOW_HASKELL__ >= 702
3−{-# LANGUAGE Trustworthy #-}
4−#endif
5−
6−-- |
7−-- Module: Data.Text.Lazy.Builder.RealFloat
8−-- Copyright: (c) The University of Glasgow 1994-2002
9−-- License: see libraries/base/LICENSE
10−--
11−-- Write a floating point value to a 'Builder'.
12−
13−module Data.Text.Lazy.Builder.RealFloat
14− (
15− FPFormat(..)
16− , realFloat
17− , formatRealFloat
18− ) where
19−
20−import Data.Array.Base (unsafeAt)
21−import Data.Array.IArray
22−import Data.Text.Internal.Builder.Functions ((<>), i2d)
23−import Data.Text.Lazy.Builder.Int (decimal)
24−import Data.Text.Internal.Builder.RealFloat.Functions (roundTo)
25−import Data.Text.Lazy.Builder
26−import qualified Data.Text as T
27−
28−-- | Control the rendering of floating point numbers.
29−data FPFormat = Exponent
30− -- ^ Scientific notation (e.g. @2.3e123@).
31− | Fixed
32− -- ^ Standard decimal notation.
33− | Generic
34− -- ^ Use decimal notation for values between @0.1@ and
35− -- @9,999,999@, and scientific notation otherwise.
36− deriving (Enum, Read, Show)
37−
38−-- | Show a signed 'RealFloat' value to full precision,
39−-- using standard decimal notation for arguments whose absolute value lies
40−-- between @0.1@ and @9,999,999@, and scientific notation otherwise.
41−realFloat :: (RealFloat a) => a -> Builder
42−{-# SPECIALIZE realFloat :: Float -> Builder #-}
43−{-# SPECIALIZE realFloat :: Double -> Builder #-}
44−realFloat x = formatRealFloat Generic Nothing x
45−
46−formatRealFloat :: (RealFloat a) =>
47− FPFormat
48− -> Maybe Int -- ^ Number of decimal places to render.
49− -> a
50− -> Builder
51−{-# SPECIALIZE formatRealFloat :: FPFormat -> Maybe Int -> Float -> Builder #-}
52−{-# SPECIALIZE formatRealFloat :: FPFormat -> Maybe Int -> Double -> Builder #-}
53−formatRealFloat fmt decs x
54− | isNaN x = "NaN"
55− | isInfinite x = if x < 0 then "-Infinity" else "Infinity"
56− | x < 0 || isNegativeZero x = singleton '-' <> doFmt fmt (floatToDigits (-x))
57− | otherwise = doFmt fmt (floatToDigits x)
58− where
59− doFmt format (is, e) =
60− let ds = map i2d is in
61− case format of
62− Generic ->
63− doFmt (if e < 0 || e > 7 then Exponent else Fixed)
64− (is,e)
65− Exponent ->
66− case decs of
67− Nothing ->
68− let show_e' = decimal (e-1) in
69− case ds of
70− "0" -> "0.0e0"
71− [d] -> singleton d <> ".0e" <> show_e'
72− (d:ds') -> singleton d <> singleton '.' <> fromString ds' <> singleton 'e' <> show_e'
73− [] -> error "formatRealFloat/doFmt/Exponent: []"
74− Just dec ->
75− let dec' = max dec 1 in
76− case is of
77− [0] -> "0." <> fromText (T.replicate dec' "0") <> "e0"
78− _ ->
79− let
80− (ei,is') = roundTo (dec'+1) is
81− (d:ds') = map i2d (if ei > 0 then init is' else is')
82− in
83− singleton d <> singleton '.' <> fromString ds' <> singleton 'e' <> decimal (e-1+ei)
84− Fixed ->
85− let
86− mk0 ls = case ls of { "" -> "0" ; _ -> fromString ls}
87− in
88− case decs of
89− Nothing
90− | e <= 0 -> "0." <> fromText (T.replicate (-e) "0") <> fromString ds
91− | otherwise ->
92− let
93− f 0 s rs = mk0 (reverse s) <> singleton '.' <> mk0 rs
94− f n s "" = f (n-1) ('0':s) ""
95− f n s (r:rs) = f (n-1) (r:s) rs
96− in
97− f e "" ds
98− Just dec ->
99− let dec' = max dec 0 in
100− if e >= 0 then
101− let
102− (ei,is') = roundTo (dec' + e) is
103− (ls,rs) = splitAt (e+ei) (map i2d is')
104− in
105− mk0 ls <> (if null rs then "" else singleton '.' <> fromString rs)
106− else
107− let
108− (ei,is') = roundTo dec' (replicate (-e) 0 ++ is)
109− d:ds' = map i2d (if ei > 0 then is' else 0:is')
110− in
111− singleton d <> (if null ds' then "" else singleton '.' <> fromString ds')
112−
113−
114−-- Based on "Printing Floating-Point Numbers Quickly and Accurately"
115−-- by R.G. Burger and R.K. Dybvig in PLDI 96.
116−-- This version uses a much slower logarithm estimator. It should be improved.
117−
118−-- | 'floatToDigits' takes a base and a non-negative 'RealFloat' number,
119−-- and returns a list of digits and an exponent.
120−-- In particular, if @x>=0@, and
121−--
122−-- > floatToDigits base x = ([d1,d2,...,dn], e)
123−--
124−-- then
125−--
126−-- (1) @n >= 1@
127−--
128−-- (2) @x = 0.d1d2...dn * (base**e)@
129−--
130−-- (3) @0 <= di <= base-1@
131−
132−floatToDigits :: (RealFloat a) => a -> ([Int], Int)
133−{-# SPECIALIZE floatToDigits :: Float -> ([Int], Int) #-}
134−{-# SPECIALIZE floatToDigits :: Double -> ([Int], Int) #-}
135−floatToDigits 0 = ([0], 0)
136−floatToDigits x =
137− let
138− (f0, e0) = decodeFloat x
139− (minExp0, _) = floatRange x
140− p = floatDigits x
141− b = floatRadix x
142− minExp = minExp0 - p -- the real minimum exponent
143− -- Haskell requires that f be adjusted so denormalized numbers
144− -- will have an impossibly low exponent. Adjust for this.
145− (f, e) =
146− let n = minExp - e0 in
147− if n > 0 then (f0 `quot` (expt b n), e0+n) else (f0, e0)
148− (r, s, mUp, mDn) =
149− if e >= 0 then
150− let be = expt b e in
151− if f == expt b (p-1) then
152− (f*be*b*2, 2*b, be*b, be) -- according to Burger and Dybvig
153− else
154− (f*be*2, 2, be, be)
155− else
156− if e > minExp && f == expt b (p-1) then
157− (f*b*2, expt b (-e+1)*2, b, 1)
158− else
159− (f*2, expt b (-e)*2, 1, 1)
160− k :: Int
161− k =
162− let
163− k0 :: Int
164− k0 =
165− if b == 2 then
166− -- logBase 10 2 is very slightly larger than 8651/28738
167− -- (about 5.3558e-10), so if log x >= 0, the approximation
168− -- k1 is too small, hence we add one and need one fixup step less.
169− -- If log x < 0, the approximation errs rather on the high side.
170− -- That is usually more than compensated for by ignoring the
171− -- fractional part of logBase 2 x, but when x is a power of 1/2
172− -- or slightly larger and the exponent is a multiple of the
173− -- denominator of the rational approximation to logBase 10 2,
174− -- k1 is larger than logBase 10 x. If k1 > 1 + logBase 10 x,
175− -- we get a leading zero-digit we don't want.
176− -- With the approximation 3/10, this happened for
177− -- 0.5^1030, 0.5^1040, ..., 0.5^1070 and values close above.
178− -- The approximation 8651/28738 guarantees k1 < 1 + logBase 10 x
179− -- for IEEE-ish floating point types with exponent fields
180− -- <= 17 bits and mantissae of several thousand bits, earlier
181− -- convergents to logBase 10 2 would fail for long double.
182− -- Using quot instead of div is a little faster and requires
183− -- fewer fixup steps for negative lx.
184− let lx = p - 1 + e0
185− k1 = (lx * 8651) `quot` 28738
186− in if lx >= 0 then k1 + 1 else k1
187− else
188− -- f :: Integer, log :: Float -> Float,
189− -- ceiling :: Float -> Int
190− ceiling ((log (fromInteger (f+1) :: Float) +
191− fromIntegral e * log (fromInteger b)) /
192− log 10)
193−--WAS: fromInt e * log (fromInteger b))
194−
195− fixup n =
196− if n >= 0 then
197− if r + mUp <= expt 10 n * s then n else fixup (n+1)
198− else
199− if expt 10 (-n) * (r + mUp) <= s then n else fixup (n+1)
200− in
201− fixup k0
202−
203− gen ds rn sN mUpN mDnN =
204− let
205− (dn, rn') = (rn * 10) `quotRem` sN
206− mUpN' = mUpN * 10
207− mDnN' = mDnN * 10
208− in
209− case (rn' < mDnN', rn' + mUpN' > sN) of
210− (True, False) -> dn : ds
211− (False, True) -> dn+1 : ds
212− (True, True) -> if rn' * 2 < sN then dn : ds else dn+1 : ds
213− (False, False) -> gen (dn:ds) rn' sN mUpN' mDnN'
214−
215− rds =
216− if k >= 0 then
217− gen [] r (s * expt 10 k) mUp mDn
218− else
219− let bk = expt 10 (-k) in
220− gen [] (r * bk) s (mUp * bk) (mDn * bk)
221− in
222− (map fromIntegral (reverse rds), k)
223−
224−-- Exponentiation with a cache for the most common numbers.
225−minExpt, maxExpt :: Int
226−minExpt = 0
227−maxExpt = 1100
228−
229−expt :: Integer -> Int -> Integer
230−expt base n
231− | base == 2 && n >= minExpt && n <= maxExpt = expts `unsafeAt` n
232− | base == 10 && n <= maxExpt10 = expts10 `unsafeAt` n
233− | otherwise = base^n
234−
235−expts :: Array Int Integer
236−expts = array (minExpt,maxExpt) [(n,2^n) | n <- [minExpt .. maxExpt]]
237−
238−maxExpt10 :: Int
239−maxExpt10 = 324
240−
241−expts10 :: Array Int Integer
242−expts10 = array (minExpt,maxExpt10) [(n,10^n) | n <- [minExpt .. maxExpt10]]
Data/Text/Lazy/Encoding.hs+30−215
@@ -1,240 +1,55 @@
1−{-# LANGUAGE BangPatterns,CPP #-}
2−#if __GLASGOW_HASKELL__ >= 702
3−{-# LANGUAGE Trustworthy #-}
4−#endif
5-- |
1-- |
6-- Module : Data.Text.Lazy.Encoding
2-- Module : Data.Text.Lazy.Encoding
7−-- Copyright : (c) 2009, 2010 Bryan O'Sullivan
3+-- Copyright : (c) Bryan O'Sullivan 2009
8--
4--
9-- License : BSD-style
5-- License : BSD-style
10−-- Maintainer : bos@serpentine.com
6+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
7+-- duncan@haskell.org
11-- Stability : experimental
8-- Stability : experimental
12-- Portability : portable
9-- Portability : portable
13--
10--
14-- Functions for converting lazy 'Text' values to and from lazy
11-- Functions for converting lazy 'Text' values to and from lazy
15-- 'ByteString', using several standard encodings.
12-- 'ByteString', using several standard encodings.
16--
13--
17−-- To gain access to a much larger variety of encodings, use the
14+-- To make use of a much larger variety of encodings, use the @text-icu@
18−-- @text-icu@ package: <http://hackage.haskell.org/package/text-icu>
15+-- package.
19
16
20module Data.Text.Lazy.Encoding
17module Data.Text.Lazy.Encoding
21 (
18 (
22 -- * Decoding ByteStrings to Text
19 -- * Decoding ByteStrings to Text
23− -- $strict
20+ -- decodeASCII
24− decodeASCII
25− , decodeLatin1
26− , decodeUtf8
27− , decodeUtf16LE
28− , decodeUtf16BE
29− , decodeUtf32LE
30− , decodeUtf32BE
31−
32− -- ** Catchable failure
33− , decodeUtf8'
21+ decodeUtf8
34−
35− -- ** Controllable error handling
36 , decodeUtf8With
22 , decodeUtf8With
37− , decodeUtf16LEWith
23+ --, decodeUtf16LE
38− , decodeUtf16BEWith
24+ --, decodeUtf16BE
39− , decodeUtf32LEWith
25+ --, decodeUtf32LE
40− , decodeUtf32BEWith
26+ --, decodeUtf32BE
41
27
42 -- * Encoding Text to ByteStrings
28 -- * Encoding Text to ByteStrings
43 , encodeUtf8
29 , encodeUtf8
44− , encodeUtf16LE
30+ --, encodeUtf16LE
45− , encodeUtf16BE
31+ --, encodeUtf16BE
46− , encodeUtf32LE
32+ --, encodeUtf32LE
47− , encodeUtf32BE
33+ --, encodeUtf32BE
48−
49− -- * Encoding Text using ByteString Builders
50− , encodeUtf8Builder
51− , encodeUtf8BuilderEscaped
52 ) where
34 ) where
53
35
54−import Control.Exception (evaluate, try)
36+import Data.ByteString.Lazy (ByteString)
55−import Data.Monoid (Monoid(..))
56−import Data.Text.Encoding.Error (OnDecodeError, UnicodeException, strictDecode)
37+import Data.Text.Encoding.Error (OnDecodeError, strictDecode)
57−import Data.Text.Internal.Lazy (Text(..), chunk, empty, foldrChunks)
38+import Data.Text.Lazy (Text)
58−import Data.Word (Word8)
59−import qualified Data.ByteString as S
39+import qualified Data.Text.Lazy.Fusion as F
60−import qualified Data.ByteString.Builder as B
40+import qualified Data.Text.Lazy.Encoding.Fusion as E
61−import qualified Data.ByteString.Builder.Extra as B (safeStrategy, toLazyByteStringWith)
62−import qualified Data.ByteString.Builder.Prim as BP
63−import qualified Data.ByteString.Lazy as B
64−import qualified Data.ByteString.Lazy.Internal as B
65−import qualified Data.ByteString.Unsafe as B
66−import qualified Data.Text as T
67−import qualified Data.Text.Encoding as TE
68−import qualified Data.Text.Internal.Lazy.Encoding.Fusion as E
69−import qualified Data.Text.Internal.Lazy.Fusion as F
70−import Data.Text.Unsafe (unsafeDupablePerformIO)
71−
72−-- $strict
73−--
74−-- All of the single-parameter functions for decoding bytestrings
75−-- encoded in one of the Unicode Transformation Formats (UTF) operate
76−-- in a /strict/ mode: each will throw an exception if given invalid
77−-- input.
78−--
79−-- Each function has a variant, whose name is suffixed with -'With',
80−-- that gives greater control over the handling of decoding errors.
81−-- For instance, 'decodeUtf8' will throw an exception, but
82−-- 'decodeUtf8With' allows the programmer to determine what to do on a
83−-- decoding error.
84−
85−-- | /Deprecated/. Decode a 'ByteString' containing 7-bit ASCII
86−-- encoded text.
87−decodeASCII :: 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
94
41
95-- | Decode a 'ByteString' containing UTF-8 encoded text.
42-- | Decode a 'ByteString' containing UTF-8 encoded text.
96−decodeUtf8With :: OnDecodeError -> B.ByteString -> Text
43+decodeUtf8With :: OnDecodeError -> ByteString -> Text
97−decodeUtf8With onErr (B.Chunk b0 bs0) =
44+decodeUtf8With onErr bs = F.unstream (E.streamUtf8 onErr bs)
98− case TE.streamDecodeUtf8With onErr b0 of
45+{-# INLINE decodeUtf8With #-}
99− TE.Some t l f -> chunk t (go f l bs0)
100− where
101− go f0 _ (B.Chunk b bs) =
102− case f0 b of
103− TE.Some t l f -> chunk t (go f l bs)
104− go _ l _
105− | S.null l = empty
106− | otherwise = case onErr desc (Just (B.unsafeHead l)) of
107− Nothing -> empty
108− Just c -> Chunk (T.singleton c) Empty
109− desc = "Data.Text.Lazy.Encoding.decodeUtf8With: Invalid UTF-8 stream"
110−decodeUtf8With _ _ = empty
111
46
112−-- | Decode a 'ByteString' containing UTF-8 encoded text that is known
47+-- | Decode a 'ByteString' containing UTF-8 encoded text.
113−-- to be valid.
114−--
115−-- If the input contains any invalid UTF-8 data, an exception will be
116−-- thrown that cannot be caught in pure code. For more control over
117−-- the handling of invalid data, use 'decodeUtf8'' or
118−-- 'decodeUtf8With'.
119−decodeUtf8 :: B.ByteString -> Text
48+decodeUtf8 :: ByteString -> Text
120decodeUtf8 = decodeUtf8With strictDecode
49decodeUtf8 = decodeUtf8With strictDecode
121−{-# INLINE[0] decodeUtf8 #-}
50+{-# INLINE decodeUtf8 #-}
122−
123−-- This rule seems to cause performance loss.
124−{- RULES "LAZY STREAM stream/decodeUtf8' fusion" [1]
125− forall bs. F.stream (decodeUtf8' bs) = E.streamUtf8 strictDecode bs #-}
126−
127−-- | Decode a 'ByteString' containing UTF-8 encoded text..
128−--
129−-- If the input contains any invalid UTF-8 data, the relevant
130−-- exception will be returned, otherwise the decoded text.
131−--
132−-- /Note/: this function is /not/ lazy, as it must decode its entire
133−-- input before it can return a result. If you need lazy (streaming)
134−-- decoding, use 'decodeUtf8With' in lenient mode.
135−decodeUtf8' :: B.ByteString -> Either UnicodeException Text
136−decodeUtf8' bs = unsafeDupablePerformIO $ do
137− let t = decodeUtf8 bs
138− try (evaluate (rnf t `seq` t))
139− where
140− rnf Empty = ()
141− rnf (Chunk _ ts) = rnf ts
142−{-# INLINE decodeUtf8' #-}
143−
144−encodeUtf8 :: Text -> B.ByteString
145−encodeUtf8 Empty = B.empty
146−encodeUtf8 lt@(Chunk t _) =
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−
166−-- | Decode text from little endian UTF-16 encoding.
167−decodeUtf16LEWith :: OnDecodeError -> B.ByteString -> Text
168−decodeUtf16LEWith onErr bs = F.unstream (E.streamUtf16LE onErr bs)
169−{-# INLINE decodeUtf16LEWith #-}
170−
171−-- | Decode text from little endian UTF-16 encoding.
172−--
173−-- If the input contains any invalid little endian UTF-16 data, an
174−-- exception will be thrown. For more control over the handling of
175−-- invalid data, use 'decodeUtf16LEWith'.
176−decodeUtf16LE :: B.ByteString -> Text
177−decodeUtf16LE = decodeUtf16LEWith strictDecode
178−{-# INLINE decodeUtf16LE #-}
179−
180−-- | Decode text from big endian UTF-16 encoding.
181−decodeUtf16BEWith :: OnDecodeError -> B.ByteString -> Text
182−decodeUtf16BEWith onErr bs = F.unstream (E.streamUtf16BE onErr bs)
183−{-# INLINE decodeUtf16BEWith #-}
184−
185−-- | Decode text from big endian UTF-16 encoding.
186−--
187−-- If the input contains any invalid big endian UTF-16 data, an
188−-- exception will be thrown. For more control over the handling of
189−-- invalid data, use 'decodeUtf16BEWith'.
190−decodeUtf16BE :: B.ByteString -> Text
191−decodeUtf16BE = decodeUtf16BEWith strictDecode
192−{-# INLINE decodeUtf16BE #-}
193−
194−-- | Encode text using little endian UTF-16 encoding.
195−encodeUtf16LE :: Text -> B.ByteString
196−encodeUtf16LE txt = B.fromChunks (foldrChunks ((:) . TE.encodeUtf16LE) [] txt)
197−{-# INLINE encodeUtf16LE #-}
198−
199−-- | Encode text using big endian UTF-16 encoding.
200−encodeUtf16BE :: Text -> B.ByteString
201−encodeUtf16BE txt = B.fromChunks (foldrChunks ((:) . TE.encodeUtf16BE) [] txt)
202−{-# INLINE encodeUtf16BE #-}
203−
204−-- | Decode text from little endian UTF-32 encoding.
205−decodeUtf32LEWith :: OnDecodeError -> B.ByteString -> Text
206−decodeUtf32LEWith onErr bs = F.unstream (E.streamUtf32LE onErr bs)
207−{-# INLINE decodeUtf32LEWith #-}
208−
209−-- | Decode text from little endian UTF-32 encoding.
210−--
211−-- If the input contains any invalid little endian UTF-32 data, an
212−-- exception will be thrown. For more control over the handling of
213−-- invalid data, use 'decodeUtf32LEWith'.
214−decodeUtf32LE :: B.ByteString -> Text
215−decodeUtf32LE = decodeUtf32LEWith strictDecode
216−{-# INLINE decodeUtf32LE #-}
217−
218−-- | Decode text from big endian UTF-32 encoding.
219−decodeUtf32BEWith :: OnDecodeError -> B.ByteString -> Text
220−decodeUtf32BEWith onErr bs = F.unstream (E.streamUtf32BE onErr bs)
221−{-# INLINE decodeUtf32BEWith #-}
222−
223−-- | Decode text from big endian UTF-32 encoding.
224−--
225−-- If the input contains any invalid big endian UTF-32 data, an
226−-- exception will be thrown. For more control over the handling of
227−-- invalid data, use 'decodeUtf32BEWith'.
228−decodeUtf32BE :: B.ByteString -> Text
229−decodeUtf32BE = decodeUtf32BEWith strictDecode
230−{-# INLINE decodeUtf32BE #-}
231−
232−-- | Encode text using little endian UTF-32 encoding.
233−encodeUtf32LE :: Text -> B.ByteString
234−encodeUtf32LE txt = B.fromChunks (foldrChunks ((:) . TE.encodeUtf32LE) [] txt)
235−{-# INLINE encodeUtf32LE #-}
236
51
237−-- | Encode text using big endian UTF-32 encoding.
52+-- | Encode text using UTF-8 encoding.
238−encodeUtf32BE :: Text -> B.ByteString
53+encodeUtf8 :: Text -> ByteString
239−encodeUtf32BE txt = B.fromChunks (foldrChunks ((:) . TE.encodeUtf32BE) [] txt)
54+encodeUtf8 txt = E.unstream (E.restreamUtf8 (F.stream txt))
240−{-# INLINE encodeUtf32BE #-}
55+{-# INLINE encodeUtf8 #-}
Data/Text/Lazy/Encoding/Fusion.hsnew file+150
@@ -0,0 +1,150 @@
1+{-# LANGUAGE BangPatterns, CPP, Rank2Types #-}
2+
3+-- |
4+-- Module : Data.Text.Lazy.Encoding.Fusion
5+-- Copyright : (c) Bryan O'Sullivan 2009
6+--
7+-- License : BSD-style
8+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
9+-- duncan@haskell.org
10+-- Stability : experimental
11+-- Portability : portable
12+--
13+-- Fusible 'Stream'-oriented functions for converting between lazy
14+-- 'Text' and several common encodings.
15+
16+module Data.Text.Lazy.Encoding.Fusion
17+ (
18+ -- * Streaming
19+ -- streamASCII
20+ streamUtf8
21+ --, streamUtf16LE
22+ --, streamUtf16BE
23+ --, streamUtf32LE
24+ --, streamUtf32BE
25+
26+ -- * Unstreaming
27+ , unstream
28+
29+ , module Data.Text.Encoding.Fusion.Common
30+ ) where
31+
32+import Data.ByteString.Lazy.Internal (ByteString(..), defaultChunkSize)
33+import qualified Data.ByteString as B
34+import qualified Data.ByteString.Unsafe as B
35+import Data.Text.Encoding.Fusion.Common
36+import Data.Text.Encoding.Error
37+import Data.Text.Fusion (Step(..), Stream(..))
38+import Data.Text.Fusion.Size
39+import Data.Text.UnsafeChar (unsafeChr8)
40+import Data.Word (Word8)
41+import qualified Data.Text.Encoding.Utf8 as U8
42+import System.IO.Unsafe (unsafePerformIO)
43+import Foreign.ForeignPtr (withForeignPtr, ForeignPtr)
44+import Foreign.Storable (pokeByteOff)
45+import Data.ByteString.Internal (mallocByteString, memcpy)
46+#if defined(ASSERTS)
47+import Control.Exception (assert)
48+#endif
49+import qualified Data.ByteString.Internal as B
50+
51+data S = S0
52+ | S1 {-# UNPACK #-} !Word8
53+ | S2 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8
54+ | S3 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8
55+ | S4 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8
56+
57+data T = T {-# UNPACK #-} !ByteString {-# UNPACK #-} !S {-# UNPACK #-} !Int
58+
59+-- | /O(n)/ Convert a lazy 'ByteString' into a 'Stream Char', using
60+-- UTF-8 encoding.
61+streamUtf8 :: OnDecodeError -> ByteString -> Stream Char
62+streamUtf8 onErr bs0 = Stream next (T bs0 S0 0) unknownSize
63+ where
64+ next (T bs@(Chunk ps _) S0 i)
65+ | i < len && U8.validate1 a =
66+ Yield (unsafeChr8 a) (T bs S0 (i+1))
67+ | i + 1 < len && U8.validate2 a b =
68+ Yield (U8.chr2 a b) (T bs S0 (i+2))
69+ | i + 2 < len && U8.validate3 a b c =
70+ Yield (U8.chr3 a b c) (T bs S0 (i+3))
71+ | i + 4 < len && U8.validate4 a b c d =
72+ Yield (U8.chr4 a b c d) (T bs S0 (i+4))
73+ where len = B.length ps
74+ a = B.unsafeIndex ps i
75+ b = B.unsafeIndex ps (i+1)
76+ c = B.unsafeIndex ps (i+2)
77+ d = B.unsafeIndex ps (i+3)
78+ next st@(T bs s i) =
79+ case s of
80+ S1 a | U8.validate1 a -> Yield (unsafeChr8 a) es
81+ S2 a b | U8.validate2 a b -> Yield (U8.chr2 a b) es
82+ S3 a b c | U8.validate3 a b c -> Yield (U8.chr3 a b c) es
83+ S4 a b c d | U8.validate4 a b c d -> Yield (U8.chr4 a b c d) es
84+ _ -> consume st
85+ where es = T bs S0 i
86+ consume (T bs@(Chunk ps rest) s i)
87+ | i >= B.length ps = consume (T rest s 0)
88+ | otherwise =
89+ case s of
90+ S0 -> next (T bs (S1 x) (i+1))
91+ S1 a -> next (T bs (S2 a x) (i+1))
92+ S2 a b -> next (T bs (S3 a b x) (i+1))
93+ S3 a b c -> next (T bs (S4 a b c x) (i+1))
94+ S4 a b c d -> decodeError "streamUtf8" "UTF-8" onErr (Just a)
95+ (T bs (S3 b c d) (i+1))
96+ where x = B.unsafeIndex ps i
97+ consume (T Empty S0 _) = Done
98+ consume st = decodeError "streamUtf8" "UTF-8" onErr Nothing st
99+{-# INLINE [0] streamUtf8 #-}
100+
101+-- | /O(n)/ Convert a 'Stream' 'Word8' to a lazy 'ByteString'.
102+unstreamChunks :: Int -> Stream Word8 -> ByteString
103+unstreamChunks chunkSize (Stream next s0 len0) = chunk s0 (upperBound 4 len0)
104+ where chunk s1 len1 = unsafePerformIO $ do
105+ let len = max 4 (min len1 chunkSize)
106+ mallocByteString len >>= loop len 0 s1
107+ where
108+ loop !n !off !s fp = case next s of
109+ Done | off == 0 -> return Empty
110+ | otherwise -> return $! Chunk (trimUp fp off) Empty
111+ Skip s' -> loop n off s' fp
112+ Yield x s'
113+ | off == chunkSize -> do
114+ let !newLen = n - off
115+ return $! Chunk (trimUp fp off) (chunk s newLen)
116+ | off == n -> realloc fp n off s' x
117+ | otherwise -> do
118+ withForeignPtr fp $ \p -> pokeByteOff p off x
119+ loop n (off+1) s' fp
120+ {-# NOINLINE realloc #-}
121+ realloc fp n off s x = do
122+ let n' = min (n+n) chunkSize
123+ fp' <- copy0 fp n n'
124+ withForeignPtr fp' $ \p -> pokeByteOff p off x
125+ loop n' (off+1) s fp'
126+ trimUp fp off = B.PS fp 0 off
127+ copy0 :: ForeignPtr Word8 -> Int -> Int -> IO (ForeignPtr Word8)
128+ copy0 !src !srcLen !destLen =
129+#if defined(ASSERTS)
130+ assert (srcLen <= destLen) $
131+#endif
132+ do
133+ dest <- mallocByteString destLen
134+ withForeignPtr src $ \src' ->
135+ withForeignPtr dest $ \dest' ->
136+ memcpy dest' src' (fromIntegral srcLen)
137+ return dest
138+
139+-- | /O(n)/ Convert a 'Stream' 'Word8' to a lazy 'ByteString'.
140+unstream :: Stream Word8 -> ByteString
141+unstream = unstreamChunks defaultChunkSize
142+
143+decodeError :: forall s. String -> String -> OnDecodeError -> Maybe Word8
144+ -> s -> Step s Char
145+decodeError func kind onErr mb i =
146+ case onErr desc mb of
147+ Nothing -> Skip i
148+ Just c -> Yield c i
149+ where desc = "Data.Text.Lazy.Encoding.Fusion." ++ func ++ ": Invalid " ++
150+ kind ++ " stream"
Data/Text/Lazy/Fusion.hsnew file+110
@@ -0,0 +1,110 @@
1+-- |
2+-- Module : Data.Text.Lazy.Fusion
3+-- Copyright : (c) Bryan O'Sullivan 2009
4+--
5+-- License : BSD-style
6+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
7+-- duncan@haskell.org
8+-- Stability : experimental
9+-- Portability : GHC
10+--
11+-- Core stream fusion functionality for text.
12+
13+module Data.Text.Lazy.Fusion
14+ (
15+ stream
16+ , unstream
17+ , unstreamChunks
18+ , length
19+ , unfoldrN
20+ , index
21+ , countChar
22+ ) where
23+
24+import Prelude hiding (length)
25+import qualified Data.Text.Fusion.Common as S
26+import Data.Text.Fusion.Internal
27+import Data.Text.Fusion.Size (isEmpty)
28+import Data.Text.Lazy.Internal
29+import qualified Data.Text.Internal as I
30+import qualified Data.Text.Array as A
31+import Data.Text.UnsafeChar (unsafeWrite)
32+import Data.Text.UnsafeShift (shiftL)
33+import Data.Text.Unsafe (iter)
34+import Data.Int (Int64)
35+
36+default(Int64)
37+
38+-- | /O(n)/ Convert a 'Text' into a 'Stream Char'.
39+stream :: Text -> Stream Char
40+stream text = Stream next (text :*: 0) 4 -- random HINT
41+ where
42+ next (Empty :*: _) = Done
43+ next (txt@(Chunk t@(I.Text _ _ len) ts) :*: i)
44+ | i >= len = next (ts :*: 0)
45+ | otherwise = Yield c (txt :*: i+d)
46+ where (c,d) = iter t i
47+{-# INLINE [0] stream #-}
48+
49+-- | /O(n)/ Convert a 'Stream Char' into a 'Text', using the given
50+-- chunk size.
51+unstreamChunks :: Int -> Stream Char -> Text
52+unstreamChunks chunkSize (Stream next s0 len0)
53+ | isEmpty len0 = Empty
54+ | otherwise = outer s0
55+ where
56+ outer s = case next s of
57+ Done -> Empty
58+ Skip s' -> outer s'
59+ Yield x s' -> I.Text arr 0 len `chunk` outer s''
60+ where (arr,(s'',len)) = A.run2 fill
61+ fill = do a <- A.unsafeNew unknownLength
62+ i <- unsafeWrite a 0 x
63+ inner a unknownLength s' i
64+ unknownLength = 4
65+ inner marr len s i
66+ | i + 1 >= chunkSize = return (marr, (s,i))
67+ | i + 1 >= len = do
68+ let newLen = min (len `shiftL` 1) chunkSize
69+ marr' <- A.unsafeNew newLen
70+ A.copy marr marr'
71+ inner marr' newLen s i
72+ | otherwise =
73+ case next s of
74+ Done -> return (marr,(s,i))
75+ Skip s' -> inner marr len s' i
76+ Yield x s' -> unsafeWrite marr i x >>= inner marr len s'
77+{-# INLINE [0] unstreamChunks #-}
78+
79+-- | /O(n)/ Convert a 'Stream Char' into a 'Text', using
80+-- 'defaultChunkSize'.
81+unstream :: Stream Char -> Text
82+unstream = unstreamChunks defaultChunkSize
83+{-# INLINE [0] unstream #-}
84+
85+-- | /O(n)/ Returns the number of characters in a text.
86+length :: Stream Char -> Int64
87+length = S.lengthI
88+{-# INLINE[0] length #-}
89+
90+{-# RULES "LAZY STREAM stream/unstream fusion" forall s.
91+ stream (unstream s) = s #-}
92+
93+-- | /O(n)/ Like 'unfoldr', 'unfoldrN64' builds a stream from a seed
94+-- value. However, the length of the result is limited by the
95+-- first argument to 'unfoldrN64'. This function is more efficient than
96+-- 'unfoldr' when the length of the result is known.
97+unfoldrN :: Int64 -> (a -> Maybe (Char,a)) -> a -> Stream Char
98+unfoldrN n = S.unfoldrNI n
99+{-# INLINE [0] unfoldrN #-}
100+
101+-- | /O(n)/ stream index (subscript) operator, starting from 0.
102+index :: Stream Char -> Int64 -> Char
103+index = S.indexI
104+{-# INLINE [0] index #-}
105+
106+-- | /O(n)/ The 'count' function returns the number of times the query
107+-- element appears in the given stream.
108+countChar :: Char -> Stream Char -> Int64
109+countChar = S.countCharI
110+{-# INLINE [0] countChar #-}
Data/Text/Lazy/IO.hs+28−49
@@ -1,26 +1,17 @@
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) Bryan O'Sullivan 2009,
8−-- (c) 2009 Simon Marlow
5+-- (c) Simon Marlow 2009
9-- License : BSD-style
6-- License : BSD-style
10-- Maintainer : bos@serpentine.com
7-- Maintainer : bos@serpentine.com
11-- Stability : experimental
8-- Stability : experimental
12-- Portability : GHC
9-- Portability : GHC
13--
10--
14-- Efficient locale-sensitive support for lazy text I\/O.
11-- Efficient locale-sensitive support for lazy text I\/O.
15−--
16−-- Skip past the synopsis for some important notes on performance and
17−-- portability across different versions of GHC.
18
12
19module Data.Text.Lazy.IO
13module Data.Text.Lazy.IO
20 (
14 (
21− -- * Performance
22− -- $performance
23−
24 -- * Locale support
15 -- * Locale support
25 -- $locale
16 -- $locale
26 -- * File-at-a-time operations
17 -- * File-at-a-time operations
@@ -41,40 +32,29 @@ module Data.Text.Lazy.IO
41 ) where
32 ) where
42
33
43import Data.Text.Lazy (Text)
34import Data.Text.Lazy (Text)
44−import Prelude hiding (appendFile, getContents, getLine, interact,
35+import Prelude hiding (appendFile, getContents, getLine, interact, putStr,
45− putStr, putStrLn, readFile, writeFile)
36+ putStrLn, readFile, writeFile)
46import System.IO (Handle, IOMode(..), hPutChar, openFile, stdin, stdout,
37import System.IO (Handle, IOMode(..), hPutChar, openFile, stdin, stdout,
47 withFile)
38 withFile)
48import qualified Data.Text.IO as T
39import qualified Data.Text.IO as T
49import qualified Data.Text.Lazy as L
40import qualified Data.Text.Lazy as L
41+#if __GLASGOW_HASKELL__ <= 610
42+import Data.Text.Lazy.Encoding (decodeUtf8)
43+import qualified Data.ByteString.Char8 as S8
44+import qualified Data.ByteString.Lazy.Char8 as L8
45+#else
50−import qualified Control.Exception as E
46+import Control.Exception (throw)
51−import Control.Monad (when)
52import Data.IORef (readIORef)
47import Data.IORef (readIORef)
53−import Data.Text.Internal.IO (hGetLineWith, readChunk)
48+import Data.Text.IO.Internal (hGetLineWith, readChunk)
54−import Data.Text.Internal.Lazy (chunk, empty)
49+import Data.Text.Lazy.Internal (chunk, empty)
55import GHC.IO.Buffer (isEmptyBuffer)
50import GHC.IO.Buffer (isEmptyBuffer)
56import GHC.IO.Exception (IOException(..), IOErrorType(..), ioException)
51import GHC.IO.Exception (IOException(..), IOErrorType(..), ioException)
57import GHC.IO.Handle.Internals (augmentIOError, hClose_help,
52import GHC.IO.Handle.Internals (augmentIOError, hClose_help,
58 wantReadableHandle, withHandle)
53 wantReadableHandle, withHandle)
59import GHC.IO.Handle.Types (Handle__(..), HandleType(..))
54import GHC.IO.Handle.Types (Handle__(..), HandleType(..))
60−import System.IO (BufferMode(..), hGetBuffering, hSetBuffering)
61import System.IO.Error (isEOFError)
55import System.IO.Error (isEOFError)
62import System.IO.Unsafe (unsafeInterleaveIO)
56import System.IO.Unsafe (unsafeInterleaveIO)
63−
57+#endif
64−-- $performance
65−--
66−-- The functions in this module obey the runtime system's locale,
67−-- character set encoding, and line ending conversion settings.
68−--
69−-- If you know in advance that you will be working with data that has
70−-- a specific encoding (e.g. UTF-8), and your application is highly
71−-- performance sensitive, you may find that it is faster to perform
72−-- I\/O with bytestrings and to encode and decode yourself than to use
73−-- the functions in this module.
74−--
75−-- Whether this will hold depends on the version of GHC you are using,
76−-- the platform you are working on, the data you are working with, and
77−-- the encodings you are using, so be sure to test for yourself.
78
58
79-- | Read a file and return its contents as a string. The file is
59-- | Read a file and return its contents as a string. The file is
80-- read lazily, as with 'getContents'.
60-- read lazily, as with 'getContents'.
@@ -93,19 +73,13 @@ appendFile p = withFile p AppendMode . flip hPutStr
93-- | Lazily read the remaining contents of a 'Handle'. The 'Handle'
73-- | Lazily read the remaining contents of a 'Handle'. The 'Handle'
94-- will be closed after the read completes, or on error.
74-- will be closed after the read completes, or on error.
95hGetContents :: Handle -> IO Text
75hGetContents :: Handle -> IO Text
76+#if __GLASGOW_HASKELL__ <= 610
96−hGetContents h = do
77+hGetContents = fmap decodeUtf8 . L8.hGetContents
97− chooseGoodBuffering h
78+#else
79+hGetContents h =
98− wantReadableHandle "hGetContents" h $ \hh -> do
80+ wantReadableHandle "hGetContents" h $ \hh -> do
99− ts <- lazyRead h
81+ ts <- lazyRead h
100− return (hh{haType=SemiClosedHandle}, ts)
82+ return (hh{haType=SemiClosedHandle}, ts)
101−
102−-- | Use a more efficient buffer size if we're reading in
103−-- block-buffered mode with the default buffer size.
104−chooseGoodBuffering :: Handle -> IO ()
105−chooseGoodBuffering h = do
106− bufMode <- hGetBuffering h
107− when (bufMode == BlockBuffering Nothing) $
108− hSetBuffering h (BlockBuffering (Just 16384))
109
83
110lazyRead :: Handle -> IO Text
84lazyRead :: Handle -> IO Text
111lazyRead h = unsafeInterleaveIO $
85lazyRead h = unsafeInterleaveIO $
@@ -113,7 +87,7 @@ lazyRead h = unsafeInterleaveIO $
113 case haType hh of
87 case haType hh of
114 ClosedHandle -> return (hh, L.empty)
88 ClosedHandle -> return (hh, L.empty)
115 SemiClosedHandle -> lazyReadBuffered h hh
89 SemiClosedHandle -> lazyReadBuffered h hh
116− _ -> ioException
90+ _ -> ioException
117 (IOError (Just h) IllegalOperation "hGetContents"
91 (IOError (Just h) IllegalOperation "hGetContents"
118 "illegal handle type" Nothing Nothing)
92 "illegal handle type" Nothing Nothing)
119
93
@@ -122,17 +96,22 @@ lazyReadBuffered h hh@Handle__{..} = do
122 buf <- readIORef haCharBuffer
96 buf <- readIORef haCharBuffer
123 (do t <- readChunk hh buf
97 (do t <- readChunk hh buf
124 ts <- lazyRead h
98 ts <- lazyRead h
125− return (hh, chunk t ts)) `E.catch` \e -> do
99+ return (hh, chunk t ts)) `catch` \e -> do
126 (hh', _) <- hClose_help hh
100 (hh', _) <- hClose_help hh
127 if isEOFError e
101 if isEOFError e
128 then return $ if isEmptyBuffer buf
102 then return $ if isEmptyBuffer buf
129 then (hh', empty)
103 then (hh', empty)
130 else (hh', L.singleton '\r')
104 else (hh', L.singleton '\r')
131− else E.throwIO (augmentIOError e "hGetContents" h)
105+ else throw (augmentIOError e "hGetContents" h)
106+#endif
132
107
133-- | Read a single line from a handle.
108-- | Read a single line from a handle.
134hGetLine :: Handle -> IO Text
109hGetLine :: Handle -> IO Text
110+#if __GLASGOW_HASKELL__ <= 610
111+hGetLine = fmap (decodeUtf8 . L8.fromChunks . (:[])) . S8.hGetLine
112+#else
135hGetLine = hGetLineWith L.fromChunks
113hGetLine = hGetLineWith L.fromChunks
114+#endif
136
115
137-- | Write a string to a handle.
116-- | Write a string to a handle.
138hPutStr :: Handle -> Text -> IO ()
117hPutStr :: Handle -> Text -> IO ()
Data/Text/Lazy/Internal.hs+92−9
@@ -1,20 +1,103 @@
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) 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−-- This module has been renamed to 'Data.Text.Internal.Lazy'. This
12+-- A module containing semi-public 'Text' internals. This exposes the
12−-- name for the module will be removed in the next major release.
13+-- 'Text' representation and low level construction functions.
13−
14+-- Modules which extend the 'Text' system may need to use this module.
15+-- Regular users should not.
14module Data.Text.Lazy.Internal
16module Data.Text.Lazy.Internal
15− {-# DEPRECATED "Use Data.Text.Internal.Lazy instead" #-}
16 (
17 (
17− module Data.Text.Internal.Lazy
18+ Text(..)
19+ , chunk
20+ , empty
21+ , foldrChunks
22+ , foldlChunks
23+ -- * Data type invariant and abstraction functions
24+ , invariant
25+ , checkInvariant
26+ , showStructure
27+ -- * Chunk allocation sizes
28+ , defaultChunkSize
29+ , smallChunkSize
30+ , chunkOverhead
18 ) where
31 ) where
19
32
20−import Data.Text.Internal.Lazy
33+import qualified Data.Text.Internal as T
34+import Data.Text ()
35+import Data.Text.UnsafeShift
36+import Data.Typeable (Typeable)
37+import Foreign.Storable (sizeOf)
38+
39+data Text = Empty
40+ | Chunk {-# UNPACK #-} !T.Text Text
41+ deriving (Typeable)
42+
43+-- | The data type invariant: Every 'Text' is either 'Empty' or
44+-- consists of non-null 'T.Text's. All functions must preserve this,
45+-- and the QC properties must check this.
46+invariant :: Text -> Bool
47+invariant Empty = True
48+invariant (Chunk (T.Text _ _ len) cs) = len > 0 && invariant cs
49+
50+showStructure :: Text -> String
51+showStructure Empty = "Empty"
52+showStructure (Chunk t Empty) = "Chunk " ++ show t ++ " Empty"
53+showStructure (Chunk t ts) =
54+ "Chunk " ++ show t ++ " (" ++ showStructure ts ++ ")"
55+
56+-- | In a form that checks the invariant lazily.
57+checkInvariant :: Text -> Text
58+checkInvariant Empty = Empty
59+checkInvariant (Chunk c@(T.Text _ _ len) cs)
60+ | len > 0 = Chunk c (checkInvariant cs)
61+ | otherwise = error $ "Data.Text.Lazy: invariant violation: "
62+ ++ showStructure (Chunk c cs)
63+
64+-- | Smart constructor for 'Chunk'. Guarantees the data type invariant.
65+chunk :: T.Text -> Text -> Text
66+{-# INLINE chunk #-}
67+chunk t@(T.Text _ _ len) ts | len == 0 = ts
68+ | otherwise = Chunk t ts
69+
70+-- | Smart constructor for 'Empty'.
71+empty :: Text
72+{-# INLINE [0] empty #-}
73+empty = Empty
74+
75+-- | Consume the chunks of a lazy 'Text' with a natural right fold.
76+foldrChunks :: (T.Text -> a -> a) -> a -> Text -> a
77+foldrChunks f z = go
78+ where go Empty = z
79+ go (Chunk c cs) = f c (go cs)
80+{-# INLINE foldrChunks #-}
81+
82+-- | Consume the chunks of a lazy 'Text' with a strict, tail-recursive,
83+-- accumulating left fold.
84+foldlChunks :: (a -> T.Text -> a) -> a -> Text -> a
85+foldlChunks f z = go z
86+ where go !a Empty = a
87+ go !a (Chunk c cs) = go (f a c) cs
88+{-# INLINE foldlChunks #-}
89+
90+-- | Currently set to 32KB, less the memory management overhead.
91+defaultChunkSize :: Int
92+defaultChunkSize = 16384 - chunkOverhead
93+{-# INLINE defaultChunkSize #-}
94+
95+-- | Currently set to 256 bytes, less the memory management overhead.
96+smallChunkSize :: Int
97+smallChunkSize = 128 - chunkOverhead
98+{-# INLINE smallChunkSize #-}
99+
100+-- | The memory management overhead. Currently this is tuned for GHC only.
101+chunkOverhead :: Int
102+chunkOverhead = sizeOf (undefined :: Int) `shiftL` 1
103+{-# INLINE chunkOverhead #-}
Data/Text/Lazy/Read.hsdeleted−193
@@ -1,193 +0,0 @@
1−{-# LANGUAGE OverloadedStrings, CPP #-}
2−#if __GLASGOW_HASKELL__ >= 704
3−{-# LANGUAGE Safe #-}
4−#elif __GLASGOW_HASKELL__ >= 702
5−{-# LANGUAGE Trustworthy #-}
6−#endif
7−
8−-- |
9−-- Module : Data.Text.Lazy.Read
10−-- Copyright : (c) 2010, 2011 Bryan O'Sullivan
11−--
12−-- License : BSD-style
13−-- Maintainer : bos@serpentine.com
14−-- Stability : experimental
15−-- Portability : GHC
16−--
17−-- Functions used frequently when reading textual data.
18−module Data.Text.Lazy.Read
19− (
20− Reader
21− , decimal
22− , hexadecimal
23− , signed
24− , rational
25− , double
26− ) where
27−
28−import Control.Monad (liftM)
29−import Data.Char (isDigit, isHexDigit)
30−import Data.Int (Int8, Int16, Int32, Int64)
31−import Data.Ratio ((%))
32−import Data.Text.Internal.Read
33−import Data.Text.Lazy as T
34−import Data.Word (Word, Word8, Word16, Word32, Word64)
35−
36−-- | Read some text. If the read succeeds, return its value and the
37−-- remaining text, otherwise an error message.
38−type Reader a = IReader Text a
39−type Parser = IParser Text
40−
41−-- | 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
43−-- is reached.
44−--
45−-- This function does not handle leading sign characters. If you need
46−-- to handle signed input, use @'signed' 'decimal'@.
47−--
48−-- /Note/: For fixed-width integer types, this function does not
49−-- attempt to detect overflow, so a sufficiently long input may give
50−-- incorrect results. If you are worried about overflow, use
51−-- 'Integer' for your result type.
52−decimal :: Integral a => Reader a
53−{-# 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 #-}
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 #-}
64−decimal txt
65− | T.null h = Left "input does not start with a digit"
66− | otherwise = Right (T.foldl' go 0 h, t)
67− where (h,t) = T.span isDigit txt
68− go n d = (n * 10 + fromIntegral (digitToInt d))
69−
70−-- | Read a hexadecimal integer, consisting of an optional leading
71−-- @\"0x\"@ followed by at least one decimal digit. Input is consumed
72−-- until a non-hex-digit or end of string is reached. This function
73−-- is case insensitive.
74−--
75−-- This function does not handle leading sign characters. If you need
76−-- to handle signed input, use @'signed' 'hexadecimal'@.
77−--
78−-- /Note/: For fixed-width integer types, this function does not
79−-- attempt to detect overflow, so a sufficiently long input may give
80−-- incorrect results. If you are worried about overflow, use
81−-- 'Integer' for your result type.
82−hexadecimal :: Integral a => Reader a
83−{-# SPECIALIZE hexadecimal :: Reader Int #-}
84−{-# SPECIALIZE hexadecimal :: Reader Integer #-}
85−hexadecimal txt
86− | h == "0x" || h == "0X" = hex t
87− | otherwise = hex txt
88− where (h,t) = T.splitAt 2 txt
89−
90−hex :: Integral a => Reader a
91−{-# SPECIALIZE hexadecimal :: 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 #-}
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 #-}
102−hex txt
103− | T.null h = Left "input does not start with a hexadecimal digit"
104− | otherwise = Right (T.foldl' go 0 h, t)
105− where (h,t) = T.span isHexDigit txt
106− go n d = (n * 16 + fromIntegral (hexDigitToInt d))
107−
108−-- | Read an optional leading sign character (@\'-\'@ or @\'+\'@) and
109−-- apply it to the result of applying the given reader.
110−signed :: Num a => Reader a -> Reader a
111−{-# INLINE signed #-}
112−signed f = runP (signa (P f))
113−
114−-- | Read a rational number.
115−--
116−-- This function accepts an optional leading sign character, followed
117−-- by at least one decimal digit. The syntax similar to that accepted
118−-- by the 'read' function, with the exception that a trailing @\'.\'@
119−-- or @\'e\'@ /not/ followed by a number is not consumed.
120−--
121−-- Examples:
122−--
123−-- >rational "3" == Right (3.0, "")
124−-- >rational "3.1" == Right (3.1, "")
125−-- >rational "3e4" == Right (30000.0, "")
126−-- >rational "3.1e4" == Right (31000.0, "")
127−-- >rational ".3" == Left "input does not start with a digit"
128−-- >rational "e3" == Left "input does not start with a digit"
129−--
130−-- Examples of differences from 'read':
131−--
132−-- >rational "3.foo" == Right (3.0, ".foo")
133−-- >rational "3e" == Right (3.0, "e")
134−rational :: Fractional a => Reader a
135−{-# SPECIALIZE rational :: Reader Double #-}
136−rational = floaty $ \real frac fracDenom -> fromRational $
137− real % 1 + frac % fracDenom
138−
139−-- | Read a rational number.
140−--
141−-- The syntax accepted by this function is the same as for 'rational'.
142−--
143−-- /Note/: This function is almost ten times faster than 'rational',
144−-- but is slightly less accurate.
145−--
146−-- The 'Double' type supports about 16 decimal places of accuracy.
147−-- For 94.2% of numbers, this function and 'rational' give identical
148−-- results, but for the remaining 5.8%, this function loses precision
149−-- around the 15th decimal place. For 0.001% of numbers, this
150−-- function will lose precision at the 13th or 14th decimal place.
151−double :: Reader Double
152−double = floaty $ \real frac fracDenom ->
153− fromIntegral real +
154− fromIntegral frac / fromIntegral fracDenom
155−
156−signa :: Num a => Parser a -> Parser a
157−{-# 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 #-}
163−signa p = do
164− sign <- perhaps '+' $ char (\c -> c == '-' || c == '+')
165− if sign == '+' then p else negate `liftM` p
166−
167−char :: (Char -> Bool) -> Parser Char
168−char p = P $ \t -> case T.uncons t of
169− Just (c,t') | p c -> Right (c,t')
170− _ -> Left "character does not match"
171−
172−floaty :: Fractional a => (Integer -> Integer -> Integer -> a) -> Reader a
173−{-# INLINE floaty #-}
174−floaty f = runP $ do
175− sign <- perhaps '+' $ char (\c -> c == '-' || c == '+')
176− real <- P decimal
177− T fraction fracDigits <- perhaps (T 0 0) $ do
178− _ <- char (=='.')
179− digits <- P $ \t -> Right (fromIntegral . T.length $ T.takeWhile isDigit t, t)
180− n <- P decimal
181− return $ T n digits
182− let e c = c == 'e' || c == 'E'
183− power <- perhaps 0 (char e >> signa (P decimal) :: Parser Int)
184− let n = if fracDigits == 0
185− then if power == 0
186− then fromIntegral real
187− else fromIntegral real * (10 ^^ power)
188− else if power == 0
189− then f real fraction (10 ^ fracDigits)
190− else f real fraction (10 ^ fracDigits) * (10 ^^ power)
191− return $! if sign == '+'
192− then n
193− else -n
Data/Text/Internal/Lazy/Search.hs → Data/Text/Lazy/Search.hsrenamed+15−21
@@ -2,22 +2,19 @@
2
2
3-- |
3-- |
4-- Module : Data.Text.Lazy.Search
4-- Module : Data.Text.Lazy.Search
5−-- Copyright : (c) 2009, 2010 Bryan O'Sullivan
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 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@.
@@ -45,17 +42,15 @@ indices :: Text -- ^ Substring to search for (@needle@)
45indices needle@(Chunk n ns) _haystack@(Chunk k ks)
42indices needle@(Chunk n ns) _haystack@(Chunk k ks)
46 | nlen <= 0 = []
43 | nlen <= 0 = []
47 | nlen == 1 = indicesOne (nindex 0) 0 k ks
44 | nlen == 1 = indicesOne (nindex 0) 0 k ks
48− | otherwise = advance k ks 0 0
45+ | otherwise = scan 0 0 k ks
49 where
46 where
50− advance x@(T.Text _ _ l) xs = scan
47+ scan !g !i x@(T.Text _ _ l) xs
51− where
52− scan !g !i
53 | i >= m = case xs of
48 | i >= m = case xs of
54 Empty -> []
49 Empty -> []
55− Chunk y ys -> advance y ys g (i-m)
50+ Chunk y ys -> scan g (i-m) y ys
56 | lackingHay (i + nlen) x xs = []
51 | lackingHay (i + nlen) x xs = []
57− | c == z && candidateMatch 0 = g : scan (g+nlen) (i+nlen)
52+ | c == z && candidateMatch 0 = g : scan (g+nlen) (i+nlen) x xs
58− | otherwise = scan (g+delta) (i+delta)
53+ | otherwise = scan (g+delta) (i+delta) x xs
59 where
54 where
60 m = fromIntegral l
55 m = fromIntegral l
61 c = hindex (i + nlast)
56 c = hindex (i + nlast)
@@ -80,11 +75,10 @@ indices needle@(Chunk n ns) _haystack@(Chunk k ks)
80 go !(g::Int64) !i !msk !skp
75 go !(g::Int64) !i !msk !skp
81 | i >= xlast = case xs of
76 | i >= xlast = case xs of
82 Empty -> (msk .|. swizzle z) :*: skp
77 Empty -> (msk .|. swizzle z) :*: skp
83− Chunk y ys -> buildTable y ys g 0 msk' skp'
78+ Chunk y ys -> buildTable y ys g 0 msk skp
84− | otherwise = go (g+1) (i+1) msk' skp'
79+ | otherwise = go (g+1) (i+1) (msk .|. swizzle c) skp'
85 where c = A.unsafeIndex xarr (xoff+i)
80 where c = A.unsafeIndex xarr (xoff+i)
86− msk' = msk .|. swizzle c
87− skp' | c == z = nlen - g - 2
81+ skp' | c == z = nlen - fromIntegral g - 2
88 | otherwise = skp
82 | otherwise = skp
89 xlast = xlen - 1
83 xlast = xlen - 1
90 -- | Check whether an attempt to index into the haystack at the
84 -- | Check whether an attempt to index into the haystack at the
Data/Text/Read.hsdeleted−201
@@ -1,201 +0,0 @@
1−{-# LANGUAGE OverloadedStrings, UnboxedTuples, CPP #-}
2−#if __GLASGOW_HASKELL__ >= 702
3−{-# LANGUAGE Trustworthy #-}
4−#endif
5−
6−-- |
7−-- Module : Data.Text.Read
8−-- Copyright : (c) 2010, 2011 Bryan O'Sullivan
9−--
10−-- License : BSD-style
11−-- Maintainer : bos@serpentine.com
12−-- Stability : experimental
13−-- Portability : GHC
14−--
15−-- Functions used frequently when reading textual data.
16−module Data.Text.Read
17− (
18− Reader
19− , decimal
20− , hexadecimal
21− , signed
22− , rational
23− , double
24− ) where
25−
26−import Control.Monad (liftM)
27−import Data.Char (isDigit, isHexDigit)
28−import Data.Int (Int8, Int16, Int32, Int64)
29−import Data.Ratio ((%))
30−import 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−
35−-- | Read some text. If the read succeeds, return its value and the
36−-- remaining text, otherwise an error message.
37−type Reader a = IReader Text a
38−type Parser a = IParser Text a
39−
40−-- | 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
42−-- is reached.
43−--
44−-- This function does not handle leading sign characters. If you need
45−-- to handle signed input, use @'signed' 'decimal'@.
46−--
47−-- /Note/: For fixed-width integer types, this function does not
48−-- attempt to detect overflow, so a sufficiently long input may give
49−-- incorrect results. If you are worried about overflow, use
50−-- 'Integer' for your result type.
51−decimal :: Integral a => Reader a
52−{-# 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 #-}
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 #-}
63−decimal txt
64− | T.null h = Left "input does not start with a digit"
65− | otherwise = Right (T.foldl' go 0 h, t)
66− where (# h,t #) = span_ isDigit txt
67− go n d = (n * 10 + fromIntegral (digitToInt d))
68−
69−-- | Read a hexadecimal integer, consisting of an optional leading
70−-- @\"0x\"@ followed by at least one decimal digit. Input is consumed
71−-- until a non-hex-digit or end of string is reached. This function
72−-- is case insensitive.
73−--
74−-- This function does not handle leading sign characters. If you need
75−-- to handle signed input, use @'signed' 'hexadecimal'@.
76−--
77−-- /Note/: For fixed-width integer types, this function does not
78−-- attempt to detect overflow, so a sufficiently long input may give
79−-- incorrect results. If you are worried about overflow, use
80−-- 'Integer' for your result type.
81−hexadecimal :: Integral a => Reader a
82−{-# 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 #-}
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 #-}
93−hexadecimal txt
94− | h == "0x" || h == "0X" = hex t
95− | otherwise = hex txt
96− where (h,t) = T.splitAt 2 txt
97−
98−hex :: Integral a => Reader a
99−{-# 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 #-}
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 #-}
110−hex txt
111− | T.null h = Left "input does not start with a hexadecimal digit"
112− | otherwise = Right (T.foldl' go 0 h, t)
113− where (# h,t #) = span_ isHexDigit txt
114− go n d = (n * 16 + fromIntegral (hexDigitToInt d))
115−
116−-- | Read an optional leading sign character (@\'-\'@ or @\'+\'@) and
117−-- apply it to the result of applying the given reader.
118−signed :: Num a => Reader a -> Reader a
119−{-# INLINE signed #-}
120−signed f = runP (signa (P f))
121−
122−-- | Read a rational number.
123−--
124−-- This function accepts an optional leading sign character, followed
125−-- by at least one decimal digit. The syntax similar to that accepted
126−-- by the 'read' function, with the exception that a trailing @\'.\'@
127−-- or @\'e\'@ /not/ followed by a number is not consumed.
128−--
129−-- Examples (with behaviour identical to 'read'):
130−--
131−-- >rational "3" == Right (3.0, "")
132−-- >rational "3.1" == Right (3.1, "")
133−-- >rational "3e4" == Right (30000.0, "")
134−-- >rational "3.1e4" == Right (31000.0, "")
135−-- >rational ".3" == Left "input does not start with a digit"
136−-- >rational "e3" == Left "input does not start with a digit"
137−--
138−-- Examples of differences from 'read':
139−--
140−-- >rational "3.foo" == Right (3.0, ".foo")
141−-- >rational "3e" == Right (3.0, "e")
142−rational :: Fractional a => Reader a
143−{-# SPECIALIZE rational :: Reader Double #-}
144−rational = floaty $ \real frac fracDenom -> fromRational $
145− real % 1 + frac % fracDenom
146−
147−-- | Read a rational number.
148−--
149−-- The syntax accepted by this function is the same as for 'rational'.
150−--
151−-- /Note/: This function is almost ten times faster than 'rational',
152−-- but is slightly less accurate.
153−--
154−-- The 'Double' type supports about 16 decimal places of accuracy.
155−-- For 94.2% of numbers, this function and 'rational' give identical
156−-- results, but for the remaining 5.8%, this function loses precision
157−-- around the 15th decimal place. For 0.001% of numbers, this
158−-- function will lose precision at the 13th or 14th decimal place.
159−double :: Reader Double
160−double = floaty $ \real frac fracDenom ->
161− fromIntegral real +
162− fromIntegral frac / fromIntegral fracDenom
163−
164−signa :: Num a => Parser a -> Parser a
165−{-# 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 #-}
171−signa p = do
172− sign <- perhaps '+' $ char (\c -> c == '-' || c == '+')
173− if sign == '+' then p else negate `liftM` p
174−
175−char :: (Char -> Bool) -> Parser Char
176−char p = P $ \t -> case T.uncons t of
177− Just (c,t') | p c -> Right (c,t')
178− _ -> Left "character does not match"
179−
180−floaty :: Fractional a => (Integer -> Integer -> Integer -> a) -> Reader a
181−{-# INLINE floaty #-}
182−floaty f = runP $ do
183− sign <- perhaps '+' $ char (\c -> c == '-' || c == '+')
184− real <- P decimal
185− T fraction fracDigits <- perhaps (T 0 0) $ do
186− _ <- char (=='.')
187− digits <- P $ \t -> Right (T.length $ T.takeWhile isDigit t, t)
188− n <- P decimal
189− return $ T n digits
190− let e c = c == 'e' || c == 'E'
191− power <- perhaps 0 (char e >> signa (P decimal) :: Parser Int)
192− let n = if fracDigits == 0
193− then if power == 0
194− then fromIntegral real
195− else fromIntegral real * (10 ^^ power)
196− else if power == 0
197− then f real fraction (10 ^ fracDigits)
198− else f real fraction (10 ^ fracDigits) * (10 ^^ power)
199− return $! if sign == '+'
200− then n
201− else -n
Data/Text/Internal/Search.hs → Data/Text/Search.hsrenamed+11−14
@@ -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)/.
@@ -59,10 +58,9 @@ indices _needle@(Text narr noff nlen) _haystack@(Text harr hoff hlen)
59 z = nindex nlast
58 z = nindex nlast
60 nindex k = A.unsafeIndex narr (noff+k)
59 nindex k = A.unsafeIndex narr (noff+k)
61 hindex k = A.unsafeIndex harr (hoff+k)
60 hindex k = A.unsafeIndex harr (hoff+k)
62− hindex' k | k == hlen = 0
61+ (mask :: Word64) :*: skip = buildTable 0 0 (nlen-2)
63− | otherwise = A.unsafeIndex harr (hoff+k)
64 buildTable !i !msk !skp
62 buildTable !i !msk !skp
65− | i >= nlast = (msk .|. swizzle z) :* skp
63+ | i >= nlast = (msk .|. swizzle z) :*: skp
66 | otherwise = buildTable (i+1) (msk .|. swizzle c) skp'
64 | otherwise = buildTable (i+1) (msk .|. swizzle c) skp'
67 where c = nindex i
65 where c = nindex i
68 skp' | c == z = nlen - i - 2
66 skp' | c == z = nlen - i - 2
@@ -80,8 +78,7 @@ indices _needle@(Text narr noff nlen) _haystack@(Text harr hoff hlen)
80 delta | nextInPattern = nlen + 1
78 delta | nextInPattern = nlen + 1
81 | c == z = skip + 1
79 | c == z = skip + 1
82 | otherwise = 1
80 | otherwise = 1
83− where nextInPattern = mask .&. swizzle (hindex' (i+nlen)) == 0
81+ nextInPattern = mask .&. swizzle (hindex (i+nlen)) == 0
84− !(mask :* skip) = buildTable 0 0 (nlen-2)
85 scanOne c = loop 0
82 scanOne c = loop 0
86 where loop !i | i >= hlen = []
83 where loop !i | i >= hlen = []
87 | hindex i == c = i : loop (i+1)
84 | 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+44−44
@@ -1,9 +1,10 @@
1{-# LANGUAGE CPP, MagicHash, UnboxedTuples #-}
1{-# LANGUAGE CPP, MagicHash, UnboxedTuples #-}
2-- |
2-- |
3-- Module : Data.Text.Unsafe
3-- Module : Data.Text.Unsafe
4−-- Copyright : (c) 2009, 2010, 2011 Bryan O'Sullivan
4+-- Copyright : (c) Bryan O'Sullivan 2009
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,29 @@ module Data.Text.Unsafe
13 (
14 (
14 inlineInterleaveST
15 inlineInterleaveST
15 , inlinePerformIO
16 , inlinePerformIO
16− , unsafeDupablePerformIO
17− , Iter(..)
18 , iter
17 , iter
19 , iter_
18 , iter_
20 , reverseIter
19 , reverseIter
21− , reverseIter_
22 , unsafeHead
20 , unsafeHead
23 , unsafeTail
21 , unsafeTail
24− , lengthWord16
25− , takeWord16
26− , dropWord16
27 ) where
22 ) where
28−
23+
29#if defined(ASSERTS)
24#if defined(ASSERTS)
30import Control.Exception (assert)
25import Control.Exception (assert)
31#endif
26#endif
32−import Data.Text.Internal.Encoding.Utf16 (chr2)
27+import Data.Text.Encoding.Utf16 (chr2)
33import Data.Text.Internal (Text(..))
28import Data.Text.Internal (Text(..))
34−import Data.Text.Internal.Unsafe (inlineInterleaveST, inlinePerformIO)
29+import Data.Text.UnsafeChar (unsafeChr)
35−import Data.Text.Internal.Unsafe.Char (unsafeChr)
30+import GHC.ST (ST(..))
36import qualified Data.Text.Array as A
31import qualified Data.Text.Array as A
32+#if defined(__GLASGOW_HASKELL__)
33+# if __GLASGOW_HASKELL__ >= 611
34+import GHC.IO (IO(IO))
35+# else
37−import GHC.IO (unsafeDupablePerformIO)
36+import GHC.IOBase (IO(IO))
37+# endif
38+import GHC.Base (realWorld#)
39+#endif
38
40
39-- | /O(1)/ A variant of 'head' for non-empty 'Text'. 'unsafeHead'
41-- | /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
42-- omits the check for the empty case, so there is an obligation on
@@ -47,7 +49,7 @@ unsafeHead (Text arr off _len)
47 n = A.unsafeIndex arr (off+1)
49 n = A.unsafeIndex arr (off+1)
48{-# INLINE unsafeHead #-}
50{-# INLINE unsafeHead #-}
49
51
50−-- | /O(1)/ A variant of 'tail' for non-empty 'Text'. 'unsafeTail'
52+-- | /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
53-- 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.
54-- the programmer to provide a proof that the 'Text' is non-empty.
53unsafeTail :: Text -> Text
55unsafeTail :: Text -> Text
@@ -59,15 +61,13 @@ unsafeTail t@(Text arr off len) =
59 where d = iter_ t 0
61 where d = iter_ t 0
60{-# INLINE unsafeTail #-}
62{-# INLINE unsafeTail #-}
61
63
62−data Iter = Iter {-# UNPACK #-} !Char {-# UNPACK #-} !Int
63−
64-- | /O(1)/ Iterate (unsafely) one step forwards through a UTF-16
64-- | /O(1)/ Iterate (unsafely) one step forwards through a UTF-16
65-- array, returning the current character and the delta to add to give
65-- array, returning the current character and the delta to add to give
66-- the next offset to iterate at.
66-- the next offset to iterate at.
67−iter :: Text -> Int -> Iter
67+iter :: Text -> Int -> (Char,Int)
68iter (Text arr off _len) i
68iter (Text arr off _len) i
69− | m < 0xD800 || m > 0xDBFF = Iter (unsafeChr m) 1
69+ | m < 0xD800 || m > 0xDBFF = (unsafeChr m, 1)
70− | otherwise = Iter (chr2 m n) 2
70+ | otherwise = (chr2 m n, 2)
71 where m = A.unsafeIndex arr j
71 where m = A.unsafeIndex arr j
72 n = A.unsafeIndex arr k
72 n = A.unsafeIndex arr k
73 j = off + i
73 j = off + i
@@ -95,29 +95,29 @@ reverseIter (Text arr off _len) i
95 k = j - 1
95 k = j - 1
96{-# INLINE reverseIter #-}
96{-# INLINE reverseIter #-}
97
97
98−-- | /O(1)/ Iterate one step backwards through a UTF-16 array,
98+-- | Just like unsafePerformIO, but we inline it. Big performance gains as
99−-- returning the delta to add (i.e. a negative number) to give the
99+-- it exposes lots of things to further inlining. /Very unsafe/. In
100−-- next offset to iterate at.
100+-- particular, you should do no memory allocation inside an
101−reverseIter_ :: Text -> Int -> Int
101+-- 'inlinePerformIO' block. On Hugs this is just @unsafePerformIO@.
102−reverseIter_ (Text arr off _len) i
102+--
103− | m < 0xDC00 || m > 0xDFFF = -1
103+{-# INLINE inlinePerformIO #-}
104− | otherwise = -2
104+inlinePerformIO :: IO a -> a
105− where m = A.unsafeIndex arr (off+i)
105+#if defined(__GLASGOW_HASKELL__)
106−{-# INLINE reverseIter_ #-}
106+inlinePerformIO (IO m) = case m realWorld# of (# _, r #) -> r
107−
107+#else
108−-- | /O(1)/ Return the length of a 'Text' in units of 'Word16'. This
108+inlinePerformIO = unsafePerformIO
109−-- is useful for sizing a target array appropriately before using
109+#endif
110−-- 'unsafeCopyToPtr'.
111−lengthWord16 :: Text -> Int
112−lengthWord16 (Text _arr _off len) = len
113−{-# INLINE lengthWord16 #-}
114−
115−-- | /O(1)/ Unchecked take of 'k' 'Word16's from the front of a 'Text'.
116−takeWord16 :: Int -> Text -> Text
117−takeWord16 k (Text arr off _len) = Text arr off k
118−{-# INLINE takeWord16 #-}
119
110
120−-- | /O(1)/ Unchecked drop of 'k' 'Word16's from the front of a 'Text'.
111+-- | Allow an 'ST' computation to be deferred lazily. When passed an
121−dropWord16 :: Int -> Text -> Text
112+-- action of type 'ST' @s@ @a@, the action will only be performed when
122−dropWord16 k (Text arr off len) = Text arr (off+k) (len-k)
113+-- the value of @a@ is demanded.
123−{-# INLINE dropWord16 #-}
114+--
115+-- This function is identical to the normal unsafeInterleaveST, but is
116+-- inlined and hence faster.
117+--
118+-- /Note/: This operation is highly unsafe, as it can introduce
119+-- externally visible non-determinism into an 'ST' action.
120+inlineInterleaveST :: ST s a -> ST s a
121+inlineInterleaveST (ST m) = ST $ \ s ->
122+ let r = case m s of (# _, res #) -> res in (# s, r #)
123+{-# INLINE inlineInterleaveST #-}
Data/Text/Internal/Unsafe/Char.hs → Data/Text/UnsafeChar.hsrenamed+10−15
@@ -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) Tom Harper 2008-2009,
6−-- (c) 2009, 2010 Bryan O'Sullivan,
6+-- (c) Bryan O'Sullivan 2009,
7−-- (c) 2009 Duncan Coutts
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-- 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
@@ -52,8 +49,6 @@ unsafeChr32 :: Word32 -> Char
52unsafeChr32 (W32# w#) = C# (chr# (word2Int# w#))
49unsafeChr32 (W32# w#) = C# (chr# (word2Int# w#))
53{-# INLINE unsafeChr32 #-}
50{-# INLINE unsafeChr32 #-}
54
51
55−-- | Write a character into the array at the given offset. Returns
56−-- the number of 'Word16's written.
57unsafeWrite :: A.MArray s -> Int -> Char -> ST s Int
52unsafeWrite :: A.MArray s -> Int -> Char -> ST s Int
58unsafeWrite marr i c
53unsafeWrite marr i c
59 | n < 0x10000 = do
54 | n < 0x10000 = do
@@ -61,14 +56,14 @@ unsafeWrite marr i c
61 assert (i >= 0) . assert (i < A.length marr) $ return ()
56 assert (i >= 0) . assert (i < A.length marr) $ return ()
62#endif
57#endif
63 A.unsafeWrite marr i (fromIntegral n)
58 A.unsafeWrite marr i (fromIntegral n)
64− return 1
59+ return $! i+1
65 | otherwise = do
60 | otherwise = do
66#if defined(ASSERTS)
61#if defined(ASSERTS)
67 assert (i >= 0) . assert (i < A.length marr - 1) $ return ()
62 assert (i >= 0) . assert (i < A.length marr - 1) $ return ()
68#endif
63#endif
69 A.unsafeWrite marr i lo
64 A.unsafeWrite marr i lo
70 A.unsafeWrite marr (i+1) hi
65 A.unsafeWrite marr (i+1) hi
71− return 2
66+ return $! i+2
72 where n = ord c
67 where n = ord c
73 m = n - 0x10000
68 m = n - 0x10000
74 lo = fromIntegral $ (m `shiftR` 10) + 0xD800
69 lo = fromIntegral $ (m `shiftR` 10) + 0xD800
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
READMEnew file+43
@@ -0,0 +1,43 @@
1+Text: Fast, packed Unicode strings, using stream fusion
2+-------------------------------------------------------
3+
4+This package provides the Data.Text library, a library for the space-
5+and time-efficient manipulation of Unicode text in Haskell.
6+
7+
8+Normalization, conversion, and collation, oh my!
9+------------------------------------------------
10+
11+This library intentionally provides a simple API based on the Haskell
12+prelude's list manipulation functions. For more complicated
13+real-world tasks, such as Unicode normalization, conversion to and
14+from a larger variety of encodings, and collation, use the text-icu
15+package:
16+
17+ http://hackage.haskell.org/cgi-bin/hackage-scripts/package/text-icu
18+
19+That library uses the well-respected and liberally licensed ICU
20+library to provide these facilities.
21+
22+
23+Source code
24+-----------
25+
26+darcs get http://code.haskell.org/text
27+
28+
29+Reporting bugs, asking for enhancements
30+---------------------------------------
31+
32+http://trac.haskell.org/text/
33+
34+
35+Authors
36+-------
37+
38+The base code for this library was originally written by Tom Harper,
39+based on the stream fusion framework developed by Roman Leshchinskiy,
40+Duncan Coutts, and Don Stewart.
41+
42+The core library was fleshed out, debugged, and tested by Bryan
43+O'Sullivan, and he is the current maintainer.
README.markdowndeleted−42
@@ -1,42 +0,0 @@
1−# Text: Fast, packed Unicode strings, using stream fusion
2−
3−This package provides the Data.Text library, a library for the space-
4−and time-efficient manipulation of Unicode text in Haskell.
5−
6−
7−# Normalization, conversion, and collation, oh my!
8−
9−This library intentionally provides a simple API based on the
10−Haskell prelude's list manipulation functions. For more complicated
11−real-world tasks, such as Unicode normalization, conversion to and
12−from a larger variety of encodings, and collation, use the [text-icu
13−package](http://hackage.haskell.org/cgi-bin/hackage-scripts/package/text-icu).
14−
15−That library uses the well-respected and liberally licensed ICU
16−library to provide these facilities.
17−
18−
19−# Get involved!
20−
21−Please report bugs via the
22−[github issue tracker](https://github.com/bos/text/issues).
23−
24−Master [git repository](https://github.com/bos/text):
25−
26−* `git clone git://github.com/bos/text.git`
27−
28−There's also a [Mercurial mirror](https://bitbucket.org/bos/text):
29−
30−* `hg clone https://bitbucket.org/bos/text`
31−
32−(You can create and contribute changes using either Mercurial or git.)
33−
34−
35−# Authors
36−
37−The base code for this library was originally written by Tom Harper,
38−based on the stream fusion framework developed by Roman Leshchinskiy,
39−Duncan Coutts, and Don Stewart.
40−
41−The core library was fleshed out, debugged, and tested by Bryan
42−O'Sullivan <bos@serpentine.com>, and he is the current maintainer.
TODOnew file+6
@@ -0,0 +1,6 @@
1+Normalization.
2+
3+Collation.
4+
5+Case conversion lacks locale sensitivity, so cannot handle a few
6+Turkic and Azeri code points completely correctly.
benchmarks/.gitignoredeleted−1
@@ -1 +0,0 @@
1−dist
benchmarks/Setup.hsdeleted−2
@@ -1,2 +0,0 @@
1−import Distribution.Simple
2−main = defaultMain
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/DecodeUtf8.hsdeleted−67
@@ -1,67 +0,0 @@
1−{-# LANGUAGE ForeignFunctionInterface #-}
2−
3−-- | Test decoding of UTF-8
4−--
5−-- Tested in this benchmark:
6−--
7−-- * Decoding bytes using UTF-8
8−--
9−-- In some tests:
10−--
11−-- * Taking the length of the result
12−--
13−-- * Taking the init of the result
14−--
15−-- The latter are used for testing stream fusion.
16−--
17−module Benchmarks.DecodeUtf8
18− ( benchmark
19− ) where
20−
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)
29−import qualified Codec.Binary.UTF8.Generic as U8
30−import qualified Data.ByteString as B
31−import qualified Data.ByteString.Lazy as BL
32−import qualified Data.Text as T
33−import qualified Data.Text.Encoding as T
34−import qualified Data.Text.Lazy as TL
35−import qualified Data.Text.Lazy.Encoding as TL
36−
37−benchmark :: String -> FilePath -> IO Benchmark
38−benchmark kind fp = do
39− bs <- B.readFile fp
40− 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"
49− [ 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
53− , bench "StrictInitLength" $ nf (T.length . T.init . T.decodeUtf8) bs
54− , bench "Lazy" $ nf TL.decodeUtf8 lbs
55− , bench "LazyLength" $ nf (TL.length . TL.decodeUtf8) lbs
56− , bench "LazyInitLength" $ nf (TL.length . TL.init . TL.decodeUtf8) lbs
57− , bench "StrictStringUtf8" $ nf U8.toString bs
58− , bench "StrictStringUtf8Length" $ nf (length . U8.toString) bs
59− , bench "LazyStringUtf8" $ nf U8.toString lbs
60− , bench "LazyStringUtf8Length" $ nf (length . U8.toString) lbs
61− ]
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.hsdeleted−33
@@ -1,33 +0,0 @@
1−-- | UTF-8 encode a text
2−--
3−-- Tested in this benchmark:
4−--
5−-- * Replicating a string a number of times
6−--
7−-- * UTF-8 encoding it
8−--
9−module Benchmarks.EncodeUtf8
10− ( benchmark
11− ) where
12−
13−import Criterion (Benchmark, bgroup, bench, whnf)
14−import qualified Data.ByteString as B
15−import qualified Data.ByteString.Lazy as BL
16−import qualified Data.Text as T
17−import qualified Data.Text.Encoding as T
18−import qualified Data.Text.Lazy as TL
19−import qualified Data.Text.Lazy.Encoding as TL
20−
21−benchmark :: String -> IO Benchmark
22−benchmark string = do
23− return $ bgroup "EncodeUtf8"
24− [ bench "Text" $ whnf (B.length . T.encodeUtf8) text
25− , bench "LazyText" $ whnf (BL.length . TL.encodeUtf8) lazyText
26− ]
27− where
28− -- The string in different formats
29− text = T.replicate k $ T.pack string
30− lazyText = TL.replicate (fromIntegral k) $ TL.pack string
31−
32− -- Amount
33− k = 100000
benchmarks/haskell/Benchmarks/Equality.hsdeleted−38
@@ -1,38 +0,0 @@
1−-- | Compare a string with a copy of itself that is identical except
2−-- for the last character.
3−--
4−-- Tested in this benchmark:
5−--
6−-- * Comparison of strings (Eq instance)
7−--
8−module Benchmarks.Equality
9− ( benchmark
10− ) where
11−
12−import Criterion (Benchmark, bgroup, bench, whnf)
13−import qualified Data.ByteString.Char8 as B
14−import qualified Data.ByteString.Lazy.Char8 as BL
15−import qualified Data.Text as T
16−import qualified Data.Text.Encoding as T
17−import qualified Data.Text.Lazy as TL
18−import qualified Data.Text.Lazy.Encoding as TL
19−
20−benchmark :: FilePath -> IO Benchmark
21−benchmark fp = do
22− b <- B.readFile fp
23− bl1 <- BL.readFile fp
24− -- A lazy bytestring is a list of chunks. When we do not explicitly create two
25− -- different lazy bytestrings at a different address, the bytestring library
26− -- will compare the chunk addresses instead of the chunk contents. This is why
27− -- we read the lazy bytestring twice here.
28− bl2 <- BL.readFile fp
29− l <- readFile fp
30− let t = T.decodeUtf8 b
31− tl = TL.decodeUtf8 bl1
32− return $ bgroup "Equality"
33− [ bench "Text" $ whnf (== T.init t `T.snoc` '\xfffd') t
34− , bench "LazyText" $ whnf (== TL.init tl `TL.snoc` '\xfffd') tl
35− , bench "ByteString" $ whnf (== B.init b `B.snoc` '\xfffd') b
36− , bench "LazyByteString" $ whnf (== BL.init bl2 `BL.snoc` '\xfffd') bl1
37− , bench "String" $ whnf (== init l ++ "\xfffd") l
38− ]
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/FoldLines.hsdeleted−58
@@ -1,58 +0,0 @@
1−-- | Read a file line-by-line using handles, and perform a fold over the lines.
2−-- The fold is used here to calculate the number of lines in the file.
3−--
4−-- Tested in this benchmark:
5−--
6−-- * Buffered, line-based IO
7−--
8−{-# LANGUAGE BangPatterns #-}
9−module Benchmarks.FoldLines
10− ( benchmark
11− ) where
12−
13−import Criterion (Benchmark, bgroup, bench, whnfIO)
14−import System.IO
15−import qualified Data.ByteString as B
16−import qualified Data.Text as T
17−import qualified Data.Text.IO as T
18−
19−benchmark :: FilePath -> IO Benchmark
20−benchmark fp = return $ bgroup "ReadLines"
21− [ bench "Text" $ withHandle $ foldLinesT (\n _ -> n + 1) (0 :: Int)
22− , bench "ByteString" $ withHandle $ foldLinesB (\n _ -> n + 1) (0 :: Int)
23− ]
24− where
25− withHandle f = whnfIO $ do
26− h <- openFile fp ReadMode
27− hSetBuffering h (BlockBuffering (Just 16384))
28− x <- f h
29− hClose h
30− return x
31−
32−-- | Text line fold
33−--
34−foldLinesT :: (a -> T.Text -> a) -> a -> Handle -> IO a
35−foldLinesT f z0 h = go z0
36− where
37− go !z = do
38− eof <- hIsEOF h
39− if eof
40− then return z
41− else do
42− l <- T.hGetLine h
43− let z' = f z l in go z'
44−{-# INLINE foldLinesT #-}
45−
46−-- | ByteString line fold
47−--
48−foldLinesB :: (a -> B.ByteString -> a) -> a -> Handle -> IO a
49−foldLinesB f z0 h = go z0
50− where
51− go !z = do
52− eof <- hIsEOF h
53− if eof
54− then return z
55− else do
56− l <- B.hGetLine h
57− let z' = f z l in go z'
58−{-# INLINE foldLinesB #-}
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/Programs/BigTable.hsdeleted−42
@@ -1,42 +0,0 @@
1−-- | Create a large HTML table and dump it to a handle
2−--
3−-- Tested in this benchmark:
4−--
5−-- * Creating a large HTML document using a builder
6−--
7−-- * Writing to a handle
8−--
9−{-# LANGUAGE OverloadedStrings #-}
10−module Benchmarks.Programs.BigTable
11− ( benchmark
12− ) where
13−
14−import Criterion (Benchmark, bench, whnfIO)
15−import Data.Monoid (mappend, mconcat)
16−import Data.Text.Lazy.Builder (Builder, fromText, toLazyText)
17−import Data.Text.Lazy.IO (hPutStr)
18−import System.IO (Handle)
19−import qualified Data.Text as T
20−
21−benchmark :: Handle -> IO Benchmark
22−benchmark sink = return $ bench "BigTable" $ whnfIO $ do
23− hPutStr sink "Content-Type: text/html\n\n<table>"
24− hPutStr sink . toLazyText . makeTable =<< rows
25− hPutStr sink "</table>"
26− where
27− -- We provide the number of rows in IO so the builder value isn't shared
28− -- between the benchmark samples.
29− rows :: IO Int
30− rows = return 20000
31− {-# NOINLINE rows #-}
32−
33−makeTable :: Int -> Builder
34−makeTable n = mconcat $ replicate n $ mconcat $ map makeCol [1 .. 50]
35−
36−makeCol :: Int -> Builder
37−makeCol 1 = fromText "<tr><td>1</td>"
38−makeCol 50 = fromText "<td>50</td></tr>"
39−makeCol i = fromText "<td>" `mappend` (fromInt i `mappend` fromText "</td>")
40−
41−fromInt :: Int -> Builder
42−fromInt = fromText . T.pack . show
benchmarks/haskell/Benchmarks/Programs/Cut.hsdeleted−98
@@ -1,98 +0,0 @@
1−-- | Cut into a file, selecting certain columns (e.g. columns 10 to 40)
2−--
3−-- Tested in this benchmark:
4−--
5−-- * Reading the file
6−--
7−-- * Splitting into lines
8−--
9−-- * Taking a number of characters from the lines
10−--
11−-- * Joining the lines
12−--
13−-- * Writing back to a handle
14−--
15−module Benchmarks.Programs.Cut
16− ( benchmark
17− ) where
18−
19−import Criterion (Benchmark, bgroup, bench, whnfIO)
20−import System.IO (Handle, hPutStr)
21−import qualified Data.ByteString as B
22−import qualified Data.ByteString.Char8 as BC
23−import qualified Data.ByteString.Lazy as BL
24−import qualified Data.ByteString.Lazy.Char8 as BLC
25−import qualified Data.Text as T
26−import qualified Data.Text.Encoding as T
27−import qualified Data.Text.IO as T
28−import qualified Data.Text.Lazy as TL
29−import qualified Data.Text.Lazy.Encoding as TL
30−import qualified Data.Text.Lazy.IO as TL
31−
32−benchmark :: FilePath -> Handle -> Int -> Int -> IO Benchmark
33−benchmark p sink from to = return $ bgroup "Cut"
34− [ bench' "String" string
35− , bench' "ByteString" byteString
36− , bench' "LazyByteString" lazyByteString
37− , bench' "Text" text
38− , bench' "LazyText" lazyText
39− , bench' "TextByteString" textByteString
40− , bench' "LazyTextByteString" lazyTextByteString
41− ]
42− where
43− bench' n s = bench n $ whnfIO (s p sink from to)
44−
45−string :: FilePath -> Handle -> Int -> Int -> IO ()
46−string fp sink from to = do
47− s <- readFile fp
48− hPutStr sink $ cut s
49− where
50− cut = unlines . map (take (to - from) . drop from) . lines
51−
52−byteString :: FilePath -> Handle -> Int -> Int -> IO ()
53−byteString fp sink from to = do
54− bs <- B.readFile fp
55− B.hPutStr sink $ cut bs
56− where
57− cut = BC.unlines . map (B.take (to - from) . B.drop from) . BC.lines
58−
59−lazyByteString :: FilePath -> Handle -> Int -> Int -> IO ()
60−lazyByteString fp sink from to = do
61− bs <- BL.readFile fp
62− BL.hPutStr sink $ cut bs
63− where
64− cut = BLC.unlines . map (BL.take (to' - from') . BL.drop from') . BLC.lines
65− from' = fromIntegral from
66− to' = fromIntegral to
67−
68−text :: FilePath -> Handle -> Int -> Int -> IO ()
69−text fp sink from to = do
70− t <- T.readFile fp
71− T.hPutStr sink $ cut t
72− where
73− cut = T.unlines . map (T.take (to - from) . T.drop from) . T.lines
74−
75−lazyText :: FilePath -> Handle -> Int -> Int -> IO ()
76−lazyText fp sink from to = do
77− t <- TL.readFile fp
78− TL.hPutStr sink $ cut t
79− where
80− cut = TL.unlines . map (TL.take (to' - from') . TL.drop from') . TL.lines
81− from' = fromIntegral from
82− to' = fromIntegral to
83−
84−textByteString :: FilePath -> Handle -> Int -> Int -> IO ()
85−textByteString fp sink from to = do
86− t <- T.decodeUtf8 `fmap` B.readFile fp
87− B.hPutStr sink $ T.encodeUtf8 $ cut t
88− where
89− cut = T.unlines . map (T.take (to - from) . T.drop from) . T.lines
90−
91−lazyTextByteString :: FilePath -> Handle -> Int -> Int -> IO ()
92−lazyTextByteString fp sink from to = do
93− t <- TL.decodeUtf8 `fmap` BL.readFile fp
94− BL.hPutStr sink $ TL.encodeUtf8 $ cut t
95− where
96− cut = TL.unlines . map (TL.take (to' - from') . TL.drop from') . TL.lines
97− from' = fromIntegral from
98− to' = fromIntegral to
benchmarks/haskell/Benchmarks/Programs/Fold.hsdeleted−68
@@ -1,68 +0,0 @@
1−-- | Benchmark which formats paragraph, like the @sort@ unix utility.
2−--
3−-- Tested in this benchmark:
4−--
5−-- * Reading the file
6−--
7−-- * Splitting into paragraphs
8−--
9−-- * Reformatting the paragraphs to a certain line width
10−--
11−-- * Concatenating the results using the text builder
12−--
13−-- * Writing back to a handle
14−--
15−{-# LANGUAGE OverloadedStrings #-}
16−module Benchmarks.Programs.Fold
17− ( benchmark
18− ) where
19−
20−import Data.List (foldl')
21−import Data.List (intersperse)
22−import Data.Monoid (mempty, mappend, mconcat)
23−import System.IO (Handle)
24−import Criterion (Benchmark, bench, whnfIO)
25−import qualified Data.Text as T
26−import qualified Data.Text.IO as T
27−import qualified Data.Text.Lazy.Builder as TLB
28−import qualified Data.Text.Lazy as TL
29−import qualified Data.Text.Lazy.IO as TL
30−
31−benchmark :: FilePath -> Handle -> IO Benchmark
32−benchmark i o = return $
33− bench "Fold" $ whnfIO $ T.readFile i >>= TL.hPutStr o . fold 80
34−
35−-- | We represent a paragraph by a word list
36−--
37−type Paragraph = [T.Text]
38−
39−-- | Fold a text
40−--
41−fold :: Int -> T.Text -> TL.Text
42−fold maxWidth = TLB.toLazyText . mconcat .
43− intersperse "\n\n" . map (foldParagraph maxWidth) . paragraphs
44−
45−-- | Fold a paragraph
46−--
47−foldParagraph :: Int -> Paragraph -> TLB.Builder
48−foldParagraph _ [] = mempty
49−foldParagraph max' (w : ws) = fst $ foldl' go (TLB.fromText w, T.length w) ws
50− where
51− go (builder, width) word
52− | width + len + 1 <= max' =
53− (builder `mappend` " " `mappend` word', width + len + 1)
54− | otherwise =
55− (builder `mappend` "\n" `mappend` word', len)
56− where
57− word' = TLB.fromText word
58− len = T.length word
59−
60−-- | Divide a text into paragraphs
61−--
62−paragraphs :: T.Text -> [Paragraph]
63−paragraphs = splitParagraphs . map T.words . T.lines
64− where
65− splitParagraphs ls = case break null ls of
66− ([], []) -> []
67− (p, []) -> [concat p]
68− (p, lr) -> concat p : splitParagraphs (dropWhile null lr)
benchmarks/haskell/Benchmarks/Programs/Sort.hsdeleted−71
@@ -1,71 +0,0 @@
1−-- | This benchmark sorts the lines of a file, like the @sort@ unix utility.
2−--
3−-- Tested in this benchmark:
4−--
5−-- * Reading the file
6−--
7−-- * Splitting into lines
8−--
9−-- * Sorting the lines
10−--
11−-- * Joining the lines
12−--
13−-- * Writing back to a handle
14−--
15−{-# LANGUAGE OverloadedStrings #-}
16−module Benchmarks.Programs.Sort
17− ( benchmark
18− ) where
19−
20−import Criterion (Benchmark, bgroup, bench, whnfIO)
21−import Data.Monoid (mconcat)
22−import System.IO (Handle, hPutStr)
23−import qualified Data.ByteString as B
24−import qualified Data.ByteString.Char8 as BC
25−import qualified Data.ByteString.Lazy as BL
26−import qualified Data.ByteString.Lazy.Char8 as BLC
27−import qualified Data.List as L
28−import qualified Data.Text as T
29−import qualified Data.Text.Encoding as T
30−import qualified Data.Text.IO as T
31−import qualified Data.Text.Lazy as TL
32−import qualified Data.Text.Lazy.Builder as TLB
33−import qualified Data.Text.Lazy.Encoding as TL
34−import qualified Data.Text.Lazy.IO as TL
35−
36−benchmark :: FilePath -> Handle -> IO Benchmark
37−benchmark i o = return $ bgroup "Sort"
38− [ bench "String" $ whnfIO $ readFile i >>= hPutStr o . string
39− , bench "ByteString" $ whnfIO $ B.readFile i >>= B.hPutStr o . byteString
40− , bench "LazyByteString" $ whnfIO $
41− BL.readFile i >>= BL.hPutStr o . lazyByteString
42− , bench "Text" $ whnfIO $ T.readFile i >>= T.hPutStr o . text
43− , bench "LazyText" $ whnfIO $ 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 >>=
49− BL.hPutStr o . TL.encodeUtf8 . textBuilder . T.decodeUtf8
50− ]
51−
52−string :: String -> String
53−string = unlines . L.sort . lines
54−
55−byteString :: B.ByteString -> B.ByteString
56−byteString = BC.unlines . L.sort . BC.lines
57−
58−lazyByteString :: BL.ByteString -> BL.ByteString
59−lazyByteString = BLC.unlines . L.sort . BLC.lines
60−
61−text :: T.Text -> T.Text
62−text = T.unlines . L.sort . T.lines
63−
64−lazyText :: TL.Text -> TL.Text
65−lazyText = TL.unlines . L.sort . TL.lines
66−
67−-- | Text variant using a builder monoid for the final concatenation
68−--
69−textBuilder :: T.Text -> TL.Text
70−textBuilder = TLB.toLazyText . mconcat . L.intersperse (TLB.singleton '\n') .
71− map TLB.fromText . L.sort . T.lines
benchmarks/haskell/Benchmarks/Programs/StripTags.hsdeleted−53
@@ -1,53 +0,0 @@
1−-- | Program to replace HTML tags by whitespace
2−--
3−-- This program was originally contributed by Petr Prokhorenkov.
4−--
5−-- Tested in this benchmark:
6−--
7−-- * Reading the file
8−--
9−-- * Replacing text between HTML tags (<>) with whitespace
10−--
11−-- * Writing back to a handle
12−--
13−{-# OPTIONS_GHC -fspec-constr-count=5 #-}
14−module Benchmarks.Programs.StripTags
15− ( benchmark
16− ) where
17−
18−import Criterion (Benchmark, bgroup, bench, whnfIO)
19−import Data.List (mapAccumL)
20−import System.IO (Handle, hPutStr)
21−import qualified Data.ByteString as B
22−import qualified Data.ByteString.Char8 as BC
23−import qualified Data.Text as T
24−import qualified Data.Text.Encoding as T
25−import qualified Data.Text.IO as T
26−
27−benchmark :: FilePath -> Handle -> IO Benchmark
28−benchmark i o = return $ bgroup "StripTags"
29− [ bench "String" $ whnfIO $ readFile i >>= hPutStr o . string
30− , bench "ByteString" $ whnfIO $ B.readFile i >>= B.hPutStr o . byteString
31− , bench "Text" $ whnfIO $ T.readFile i >>= T.hPutStr o . text
32− , bench "TextByteString" $ whnfIO $
33− B.readFile i >>= B.hPutStr o . T.encodeUtf8 . text . T.decodeUtf8
34− ]
35−
36−string :: String -> String
37−string = snd . mapAccumL step 0
38−
39−text :: T.Text -> T.Text
40−text = snd . T.mapAccumL step 0
41−
42−byteString :: B.ByteString -> B.ByteString
43−byteString = snd . BC.mapAccumL step 0
44−
45−step :: Int -> Char -> (Int, Char)
46−step d c
47− | d > 0 || d' > 0 = (d', ' ')
48− | otherwise = (d', c)
49− where
50− d' = d + depth c
51− depth '>' = 1
52− depth '<' = -1
53− depth _ = 0
benchmarks/haskell/Benchmarks/Programs/Throughput.hsdeleted−41
@@ -1,41 +0,0 @@
1−-- | This benchmark simply reads and writes a file using the various string
2−-- libraries. The point of it is that we can make better estimations on how
3−-- much time the other benchmarks spend doing IO.
4−--
5−-- Note that we expect ByteStrings to be a whole lot faster, since they do not
6−-- do any actual encoding/decoding here, while String and Text do have UTF-8
7−-- encoding/decoding.
8−--
9−-- Tested in this benchmark:
10−--
11−-- * Reading the file
12−--
13−-- * Replacing text between HTML tags (<>) with whitespace
14−--
15−-- * Writing back to a handle
16−--
17−module Benchmarks.Programs.Throughput
18− ( benchmark
19− ) where
20−
21−import Criterion (Benchmark, bgroup, bench, whnfIO)
22−import System.IO (Handle, hPutStr)
23−import qualified Data.ByteString as B
24−import qualified Data.ByteString.Lazy as BL
25−import qualified Data.Text.Encoding as T
26−import qualified Data.Text.IO as T
27−import qualified Data.Text.Lazy.Encoding as TL
28−import qualified Data.Text.Lazy.IO as TL
29−
30−benchmark :: FilePath -> Handle -> IO Benchmark
31−benchmark fp sink = return $ bgroup "Throughput"
32− [ bench "String" $ whnfIO $ readFile fp >>= hPutStr sink
33− , bench "ByteString" $ whnfIO $ B.readFile fp >>= B.hPutStr sink
34− , bench "LazyByteString" $ whnfIO $ BL.readFile fp >>= BL.hPutStr sink
35− , bench "Text" $ whnfIO $ T.readFile fp >>= T.hPutStr sink
36− , bench "LazyText" $ whnfIO $ 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− ]
benchmarks/haskell/Benchmarks/Pure.hsdeleted−486
@@ -1,486 +0,0 @@
1−-- | Benchmarks various pure functions from the Text library
2−--
3−-- Tested in this benchmark:
4−--
5−-- * Most pure functions defined the string types
6−--
7−{-# LANGUAGE BangPatterns, CPP, GADTs, MagicHash #-}
8−{-# OPTIONS_GHC -fno-warn-orphans #-}
9−module Benchmarks.Pure
10− ( benchmark
11− ) where
12−
13−import Control.DeepSeq (NFData (..))
14−import Control.Exception (evaluate)
15−import Criterion (Benchmark, bgroup, bench, nf)
16−import Data.Char (toLower, toUpper)
17−import Data.Monoid (mappend, mempty)
18−import GHC.Base (Char (..), Int (..), chr#, ord#, (+#))
19−import qualified Data.ByteString.Char8 as BS
20−import qualified Data.ByteString.Lazy.Char8 as BL
21−import qualified Data.ByteString.UTF8 as UTF8
22−import qualified Data.List as L
23−import qualified Data.Text as T
24−import qualified Data.Text.Encoding as T
25−import qualified Data.Text.Lazy as TL
26−import qualified Data.Text.Lazy.Builder as TB
27−import qualified Data.Text.Lazy.Encoding as TL
28−
29−benchmark :: String -> FilePath -> IO Benchmark
30−benchmark kind fp = do
31− -- Evaluate stuff before actually running the benchmark, we don't want to
32− -- count it here.
33−
34− -- ByteString A
35− bsa <- BS.readFile fp
36−
37− -- Text A/B, LazyText A/B
38− ta <- evaluate $ T.decodeUtf8 bsa
39− tb <- evaluate $ T.toUpper ta
40− tla <- evaluate $ TL.fromChunks (T.chunksOf 16376 ta)
41− tlb <- evaluate $ TL.fromChunks (T.chunksOf 16376 tb)
42−
43− -- ByteString B, LazyByteString A/B
44− bsb <- evaluate $ T.encodeUtf8 tb
45− bla <- evaluate $ BL.fromChunks (chunksOf 16376 bsa)
46− blb <- evaluate $ BL.fromChunks (chunksOf 16376 bsb)
47−
48− -- String A/B
49− sa <- evaluate $ UTF8.toString bsa
50− sb <- evaluate $ T.unpack tb
51−
52− -- Lengths
53− bsa_len <- evaluate $ BS.length bsa
54− ta_len <- evaluate $ T.length ta
55− bla_len <- evaluate $ BL.length bla
56− tla_len <- evaluate $ TL.length tla
57− sa_len <- evaluate $ L.length sa
58−
59− -- Lines
60− bsl <- evaluate $ BS.lines bsa
61− bll <- evaluate $ BL.lines bla
62− tl <- evaluate $ T.lines ta
63− tll <- evaluate $ TL.lines tla
64− sl <- evaluate $ L.lines sa
65−
66− return $ bgroup "Pure"
67− [ bgroup "append"
68− [ benchT $ nf (T.append tb) ta
69− , benchTL $ nf (TL.append tlb) tla
70− , benchBS $ nf (BS.append bsb) bsa
71− , benchBSL $ nf (BL.append blb) bla
72− , benchS $ nf ((++) sb) sa
73− ]
74− , bgroup "concat"
75− [ benchT $ nf T.concat tl
76− , benchTL $ nf TL.concat tll
77− , benchBS $ nf BS.concat bsl
78− , benchBSL $ nf BL.concat bll
79− , benchS $ nf L.concat sl
80− ]
81− , bgroup "cons"
82− [ benchT $ nf (T.cons c) ta
83− , benchTL $ nf (TL.cons c) tla
84− , benchBS $ nf (BS.cons c) bsa
85− , benchBSL $ nf (BL.cons c) bla
86− , benchS $ nf (c:) sa
87− ]
88− , bgroup "concatMap"
89− [ benchT $ nf (T.concatMap (T.replicate 3 . T.singleton)) ta
90− , benchTL $ nf (TL.concatMap (TL.replicate 3 . TL.singleton)) tla
91− , benchBS $ nf (BS.concatMap (BS.replicate 3)) bsa
92− , benchBSL $ nf (BL.concatMap (BL.replicate 3)) bla
93− , benchS $ nf (L.concatMap (L.replicate 3 . (:[]))) sa
94− ]
95− , bgroup "decode"
96− [ benchT $ nf T.decodeUtf8 bsa
97− , benchTL $ nf TL.decodeUtf8 bla
98− , benchBS $ nf BS.unpack bsa
99− , benchBSL $ nf BL.unpack bla
100− , benchS $ nf UTF8.toString bsa
101− ]
102− , bgroup "decode'"
103− [ benchT $ nf T.decodeUtf8' bsa
104− , benchTL $ nf TL.decodeUtf8' bla
105− ]
106− , bgroup "drop"
107− [ benchT $ nf (T.drop (ta_len `div` 3)) ta
108− , benchTL $ nf (TL.drop (tla_len `div` 3)) tla
109− , benchBS $ nf (BS.drop (bsa_len `div` 3)) bsa
110− , benchBSL $ nf (BL.drop (bla_len `div` 3)) bla
111− , benchS $ nf (L.drop (sa_len `div` 3)) sa
112− ]
113− , bgroup "encode"
114− [ benchT $ nf T.encodeUtf8 ta
115− , benchTL $ nf TL.encodeUtf8 tla
116− , benchBS $ nf BS.pack sa
117− , benchBSL $ nf BL.pack sa
118− , benchS $ nf UTF8.fromString sa
119− ]
120− , bgroup "filter"
121− [ benchT $ nf (T.filter p0) ta
122− , benchTL $ nf (TL.filter p0) tla
123− , benchBS $ nf (BS.filter p0) bsa
124− , benchBSL $ nf (BL.filter p0) bla
125− , benchS $ nf (L.filter p0) sa
126− ]
127− , bgroup "filter.filter"
128− [ benchT $ nf (T.filter p1 . T.filter p0) ta
129− , benchTL $ nf (TL.filter p1 . TL.filter p0) tla
130− , benchBS $ nf (BS.filter p1 . BS.filter p0) bsa
131− , benchBSL $ nf (BL.filter p1 . BL.filter p0) bla
132− , benchS $ nf (L.filter p1 . L.filter p0) sa
133− ]
134− , bgroup "foldl'"
135− [ benchT $ nf (T.foldl' len 0) ta
136− , benchTL $ nf (TL.foldl' len 0) tla
137− , benchBS $ nf (BS.foldl' len 0) bsa
138− , benchBSL $ nf (BL.foldl' len 0) bla
139− , benchS $ nf (L.foldl' len 0) sa
140− ]
141− , bgroup "foldr"
142− [ benchT $ nf (L.length . T.foldr (:) []) ta
143− , benchTL $ nf (L.length . TL.foldr (:) []) tla
144− , benchBS $ nf (L.length . BS.foldr (:) []) bsa
145− , benchBSL $ nf (L.length . BL.foldr (:) []) bla
146− , benchS $ nf (L.length . L.foldr (:) []) sa
147− ]
148− , bgroup "head"
149− [ benchT $ nf T.head ta
150− , benchTL $ nf TL.head tla
151− , benchBS $ nf BS.head bsa
152− , benchBSL $ nf BL.head bla
153− , benchS $ nf L.head sa
154− ]
155− , bgroup "init"
156− [ benchT $ nf T.init ta
157− , benchTL $ nf TL.init tla
158− , benchBS $ nf BS.init bsa
159− , benchBSL $ nf BL.init bla
160− , benchS $ nf L.init sa
161− ]
162− , bgroup "intercalate"
163− [ benchT $ nf (T.intercalate tsw) tl
164− , benchTL $ nf (TL.intercalate tlw) tll
165− , benchBS $ nf (BS.intercalate bsw) bsl
166− , benchBSL $ nf (BL.intercalate blw) bll
167− , benchS $ nf (L.intercalate lw) sl
168− ]
169− , bgroup "intersperse"
170− [ benchT $ nf (T.intersperse c) ta
171− , benchTL $ nf (TL.intersperse c) tla
172− , benchBS $ nf (BS.intersperse c) bsa
173− , benchBSL $ nf (BL.intersperse c) bla
174− , benchS $ nf (L.intersperse c) sa
175− ]
176− , bgroup "isInfixOf"
177− [ benchT $ nf (T.isInfixOf tsw) ta
178− , benchTL $ nf (TL.isInfixOf tlw) tla
179− , benchBS $ nf (BS.isInfixOf bsw) bsa
180− -- no isInfixOf for lazy bytestrings
181− , benchS $ nf (L.isInfixOf lw) sa
182− ]
183− , bgroup "last"
184− [ benchT $ nf T.last ta
185− , benchTL $ nf TL.last tla
186− , benchBS $ nf BS.last bsa
187− , benchBSL $ nf BL.last bla
188− , benchS $ nf L.last sa
189− ]
190− , bgroup "map"
191− [ benchT $ nf (T.map f) ta
192− , benchTL $ nf (TL.map f) tla
193− , benchBS $ nf (BS.map f) bsa
194− , benchBSL $ nf (BL.map f) bla
195− , benchS $ nf (L.map f) sa
196− ]
197− , bgroup "mapAccumL"
198− [ benchT $ nf (T.mapAccumL g 0) ta
199− , benchTL $ nf (TL.mapAccumL g 0) tla
200− , benchBS $ nf (BS.mapAccumL g 0) bsa
201− , benchBSL $ nf (BL.mapAccumL g 0) bla
202− , benchS $ nf (L.mapAccumL g 0) sa
203− ]
204− , bgroup "mapAccumR"
205− [ benchT $ nf (T.mapAccumR g 0) ta
206− , benchTL $ nf (TL.mapAccumR g 0) tla
207− , benchBS $ nf (BS.mapAccumR g 0) bsa
208− , benchBSL $ nf (BL.mapAccumR g 0) bla
209− , benchS $ nf (L.mapAccumR g 0) sa
210− ]
211− , bgroup "map.map"
212− [ benchT $ nf (T.map f . T.map f) ta
213− , benchTL $ nf (TL.map f . TL.map f) tla
214− , benchBS $ nf (BS.map f . BS.map f) bsa
215− , benchBSL $ nf (BL.map f . BL.map f) bla
216− , benchS $ nf (L.map f . L.map f) sa
217− ]
218− , bgroup "replicate char"
219− [ benchT $ nf (T.replicate bsa_len) (T.singleton c)
220− , benchTL $ nf (TL.replicate (fromIntegral bsa_len)) (TL.singleton c)
221− , benchBS $ nf (BS.replicate bsa_len) c
222− , benchBSL $ nf (BL.replicate (fromIntegral bsa_len)) c
223− , benchS $ nf (L.replicate bsa_len) c
224− ]
225− , bgroup "replicate string"
226− [ benchT $ nf (T.replicate (bsa_len `div` T.length tsw)) tsw
227− , benchTL $ nf (TL.replicate (fromIntegral bsa_len `div` TL.length tlw)) tlw
228− , benchS $ nf (replicat (bsa_len `div` T.length tsw)) lw
229− ]
230− , bgroup "reverse"
231− [ benchT $ nf T.reverse ta
232− , benchTL $ nf TL.reverse tla
233− , benchBS $ nf BS.reverse bsa
234− , benchBSL $ nf BL.reverse bla
235− , benchS $ nf L.reverse sa
236− ]
237− , bgroup "take"
238− [ benchT $ nf (T.take (ta_len `div` 3)) ta
239− , benchTL $ nf (TL.take (tla_len `div` 3)) tla
240− , benchBS $ nf (BS.take (bsa_len `div` 3)) bsa
241− , benchBSL $ nf (BL.take (bla_len `div` 3)) bla
242− , benchS $ nf (L.take (sa_len `div` 3)) sa
243− ]
244− , bgroup "tail"
245− [ benchT $ nf T.tail ta
246− , benchTL $ nf TL.tail tla
247− , benchBS $ nf BS.tail bsa
248− , benchBSL $ nf BL.tail bla
249− , benchS $ nf L.tail sa
250− ]
251− , bgroup "toLower"
252− [ benchT $ nf T.toLower ta
253− , benchTL $ nf TL.toLower tla
254− , benchBS $ nf (BS.map toLower) bsa
255− , benchBSL $ nf (BL.map toLower) bla
256− , benchS $ nf (L.map toLower) sa
257− ]
258− , bgroup "toUpper"
259− [ benchT $ nf T.toUpper ta
260− , benchTL $ nf TL.toUpper tla
261− , benchBS $ nf (BS.map toUpper) bsa
262− , benchBSL $ nf (BL.map toUpper) bla
263− , benchS $ nf (L.map toUpper) sa
264− ]
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"
273− [ benchT $ nf T.words ta
274− , benchTL $ nf TL.words tla
275− , benchBS $ nf BS.words bsa
276− , benchBSL $ nf BL.words bla
277− , benchS $ nf L.words sa
278− ]
279− , bgroup "zipWith"
280− [ benchT $ nf (T.zipWith min tb) ta
281− , benchTL $ nf (TL.zipWith min tlb) tla
282− , benchBS $ nf (BS.zipWith min bsb) bsa
283− , benchBSL $ nf (BL.zipWith min blb) bla
284− , benchS $ nf (L.zipWith min sb) sa
285− ]
286− , bgroup "length"
287− [ bgroup "cons"
288− [ benchT $ nf (T.length . T.cons c) ta
289− , benchTL $ nf (TL.length . TL.cons c) tla
290− , benchBS $ nf (BS.length . BS.cons c) bsa
291− , benchBSL $ nf (BL.length . BL.cons c) bla
292− , benchS $ nf (L.length . (:) c) sa
293− ]
294− , bgroup "decode"
295− [ benchT $ nf (T.length . T.decodeUtf8) bsa
296− , benchTL $ nf (TL.length . TL.decodeUtf8) bla
297− , benchBS $ nf (L.length . BS.unpack) bsa
298− , benchBSL $ nf (L.length . BL.unpack) bla
299− , bench "StringUTF8" $ nf (L.length . UTF8.toString) bsa
300− ]
301− , bgroup "drop"
302− [ benchT $ nf (T.length . T.drop (ta_len `div` 3)) ta
303− , benchTL $ nf (TL.length . TL.drop (tla_len `div` 3)) tla
304− , benchBS $ nf (BS.length . BS.drop (bsa_len `div` 3)) bsa
305− , benchBSL $ nf (BL.length . BL.drop (bla_len `div` 3)) bla
306− , benchS $ nf (L.length . L.drop (sa_len `div` 3)) sa
307− ]
308− , bgroup "filter"
309− [ benchT $ nf (T.length . T.filter p0) ta
310− , benchTL $ nf (TL.length . TL.filter p0) tla
311− , benchBS $ nf (BS.length . BS.filter p0) bsa
312− , benchBSL $ nf (BL.length . BL.filter p0) bla
313− , benchS $ nf (L.length . L.filter p0) sa
314− ]
315− , bgroup "filter.filter"
316− [ benchT $ nf (T.length . T.filter p1 . T.filter p0) ta
317− , benchTL $ nf (TL.length . TL.filter p1 . TL.filter p0) tla
318− , benchBS $ nf (BS.length . BS.filter p1 . BS.filter p0) bsa
319− , benchBSL $ nf (BL.length . BL.filter p1 . BL.filter p0) bla
320− , benchS $ nf (L.length . L.filter p1 . L.filter p0) sa
321− ]
322− , bgroup "init"
323− [ benchT $ nf (T.length . T.init) ta
324− , benchTL $ nf (TL.length . TL.init) tla
325− , benchBS $ nf (BS.length . BS.init) bsa
326− , benchBSL $ nf (BL.length . BL.init) bla
327− , benchS $ nf (L.length . L.init) sa
328− ]
329− , bgroup "intercalate"
330− [ benchT $ nf (T.length . T.intercalate tsw) tl
331− , benchTL $ nf (TL.length . TL.intercalate tlw) tll
332− , benchBS $ nf (BS.length . BS.intercalate bsw) bsl
333− , benchBSL $ nf (BL.length . BL.intercalate blw) bll
334− , benchS $ nf (L.length . L.intercalate lw) sl
335− ]
336− , bgroup "intersperse"
337− [ benchT $ nf (T.length . T.intersperse c) ta
338− , benchTL $ nf (TL.length . TL.intersperse c) tla
339− , benchBS $ nf (BS.length . BS.intersperse c) bsa
340− , benchBSL $ nf (BL.length . BL.intersperse c) bla
341− , benchS $ nf (L.length . L.intersperse c) sa
342− ]
343− , bgroup "map"
344− [ benchT $ nf (T.length . T.map f) ta
345− , benchTL $ nf (TL.length . TL.map f) tla
346− , benchBS $ nf (BS.length . BS.map f) bsa
347− , benchBSL $ nf (BL.length . BL.map f) bla
348− , benchS $ nf (L.length . L.map f) sa
349− ]
350− , bgroup "map.map"
351− [ benchT $ nf (T.length . T.map f . T.map f) ta
352− , benchTL $ nf (TL.length . TL.map f . TL.map f) tla
353− , benchBS $ nf (BS.length . BS.map f . BS.map f) bsa
354− , benchS $ nf (L.length . L.map f . L.map f) sa
355− ]
356− , bgroup "replicate char"
357− [ benchT $ nf (T.length . T.replicate bsa_len) (T.singleton c)
358− , benchTL $ nf (TL.length . TL.replicate (fromIntegral bsa_len)) (TL.singleton c)
359− , benchBS $ nf (BS.length . BS.replicate bsa_len) c
360− , benchBSL $ nf (BL.length . BL.replicate (fromIntegral bsa_len)) c
361− , benchS $ nf (L.length . L.replicate bsa_len) c
362− ]
363− , bgroup "replicate string"
364− [ benchT $ nf (T.length . T.replicate (bsa_len `div` T.length tsw)) tsw
365− , benchTL $ nf (TL.length . TL.replicate (fromIntegral bsa_len `div` TL.length tlw)) tlw
366− , benchS $ nf (L.length . replicat (bsa_len `div` T.length tsw)) lw
367− ]
368− , bgroup "take"
369− [ benchT $ nf (T.length . T.take (ta_len `div` 3)) ta
370− , benchTL $ nf (TL.length . TL.take (tla_len `div` 3)) tla
371− , benchBS $ nf (BS.length . BS.take (bsa_len `div` 3)) bsa
372− , benchBSL $ nf (BL.length . BL.take (bla_len `div` 3)) bla
373− , benchS $ nf (L.length . L.take (sa_len `div` 3)) sa
374− ]
375− , bgroup "tail"
376− [ benchT $ nf (T.length . T.tail) ta
377− , benchTL $ nf (TL.length . TL.tail) tla
378− , benchBS $ nf (BS.length . BS.tail) bsa
379− , benchBSL $ nf (BL.length . BL.tail) bla
380− , benchS $ nf (L.length . L.tail) sa
381− ]
382− , bgroup "toLower"
383− [ benchT $ nf (T.length . T.toLower) ta
384− , benchTL $ nf (TL.length . TL.toLower) tla
385− , benchBS $ nf (BS.length . BS.map toLower) bsa
386− , benchBSL $ nf (BL.length . BL.map toLower) bla
387− , benchS $ nf (L.length . L.map toLower) sa
388− ]
389− , bgroup "toUpper"
390− [ benchT $ nf (T.length . T.toUpper) ta
391− , benchTL $ nf (TL.length . TL.toUpper) tla
392− , benchBS $ nf (BS.length . BS.map toUpper) bsa
393− , benchBSL $ nf (BL.length . BL.map toUpper) bla
394− , benchS $ nf (L.length . L.map toUpper) sa
395− ]
396− , bgroup "words"
397− [ benchT $ nf (L.length . T.words) ta
398− , benchTL $ nf (L.length . TL.words) tla
399− , benchBS $ nf (L.length . BS.words) bsa
400− , benchBSL $ nf (L.length . BL.words) bla
401− , benchS $ nf (L.length . L.words) sa
402− ]
403− , bgroup "zipWith"
404− [ benchT $ nf (T.length . T.zipWith min tb) ta
405− , benchTL $ nf (TL.length . TL.zipWith min tlb) tla
406− , benchBS $ nf (L.length . BS.zipWith min bsb) bsa
407− , benchBSL $ nf (L.length . BL.zipWith min blb) bla
408− , benchS $ nf (L.length . L.zipWith min sb) sa
409− ]
410− ]
411− , bgroup "Builder"
412− [ bench "mappend char" $ nf (TL.length . TB.toLazyText . mappendNChar 'a') 10000
413− , bench "mappend 8 char" $ nf (TL.length . TB.toLazyText . mappend8Char) 'a'
414− , bench "mappend text" $ nf (TL.length . TB.toLazyText . mappendNText short) 10000
415− ]
416− ]
417− where
418− benchS = bench ("String+" ++ kind)
419− benchT = bench ("Text+" ++ kind)
420− benchTL = bench ("LazyText+" ++ kind)
421− benchBS = bench ("ByteString+" ++ kind)
422− benchBSL = bench ("LazyByteString+" ++ kind)
423−
424− c = 'й'
425− p0 = (== c)
426− p1 = (/= 'д')
427− lw = "право"
428− bsw = UTF8.fromString lw
429− blw = BL.fromChunks [bsw]
430− tsw = T.pack lw
431− tlw = TL.fromChunks [tsw]
432− f (C# c#) = C# (chr# (ord# c# +# 1#))
433− g (I# i#) (C# c#) = (I# (i# +# 1#), C# (chr# (ord# c# +# i#)))
434− len l _ = l + (1::Int)
435− replicat n = concat . L.replicate n
436− short = T.pack "short"
437−
438−#if !MIN_VERSION_bytestring(0,10,0)
439−instance NFData BS.ByteString
440−
441−instance NFData BL.ByteString where
442− rnf BL.Empty = ()
443− rnf (BL.Chunk _ ts) = rnf ts
444−#endif
445−
446−data B where
447− B :: NFData a => a -> B
448−
449−instance NFData B where
450− rnf (B b) = rnf b
451−
452−-- | Split a bytestring in chunks
453−--
454−chunksOf :: Int -> BS.ByteString -> [BS.ByteString]
455−chunksOf k = go
456− where
457− go t = case BS.splitAt k t of
458− (a,b) | BS.null a -> []
459− | otherwise -> a : go b
460−
461−-- | Append a character n times
462−--
463−mappendNChar :: Char -> Int -> TB.Builder
464−mappendNChar c n = go 0
465− where
466− go i
467− | i < n = TB.singleton c `mappend` go (i+1)
468− | otherwise = mempty
469−
470−-- | Gives more opportunity for inlining and elimination of unnecesary
471−-- bounds checks.
472−--
473−mappend8Char :: Char -> TB.Builder
474−mappend8Char c = TB.singleton c `mappend` TB.singleton c `mappend`
475− TB.singleton c `mappend` TB.singleton c `mappend`
476− TB.singleton c `mappend` TB.singleton c `mappend`
477− TB.singleton c `mappend` TB.singleton c
478−
479−-- | Append a text N times
480−--
481−mappendNText :: T.Text -> Int -> TB.Builder
482−mappendNText t n = go 0
483− where
484− go i
485− | i < n = TB.fromText t `mappend` go (i+1)
486− | otherwise = mempty
benchmarks/haskell/Benchmarks/ReadNumbers.hsdeleted−93
@@ -1,93 +0,0 @@
1−-- | Read numbers from a file with a just a number on each line, find the
2−-- minimum of those numbers. The file contains different kinds of numbers:
3−--
4−-- * Decimals
5−--
6−-- * Hexadecimals
7−--
8−-- * Floating point numbers
9−--
10−-- * Floating point numbers in scientific notation
11−--
12−-- The different benchmarks will only take into account the values they can
13−-- parse.
14−--
15−-- Tested in this benchmark:
16−--
17−-- * Lexing/parsing of different numerical types
18−--
19−module Benchmarks.ReadNumbers
20− ( benchmark
21− ) where
22−
23−import Criterion (Benchmark, bgroup, bench, whnf)
24−import Data.List (foldl')
25−import Numeric (readDec, readFloat, readHex)
26−import qualified Data.ByteString.Char8 as B
27−import qualified Data.ByteString.Lazy.Char8 as BL
28−import qualified Data.ByteString.Lex.Fractional as B
29−import qualified Data.Text as T
30−import qualified Data.Text.IO as T
31−import qualified Data.Text.Lazy as TL
32−import qualified Data.Text.Lazy.IO as TL
33−import qualified Data.Text.Lazy.Read as TL
34−import qualified Data.Text.Read as T
35−
36−benchmark :: FilePath -> IO Benchmark
37−benchmark fp = do
38− -- Read all files into lines: string, text, lazy text, bytestring, lazy
39− -- bytestring
40− s <- lines `fmap` readFile fp
41− t <- T.lines `fmap` T.readFile fp
42− tl <- TL.lines `fmap` TL.readFile fp
43− b <- B.lines `fmap` B.readFile fp
44− bl <- BL.lines `fmap` BL.readFile fp
45− return $ bgroup "ReadNumbers"
46− [ bench "DecimalString" $ whnf (int . string readDec) s
47− , bench "HexadecimalString" $ whnf (int . string readHex) s
48− , bench "DoubleString" $ whnf (double . string readFloat) s
49−
50− , bench "DecimalText" $ whnf (int . text (T.signed T.decimal)) t
51− , bench "HexadecimalText" $ whnf (int . text (T.signed T.hexadecimal)) t
52− , bench "DoubleText" $ whnf (double . text T.double) t
53− , bench "RationalText" $ whnf (double . text T.rational) t
54−
55− , bench "DecimalLazyText" $
56− whnf (int . text (TL.signed TL.decimal)) tl
57− , bench "HexadecimalLazyText" $
58− whnf (int . text (TL.signed TL.hexadecimal)) tl
59− , bench "DoubleLazyText" $
60− whnf (double . text TL.double) tl
61− , bench "RationalLazyText" $
62− whnf (double . text TL.rational) tl
63−
64− , bench "DecimalByteString" $ whnf (int . byteString B.readInt) b
65− , bench "DoubleByteString" $ whnf (double . byteString B.readDecimal) b
66−
67− , bench "DecimalLazyByteString" $
68− whnf (int . byteString BL.readInt) bl
69− ]
70− where
71− -- Used for fixing types
72− int :: Int -> Int
73− int = id
74− double :: Double -> Double
75− double = id
76−
77−string :: (Ord a, Num a) => (t -> [(a, t)]) -> [t] -> a
78−string reader = foldl' go 1000000
79− where
80− go z t = case reader t of [(n, _)] -> min n z
81− _ -> z
82−
83−text :: (Ord a, Num a) => (t -> Either String (a,t)) -> [t] -> a
84−text reader = foldl' go 1000000
85− where
86− go z t = case reader t of Left _ -> z
87− Right (n, _) -> min n z
88−
89−byteString :: (Ord a, Num a) => (t -> Maybe (a,t)) -> [t] -> a
90−byteString reader = foldl' go 1000000
91− where
92− go z t = case reader t of Nothing -> z
93− Just (n, _) -> min n z
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/Search.hsdeleted−48
@@ -1,48 +0,0 @@
1−-- | Search for a pattern in a file, find the number of occurences
2−--
3−-- Tested in this benchmark:
4−--
5−-- * Searching all occurences of a pattern using library routines
6−--
7−module Benchmarks.Search
8− ( benchmark
9− ) where
10−
11−import Criterion (Benchmark, bench, bgroup, whnf)
12−import qualified Data.ByteString as B
13−import qualified Data.ByteString.Lazy as BL
14−import qualified Data.ByteString.Lazy.Search as BL
15−import qualified Data.ByteString.Search as B
16−import qualified Data.Text as T
17−import qualified Data.Text.Encoding as T
18−import qualified Data.Text.IO as T
19−import qualified Data.Text.Lazy as TL
20−import qualified Data.Text.Lazy.IO as TL
21−
22−benchmark :: FilePath -> T.Text -> IO Benchmark
23−benchmark fp needleT = do
24− b <- B.readFile fp
25− bl <- BL.readFile fp
26− t <- T.readFile fp
27− tl <- TL.readFile fp
28− return $ bgroup "FileIndices"
29− [ bench "ByteString" $ whnf (byteString needleB) b
30− , bench "LazyByteString" $ whnf (lazyByteString needleB) bl
31− , bench "Text" $ whnf (text needleT) t
32− , bench "LazyText" $ whnf (lazyText needleTL) tl
33− ]
34− where
35− needleB = T.encodeUtf8 needleT
36− needleTL = TL.fromChunks [needleT]
37−
38−byteString :: B.ByteString -> B.ByteString -> Int
39−byteString needle = length . B.indices needle
40−
41−lazyByteString :: B.ByteString -> BL.ByteString -> Int
42−lazyByteString needle = length . BL.indices needle
43−
44−text :: T.Text -> T.Text -> Int
45−text = T.count
46−
47−lazyText :: TL.Text -> TL.Text -> Int
48−lazyText needle = fromIntegral . TL.count needle
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/Benchmarks/WordFrequencies.hsdeleted−36
@@ -1,36 +0,0 @@
1−-- | A word frequency count using the different string types
2−--
3−-- Tested in this benchmark:
4−--
5−-- * Splitting into words
6−--
7−-- * Converting to lowercase
8−--
9−-- * Comparing: Eq/Ord instances
10−--
11−module Benchmarks.WordFrequencies
12− ( benchmark
13− ) where
14−
15−import Criterion (Benchmark, bench, bgroup, whnf)
16−import Data.Char (toLower)
17−import Data.List (foldl')
18−import Data.Map (Map)
19−import qualified Data.ByteString.Char8 as B
20−import qualified Data.Map as M
21−import qualified Data.Text as T
22−import qualified Data.Text.IO as T
23−
24−benchmark :: FilePath -> IO Benchmark
25−benchmark fp = do
26− s <- readFile fp
27− b <- B.readFile fp
28− t <- T.readFile fp
29− return $ bgroup "WordFrequencies"
30− [ bench "String" $ whnf (frequencies . words . map toLower) s
31− , bench "ByteString" $ whnf (frequencies . B.words . B.map toLower) b
32− , bench "Text" $ whnf (frequencies . T.words . T.toLower) t
33− ]
34−
35−frequencies :: Ord a => [a] -> Map a Int
36−frequencies = foldl' (\m k -> M.insertWith (+) k 1 m) M.empty
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/.gitignoredeleted−2
@@ -1,2 +0,0 @@
1−__pycache__
2−*.pyc
benchmarks/python/cut.pydeleted−12
@@ -1,12 +0,0 @@
1−#!/usr/bin/env python
2−
3−import utils, sys, codecs
4−
5−def cut(filename, l, r):
6− content = open(filename, encoding='utf-8')
7− for line in content:
8− print(line[l:r])
9−
10−for f in sys.argv[1:]:
11− t = utils.benchmark(lambda: cut(f, 20, 40))
12− sys.stderr.write('{0}: {1}\n'.format(f, t))
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/python/sort.pydeleted−13
@@ -1,13 +0,0 @@
1−#!/usr/bin/env python
2−
3−import utils, sys, codecs
4−
5−def sort(filename):
6− content = open(filename, encoding='utf-8').read()
7− lines = content.splitlines()
8− lines.sort()
9− print('\n'.join(lines))
10−
11−for f in sys.argv[1:]:
12− t = utils.benchmark(lambda: sort(f))
13− sys.stderr.write('{0}: {1}\n'.format(f, t))
benchmarks/python/strip_tags.pydeleted−25
@@ -1,25 +0,0 @@
1−#!/usr/bin/env python
2−
3−import utils, sys
4−
5−def strip_tags(filename):
6− string = open(filename, encoding='utf-8').read()
7−
8− d = 0
9− out = []
10−
11− for c in string:
12− if c == '<': d += 1
13−
14− if d > 0:
15− out += ' '
16− else:
17− out += c
18−
19− if c == '>': d -= 1
20−
21− print(''.join(out))
22−
23−for f in sys.argv[1:]:
24− t = utils.benchmark(lambda: strip_tags(f))
25− sys.stderr.write('{0}: {1}\n'.format(f, t))
benchmarks/python/utils.pydeleted−18
@@ -1,18 +0,0 @@
1−#!/usr/bin/env python
2−
3−import sys, time
4−
5−def benchmark_once(f):
6− start = time.time()
7− f()
8− end = time.time()
9− return end - start
10−
11−def benchmark(f):
12− runs = 100
13− total = 0.0
14− for i in range(runs):
15− result = benchmark_once(f)
16− sys.stderr.write('Run {0}: {1}\n'.format(i, result))
17− total += result
18− return total / runs
benchmarks/ruby/cut.rbdeleted−16
@@ -1,16 +0,0 @@
1−#!/usr/bin/env ruby
2−
3−require './utils.rb'
4−
5−def cut(filename, l, r)
6− File.open(filename, 'r:utf-8') do |file|
7− file.each_line do |line|
8− puts line[l, r - l]
9− end
10− end
11−end
12−
13−ARGV.each do |f|
14− t = benchmark { cut(f, 20, 40) }
15− STDERR.puts "#{f}: #{t}"
16−end
benchmarks/ruby/fold.rbdeleted−50
@@ -1,50 +0,0 @@
1−#!/usr/bin/env ruby
2−
3−require './utils.rb'
4−
5−def fold(filename, max_width)
6− File.open(filename, 'r:utf-8') do |file|
7− # Words in this paragraph
8− paragraph = []
9−
10− file.each_line do |line|
11− # If we encounter an empty line, we reformat and dump the current
12− # paragraph
13− if line.strip.empty?
14− puts fold_paragraph(paragraph, max_width)
15− puts
16− paragraph = []
17− # Otherwise, we append the words found in the line to the paragraph
18− else
19− paragraph.concat line.split
20− end
21− end
22−
23− # Last paragraph
24− puts fold_paragraph(paragraph, max_width) unless paragraph.empty?
25− end
26−end
27−
28−# Fold a single paragraph to the desired width
29−def fold_paragraph(paragraph, max_width)
30− # Gradually build our output
31− str, *rest = paragraph
32− width = str.length
33−
34− rest.each do |word|
35− if width + word.length + 1 <= max_width
36− str << ' ' << word
37− width += word.length + 1
38− else
39− str << "\n" << word
40− width = word.length
41− end
42− end
43−
44− str
45−end
46−
47−ARGV.each do |f|
48− t = benchmark { fold(f, 80) }
49− STDERR.puts "#{f}: #{t}"
50−end
benchmarks/ruby/sort.rbdeleted−15
@@ -1,15 +0,0 @@
1−#!/usr/bin/env ruby
2−
3−require './utils.rb'
4−
5−def sort(filename)
6− File.open(filename, 'r:utf-8') do |file|
7− content = file.read
8− puts content.lines.sort.join
9− end
10−end
11−
12−ARGV.each do |f|
13− t = benchmark { sort(f) }
14− STDERR.puts "#{f}: #{t}"
15−end
benchmarks/ruby/strip_tags.rbdeleted−22
@@ -1,22 +0,0 @@
1−#!/usr/bin/env ruby
2−
3−require './utils.rb'
4−
5−def strip_tags(filename)
6− File.open(filename, 'r:utf-8') do |file|
7− str = file.read
8−
9− d = 0
10−
11− str.each_char do |c|
12− d += 1 if c == '<'
13− putc(if d > 0 then ' ' else c end)
14− d -= 1 if c == '>'
15− end
16− end
17−end
18−
19−ARGV.each do |f|
20− t = benchmark { strip_tags(f) }
21− STDERR.puts "#{f}: #{t}"
22−end
benchmarks/ruby/utils.rbdeleted−14
@@ -1,14 +0,0 @@
1−require 'benchmark'
2−
3−def benchmark(&block)
4− runs = 100
5− total = 0
6−
7− runs.times do |i|
8− result = Benchmark.measure(&block).total
9− $stderr.puts "Run #{i}: #{result}"
10− total += result
11− end
12−
13− total / runs
14−end
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.cdeleted−311
@@ -1,311 +0,0 @@
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>
10−#include <stdint.h>
11−#include <stdio.h>
12−#include "text_cbits.h"
13−
14−void _hs_text_memcpy(void *dest, size_t doff, const void *src, size_t soff,
15− size_t n)
16−{
17− memcpy(dest + (doff<<1), src + (soff<<1), n<<1);
18−}
19−
20−int _hs_text_memcmp(const void *a, size_t aoff, const void *b, size_t boff,
21− size_t n)
22−{
23− return memcmp(a + (aoff<<1), b + (boff<<1), n<<1);
24−}
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/ApiCompare.hs+2−6
@@ -17,12 +17,8 @@ main = do
17 S.difference a b
17 S.difference a b
18 text <- tidy "Data.Text"
18 text <- tidy "Data.Text"
19 lazy <- tidy "Data.Text.Lazy"
19 lazy <- tidy "Data.Text.Lazy"
20− list <- tidy "Data.List"
20+ putStrLn "In Data.Text:"
21− putStrLn "Text \\ List:"
22− diff text list
23− putStrLn ""
24− putStrLn "Text \\ Lazy:"
25 diff text lazy
21 diff text lazy
26 putStrLn ""
22 putStrLn ""
27− putStrLn "Lazy \\ Text:"
23+ putStrLn "In Data.Text.Lazy:"
28 diff lazy text
24 diff lazy text
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/.ghcideleted−1
@@ -1 +0,0 @@
1−:set -DHAVE_DEEPSEQ -isrc -i../..
tests/Benchmarks.hsnew file+441
@@ -0,0 +1,441 @@
1+{-# LANGUAGE BangPatterns, GADTs, MagicHash #-}
2+
3+import qualified Data.ByteString.Char8 as BS
4+import qualified Data.ByteString.Lazy.Char8 as BL
5+import qualified Data.ByteString.Lazy.Internal as BL
6+import Control.Monad.Trans (liftIO)
7+import Control.Exception (evaluate)
8+import Criterion.Main
9+import Data.Char
10+import Data.Monoid (mappend, mempty)
11+import qualified Codec.Binary.UTF8.Generic as UTF8
12+import qualified Data.Text as TS
13+import qualified Data.Text.IO as TS
14+import qualified Data.Text.Lazy as TL
15+import qualified Data.Text.Lazy.Builder as TB
16+import qualified Data.Text.Lazy.IO as TL
17+import qualified Data.List as L
18+import qualified Data.Text.Encoding as TS
19+import qualified Data.Text.Lazy.Encoding as TL
20+import qualified Criterion.MultiMap as M
21+import Control.DeepSeq
22+import Criterion.Config
23+import GHC.Base
24+
25+
26+myConfig
27+ | False = defaultConfig {
28+ -- Always display an 800x600 window.
29+ cfgPlot = M.singleton KernelDensity (Window 800 600)
30+ }
31+ | otherwise = defaultConfig
32+
33+instance NFData BS.ByteString
34+
35+instance NFData BL.ByteString where
36+ rnf BL.Empty = ()
37+ rnf (BL.Chunk _ ts) = rnf ts
38+
39+data B where
40+ B :: NFData a => a -> B
41+
42+instance NFData B where
43+ rnf (B b) = rnf b
44+
45+main = do
46+ let dataFile = "text/test/russian.txt"
47+ bsa <- BS.readFile dataFile
48+ let tsa = TS.decodeUtf8 bsa
49+ tsb = TS.toUpper tsa
50+ tla = TL.fromChunks (TS.chunksOf 16376 tsa)
51+ tlb = TL.fromChunks (TS.chunksOf 16376 tsb)
52+ bsb = TS.encodeUtf8 tsb
53+ bla = BL.fromChunks (chunksOf 16376 bsa)
54+ blb = BL.fromChunks (chunksOf 16376 bsb)
55+ bsa_len = BS.length bsa
56+ tsa_len = TS.length tsa
57+ bla_len = BL.length bla
58+ tla_len = TL.length tla
59+ la = UTF8.toString bsa
60+ la_len = L.length la
61+ tsb_len = TS.length tsb
62+ lb = TS.unpack tsb
63+ bsl = BS.lines bsa
64+ bll = BL.lines bla
65+ tsl = TS.lines tsa
66+ tll = TL.lines tla
67+ ll = L.lines la
68+ defaultMainWith
69+ myConfig
70+ (liftIO . evaluate $
71+ rnf [B tsa, B tsb, B tla, B tlb, B bsa, B bsb, B bla, B blb,
72+ B bsa_len, B tsa_len, B bla_len, B tla_len, B la, B la_len,
73+ B tsb_len, B lb, B bsl, B bll, B tsl, B tll, B ll])
74+ [
75+ bgroup "append" [
76+ bench "ts" $ nf (TS.append tsb) tsa
77+ , bench "tl" $ nf (TL.append tlb) tla
78+ , bench "bs" $ nf (BS.append bsb) bsa
79+ , bench "bl" $ nf (BL.append blb) bla
80+ , bench "l" $ nf ((++) lb) la
81+ ],
82+ bgroup "concat" [
83+ bench "ts" $ nf TS.concat tsl
84+ , bench "tl" $ nf TL.concat tll
85+ , bench "bs" $ nf BS.concat bsl
86+ , bench "bl" $ nf BL.concat bll
87+ , bench "l" $ nf L.concat ll
88+ ],
89+ bgroup "cons" [
90+ bench "ts" $ nf (TS.cons c) tsa
91+ , bench "tl" $ nf (TL.cons c) tla
92+ , bench "bs" $ nf (BS.cons c) bsa
93+ , bench "bl" $ nf (BL.cons c) bla
94+ , bench "l" $ nf (c:) la
95+ ],
96+ bgroup "concatMap" [
97+ bench "ts" $ nf (TS.concatMap (TS.replicate 3 . TS.singleton)) tsa
98+ , bench "tl" $ nf (TL.concatMap (TL.replicate 3 . TL.singleton)) tla
99+ , bench "bs" $ nf (BS.concatMap (BS.replicate 3)) bsa
100+ , bench "bl" $ nf (BL.concatMap (BL.replicate 3)) bla
101+ , bench "l" $ nf (L.concatMap (L.replicate 3 . (:[]))) la
102+ ],
103+ bgroup "decode" [
104+ bench "ts" $ nf TS.decodeUtf8 bsa
105+ , bench "tl" $ nf TL.decodeUtf8 bla
106+ , bench "bs" $ nf BS.unpack bsa
107+ , bench "bl" $ nf BL.unpack bla
108+ , bench "l" $ nf UTF8.toString bsa
109+ ],
110+ bgroup "drop" [
111+ bench "ts" $ nf (TS.drop (tsa_len `div` 3)) tsa
112+ , bench "tl" $ nf (TL.drop (tla_len `div` 3)) tla
113+ , bench "bs" $ nf (BS.drop (bsa_len `div` 3)) bsa
114+ , bench "bl" $ nf (BL.drop (bla_len `div` 3)) bla
115+ , bench "l" $ nf (L.drop (la_len `div` 3)) la
116+ ],
117+ bgroup "filter" [
118+ bench "ts" $ nf (TS.filter p0) tsa
119+ , bench "tl" $ nf (TL.filter p0) tla
120+ , bench "bs" $ nf (BS.filter p0) bsa
121+ , bench "bl" $ nf (BL.filter p0) bla
122+ , bench "l" $ nf (L.filter p0) la
123+ ],
124+ bgroup "filter.filter" [
125+ bench "ts" $ nf (TS.filter p1 . TS.filter p0) tsa
126+ , bench "tl" $ nf (TL.filter p1 . TL.filter p0) tla
127+ , bench "bs" $ nf (BS.filter p1 . BS.filter p0) bsa
128+ , bench "bl" $ nf (BL.filter p1 . BL.filter p0) bla
129+ , bench "l" $ nf (L.filter p1 . L.filter p0) la
130+ ],
131+ bgroup "foldl'" [
132+ bench "ts" $ nf (TS.foldl' len 0) tsa
133+ , bench "tl" $ nf (TL.foldl' len 0) tla
134+ , bench "bs" $ nf (BS.foldl' len 0) bsa
135+ , bench "bl" $ nf (BL.foldl' len 0) bla
136+ , bench "l" $ nf (L.foldl' len 0) la
137+ ],
138+ bgroup "foldr" [
139+ bench "ts" $ nf (L.length . TS.foldr (:) []) tsa
140+ , bench "tl" $ nf (L.length . TL.foldr (:) []) tla
141+ , bench "bs" $ nf (L.length . BS.foldr (:) []) bsa
142+ , bench "bl" $ nf (L.length . BL.foldr (:) []) bla
143+ , bench "l" $ nf (L.length . L.foldr (:) []) la
144+ ],
145+ bgroup "head" [
146+ bench "ts" $ nf TS.head tsa
147+ , bench "tl" $ nf TL.head tla
148+ , bench "bs" $ nf BS.head bsa
149+ , bench "bl" $ nf BL.head bla
150+ , bench "l" $ nf L.head la
151+ ],
152+ bgroup "init" [
153+ bench "ts" $ nf TS.init tsa
154+ , bench "tl" $ nf TL.init tla
155+ , bench "bs" $ nf BS.init bsa
156+ , bench "bl" $ nf BL.init bla
157+ , bench "l" $ nf L.init la
158+ ],
159+ bgroup "intercalate" [
160+ bench "ts" $ nf (TS.intercalate tsw) tsl
161+ , bench "tl" $ nf (TL.intercalate tlw) tll
162+ , bench "bs" $ nf (BS.intercalate bsw) bsl
163+ , bench "bl" $ nf (BL.intercalate blw) bll
164+ , bench "l" $ nf (L.intercalate lw) ll
165+ ],
166+ bgroup "intersperse" [
167+ bench "ts" $ nf (TS.intersperse c) tsa
168+ , bench "tl" $ nf (TL.intersperse c) tla
169+ , bench "bs" $ nf (BS.intersperse c) bsa
170+ , bench "bl" $ nf (BL.intersperse c) bla
171+ , bench "l" $ nf (L.intersperse c) la
172+ ],
173+ bgroup "isInfixOf" [
174+ bench "ts" $ nf (TS.isInfixOf tsw) tsa
175+ , bench "tl" $ nf (TL.isInfixOf tlw) tla
176+ , bench "bs" $ nf (BS.isInfixOf bsw) bsa
177+ -- no isInfixOf for lazy bytestrings
178+ , bench "l" $ nf (L.isInfixOf lw) la
179+ ],
180+ bgroup "last" [
181+ bench "ts" $ nf TS.last tsa
182+ , bench "tl" $ nf TL.last tla
183+ , bench "bs" $ nf BS.last bsa
184+ , bench "bl" $ nf BL.last bla
185+ , bench "l" $ nf L.last la
186+ ],
187+ bgroup "map" [
188+ bench "ts" $ nf (TS.map f) tsa
189+ , bench "tl" $ nf (TL.map f) tla
190+ , bench "bs" $ nf (BS.map f) bsa
191+ , bench "bl" $ nf (BL.map f) bla
192+ , bench "l" $ nf (L.map f) la
193+ ],
194+ bgroup "map.map" [
195+ bench "ts" $ nf (TS.map f . TS.map f) tsa
196+ , bench "tl" $ nf (TL.map f . TL.map f) tla
197+ , bench "bs" $ nf (BS.map f . BS.map f) bsa
198+ , bench "bl" $ nf (BL.map f . BL.map f) bla
199+ , bench "l" $ nf (L.map f . L.map f) la
200+ ],
201+ bgroup "readFile" [
202+ bench "ts" $ TS.readFile dataFile
203+ , bench "tl" $ nfIO (TL.readFile dataFile)
204+ , bench "bs" $ BS.readFile dataFile
205+ , bench "bl" $ nfIO (BL.length `fmap` BL.readFile dataFile)
206+ , bench "l" $ nfIO (length `fmap` readFile dataFile)
207+ ],
208+ bgroup "replicate char" [
209+ bench "ts" $ nf (TS.replicate bsa_len) (TS.singleton c)
210+ , bench "tl" $ nf (TL.replicate (fromIntegral bsa_len)) (TL.singleton c)
211+ , bench "bs" $ nf (BS.replicate bsa_len) c
212+ , bench "bl" $ nf (BL.replicate (fromIntegral bsa_len)) c
213+ , bench "l" $ nf (L.replicate bsa_len) c
214+ ],
215+ bgroup "replicate string" [
216+ bench "ts" $ nf (TS.replicate (bsa_len `div` TS.length tsw)) tsw
217+ , bench "tl" $ nf (TL.replicate (fromIntegral bsa_len `div` TL.length tlw)) tlw
218+ , bench "l" $ nf (replicat (bsa_len `div` TS.length tsw)) lw
219+ ],
220+ bgroup "reverse" [
221+ bench "ts" $ nf TS.reverse tsa
222+ , bench "tl" $ nf TL.reverse tla
223+ , bench "bs" $ nf BS.reverse bsa
224+ , bench "bl" $ nf BL.reverse bla
225+ , bench "l" $ nf L.reverse la
226+ ],
227+ bgroup "take" [
228+ bench "ts" $ nf (TS.take (tsa_len `div` 3)) tsa
229+ , bench "tl" $ nf (TL.take (tla_len `div` 3)) tla
230+ , bench "bs" $ nf (BS.take (bsa_len `div` 3)) bsa
231+ , bench "bl" $ nf (BL.take (bla_len `div` 3)) bla
232+ , bench "l" $ nf (L.take (la_len `div` 3)) la
233+ ],
234+ bgroup "tail" [
235+ bench "ts" $ nf TS.tail tsa
236+ , bench "tl" $ nf TL.tail tla
237+ , bench "bs" $ nf BS.tail bsa
238+ , bench "bl" $ nf BL.tail bla
239+ , bench "l" $ nf L.tail la
240+ ],
241+ bgroup "toLower" [
242+ bench "ts" $ nf TS.toLower tsa
243+ , bench "tl" $ nf TL.toLower tla
244+ , bench "bs" $ nf (BS.map toLower) bsa
245+ , bench "bl" $ nf (BL.map toLower) bla
246+ , bench "l" $ nf (L.map toLower) la
247+ ],
248+ bgroup "toUpper" [
249+ bench "ts" $ nf TS.toUpper tsa
250+ , bench "tl" $ nf TL.toUpper tla
251+ , bench "bs" $ nf (BS.map toUpper) bsa
252+ , bench "bl" $ nf (BL.map toUpper) bla
253+ , bench "l" $ nf (L.map toUpper) la
254+ ],
255+ bgroup "words" [
256+ bench "ts" $ nf TS.words tsa
257+ , bench "tl" $ nf TL.words tla
258+ , bench "bs" $ nf BS.words bsa
259+ , bench "bl" $ nf BL.words bla
260+ , bench "l" $ nf L.words la
261+ ],
262+ bgroup "zipWith" [
263+ bench "ts" $ nf (TS.zipWith min tsb) tsa
264+ , bench "tl" $ nf (TL.zipWith min tlb) tla
265+ , bench "bs" $ nf (BS.zipWith min bsb) bsa
266+ , bench "bl" $ nf (BL.zipWith min blb) bla
267+ , bench "l" $ nf (L.zipWith min lb) la
268+ ],
269+ bgroup "length" [
270+ bgroup "cons" [
271+ bench "ts" $ nf (TS.length . TS.cons c) tsa
272+ , bench "tl" $ nf (TL.length . TL.cons c) tla
273+ , bench "bs" $ nf (BS.length . BS.cons c) bsa
274+ , bench "bl" $ nf (BL.length . BL.cons c) bla
275+ , bench "l" $ nf (L.length . (:) c) la
276+ ],
277+ bgroup "decode" [
278+ bench "ts" $ nf (TS.length . TS.decodeUtf8) bsa
279+ , bench "tl" $ nf (TL.length . TL.decodeUtf8) bla
280+ , bench "bs" $ nf (L.length . BS.unpack) bsa
281+ , bench "bl" $ nf (L.length . BL.unpack) bla
282+ , bench "utf8-string" $ nf (L.length . UTF8.toString) bsa
283+ ],
284+ bgroup "drop" [
285+ bench "ts" $ nf (TS.length . TS.drop (tsa_len `div` 3)) tsa
286+ , bench "tl" $ nf (TL.length . TL.drop (tla_len `div` 3)) tla
287+ , bench "bs" $ nf (BS.length . BS.drop (bsa_len `div` 3)) bsa
288+ , bench "bl" $ nf (BL.length . BL.drop (bla_len `div` 3)) bla
289+ , bench "l" $ nf (L.length . L.drop (la_len `div` 3)) la
290+ ],
291+ bgroup "filter" [
292+ bench "ts" $ nf (TS.length . TS.filter p0) tsa
293+ , bench "tl" $ nf (TL.length . TL.filter p0) tla
294+ , bench "bs" $ nf (BS.length . BS.filter p0) bsa
295+ , bench "bl" $ nf (BL.length . BL.filter p0) bla
296+ , bench "l" $ nf (L.length . L.filter p0) la
297+ ],
298+ bgroup "filter.filter" [
299+ bench "ts" $ nf (TS.length . TS.filter p1 . TS.filter p0) tsa
300+ , bench "tl" $ nf (TL.length . TL.filter p1 . TL.filter p0) tla
301+ , bench "bs" $ nf (BS.length . BS.filter p1 . BS.filter p0) bsa
302+ , bench "bl" $ nf (BL.length . BL.filter p1 . BL.filter p0) bla
303+ , bench "l" $ nf (L.length . L.filter p1 . L.filter p0) la
304+ ],
305+ bgroup "init" [
306+ bench "ts" $ nf (TS.length . TS.init) tsa
307+ , bench "tl" $ nf (TL.length . TL.init) tla
308+ , bench "bs" $ nf (BS.length . BS.init) bsa
309+ , bench "bl" $ nf (BL.length . BL.init) bla
310+ , bench "l" $ nf (L.length . L.init) la
311+ ],
312+ bgroup "intercalate" [
313+ bench "ts" $ nf (TS.length . TS.intercalate tsw) tsl
314+ , bench "tl" $ nf (TL.length . TL.intercalate tlw) tll
315+ , bench "bs" $ nf (BS.length . BS.intercalate bsw) bsl
316+ , bench "bl" $ nf (BL.length . BL.intercalate blw) bll
317+ , bench "l" $ nf (L.length . L.intercalate lw) ll
318+ ],
319+ bgroup "intersperse" [
320+ bench "ts" $ nf (TS.length . TS.intersperse c) tsa
321+ , bench "tl" $ nf (TL.length . TL.intersperse c) tla
322+ , bench "bs" $ nf (BS.length . BS.intersperse c) bsa
323+ , bench "bl" $ nf (BL.length . BL.intersperse c) bla
324+ , bench "l" $ nf (L.length . L.intersperse c) la
325+ ],
326+ bgroup "map" [
327+ bench "ts" $ nf (TS.length . TS.map f) tsa
328+ , bench "tl" $ nf (TL.length . TL.map f) tla
329+ , bench "bs" $ nf (BS.length . BS.map f) bsa
330+ , bench "bl" $ nf (BL.length . BL.map f) bla
331+ , bench "l" $ nf (L.length . L.map f) la
332+ ],
333+ bgroup "map.map" [
334+ bench "ts" $ nf (TS.length . TS.map f . TS.map f) tsa
335+ , bench "tl" $ nf (TL.length . TL.map f . TL.map f) tla
336+ , bench "bs" $ nf (BS.length . BS.map f . BS.map f) bsa
337+ , bench "l" $ nf (L.length . L.map f . L.map f) la
338+ ],
339+ bgroup "replicate char" [
340+ bench "ts" $ nf (TS.length . TS.replicate bsa_len) (TS.singleton c)
341+ , bench "tl" $ nf (TL.length . TL.replicate (fromIntegral bsa_len)) (TL.singleton c)
342+ , bench "bs" $ nf (BS.length . BS.replicate bsa_len) c
343+ , bench "bl" $ nf (BL.length . BL.replicate (fromIntegral bsa_len)) c
344+ , bench "l" $ nf (L.length . L.replicate bsa_len) c
345+ ],
346+ bgroup "replicate string" [
347+ bench "ts" $ nf (TS.length . TS.replicate (bsa_len `div` TS.length tsw)) tsw
348+ , bench "tl" $ nf (TL.length . TL.replicate (fromIntegral bsa_len `div` TL.length tlw)) tlw
349+ , bench "l" $ nf (L.length . replicat (bsa_len `div` TS.length tsw)) lw
350+ ],
351+ bgroup "take" [
352+ bench "ts" $ nf (TS.length . TS.take (tsa_len `div` 3)) tsa
353+ , bench "tl" $ nf (TL.length . TL.take (tla_len `div` 3)) tla
354+ , bench "bs" $ nf (BS.length . BS.take (bsa_len `div` 3)) bsa
355+ , bench "bl" $ nf (BL.length . BL.take (bla_len `div` 3)) bla
356+ , bench "l" $ nf (L.length . L.take (la_len `div` 3)) la
357+ ],
358+ bgroup "tail" [
359+ bench "ts" $ nf (TS.length . TS.tail) tsa
360+ , bench "tl" $ nf (TL.length . TL.tail) tla
361+ , bench "bs" $ nf (BS.length . BS.tail) bsa
362+ , bench "bl" $ nf (BL.length . BL.tail) bla
363+ , bench "l" $ nf (L.length . L.tail) la
364+ ],
365+ bgroup "toLower" [
366+ bench "ts" $ nf (TS.length . TS.toLower) tsa
367+ , bench "tl" $ nf (TL.length . TL.toLower) tla
368+ , bench "bs" $ nf (BS.length . BS.map toLower) bsa
369+ , bench "bl" $ nf (BL.length . BL.map toLower) bla
370+ , bench "l" $ nf (L.length . L.map toLower) la
371+ ],
372+ bgroup "toUpper" [
373+ bench "ts" $ nf (TS.length . TS.toUpper) tsa
374+ , bench "tl" $ nf (TL.length . TL.toUpper) tla
375+ , bench "bs" $ nf (BS.length . BS.map toUpper) bsa
376+ , bench "bl" $ nf (BL.length . BL.map toUpper) bla
377+ , bench "l" $ nf (L.length . L.map toUpper) la
378+ ],
379+ bgroup "words" [
380+ bench "ts" $ nf (L.length . TS.words) tsa
381+ , bench "tl" $ nf (L.length . TL.words) tla
382+ , bench "bs" $ nf (L.length . BS.words) bsa
383+ , bench "bl" $ nf (L.length . BL.words) bla
384+ , bench "l" $ nf (L.length . L.words) la
385+ ],
386+ bgroup "zipWith" [
387+ bench "ts" $ nf (TS.length . TS.zipWith min tsb) tsa
388+ , bench "tl" $ nf (TL.length . TL.zipWith min tlb) tla
389+ , bench "bs" $ nf (L.length . BS.zipWith min bsb) bsa
390+ , bench "bl" $ nf (L.length . BL.zipWith min blb) bla
391+ , bench "l" $ nf (L.length . L.zipWith min lb) la
392+ ]
393+ ],
394+ bgroup "builder" [
395+ bench "mappend char" $ nf (TL.length . TB.toLazyText . mappendNChar 'a') 10000,
396+ bench "mappend 8 char" $ nf (TL.length . TB.toLazyText . mappend8Char) 'a',
397+ bench "mappend text" $ nf (TL.length . TB.toLazyText . mappendNText short) 10000
398+ ]
399+ ]
400+ where
401+ c = 'й'
402+ p0 = (== c)
403+ p1 = (/= 'д')
404+ lw = "право"
405+ bsw = UTF8.fromString lw
406+ blw = BL.fromChunks [bsw]
407+ tsw = TS.pack lw
408+ tlw = TL.fromChunks [tsw]
409+ f (C# c#) = C# (chr# (ord# c# +# 1#))
410+ len l _ = l + (1::Int)
411+ replicat n = concat . L.replicate n
412+ short = TS.pack "short"
413+
414+chunksOf :: Int -> BS.ByteString -> [BS.ByteString]
415+chunksOf k = go
416+ where
417+ go t = case BS.splitAt k t of
418+ (a,b) | BS.null a -> []
419+ | otherwise -> a : go b
420+
421+mappendNChar :: Char -> Int -> TB.Builder
422+mappendNChar c n = go 0
423+ where
424+ go i
425+ | i < n = TB.singleton c `mappend` go (i+1)
426+ | otherwise = mempty
427+
428+-- Gives more opportunity for inlining and elimination of unnecesary
429+-- bounds checks.
430+mappend8Char :: Char -> TB.Builder
431+mappend8Char c = TB.singleton c `mappend` TB.singleton c `mappend`
432+ TB.singleton c `mappend` TB.singleton c `mappend`
433+ TB.singleton c `mappend` TB.singleton c `mappend`
434+ TB.singleton c `mappend` TB.singleton c
435+
436+mappendNText :: TS.Text -> Int -> TB.Builder
437+mappendNText t n = go 0
438+ where
439+ go i
440+ | i < n = TB.fromText t `mappend` go (i+1)
441+ | otherwise = mempty
tests/Chartem.hsnew file+153
@@ -0,0 +1,153 @@
1+{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}
2+
3+import Data.Char
4+import Control.Monad (forM_)
5+import Data.Accessor ((^=))
6+import Data.Function
7+import Data.Maybe
8+import Data.List
9+import Debug.Trace
10+import Data.Text (Text)
11+import Data.Text.Encoding (decodeUtf8)
12+import Graphics.Rendering.Chart
13+import Graphics.Rendering.Chart.Gtk (renderableToWindow)
14+import System.Environment (getArgs)
15+import Text.Printf
16+import qualified Data.ByteString as B
17+import qualified Data.Map as M
18+import qualified Data.Text as T
19+
20+data Row = Row {
21+ rowName :: !Text
22+ , rowMean :: !Double
23+ , rowMeanLB :: !Double
24+ , rowMeanUB :: !Double
25+ , rowStdDev :: !Double
26+ , rowStdDevLB :: !Double
27+ , rowStdDevUB :: !Double
28+ } deriving (Show)
29+
30+parseRow :: Text -> Row
31+parseRow = f . T.split ","
32+ where f [n,m,ml,mu,s,sl,su] = Row {
33+ rowName = n
34+ , rowMean = r m
35+ , rowMeanLB = r ml
36+ , rowMeanUB = r mu
37+ , rowStdDev = r s
38+ , rowStdDevLB = r sl
39+ , rowStdDevUB = r su
40+ }
41+ r = read . T.unpack
42+
43+readCSV :: FilePath -> IO [Row]
44+readCSV = fmap (map parseRow . tail . T.lines . decodeUtf8) . B.readFile
45+
46+groupRows :: [Row] -> M.Map Text [Row]
47+groupRows = M.map (sortBy (compare `on` rowName)) . foldr f M.empty
48+ where f r m = let (p,s) = T.breakEnd "/" (rowName r)
49+ in M.insertWith' (++) (T.init . T.tail $ p)
50+ [r { rowName = T.init s}] m
51+
52+main = do
53+ args <- getArgs
54+ groups <- mapM (fmap groupRows . readCSV) args
55+ let dd = M.unionsWith (++) . map (M.map (:[])) $ groups
56+ forM_ (M.toList dd) $ \(tdesc,rows) -> do
57+ let desc = T.unpack tdesc
58+ if False
59+ then renderableToWindow (renderMark desc rows) 400 160
60+ else renderableToPNGFile (renderMark desc rows) 400 160
61+ (printf "time-%s.png" (map clean desc))
62+ where clean '/' = '-'
63+ clean c | isSpace c = '-'
64+ | otherwise = c
65+
66+instance BarsPlotValue LogValue where
67+ barsReference = LogValue 1e-300
68+ barsAdd (LogValue a) (LogValue b) = LogValue (a * b)
69+
70+renderMark :: String -> [[Row]] -> Renderable ()
71+renderMark desc rows
72+ | useLog = toRenderable linLayout
73+ | otherwise = toRenderable logLayout
74+ where
75+ useLog = minimum (map minimum values) >= maximum (map maximum values) / 25
76+ values = transpose . map (map rowMean) $ rows
77+ keys = map git (head rows)
78+ where git r = let n = T.unpack . rowName $ r
79+ in maybe n id . flip lookup mappings $ n
80+ mappings = [("bl", "lazy BS"), ("bs", "strict BS"), ("l", "list"),
81+ ("tl", "lazy T"), ("ts", "strict T")]
82+
83+ linLayout = layout1_title ^= "Timings for \"" ++ desc ++ "\""
84+ $ layout1_plots ^= [ Left (plotBars linBars) ]
85+ $ layout1_left_axis ^= linLeftAxis
86+ $ layout1_bottom_axis ^= bottomAxis
87+ $ defaultLayout1 :: Layout1 Double Double
88+
89+ logLayout = layout1_title ^= "Timings for \"" ++ desc ++
90+ "\" (log scale)"
91+ $ layout1_plots ^= [ Left (plotBars logBars) ]
92+ $ layout1_left_axis ^= logLeftAxis
93+ $ layout1_bottom_axis ^= bottomAxis
94+ $ defaultLayout1 :: Layout1 Double LogValue
95+
96+ logLeftAxis = laxis_generate ^= autoScaledLogAxis logSecAxis
97+ $ laxis_reverse ^= False
98+ $ defaultLayoutAxis
99+
100+ linLeftAxis = laxis_generate ^= autoScaledAxis linSecAxis
101+ $ defaultLayoutAxis
102+
103+ bottomAxis = laxis_generate ^= autoScaledAxis typeAxis
104+ $ defaultLayoutAxis
105+
106+ linBars = plot_bars_values ^= (zip [0.5,1.5..] values)
107+ $ defaultPlotBars
108+
109+ logBars = plot_bars_values ^= (zip [0.5,1.5..] . map (map LogValue) $ values)
110+ $ defaultPlotBars
111+
112+ typeAxis = la_labelf ^= (ix keys . floor)
113+ $ la_nLabels ^= length keys
114+ $ defaultLinearAxis
115+
116+ ix (x:xs) n | n <= 0 = x
117+ | otherwise = ix xs (n-1)
118+ ix [] _ = ""
119+
120+ linSecAxis = la_labelf ^= secs
121+ $ defaultLinearAxis
122+
123+ logSecAxis = loga_labelf ^= (secs . fromLV)
124+ $ defaultLogAxis
125+
126+ fromLV (LogValue v) = v
127+
128+-- | Try to render meaningful time-axis labels.
129+--
130+-- /FIXME/: Trouble is, we need to know the range of times for this to
131+-- work properly, so that we don't accidentally display consecutive
132+-- values that appear identical (e.g. \"43 ms, 43 ms\").
133+secs :: Double -> String
134+secs k
135+ | k < 0 = '-' : secs (-k)
136+ | k >= 1e9 = (k/1e9) `with` "Gs"
137+ | k >= 1e6 = (k/1e6) `with` "Ms"
138+ | k >= 1e4 = (k/1e3) `with` "Ks"
139+ | k >= 1 = k `with` "s"
140+ | k >= 1e-3 = (k*1e3) `with` "ms"
141+ | k >= 1e-6 = (k*1e6) `with` "µs"
142+ | k >= 1e-9 = (k*1e9) `with` "ns"
143+ | k >= 1e-12 = (k*1e12) `with` "ps"
144+ | otherwise = printf "%g s" k
145+ where with (t :: Double) (u :: String)
146+ | t >= 1e9 = printf "%.4g %s" t u
147+ | t >= 1e6 = printf "%.0f %s" t u
148+ | t >= 1e5 = printf "%.0f %s" t u
149+ | t >= 1e4 = printf "%.0f %s" t u
150+ | t >= 1e3 = printf "%.0f %s" t u
151+ | t >= 1e2 = printf "%.0f %s" t u
152+ | t >= 1e1 = printf "%.0f %s" t u
153+ | otherwise = printf "%.0f %s" t u
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/Makefile+70−29
@@ -1,40 +1,81 @@
1−count = 1000
1+version := $(shell awk '/^version:/{print $$2}' ../text.cabal)
2+ghc := ghc
3+ghc-opt-flags = -O0
4+ghc-base-flags := -funbox-strict-fields -package criterion -package deepseq \
5+ -package bytestring -ignore-package text \
6+ -fno-ignore-asserts
7+ghc-test-flags := -package QuickCheck -package test-framework -package deepseq \
8+ -package test-framework-quickcheck2 -package test-framework-hunit \
9+ -package HUnit
10+ghc-base-flags += -Wall -fno-warn-orphans -fno-warn-missing-signatures
11+ghc-flags := $(ghc-base-flags) -i../dist/build -package-name text-$(version)
12+ghc-hpc-flags := $(ghc-base-flags) -fhpc -fno-ignore-asserts -odir hpcdir \
13+ -hidir hpcdir -i..
14+lib := ../dist/build/libHStext-$(version).a
15+lib-srcs := $(shell grep '^ *Data' ../text.cabal | \
16+ sed -e 's,\.,/,g' -e 's,$$,.hs,')
2
17
3−all: coverage literal-rule-test
18+cabal := $(shell which cabal 2>/dev/null)
4
19
5−literal-rule-test:
20+all: bm qc coverage regressions
6− ./literal-rule-test.sh
7
21
8−coverage: build coverage/hpc_index.html
22+lib: $(lib)
9
23
10−build: text-test-data
24+$(lib): $(lib-srcs:%=../%)
11− cabal configure -fhpc
25+ifeq ($(cabal),)
26+ cd .. && runghc Setup configure --user --prefix=$(HOME)
27+ cd .. && runghc Setup build
28+else
29+ cd .. && cabal configure
12− cabal build
30+ cd .. && cabal build
31+endif
13
32
14−text-test-data:
33+Properties.o qc qc-hpc: ghc-flags += $(ghc-test-flags)
15− hg clone https://bitbucket.org/bos/text-test-data
34+Properties.o: QuickCheckUtils.o SlowFunctions.o
16− $(MAKE) -C text-test-data
17
35
18−coverage/text-tests.tix:
36+QuickCheckUtils.o: $(lib)
19− -mkdir -p coverage
20− ./dist/build/text-tests/text-tests -a $(count)
21− mv text-tests.tix $@
22
37
23−coverage/text-tests-stdio.tix:
38+qc: Properties.o QuickCheckUtils.o SlowFunctions.o
24− -mkdir -p coverage
39+ $(ghc) $(ghc-flags) -threaded -o $@ $^ $(lib)
25− ./scripts/cover-stdio.sh ./dist/build/text-tests-stdio/text-tests-stdio
26− mv text-tests-stdio.tix $@
27
40
28−coverage/coverage.tix: coverage/text-tests.tix coverage/text-tests-stdio.tix
41+sb: SearchBench.o SlowFunctions.o
29− hpc combine --output=$@ \
42+ $(ghc) $(ghc-flags) -threaded -o $@ $^ $(lib)
30− --exclude=Main \
31− coverage/text-tests.tix \
32− coverage/text-tests-stdio.tix
33
43
34−coverage/hpc_index.html: coverage/coverage.tix
44+qc-hpc: Properties.hs QuickCheckUtils.hs $(lib-srcs:%=../%)
35− hpc markup --destdir=coverage coverage/coverage.tix
45+ -mkdir -p hpcdir
46+ @rm -f $@.tix
47+ $(ghc) $(ghc-hpc-flags) $(ghc-opt-flags) -ihpcdir \
48+ --make -threaded -o $@ $<
36
49
37−clean:
50+regressions: Regressions.o
38− rm -rf dist coverage .hpc
51+ $(ghc) $(ghc-test-flags) -o $@ $^ $(lib)
52+
53+coverage: qc-hpc-html/hpc_index.html
54+
55+qc-hpc-html/hpc_index.html: qc-hpc
56+ ./qc-hpc -a 100 +RTS -N2
57+ hpc markup qc-hpc --exclude=Main --exclude=Properties \
58+ --exclude=Data.Text.Fusion.CaseMapping \
59+ --exclude=QuickCheckUtils --srcdir=.. --srcdir=. --destdir=$(dir $@)
60+
61+Benchmarks.o: ghc-opt-flags = -O
62+bm Benchmarks.o: ghc-flags += -hide-package transformers -package utf8-string
63+bm: Benchmarks.o
64+ $(ghc) $(ghc-flags) -o $@ $^ $(lib)
65+
66+SlowFunctions.o: ghc-opt-flags = -O2
67+SearchBench.o: ghc-opt-flags = -O
68+%.o: %.hs
69+ $(ghc) $(ghc-flags) $(ghc-opt-flags) -c -o $@ $<
39
70
40−.PHONY: build coverage all literal-rule-test
71+hpcdir/%.o: %.hs
72+ $(ghc) $(ghc-hpc-flags) $(ghc-opt-flags) --make -c -o $@ $<
73+
74+.PHONY: testdata
75+testdata: text-testdata.tar.bz2
76+
77+text-testdata.tar.bz2:
78+ curl -O http://projects.haskell.org/text/text-testdata.tar.bz2
79+
80+clean:
81+ -rm -rf *.o *.hi *.tix bm qc qc-hpc hpcdir .hpc qc-hpc-html
tests/Properties.hsnew file+947
@@ -0,0 +1,947 @@
1+{-# LANGUAGE BangPatterns, FlexibleInstances, OverloadedStrings,
2+ ScopedTypeVariables, TypeSynonymInstances #-}
3+{-# OPTIONS_GHC -fno-enable-rewrite-rules #-}
4+
5+import Test.QuickCheck
6+import Text.Show.Functions ()
7+
8+import qualified Data.Bits as Bits (shiftL, shiftR)
9+import Data.Char (chr, isLower, isSpace, isUpper, ord)
10+import Data.Monoid (Monoid(..))
11+import Data.String (fromString)
12+import Debug.Trace (trace)
13+import Control.Arrow ((***), second)
14+import Data.Word (Word8, Word16, Word32)
15+import qualified Data.Text as T
16+import qualified Data.Text.Lazy as TL
17+import qualified Data.Text.Lazy.Builder as TB
18+import qualified Data.Text.Encoding as E
19+import Control.Exception (SomeException, evaluate, try)
20+import qualified Data.Text.Fusion as S
21+import qualified Data.Text.Fusion.Common as S
22+import Data.Text.Fusion.Size
23+import qualified Data.Text.Lazy.Encoding as EL
24+import qualified Data.Text.Lazy.Fusion as SL
25+import qualified Data.Text.UnsafeShift as U
26+import qualified Data.List as L
27+import Prelude hiding (replicate)
28+import System.IO.Unsafe (unsafePerformIO)
29+import Test.Framework (defaultMain, testGroup)
30+import Test.Framework.Providers.QuickCheck2 (testProperty)
31+import Data.Text.Search (indices)
32+import qualified Data.Text.Lazy.Search as S (indices)
33+import qualified SlowFunctions as Slow
34+
35+import QuickCheckUtils (NotEmpty(..), small)
36+
37+-- Ensure that two potentially bottom values (in the sense of crashing
38+-- for some inputs, not looping infinitely) either both crash, or both
39+-- give comparable results for some input.
40+(=^=) :: (Eq a, Show a) => a -> a -> Bool
41+{-# NOINLINE (=^=) #-}
42+i =^= j = unsafePerformIO $ do
43+ x <- try (evaluate i)
44+ y <- try (evaluate j)
45+ case (x,y) of
46+ (Left (_ :: SomeException), Left (_ :: SomeException))
47+ -> return True
48+ (Right a, Right b) -> return (a == b)
49+ e -> trace ("*** Divergence: " ++ show e) return False
50+infix 4 =^=
51+
52+t_pack_unpack = (T.unpack . T.pack) `eq` id
53+tl_pack_unpack = (TL.unpack . TL.pack) `eq` id
54+t_stream_unstream = (S.unstream . S.stream) `eq` id
55+tl_stream_unstream = (SL.unstream . SL.stream) `eq` id
56+t_reverse_stream t = (S.reverse . S.reverseStream) t == t
57+t_singleton c = [c] == (T.unpack . T.singleton) c
58+tl_singleton c = [c] == (TL.unpack . TL.singleton) c
59+tl_unstreamChunks x = f 11 x == f 1000 x
60+ where f n = SL.unstreamChunks n . S.streamList
61+tl_chunk_unchunk = (TL.fromChunks . TL.toChunks) `eq` id
62+
63+t_ascii t = E.decodeASCII (E.encodeUtf8 a) == a
64+ where a = T.map (\c -> chr (ord c `mod` 128)) t
65+t_utf8 = (E.decodeUtf8 . E.encodeUtf8) `eq` id
66+tl_utf8 = (EL.decodeUtf8 . EL.encodeUtf8) `eq` id
67+t_utf16LE = (E.decodeUtf16LE . E.encodeUtf16LE) `eq` id
68+t_utf16BE = (E.decodeUtf16BE . E.encodeUtf16BE) `eq` id
69+t_utf32LE = (E.decodeUtf32LE . E.encodeUtf32LE) `eq` id
70+t_utf32BE = (E.decodeUtf32BE . E.encodeUtf32BE) `eq` id
71+
72+class Stringy s where
73+ packS :: String -> s
74+ unpackS :: s -> String
75+ splitAtS :: Int -> s -> (s,s)
76+ packSChunkSize :: Int -> String -> s
77+ packSChunkSize _ = packS
78+
79+instance Stringy String where
80+ packS = id
81+ unpackS = id
82+ splitAtS = splitAt
83+
84+instance Stringy (S.Stream Char) where
85+ packS = S.streamList
86+ unpackS = S.unstreamList
87+ splitAtS n s = (S.take n s, S.drop n s)
88+
89+instance Stringy T.Text where
90+ packS = T.pack
91+ unpackS = T.unpack
92+ splitAtS = T.splitAt
93+
94+instance Stringy TL.Text where
95+ packSChunkSize k = SL.unstreamChunks k . S.streamList
96+ packS = TL.pack
97+ unpackS = TL.unpack
98+ splitAtS = TL.splitAt . fromIntegral
99+
100+-- Do two functions give the same answer?
101+eq :: (Eq a, Show a) => (t -> a) -> (t -> a) -> t -> Bool
102+eq a b s = a s =^= b s
103+
104+-- What about with the RHS packed?
105+eqP :: (Eq a, Show a, Stringy s) =>
106+ (String -> a) -> (s -> a) -> String -> Word8 -> Bool
107+eqP f g s w = eql "orig" (f s) (g t) &&
108+ eql "mini" (f s) (g mini) &&
109+ eql "head" (f sa) (g ta) &&
110+ eql "tail" (f sb) (g tb)
111+ where t = packS s
112+ mini = packSChunkSize 10 s
113+ (sa,sb) = splitAt m s
114+ (ta,tb) = splitAtS m t
115+ l = length s
116+ m | l == 0 = n
117+ | otherwise = n `mod` l
118+ n = fromIntegral w
119+ eql d a b | a =^= b = True
120+ | otherwise = trace (d ++ ": " ++ show a ++ " /= " ++ show b) False
121+
122+-- For tests that have O(n^2) running times or input sizes, resize
123+-- their inputs to the square root of the originals.
124+unsquare :: (Arbitrary a, Show a, Testable b) => (a -> b) -> Property
125+unsquare = forAll . sized $ \n -> resize (smallish n) arbitrary
126+ where smallish = round . (sqrt :: Double -> Double) . fromIntegral
127+
128+s_Eq s = (s==) `eq` ((S.streamList s==) . S.streamList)
129+ where _types = s :: String
130+sf_Eq p s =
131+ ((L.filter p s==) . L.filter p) `eq`
132+ (((S.filter p $ S.streamList s)==) . S.filter p . S.streamList)
133+t_Eq s = (s==) `eq` ((T.pack s==) . T.pack)
134+tl_Eq s = (s==) `eq` ((TL.pack s==) . TL.pack)
135+s_Ord s = (compare s) `eq` (compare (S.streamList s) . S.streamList)
136+ where _types = s :: String
137+sf_Ord p s =
138+ ((compare $ L.filter p s) . L.filter p) `eq`
139+ (compare (S.filter p $ S.streamList s) . S.filter p . S.streamList)
140+t_Ord s = (compare s) `eq` (compare (T.pack s) . T.pack)
141+tl_Ord s = (compare s) `eq` (compare (TL.pack s) . TL.pack)
142+t_Read = id `eq` (T.unpack . read . show)
143+tl_Read = id `eq` (TL.unpack . read . show)
144+t_Show = show `eq` (show . T.pack)
145+tl_Show = show `eq` (show . TL.pack)
146+t_mappend s = mappend s`eqP` (unpackS . mappend (T.pack s))
147+tl_mappend s = mappend s`eqP` (unpackS . mappend (TL.pack s))
148+t_mconcat = unsquare (mconcat `eq` (unpackS . mconcat . L.map T.pack))
149+tl_mconcat = unsquare (mconcat `eq` (unpackS . mconcat . L.map TL.pack))
150+t_IsString = fromString `eqP` (T.unpack . fromString)
151+tl_IsString = fromString `eqP` (TL.unpack . fromString)
152+
153+s_cons x = (x:) `eqP` (unpackS . S.cons x)
154+s_cons_s x = (x:) `eqP` (unpackS . S.unstream . S.cons x)
155+sf_cons p x = ((x:) . L.filter p) `eqP` (unpackS . S.cons x . S.filter p)
156+t_cons x = (x:) `eqP` (unpackS . T.cons x)
157+tl_cons x = (x:) `eqP` (unpackS . TL.cons x)
158+s_snoc x = (++ [x]) `eqP` (unpackS . (flip S.snoc) x)
159+t_snoc x = (++ [x]) `eqP` (unpackS . (flip T.snoc) x)
160+tl_snoc x = (++ [x]) `eqP` (unpackS . (flip TL.snoc) x)
161+s_append s = (s++) `eqP` (unpackS . S.append (S.streamList s))
162+s_append_s s = (s++) `eqP` (unpackS . S.unstream . S.append (S.streamList s))
163+sf_append p s = (L.filter p s++) `eqP` (unpackS . S.append (S.filter p $ S.streamList s))
164+t_append s = (s++) `eqP` (unpackS . T.append (packS s))
165+
166+uncons (x:xs) = Just (x,xs)
167+uncons _ = Nothing
168+
169+s_uncons = uncons `eqP` (fmap (second unpackS) . S.uncons)
170+sf_uncons p = (uncons . L.filter p) `eqP` (fmap (second unpackS) . S.uncons . S.filter p)
171+t_uncons = uncons `eqP` (fmap (second unpackS) . T.uncons)
172+tl_uncons = uncons `eqP` (fmap (second unpackS) . TL.uncons)
173+s_head = head `eqP` S.head
174+sf_head p = (head . L.filter p) `eqP` (S.head . S.filter p)
175+t_head = head `eqP` T.head
176+tl_head = head `eqP` TL.head
177+s_last = last `eqP` S.last
178+sf_last p = (last . L.filter p) `eqP` (S.last . S.filter p)
179+t_last = last `eqP` T.last
180+tl_last = last `eqP` TL.last
181+s_tail = tail `eqP` (unpackS . S.tail)
182+s_tail_s = tail `eqP` (unpackS . S.unstream . S.tail)
183+sf_tail p = (tail . L.filter p) `eqP` (unpackS . S.tail . S.filter p)
184+t_tail = tail `eqP` (unpackS . T.tail)
185+tl_tail = tail `eqP` (unpackS . TL.tail)
186+s_init = init `eqP` (unpackS . S.init)
187+s_init_s = init `eqP` (unpackS . S.unstream . S.init)
188+sf_init p = (init . L.filter p) `eqP` (unpackS . S.init . S.filter p)
189+t_init = init `eqP` (unpackS . T.init)
190+tl_init = init `eqP` (unpackS . TL.init)
191+s_null = null `eqP` S.null
192+sf_null p = (null . L.filter p) `eqP` (S.null . S.filter p)
193+t_null = null `eqP` T.null
194+tl_null = null `eqP` TL.null
195+s_length = length `eqP` S.length
196+sf_length p = (length . L.filter p) `eqP` (S.length . S.filter p)
197+t_length = length `eqP` T.length
198+tl_length = L.genericLength `eqP` TL.length
199+
200+s_map f = map f `eqP` (unpackS . S.map f)
201+s_map_s f = map f `eqP` (unpackS . S.unstream . S.map f)
202+sf_map p f = (map f . L.filter p) `eqP` (unpackS . S.map f . S.filter p)
203+t_map f = map f `eqP` (unpackS . T.map f)
204+tl_map f = map f `eqP` (unpackS . TL.map f)
205+t_intercalate c = unsquare (L.intercalate c `eq` (unpackS . T.intercalate (packS c) . map packS))
206+tl_intercalate c = unsquare (L.intercalate c `eq` (unpackS . TL.intercalate (TL.pack c) . map TL.pack))
207+s_intersperse c = L.intersperse c `eqP` (unpackS . S.intersperse c)
208+s_intersperse_s c = L.intersperse c `eqP` (unpackS . S.unstream . S.intersperse c)
209+sf_intersperse p c= (L.intersperse c . L.filter p) `eqP` (unpackS . S.intersperse c . S.filter p)
210+t_intersperse c = L.intersperse c `eqP` (unpackS . T.intersperse c)
211+tl_intersperse c = L.intersperse c `eqP` (unpackS . TL.intersperse c)
212+t_transpose = unsquare (L.transpose `eq` (map unpackS . T.transpose . map packS))
213+tl_transpose = unsquare (L.transpose `eq` (map unpackS . TL.transpose . map TL.pack))
214+t_reverse = L.reverse `eqP` (unpackS . T.reverse)
215+tl_reverse = L.reverse `eqP` (unpackS . TL.reverse)
216+t_reverse_short n = L.reverse `eqP` (unpackS . S.reverse . shorten n . S.stream)
217+
218+t_replace s d = (L.intercalate d . split s) `eqP` (unpackS . T.replace (T.pack s) (T.pack d))
219+tl_replace s d = (L.intercalate d . split s) `eqP` (unpackS . TL.replace (TL.pack s) (TL.pack d))
220+
221+split :: (Eq a) => [a] -> [a] -> [[a]]
222+split pat src0
223+ | l == 0 = error "empty"
224+ | otherwise = go src0
225+ where
226+ l = length pat
227+ go src = search 0 src
228+ where
229+ search _ [] = [src]
230+ search !n s@(_:s')
231+ | pat `L.isPrefixOf` s = take n src : go (drop l s)
232+ | otherwise = search (n+1) s'
233+
234+s_toCaseFold_length xs = S.length (S.toCaseFold s) >= length xs
235+ where s = S.streamList xs
236+sf_toCaseFold_length p xs =
237+ (S.length . S.toCaseFold . S.filter p $ s) >= (length . L.filter p $ xs)
238+ where s = S.streamList xs
239+t_toCaseFold_length t = T.length (T.toCaseFold t) >= T.length t
240+tl_toCaseFold_length t = TL.length (TL.toCaseFold t) >= TL.length t
241+t_toLower_length t = T.length (T.toLower t) >= T.length t
242+t_toLower_lower t = p (T.toLower t) >= p t
243+ where p = T.length . T.filter isLower
244+tl_toLower_lower t = p (TL.toLower t) >= p t
245+ where p = TL.length . TL.filter isLower
246+t_toUpper_length t = T.length (T.toUpper t) >= T.length t
247+t_toUpper_upper t = p (T.toUpper t) >= p t
248+ where p = T.length . T.filter isUpper
249+tl_toUpper_upper t = p (TL.toUpper t) >= p t
250+ where p = TL.length . TL.filter isUpper
251+
252+justifyLeft k c s = s ++ L.replicate (k - length s) c
253+justifyRight m n s = L.replicate (m - length s) n ++ s
254+
255+s_justifyLeft k c = justifyLeft j c `eqP` (unpackS . S.justifyLeftI j c)
256+ where j = fromIntegral (k :: Word8)
257+s_justifyLeft_s k c = justifyLeft j c `eqP` (unpackS . S.unstream . S.justifyLeftI j c)
258+ where j = fromIntegral (k :: Word8)
259+sf_justifyLeft p k c = (justifyLeft j c . L.filter p) `eqP`
260+ (unpackS . S.justifyLeftI j c . S.filter p)
261+ where j = fromIntegral (k :: Word8)
262+t_justifyLeft k c = justifyLeft j c `eqP` (unpackS . T.justifyLeft j c)
263+ where j = fromIntegral (k :: Word8)
264+tl_justifyLeft k c = justifyLeft j c `eqP` (unpackS . TL.justifyLeft (fromIntegral j) c)
265+ where j = fromIntegral (k :: Word8)
266+t_justifyRight k c = justifyRight j c `eqP` (unpackS . T.justifyRight j c)
267+ where j = fromIntegral (k :: Word8)
268+tl_justifyRight k c = justifyRight j c `eqP` (unpackS . TL.justifyRight (fromIntegral j) c)
269+ where j = fromIntegral (k :: Word8)
270+
271+sf_foldl p f z = (L.foldl f z . L.filter p) `eqP` (S.foldl f z . S.filter p)
272+ where _types = f :: Char -> Char -> Char
273+t_foldl f z = L.foldl f z `eqP` (T.foldl f z)
274+ where _types = f :: Char -> Char -> Char
275+tl_foldl f z = L.foldl f z `eqP` (TL.foldl f z)
276+ where _types = f :: Char -> Char -> Char
277+sf_foldl' p f z = (L.foldl' f z . L.filter p) `eqP` (S.foldl' f z . S.filter p)
278+ where _types = f :: Char -> Char -> Char
279+t_foldl' f z = L.foldl' f z `eqP` T.foldl' f z
280+ where _types = f :: Char -> Char -> Char
281+tl_foldl' f z = L.foldl' f z `eqP` TL.foldl' f z
282+ where _types = f :: Char -> Char -> Char
283+sf_foldl1 p f = (L.foldl1 f . L.filter p) `eqP` (S.foldl1 f . S.filter p)
284+t_foldl1 f = L.foldl1 f `eqP` T.foldl1 f
285+tl_foldl1 f = L.foldl1 f `eqP` TL.foldl1 f
286+sf_foldl1' p f = (L.foldl1' f . L.filter p) `eqP` (S.foldl1' f . S.filter p)
287+t_foldl1' f = L.foldl1' f `eqP` T.foldl1' f
288+tl_foldl1' f = L.foldl1' f `eqP` TL.foldl1' f
289+sf_foldr p f z = (L.foldr f z . L.filter p) `eqP` (S.foldr f z . S.filter p)
290+ where _types = f :: Char -> Char -> Char
291+t_foldr f z = L.foldr f z `eqP` T.foldr f z
292+ where _types = f :: Char -> Char -> Char
293+tl_foldr f z = L.foldr f z `eqP` TL.foldr f z
294+ where _types = f :: Char -> Char -> Char
295+sf_foldr1 p f = (L.foldr1 f . L.filter p) `eqP` (S.foldr1 f . S.filter p)
296+t_foldr1 f = L.foldr1 f `eqP` T.foldr1 f
297+tl_foldr1 f = L.foldr1 f `eqP` TL.foldr1 f
298+
299+s_concat_s = unsquare (L.concat `eq` (unpackS . S.unstream . S.concat . map packS))
300+sf_concat p = unsquare ((L.concat . map (L.filter p)) `eq` (unpackS . S.concat . map (S.filter p . packS)))
301+t_concat = unsquare (L.concat `eq` (unpackS . T.concat . map packS))
302+tl_concat = unsquare (L.concat `eq` (unpackS . TL.concat . map TL.pack))
303+sf_concatMap p f = unsquare ((L.concatMap f . L.filter p) `eqP` (unpackS . S.concatMap (packS . f) . S.filter p))
304+t_concatMap f = unsquare (L.concatMap f `eqP` (unpackS . T.concatMap (packS . f)))
305+tl_concatMap f = unsquare (L.concatMap f `eqP` (unpackS . TL.concatMap (TL.pack . f)))
306+sf_any q p = (L.any p . L.filter q) `eqP` (S.any p . S.filter q)
307+t_any p = L.any p `eqP` T.any p
308+tl_any p = L.any p `eqP` TL.any p
309+sf_all q p = (L.all p . L.filter q) `eqP` (S.all p . S.filter q)
310+t_all p = L.all p `eqP` T.all p
311+tl_all p = L.all p `eqP` TL.all p
312+sf_maximum p = (L.maximum . L.filter p) `eqP` (S.maximum . S.filter p)
313+t_maximum = L.maximum `eqP` T.maximum
314+tl_maximum = L.maximum `eqP` TL.maximum
315+sf_minimum p = (L.minimum . L.filter p) `eqP` (S.minimum . S.filter p)
316+t_minimum = L.minimum `eqP` T.minimum
317+tl_minimum = L.minimum `eqP` TL.minimum
318+
319+sf_scanl p f z = (L.scanl f z . L.filter p) `eqP` (unpackS . S.scanl f z . S.filter p)
320+t_scanl f z = L.scanl f z `eqP` (unpackS . T.scanl f z)
321+tl_scanl f z = L.scanl f z `eqP` (unpackS . TL.scanl f z)
322+t_scanl1 f = L.scanl1 f `eqP` (unpackS . T.scanl1 f)
323+tl_scanl1 f = L.scanl1 f `eqP` (unpackS . TL.scanl1 f)
324+t_scanr f z = L.scanr f z `eqP` (unpackS . T.scanr f z)
325+tl_scanr f z = L.scanr f z `eqP` (unpackS . TL.scanr f z)
326+t_scanr1 f = L.scanr1 f `eqP` (unpackS . T.scanr1 f)
327+tl_scanr1 f = L.scanr1 f `eqP` (unpackS . TL.scanr1 f)
328+
329+t_mapAccumL f z = unsquare (L.mapAccumL f z `eqP` (second unpackS . T.mapAccumL f z))
330+ where _types = f :: Int -> Char -> (Int,Char)
331+tl_mapAccumL f z = unsquare (L.mapAccumL f z `eqP` (second unpackS . TL.mapAccumL f z))
332+ where _types = f :: Int -> Char -> (Int,Char)
333+t_mapAccumR f z = unsquare (L.mapAccumR f z `eqP` (second unpackS . T.mapAccumR f z))
334+ where _types = f :: Int -> Char -> (Int,Char)
335+tl_mapAccumR f z = unsquare (L.mapAccumR f z `eqP` (second unpackS . TL.mapAccumR f z))
336+ where _types = f :: Int -> Char -> (Int,Char)
337+
338+replicate n l = concat (L.replicate n l)
339+
340+t_replicate n = replicate m `eq` (unpackS . T.replicate m . packS)
341+ where m = fromIntegral (n :: Word8)
342+tl_replicate n = replicate m `eq` (unpackS . TL.replicate (fromIntegral m) . packS)
343+ where m = fromIntegral (n :: Word8)
344+
345+unf :: Int -> Char -> Maybe (Char, Char)
346+unf n c | fromEnum c * 100 > n = Nothing
347+ | otherwise = Just (c, succ c)
348+
349+t_unfoldr n = L.unfoldr (unf m) `eq` (unpackS . T.unfoldr (unf m))
350+ where m = fromIntegral (n :: Word16)
351+tl_unfoldr n = L.unfoldr (unf m) `eq` (unpackS . TL.unfoldr (unf m))
352+ where m = fromIntegral (n :: Word16)
353+t_unfoldrN n m = (L.take i . L.unfoldr (unf j)) `eq`
354+ (unpackS . T.unfoldrN i (unf j))
355+ where i = fromIntegral (n :: Word16)
356+ j = fromIntegral (m :: Word16)
357+tl_unfoldrN n m = (L.take i . L.unfoldr (unf j)) `eq`
358+ (unpackS . TL.unfoldrN (fromIntegral i) (unf j))
359+ where i = fromIntegral (n :: Word16)
360+ j = fromIntegral (m :: Word16)
361+
362+unpack2 :: (Stringy s) => (s,s) -> (String,String)
363+unpack2 = unpackS *** unpackS
364+
365+s_take n = L.take n `eqP` (unpackS . S.take n)
366+s_take_s m = L.take n `eqP` (unpackS . S.unstream . S.take n)
367+ where n = small m
368+sf_take p n = (L.take n . L.filter p) `eqP` (unpackS . S.take n . S.filter p)
369+t_take n = L.take n `eqP` (unpackS . T.take n)
370+tl_take n = L.take n `eqP` (unpackS . TL.take (fromIntegral n))
371+s_drop n = L.drop n `eqP` (unpackS . S.drop n)
372+s_drop_s m = L.drop n `eqP` (unpackS . S.unstream . S.drop n)
373+ where n = small m
374+sf_drop p n = (L.drop n . L.filter p) `eqP` (unpackS . S.drop n . S.filter p)
375+t_drop n = L.drop n `eqP` (unpackS . T.drop n)
376+tl_drop n = L.drop n `eqP` (unpackS . TL.drop (fromIntegral n))
377+s_take_drop m = (L.take n . L.drop n) `eqP` (unpackS . S.take n . S.drop n)
378+ where n = small m
379+s_take_drop_s m = (L.take n . L.drop n) `eqP` (unpackS . S.unstream . S.take n . S.drop n)
380+ where n = small m
381+s_takeWhile p = L.takeWhile p `eqP` (unpackS . S.takeWhile p)
382+s_takeWhile_s p = L.takeWhile p `eqP` (unpackS . S.unstream . S.takeWhile p)
383+sf_takeWhile q p = (L.takeWhile p . L.filter q) `eqP` (unpackS . S.takeWhile p . S.filter q)
384+t_takeWhile p = L.takeWhile p `eqP` (unpackS . T.takeWhile p)
385+tl_takeWhile p = L.takeWhile p `eqP` (unpackS . TL.takeWhile p)
386+s_dropWhile p = L.dropWhile p `eqP` (unpackS . S.dropWhile p)
387+s_dropWhile_s p = L.dropWhile p `eqP` (unpackS . S.unstream . S.dropWhile p)
388+sf_dropWhile q p = (L.dropWhile p . L.filter q) `eqP` (unpackS . S.dropWhile p . S.filter q)
389+t_dropWhile p = L.dropWhile p `eqP` (unpackS . T.dropWhile p)
390+tl_dropWhile p = L.dropWhile p `eqP` (unpackS . S.dropWhile p)
391+t_dropWhileEnd p = (L.reverse . L.dropWhile p . L.reverse) `eqP` (unpackS . T.dropWhileEnd p)
392+tl_dropWhileEnd p = (L.reverse . L.dropWhile p . L.reverse) `eqP` (unpackS . TL.dropWhileEnd p)
393+t_dropAround p = (L.dropWhile p . L.reverse . L.dropWhile p . L.reverse) `eqP` (unpackS . T.dropAround p)
394+tl_dropAround p = (L.dropWhile p . L.reverse . L.dropWhile p . L.reverse) `eqP` (unpackS . TL.dropAround p)
395+t_stripStart = T.dropWhile isSpace `eq` T.stripStart
396+tl_stripStart = TL.dropWhile isSpace `eq` TL.stripStart
397+t_stripEnd = T.dropWhileEnd isSpace `eq` T.stripEnd
398+tl_stripEnd = TL.dropWhileEnd isSpace `eq` TL.stripEnd
399+t_strip = T.dropAround isSpace `eq` T.strip
400+tl_strip = TL.dropAround isSpace `eq` TL.strip
401+t_splitAt n = L.splitAt n `eqP` (unpack2 . T.splitAt n)
402+tl_splitAt n = L.splitAt n `eqP` (unpack2 . TL.splitAt (fromIntegral n))
403+t_spanBy p = L.span p `eqP` (unpack2 . T.spanBy p)
404+tl_spanBy p = L.span p `eqP` (unpack2 . TL.spanBy p)
405+
406+t_break_id s = squid `eq` (uncurry T.append . T.break s)
407+ where squid t | T.null s = error "empty"
408+ | otherwise = t
409+tl_break_id s = squid `eq` (uncurry TL.append . TL.break s)
410+ where squid t | TL.null s = error "empty"
411+ | otherwise = t
412+t_break_start (NotEmpty s) t = let (_,m) = T.break s t
413+ in T.null m || s `T.isPrefixOf` m
414+tl_break_start (NotEmpty s) t = let (_,m) = TL.break s t
415+ in TL.null m || s `TL.isPrefixOf` m
416+t_breakBy p = L.break p `eqP` (unpack2 . T.breakBy p)
417+tl_breakBy p = L.break p `eqP` (unpack2 . TL.breakBy p)
418+t_group = L.group `eqP` (map unpackS . T.group)
419+tl_group = L.group `eqP` (map unpackS . TL.group)
420+t_groupBy p = L.groupBy p `eqP` (map unpackS . T.groupBy p)
421+tl_groupBy p = L.groupBy p `eqP` (map unpackS . TL.groupBy p)
422+t_inits = L.inits `eqP` (map unpackS . T.inits)
423+tl_inits = L.inits `eqP` (map unpackS . TL.inits)
424+t_tails = L.tails `eqP` (map unpackS . T.tails)
425+tl_tails = L.tails `eqP` (map unpackS . TL.tails)
426+t_findAppendId (NotEmpty s) = unsquare $ \ts ->
427+ let t = T.intercalate s ts
428+ in all (==t) $ map (uncurry T.append) (T.find s t)
429+tl_findAppendId (NotEmpty s) = unsquare $ \ts ->
430+ let t = TL.intercalate s ts
431+ in all (==t) $ map (uncurry TL.append) (TL.find s t)
432+t_findContains (NotEmpty s) = unsquare (all (T.isPrefixOf s . snd) . T.find s .
433+ T.intercalate s)
434+tl_findContains (NotEmpty s) = unsquare (all (TL.isPrefixOf s . snd) .
435+ TL.find s . TL.intercalate s)
436+t_findCount s = (L.length . T.find s) `eq` T.count s
437+tl_findCount s = (L.genericLength . TL.find s) `eq` TL.count s
438+
439+t_split_split s = unsquare ((T.split s `eq` Slow.split s) .
440+ T.intercalate s)
441+tl_split_split s = unsquare (((TL.split (chunkify s) . chunkify) `eq`
442+ (map chunkify . T.split s)) .
443+ T.intercalate s)
444+t_split_i (NotEmpty t) = id `eq` (T.intercalate t . T.split t)
445+tl_split_i (NotEmpty t) = id `eq` (TL.intercalate t . TL.split t)
446+
447+t_splitBy p = splitBy p `eqP` (map unpackS . T.splitBy p)
448+t_splitBy_count c = (L.length . T.splitBy (==c)) `eq` ((1+) . T.count (T.singleton c))
449+t_splitBy_split c = T.splitBy (==c) `eq` T.split (T.singleton c)
450+tl_splitBy p = splitBy p `eqP` (map unpackS . TL.splitBy p)
451+
452+splitBy :: (a -> Bool) -> [a] -> [[a]]
453+splitBy _ [] = [[]]
454+splitBy p xs = loop xs
455+ where loop s | null s' = [l]
456+ | otherwise = l : loop (tail s')
457+ where (l, s') = break p s
458+
459+t_chunksOf_same_lengths k = all ((==k) . T.length) . ini . T.chunksOf k
460+ where ini [] = []
461+ ini xs = init xs
462+
463+t_chunksOf_length k t = len == T.length t || (k <= 0 && len == 0)
464+ where len = L.sum . L.map T.length $ T.chunksOf k t
465+
466+chunkify = TL.fromChunks . (:[])
467+
468+tl_chunksOf k = T.chunksOf k `eq` (map (T.concat . TL.toChunks) . TL.chunksOf (fromIntegral k) . chunkify)
469+
470+t_lines = L.lines `eqP` (map unpackS . T.lines)
471+tl_lines = L.lines `eqP` (map unpackS . TL.lines)
472+{-
473+t_lines' = lines' `eqP` (map unpackS . T.lines')
474+ where lines' "" = []
475+ lines' s = let (l, s') = break eol s
476+ in l : case s' of
477+ [] -> []
478+ ('\r':'\n':s'') -> lines' s''
479+ (_:s'') -> lines' s''
480+ eol c = c == '\r' || c == '\n'
481+-}
482+t_words = L.words `eqP` (map unpackS . T.words)
483+
484+tl_words = L.words `eqP` (map unpackS . TL.words)
485+t_unlines = unsquare (L.unlines `eq` (unpackS . T.unlines . map packS))
486+tl_unlines = unsquare (L.unlines `eq` (unpackS . TL.unlines . map packS))
487+t_unwords = unsquare (L.unwords `eq` (unpackS . T.unwords . map packS))
488+tl_unwords = unsquare (L.unwords `eq` (unpackS . TL.unwords . map packS))
489+
490+s_isPrefixOf s = L.isPrefixOf s `eqP` (S.isPrefixOf (S.stream $ packS s) . S.stream)
491+sf_isPrefixOf p s = (L.isPrefixOf s . L.filter p) `eqP` (S.isPrefixOf (S.stream $ packS s) . S.filter p . S.stream)
492+t_isPrefixOf s = L.isPrefixOf s`eqP` T.isPrefixOf (packS s)
493+tl_isPrefixOf s = L.isPrefixOf s`eqP` TL.isPrefixOf (packS s)
494+t_isSuffixOf s = L.isSuffixOf s`eqP` T.isSuffixOf (packS s)
495+tl_isSuffixOf s = L.isSuffixOf s`eqP` TL.isSuffixOf (packS s)
496+t_isInfixOf s = L.isInfixOf s `eqP` T.isInfixOf (packS s)
497+tl_isInfixOf s = L.isInfixOf s `eqP` TL.isInfixOf (packS s)
498+
499+prefixed (p:ps) (t:ts)
500+ | p == t = prefixed ps ts
501+prefixed [] ts = Just ts
502+prefixed _ _ = Nothing
503+
504+t_prefixed s = (fmap packS . prefixed s) `eqP` T.prefixed (packS s)
505+tl_prefixed s = (fmap packS . prefixed s) `eqP` TL.prefixed (packS s)
506+
507+suffixed p t = reverse `fmap` prefixed (reverse p) (reverse t)
508+
509+t_suffixed s = (fmap packS . suffixed s) `eqP` T.suffixed (packS s)
510+tl_suffixed s = (fmap packS . suffixed s) `eqP` TL.suffixed (packS s)
511+
512+sf_elem p c = (L.elem c . L.filter p) `eqP` (S.elem c . S.filter p)
513+sf_filter q p = (L.filter p . L.filter q) `eqP` (unpackS . S.filter p . S.filter q)
514+t_filter p = L.filter p `eqP` (unpackS . T.filter p)
515+tl_filter p = L.filter p `eqP` (unpackS . TL.filter p)
516+sf_findBy q p = (L.find p . L.filter q) `eqP` (S.findBy p . S.filter q)
517+t_findBy p = L.find p `eqP` T.findBy p
518+tl_findBy p = L.find p `eqP` TL.findBy p
519+t_partition p = L.partition p `eqP` (unpack2 . T.partitionBy p)
520+tl_partition p = L.partition p `eqP` (unpack2 . TL.partitionBy p)
521+
522+sf_index p s = forAll (choose (-l,l*2)) ((L.filter p s L.!!) `eq` S.index (S.filter p $ packS s))
523+ where l = L.length s
524+t_index s = forAll (choose (-l,l*2)) ((s L.!!) `eq` T.index (packS s))
525+ where l = L.length s
526+
527+tl_index s = forAll (choose (-l,l*2)) ((s L.!!) `eq` (TL.index (packS s) . fromIntegral))
528+ where l = L.length s
529+
530+t_findIndex p = L.findIndex p `eqP` T.findIndex p
531+t_count t = (subtract 1 . L.length . T.split t) `eq` T.count t
532+tl_count t = (subtract 1 . L.genericLength . TL.split t) `eq` TL.count t
533+t_zip s = L.zip s `eqP` T.zip (packS s)
534+tl_zip s = L.zip s `eqP` TL.zip (packS s)
535+sf_zipWith p c s = (L.zipWith c (L.filter p s) . L.filter p) `eqP` (unpackS . S.zipWith c (S.filter p $ packS s) . S.filter p)
536+t_zipWith c s = L.zipWith c s `eqP` (unpackS . T.zipWith c (packS s))
537+tl_zipWith c s = L.zipWith c s `eqP` (unpackS . TL.zipWith c (packS s))
538+
539+t_indices = unsquare (\s -> Slow.indices s `eq` indices s)
540+tl_indices = unsquare (\s -> lazyIndices s `eq` S.indices s)
541+ where lazyIndices s t = map fromIntegral $ Slow.indices (conc s) (conc t)
542+ conc = T.concat . TL.toChunks
543+t_indices_occurs t = unsquare (\ts -> let s = T.intercalate t ts
544+ in Slow.indices t s == indices t s)
545+
546+-- Bit shifts.
547+shiftL w = forAll (choose (0,width-1)) $ \k -> Bits.shiftL w k == U.shiftL w k
548+ where width = round (log (fromIntegral m) / log 2 :: Double)
549+ (m,_) = (maxBound, m == w)
550+shiftR w = forAll (choose (0,width-1)) $ \k -> Bits.shiftR w k == U.shiftR w k
551+ where width = round (log (fromIntegral m) / log 2 :: Double)
552+ (m,_) = (maxBound, m == w)
553+
554+shiftL_Int = shiftL :: Int -> Property
555+shiftL_Word16 = shiftL :: Word16 -> Property
556+shiftL_Word32 = shiftL :: Word32 -> Property
557+shiftR_Int = shiftR :: Int -> Property
558+shiftR_Word16 = shiftR :: Word16 -> Property
559+shiftR_Word32 = shiftR :: Word32 -> Property
560+
561+-- Builder
562+t_builderSingleton = id `eqP` (unpackS . TB.toLazyText . mconcat . map TB.singleton)
563+t_builderFromText = L.concat `eq` (unpackS . TB.toLazyText . mconcat . map (TB.fromText . packS))
564+t_builderAssociative s1 s2 s3 = TB.toLazyText (b1 `mappend` (b2 `mappend` b3)) ==
565+ TB.toLazyText ((b1 `mappend` b2) `mappend` b3)
566+ where b1 = TB.fromText (packS s1)
567+ b2 = TB.fromText (packS s2)
568+ b3 = TB.fromText (packS s3)
569+
570+-- Regression tests.
571+s_filter_eq s = S.filter p t == S.streamList (filter p s)
572+ where p = (/= S.last t)
573+ t = S.streamList s
574+
575+-- Make a stream appear shorter than it really is, to ensure that
576+-- functions that consume inaccurately sized streams behave
577+-- themselves.
578+shorten :: Int -> S.Stream a -> S.Stream a
579+shorten n t@(S.Stream arr off len)
580+ | n > 0 = S.Stream arr off (smaller (exactSize n) len)
581+ | otherwise = t
582+
583+main = defaultMain tests
584+
585+tests = [
586+ testGroup "creation/elimination" [
587+ testProperty "t_pack_unpack" t_pack_unpack,
588+ testProperty "tl_pack_unpack" tl_pack_unpack,
589+ testProperty "t_stream_unstream" t_stream_unstream,
590+ testProperty "tl_stream_unstream" tl_stream_unstream,
591+ testProperty "t_reverse_stream" t_reverse_stream,
592+ testProperty "t_singleton" t_singleton,
593+ testProperty "tl_singleton" tl_singleton,
594+ testProperty "tl_unstreamChunks" tl_unstreamChunks,
595+ testProperty "tl_chunk_unchunk" tl_chunk_unchunk
596+ ],
597+
598+ testGroup "transcoding" [
599+ testProperty "t_ascii" t_ascii,
600+ testProperty "t_utf8" t_utf8,
601+ testProperty "tl_utf8" tl_utf8,
602+ testProperty "t_utf16LE" t_utf16LE,
603+ testProperty "t_utf16BE" t_utf16BE,
604+ testProperty "t_utf32LE" t_utf32LE,
605+ testProperty "t_utf32BE" t_utf32BE
606+ ],
607+
608+ testGroup "instances" [
609+ testProperty "s_Eq" s_Eq,
610+ testProperty "sf_Eq" sf_Eq,
611+ testProperty "t_Eq" t_Eq,
612+ testProperty "tl_Eq" tl_Eq,
613+ testProperty "s_Ord" s_Ord,
614+ testProperty "sf_Ord" sf_Ord,
615+ testProperty "t_Ord" t_Ord,
616+ testProperty "tl_Ord" tl_Ord,
617+ testProperty "t_Read" t_Read,
618+ testProperty "tl_Read" tl_Read,
619+ testProperty "t_Show" t_Show,
620+ testProperty "tl_Show" tl_Show,
621+ testProperty "t_mappend" t_mappend,
622+ testProperty "tl_mappend" tl_mappend,
623+ testProperty "t_mconcat" t_mconcat,
624+ testProperty "tl_mconcat" tl_mconcat,
625+ testProperty "t_IsString" t_IsString,
626+ testProperty "tl_IsString" tl_IsString
627+ ],
628+
629+ testGroup "basics" [
630+ testProperty "s_cons" s_cons,
631+ testProperty "s_cons_s" s_cons_s,
632+ testProperty "sf_cons" sf_cons,
633+ testProperty "t_cons" t_cons,
634+ testProperty "tl_cons" tl_cons,
635+ testProperty "s_snoc" s_snoc,
636+ testProperty "t_snoc" t_snoc,
637+ testProperty "tl_snoc" tl_snoc,
638+ testProperty "s_append" s_append,
639+ testProperty "s_append_s" s_append_s,
640+ testProperty "sf_append" sf_append,
641+ testProperty "t_append" t_append,
642+ testProperty "s_uncons" s_uncons,
643+ testProperty "sf_uncons" sf_uncons,
644+ testProperty "t_uncons" t_uncons,
645+ testProperty "tl_uncons" tl_uncons,
646+ testProperty "s_head" s_head,
647+ testProperty "sf_head" sf_head,
648+ testProperty "t_head" t_head,
649+ testProperty "tl_head" tl_head,
650+ testProperty "s_last" s_last,
651+ testProperty "sf_last" sf_last,
652+ testProperty "t_last" t_last,
653+ testProperty "tl_last" tl_last,
654+ testProperty "s_tail" s_tail,
655+ testProperty "s_tail_s" s_tail_s,
656+ testProperty "sf_tail" sf_tail,
657+ testProperty "t_tail" t_tail,
658+ testProperty "tl_tail" tl_tail,
659+ testProperty "s_init" s_init,
660+ testProperty "s_init_s" s_init_s,
661+ testProperty "sf_init" sf_init,
662+ testProperty "t_init" t_init,
663+ testProperty "tl_init" tl_init,
664+ testProperty "s_null" s_null,
665+ testProperty "sf_null" sf_null,
666+ testProperty "t_null" t_null,
667+ testProperty "tl_null" tl_null,
668+ testProperty "s_length" s_length,
669+ testProperty "sf_length" sf_length,
670+ testProperty "t_length" t_length,
671+ testProperty "tl_length" tl_length
672+ ],
673+
674+ testGroup "transformations" [
675+ testProperty "s_map" s_map,
676+ testProperty "s_map_s" s_map_s,
677+ testProperty "sf_map" sf_map,
678+ testProperty "t_map" t_map,
679+ testProperty "tl_map" tl_map,
680+ testProperty "t_intercalate" t_intercalate,
681+ testProperty "tl_intercalate" tl_intercalate,
682+ testProperty "s_intersperse" s_intersperse,
683+ testProperty "s_intersperse_s" s_intersperse_s,
684+ testProperty "sf_intersperse" sf_intersperse,
685+ testProperty "t_intersperse" t_intersperse,
686+ testProperty "tl_intersperse" tl_intersperse,
687+ testProperty "t_transpose" t_transpose,
688+ testProperty "tl_transpose" tl_transpose,
689+ testProperty "t_reverse" t_reverse,
690+ testProperty "tl_reverse" tl_reverse,
691+ testProperty "t_reverse_short" t_reverse_short,
692+ testProperty "t_replace" t_replace,
693+ testProperty "tl_replace" tl_replace,
694+
695+ testGroup "case conversion" [
696+ testProperty "s_toCaseFold_length" s_toCaseFold_length,
697+ testProperty "sf_toCaseFold_length" sf_toCaseFold_length,
698+ testProperty "t_toCaseFold_length" t_toCaseFold_length,
699+ testProperty "tl_toCaseFold_length" tl_toCaseFold_length,
700+ testProperty "t_toLower_length" t_toLower_length,
701+ testProperty "t_toLower_lower" t_toLower_lower,
702+ testProperty "tl_toLower_lower" tl_toLower_lower,
703+ testProperty "t_toUpper_length" t_toUpper_length,
704+ testProperty "t_toUpper_upper" t_toUpper_upper,
705+ testProperty "tl_toUpper_upper" tl_toUpper_upper
706+ ],
707+
708+ testGroup "justification" [
709+ testProperty "s_justifyLeft" s_justifyLeft,
710+ testProperty "s_justifyLeft_s" s_justifyLeft_s,
711+ testProperty "sf_justifyLeft" sf_justifyLeft,
712+ testProperty "t_justifyLeft" t_justifyLeft,
713+ testProperty "tl_justifyLeft" tl_justifyLeft,
714+ testProperty "t_justifyRight" t_justifyRight,
715+ testProperty "tl_justifyRight" tl_justifyRight
716+ ]
717+ ],
718+
719+ testGroup "folds" [
720+ testProperty "sf_foldl" sf_foldl,
721+ testProperty "t_foldl" t_foldl,
722+ testProperty "tl_foldl" tl_foldl,
723+ testProperty "sf_foldl'" sf_foldl',
724+ testProperty "t_foldl'" t_foldl',
725+ testProperty "tl_foldl'" tl_foldl',
726+ testProperty "sf_foldl1" sf_foldl1,
727+ testProperty "t_foldl1" t_foldl1,
728+ testProperty "tl_foldl1" tl_foldl1,
729+ testProperty "t_foldl1'" t_foldl1',
730+ testProperty "sf_foldl1'" sf_foldl1',
731+ testProperty "tl_foldl1'" tl_foldl1',
732+ testProperty "sf_foldr" sf_foldr,
733+ testProperty "t_foldr" t_foldr,
734+ testProperty "tl_foldr" tl_foldr,
735+ testProperty "sf_foldr1" sf_foldr1,
736+ testProperty "t_foldr1" t_foldr1,
737+ testProperty "tl_foldr1" tl_foldr1,
738+
739+ testGroup "special" [
740+ testProperty "s_concat_s" s_concat_s,
741+ testProperty "sf_concat" sf_concat,
742+ testProperty "t_concat" t_concat,
743+ testProperty "tl_concat" tl_concat,
744+ testProperty "sf_concatMap" sf_concatMap,
745+ testProperty "t_concatMap" t_concatMap,
746+ testProperty "tl_concatMap" tl_concatMap,
747+ testProperty "sf_any" sf_any,
748+ testProperty "t_any" t_any,
749+ testProperty "tl_any" tl_any,
750+ testProperty "sf_all" sf_all,
751+ testProperty "t_all" t_all,
752+ testProperty "tl_all" tl_all,
753+ testProperty "sf_maximum" sf_maximum,
754+ testProperty "t_maximum" t_maximum,
755+ testProperty "tl_maximum" tl_maximum,
756+ testProperty "sf_minimum" sf_minimum,
757+ testProperty "t_minimum" t_minimum,
758+ testProperty "tl_minimum" tl_minimum
759+ ]
760+ ],
761+
762+ testGroup "construction" [
763+ testGroup "scans" [
764+ testProperty "sf_scanl" sf_scanl,
765+ testProperty "t_scanl" t_scanl,
766+ testProperty "tl_scanl" tl_scanl,
767+ testProperty "t_scanl1" t_scanl1,
768+ testProperty "tl_scanl1" tl_scanl1,
769+ testProperty "t_scanr" t_scanr,
770+ testProperty "tl_scanr" tl_scanr,
771+ testProperty "t_scanr1" t_scanr1,
772+ testProperty "tl_scanr1" tl_scanr1
773+ ],
774+
775+ testGroup "mapAccum" [
776+ testProperty "t_mapAccumL" t_mapAccumL,
777+ testProperty "tl_mapAccumL" tl_mapAccumL,
778+ testProperty "t_mapAccumR" t_mapAccumR,
779+ testProperty "tl_mapAccumR" tl_mapAccumR
780+ ],
781+
782+ testGroup "unfolds" [
783+ testProperty "t_replicate" t_replicate,
784+ testProperty "tl_replicate" tl_replicate,
785+ testProperty "t_unfoldr" t_unfoldr,
786+ testProperty "tl_unfoldr" tl_unfoldr,
787+ testProperty "t_unfoldrN" t_unfoldrN,
788+ testProperty "tl_unfoldrN" tl_unfoldrN
789+ ]
790+ ],
791+
792+ testGroup "substrings" [
793+ testGroup "breaking" [
794+ testProperty "s_take" s_take,
795+ testProperty "s_take_s" s_take_s,
796+ testProperty "sf_take" sf_take,
797+ testProperty "t_take" t_take,
798+ testProperty "tl_take" tl_take,
799+ testProperty "s_drop" s_drop,
800+ testProperty "s_drop_s" s_drop_s,
801+ testProperty "sf_drop" sf_drop,
802+ testProperty "t_drop" t_drop,
803+ testProperty "tl_drop" tl_drop,
804+ testProperty "s_take_drop" s_take_drop,
805+ testProperty "s_take_drop_s" s_take_drop_s,
806+ testProperty "s_takeWhile" s_takeWhile,
807+ testProperty "s_takeWhile_s" s_takeWhile_s,
808+ testProperty "sf_takeWhile" sf_takeWhile,
809+ testProperty "t_takeWhile" t_takeWhile,
810+ testProperty "tl_takeWhile" tl_takeWhile,
811+ testProperty "sf_dropWhile" sf_dropWhile,
812+ testProperty "s_dropWhile" s_dropWhile,
813+ testProperty "s_dropWhile_s" s_dropWhile_s,
814+ testProperty "t_dropWhile" t_dropWhile,
815+ testProperty "tl_dropWhile" tl_dropWhile,
816+ testProperty "t_dropWhileEnd" t_dropWhileEnd,
817+ testProperty "tl_dropWhileEnd" tl_dropWhileEnd,
818+ testProperty "t_dropAround" t_dropAround,
819+ testProperty "tl_dropAround" tl_dropAround,
820+ testProperty "t_stripStart" t_stripStart,
821+ testProperty "tl_stripStart" tl_stripStart,
822+ testProperty "t_stripEnd" t_stripEnd,
823+ testProperty "tl_stripEnd" tl_stripEnd,
824+ testProperty "t_strip" t_strip,
825+ testProperty "tl_strip" tl_strip,
826+ testProperty "t_splitAt" t_splitAt,
827+ testProperty "tl_splitAt" tl_splitAt,
828+ testProperty "t_spanBy" t_spanBy,
829+ testProperty "tl_spanBy" tl_spanBy,
830+ testProperty "t_break_id" t_break_id,
831+ testProperty "tl_break_id" tl_break_id,
832+ testProperty "t_break_start" t_break_start,
833+ testProperty "tl_break_start" tl_break_start,
834+ testProperty "t_breakBy" t_breakBy,
835+ testProperty "tl_breakBy" tl_breakBy,
836+ testProperty "t_group" t_group,
837+ testProperty "tl_group" tl_group,
838+ testProperty "t_groupBy" t_groupBy,
839+ testProperty "tl_groupBy" tl_groupBy,
840+ testProperty "t_inits" t_inits,
841+ testProperty "tl_inits" tl_inits,
842+ testProperty "t_tails" t_tails,
843+ testProperty "tl_tails" tl_tails
844+ ],
845+
846+ testGroup "breaking many" [
847+ testProperty "t_findAppendId" t_findAppendId,
848+ testProperty "tl_findAppendId" tl_findAppendId,
849+ testProperty "t_findContains" t_findContains,
850+ testProperty "tl_findContains" tl_findContains,
851+ testProperty "t_findCount" t_findCount,
852+ testProperty "tl_findCount" tl_findCount,
853+ testProperty "t_split_split" t_split_split,
854+ testProperty "tl_split_split" tl_split_split,
855+ testProperty "t_split_i" t_split_i,
856+ testProperty "tl_split_i" tl_split_i,
857+ testProperty "t_splitBy" t_splitBy,
858+ testProperty "t_splitBy_count" t_splitBy_count,
859+ testProperty "t_splitBy_split" t_splitBy_split,
860+ testProperty "tl_splitBy" tl_splitBy,
861+ testProperty "t_chunksOf_same_lengths" t_chunksOf_same_lengths,
862+ testProperty "t_chunksOf_length" t_chunksOf_length,
863+ testProperty "tl_chunksOf" tl_chunksOf
864+ ],
865+
866+ testGroup "lines and words" [
867+ testProperty "t_lines" t_lines,
868+ testProperty "tl_lines" tl_lines,
869+ --testProperty "t_lines'" t_lines',
870+ testProperty "t_words" t_words,
871+ testProperty "tl_words" tl_words,
872+ testProperty "t_unlines" t_unlines,
873+ testProperty "tl_unlines" tl_unlines,
874+ testProperty "t_unwords" t_unwords,
875+ testProperty "tl_unwords" tl_unwords
876+ ]
877+ ],
878+
879+ testGroup "predicates" [
880+ testProperty "s_isPrefixOf" s_isPrefixOf,
881+ testProperty "sf_isPrefixOf" sf_isPrefixOf,
882+ testProperty "t_isPrefixOf" t_isPrefixOf,
883+ testProperty "tl_isPrefixOf" tl_isPrefixOf,
884+ testProperty "t_isSuffixOf" t_isSuffixOf,
885+ testProperty "tl_isSuffixOf" tl_isSuffixOf,
886+ testProperty "t_isInfixOf" t_isInfixOf,
887+ testProperty "tl_isInfixOf" tl_isInfixOf,
888+
889+ testGroup "view" [
890+ testProperty "t_prefixed" t_prefixed,
891+ testProperty "tl_prefixed" tl_prefixed,
892+ testProperty "t_suffixed" t_suffixed,
893+ testProperty "tl_suffixed" tl_suffixed
894+ ]
895+ ],
896+
897+ testGroup "searching" [
898+ testProperty "sf_elem" sf_elem,
899+ testProperty "sf_filter" sf_filter,
900+ testProperty "t_filter" t_filter,
901+ testProperty "tl_filter" tl_filter,
902+ testProperty "sf_findBy" sf_findBy,
903+ testProperty "t_findBy" t_findBy,
904+ testProperty "tl_findBy" tl_findBy,
905+ testProperty "t_partition" t_partition,
906+ testProperty "tl_partition" tl_partition
907+ ],
908+
909+ testGroup "indexing" [
910+ testProperty "sf_index" sf_index,
911+ testProperty "t_index" t_index,
912+ testProperty "tl_index" tl_index,
913+ testProperty "t_findIndex" t_findIndex,
914+ testProperty "t_count" t_count,
915+ testProperty "tl_count" tl_count,
916+ testProperty "t_indices" t_indices,
917+ testProperty "tl_indices" tl_indices,
918+ testProperty "t_indices_occurs" t_indices_occurs
919+ ],
920+
921+ testGroup "zips" [
922+ testProperty "t_zip" t_zip,
923+ testProperty "tl_zip" tl_zip,
924+ testProperty "sf_zipWith" sf_zipWith,
925+ testProperty "t_zipWith" t_zipWith,
926+ testProperty "tl_zipWith" tl_zipWith
927+ ],
928+
929+ testGroup "regressions" [
930+ testProperty "s_filter_eq" s_filter_eq
931+ ],
932+
933+ testGroup "shifts" [
934+ testProperty "shiftL_Int" shiftL_Int,
935+ testProperty "shiftL_Word16" shiftL_Word16,
936+ testProperty "shiftL_Word32" shiftL_Word32,
937+ testProperty "shiftR_Int" shiftR_Int,
938+ testProperty "shiftR_Word16" shiftR_Word16,
939+ testProperty "shiftR_Word32" shiftR_Word32
940+ ],
941+
942+ testGroup "builder" [
943+ testProperty "t_builderSingleton" t_builderSingleton,
944+ testProperty "t_builderFromText" t_builderFromText,
945+ testProperty "t_builderAssociative" t_builderAssociative
946+ ]
947+ ]
tests/QuickCheckUtils.hsnew file+115
@@ -0,0 +1,115 @@
1+{-# LANGUAGE FlexibleInstances #-}
2+
3+module QuickCheckUtils where
4+
5+import Control.Arrow (first)
6+import Data.Int (Int64)
7+import Data.Word (Word8, Word16, Word32)
8+import qualified Data.Text as T
9+import qualified Data.Text.Lazy as TL
10+import System.Random (Random(..), RandomGen)
11+import Test.QuickCheck (Arbitrary(..), choose, sized, vector)
12+import qualified Data.ByteString as B
13+
14+instance Random Int64 where
15+ randomR = integralRandomR
16+ random = randomR (minBound,maxBound)
17+
18+instance Arbitrary Int64 where
19+ arbitrary = choose (minBound,maxBound)
20+
21+instance Random Word8 where
22+ randomR = integralRandomR
23+ random = randomR (minBound,maxBound)
24+
25+instance Arbitrary Word8 where
26+ arbitrary = choose (minBound,maxBound)
27+
28+instance Arbitrary B.ByteString where
29+ arbitrary = B.pack `fmap` arbitrary
30+
31+instance Random Word16 where
32+ randomR = integralRandomR
33+ random = randomR (minBound,maxBound)
34+
35+instance Arbitrary Word16 where
36+ arbitrary = choose (minBound,maxBound)
37+
38+instance Random Word32 where
39+ randomR = integralRandomR
40+ random = randomR (minBound,maxBound)
41+
42+instance Arbitrary Word32 where
43+ arbitrary = choose (minBound,maxBound)
44+
45+instance Arbitrary T.Text where
46+ arbitrary = T.pack `fmap` arbitrary
47+
48+instance Arbitrary TL.Text where
49+ arbitrary = TL.pack `fmap` arbitrary
50+
51+newtype NotEmpty a = NotEmpty { notEmpty :: a }
52+ deriving (Eq, Ord)
53+
54+instance Show a => Show (NotEmpty a) where
55+ show (NotEmpty a) = show a
56+
57+instance Functor NotEmpty where
58+ fmap f (NotEmpty a) = NotEmpty (f a)
59+
60+instance Arbitrary a => Arbitrary (NotEmpty [a]) where
61+ arbitrary = sized (\n -> NotEmpty `fmap` (choose (1,n+1) >>= vector))
62+
63+instance Arbitrary (NotEmpty T.Text) where
64+ arbitrary = (fmap T.pack) `fmap` arbitrary
65+
66+instance Arbitrary (NotEmpty TL.Text) where
67+ arbitrary = (fmap TL.pack) `fmap` arbitrary
68+
69+instance Arbitrary (NotEmpty B.ByteString) where
70+ arbitrary = (fmap B.pack) `fmap` arbitrary
71+
72+data Small = S0 | S1 | S2 | S3 | S4 | S5 | S6 | S7
73+ | S8 | S9 | S10 | S11 | S12 | S13 | S14 | S15
74+ | S16 | S17 | S18 | S19 | S20 | S21 | S22 | S23
75+ | S24 | S25 | S26 | S27 | S28 | S29 | S30 | S31
76+ deriving (Eq, Ord, Enum, Bounded)
77+
78+small :: Small -> Int
79+small = fromEnum
80+
81+intf f a b = toEnum ((fromEnum a `f` fromEnum b) `mod` 32)
82+
83+instance Show Small where
84+ show = show . fromEnum
85+
86+instance Read Small where
87+ readsPrec n = map (first toEnum) . readsPrec n
88+
89+instance Num Small where
90+ fromInteger = toEnum . fromIntegral
91+ signum _ = 1
92+ abs = id
93+ (+) = intf (+)
94+ (-) = intf (-)
95+ (*) = intf (*)
96+
97+instance Real Small where
98+ toRational = toRational . fromEnum
99+
100+instance Integral Small where
101+ toInteger = toInteger . fromEnum
102+ quotRem a b = (toEnum x, toEnum y)
103+ where (x, y) = fromEnum a `quotRem` fromEnum b
104+
105+instance Random Small where
106+ randomR = integralRandomR
107+ random = randomR (minBound,maxBound)
108+
109+instance Arbitrary Small where
110+ arbitrary = choose (minBound,maxBound)
111+
112+integralRandomR :: (Integral a, RandomGen g) => (a,a) -> g -> (a,g)
113+integralRandomR (a,b) g = case randomR (fromIntegral a :: Integer,
114+ fromIntegral b :: Integer) g of
115+ (x,h) -> (fromIntegral x, h)
tests/READMEnew file+2
@@ -0,0 +1,2 @@
1+You also need the test data from:
2+http://projects.haskell.org/text/text-testdata.tar.bz2
tests/Regressions.hsnew file+25
@@ -0,0 +1,25 @@
1+-- Regression tests for specific bugs.
2+
3+import Control.Exception (bracket)
4+import System.Directory (removeFile)
5+import System.IO (hClose, openTempFile)
6+import qualified Data.ByteString.Lazy as LB
7+import qualified Data.Text.Lazy as LT
8+import qualified Data.Text.Lazy.Encoding as LE
9+import qualified Test.Framework as F
10+import qualified Test.Framework.Providers.HUnit as F
11+
12+-- Reported by Michael Snoyman: UTF-8 encoding a large lazy bytestring
13+-- caused either a segfault or attempt to allocate a negative number
14+-- of bytes.
15+lazy_encode_crash =
16+ bracket (openTempFile "." "crashy.txt")
17+ (\(path,h) -> hClose h >> removeFile path) $
18+ \(_,h) -> LB.hPut h . LE.encodeUtf8 . LT.pack . replicate 100000 $ 'a'
19+
20+tests :: F.Test
21+tests = F.testGroup "crashers" [
22+ F.testCase "lazy_encode_crash" lazy_encode_crash
23+ ]
24+
25+main = F.defaultMain [tests]
tests/SearchBench.hsnew file+115
@@ -0,0 +1,115 @@
1+{-# LANGUAGE BangPatterns, OverloadedStrings #-}
2+
3+import Criterion.Main
4+import Data.Text.Encoding
5+import Data.Text.Search
6+import qualified Data.ByteString.Char8 as B
7+import qualified Data.Text as T
8+import qualified SlowFunctions as Slow
9+
10+main = defaultMain [
11+ bench "big/fast" $ (length . search indices)
12+ , bench "big/slow" $ (length . search Slow.indices)
13+ , bench "big/bytestring" $ (length . searchBS)
14+ , bench "dna/fast" $ (length . searchDNA indices)
15+ , bench "dna/slow" $ (length . searchDNA Slow.indices)
16+ , bench "dna/bytestring" $ (length . searchDNABS)
17+ ]
18+
19+search f n = f needle' haystack
20+ where
21+ needle' = T.drop (n `mod` 20) needle
22+ needle = T.replicate 10 "abcdefghijklmnopqrstuvwxyz"
23+ haystack = T.replicate 100 $
24+ T.concat [ T.replicate 1000 "def"
25+ , needle
26+ , T.replicate 1000 "123"
27+ ]
28+
29+searchDNA f n = f needle haystack
30+ where
31+ needle = T.take 4 . T.drop (n `mod` (T.length dna - 4)) $ dna
32+ haystack = T.replicate 100 dna
33+
34+replicateBS n = B.concat . replicate n
35+
36+searchBS n = indicesBS needle' haystack
37+ where
38+ needle' = B.drop (n `mod` 20) needle
39+ needle = replicateBS 10 "abcdefghijklmnopqrstuvwxyz"
40+ haystack = replicateBS 100 $
41+ B.concat [ replicateBS 1000 "def"
42+ , needle
43+ , replicateBS 1000 "123"
44+ ]
45+
46+searchDNABS n = indicesBS needle haystack
47+ where
48+ needle = B.take 4 . B.drop (n `mod` (B.length bdna - 4)) $ bdna
49+ haystack = replicateBS 100 bdna
50+
51+indicesBS :: B.ByteString -> B.ByteString -> [Int]
52+indicesBS pat
53+ | B.null pat = error "empty"
54+ | otherwise = go 0
55+ where
56+ l = B.length pat
57+ go !i src = case B.breakSubstring pat src of
58+ (h,t) | B.null t -> []
59+ | otherwise -> i' : go (i'+l) (B.drop l t)
60+ where i' = i + B.length h
61+
62+dna = decodeASCII bdna
63+
64+bdna :: B.ByteString
65+bdna = "\
66+\CGTAACAAGGTTTCCGTAGGTGAACCTGCGGAAGGATCATTGTTGAGATCACATAATAATTGATCGGGTT\
67+\AATCTGGAGGATCTGTTTACTTTGGTCACCCATGAGCATTTGCTGTTGAAGTGACCTAGAATTGCCATCG\
68+\AGCCTCCTTGGGAGCTTTCTTGTTGGCGAGATCTAAACCCTTGCCCGGCGCAGTTTTGCTCCAAGTCGTT\
69+\TGACACATAATTGGTGAAGGGGGTGGCATCCTTCCCTGACCCTCCCCCAACTATTTTTTTAACAACTCTC\
70+\AGCAACGGAGACTCAGTCTTCGGCAAATGCGATAAATGGTGTGAATTGCAGAATCCCGTGCACCATCGAG\
71+\TCTTTGAACGCAAGTTGCGCCCGAGGCCATCAGGCCAAGGGCACGCCTGCCTGGGCATTGCGAGTCATAT\
72+\CTCTCCCTTAACGAGGCTGTCCATACATACTGTTCAGCCGGTGCGGATGTGAGTTTGGCCCCTTGTTCTT\
73+\TGGTACGGGGGGTCTAAGAGCTGCATGGGCTTTTGATGGTCCTAAATACGGCAAGAGGTGGACGAACTAT\
74+\GCTACAACAAAATTGTTGTGCAGAGGCCCCGGGTTGTCGTATTAGATGGGCCACCGTAATCTGAAGACCC\
75+\TTTTGAACCCCATTGGAGGCCCATCAACCCATGATCAGTTGATGGCCATTTGGTTGCGACCCCAGGTCAG\
76+\GTGAGCAACAGCTGTCGTAACAAGGTTTCCGTAGGGTGAACTGCGGAAGGATCATTGTTGAGATCACATA\
77+\ATAATTGATCGAGTTAATCTGGAGGATCTGTTTACTTGGGTCACCCATGGGCATTTGCTGTTGAAGTGAC\
78+\CTAGATTTGCCATCGAGCCTCCTTGGGAGCATCCTTGTTGGCGATATCTAAACCCTCAATTTTTCCCCCA\
79+\ATCAAATTACACAAAATTGGTGGAGGGGGTGGCATTCTTCCCTTACCCTCCCCCAAATATTTTTTTAACA\
80+\ACTCTCAGCAACGGATATCTCAGCTCTTGCATCGATGAAGAACCCACCGAAATGCGATAAATGGTGTGAA\
81+\TTGCAGAATCCCGTGAACCATCGAGTCTTTGAACGCAAGTTGCGCCCGAGGCCATCAGGCCAAGGGCACG\
82+\CCTGCCTGGGCATTGCGAGTCATATCTCTCCCTTAACGAGGCTGTCCATACATACTGTTCAGCCGGTGCG\
83+\GATGTGAGTTTGGCCCCTTGTTCTTTGGTACGGGGGGTCTAAGAGATGCATGGGCTTTTGATGGTCCTAA\
84+\ATACGGCAAGAGGTGGACGAACTATGCTACAACAAAATTGTTGTGCAAAGGCCCCGGGTTGTCGTATAAG\
85+\ATGGGCCACCGATATCTGAAGACCCTTTTGGACCCCATTGGAGCCCATCAACCCATGTCAGTTGATGGCC\
86+\ATTCGTAACAAGGTTTCCGTAGGTGAACCTGCGGAAGGATCATTGTTGAGATCACATAATAATTGATCGA\
87+\GTTAATCTGGAGGATCTGTTTACTTGGGTCACCCATGGGCATTTGCTGTTGAAGTGACCTAGATTTGCCA\
88+\TCGAGCCTCCTTGGGAGCTTTCTTGTTGGCGATATCTAAACCCTTGCCCGGCAGAGTTTTGGGAATCCCG\
89+\TGAACCATCGAGTCTTTGAACGCAAGTTGCGCCCGAGGCCATCAGGCCAAGGGCACGCCTGCCTGGGCAT\
90+\TGCGAGTCATATCTCTCCCTTAACGAGGCTGTCCATACACACCTGTTCAGCCGGTGCGGATGTGAGTTTG\
91+\GCCCCTTGTTCTTTGGTACGGGGGGTCTAAGAGCTGCATGGGCTTTTGATGGTCCTAAATACGGCAAGAG\
92+\GTGGACGAACTATGCTACAACAAAATTGTTGTGCAAAGGCCCCGGGTTGTCGTATTAGATGGGCCACCAT\
93+\AATCTGAAGACCCTTTTGAACCCCATTGGAGGCCCATCAACCCATGATCAGTTGATGGCCATTTGGTTGC\
94+\GACCCAGTCAGGTGAGGGTAGGTGAACCTGCGGAAGGATCATTGTTGAGATCACATAATAATTGATCGAG\
95+\TTAATCTGGAGGATCTGTTTACTTTGGTCACCCATGGGCATTTGCTGTTGAAGTGACCTAGATTTGCCAT\
96+\CGAGCCTCCTTGGGAGCTTTCTTGTTGGCGAGATCTAAACCCTTGCCCGGCGGAGTTTGGCGCCAAGTCA\
97+\TATGACACATAATTGGTGAAGGGGGTGGCATCCTGCCCTGACCCTCCCCAAATTATTTTTTTAACAACTC\
98+\TCAGCAACGGATATCTCGGCTCTTGCATCGATGAAGAACGCAGCGAAATGCGATAAATGGTGTGAATTGC\
99+\AGAATCCCGTGAACCATCGAGTCTTTGGAACGCAAGTTGCGCCCGAGGCCATCAGGCCAAGGGCACGCCT\
100+\GCCTGGGCATTGGGAATCATATCTCTCCCCTAACGAGGCTATCCAAACATACTGTTCATCCGGTGCGGAT\
101+\GTGAGTTTGGCCCCTTGTTCTTTGGTACCGGGGGTCTAAGAGCTGCATGGGCATTTGATGGTCCTCAAAA\
102+\CGGCAAGAGGTGGACGAACTATGCCACAACAAAATTGTTGTCCCAAGGCCCCGGGTTGTCGTATTAGATG\
103+\GGCCACCGTAACCTGAAGACCCTTTTGAACCCCATTGGAGGCCCATCAACCCATGATCAGTTGATGACCA\
104+\TTTGTTGCGACCCCAGTCAGCTGAGCAACCCGCTGAGTGGAAGGTCATTGCCGATATCACATAATAATTG\
105+\ATCGAGTTAATCTGGAGGATCTGTTTACTTGGTCACCCATGAGCATTTGCTGTTGAAGTGACCTAGATTT\
106+\GCCATCGAGCCTCCTTGGGAGTTTTCTTGTTGGCGAGATCTAAACCCTTGCCCGGCGGAGTTGTGCGCCA\
107+\AGTCATATGACACATAATTGGTGAAGGGGGTGGCATCCTGCCCTGACCCTCCCCAAATTATTTTTTTAAC\
108+\AACTCTCAGCAACGGATATCTCGGCTCTTGCATCGATGAAGAACGCAGCGAAATGCGATAAATGGTGTGA\
109+\ATTGCAGAATCCCGTGAACCATCGAGTCTTTGAACGCAAGTTGCGCCCGAGGCCATCAGGCCAAGGGCAC\
110+\GCCTGCCTGGGCATTGCGAGTCATATCTCTCCCTTAACGAGGCTGTCCATACATACTGTTCATCCGGTGC\
111+\GGATGTGAGTTTGGCCCCTTGTTCTTTGGTACGGGGGGTCTAAGAGCTGCATGGGCATTTGATGGTCCTC\
112+\AAAACGGCAAGAGGTGGACGAACTATGCTACAACCAAATTGTTGTCCCAAGGCCCCGGGTTGTCGTATTA\
113+\GATGGGCCACCGTAACCTGAAGACCCTTTTGAACCCCATTGGAGGCCCATCAACCCATGATCAGTTGATG\
114+\ACCATGTGTTGCGACCCCAGTCAGCTGAGCAACGCGCTGAGCGTAACAAGGTTTCCGTAGGTGGACCTCC\
115+\GGGAGGATCATTGTTGAGATCACATAATAATTGATCGAGGTAATCTGGAGGATCTGCATATTTTGGTCAC"
tests/Tests/SlowFunctions.hs → tests/SlowFunctions.hsrenamed+9−8
@@ -1,8 +1,9 @@
1{-# LANGUAGE BangPatterns #-}
1{-# LANGUAGE BangPatterns #-}
2+
2−module Tests.SlowFunctions
3+module SlowFunctions
3 (
4 (
4 indices
5 indices
5− , splitOn
6+ , split
6 ) where
7 ) where
7
8
8import qualified Data.Text as T
9import qualified Data.Text as T
@@ -22,12 +23,12 @@ indices needle@(Text _narr _noff nlen) haystack@(Text harr hoff hlen)
22 where t = Text harr (hoff+i) (hlen-i)
23 where t = Text harr (hoff+i) (hlen-i)
23 d = iter_ haystack i
24 d = iter_ haystack i
24
25
25−splitOn :: T.Text -- ^ Text to split on
26+split :: T.Text -- ^ Text to split on
26− -> T.Text -- ^ Input text
27+ -> T.Text -- ^ Input text
27− -> [T.Text]
28+ -> [T.Text]
28−splitOn pat src0
29+split pat src0
29− | T.null pat = error "splitOn: empty"
30+ | T.null pat = error "split: empty"
30− | l == 1 = T.split (== (unsafeHead pat)) src0
31+ | l == 1 = T.splitBy (== (unsafeHead pat)) src0
31 | otherwise = go src0
32 | otherwise = go src0
32 where
33 where
33 l = T.length pat
34 l = T.length pat
tests/Tests.hsdeleted−13
@@ -1,13 +0,0 @@
1−-- | Provides a simple main function which runs all the tests
2−--
3−module Main
4− ( main
5− ) where
6−
7−import Test.Framework (defaultMain)
8−
9−import qualified Tests.Properties as Properties
10−import qualified Tests.Regressions as Regressions
11−
12−main :: IO ()
13−main = defaultMain [Properties.tests, Regressions.tests]
tests/Tests/IO.hsdeleted−34
@@ -1,34 +0,0 @@
1−-- | Program which exposes some haskell functions as an exutable. The results
2−-- and coverage of this module is meant to be checked using a shell script.
3−--
4−module Main
5− (
6− main
7− ) where
8−
9−import System.Environment (getArgs)
10−import System.Exit (exitFailure)
11−import System.IO (hPutStrLn, stderr)
12−import qualified Data.Text as T
13−import qualified Data.Text.IO as T
14−import qualified Data.Text.Lazy as TL
15−import qualified Data.Text.Lazy.IO as TL
16−
17−main :: IO ()
18−main = do
19− args <- getArgs
20− case args of
21− ["T.readFile", name] -> T.putStr =<< T.readFile name
22− ["T.writeFile", name, t] -> T.writeFile name (T.pack t)
23− ["T.appendFile", name, t] -> T.appendFile name (T.pack t)
24− ["T.interact"] -> T.interact id
25− ["T.getContents"] -> T.putStr =<< T.getContents
26− ["T.getLine"] -> T.putStrLn =<< T.getLine
27−
28− ["TL.readFile", name] -> TL.putStr =<< TL.readFile name
29− ["TL.writeFile", name, t] -> TL.writeFile name (TL.pack t)
30− ["TL.appendFile", name, t] -> TL.appendFile name (TL.pack t)
31− ["TL.interact"] -> TL.interact id
32− ["TL.getContents"] -> TL.putStr =<< TL.getContents
33− ["TL.getLine"] -> TL.putStrLn =<< TL.getLine
34− _ -> hPutStrLn stderr "invalid directive!" >> exitFailure
tests/Tests/Properties.hsdeleted−1363
@@ -1,1363 +0,0 @@
1−-- | QuickCheck properties for the text library.
2−
3−{-# LANGUAGE BangPatterns, FlexibleInstances, OverloadedStrings,
4− ScopedTypeVariables, TypeSynonymInstances #-}
5−{-# OPTIONS_GHC -fno-enable-rewrite-rules -fno-warn-missing-signatures #-}
6−module Tests.Properties
7− (
8− tests
9− ) where
10−
11−import Control.Applicative ((<$>), (<*>))
12−import Control.Arrow ((***), second)
13−import Data.Bits ((.&.))
14−import Data.Char (chr, isDigit, isHexDigit, isLower, isSpace, isUpper, ord)
15−import Data.Int (Int8, Int16, Int32, Int64)
16−import Data.Monoid (Monoid(..))
17−import Data.String (IsString(fromString))
18−import Data.Text.Encoding.Error
19−import Data.Text.Foreign
20−import Data.Text.Internal.Encoding.Utf8
21−import Data.Text.Internal.Fusion.Size
22−import Data.Text.Internal.Search (indices)
23−import Data.Text.Lazy.Read as TL
24−import Data.Text.Read as T
25−import Data.Word (Word, Word8, Word16, Word32, Word64)
26−import Numeric (showEFloat, showFFloat, showGFloat, showHex)
27−import Prelude hiding (replicate)
28−import Test.Framework (Test, testGroup)
29−import 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
37−import qualified Data.Bits as Bits (shiftL, shiftR)
38−import qualified Data.ByteString as B
39−import qualified Data.ByteString.Lazy as BL
40−import qualified Data.List as L
41−import qualified Data.Text as T
42−import qualified Data.Text.Encoding as E
43−import 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
49−import qualified Data.Text.Lazy as TL
50−import 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
53−import qualified Data.Text.Lazy.Encoding as EL
54−import qualified Data.Text.Lazy.IO as TL
55−import qualified System.IO as IO
56−import qualified Tests.Properties.Mul as Mul
57−import qualified Tests.SlowFunctions as Slow
58−
59−t_pack_unpack = (T.unpack . T.pack) `eq` id
60−tl_pack_unpack = (TL.unpack . TL.pack) `eq` id
61−t_stream_unstream = (S.unstream . S.stream) `eq` id
62−tl_stream_unstream = (SL.unstream . SL.stream) `eq` id
63−t_reverse_stream t = (S.reverse . S.reverseStream) t == t
64−t_singleton c = [c] == (T.unpack . T.singleton) c
65−tl_singleton c = [c] == (TL.unpack . TL.singleton) c
66−tl_unstreamChunks x = f 11 x == f 1000 x
67− where f n = SL.unstreamChunks n . S.streamList
68−tl_chunk_unchunk = (TL.fromChunks . TL.toChunks) `eq` id
69−tl_from_to_strict = (TL.fromStrict . TL.toStrict) `eq` id
70−
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−
77−t_ascii t = E.decodeASCII (E.encodeUtf8 a) == a
78− where a = T.map (\c -> chr (ord c `mod` 128)) t
79−tl_ascii t = EL.decodeASCII (EL.encodeUtf8 a) == a
80− 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
85−t_utf8 = forAll genUnicode $ (E.decodeUtf8 . E.encodeUtf8) `eq` id
86−t_utf8' = forAll genUnicode $ (E.decodeUtf8' . E.encodeUtf8) `eq` (id . Right)
87−tl_utf8 = forAll genUnicode $ (EL.decodeUtf8 . EL.encodeUtf8) `eq` id
88−tl_utf8' = forAll genUnicode $ (EL.decodeUtf8' . EL.encodeUtf8) `eq` (id . Right)
89−t_utf16LE = forAll genUnicode $ (E.decodeUtf16LE . E.encodeUtf16LE) `eq` id
90−tl_utf16LE = forAll genUnicode $ (EL.decodeUtf16LE . EL.encodeUtf16LE) `eq` id
91−t_utf16BE = forAll genUnicode $ (E.decodeUtf16BE . E.encodeUtf16BE) `eq` id
92−tl_utf16BE = forAll genUnicode $ (EL.decodeUtf16BE . EL.encodeUtf16BE) `eq` id
93−t_utf32LE = forAll genUnicode $ (E.decodeUtf32LE . E.encodeUtf32LE) `eq` id
94−tl_utf32LE = forAll genUnicode $ (EL.decodeUtf32LE . EL.encodeUtf32LE) `eq` id
95−t_utf32BE = forAll genUnicode $ (E.decodeUtf32BE . E.encodeUtf32BE) `eq` id
96−tl_utf32BE = forAll genUnicode $ (EL.decodeUtf32BE . EL.encodeUtf32BE) `eq` id
97−
98−t_utf8_incr = forAll genUnicode $ \s (Positive n) -> (recode n `eq` id) s
99− where recode n = T.concat . map fst . feedChunksOf n E.streamDecodeUtf8 .
100− E.encodeUtf8
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
123−t_utf8_err bad de = 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)
133− in (len `seq` return (Right len)) `Exception.catch`
134− (\(e::UnicodeException) -> return (Left e))
135− assert $ case l of
136− Left err -> length (show err) >= 0
137− Right _ -> de /= Strict
138−
139−t_utf8_err' :: B.ByteString -> Property
140−t_utf8_err' bs = monadicIO . assert $ case E.decodeUtf8' bs of
141− Left err -> length (show err) >= 0
142− Right t -> T.length t >= 0
143−
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−
180−s_Eq s = (s==) `eq` ((S.streamList s==) . S.streamList)
181− where _types = s :: String
182−sf_Eq p s =
183− ((L.filter p s==) . L.filter p) `eq`
184− (((S.filter p $ S.streamList s)==) . S.filter p . S.streamList)
185−t_Eq s = (s==) `eq` ((T.pack s==) . T.pack)
186−tl_Eq s = (s==) `eq` ((TL.pack s==) . TL.pack)
187−s_Ord s = (compare s) `eq` (compare (S.streamList s) . S.streamList)
188− where _types = s :: String
189−sf_Ord p s =
190− ((compare $ L.filter p s) . L.filter p) `eq`
191− (compare (S.filter p $ S.streamList s) . S.filter p . S.streamList)
192−t_Ord s = (compare s) `eq` (compare (T.pack s) . T.pack)
193−tl_Ord s = (compare s) `eq` (compare (TL.pack s) . TL.pack)
194−t_Read = id `eq` (T.unpack . read . show)
195−tl_Read = id `eq` (TL.unpack . read . show)
196−t_Show = show `eq` (show . T.pack)
197−tl_Show = show `eq` (show . TL.pack)
198−t_mappend s = mappend s`eqP` (unpackS . mappend (T.pack s))
199−tl_mappend s = mappend s`eqP` (unpackS . mappend (TL.pack s))
200−t_mconcat = unsquare $
201− mconcat `eq` (unpackS . mconcat . L.map T.pack)
202−tl_mconcat = unsquare $
203− mconcat `eq` (unpackS . mconcat . L.map TL.pack)
204−t_mempty = mempty == (unpackS (mempty :: T.Text))
205−tl_mempty = mempty == (unpackS (mempty :: TL.Text))
206−t_IsString = fromString `eqP` (T.unpack . fromString)
207−tl_IsString = fromString `eqP` (TL.unpack . fromString)
208−
209−s_cons x = (x:) `eqP` (unpackS . S.cons x)
210−s_cons_s x = (x:) `eqP` (unpackS . S.unstream . S.cons x)
211−sf_cons p x = ((x:) . L.filter p) `eqP` (unpackS . S.cons x . S.filter p)
212−t_cons x = (x:) `eqP` (unpackS . T.cons x)
213−tl_cons x = (x:) `eqP` (unpackS . TL.cons x)
214−s_snoc x = (++ [x]) `eqP` (unpackS . (flip S.snoc) x)
215−t_snoc x = (++ [x]) `eqP` (unpackS . (flip T.snoc) x)
216−tl_snoc x = (++ [x]) `eqP` (unpackS . (flip TL.snoc) x)
217−s_append s = (s++) `eqP` (unpackS . S.append (S.streamList s))
218−s_append_s s = (s++) `eqP`
219− (unpackS . S.unstream . S.append (S.streamList s))
220−sf_append p s = (L.filter p s++) `eqP`
221− (unpackS . S.append (S.filter p $ S.streamList s))
222−t_append s = (s++) `eqP` (unpackS . T.append (packS s))
223−
224−uncons (x:xs) = Just (x,xs)
225−uncons _ = Nothing
226−
227−s_uncons = uncons `eqP` (fmap (second unpackS) . S.uncons)
228−sf_uncons p = (uncons . L.filter p) `eqP`
229− (fmap (second unpackS) . S.uncons . S.filter p)
230−t_uncons = uncons `eqP` (fmap (second unpackS) . T.uncons)
231−tl_uncons = uncons `eqP` (fmap (second unpackS) . TL.uncons)
232−s_head = head `eqP` S.head
233−sf_head p = (head . L.filter p) `eqP` (S.head . S.filter p)
234−t_head = head `eqP` T.head
235−tl_head = head `eqP` TL.head
236−s_last = last `eqP` S.last
237−sf_last p = (last . L.filter p) `eqP` (S.last . S.filter p)
238−t_last = last `eqP` T.last
239−tl_last = last `eqP` TL.last
240−s_tail = tail `eqP` (unpackS . S.tail)
241−s_tail_s = tail `eqP` (unpackS . S.unstream . S.tail)
242−sf_tail p = (tail . L.filter p) `eqP` (unpackS . S.tail . S.filter p)
243−t_tail = tail `eqP` (unpackS . T.tail)
244−tl_tail = tail `eqP` (unpackS . TL.tail)
245−s_init = init `eqP` (unpackS . S.init)
246−s_init_s = init `eqP` (unpackS . S.unstream . S.init)
247−sf_init p = (init . L.filter p) `eqP` (unpackS . S.init . S.filter p)
248−t_init = init `eqP` (unpackS . T.init)
249−tl_init = init `eqP` (unpackS . TL.init)
250−s_null = null `eqP` S.null
251−sf_null p = (null . L.filter p) `eqP` (S.null . S.filter p)
252−t_null = null `eqP` T.null
253−tl_null = null `eqP` TL.null
254−s_length = length `eqP` S.length
255−sf_length p = (length . L.filter p) `eqP` (S.length . S.filter p)
256−sl_length = (fromIntegral . length) `eqP` SL.length
257−t_length = length `eqP` T.length
258−tl_length = L.genericLength `eqP` TL.length
259−t_compareLength t = (compare (T.length t)) `eq` T.compareLength t
260−tl_compareLength t= (compare (TL.length t)) `eq` TL.compareLength t
261−
262−s_map f = map f `eqP` (unpackS . S.map f)
263−s_map_s f = map f `eqP` (unpackS . S.unstream . S.map f)
264−sf_map p f = (map f . L.filter p) `eqP` (unpackS . S.map f . S.filter p)
265−t_map f = map f `eqP` (unpackS . T.map f)
266−tl_map f = map f `eqP` (unpackS . TL.map f)
267−s_intercalate c = unsquare $
268− L.intercalate c `eq`
269− (unpackS . S.intercalate (packS c) . map packS)
270−t_intercalate c = unsquare $
271− L.intercalate c `eq`
272− (unpackS . T.intercalate (packS c) . map packS)
273−tl_intercalate c = unsquare $
274− L.intercalate c `eq`
275− (unpackS . TL.intercalate (TL.pack c) . map TL.pack)
276−s_intersperse c = L.intersperse c `eqP`
277− (unpackS . S.intersperse c)
278−s_intersperse_s c = L.intersperse c `eqP`
279− (unpackS . S.unstream . S.intersperse c)
280−sf_intersperse p c= (L.intersperse c . L.filter p) `eqP`
281− (unpackS . S.intersperse c . S.filter p)
282−t_intersperse c = unsquare $
283− L.intersperse c `eqP` (unpackS . T.intersperse c)
284−tl_intersperse c = unsquare $
285− L.intersperse c `eqP` (unpackS . TL.intersperse c)
286−t_transpose = unsquare $
287− L.transpose `eq` (map unpackS . T.transpose . map packS)
288−tl_transpose = unsquare $
289− L.transpose `eq` (map unpackS . TL.transpose . map TL.pack)
290−t_reverse = L.reverse `eqP` (unpackS . T.reverse)
291−tl_reverse = L.reverse `eqP` (unpackS . TL.reverse)
292−t_reverse_short n = L.reverse `eqP` (unpackS . S.reverse . shorten n . S.stream)
293−
294−t_replace s d = (L.intercalate d . splitOn s) `eqP`
295− (unpackS . T.replace (T.pack s) (T.pack d))
296−tl_replace s d = (L.intercalate d . splitOn s) `eqP`
297− (unpackS . TL.replace (TL.pack s) (TL.pack d))
298−
299−splitOn :: (Eq a) => [a] -> [a] -> [[a]]
300−splitOn pat src0
301− | l == 0 = error "splitOn: empty"
302− | otherwise = go src0
303− where
304− l = length pat
305− go src = search 0 src
306− where
307− search _ [] = [src]
308− search !n s@(_:s')
309− | pat `L.isPrefixOf` s = take n src : go (drop l s)
310− | otherwise = search (n+1) s'
311−
312−s_toCaseFold_length xs = S.length (S.toCaseFold s) >= length xs
313− where s = S.streamList xs
314−sf_toCaseFold_length p xs =
315− (S.length . S.toCaseFold . S.filter p $ s) >= (length . L.filter p $ xs)
316− where s = S.streamList xs
317−t_toCaseFold_length t = T.length (T.toCaseFold t) >= T.length t
318−tl_toCaseFold_length t = TL.length (TL.toCaseFold t) >= TL.length t
319−t_toLower_length t = T.length (T.toLower t) >= T.length t
320−t_toLower_lower t = p (T.toLower t) >= p t
321− where p = T.length . T.filter isLower
322−tl_toLower_lower t = p (TL.toLower t) >= p t
323− where p = TL.length . TL.filter isLower
324−t_toUpper_length t = T.length (T.toUpper t) >= T.length t
325−t_toUpper_upper t = p (T.toUpper t) >= p t
326− where p = T.length . T.filter isUpper
327−tl_toUpper_upper t = p (TL.toUpper t) >= p t
328− where p = TL.length . TL.filter isUpper
329−
330−justifyLeft k c xs = xs ++ L.replicate (k - length xs) c
331−justifyRight m n xs = L.replicate (m - length xs) n ++ xs
332−center k c xs
333− | len >= k = xs
334− | otherwise = L.replicate l c ++ xs ++ L.replicate r c
335− where len = length xs
336− d = k - len
337− r = d `div` 2
338− l = d - r
339−
340−s_justifyLeft k c = justifyLeft j c `eqP` (unpackS . S.justifyLeftI j c)
341− where j = fromIntegral (k :: Word8)
342−s_justifyLeft_s k c = justifyLeft j c `eqP`
343− (unpackS . S.unstream . S.justifyLeftI j c)
344− where j = fromIntegral (k :: Word8)
345−sf_justifyLeft p k c = (justifyLeft j c . L.filter p) `eqP`
346− (unpackS . S.justifyLeftI j c . S.filter p)
347− where j = fromIntegral (k :: Word8)
348−t_justifyLeft k c = justifyLeft j c `eqP` (unpackS . T.justifyLeft j c)
349− where j = fromIntegral (k :: Word8)
350−tl_justifyLeft k c = justifyLeft j c `eqP`
351− (unpackS . TL.justifyLeft (fromIntegral j) c)
352− where j = fromIntegral (k :: Word8)
353−t_justifyRight k c = justifyRight j c `eqP` (unpackS . T.justifyRight j c)
354− where j = fromIntegral (k :: Word8)
355−tl_justifyRight k c = justifyRight j c `eqP`
356− (unpackS . TL.justifyRight (fromIntegral j) c)
357− where j = fromIntegral (k :: Word8)
358−t_center k c = center j c `eqP` (unpackS . T.center j c)
359− where j = fromIntegral (k :: Word8)
360−tl_center k c = center j c `eqP` (unpackS . TL.center (fromIntegral j) c)
361− where j = fromIntegral (k :: Word8)
362−
363−sf_foldl p f z = (L.foldl f z . L.filter p) `eqP` (S.foldl f z . S.filter p)
364− where _types = f :: Char -> Char -> Char
365−t_foldl f z = L.foldl f z `eqP` (T.foldl f z)
366− where _types = f :: Char -> Char -> Char
367−tl_foldl f z = L.foldl f z `eqP` (TL.foldl f z)
368− where _types = f :: Char -> Char -> Char
369−sf_foldl' p f z = (L.foldl' f z . L.filter p) `eqP`
370− (S.foldl' f z . S.filter p)
371− where _types = f :: Char -> Char -> Char
372−t_foldl' f z = L.foldl' f z `eqP` T.foldl' f z
373− where _types = f :: Char -> Char -> Char
374−tl_foldl' f z = L.foldl' f z `eqP` TL.foldl' f z
375− where _types = f :: Char -> Char -> Char
376−sf_foldl1 p f = (L.foldl1 f . L.filter p) `eqP` (S.foldl1 f . S.filter p)
377−t_foldl1 f = L.foldl1 f `eqP` T.foldl1 f
378−tl_foldl1 f = L.foldl1 f `eqP` TL.foldl1 f
379−sf_foldl1' p f = (L.foldl1' f . L.filter p) `eqP` (S.foldl1' f . S.filter p)
380−t_foldl1' f = L.foldl1' f `eqP` T.foldl1' f
381−tl_foldl1' f = L.foldl1' f `eqP` TL.foldl1' f
382−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
384−t_foldr f z = L.foldr f z `eqP` T.foldr f z
385− where _types = f :: Char -> Char -> Char
386−tl_foldr f z = unsquare $
387− L.foldr f z `eqP` TL.foldr f z
388− 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)
391−t_foldr1 f = L.foldr1 f `eqP` T.foldr1 f
392−tl_foldr1 f = unsquare $
393− L.foldr1 f `eqP` TL.foldr1 f
394−
395−s_concat_s = unsquare $
396− L.concat `eq` (unpackS . S.unstream . S.concat . map packS)
397−sf_concat p = unsquare $
398− (L.concat . map (L.filter p)) `eq`
399− (unpackS . S.concat . map (S.filter p . packS))
400−t_concat = unsquare $
401− L.concat `eq` (unpackS . T.concat . map packS)
402−tl_concat = unsquare $
403− L.concat `eq` (unpackS . TL.concat . map TL.pack)
404−sf_concatMap p f = unsquare $ (L.concatMap f . L.filter p) `eqP`
405− (unpackS . S.concatMap (packS . f) . S.filter p)
406−t_concatMap f = unsquare $
407− L.concatMap f `eqP` (unpackS . T.concatMap (packS . f))
408−tl_concatMap f = unsquare $
409− L.concatMap f `eqP` (unpackS . TL.concatMap (TL.pack . f))
410−sf_any q p = (L.any p . L.filter q) `eqP` (S.any p . S.filter q)
411−t_any p = L.any p `eqP` T.any p
412−tl_any p = L.any p `eqP` TL.any p
413−sf_all q p = (L.all p . L.filter q) `eqP` (S.all p . S.filter q)
414−t_all p = L.all p `eqP` T.all p
415−tl_all p = L.all p `eqP` TL.all p
416−sf_maximum p = (L.maximum . L.filter p) `eqP` (S.maximum . S.filter p)
417−t_maximum = L.maximum `eqP` T.maximum
418−tl_maximum = L.maximum `eqP` TL.maximum
419−sf_minimum p = (L.minimum . L.filter p) `eqP` (S.minimum . S.filter p)
420−t_minimum = L.minimum `eqP` T.minimum
421−tl_minimum = L.minimum `eqP` TL.minimum
422−
423−sf_scanl p f z = (L.scanl f z . L.filter p) `eqP`
424− (unpackS . S.scanl f z . S.filter p)
425−t_scanl f z = L.scanl f z `eqP` (unpackS . T.scanl f z)
426−tl_scanl f z = L.scanl f z `eqP` (unpackS . TL.scanl f z)
427−t_scanl1 f = L.scanl1 f `eqP` (unpackS . T.scanl1 f)
428−tl_scanl1 f = L.scanl1 f `eqP` (unpackS . TL.scanl1 f)
429−t_scanr f z = L.scanr f z `eqP` (unpackS . T.scanr f z)
430−tl_scanr f z = L.scanr f z `eqP` (unpackS . TL.scanr f z)
431−t_scanr1 f = L.scanr1 f `eqP` (unpackS . T.scanr1 f)
432−tl_scanr1 f = L.scanr1 f `eqP` (unpackS . TL.scanr1 f)
433−
434−t_mapAccumL f z = L.mapAccumL f z `eqP` (second unpackS . T.mapAccumL f z)
435− where _types = f :: Int -> Char -> (Int,Char)
436−tl_mapAccumL f z = L.mapAccumL f z `eqP` (second unpackS . TL.mapAccumL f z)
437− where _types = f :: Int -> Char -> (Int,Char)
438−t_mapAccumR f z = L.mapAccumR f z `eqP` (second unpackS . T.mapAccumR f z)
439− where _types = f :: Int -> Char -> (Int,Char)
440−tl_mapAccumR f z = L.mapAccumR f z `eqP` (second unpackS . TL.mapAccumR f z)
441− where _types = f :: Int -> Char -> (Int,Char)
442−
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−
447−replicate n l = concat (L.replicate n l)
448−
449−s_replicate n = replicate m `eq`
450− (unpackS . S.replicateI (fromIntegral m) . packS)
451− where m = fromIntegral (n :: Word8)
452−t_replicate n = replicate m `eq` (unpackS . T.replicate m . packS)
453− where m = fromIntegral (n :: Word8)
454−tl_replicate n = replicate m `eq`
455− (unpackS . TL.replicate (fromIntegral m) . packS)
456− where m = fromIntegral (n :: Word8)
457−
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−
466−unf :: Int -> Char -> Maybe (Char, Char)
467−unf n c | fromEnum c * 100 > n = Nothing
468− | otherwise = Just (c, succ c)
469−
470−t_unfoldr n = L.unfoldr (unf m) `eq` (unpackS . T.unfoldr (unf m))
471− where m = fromIntegral (n :: Word16)
472−tl_unfoldr n = L.unfoldr (unf m) `eq` (unpackS . TL.unfoldr (unf m))
473− where m = fromIntegral (n :: Word16)
474−t_unfoldrN n m = (L.take i . L.unfoldr (unf j)) `eq`
475− (unpackS . T.unfoldrN i (unf j))
476− where i = fromIntegral (n :: Word16)
477− j = fromIntegral (m :: Word16)
478−tl_unfoldrN n m = (L.take i . L.unfoldr (unf j)) `eq`
479− (unpackS . TL.unfoldrN (fromIntegral i) (unf j))
480− where i = fromIntegral (n :: Word16)
481− j = fromIntegral (m :: Word16)
482−
483−unpack2 :: (Stringy s) => (s,s) -> (String,String)
484−unpack2 = unpackS *** unpackS
485−
486−s_take n = L.take n `eqP` (unpackS . S.take n)
487−s_take_s m = L.take n `eqP` (unpackS . S.unstream . S.take n)
488− where n = small m
489−sf_take p n = (L.take n . L.filter p) `eqP`
490− (unpackS . S.take n . S.filter p)
491−t_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)
494−tl_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)
497−s_drop n = L.drop n `eqP` (unpackS . S.drop n)
498−s_drop_s m = L.drop n `eqP` (unpackS . S.unstream . S.drop n)
499− where n = small m
500−sf_drop p n = (L.drop n . L.filter p) `eqP`
501− (unpackS . S.drop n . S.filter p)
502−t_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)
505−tl_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))
508−s_take_drop m = (L.take n . L.drop n) `eqP` (unpackS . S.take n . S.drop n)
509− where n = small m
510−s_take_drop_s m = (L.take n . L.drop n) `eqP`
511− (unpackS . S.unstream . S.take n . S.drop n)
512− where n = small m
513−s_takeWhile p = L.takeWhile p `eqP` (unpackS . S.takeWhile p)
514−s_takeWhile_s p = L.takeWhile p `eqP` (unpackS . S.unstream . S.takeWhile p)
515−sf_takeWhile q p = (L.takeWhile p . L.filter q) `eqP`
516− (unpackS . S.takeWhile p . S.filter q)
517−t_takeWhile p = L.takeWhile p `eqP` (unpackS . T.takeWhile p)
518−tl_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)
523−s_dropWhile p = L.dropWhile p `eqP` (unpackS . S.dropWhile p)
524−s_dropWhile_s p = L.dropWhile p `eqP` (unpackS . S.unstream . S.dropWhile p)
525−sf_dropWhile q p = (L.dropWhile p . L.filter q) `eqP`
526− (unpackS . S.dropWhile p . S.filter q)
527−t_dropWhile p = L.dropWhile p `eqP` (unpackS . T.dropWhile p)
528−tl_dropWhile p = L.dropWhile p `eqP` (unpackS . S.dropWhile p)
529−t_dropWhileEnd p = (L.reverse . L.dropWhile p . L.reverse) `eqP`
530− (unpackS . T.dropWhileEnd p)
531−tl_dropWhileEnd p = (L.reverse . L.dropWhile p . L.reverse) `eqP`
532− (unpackS . TL.dropWhileEnd p)
533−t_dropAround p = (L.dropWhile p . L.reverse . L.dropWhile p . L.reverse)
534− `eqP` (unpackS . T.dropAround p)
535−tl_dropAround p = (L.dropWhile p . L.reverse . L.dropWhile p . L.reverse)
536− `eqP` (unpackS . TL.dropAround p)
537−t_stripStart = T.dropWhile isSpace `eq` T.stripStart
538−tl_stripStart = TL.dropWhile isSpace `eq` TL.stripStart
539−t_stripEnd = T.dropWhileEnd isSpace `eq` T.stripEnd
540−tl_stripEnd = TL.dropWhileEnd isSpace `eq` TL.stripEnd
541−t_strip = T.dropAround isSpace `eq` T.strip
542−tl_strip = TL.dropAround isSpace `eq` TL.strip
543−t_splitAt n = L.splitAt n `eqP` (unpack2 . T.splitAt n)
544−tl_splitAt n = L.splitAt n `eqP` (unpack2 . TL.splitAt (fromIntegral n))
545−t_span p = L.span p `eqP` (unpack2 . T.span p)
546−tl_span p = L.span p `eqP` (unpack2 . TL.span p)
547−
548−t_breakOn_id s = squid `eq` (uncurry T.append . T.breakOn s)
549− where squid t | T.null s = error "empty"
550− | otherwise = t
551−tl_breakOn_id s = squid `eq` (uncurry TL.append . TL.breakOn s)
552− where squid t | TL.null s = error "empty"
553− | otherwise = t
554−t_breakOn_start (NotEmpty s) t =
555− let (k,m) = T.breakOn s t
556− in k `T.isPrefixOf` t && (T.null m || s `T.isPrefixOf` m)
557−tl_breakOn_start (NotEmpty s) t =
558− let (k,m) = TL.breakOn s t
559− in k `TL.isPrefixOf` t && TL.null m || s `TL.isPrefixOf` m
560−t_breakOnEnd_end (NotEmpty s) t =
561− let (m,k) = T.breakOnEnd s t
562− in k `T.isSuffixOf` t && (T.null m || s `T.isSuffixOf` m)
563−tl_breakOnEnd_end (NotEmpty s) t =
564− let (m,k) = TL.breakOnEnd s t
565− in k `TL.isSuffixOf` t && (TL.null m || s `TL.isSuffixOf` m)
566−t_break p = L.break p `eqP` (unpack2 . T.break p)
567−tl_break p = L.break p `eqP` (unpack2 . TL.break p)
568−t_group = L.group `eqP` (map unpackS . T.group)
569−tl_group = L.group `eqP` (map unpackS . TL.group)
570−t_groupBy p = L.groupBy p `eqP` (map unpackS . T.groupBy p)
571−tl_groupBy p = L.groupBy p `eqP` (map unpackS . TL.groupBy p)
572−t_inits = L.inits `eqP` (map unpackS . T.inits)
573−tl_inits = L.inits `eqP` (map unpackS . TL.inits)
574−t_tails = L.tails `eqP` (map unpackS . T.tails)
575−tl_tails = unsquare $
576− L.tails `eqP` (map unpackS . TL.tails)
577−t_findAppendId = unsquare $ \(NotEmpty s) ts ->
578− let t = T.intercalate s ts
579− in all (==t) $ map (uncurry T.append) (T.breakOnAll s t)
580−tl_findAppendId = unsquare $ \(NotEmpty s) ts ->
581− let t = TL.intercalate s ts
582− 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
585−tl_findContains = unsquare $ \(NotEmpty s) -> all (TL.isPrefixOf s . snd) .
586− TL.breakOnAll s . TL.intercalate s
587−sl_filterCount c = (L.genericLength . L.filter (==c)) `eqP` SL.countChar c
588−t_findCount s = (L.length . T.breakOnAll s) `eq` T.count s
589−tl_findCount s = (L.genericLength . TL.breakOnAll s) `eq` TL.count s
590−
591−t_splitOn_split s = unsquare $
592− (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`
595− (map TL.fromStrict . T.splitOn s)) . T.intercalate s
596−t_splitOn_i (NotEmpty t) = id `eq` (T.intercalate t . T.splitOn t)
597−tl_splitOn_i (NotEmpty t) = id `eq` (TL.intercalate t . TL.splitOn t)
598−
599−t_split p = split p `eqP` (map unpackS . T.split p)
600−t_split_count c = (L.length . T.split (==c)) `eq`
601− ((1+) . T.count (T.singleton c))
602−t_split_splitOn c = T.split (==c) `eq` T.splitOn (T.singleton c)
603−tl_split p = split p `eqP` (map unpackS . TL.split p)
604−
605−split :: (a -> Bool) -> [a] -> [[a]]
606−split _ [] = [[]]
607−split p xs = loop xs
608− where loop s | null s' = [l]
609− | otherwise = l : loop (tail s')
610− where (l, s') = break p s
611−
612−t_chunksOf_same_lengths k = all ((==k) . T.length) . ini . T.chunksOf k
613− where ini [] = []
614− ini xs = init xs
615−
616−t_chunksOf_length k t = len == T.length t || (k <= 0 && len == 0)
617− where len = L.sum . L.map T.length $ T.chunksOf k t
618−
619−tl_chunksOf k = T.chunksOf k `eq` (map (T.concat . TL.toChunks) .
620− TL.chunksOf (fromIntegral k) . TL.fromStrict)
621−
622−t_lines = L.lines `eqP` (map unpackS . T.lines)
623−tl_lines = L.lines `eqP` (map unpackS . TL.lines)
624−{-
625−t_lines' = lines' `eqP` (map unpackS . T.lines')
626− where lines' "" = []
627− lines' s = let (l, s') = break eol s
628− in l : case s' of
629− [] -> []
630− ('\r':'\n':s'') -> lines' s''
631− (_:s'') -> lines' s''
632− eol c = c == '\r' || c == '\n'
633−-}
634−t_words = L.words `eqP` (map unpackS . T.words)
635−
636−tl_words = L.words `eqP` (map unpackS . TL.words)
637−t_unlines = unsquare $
638− L.unlines `eq` (unpackS . T.unlines . map packS)
639−tl_unlines = unsquare $
640− L.unlines `eq` (unpackS . TL.unlines . map packS)
641−t_unwords = unsquare $
642− L.unwords `eq` (unpackS . T.unwords . map packS)
643−tl_unwords = unsquare $
644− L.unwords `eq` (unpackS . TL.unwords . map packS)
645−
646−s_isPrefixOf s = L.isPrefixOf s `eqP`
647− (S.isPrefixOf (S.stream $ packS s) . S.stream)
648−sf_isPrefixOf p s = (L.isPrefixOf s . L.filter p) `eqP`
649− (S.isPrefixOf (S.stream $ packS s) . S.filter p . S.stream)
650−t_isPrefixOf s = L.isPrefixOf s`eqP` T.isPrefixOf (packS s)
651−tl_isPrefixOf s = L.isPrefixOf s`eqP` TL.isPrefixOf (packS s)
652−t_isSuffixOf s = L.isSuffixOf s`eqP` T.isSuffixOf (packS s)
653−tl_isSuffixOf s = L.isSuffixOf s`eqP` TL.isSuffixOf (packS s)
654−t_isInfixOf s = L.isInfixOf s `eqP` T.isInfixOf (packS s)
655−tl_isInfixOf s = L.isInfixOf s `eqP` TL.isInfixOf (packS s)
656−
657−t_stripPrefix s = (fmap packS . L.stripPrefix s) `eqP` T.stripPrefix (packS s)
658−tl_stripPrefix s = (fmap packS . L.stripPrefix s) `eqP` TL.stripPrefix (packS s)
659−
660−stripSuffix p t = reverse `fmap` L.stripPrefix (reverse p) (reverse t)
661−
662−t_stripSuffix s = (fmap packS . stripSuffix s) `eqP` T.stripSuffix (packS s)
663−tl_stripSuffix s = (fmap packS . stripSuffix s) `eqP` TL.stripSuffix (packS s)
664−
665−commonPrefixes a0@(_:_) b0@(_:_) = Just (go a0 b0 [])
666− where go (a:as) (b:bs) ps
667− | a == b = go as bs (a:ps)
668− go as bs ps = (reverse ps,as,bs)
669−commonPrefixes _ _ = Nothing
670−
671−t_commonPrefixes a b (NonEmpty p)
672− = commonPrefixes pa pb ==
673− repack `fmap` T.commonPrefixes (packS pa) (packS pb)
674− where repack (x,y,z) = (unpackS x,unpackS y,unpackS z)
675− pa = p ++ a
676− pb = p ++ b
677−
678−tl_commonPrefixes a b (NonEmpty p)
679− = commonPrefixes pa pb ==
680− repack `fmap` TL.commonPrefixes (packS pa) (packS pb)
681− where repack (x,y,z) = (unpackS x,unpackS y,unpackS z)
682− pa = p ++ a
683− pb = p ++ b
684−
685−sf_elem p c = (L.elem c . L.filter p) `eqP` (S.elem c . S.filter p)
686−sf_filter q p = (L.filter p . L.filter q) `eqP`
687− (unpackS . S.filter p . S.filter q)
688−t_filter p = L.filter p `eqP` (unpackS . T.filter p)
689−tl_filter p = L.filter p `eqP` (unpackS . TL.filter p)
690−sf_findBy q p = (L.find p . L.filter q) `eqP` (S.findBy p . S.filter q)
691−t_find p = L.find p `eqP` T.find p
692−tl_find p = L.find p `eqP` TL.find p
693−t_partition p = L.partition p `eqP` (unpack2 . T.partition p)
694−tl_partition p = L.partition p `eqP` (unpack2 . TL.partition p)
695−
696−sf_index p s = forAll (choose (-l,l*2))
697− ((L.filter p s L.!!) `eq` S.index (S.filter p $ packS s))
698− where l = L.length s
699−t_index s = forAll (choose (-l,l*2)) ((s L.!!) `eq` T.index (packS s))
700− where l = L.length s
701−
702−tl_index s = forAll (choose (-l,l*2))
703− ((s L.!!) `eq` (TL.index (packS s) . fromIntegral))
704− where l = L.length s
705−
706−t_findIndex p = L.findIndex p `eqP` T.findIndex p
707−t_count (NotEmpty t) = (subtract 1 . L.length . T.splitOn t) `eq` T.count t
708−tl_count (NotEmpty t) = (subtract 1 . L.genericLength . TL.splitOn t) `eq`
709− TL.count t
710−t_zip s = L.zip s `eqP` T.zip (packS s)
711−tl_zip s = L.zip s `eqP` TL.zip (packS s)
712−sf_zipWith p c s = (L.zipWith c (L.filter p s) . L.filter p) `eqP`
713− (unpackS . S.zipWith c (S.filter p $ packS s) . S.filter p)
714−t_zipWith c s = L.zipWith c s `eqP` (unpackS . T.zipWith c (packS s))
715−tl_zipWith c s = L.zipWith c s `eqP` (unpackS . TL.zipWith c (packS s))
716−
717−t_indices (NotEmpty s) = Slow.indices s `eq` indices s
718−tl_indices (NotEmpty s) = lazyIndices s `eq` S.indices s
719− where lazyIndices ss t = map fromIntegral $ Slow.indices (conc ss) (conc t)
720− conc = T.concat . TL.toChunks
721−t_indices_occurs = unsquare $ \(NotEmpty t) ts ->
722− let s = T.intercalate t ts
723− in Slow.indices t s == indices t s
724−
725−-- Bit shifts.
726−shiftL w = forAll (choose (0,width-1)) $ \k -> Bits.shiftL w k == U.shiftL w k
727− where width = round (log (fromIntegral m) / log 2 :: Double)
728− (m,_) = (maxBound, m == w)
729−shiftR w = forAll (choose (0,width-1)) $ \k -> Bits.shiftR w k == U.shiftR w k
730− where width = round (log (fromIntegral m) / log 2 :: Double)
731− (m,_) = (maxBound, m == w)
732−
733−shiftL_Int = shiftL :: Int -> Property
734−shiftL_Word16 = shiftL :: Word16 -> Property
735−shiftL_Word32 = shiftL :: Word32 -> Property
736−shiftR_Int = shiftR :: Int -> Property
737−shiftR_Word16 = shiftR :: Word16 -> Property
738−shiftR_Word32 = shiftR :: Word32 -> Property
739−
740−-- Builder.
741−
742−tb_singleton = id `eqP`
743− (unpackS . TB.toLazyText . mconcat . map TB.singleton)
744−tb_fromText = L.concat `eq` (unpackS . TB.toLazyText . mconcat .
745− map (TB.fromText . packS))
746−tb_associative s1 s2 s3 =
747− TB.toLazyText (b1 `mappend` (b2 `mappend` b3)) ==
748− TB.toLazyText ((b1 `mappend` b2) `mappend` b3)
749− where b1 = TB.fromText (packS s1)
750− b2 = TB.fromText (packS s2)
751− b3 = TB.fromText (packS s3)
752−
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.
813−
814−t_decimal (n::Int) s =
815− T.signed T.decimal (T.pack (show n) `T.append` t) == Right (n,t)
816− where t = T.dropWhile isDigit s
817−tl_decimal (n::Int) s =
818− TL.signed TL.decimal (TL.pack (show n) `TL.append` t) == Right (n,t)
819− where t = TL.dropWhile isDigit s
820−t_hexadecimal m s ox =
821− T.hexadecimal (T.concat [p, T.pack (showHex n ""), t]) == Right (n,t)
822− where t = T.dropWhile isHexDigit s
823− p = if ox then "0x" else ""
824− n = getPositive m :: Int
825−tl_hexadecimal m s ox =
826− TL.hexadecimal (TL.concat [p, TL.pack (showHex n ""), t]) == Right (n,t)
827− where t = TL.dropWhile isHexDigit s
828− p = if ox then "0x" else ""
829− n = getPositive m :: Int
830−
831−isFloaty c = c `elem` ("+-.0123456789eE" :: String)
832−
833−t_read_rational p tol (n::Double) s =
834− case p (T.pack (show n) `T.append` t) of
835− Left _err -> False
836− Right (n',t') -> t == t' && abs (n-n') <= tol
837− where t = T.dropWhile isFloaty s
838−
839−tl_read_rational p tol (n::Double) s =
840− case p (TL.pack (show n) `TL.append` t) of
841− Left _err -> False
842− Right (n',t') -> t == t' && abs (n-n') <= tol
843− where t = TL.dropWhile isFloaty s
844−
845−t_double = t_read_rational T.double 1e-13
846−tl_double = tl_read_rational TL.double 1e-13
847−t_rational = t_read_rational T.rational 1e-16
848−tl_rational = tl_read_rational TL.rational 1e-16
849−
850−-- Input and output.
851−
852−t_put_get = write_read T.unlines T.filter put get
853− where put h = withRedirect h IO.stdout . T.putStr
854− get h = withRedirect h IO.stdin T.getContents
855−tl_put_get = write_read TL.unlines TL.filter put get
856− where put h = withRedirect h IO.stdout . TL.putStr
857− get h = withRedirect h IO.stdin TL.getContents
858−t_write_read = write_read T.unlines T.filter T.hPutStr T.hGetContents
859−tl_write_read = write_read TL.unlines TL.filter TL.hPutStr TL.hGetContents
860−
861−t_write_read_line e m b t = write_read head T.filter T.hPutStrLn
862− T.hGetLine e m b [t]
863−tl_write_read_line e m b t = write_read head TL.filter TL.hPutStrLn
864− TL.hGetLine e m b [t]
865−
866−-- Low-level.
867−
868−t_dropWord16 m t = dropWord16 m t `T.isSuffixOf` t
869−t_takeWord16 m t = takeWord16 m t `T.isPrefixOf` t
870−t_take_drop_16 m t = T.append (takeWord16 n t) (dropWord16 n t) == t
871− where n = small m
872−t_use_from t = monadicIO $ assert . (==t) =<< run (useAsPtr t fromPtr)
873−
874−t_copy t = T.copy t == t
875−
876−-- Regression tests.
877−s_filter_eq s = S.filter p t == S.streamList (filter p s)
878− where p = (/= S.last t)
879− t = S.streamList s
880−
881−-- Make a stream appear shorter than it really is, to ensure that
882−-- functions that consume inaccurately sized streams behave
883−-- themselves.
884−shorten :: Int -> S.Stream a -> S.Stream a
885−shorten n t@(S.Stream arr off len)
886− | n > 0 = S.Stream arr off (smaller (exactSize n) len)
887− | otherwise = t
888−
889−tests :: Test
890−tests =
891− testGroup "Properties" [
892− testGroup "creation/elimination" [
893− testProperty "t_pack_unpack" t_pack_unpack,
894− testProperty "tl_pack_unpack" tl_pack_unpack,
895− testProperty "t_stream_unstream" t_stream_unstream,
896− testProperty "tl_stream_unstream" tl_stream_unstream,
897− testProperty "t_reverse_stream" t_reverse_stream,
898− testProperty "t_singleton" t_singleton,
899− testProperty "tl_singleton" tl_singleton,
900− testProperty "tl_unstreamChunks" tl_unstreamChunks,
901− testProperty "tl_chunk_unchunk" tl_chunk_unchunk,
902− testProperty "tl_from_to_strict" tl_from_to_strict
903− ],
904−
905− testGroup "transcoding" [
906− testProperty "t_ascii" t_ascii,
907− testProperty "tl_ascii" tl_ascii,
908− testProperty "t_latin1" t_latin1,
909− testProperty "tl_latin1" tl_latin1,
910− testProperty "t_utf8" t_utf8,
911− 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,
915− testProperty "tl_utf8'" tl_utf8',
916− testProperty "t_utf16LE" t_utf16LE,
917− testProperty "tl_utf16LE" tl_utf16LE,
918− testProperty "t_utf16BE" t_utf16BE,
919− testProperty "tl_utf16BE" tl_utf16BE,
920− testProperty "t_utf32LE" t_utf32LE,
921− testProperty "tl_utf32LE" tl_utf32LE,
922− testProperty "t_utf32BE" t_utf32BE,
923− testProperty "tl_utf32BE" tl_utf32BE,
924− testGroup "errors" [
925− testProperty "t_utf8_err" t_utf8_err,
926− testProperty "t_utf8_err'" t_utf8_err'
927− ]
928− ],
929−
930− testGroup "instances" [
931− testProperty "s_Eq" s_Eq,
932− testProperty "sf_Eq" sf_Eq,
933− testProperty "t_Eq" t_Eq,
934− testProperty "tl_Eq" tl_Eq,
935− testProperty "s_Ord" s_Ord,
936− testProperty "sf_Ord" sf_Ord,
937− testProperty "t_Ord" t_Ord,
938− testProperty "tl_Ord" tl_Ord,
939− testProperty "t_Read" t_Read,
940− testProperty "tl_Read" tl_Read,
941− testProperty "t_Show" t_Show,
942− testProperty "tl_Show" tl_Show,
943− testProperty "t_mappend" t_mappend,
944− testProperty "tl_mappend" tl_mappend,
945− testProperty "t_mconcat" t_mconcat,
946− testProperty "tl_mconcat" tl_mconcat,
947− testProperty "t_mempty" t_mempty,
948− testProperty "tl_mempty" tl_mempty,
949− testProperty "t_IsString" t_IsString,
950− testProperty "tl_IsString" tl_IsString
951− ],
952−
953− testGroup "basics" [
954− testProperty "s_cons" s_cons,
955− testProperty "s_cons_s" s_cons_s,
956− testProperty "sf_cons" sf_cons,
957− testProperty "t_cons" t_cons,
958− testProperty "tl_cons" tl_cons,
959− testProperty "s_snoc" s_snoc,
960− testProperty "t_snoc" t_snoc,
961− testProperty "tl_snoc" tl_snoc,
962− testProperty "s_append" s_append,
963− testProperty "s_append_s" s_append_s,
964− testProperty "sf_append" sf_append,
965− testProperty "t_append" t_append,
966− testProperty "s_uncons" s_uncons,
967− testProperty "sf_uncons" sf_uncons,
968− testProperty "t_uncons" t_uncons,
969− testProperty "tl_uncons" tl_uncons,
970− testProperty "s_head" s_head,
971− testProperty "sf_head" sf_head,
972− testProperty "t_head" t_head,
973− testProperty "tl_head" tl_head,
974− testProperty "s_last" s_last,
975− testProperty "sf_last" sf_last,
976− testProperty "t_last" t_last,
977− testProperty "tl_last" tl_last,
978− testProperty "s_tail" s_tail,
979− testProperty "s_tail_s" s_tail_s,
980− testProperty "sf_tail" sf_tail,
981− testProperty "t_tail" t_tail,
982− testProperty "tl_tail" tl_tail,
983− testProperty "s_init" s_init,
984− testProperty "s_init_s" s_init_s,
985− testProperty "sf_init" sf_init,
986− testProperty "t_init" t_init,
987− testProperty "tl_init" tl_init,
988− testProperty "s_null" s_null,
989− testProperty "sf_null" sf_null,
990− testProperty "t_null" t_null,
991− testProperty "tl_null" tl_null,
992− testProperty "s_length" s_length,
993− testProperty "sf_length" sf_length,
994− testProperty "sl_length" sl_length,
995− testProperty "t_length" t_length,
996− testProperty "tl_length" tl_length,
997− testProperty "t_compareLength" t_compareLength,
998− testProperty "tl_compareLength" tl_compareLength
999− ],
1000−
1001− testGroup "transformations" [
1002− testProperty "s_map" s_map,
1003− testProperty "s_map_s" s_map_s,
1004− testProperty "sf_map" sf_map,
1005− testProperty "t_map" t_map,
1006− testProperty "tl_map" tl_map,
1007− testProperty "s_intercalate" s_intercalate,
1008− testProperty "t_intercalate" t_intercalate,
1009− testProperty "tl_intercalate" tl_intercalate,
1010− testProperty "s_intersperse" s_intersperse,
1011− testProperty "s_intersperse_s" s_intersperse_s,
1012− testProperty "sf_intersperse" sf_intersperse,
1013− testProperty "t_intersperse" t_intersperse,
1014− testProperty "tl_intersperse" tl_intersperse,
1015− testProperty "t_transpose" t_transpose,
1016− testProperty "tl_transpose" tl_transpose,
1017− testProperty "t_reverse" t_reverse,
1018− testProperty "tl_reverse" tl_reverse,
1019− testProperty "t_reverse_short" t_reverse_short,
1020− testProperty "t_replace" t_replace,
1021− testProperty "tl_replace" tl_replace,
1022−
1023− testGroup "case conversion" [
1024− testProperty "s_toCaseFold_length" s_toCaseFold_length,
1025− testProperty "sf_toCaseFold_length" sf_toCaseFold_length,
1026− testProperty "t_toCaseFold_length" t_toCaseFold_length,
1027− testProperty "tl_toCaseFold_length" tl_toCaseFold_length,
1028− testProperty "t_toLower_length" t_toLower_length,
1029− testProperty "t_toLower_lower" t_toLower_lower,
1030− testProperty "tl_toLower_lower" tl_toLower_lower,
1031− testProperty "t_toUpper_length" t_toUpper_length,
1032− testProperty "t_toUpper_upper" t_toUpper_upper,
1033− testProperty "tl_toUpper_upper" tl_toUpper_upper
1034− ],
1035−
1036− testGroup "justification" [
1037− testProperty "s_justifyLeft" s_justifyLeft,
1038− testProperty "s_justifyLeft_s" s_justifyLeft_s,
1039− testProperty "sf_justifyLeft" sf_justifyLeft,
1040− testProperty "t_justifyLeft" t_justifyLeft,
1041− testProperty "tl_justifyLeft" tl_justifyLeft,
1042− testProperty "t_justifyRight" t_justifyRight,
1043− testProperty "tl_justifyRight" tl_justifyRight,
1044− testProperty "t_center" t_center,
1045− testProperty "tl_center" tl_center
1046− ]
1047− ],
1048−
1049− testGroup "folds" [
1050− testProperty "sf_foldl" sf_foldl,
1051− testProperty "t_foldl" t_foldl,
1052− testProperty "tl_foldl" tl_foldl,
1053− testProperty "sf_foldl'" sf_foldl',
1054− testProperty "t_foldl'" t_foldl',
1055− testProperty "tl_foldl'" tl_foldl',
1056− testProperty "sf_foldl1" sf_foldl1,
1057− testProperty "t_foldl1" t_foldl1,
1058− testProperty "tl_foldl1" tl_foldl1,
1059− testProperty "t_foldl1'" t_foldl1',
1060− testProperty "sf_foldl1'" sf_foldl1',
1061− testProperty "tl_foldl1'" tl_foldl1',
1062− testProperty "sf_foldr" sf_foldr,
1063− testProperty "t_foldr" t_foldr,
1064− testProperty "tl_foldr" tl_foldr,
1065− testProperty "sf_foldr1" sf_foldr1,
1066− testProperty "t_foldr1" t_foldr1,
1067− testProperty "tl_foldr1" tl_foldr1,
1068−
1069− testGroup "special" [
1070− testProperty "s_concat_s" s_concat_s,
1071− testProperty "sf_concat" sf_concat,
1072− testProperty "t_concat" t_concat,
1073− testProperty "tl_concat" tl_concat,
1074− testProperty "sf_concatMap" sf_concatMap,
1075− testProperty "t_concatMap" t_concatMap,
1076− testProperty "tl_concatMap" tl_concatMap,
1077− testProperty "sf_any" sf_any,
1078− testProperty "t_any" t_any,
1079− testProperty "tl_any" tl_any,
1080− testProperty "sf_all" sf_all,
1081− testProperty "t_all" t_all,
1082− testProperty "tl_all" tl_all,
1083− testProperty "sf_maximum" sf_maximum,
1084− testProperty "t_maximum" t_maximum,
1085− testProperty "tl_maximum" tl_maximum,
1086− testProperty "sf_minimum" sf_minimum,
1087− testProperty "t_minimum" t_minimum,
1088− testProperty "tl_minimum" tl_minimum
1089− ]
1090− ],
1091−
1092− testGroup "construction" [
1093− testGroup "scans" [
1094− testProperty "sf_scanl" sf_scanl,
1095− testProperty "t_scanl" t_scanl,
1096− testProperty "tl_scanl" tl_scanl,
1097− testProperty "t_scanl1" t_scanl1,
1098− testProperty "tl_scanl1" tl_scanl1,
1099− testProperty "t_scanr" t_scanr,
1100− testProperty "tl_scanr" tl_scanr,
1101− testProperty "t_scanr1" t_scanr1,
1102− testProperty "tl_scanr1" tl_scanr1
1103− ],
1104−
1105− testGroup "mapAccum" [
1106− testProperty "t_mapAccumL" t_mapAccumL,
1107− testProperty "tl_mapAccumL" tl_mapAccumL,
1108− testProperty "t_mapAccumR" t_mapAccumR,
1109− testProperty "tl_mapAccumR" tl_mapAccumR
1110− ],
1111−
1112− testGroup "unfolds" [
1113− testProperty "tl_repeat" tl_repeat,
1114− testProperty "s_replicate" s_replicate,
1115− testProperty "t_replicate" t_replicate,
1116− testProperty "tl_replicate" tl_replicate,
1117− testProperty "tl_cycle" tl_cycle,
1118− testProperty "tl_iterate" tl_iterate,
1119− testProperty "t_unfoldr" t_unfoldr,
1120− testProperty "tl_unfoldr" tl_unfoldr,
1121− testProperty "t_unfoldrN" t_unfoldrN,
1122− testProperty "tl_unfoldrN" tl_unfoldrN
1123− ]
1124− ],
1125−
1126− testGroup "substrings" [
1127− testGroup "breaking" [
1128− testProperty "s_take" s_take,
1129− testProperty "s_take_s" s_take_s,
1130− testProperty "sf_take" sf_take,
1131− testProperty "t_take" t_take,
1132− testProperty "t_takeEnd" t_takeEnd,
1133− testProperty "tl_take" tl_take,
1134− testProperty "tl_takeEnd" tl_takeEnd,
1135− testProperty "s_drop" s_drop,
1136− testProperty "s_drop_s" s_drop_s,
1137− testProperty "sf_drop" sf_drop,
1138− testProperty "t_drop" t_drop,
1139− testProperty "t_dropEnd" t_dropEnd,
1140− testProperty "tl_drop" tl_drop,
1141− testProperty "tl_dropEnd" tl_dropEnd,
1142− testProperty "s_take_drop" s_take_drop,
1143− testProperty "s_take_drop_s" s_take_drop_s,
1144− testProperty "s_takeWhile" s_takeWhile,
1145− testProperty "s_takeWhile_s" s_takeWhile_s,
1146− testProperty "sf_takeWhile" sf_takeWhile,
1147− testProperty "t_takeWhile" t_takeWhile,
1148− testProperty "tl_takeWhile" tl_takeWhile,
1149− testProperty "t_takeWhileEnd" t_takeWhileEnd,
1150− testProperty "tl_takeWhileEnd" tl_takeWhileEnd,
1151− testProperty "sf_dropWhile" sf_dropWhile,
1152− testProperty "s_dropWhile" s_dropWhile,
1153− testProperty "s_dropWhile_s" s_dropWhile_s,
1154− testProperty "t_dropWhile" t_dropWhile,
1155− testProperty "tl_dropWhile" tl_dropWhile,
1156− testProperty "t_dropWhileEnd" t_dropWhileEnd,
1157− testProperty "tl_dropWhileEnd" tl_dropWhileEnd,
1158− testProperty "t_dropAround" t_dropAround,
1159− testProperty "tl_dropAround" tl_dropAround,
1160− testProperty "t_stripStart" t_stripStart,
1161− testProperty "tl_stripStart" tl_stripStart,
1162− testProperty "t_stripEnd" t_stripEnd,
1163− testProperty "tl_stripEnd" tl_stripEnd,
1164− testProperty "t_strip" t_strip,
1165− testProperty "tl_strip" tl_strip,
1166− testProperty "t_splitAt" t_splitAt,
1167− testProperty "tl_splitAt" tl_splitAt,
1168− testProperty "t_span" t_span,
1169− testProperty "tl_span" tl_span,
1170− testProperty "t_breakOn_id" t_breakOn_id,
1171− testProperty "tl_breakOn_id" tl_breakOn_id,
1172− testProperty "t_breakOn_start" t_breakOn_start,
1173− testProperty "tl_breakOn_start" tl_breakOn_start,
1174− testProperty "t_breakOnEnd_end" t_breakOnEnd_end,
1175− testProperty "tl_breakOnEnd_end" tl_breakOnEnd_end,
1176− testProperty "t_break" t_break,
1177− testProperty "tl_break" tl_break,
1178− testProperty "t_group" t_group,
1179− testProperty "tl_group" tl_group,
1180− testProperty "t_groupBy" t_groupBy,
1181− testProperty "tl_groupBy" tl_groupBy,
1182− testProperty "t_inits" t_inits,
1183− testProperty "tl_inits" tl_inits,
1184− testProperty "t_tails" t_tails,
1185− testProperty "tl_tails" tl_tails
1186− ],
1187−
1188− testGroup "breaking many" [
1189− testProperty "t_findAppendId" t_findAppendId,
1190− testProperty "tl_findAppendId" tl_findAppendId,
1191− testProperty "t_findContains" t_findContains,
1192− testProperty "tl_findContains" tl_findContains,
1193− testProperty "sl_filterCount" sl_filterCount,
1194− testProperty "t_findCount" t_findCount,
1195− testProperty "tl_findCount" tl_findCount,
1196− testProperty "t_splitOn_split" t_splitOn_split,
1197− testProperty "tl_splitOn_split" tl_splitOn_split,
1198− testProperty "t_splitOn_i" t_splitOn_i,
1199− testProperty "tl_splitOn_i" tl_splitOn_i,
1200− testProperty "t_split" t_split,
1201− testProperty "t_split_count" t_split_count,
1202− testProperty "t_split_splitOn" t_split_splitOn,
1203− testProperty "tl_split" tl_split,
1204− testProperty "t_chunksOf_same_lengths" t_chunksOf_same_lengths,
1205− testProperty "t_chunksOf_length" t_chunksOf_length,
1206− testProperty "tl_chunksOf" tl_chunksOf
1207− ],
1208−
1209− testGroup "lines and words" [
1210− testProperty "t_lines" t_lines,
1211− testProperty "tl_lines" tl_lines,
1212− --testProperty "t_lines'" t_lines',
1213− testProperty "t_words" t_words,
1214− testProperty "tl_words" tl_words,
1215− testProperty "t_unlines" t_unlines,
1216− testProperty "tl_unlines" tl_unlines,
1217− testProperty "t_unwords" t_unwords,
1218− testProperty "tl_unwords" tl_unwords
1219− ]
1220− ],
1221−
1222− testGroup "predicates" [
1223− testProperty "s_isPrefixOf" s_isPrefixOf,
1224− testProperty "sf_isPrefixOf" sf_isPrefixOf,
1225− testProperty "t_isPrefixOf" t_isPrefixOf,
1226− testProperty "tl_isPrefixOf" tl_isPrefixOf,
1227− testProperty "t_isSuffixOf" t_isSuffixOf,
1228− testProperty "tl_isSuffixOf" tl_isSuffixOf,
1229− testProperty "t_isInfixOf" t_isInfixOf,
1230− testProperty "tl_isInfixOf" tl_isInfixOf,
1231−
1232− testGroup "view" [
1233− testProperty "t_stripPrefix" t_stripPrefix,
1234− testProperty "tl_stripPrefix" tl_stripPrefix,
1235− testProperty "t_stripSuffix" t_stripSuffix,
1236− testProperty "tl_stripSuffix" tl_stripSuffix,
1237− testProperty "t_commonPrefixes" t_commonPrefixes,
1238− testProperty "tl_commonPrefixes" tl_commonPrefixes
1239− ]
1240− ],
1241−
1242− testGroup "searching" [
1243− testProperty "sf_elem" sf_elem,
1244− testProperty "sf_filter" sf_filter,
1245− testProperty "t_filter" t_filter,
1246− testProperty "tl_filter" tl_filter,
1247− testProperty "sf_findBy" sf_findBy,
1248− testProperty "t_find" t_find,
1249− testProperty "tl_find" tl_find,
1250− testProperty "t_partition" t_partition,
1251− testProperty "tl_partition" tl_partition
1252− ],
1253−
1254− testGroup "indexing" [
1255− testProperty "sf_index" sf_index,
1256− testProperty "t_index" t_index,
1257− testProperty "tl_index" tl_index,
1258− testProperty "t_findIndex" t_findIndex,
1259− testProperty "t_count" t_count,
1260− testProperty "tl_count" tl_count,
1261− testProperty "t_indices" t_indices,
1262− testProperty "tl_indices" tl_indices,
1263− testProperty "t_indices_occurs" t_indices_occurs
1264− ],
1265−
1266− testGroup "zips" [
1267− testProperty "t_zip" t_zip,
1268− testProperty "tl_zip" tl_zip,
1269− testProperty "sf_zipWith" sf_zipWith,
1270− testProperty "t_zipWith" t_zipWith,
1271− testProperty "tl_zipWith" tl_zipWith
1272− ],
1273−
1274− testGroup "regressions" [
1275− testProperty "s_filter_eq" s_filter_eq
1276− ],
1277−
1278− testGroup "shifts" [
1279− testProperty "shiftL_Int" shiftL_Int,
1280− testProperty "shiftL_Word16" shiftL_Word16,
1281− testProperty "shiftL_Word32" shiftL_Word32,
1282− testProperty "shiftR_Int" shiftR_Int,
1283− testProperty "shiftR_Word16" shiftR_Word16,
1284− testProperty "shiftR_Word32" shiftR_Word32
1285− ],
1286−
1287− testGroup "builder" [
1288− testProperty "tb_associative" tb_associative,
1289− testGroup "decimal" [
1290− testProperty "tb_decimal_int" tb_decimal_int,
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− ],
1329−
1330− testGroup "read" [
1331− testProperty "t_decimal" t_decimal,
1332− testProperty "tl_decimal" tl_decimal,
1333− testProperty "t_hexadecimal" t_hexadecimal,
1334− testProperty "tl_hexadecimal" tl_hexadecimal,
1335− testProperty "t_double" t_double,
1336− testProperty "tl_double" tl_double,
1337− testProperty "t_rational" t_rational,
1338− testProperty "tl_rational" tl_rational
1339− ],
1340−
1341− {-
1342− testGroup "input-output" [
1343− testProperty "t_write_read" t_write_read,
1344− testProperty "tl_write_read" tl_write_read,
1345− testProperty "t_write_read_line" t_write_read_line,
1346− testProperty "tl_write_read_line" tl_write_read_line
1347− -- These tests are subject to I/O race conditions when run under
1348− -- test-framework-quickcheck2.
1349− -- testProperty "t_put_get" t_put_get
1350− -- testProperty "tl_put_get" tl_put_get
1351− ],
1352− -}
1353−
1354− testGroup "lowlevel" [
1355− testProperty "t_dropWord16" t_dropWord16,
1356− testProperty "t_takeWord16" t_takeWord16,
1357− testProperty "t_take_drop_16" t_take_drop_16,
1358− testProperty "t_use_from" t_use_from,
1359− testProperty "t_copy" t_copy
1360− ],
1361−
1362− testGroup "mul" Mul.tests
1363− ]
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− ]
tests/Tests/QuickCheckUtils.hsdeleted−360
@@ -1,360 +0,0 @@
1−-- | This module provides quickcheck utilities, e.g. arbitrary and show
2−-- instances, and comparison functions, so we can focus on the actual properties
3−-- in the 'Tests.Properties' module.
4−--
5−{-# LANGUAGE CPP, FlexibleInstances, TypeSynonymInstances #-}
6−{-# OPTIONS_GHC -fno-warn-orphans #-}
7−module Tests.QuickCheckUtils
8− (
9− genUnicode
10− , unsquare
11− , smallArbitrary
12−
13− , BigBounded(..)
14− , BigInt(..)
15− , NotEmpty(..)
16−
17− , Small(..)
18− , small
19−
20− , Precision(..)
21− , precision
22−
23− , integralRandomR
24−
25− , DecodeErr(..)
26− , genDecodeErr
27−
28− , Stringy(..)
29− , eq
30− , eqP
31−
32− , Encoding(..)
33−
34− , write_read
35− ) where
36−
37−import Control.Applicative ((<$>))
38−import Control.Arrow (first, (***))
39−import Control.DeepSeq (NFData (..), deepseq)
40−import Control.Exception (bracket)
41−import Data.String (IsString, fromString)
42−import Data.Text.Foreign (I16)
43−import Data.Text.Lazy.Builder.RealFloat (FPFormat(..))
44−import Data.Word (Word8, Word16)
45−import Debug.Trace (trace)
46−import System.Random (Random(..), RandomGen)
47−import Test.QuickCheck hiding (Fixed(..), Small (..), (.&.))
48−import Test.QuickCheck.Monadic (assert, monadicIO, run)
49−import Test.QuickCheck.Unicode (string)
50−import Tests.Utils
51−import qualified Data.ByteString as B
52−import qualified Data.Text as T
53−import qualified Data.Text.Encoding.Error as T
54−import qualified Data.Text.Internal.Fusion as TF
55−import qualified Data.Text.Internal.Fusion.Common as TF
56−import qualified Data.Text.Internal.Lazy as TL
57−import qualified Data.Text.Internal.Lazy.Fusion as TLF
58−import qualified Data.Text.Lazy as TL
59−import qualified System.IO as IO
60−
61−#if !MIN_VERSION_base(4,4,0)
62−import Data.Int (Int64)
63−import Data.Word (Word, Word64)
64−#endif
65−
66−genUnicode :: IsString a => Gen a
67−genUnicode = fromString <$> string
68−
69−instance Random I16 where
70− randomR = integralRandomR
71− random = randomR (minBound,maxBound)
72−
73−instance Arbitrary I16 where
74− arbitrary = arbitrarySizedIntegral
75− shrink = shrinkIntegral
76−
77−instance Arbitrary B.ByteString where
78− 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−
90−instance Random Word8 where
91− randomR = integralRandomR
92− random = randomR (minBound,maxBound)
93−
94−instance Random Word64 where
95− randomR = integralRandomR
96− random = randomR (minBound,maxBound)
97−#endif
98−
99−-- For tests that have O(n^2) running times or input sizes, resize
100−-- their inputs to the square root of the originals.
101−unsquare :: (Arbitrary a, Show a, Testable b) => (a -> b) -> Property
102−unsquare = forAll smallArbitrary
103−
104−smallArbitrary :: (Arbitrary a, Show a) => Gen a
105−smallArbitrary = sized $ \n -> resize (smallish n) arbitrary
106− where smallish = round . (sqrt :: Double -> Double) . fromIntegral . abs
107−
108−instance Arbitrary T.Text where
109− arbitrary = T.pack `fmap` arbitrary
110− shrink = map T.pack . shrink . T.unpack
111−
112−instance Arbitrary TL.Text where
113− 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−
130−newtype NotEmpty a = NotEmpty { notEmpty :: a }
131− deriving (Eq, Ord)
132−
133−instance Show a => Show (NotEmpty a) where
134− show (NotEmpty a) = show a
135−
136−instance Functor NotEmpty where
137− fmap f (NotEmpty a) = NotEmpty (f a)
138−
139−instance Arbitrary a => Arbitrary (NotEmpty [a]) where
140− arbitrary = sized (\n -> NotEmpty `fmap` (choose (1,n+1) >>= vector))
141− shrink = shrinkNotEmpty null
142−
143−instance Arbitrary (NotEmpty T.Text) where
144− arbitrary = (fmap T.pack) `fmap` arbitrary
145− shrink = shrinkNotEmpty T.null
146−
147−instance Arbitrary (NotEmpty TL.Text) where
148− arbitrary = (fmap TL.pack) `fmap` arbitrary
149− shrink = shrinkNotEmpty TL.null
150−
151−instance Arbitrary (NotEmpty B.ByteString) where
152− 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−
159−data Small = S0 | S1 | S2 | S3 | S4 | S5 | S6 | S7
160− | S8 | S9 | S10 | S11 | S12 | S13 | S14 | S15
161− | S16 | S17 | S18 | S19 | S20 | S21 | S22 | S23
162− | S24 | S25 | S26 | S27 | S28 | S29 | S30 | S31
163− deriving (Eq, Ord, Enum, Bounded)
164−
165−small :: Integral a => Small -> a
166−small = fromIntegral . fromEnum
167−
168−intf :: (Int -> Int -> Int) -> Small -> Small -> Small
169−intf f a b = toEnum ((fromEnum a `f` fromEnum b) `mod` 32)
170−
171−instance Show Small where
172− show = show . fromEnum
173−
174−instance Read Small where
175− readsPrec n = map (first toEnum) . readsPrec n
176−
177−instance Num Small where
178− fromInteger = toEnum . fromIntegral
179− signum _ = 1
180− abs = id
181− (+) = intf (+)
182− (-) = intf (-)
183− (*) = intf (*)
184−
185−instance Real Small where
186− toRational = toRational . fromEnum
187−
188−instance Integral Small where
189− toInteger = toInteger . fromEnum
190− quotRem a b = (toEnum x, toEnum y)
191− where (x, y) = fromEnum a `quotRem` fromEnum b
192−
193−instance Random Small where
194− randomR = integralRandomR
195− random = randomR (minBound,maxBound)
196−
197−instance Arbitrary Small where
198− arbitrary = choose (minBound, maxBound)
199− shrink = shrinkIntegral
200−
201−integralRandomR :: (Integral a, RandomGen g) => (a,a) -> g -> (a,g)
202−integralRandomR (a,b) g = case randomR (fromIntegral a :: Integer,
203− fromIntegral b :: Integer) g of
204− (x,h) -> (fromIntegral x, h)
205−
206−data DecodeErr = Lenient | Ignore | Strict | Replace
207− deriving (Show, Eq)
208−
209−genDecodeErr :: DecodeErr -> Gen T.OnDecodeError
210−genDecodeErr Lenient = return T.lenientDecode
211−genDecodeErr Ignore = return T.ignore
212−genDecodeErr Strict = return T.strictDecode
213−genDecodeErr Replace = arbitrary
214−
215−instance Arbitrary DecodeErr where
216− arbitrary = elements [Lenient, Ignore, Strict, Replace]
217−
218−class Stringy s where
219− packS :: String -> s
220− unpackS :: s -> String
221− splitAtS :: Int -> s -> (s,s)
222− packSChunkSize :: Int -> String -> s
223− packSChunkSize _ = packS
224−
225−instance Stringy String where
226− packS = id
227− unpackS = id
228− splitAtS = splitAt
229−
230−instance Stringy (TF.Stream Char) where
231− packS = TF.streamList
232− unpackS = TF.unstreamList
233− splitAtS n s = (TF.take n s, TF.drop n s)
234−
235−instance Stringy T.Text where
236− packS = T.pack
237− unpackS = T.unpack
238− splitAtS = T.splitAt
239−
240−instance Stringy TL.Text where
241− packSChunkSize k = TLF.unstreamChunks k . TF.streamList
242− packS = TL.pack
243− unpackS = TL.unpack
244− splitAtS = ((TL.lazyInvariant *** TL.lazyInvariant) .) .
245− TL.splitAt . fromIntegral
246−
247−-- Do two functions give the same answer?
248−eq :: (Eq a, Show a) => (t -> a) -> (t -> a) -> t -> Bool
249−eq a b s = a s =^= b s
250−
251−-- What about with the RHS packed?
252−eqP :: (Eq a, Show a, Stringy s) =>
253− (String -> a) -> (s -> a) -> String -> Word8 -> Bool
254−eqP f g s w = eql "orig" (f s) (g t) &&
255− eql "mini" (f s) (g mini) &&
256− eql "head" (f sa) (g ta) &&
257− eql "tail" (f sb) (g tb)
258− where t = packS s
259− mini = packSChunkSize 10 s
260− (sa,sb) = splitAt m s
261− (ta,tb) = splitAtS m t
262− l = length s
263− m | l == 0 = n
264− | otherwise = n `mod` l
265− n = fromIntegral w
266− eql d a b
267− | a =^= b = True
268− | otherwise = trace (d ++ ": " ++ show a ++ " /= " ++ show b) False
269−
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.
295−data Encoding = E String IO.TextEncoding
296−
297−instance Show Encoding where show (E n _) = "utf" ++ n
298−
299−instance Arbitrary Encoding where
300− arbitrary = oneof . map return $
301− [ E "8" IO.utf8, E "8_bom" IO.utf8_bom, E "16" IO.utf16
302− , E "16le" IO.utf16le, E "16be" IO.utf16be, E "32" IO.utf32
303− , E "32le" IO.utf32le, E "32be" IO.utf32be
304− ]
305−
306−windowsNewlineMode :: IO.NewlineMode
307−windowsNewlineMode = IO.NewlineMode
308− { IO.inputNL = IO.CRLF, IO.outputNL = IO.CRLF
309− }
310−
311−instance Arbitrary IO.NewlineMode where
312− arbitrary = oneof . map return $
313− [ IO.noNewlineTranslation, IO.universalNewlineMode, IO.nativeNewlineMode
314− , windowsNewlineMode
315− ]
316−
317−instance Arbitrary IO.BufferMode where
318− arbitrary = oneof [ return IO.NoBuffering,
319− return IO.LineBuffering,
320− return (IO.BlockBuffering Nothing),
321− (IO.BlockBuffering . Just . (+1) . fromIntegral) `fmap`
322− (arbitrary :: Gen Word16) ]
323−
324−-- This test harness is complex! What property are we checking?
325−--
326−-- Reading after writing a multi-line file should give the same
327−-- results as were written.
328−--
329−-- What do we vary while checking this property?
330−-- * The lines themselves, scrubbed to contain neither CR nor LF. (By
331−-- working with a list of lines, we ensure that the data will
332−-- sometimes contain line endings.)
333−-- * Encoding.
334−-- * Newline translation mode.
335−-- * Buffering.
336−write_read :: (NFData a, Eq a)
337− => ([b] -> a)
338− -> ((Char -> Bool) -> a -> b)
339− -> (IO.Handle -> a -> IO ())
340− -> (IO.Handle -> IO a)
341− -> Encoding
342− -> IO.NewlineMode
343− -> IO.BufferMode
344− -> [a]
345− -> Property
346−write_read unline filt writer reader (E _ _) nl buf ts =
347− monadicIO $ assert . (==t) =<< run act
348− where t = unline . map (filt (not . (`elem` "\r\n"))) $ ts
349− act = withTempFile $ \path h -> do
350− -- hSetEncoding h enc
351− IO.hSetNewlineMode h nl
352− IO.hSetBuffering h buf
353− () <- writer h t
354− IO.hClose h
355− bracket (IO.openFile path IO.ReadMode) IO.hClose $ \h' -> do
356− -- hSetEncoding h' enc
357− IO.hSetNewlineMode h' nl
358− IO.hSetBuffering h' buf
359− r <- reader h'
360− r `deepseq` return r
tests/Tests/Regressions.hsdeleted−82
@@ -1,82 +0,0 @@
1−-- | Regression tests for specific bugs.
2−--
3−{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}
4−module Tests.Regressions
5− (
6− tests
7− ) where
8−
9−import Control.Exception (SomeException, handle)
10−import System.IO
11−import Test.HUnit (assertBool, assertEqual, assertFailure)
12−import qualified Data.ByteString as B
13−import Data.ByteString.Char8 ()
14−import qualified Data.ByteString.Lazy as LB
15−import qualified Data.Text as T
16−import qualified Data.Text.Encoding as TE
17−import qualified Data.Text.IO as T
18−import qualified Data.Text.Lazy as LT
19−import qualified Data.Text.Lazy.Encoding as LE
20−import qualified Data.Text.Unsafe as T
21−import qualified Test.Framework as F
22−import qualified Test.Framework.Providers.HUnit as F
23−
24−import Tests.Utils (withTempFile)
25−
26−-- Reported by Michael Snoyman: UTF-8 encoding a large lazy bytestring
27−-- caused either a segfault or attempt to allocate a negative number
28−-- of bytes.
29−lazy_encode_crash :: IO ()
30−lazy_encode_crash = withTempFile $ \ _ h ->
31− LB.hPut h . LE.encodeUtf8 . LT.pack . replicate 100000 $ 'a'
32−
33−-- Reported by Pieter Laeremans: attempting to read an incorrectly
34−-- encoded file can result in a crash in the RTS (i.e. not merely an
35−-- exception).
36−hGetContents_crash :: IO ()
37−hGetContents_crash = withTempFile $ \ path h -> do
38− B.hPut h (B.pack [0x78, 0xc4 ,0x0a]) >> hClose h
39− h' <- openFile path ReadMode
40− hSetEncoding h' utf8
41− handle (\(_::SomeException) -> return ()) $
42− T.hGetContents h' >> assertFailure "T.hGetContents should crash"
43−
44−-- Reported by Ian Lynagh: attempting to allocate a sufficiently large
45−-- string (via either Array.new or Text.replicate) could result in an
46−-- integer overflow.
47−replicate_crash :: IO ()
48−replicate_crash = handle (\(_::SomeException) -> return ()) $
49− T.replicate (2^power) "0123456789abcdef" `seq`
50− assertFailure "T.replicate should crash"
51− where
52− power | maxBound == (2147483647::Int) = 28
53− | otherwise = 60 :: Int
54−
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−
75−tests :: F.Test
76−tests = F.testGroup "Regressions"
77− [ F.testCase "hGetContents_crash" hGetContents_crash
78− , F.testCase "lazy_encode_crash" lazy_encode_crash
79− , F.testCase "mapAccumL_resize" mapAccumL_resize
80− , F.testCase "replicate_crash" replicate_crash
81− , F.testCase "utf8_decode_unsafe" utf8_decode_unsafe
82− ]
tests/Tests/Utils.hsdeleted−52
@@ -1,52 +0,0 @@
1−-- | Miscellaneous testing utilities
2−--
3−{-# LANGUAGE ScopedTypeVariables #-}
4−module Tests.Utils
5− (
6− (=^=)
7− , withRedirect
8− , withTempFile
9− ) where
10−
11−import Control.Exception (SomeException, bracket, bracket_, evaluate, try)
12−import Control.Monad (when)
13−import Debug.Trace (trace)
14−import GHC.IO.Handle.Internals (withHandle)
15−import System.Directory (removeFile)
16−import System.IO (Handle, hClose, hFlush, hIsOpen, hIsWritable, openTempFile)
17−import System.IO.Unsafe (unsafePerformIO)
18−
19−-- Ensure that two potentially bottom values (in the sense of crashing
20−-- for some inputs, not looping infinitely) either both crash, or both
21−-- give comparable results for some input.
22−(=^=) :: (Eq a, Show a) => a -> a -> Bool
23−i =^= j = unsafePerformIO $ do
24− x <- try (evaluate i)
25− y <- try (evaluate j)
26− case (x,y) of
27− (Left (_ :: SomeException), Left (_ :: SomeException))
28− -> return True
29− (Right a, Right b) -> return (a == b)
30− e -> trace ("*** Divergence: " ++ show e) return False
31−infix 4 =^=
32−{-# NOINLINE (=^=) #-}
33−
34−withTempFile :: (FilePath -> Handle -> IO a) -> IO a
35−withTempFile = bracket (openTempFile "." "crashy.txt") cleanupTemp . uncurry
36− where
37− cleanupTemp (path,h) = do
38− open <- hIsOpen h
39− when open (hClose h)
40− removeFile path
41−
42−withRedirect :: Handle -> Handle -> IO a -> IO a
43−withRedirect tmp h = bracket_ swap swap
44− where
45− whenM p a = p >>= (`when` a)
46− swap = do
47− whenM (hIsOpen tmp) $ whenM (hIsWritable tmp) $ hFlush tmp
48− whenM (hIsOpen h) $ whenM (hIsWritable h) $ hFlush h
49− withHandle "spam" tmp $ \tmph -> do
50− hh <- withHandle "spam" h $ \hh ->
51− return (tmph,hh)
52− return (hh,())
tests/benchmarks/FileIndices.hsnew file+25
@@ -0,0 +1,25 @@
1+{-# LANGUAGE BangPatterns #-}
2+
3+import System.Environment (getArgs)
4+import qualified Data.Text.Lazy.IO as T
5+import qualified Data.Text.Lazy as T
6+import qualified Data.Text.Lazy.Encoding as T
7+import qualified Data.ByteString.Lazy.Char8 as B
8+import qualified Data.ByteString.Char8 as BS
9+import qualified Data.ByteString.Lazy.Search as B
10+
11+text :: FilePath -> String -> IO ()
12+text file pat = T.readFile file >>= print . T.count (T.pack pat)
13+
14+textBS :: FilePath -> String -> IO ()
15+textBS file pat = B.readFile file >>= print . T.count (T.pack pat) . T.decodeUtf8
16+
17+bytestring :: FilePath -> String -> IO ()
18+bytestring file pat = B.readFile file >>= print . length . B.indices (BS.pack pat)
19+
20+main = do
21+ (name : file : pat : _) <- getArgs
22+ case name of
23+ "bs" -> bytestring file pat
24+ "text" -> text file pat
25+ "textBS" -> textBS file pat
tests/benchmarks/FileRead.hsnew file+29
@@ -0,0 +1,29 @@
1+{-# LANGUAGE BangPatterns #-}
2+
3+import System.Environment (getArgs)
4+import qualified Data.Text.Lazy.IO as T
5+import qualified Data.Text.Lazy as T
6+import qualified Data.Text.Lazy.Encoding as T
7+import qualified Data.ByteString.Lazy.Char8 as B
8+import qualified Data.ByteString.Char8 as BS
9+import qualified Data.ByteString.Lazy.Search as B
10+
11+string :: FilePath -> IO ()
12+string file = readFile file >>= print . length
13+
14+text :: FilePath -> IO ()
15+text file = T.readFile file >>= print . T.length
16+
17+textBS :: FilePath -> IO ()
18+textBS file = B.readFile file >>= print . T.length . T.decodeUtf8
19+
20+bytestring :: FilePath -> IO ()
21+bytestring file = B.readFile file >>= print . B.length
22+
23+main = do
24+ (name : file : _) <- getArgs
25+ case name of
26+ "bs" -> bytestring file
27+ "string" -> string file
28+ "text" -> text file
29+ "textBS" -> textBS file
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/scripts/cover-stdio.shdeleted−62
@@ -1,62 +0,0 @@
1−#!/bin/bash
2−
3−if [[ $# < 1 ]]; then
4− echo "Usage: $0 <exe>"
5− exit 1
6−fi
7−
8−exe=$1
9−
10−rm -f $exe.tix
11−
12−f=$(mktemp stdio-f.XXXXXX)
13−g=$(mktemp stdio-g.XXXXXX)
14−
15−for t in T TL; do
16− echo $t.readFile > $f
17− $exe $t.readFile $f > $g
18− if ! diff -u $f $g; then
19− errs=$((errs+1))
20− echo FAIL: $t.readFile 1>&2
21− fi
22−
23− $exe $t.writeFile $f $t.writeFile
24− echo -n $t.writeFile > $g
25− if ! diff -u $f $g; then
26− errs=$((errs+1))
27− echo FAIL: $t.writeFile 1>&2
28− fi
29−
30− echo -n quux > $f
31− $exe $t.appendFile $f $t.appendFile
32− echo -n quux$t.appendFile > $g
33− if ! diff -u $f $g; then
34− errs=$((errs+1))
35− echo FAIL: $t.appendFile 1>&2
36− fi
37−
38− echo $t.interact | $exe $t.interact > $f
39− echo $t.interact > $g
40− if ! diff -u $f $g; then
41− errs=$((errs+1))
42− echo FAIL: $t.interact 1>&2
43− fi
44−
45− echo $t.getContents | $exe $t.getContents > $f
46− echo $t.getContents > $g
47− if ! diff -u $f $g; then
48− errs=$((errs+1))
49− echo FAIL: $t.getContents 1>&2
50− fi
51−
52− echo $t.getLine | $exe $t.getLine > $f
53− echo $t.getLine > $g
54− if ! diff -u $f $g; then
55− errs=$((errs+1))
56− echo FAIL: $t.getLine 1>&2
57− fi
58−done
59−
60−rm -f $f $g
61−
62−exit $errs
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+55−175
@@ -1,208 +1,88 @@
1name: text
1name: text
2−version: 1.2.2.1
2+version: 0.8.0.0
3−homepage: https://github.com/bos/text
4−bug-reports: https://github.com/bos/text/issues
5−synopsis: An efficient packed Unicode text type.
3+synopsis: An efficient packed Unicode text type
6−description:
7− .
8− An efficient packed, immutable Unicode text type (both strict and
4+description: An efficient packed Unicode text type.
9− lazy), with a powerful loop fusion optimization framework.
10− .
11− The 'Text' type represents Unicode character strings, in a time and
12− space-efficient manner. This package provides text processing
13− capabilities that are optimized for performance critical use, both
14− in terms of large data quantities and high speed.
15− .
16− The 'Text' type provides character-encoding, type-safe case
17− conversion via whole-string case conversion functions. It also
18− provides a range of functions for converting 'Text' values to and from
19− 'ByteStrings', using several standard encodings.
20− .
21− Efficient locale-sensitive support for text IO is also supported.
22− .
23− These modules are intended to be imported qualified, to avoid name
24− clashes with Prelude functions, e.g.
25− .
26− > import qualified Data.Text as T
27− .
28− To use an extended and very rich family of functions for working
29− with Unicode text (including normalization, regular expressions,
30− non-standard encodings, text breaking, and locales), see
31− the @text-icu@ package:
32− <http://hackage.haskell.org/package/text-icu>
33−
34−license: BSD2
5+license: BSD3
35license-file: LICENSE
6license-file: LICENSE
36−author: Bryan O'Sullivan <bos@serpentine.com>
7+author: Tom Harper <rtharper@aftereternity.co.uk>
37maintainer: Bryan O'Sullivan <bos@serpentine.com>
8maintainer: Bryan O'Sullivan <bos@serpentine.com>
9+ Tom Harper <rtharper@aftereternity.co.uk>
10+ Duncan Coutts <duncan@haskell.org>
38−copyright: 2009-2011 Bryan O'Sullivan, 2008-2009 Tom Harper
11+copyright: 2008-2009 Tom Harper, 2009-2010 Bryan O'Sullivan
39category: Data, Text
12category: Data, Text
40build-type: Simple
13build-type: Simple
41−cabal-version: >= 1.8
14+cabal-version: >= 1.2.3
42extra-source-files:
15extra-source-files:
16+ README
17+ TODO
18+ scripts/ApiCompare.hs
19+ scripts/Arsec.hs
20+ scripts/CaseFolding.hs
43 -- scripts/CaseFolding.txt
21 -- scripts/CaseFolding.txt
22+ scripts/CaseMapping.hs
23+ scripts/SpecialCasing.hs
44 -- scripts/SpecialCasing.txt
24 -- 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
57− tests-and-benchmarks.markdown
58− tests/*.hs
59− tests/.ghci
60 tests/Makefile
25 tests/Makefile
61− tests/Tests/*.hs
26+ tests/Benchmarks.hs
62− tests/Tests/Properties/*.hs
27+ tests/Properties.hs
63− tests/cabal.config
28+ tests/QuickCheckUtils.hs
64− tests/scripts/*.sh
29+ tests/SlowFunctions.hs
65− tests/text-tests.cabal
66−
67−flag bytestring-builder
68− description: Depend on the bytestring-builder package for backwards compatibility.
69− default: False
70− manual: False
71
30
72flag developer
31flag developer
73 description: operate in developer mode
32 description: operate in developer mode
74 default: False
33 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
34
82library
35library
83− c-sources: cbits/cbits.c
84− include-dirs: include
85−
86 exposed-modules:
36 exposed-modules:
87 Data.Text
37 Data.Text
88− Data.Text.Array
89 Data.Text.Encoding
38 Data.Text.Encoding
90 Data.Text.Encoding.Error
39 Data.Text.Encoding.Error
91 Data.Text.Foreign
40 Data.Text.Foreign
92 Data.Text.IO
41 Data.Text.IO
93− 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
42 Data.Text.Lazy
121− Data.Text.Lazy.Builder
122− Data.Text.Lazy.Builder.Int
123− Data.Text.Lazy.Builder.RealFloat
124 Data.Text.Lazy.Encoding
43 Data.Text.Lazy.Encoding
125 Data.Text.Lazy.IO
44 Data.Text.Lazy.IO
45+ other-modules:
46+ Data.Text.Array
47+ Data.Text.Encoding.Fusion
48+ Data.Text.Encoding.Fusion.Common
49+ Data.Text.Encoding.Utf16
50+ Data.Text.Encoding.Utf32
51+ Data.Text.Encoding.Utf8
52+ Data.Text.Fusion
53+ Data.Text.Fusion.CaseMapping
54+ Data.Text.Fusion.Common
55+ Data.Text.Fusion.Internal
56+ Data.Text.Fusion.Size
57+ Data.Text.IO.Internal
58+ Data.Text.Internal
59+ Data.Text.Lazy.Builder
60+ Data.Text.Lazy.Encoding.Fusion
61+ Data.Text.Lazy.Fusion
126 Data.Text.Lazy.Internal
62 Data.Text.Lazy.Internal
127− Data.Text.Lazy.Read
63+ Data.Text.Lazy.Search
128− Data.Text.Read
64+ Data.Text.Search
129 Data.Text.Unsafe
65 Data.Text.Unsafe
130−
66+ Data.Text.UnsafeChar
131− other-modules:
132− Data.Text.Show
67+ Data.Text.UnsafeShift
133
68
134 build-depends:
69 build-depends:
135− array >= 0.3,
136− base >= 4.2 && < 5,
70+ base < 5,
137− binary,
71+ bytestring >= 0.9 && < 1.0
138− deepseq >= 1.1.0.0,
72+ 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,
73+ build-depends:
143− bytestring-builder >= 0.10.4
74+ ghc-prim, base >= 4, deepseq >= 1.1.0.0
75+ cpp-options: -DHAVE_DEEPSEQ
144 else
76 else
145− build-depends: bytestring >= 0.10.4
77+ build-depends: extensible-exceptions
78+ extensions: PatternSignatures
79+
80+ -- gather extensive profiling data for now
81+ ghc-prof-options: -auto-all
146
82
147− cpp-options: -DHAVE_DEEPSEQ
148− ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2
83+ ghc-options: -Wall -funbox-strict-fields -O2
84+ if impl(ghc >= 6.8)
85+ ghc-options: -fwarn-tabs
149 if flag(developer)
86 if flag(developer)
150− ghc-prof-options: -auto-all
151 ghc-options: -Werror
87 ghc-options: -Werror
152 cpp-options: -DASSERTS
88 cpp-options: -DASSERTS
153−
154− if flag(integer-simple)
155− cpp-options: -DINTEGER_SIMPLE
156− build-depends: integer-simple >= 0.1 && < 0.5
157− else
158− cpp-options: -DINTEGER_GMP
159− build-depends: integer-gmp >= 0.2
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−
171− cpp-options:
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
200− build-depends: integer-gmp >= 0.2
201−
202−source-repository head
203− type: git
204− location: https://github.com/bos/text
205−
206−source-repository head
207− type: mercurial
208− location: https://bitbucket.org/bos/text