git.iko.soy/text
on master help sign in
Migrate benchmark suite to criterion/cabal
0816c04Jasper Van der Jeugt
tests/Benchmarks.hsdeleted−463
compare with master
unifiedsplit
@@ -1,463 +0,0 @@
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 Data.ByteString.UTF8 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 "encode" [
118− bench "ts" $ nf TS.encodeUtf8 tsa
119− , bench "tl" $ nf TL.encodeUtf8 tla
120− , bench "bs" $ nf BS.pack la
121− , bench "bl" $ nf BL.pack la
122− , bench "l" $ nf UTF8.fromString la
123− ],
124− bgroup "filter" [
125− bench "ts" $ nf (TS.filter p0) tsa
126− , bench "tl" $ nf (TL.filter p0) tla
127− , bench "bs" $ nf (BS.filter p0) bsa
128− , bench "bl" $ nf (BL.filter p0) bla
129− , bench "l" $ nf (L.filter p0) la
130− ],
131− bgroup "filter.filter" [
132− bench "ts" $ nf (TS.filter p1 . TS.filter p0) tsa
133− , bench "tl" $ nf (TL.filter p1 . TL.filter p0) tla
134− , bench "bs" $ nf (BS.filter p1 . BS.filter p0) bsa
135− , bench "bl" $ nf (BL.filter p1 . BL.filter p0) bla
136− , bench "l" $ nf (L.filter p1 . L.filter p0) la
137− ],
138− bgroup "foldl'" [
139− bench "ts" $ nf (TS.foldl' len 0) tsa
140− , bench "tl" $ nf (TL.foldl' len 0) tla
141− , bench "bs" $ nf (BS.foldl' len 0) bsa
142− , bench "bl" $ nf (BL.foldl' len 0) bla
143− , bench "l" $ nf (L.foldl' len 0) la
144− ],
145− bgroup "foldr" [
146− bench "ts" $ nf (L.length . TS.foldr (:) []) tsa
147− , bench "tl" $ nf (L.length . TL.foldr (:) []) tla
148− , bench "bs" $ nf (L.length . BS.foldr (:) []) bsa
149− , bench "bl" $ nf (L.length . BL.foldr (:) []) bla
150− , bench "l" $ nf (L.length . L.foldr (:) []) la
151− ],
152− bgroup "head" [
153− bench "ts" $ nf TS.head tsa
154− , bench "tl" $ nf TL.head tla
155− , bench "bs" $ nf BS.head bsa
156− , bench "bl" $ nf BL.head bla
157− , bench "l" $ nf L.head la
158− ],
159− bgroup "init" [
160− bench "ts" $ nf TS.init tsa
161− , bench "tl" $ nf TL.init tla
162− , bench "bs" $ nf BS.init bsa
163− , bench "bl" $ nf BL.init bla
164− , bench "l" $ nf L.init la
165− ],
166− bgroup "intercalate" [
167− bench "ts" $ nf (TS.intercalate tsw) tsl
168− , bench "tl" $ nf (TL.intercalate tlw) tll
169− , bench "bs" $ nf (BS.intercalate bsw) bsl
170− , bench "bl" $ nf (BL.intercalate blw) bll
171− , bench "l" $ nf (L.intercalate lw) ll
172− ],
173− bgroup "intersperse" [
174− bench "ts" $ nf (TS.intersperse c) tsa
175− , bench "tl" $ nf (TL.intersperse c) tla
176− , bench "bs" $ nf (BS.intersperse c) bsa
177− , bench "bl" $ nf (BL.intersperse c) bla
178− , bench "l" $ nf (L.intersperse c) la
179− ],
180− bgroup "isInfixOf" [
181− bench "ts" $ nf (TS.isInfixOf tsw) tsa
182− , bench "tl" $ nf (TL.isInfixOf tlw) tla
183− , bench "bs" $ nf (BS.isInfixOf bsw) bsa
184− -- no isInfixOf for lazy bytestrings
185− , bench "l" $ nf (L.isInfixOf lw) la
186− ],
187− bgroup "last" [
188− bench "ts" $ nf TS.last tsa
189− , bench "tl" $ nf TL.last tla
190− , bench "bs" $ nf BS.last bsa
191− , bench "bl" $ nf BL.last bla
192− , bench "l" $ nf L.last la
193− ],
194− bgroup "map" [
195− bench "ts" $ nf (TS.map f) tsa
196− , bench "tl" $ nf (TL.map f) tla
197− , bench "bs" $ nf (BS.map f) bsa
198− , bench "bl" $ nf (BL.map f) bla
199− , bench "l" $ nf (L.map f) la
200− ],
201− bgroup "mapAccumL" [
202− bench "ts" $ nf (TS.mapAccumL g 0) tsa
203− , bench "tl" $ nf (TL.mapAccumL g 0) tla
204− , bench "bs" $ nf (BS.mapAccumL g 0) bsa
205− , bench "bl" $ nf (BL.mapAccumL g 0) bla
206− , bench "l" $ nf (L.mapAccumL g 0) la
207− ],
208− bgroup "mapAccumR" [
209− bench "ts" $ nf (TS.mapAccumR g 0) tsa
210− , bench "tl" $ nf (TL.mapAccumR g 0) tla
211− , bench "bs" $ nf (BS.mapAccumR g 0) bsa
212− , bench "bl" $ nf (BL.mapAccumR g 0) bla
213− , bench "l" $ nf (L.mapAccumR g 0) la
214− ],
215− bgroup "map.map" [
216− bench "ts" $ nf (TS.map f . TS.map f) tsa
217− , bench "tl" $ nf (TL.map f . TL.map f) tla
218− , bench "bs" $ nf (BS.map f . BS.map f) bsa
219− , bench "bl" $ nf (BL.map f . BL.map f) bla
220− , bench "l" $ nf (L.map f . L.map f) la
221− ],
222− bgroup "readFile" [
223− bench "ts" $ TS.readFile dataFile
224− , bench "tl" $ nfIO (TL.readFile dataFile)
225− , bench "bs" $ BS.readFile dataFile
226− , bench "bl" $ nfIO (BL.length `fmap` BL.readFile dataFile)
227− , bench "l" $ nfIO (length `fmap` readFile dataFile)
228− ],
229− bgroup "replicate char" [
230− bench "ts" $ nf (TS.replicate bsa_len) (TS.singleton c)
231− , bench "tl" $ nf (TL.replicate (fromIntegral bsa_len)) (TL.singleton c)
232− , bench "bs" $ nf (BS.replicate bsa_len) c
233− , bench "bl" $ nf (BL.replicate (fromIntegral bsa_len)) c
234− , bench "l" $ nf (L.replicate bsa_len) c
235− ],
236− bgroup "replicate string" [
237− bench "ts" $ nf (TS.replicate (bsa_len `div` TS.length tsw)) tsw
238− , bench "tl" $ nf (TL.replicate (fromIntegral bsa_len `div` TL.length tlw)) tlw
239− , bench "l" $ nf (replicat (bsa_len `div` TS.length tsw)) lw
240− ],
241− bgroup "reverse" [
242− bench "ts" $ nf TS.reverse tsa
243− , bench "tl" $ nf TL.reverse tla
244− , bench "bs" $ nf BS.reverse bsa
245− , bench "bl" $ nf BL.reverse bla
246− , bench "l" $ nf L.reverse la
247− ],
248− bgroup "take" [
249− bench "ts" $ nf (TS.take (tsa_len `div` 3)) tsa
250− , bench "tl" $ nf (TL.take (tla_len `div` 3)) tla
251− , bench "bs" $ nf (BS.take (bsa_len `div` 3)) bsa
252− , bench "bl" $ nf (BL.take (bla_len `div` 3)) bla
253− , bench "l" $ nf (L.take (la_len `div` 3)) la
254− ],
255− bgroup "tail" [
256− bench "ts" $ nf TS.tail tsa
257− , bench "tl" $ nf TL.tail tla
258− , bench "bs" $ nf BS.tail bsa
259− , bench "bl" $ nf BL.tail bla
260− , bench "l" $ nf L.tail la
261− ],
262− bgroup "toLower" [
263− bench "ts" $ nf TS.toLower tsa
264− , bench "tl" $ nf TL.toLower tla
265− , bench "bs" $ nf (BS.map toLower) bsa
266− , bench "bl" $ nf (BL.map toLower) bla
267− , bench "l" $ nf (L.map toLower) la
268− ],
269− bgroup "toUpper" [
270− bench "ts" $ nf TS.toUpper tsa
271− , bench "tl" $ nf TL.toUpper tla
272− , bench "bs" $ nf (BS.map toUpper) bsa
273− , bench "bl" $ nf (BL.map toUpper) bla
274− , bench "l" $ nf (L.map toUpper) la
275− ],
276− bgroup "words" [
277− bench "ts" $ nf TS.words tsa
278− , bench "tl" $ nf TL.words tla
279− , bench "bs" $ nf BS.words bsa
280− , bench "bl" $ nf BL.words bla
281− , bench "l" $ nf L.words la
282− ],
283− bgroup "zipWith" [
284− bench "ts" $ nf (TS.zipWith min tsb) tsa
285− , bench "tl" $ nf (TL.zipWith min tlb) tla
286− , bench "bs" $ nf (BS.zipWith min bsb) bsa
287− , bench "bl" $ nf (BL.zipWith min blb) bla
288− , bench "l" $ nf (L.zipWith min lb) la
289− ],
290− bgroup "length" [
291− bgroup "cons" [
292− bench "ts" $ nf (TS.length . TS.cons c) tsa
293− , bench "tl" $ nf (TL.length . TL.cons c) tla
294− , bench "bs" $ nf (BS.length . BS.cons c) bsa
295− , bench "bl" $ nf (BL.length . BL.cons c) bla
296− , bench "l" $ nf (L.length . (:) c) la
297− ],
298− bgroup "decode" [
299− bench "ts" $ nf (TS.length . TS.decodeUtf8) bsa
300− , bench "tl" $ nf (TL.length . TL.decodeUtf8) bla
301− , bench "bs" $ nf (L.length . BS.unpack) bsa
302− , bench "bl" $ nf (L.length . BL.unpack) bla
303− , bench "utf8-string" $ nf (L.length . UTF8.toString) bsa
304− ],
305− bgroup "drop" [
306− bench "ts" $ nf (TS.length . TS.drop (tsa_len `div` 3)) tsa
307− , bench "tl" $ nf (TL.length . TL.drop (tla_len `div` 3)) tla
308− , bench "bs" $ nf (BS.length . BS.drop (bsa_len `div` 3)) bsa
309− , bench "bl" $ nf (BL.length . BL.drop (bla_len `div` 3)) bla
310− , bench "l" $ nf (L.length . L.drop (la_len `div` 3)) la
311− ],
312− bgroup "filter" [
313− bench "ts" $ nf (TS.length . TS.filter p0) tsa
314− , bench "tl" $ nf (TL.length . TL.filter p0) tla
315− , bench "bs" $ nf (BS.length . BS.filter p0) bsa
316− , bench "bl" $ nf (BL.length . BL.filter p0) bla
317− , bench "l" $ nf (L.length . L.filter p0) la
318− ],
319− bgroup "filter.filter" [
320− bench "ts" $ nf (TS.length . TS.filter p1 . TS.filter p0) tsa
321− , bench "tl" $ nf (TL.length . TL.filter p1 . TL.filter p0) tla
322− , bench "bs" $ nf (BS.length . BS.filter p1 . BS.filter p0) bsa
323− , bench "bl" $ nf (BL.length . BL.filter p1 . BL.filter p0) bla
324− , bench "l" $ nf (L.length . L.filter p1 . L.filter p0) la
325− ],
326− bgroup "init" [
327− bench "ts" $ nf (TS.length . TS.init) tsa
328− , bench "tl" $ nf (TL.length . TL.init) tla
329− , bench "bs" $ nf (BS.length . BS.init) bsa
330− , bench "bl" $ nf (BL.length . BL.init) bla
331− , bench "l" $ nf (L.length . L.init) la
332− ],
333− bgroup "intercalate" [
334− bench "ts" $ nf (TS.length . TS.intercalate tsw) tsl
335− , bench "tl" $ nf (TL.length . TL.intercalate tlw) tll
336− , bench "bs" $ nf (BS.length . BS.intercalate bsw) bsl
337− , bench "bl" $ nf (BL.length . BL.intercalate blw) bll
338− , bench "l" $ nf (L.length . L.intercalate lw) ll
339− ],
340− bgroup "intersperse" [
341− bench "ts" $ nf (TS.length . TS.intersperse c) tsa
342− , bench "tl" $ nf (TL.length . TL.intersperse c) tla
343− , bench "bs" $ nf (BS.length . BS.intersperse c) bsa
344− , bench "bl" $ nf (BL.length . BL.intersperse c) bla
345− , bench "l" $ nf (L.length . L.intersperse c) la
346− ],
347− bgroup "map" [
348− bench "ts" $ nf (TS.length . TS.map f) tsa
349− , bench "tl" $ nf (TL.length . TL.map f) tla
350− , bench "bs" $ nf (BS.length . BS.map f) bsa
351− , bench "bl" $ nf (BL.length . BL.map f) bla
352− , bench "l" $ nf (L.length . L.map f) la
353− ],
354− bgroup "map.map" [
355− bench "ts" $ nf (TS.length . TS.map f . TS.map f) tsa
356− , bench "tl" $ nf (TL.length . TL.map f . TL.map f) tla
357− , bench "bs" $ nf (BS.length . BS.map f . BS.map f) bsa
358− , bench "l" $ nf (L.length . L.map f . L.map f) la
359− ],
360− bgroup "replicate char" [
361− bench "ts" $ nf (TS.length . TS.replicate bsa_len) (TS.singleton c)
362− , bench "tl" $ nf (TL.length . TL.replicate (fromIntegral bsa_len)) (TL.singleton c)
363− , bench "bs" $ nf (BS.length . BS.replicate bsa_len) c
364− , bench "bl" $ nf (BL.length . BL.replicate (fromIntegral bsa_len)) c
365− , bench "l" $ nf (L.length . L.replicate bsa_len) c
366− ],
367− bgroup "replicate string" [
368− bench "ts" $ nf (TS.length . TS.replicate (bsa_len `div` TS.length tsw)) tsw
369− , bench "tl" $ nf (TL.length . TL.replicate (fromIntegral bsa_len `div` TL.length tlw)) tlw
370− , bench "l" $ nf (L.length . replicat (bsa_len `div` TS.length tsw)) lw
371− ],
372− bgroup "take" [
373− bench "ts" $ nf (TS.length . TS.take (tsa_len `div` 3)) tsa
374− , bench "tl" $ nf (TL.length . TL.take (tla_len `div` 3)) tla
375− , bench "bs" $ nf (BS.length . BS.take (bsa_len `div` 3)) bsa
376− , bench "bl" $ nf (BL.length . BL.take (bla_len `div` 3)) bla
377− , bench "l" $ nf (L.length . L.take (la_len `div` 3)) la
378− ],
379− bgroup "tail" [
380− bench "ts" $ nf (TS.length . TS.tail) tsa
381− , bench "tl" $ nf (TL.length . TL.tail) tla
382− , bench "bs" $ nf (BS.length . BS.tail) bsa
383− , bench "bl" $ nf (BL.length . BL.tail) bla
384− , bench "l" $ nf (L.length . L.tail) la
385− ],
386− bgroup "toLower" [
387− bench "ts" $ nf (TS.length . TS.toLower) tsa
388− , bench "tl" $ nf (TL.length . TL.toLower) tla
389− , bench "bs" $ nf (BS.length . BS.map toLower) bsa
390− , bench "bl" $ nf (BL.length . BL.map toLower) bla
391− , bench "l" $ nf (L.length . L.map toLower) la
392− ],
393− bgroup "toUpper" [
394− bench "ts" $ nf (TS.length . TS.toUpper) tsa
395− , bench "tl" $ nf (TL.length . TL.toUpper) tla
396− , bench "bs" $ nf (BS.length . BS.map toUpper) bsa
397− , bench "bl" $ nf (BL.length . BL.map toUpper) bla
398− , bench "l" $ nf (L.length . L.map toUpper) la
399− ],
400− bgroup "words" [
401− bench "ts" $ nf (L.length . TS.words) tsa
402− , bench "tl" $ nf (L.length . TL.words) tla
403− , bench "bs" $ nf (L.length . BS.words) bsa
404− , bench "bl" $ nf (L.length . BL.words) bla
405− , bench "l" $ nf (L.length . L.words) la
406− ],
407− bgroup "zipWith" [
408− bench "ts" $ nf (TS.length . TS.zipWith min tsb) tsa
409− , bench "tl" $ nf (TL.length . TL.zipWith min tlb) tla
410− , bench "bs" $ nf (L.length . BS.zipWith min bsb) bsa
411− , bench "bl" $ nf (L.length . BL.zipWith min blb) bla
412− , bench "l" $ nf (L.length . L.zipWith min lb) la
413− ]
414− ],
415− bgroup "builder" [
416− bench "mappend char" $ nf (TL.length . TB.toLazyText . mappendNChar 'a') 10000,
417− bench "mappend 8 char" $ nf (TL.length . TB.toLazyText . mappend8Char) 'a',
418− bench "mappend text" $ nf (TL.length . TB.toLazyText . mappendNText short) 10000
419− ]
420− ]
421− where
422− c = 'й'
423− p0 = (== c)
424− p1 = (/= 'д')
425− lw = "право"
426− bsw = UTF8.fromString lw
427− blw = BL.fromChunks [bsw]
428− tsw = TS.pack lw
429− tlw = TL.fromChunks [tsw]
430− f (C# c#) = C# (chr# (ord# c# +# 1#))
431− g (I# i#) (C# c#) = (I# (i# +# 1#), C# (chr# (ord# c# +# i#)))
432− len l _ = l + (1::Int)
433− replicat n = concat . L.replicate n
434− short = TS.pack "short"
435−
436−chunksOf :: Int -> BS.ByteString -> [BS.ByteString]
437−chunksOf k = go
438− where
439− go t = case BS.splitAt k t of
440− (a,b) | BS.null a -> []
441− | otherwise -> a : go b
442−
443−mappendNChar :: Char -> Int -> TB.Builder
444−mappendNChar c n = go 0
445− where
446− go i
447− | i < n = TB.singleton c `mappend` go (i+1)
448− | otherwise = mempty
449−
450−-- Gives more opportunity for inlining and elimination of unnecesary
451−-- bounds checks.
452−mappend8Char :: Char -> TB.Builder
453−mappend8Char c = TB.singleton c `mappend` TB.singleton c `mappend`
454− TB.singleton c `mappend` TB.singleton c `mappend`
455− TB.singleton c `mappend` TB.singleton c `mappend`
456− TB.singleton c `mappend` TB.singleton c
457−
458−mappendNText :: TS.Text -> Int -> TB.Builder
459−mappendNText t n = go 0
460− where
461− go i
462− | i < n = TB.fromText t `mappend` go (i+1)
463− | otherwise = mempty
tests/Makefile+2−7
@@ -23,7 +23,7 @@ lib-srcs := $(shell grep '^ *Data' ../text.cabal | \
23
23
24cabal := $(shell which cabal 2>/dev/null)
24cabal := $(shell which cabal 2>/dev/null)
25
25
26−all: bm qc coverage regressions
26+all: qc coverage regressions
27
27
28lib: $(lib)
28lib: $(lib)
29
29
@@ -78,11 +78,6 @@ Regressions.o: TestUtils.o
78regressions: Regressions.o TestUtils.o
78regressions: Regressions.o TestUtils.o
79 $(ghc) $(ghc-test-flags) -o $@ $^ $(lib)
79 $(ghc) $(ghc-test-flags) -o $@ $^ $(lib)
80
80
81−Benchmarks.o: ghc-opt-flags = -O
82−bm Benchmarks.o: ghc-flags += -package utf8-string
83−bm: Benchmarks.o
84− $(ghc) $(ghc-flags) -o $@ $^ $(lib)
85−
86SlowFunctions.o: ghc-opt-flags = -O2
81SlowFunctions.o: ghc-opt-flags = -O2
87SearchBench.o: ghc-opt-flags = -O
82SearchBench.o: ghc-opt-flags = -O
88%.o: %.hs
83%.o: %.hs
@@ -98,4 +93,4 @@ text-testdata.tar.bz2:
98 curl -O http://projects.haskell.org/text/text-testdata.tar.bz2
93 curl -O http://projects.haskell.org/text/text-testdata.tar.bz2
99
94
100clean:
95clean:
101− -rm -rf *.o *.hi *.tix bm qc qc-hpc stdio-hpc hpcdir .hpc coverage-html
96+ -rm -rf *.o *.hi *.tix qc qc-hpc stdio-hpc hpcdir .hpc coverage-html
tests/READMEdeleted−2
@@ -1,2 +0,0 @@
1−You also need the test data from:
2−http://projects.haskell.org/text/text-testdata.tar.bz2
tests/README.markdownnew file+42
@@ -0,0 +1,42 @@
1+Tests
2+=====
3+
4+This directory contains the tests for the Text library. To run these tests, you
5+will need the test data from:
6+
7+ http://projects.haskell.org/text/text-testdata.tar.bz2
8+
9+You should extract that archive to the same directory as this README (some tests
10+rely on this).
11+
12+There are two categories of tests: functional tests (including QuickCheck
13+properties), and benchmarks.
14+
15+Functional tests
16+----------------
17+
18+TODO
19+
20+Benchmarks
21+----------
22+
23+The benchmarks are located in the `benchmarks` subdirectory. An overview of
24+what's in that directory:
25+
26+ python Python implementations of some benchmarks
27+ ruby Ruby implementations of some benchmarks
28+ src Source files of the haskell benchmarks
29+ benchmarks.cabal Cabal file which compiles all benchmarks
30+ Makefile Has targets for common tasks
31+
32+To compile the benchmarks, navigate to the `benchmarks` subdirectory and run
33+`cabal configure && cabal build`. Then, you can run the benchmarks using:
34+
35+ ./dist/build/benchmarks/benchmarks
36+
37+However, since there quite a lot of benchmarks, you usually don't want to run
38+them all. Instead, use the `-l` flag to get a list of benchmarks:
39+
40+ ./dist/build/benchmarks/benchmarks
41+
42+And run the ones you want to inspect.
tests/benchmarks/.gitignorenew file+1
@@ -0,0 +1 @@
1+dist
tests/benchmarks/CaseMap.hsdeleted−21
@@ -1,21 +0,0 @@
1−import Control.Exception
2−import Control.Monad
3−import Data.Time.Clock
4−import Data.ByteString as B
5−import Data.Text.Encoding as T
6−import Data.Text as T
7−import System.Environment
8−
9−time act = do
10− start <- getCurrentTime
11− act
12− end <- getCurrentTime
13− let d = diffUTCTime end start
14− print d
15−
16−main = do
17− args <- getArgs
18− forM_ args $ \f -> do
19− t <- T.decodeUtf8 `fmap` B.readFile f
20− evaluate t
21− time $ evaluate (T.toUpper t)
tests/benchmarks/Cut.hsdeleted−60
@@ -1,60 +0,0 @@
1−import qualified Data.ByteString.Char8 as B
2−import qualified Data.ByteString.Lazy.Char8 as BL
3−import qualified Data.Text.IO as T
4−import qualified Data.Text as T
5−import qualified Data.Text.Encoding as T
6−import qualified Data.Text.Lazy.Encoding as TL
7−import qualified Data.Text.Lazy.IO as TL
8−import qualified Data.Text.Lazy as TL
9−import Data.Int (Int64)
10−import Numeric (readDec)
11−import System.Environment (getArgs)
12−
13−bytestring file s e = do
14− t <- B.readFile file
15− B.putStr (cut t)
16− where
17− cut = B.unlines . map (B.take (e - s) . B.drop s) . B.lines
18−
19−lazyBytestring file s e = do
20− t <- BL.readFile file
21− BL.putStr (cut (fromIntegral s) (fromIntegral e) t)
22− where
23− cut s e = BL.unlines . map (BL.take (e - s) . BL.drop s) . BL.lines
24−
25−lazyText file s e = do
26− t <- TL.readFile file
27− TL.putStr (cut (fromIntegral s) (fromIntegral e) t)
28− where
29− cut s e = TL.unlines . map (TL.take (e - s) . TL.drop s) . TL.lines
30−
31−text file s e = do
32− t <- T.readFile file
33− T.putStr (cut t)
34− where
35− cut = T.unlines . map (T.take (e - s) . T.drop s) . T.lines
36−
37−textBS file s e = do
38− bs <- B.readFile file
39− T.putStr . cut . T.decodeUtf8 $ bs
40− where
41− cut = T.unlines . map (T.take (e - s) . T.drop s) . T.lines
42−
43−lazyTextBS file s e = do
44− t <- BL.readFile file
45− TL.putStr (cut (fromIntegral s) (fromIntegral e) (TL.decodeUtf8 t))
46− where
47− cut s e = TL.unlines . map (TL.take (e - s) . TL.drop s) . TL.lines
48−
49−main = do
50− (name : ss : es : file : _) <- getArgs
51− let [(s',"")] = readDec ss
52− [(e,"")] = readDec es
53− s = s' - 1
54− case name of
55− "bs" -> bytestring file s e
56− "lbs" -> lazyBytestring file s e
57− "ltext" -> lazyText file s e
58− "text" -> text file s e
59− "ltextBS" -> lazyTextBS file s e
60− "textBS" -> textBS file s e
tests/benchmarks/DecodeUtf8.hsdeleted−107
@@ -1,107 +0,0 @@
1−import qualified Data.ByteString as B
2−import qualified Data.ByteString.Lazy as BL
3−import qualified Data.Text as T
4−import qualified Data.Text.IO as T
5−import qualified Data.Text.Encoding as T
6−import qualified Data.Text.Lazy as TL
7−import qualified Data.Text.Lazy.Encoding as TL
8−import qualified Data.Text.Lazy.IO as TL
9−import qualified Codec.Binary.UTF8.Generic as U8
10−import Control.DeepSeq
11−import System.Environment
12−import System.IO
13−
14−strict h = do
15− bs <- B.hGetContents h
16− rnf (T.decodeUtf8 bs) `seq` return ()
17−
18−strict_len h = do
19− bs <- B.hGetContents h
20− print . T.length . T.decodeUtf8 $ bs
21−
22−strict_init_len h = do
23− bs <- B.hGetContents h
24− print . T.length . T.init . T.decodeUtf8 $ bs
25−
26−strict_io h = do
27− hSetEncoding h utf8
28− t <- T.hGetContents h
29− rnf t `seq` return ()
30−
31−strict_len_io h = do
32− hSetEncoding h utf8
33− t <- T.hGetContents h
34− print (T.length t)
35−
36−lazy h = do
37− bs <- BL.hGetContents h
38− rnf (TL.decodeUtf8 bs) `seq` return ()
39−
40−lazy_len h = do
41− bs <- BL.hGetContents h
42− print . TL.length . TL.decodeUtf8 $ bs
43−
44−lazy_init_len h = do
45− bs <- BL.hGetContents h
46− print . TL.length . TL.init . TL.decodeUtf8 $ bs
47−
48−lazy_io h = do
49− hSetEncoding h utf8
50− t <- TL.hGetContents h
51− rnf t `seq` return ()
52−
53−lazy_len_io h = do
54− hSetEncoding h utf8
55− t <- TL.hGetContents h
56− print (TL.length t)
57−
58−string h = do
59− hSetEncoding h utf8
60− t <- hGetContents h
61− rnf t `seq` return ()
62−
63−string_len h = do
64− hSetEncoding h utf8
65− t <- hGetContents h
66− print (length t)
67−
68−lazy_string_utf8 h = do
69− bs <- BL.hGetContents h
70− let t = U8.toString bs
71− rnf t `seq` return ()
72−
73−lazy_string_utf8_len h = do
74− bs <- BL.hGetContents h
75− let t = U8.toString bs
76− print (length t)
77−
78−strict_string_utf8 h = do
79− bs <- B.hGetContents h
80− let t = U8.toString bs
81− rnf t `seq` return ()
82−
83−strict_string_utf8_len h = do
84− bs <- B.hGetContents h
85− let t = U8.toString bs
86− print (length t)
87−
88−main = do
89− [kind,name] <- getArgs
90− h <- openFile name ReadMode
91− case kind of
92− "strict" -> strict h
93− "strict_len" -> strict_len h
94− "strict_init_len" -> strict_init_len h
95− "strict_io" -> strict_io h
96− "strict_len_io" -> strict_len_io h
97− "lazy" -> lazy h
98− "lazy_len" -> lazy_len h
99− "lazy_init_len" -> lazy_init_len h
100− "lazy_io" -> lazy_io h
101− "lazy_len_io" -> lazy_len_io h
102− "string" -> string h
103− "string_len" -> string_len h
104− "lazy_string_utf8" -> lazy_string_utf8 h
105− "lazy_string_utf8_len" -> lazy_string_utf8_len h
106− "strict_string_utf8" -> strict_string_utf8 h
107− "strict_string_utf8_len" -> strict_string_utf8_len h
tests/benchmarks/EncodeUtf8.hsdeleted−55
@@ -1,55 +0,0 @@
1−{-# LANGUAGE OverloadedStrings #-}
2−import qualified Data.ByteString as B
3−import qualified Data.ByteString.Lazy as BL
4−import qualified Data.Text as T
5−import qualified Data.Text.IO as T
6−import qualified Data.Text.Encoding as T
7−import qualified Data.Text.Lazy as TL
8−import qualified Data.Text.Lazy.Encoding as TL
9−import qualified Data.Text.Lazy.IO as TL
10−import qualified Codec.Binary.UTF8.Generic as U8
11−import System.Environment
12−import System.IO
13−
14−strict_bytestring k s = do
15− let t = T.replicate k (T.pack s)
16− B.putStr (T.encodeUtf8 t)
17−
18−lazy_bytestring k s = do
19− let t = TL.replicate (fromIntegral k) (TL.pack s)
20− BL.putStr (TL.encodeUtf8 t)
21−
22−strict_io k s = do
23− let t = T.replicate k (T.pack s)
24− hSetEncoding stdout utf8
25− T.putStr t
26−
27−lazy_io k s = do
28− let t = TL.replicate (fromIntegral k) (TL.pack s)
29− hSetEncoding stdout utf8
30− TL.putStr t
31−
32−string k s = do
33− let t = concat $ replicate k s
34− hSetEncoding stdout utf8
35− putStr t
36−
37−lazy_string_utf8 k s = do
38− let t = concat $ replicate k s
39− BL.putStr (U8.fromString t)
40−
41−strict_string_utf8 k s = do
42− let t = concat $ replicate k s
43− B.putStr (U8.fromString t)
44−
45−main = do
46− [kind,str,kstr] <- getArgs
47− let k = read kstr * 1000000
48− case kind of
49− "strict" -> strict_bytestring k str
50− "lazy" -> lazy_bytestring k str
51− "strict_io" -> strict_io k str
52− "lazy_io" -> lazy_io k str
53− "string" -> string k str
54− "lazy_string_utf8" -> lazy_string_utf8 k str
55− "strict_string_utf8" -> strict_string_utf8 k str
tests/benchmarks/Equality.hsdeleted−31
@@ -1,31 +0,0 @@
1−import System.Environment
2−import qualified Data.ByteString.Char8 as B
3−import qualified Data.ByteString.Lazy.Char8 as BL
4−import qualified Data.Text as T
5−import qualified Data.Text.Encoding as T
6−import qualified Data.Text.Lazy as TL
7−import qualified Data.Text.Lazy.Encoding as TL
8−
9−func :: (Eq a) => [a] -> IO ()
10−func ls =
11− print . sum . map (\needle -> length . filter (==needle) $ ls) $ take 100 ls
12−
13−bytestring haystack = func =<< B.lines `fmap` B.readFile haystack
14−
15−lazyBytestring haystack = func =<< BL.lines `fmap` BL.readFile haystack
16−
17−text haystack = func =<< (T.lines . T.decodeUtf8) `fmap` B.readFile haystack
18−
19−lazyText haystack = func =<<
20− (TL.lines . TL.decodeUtf8) `fmap` BL.readFile haystack
21−
22−string haystack = func =<< lines `fmap` readFile haystack
23−
24−main = do
25− args <- getArgs
26− case args of
27− ["bs",h] -> bytestring h
28− ["lazybs",h] -> lazyBytestring h
29− ["text",h] -> text h
30− ["lazytext",h] -> lazyText h
31− ["string",h] -> string h
tests/benchmarks/FileIndices.hsdeleted−25
@@ -1,25 +0,0 @@
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.hsdeleted−57
@@ -1,57 +0,0 @@
1−{-# LANGUAGE BangPatterns #-}
2−
3−import System.Environment (getArgs)
4−import qualified Data.Text.IO as T
5−import qualified Data.Text as T
6−import qualified Data.Text.Encoding as T
7−import qualified Data.Text.Lazy.IO as TL
8−import qualified Data.Text.Lazy as TL
9−import qualified Data.Text.Lazy.Encoding as TL
10−import qualified Data.ByteString.Char8 as B
11−import qualified Data.ByteString.Lazy.Char8 as BL
12−import System.IO
13−
14−string :: Handle -> IO ()
15−string h = hGetContents h >>= print . length
16−
17−ltext :: Handle -> IO ()
18−ltext h = do
19− t <- {-# SCC "TL.hGetContents" #-} TL.hGetContents h
20− print (TL.length t)
21−
22−ltextBS :: Handle -> IO ()
23−ltextBS h = do
24− bs <- {-# SCC "B.hGetContents" #-} BL.hGetContents h
25− print . TL.length . TL.decodeUtf8 $ bs
26−
27−text :: Handle -> IO ()
28−text h = do
29− t <- {-# SCC "T.hGetContents" #-} T.hGetContents h
30− print (T.length t)
31−
32−textBS :: Handle -> IO ()
33−textBS h = do
34− bs <- {-# SCC "B.hGetContents" #-} B.hGetContents h
35− print . T.length . T.decodeUtf8 $ bs
36−
37−lbytestring :: Handle -> IO ()
38−lbytestring h = do
39− bs <- {-# SCC "BL.hGetContents" #-} BL.hGetContents h
40− print (BL.length bs)
41−
42−bytestring :: Handle -> IO ()
43−bytestring h = do
44− bs <- {-# SCC "B.hGetContents" #-} B.hGetContents h
45− print (B.length bs)
46−
47−main = do
48− (name : file : _) <- getArgs
49− h <- openFile file ReadMode
50− case name of
51− "bs" -> bytestring h
52− "lbs" -> lbytestring h
53− "ltext" -> ltext h
54− "ltextBS" -> ltextBS h
55− "string" -> string h
56− "text" -> text h
57− "textBS" -> textBS h
tests/benchmarks/FoldLines.hsdeleted−47
@@ -1,47 +0,0 @@
1−{-# LANGUAGE BangPatterns #-}
2−
3−import System.Environment
4−import System.IO
5−import qualified Data.Text as T
6−import qualified Data.Text.IO as T
7−import qualified Data.ByteString as S
8−
9−-- Text
10−foldLinesT :: (a -> T.Text -> a) -> a -> Handle -> IO a
11−foldLinesT f z0 h = go z0
12− where
13− go !z = do
14− eof <- hIsEOF h
15− if eof
16− then return z
17− else do
18− l <- T.hGetLine h
19− let z' = f z l in go z'
20−{-# INLINE foldLinesT #-}
21−
22−testT :: Handle -> IO Int
23−testT = foldLinesT (\n _ -> n + 1) 0
24−
25−--ByteString
26−foldLinesB :: (a -> S.ByteString -> a) -> a -> Handle -> IO a
27−foldLinesB f z0 h = go z0
28− where
29− go !z = do
30− eof <- hIsEOF h
31− if eof
32− then return z
33− else do
34− l <- S.hGetLine h
35− let z' = f z l in go z'
36−{-# INLINE foldLinesB #-}
37−
38−testB :: Handle -> IO Int
39−testB = foldLinesB (\n _ -> n + 1) 0
40−
41−main = do
42− (name : file : _) <- getArgs
43− h <- openFile file ReadMode
44− hSetBuffering h (BlockBuffering (Just 16384))
45− case name of
46− "bs" -> testB h
47− "text" -> testT h
tests/benchmarks/HtmlCombinator.hsdeleted−24
@@ -1,24 +0,0 @@
1−{-# LANGUAGE BangPatterns, OverloadedStrings #-}
2−import Data.Monoid (mappend, mconcat)
3−import Prelude hiding (putStr)
4−import Data.Text.Lazy.Builder (Builder, fromText, toLazyText)
5−import Data.Text.Lazy.IO (putStr)
6−
7−import qualified Data.Text as T
8−
9−main :: IO ()
10−main = do
11− putStr "Content-Type: text/html\n\n<table>"
12− putStr . toLazyText $ mconcat (replicate 20000 makeRow)
13− putStr "</table>"
14−
15−makeRow :: Builder
16−makeRow = mconcat (map makeCol [1..50])
17−
18−makeCol :: Int -> Builder
19−makeCol 1 = fromText "<tr><td>1</td>"
20−makeCol 50 = fromText "<td>50</td></tr>"
21−makeCol i = fromText "<td>" `mappend` (textInt i `mappend` fromText "</td>")
22−
23−textInt :: Int -> Builder
24−textInt = fromText . T.pack . show
tests/benchmarks/Makefiledeleted−18
@@ -1,18 +0,0 @@
1−CC := $(shell icu-config --cc)
2−CFLAGS := -g $(shell icu-config --cflags)
3−CPPFLAGS := $(shell icu-config --cppflags)
4−LDFLAGS := $(CFLAGS) $(shell icu-config --ldflags --ldflags-icuio)
5−ghc := ghc
6−
7−all := FileRead FileRead_prof Replace Replace_prof fileread_c
8−
9−all: $(all)
10−
11−%: %.hs
12− $(ghc) -O --make -o $@ $^
13−
14−%_prof: %.hs
15− $(ghc) -prof -auto-all -O --make -o $@ $^
16−
17−clean:
18− -rm -f *.hi *.o $(all)
tests/benchmarks/Ordering.hsdeleted−42
@@ -1,42 +0,0 @@
1−import System.Environment
2−import qualified Data.ByteString.Char8 as B
3−import qualified Data.ByteString.Lazy.Char8 as BL
4−import qualified Data.Text as T
5−import qualified Data.Text.Encoding as T
6−import qualified Data.Text.Lazy as TL
7−import qualified Data.Text.Lazy.Encoding as TL
8−
9−every :: Int -> [a] -> [a]
10−every k = go k
11− where go n (x:xs)
12− | n < k = go (n+1) xs
13− | otherwise = x : go 1 xs
14− go _ _ = []
15−
16−func :: (Ord a) => [a] -> IO ()
17−func ls = print . sum . map f $ every 1000 ls
18− where f needle = length . filter ((==GT) . compare needle) $ ls
19−
20−-- Test a comparison that could be fused: compare (toLower a) (toLower b)
21−func1 ls = print . sum . map f $ every 1000 ls
22− where f needle = length . filter ((==GT) . compare (T.toLower needle) . T.toLower) $ ls
23−
24−bytestring haystack = func =<< B.lines `fmap` B.readFile haystack
25−
26−lazyBytestring haystack = func =<< BL.lines `fmap` BL.readFile haystack
27−
28−text haystack = func =<< (T.lines . T.decodeUtf8) `fmap` B.readFile haystack
29−
30−lazyText haystack = func =<<
31− (TL.lines . TL.decodeUtf8) `fmap` BL.readFile haystack
32−
33−string haystack = func =<< lines `fmap` readFile haystack
34−
35−main = do
36− args <- getArgs
37− case args of
38− ["bs",h] -> bytestring h
39− ["lazybs",h] -> lazyBytestring h
40− ["text",h] -> text h
41− ["lazytext",h] -> lazyText h
42− ["string",h] -> string h
tests/benchmarks/ReadNumbers.hsdeleted−48
@@ -1,48 +0,0 @@
1−{-# LANGUAGE BangPatterns #-}
2−
3−import Data.List (foldl')
4−import System.Environment (getArgs)
5−import qualified Data.ByteString.Char8 as B
6−import qualified Data.ByteString.Lazy.Char8 as BL
7−import qualified Data.ByteString.Lex.Double as B
8−import qualified Data.ByteString.Lex.Lazy.Double as BL
9−import qualified Data.Text as T
10−import qualified Data.Text.Encoding as T
11−import qualified Data.Text.Lazy as TL
12−import qualified Data.Text.Lazy.Encoding as TL
13−import qualified Data.Text.Lazy.Read as TL
14−import qualified Data.Text.Read as T
15−
16−readem :: (Ord a, Num a) =>
17− IO [t] -> (t -> Either String (a,t)) -> IO ()
18−readem act reader = print . foldl' go 1000000 =<< act
19− where go z t = case reader t of
20− Left err -> error err
21− Right (n,_) -> min n z
22−
23−bytey :: (Ord a, Num a) =>
24− IO [t] -> (t -> Maybe (a,t)) -> IO ()
25−bytey act reader = print . foldl' go 1000000 =<< act
26− where go z t = case reader t of
27− Nothing -> error "barf"
28− Just (n,_) -> min n z
29−
30−main = do
31− args <- getArgs
32− let strict = (T.lines . T.decodeUtf8) `fmap` B.getContents
33− lazy = (TL.lines . TL.decodeUtf8) `fmap` BL.getContents
34− bs = B.lines `fmap` B.getContents
35− lbs = BL.lines `fmap` BL.getContents
36− case args of
37− ["dec"] -> readem strict (T.signed T.decimal :: T.Reader Int)
38− ["hex"] -> readem strict (T.signed T.hexadecimal :: T.Reader Int)
39− ["double"] -> readem strict (T.double :: T.Reader Double)
40− ["rational"] -> readem strict (T.rational :: T.Reader Double)
41− ["ldec"] -> readem lazy (TL.signed TL.decimal :: TL.Reader Int)
42− ["lhex"] -> readem lazy (TL.signed TL.hexadecimal :: TL.Reader Int)
43− ["ldouble"] -> readem lazy (TL.double :: TL.Reader Double)
44− ["lrational"] -> readem lazy (TL.rational :: TL.Reader Double)
45− ["bdec"] -> bytey bs B.readInt
46− ["bdouble"] -> bytey bs B.readDouble
47− ["bldec"] -> bytey lbs BL.readInt
48− ["bldouble"] -> bytey lbs BL.readDouble
tests/benchmarks/Replace.hsdeleted−23
@@ -1,23 +0,0 @@
1−{-# LANGUAGE BangPatterns #-}
2−module Main (main) where
3−
4−import System.Environment (getArgs)
5−import qualified Data.Text.Lazy as LT
6−import qualified Data.Text.Lazy.IO as LT
7−import qualified Data.ByteString.Lazy.Search as LB
8−import qualified Data.ByteString.Lazy.Char8 as LB
9−import qualified Data.ByteString.Char8 as B
10−
11−lazyText file pat sub =
12− LT.readFile file >>= LT.putStr . LT.replace (LT.pack pat) (LT.pack sub)
13−
14−lazyBS file pat sub =
15− LB.readFile file >>= LB.putStr . LB.replace (B.pack pat) (LB.pack sub)
16−
17−main = do
18− (kind : file : pat : sub : _) <- getArgs
19− case kind of
20− "lazyText" -> lazyText file pat sub
21− "lazyTextNull" -> LT.readFile file >>= LT.putStr
22− "lazyBS" -> lazyBS file pat sub
23− "lazyBSNull" -> LB.readFile file >>= LB.putStr
tests/benchmarks/ReplaceTags.hsdeleted−91
@@ -1,91 +0,0 @@
1−-- Contributed by Ken Friis Larsen and Morten Ib Nielsen.
2−
3−{-# LANGUAGE BangPatterns #-}
4−module Main (main) where
5−
6−import System.Environment (getArgs)
7−import qualified Char
8−
9−import qualified Data.Text as T
10−import qualified Data.Text.IO as T
11−
12−import qualified Data.Text.Lazy as TL
13−import qualified Data.Text.Lazy.IO as TL
14−import qualified Data.ByteString.Lazy as BL
15−import qualified Data.Text.Lazy.Encoding as TLE
16−
17−
18−import qualified Data.ByteString.Char8 as BC
19−import qualified Data.ByteString as B
20−import qualified Data.Text.Encoding as TE
21−
22−replaceTagsM file tag sub =
23− BC.readFile file >>= BC.putStr . replaceTags tag sub . TE.encodeUtf8 . T.toLower . TE.decodeUtf8
24− where
25− replaceTags tag replacement str = B.concat $ reverse $ replaceTags' [] (BC.pack $ '<' : tag) '>' (BC.pack replacement) str
26− replaceTags' !res start end repl str =
27− let (pre, post) = BC.breakSubstring start str
28− in if BC.null post
29− then pre : res
30− else replaceTags' (repl : pre : res) start end repl $ BC.drop 1 $
31− BC.dropWhile (/= end) post
32−
33−splitB sep str = seplen `seq` splitter str
34− where
35− splitter str = h : if B.null t then [] else splitter (B.drop seplen t)
36− where (h,t) = B.breakSubstring sep str
37− seplen = B.length sep
38−
39−replaceTagsWrong file tagName sub = do
40− content <- BC.readFile file
41− let frags = map (BC.drop 1 . BC.dropWhile (/= '>'))
42− $ splitB (BC.pack $ '<' : tagName) (BC.map Char.toLower content)
43− BC.putStr $ BC.intercalate (BC.pack sub) frags
44−
45−replaceTagsK file tagName sub = do
46− raw <- BC.readFile file
47− let content = (TE.encodeUtf8 . T.toLower . TE.decodeUtf8) raw
48− let frags = map (BC.drop 1 . BC.dropWhile (/= '>'))
49− $ splitB (BC.pack $ '<' : tagName) content
50− BC.putStr $ BC.intercalate (BC.pack sub) frags
51−
52−replaceTagsO file tagName sub = do
53− raw <- BC.readFile file
54− let content = (TE.encodeUtf8 . T.toLower . TE.decodeUtf8) raw
55− let frags = splitB (BC.pack $ '<' : tagName) content
56− BC.putStr $ BC.intercalate (BC.pack sub) frags
57− where
58− splitB sep str = splitter str
59− where
60− splitter str = h : if BC.null t then [] else splitter (BC.drop 1 $ BC.dropWhile (/= '>') t)
61− where (h,t) = B.breakSubstring sep str
62−
63−
64−
65−replaceTagsT file tagName sub = do
66− raw <- B.readFile file
67− let content = TE.decodeUtf8 raw
68− let frags = map (T.drop 1 . T.dropWhile (/= '>'))
69− $ T.split (T.pack $ '<' : tagName) (T.toLower content)
70− T.putStr $ T.intercalate (T.pack sub) frags
71−
72−replaceTagsTL file tagName sub = do
73− raw <- BL.readFile file
74− let content = TLE.decodeUtf8 raw
75− let frags = map (TL.drop 1 . TL.dropWhile (/= '>'))
76− $ TL.split (TL.pack $ '<' : tagName) (TL.toLower content)
77− TL.putStr $ TL.intercalate (TL.pack sub) frags
78−
79−
80−main = do
81− (kind : file : tag : sub : _) <- getArgs
82− case kind of
83− "Text" -> replaceTagsT file tag sub
84− "TextLazy" -> replaceTagsTL file tag sub
85− "BytestringM" -> replaceTagsM file tag sub
86− "BytestringK" -> replaceTagsK file tag sub
87− "BytestringO" -> replaceTagsO file tag sub
88− "TextNull" -> T.readFile file >>= T.putStr
89− "ByteNull" -> B.readFile file >>= B.putStr
90− "EncodeNull" -> B.readFile file >>= T.putStr . T.toLower . TE.decodeUtf8
91−
tests/benchmarks/Setup.hsnew file+2
@@ -0,0 +1,2 @@
1+import Distribution.Simple
2+main = defaultMain
tests/benchmarks/StripBrackets.hsdeleted−21
@@ -1,21 +0,0 @@
1−-- From Petr Prokhorenkov.
2−
3−import Data.Text as T
4−import Data.Text.IO as T
5−
6−stripBrackets :: T.Text -> T.Text
7−stripBrackets text = snd $ T.mapAccumL f 0 text where
8− f depth c = let
9− depth' = depth + d' c
10− c' | depth > 0 || depth' > 0 = ' '
11− | otherwise = c
12− in
13− (depth', c')
14−
15− d' '{' = 1
16− d' '[' = 1
17− d' '}' = -1
18− d' ']' = -1
19− d' _ = 0
20−
21−main = T.interact stripBrackets
tests/benchmarks/benchmarks.cabalnew file+33
@@ -0,0 +1,33 @@
1+Name: benchmarks
2+Version: 0.1
3+Synopsis: Benchmarks for the text package
4+Homepage: http://bitbucket.org/bos/text
5+License: BSD3
6+License-file: LICENSE
7+Author: Jasper Van der Jeugt <jaspervdj@gmail.com>,
8+ Bryan O'Sullivan <bos@serpentine.com>,
9+ Tom Harper <rtomharper@googlemail.com>,
10+ Duncan Coutts <duncan@haskell.org>
11+Maintainer: jaspervdj@gmail.com
12+Category: Text
13+Build-type: Simple
14+
15+Cabal-version: >=1.2
16+
17+Executable benchmarks
18+ Hs-source-dirs: src ../..
19+ Main-is: Data/Text/Benchmarks.hs
20+ Ghc-options: -Wall -O2
21+ Cpp-options: -DHAVE_DEEPSEQ
22+ Build-depends: base >= 4 && < 5,
23+ criterion >= 0.5 && < 0.6,
24+ bytestring >= 0.9 && < 0.10,
25+ deepseq >= 1.1 && < 1.2,
26+ filepath >= 1.2 && < 1.3,
27+ directory >= 1.1 && < 1.2,
28+ containers >= 0.3 && < 0.5,
29+ binary >= 0.5 && < 0.6,
30+ utf8-string >= 0.3 && < 0.4,
31+ blaze-builder >= 0.3 && < 0.4,
32+ bytestring-lexing >= 0.2 && < 0.3,
33+ stringsearch >= 0.3 && < 0.4
tests/benchmarks/casemap.pydeleted−15
@@ -1,15 +0,0 @@
1−#!/usr/bin/env python
2−
3−import sys, time
4−
5−def timeit(f):
6− start = time.time()
7− f()
8− end = time.time()
9− print end - start
10−
11−for f in sys.argv[1:]:
12− s = open(f).read()
13− u = s.decode('utf8')
14− timeit(lambda: s.upper())
15− timeit(lambda: u.upper())
tests/benchmarks/fileread.pydeleted−41
@@ -1,41 +0,0 @@
1−#!/usr/bin/env python
2−
3−import sys
4−
5−def string(name):
6− print len(open(name).read())
7−
8−def lazystring(name):
9− fp = open(name)
10− n = 0
11− d = True
12− bs = 128 * 1024
13− read = fp.read
14− while d:
15− d = len(read(bs))
16− n += d
17− print n
18−
19−def lazytext(name):
20− fp = open(name)
21− n = 0
22− d = True
23− bs = 128 * 1024
24− read = fp.read
25− while d:
26− s = read(bs)
27− d = len(s.decode('utf-8', 'replace'))
28− n += d
29− print n
30−
31−def text(name):
32− print len(open(name).read().decode('utf-8', 'replace'))
33−
34−if sys.argv[1] == 'bs':
35− string(sys.argv[2])
36−if sys.argv[1] == 'lbs':
37− lazystring(sys.argv[2])
38−elif sys.argv[1] == 'lazytext':
39− lazytext(sys.argv[2])
40−elif sys.argv[1] == 'text':
41− text(sys.argv[2])
tests/benchmarks/fileread_c.cdeleted−96
@@ -1,96 +0,0 @@
1−#include <unicode/ustdio.h>
2−#include <stdio.h>
3−#include <stdlib.h>
4−#include <string.h>
5−
6−void lazystring(const char *name)
7−{
8− FILE *ufp = fopen(name, "r");
9− const size_t bufsize = sizeof(char) * 32 * 1024;
10− char *str = malloc(bufsize);
11− long len = 0;
12− int32_t n;
13−
14− do {
15− n = fread(str, sizeof(char), bufsize, ufp);
16− len += n;
17− } while (n > 0);
18−
19− printf("%ld\n", len);
20−}
21−
22−void lazytext(const char *name)
23−{
24− UFILE *ufp = u_fopen(name, "r", NULL, "UTF-8");
25− const size_t bufsize = sizeof(UChar) * 32 * 1024;
26− UChar *str = malloc(bufsize);
27− long len = 0;
28− int32_t n;
29−
30− do {
31− n = u_file_read(str, bufsize, ufp);
32− len += n;
33− } while (n > 0);
34−
35− printf("%ld\n", len);
36−}
37−
38−void text(const char *name)
39−{
40− UFILE *ufp = u_fopen(name, "r", NULL, "UTF-8");
41− FILE *fp = u_fgetfile(ufp);
42− UChar *str;
43− long fsize;
44− int32_t n;
45−
46− fseek(fp, 0, SEEK_END);
47− fsize = ftell(fp);
48− u_frewind(ufp);
49−
50− str = malloc(sizeof(*str) * fsize);
51−
52− n = u_file_read(str, fsize, ufp);
53−
54− printf("%d\n", n);
55−}
56−
57−void string(const char *name)
58−{
59− FILE *fp = fopen(name, "r");
60− char *str;
61− long fsize;
62− int32_t n;
63−
64− fseek(fp, 0, SEEK_END);
65− fsize = ftell(fp);
66− fseek(fp, 0, SEEK_SET);
67−
68− str = malloc(sizeof(*str) * fsize);
69−
70− n = fread(str, sizeof(char), fsize, fp);
71−
72− printf("%d\n", n);
73−}
74−
75−int main(int argc, char **argv)
76−{
77− if (argc != 3) {
78− fprintf(stderr, "Usage: %s handler filename\n", argv[0]);
79− exit(1);
80− }
81−
82− if (strcmp(argv[1], "lazystring") == 0)
83− lazystring(argv[2]);
84− else if (strcmp(argv[1], "lazytext") == 0)
85− lazytext(argv[2]);
86− else if (strcmp(argv[1], "string") == 0)
87− string(argv[2]);
88− else if (strcmp(argv[1], "text") == 0)
89− text(argv[2]);
90− else {
91− fprintf(stderr, "no matching handler\n");
92− return 1;
93− }
94−
95− return 0;
96−}
tests/benchmarks/python/.gitignorenew file+2
@@ -0,0 +1,2 @@
1+__pycache__
2+*.pyc
tests/benchmarks/python/case_map.pynew file+7
@@ -0,0 +1,7 @@
1+#!/usr/bin/env python
2+
3+import utils, sys
4+
5+for f in sys.argv[1:]:
6+ t = utils.benchmark(lambda: utils.with_utf8_file(f, lambda c: c.upper()))
7+ sys.stderr.write('{0}: {1}\n'.format(f, t))
tests/benchmarks/python/file_read.pynew file+7
@@ -0,0 +1,7 @@
1+#!/usr/bin/env python
2+
3+import utils, sys
4+
5+for f in sys.argv[1:]:
6+ t = utils.benchmark(lambda: utils.with_utf8_file(f, lambda c: len(c)))
7+ sys.stderr.write('{0}: {1}\n'.format(f, t))
tests/benchmarks/python/sort.pynew file+15
@@ -0,0 +1,15 @@
1+#!/usr/bin/env python
2+
3+import utils, sys
4+
5+def sort(string):
6+ lines = string.splitlines()
7+ lines.sort()
8+ return '\n'.join(lines)
9+
10+for f in sys.argv[1:]:
11+ t = utils.benchmark(lambda: sys.stdout.write(
12+ utils.with_utf8_file(f,sort).encode('utf-8'))
13+ )
14+ sys.stderr.write('{0}: {1}\n'.format(f, t))
15+
tests/benchmarks/python/strip_brackets.pynew file+22
@@ -0,0 +1,22 @@
1+#!/usr/bin/env python
2+
3+import utils, sys
4+
5+def strip_brackets(string):
6+ d = 0
7+ out = ''
8+ for c in string:
9+ if c == '{' or c == '[': d += 1
10+
11+ if d > 0:
12+ out += ' '
13+ else:
14+ out += c
15+
16+ if c == '}' or c == ']': d -= 1
17+
18+ return out
19+
20+for f in sys.argv[1:]:
21+ t = utils.benchmark(lambda: utils.with_utf8_file(f, strip_brackets))
22+ sys.stderr.write('{0}: {1}\n'.format(f, t))
tests/benchmarks/python/utils.pynew file+22
@@ -0,0 +1,22 @@
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
19+
20+def with_utf8_file(filename, f):
21+ contents = open(filename).read().decode('utf-8')
22+ return f(contents)
tests/benchmarks/python/word_count.pynew file+17
@@ -0,0 +1,17 @@
1+#!/usr/bin/env python
2+
3+import utils, sys
4+
5+def word_count(string):
6+ freqs = {}
7+ for w in string.split():
8+ w = w.lower()
9+ if freqs.get(w):
10+ freqs[w] += 1
11+ else:
12+ freqs[w] = 1
13+ return freqs
14+
15+for f in sys.argv[1:]:
16+ t = utils.benchmark(lambda: utils.with_utf8_file(f, word_count))
17+ sys.stderr.write('{0}: {1}\n'.format(f, t))
tests/benchmarks/ruby/case_map.rbnew file+8
@@ -0,0 +1,8 @@
1+#!/usr/bin/env ruby
2+
3+require './utils.rb'
4+
5+ARGV.each do |f|
6+ t = benchmark { with_utf8_file(f) { |c| c.upcase } }
7+ STDERR.puts "#{f}: #{t}"
8+end
tests/benchmarks/ruby/file_read.rbnew file+8
@@ -0,0 +1,8 @@
1+#!/usr/bin/env ruby
2+
3+require './utils.rb'
4+
5+ARGV.each do |f|
6+ t = benchmark { with_utf8_file(f) { |c| c.size } }
7+ STDERR.puts "#{f}: #{t}"
8+end
tests/benchmarks/ruby/sort.rbnew file+14
@@ -0,0 +1,14 @@
1+#!/usr/bin/env ruby
2+
3+require './utils.rb'
4+
5+def sort(str)
6+ str.lines.sort.join
7+end
8+
9+ARGV.each do |f|
10+ t = benchmark do
11+ with_utf8_file(f) { |c| puts sort(c) }
12+ end
13+ STDERR.puts "#{f}: #{t}"
14+end
tests/benchmarks/ruby/strip_brackets.rbnew file+21
@@ -0,0 +1,21 @@
1+#!/usr/bin/env ruby
2+
3+require './utils.rb'
4+
5+def strip_brackets(str)
6+ d = 0
7+ out = ''
8+
9+ str.each_char do |c|
10+ d += 1 if c == '{' || c == '['
11+ out << if d > 0 then ' ' else c end
12+ d -= 1 if c == '}' || c == ']'
13+ end
14+
15+ out
16+end
17+
18+ARGV.each do |f|
19+ t = benchmark { with_utf8_file(f) { |c| strip_brackets(c) } }
20+ STDERR.puts "#{f}: #{t}"
21+end
tests/benchmarks/ruby/utils.rbnew file+20
@@ -0,0 +1,20 @@
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
15+
16+def with_utf8_file(filename)
17+ File.open(filename, 'r:utf-8') do |file|
18+ yield file.read
19+ end
20+end
tests/benchmarks/ruby/word_count.rbnew file+16
@@ -0,0 +1,16 @@
1+#!/usr/bin/env ruby
2+
3+require './utils.rb'
4+
5+def word_count(str)
6+ freqs = Hash.new 0
7+ str.split.each do |w|
8+ freqs[w.downcase] += 1
9+ end
10+ freqs
11+end
12+
13+ARGV.each do |f|
14+ t = benchmark { with_utf8_file(f) { |c| word_count(c) } }
15+ STDERR.puts "#{f}: #{t}"
16+end
tests/benchmarks/src/Data/Text/Benchmarks.hsnew file+58
@@ -0,0 +1,58 @@
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)
9+import System.FilePath ((</>))
10+import System.IO (IOMode (WriteMode), openFile, hSetEncoding, utf8)
11+
12+import qualified Data.Text.Benchmarks.Builder as Builder
13+import qualified Data.Text.Benchmarks.CaseMap as CaseMap
14+import qualified Data.Text.Benchmarks.Cut as Cut
15+import qualified Data.Text.Benchmarks.DecodeUtf8 as DecodeUtf8
16+import qualified Data.Text.Benchmarks.EncodeUtf8 as EncodeUtf8
17+import qualified Data.Text.Benchmarks.Equality as Equality
18+import qualified Data.Text.Benchmarks.FileIndices as FileIndices
19+import qualified Data.Text.Benchmarks.FileRead as FileRead
20+import qualified Data.Text.Benchmarks.FoldLines as FoldLines
21+import qualified Data.Text.Benchmarks.HtmlCombinator as HtmlCombinator
22+import qualified Data.Text.Benchmarks.Ordering as Ordering
23+import qualified Data.Text.Benchmarks.Pure as Pure
24+import qualified Data.Text.Benchmarks.ReadNumbers as ReadNumbers
25+import qualified Data.Text.Benchmarks.Replace as Replace
26+import qualified Data.Text.Benchmarks.Sort as Sort
27+import qualified Data.Text.Benchmarks.StripBrackets as StripBrackets
28+import qualified Data.Text.Benchmarks.WordCount as WordCount
29+
30+main :: IO ()
31+main = benchmarks >>= defaultMain
32+
33+benchmarks :: IO [Benchmark]
34+benchmarks = do
35+ sink <- openFile "/dev/null" WriteMode
36+ hSetEncoding sink utf8
37+ sequence
38+ [ Builder.benchmark
39+ , CaseMap.benchmark (tf "russian.txt") sink
40+ , Cut.benchmark (tf "russian.txt") sink 30 60
41+ , DecodeUtf8.benchmark (tf "russian.txt")
42+ , EncodeUtf8.benchmark sink "επανάληψη 竺法蘭共譯"
43+ , Equality.benchmark (tf "japanese.txt")
44+ , FileIndices.benchmark (tf "russian.txt") "принимая"
45+ , FileRead.benchmark (tf "russian.txt")
46+ , FoldLines.benchmark (tf "russian.txt")
47+ , HtmlCombinator.benchmark sink
48+ , Ordering.benchmark (tf "russian.txt")
49+ , Pure.benchmark (tf "japanese.txt")
50+ , ReadNumbers.benchmark (tf "numbers.txt")
51+ , Replace.benchmark (tf "russian.txt") sink "принимая" "своем"
52+ , Sort.benchmark (tf "russian.txt") sink
53+ , StripBrackets.benchmark (tf "russian.txt") sink
54+ , WordCount.benchmark (tf "russian.txt")
55+ ]
56+ where
57+ -- Location of a test file
58+ tf = ("../text/test" </>)
tests/benchmarks/src/Data/Text/Benchmarks/Builder.hsnew file+44
@@ -0,0 +1,44 @@
1+-- | Testing the internal builder monoid
2+--
3+{-# LANGUAGE OverloadedStrings #-}
4+module Data.Text.Benchmarks.Builder
5+ ( benchmark
6+ ) where
7+
8+import Criterion (Benchmark, bgroup, bench, nf)
9+import Data.Binary.Builder as B
10+import Data.ByteString.Char8 ()
11+import Data.Monoid (mconcat)
12+import qualified Blaze.ByteString.Builder as Blaze
13+import qualified Blaze.ByteString.Builder.Char.Utf8 as Blaze
14+import qualified Data.ByteString as SB
15+import qualified Data.ByteString.Lazy as LB
16+import qualified Data.Text as T
17+import qualified Data.Text.Lazy as LT
18+import qualified Data.Text.Lazy.Builder as LTB
19+
20+benchmark :: IO Benchmark
21+benchmark = return $ bgroup "Builder"
22+ [ bench "LazyText" $ nf
23+ (LT.length . LTB.toLazyText . mconcat . map LTB.fromText) texts
24+ , bench "Binary" $ nf
25+ (LB.length . B.toLazyByteString . mconcat . map B.fromByteString)
26+ byteStrings
27+ , bench "Blaze" $ nf
28+ (LB.length . Blaze.toLazyByteString . mconcat . map Blaze.fromString)
29+ strings
30+ ]
31+
32+texts :: [T.Text]
33+texts = take 200000 $ cycle ["foo", "λx", "由の"]
34+{-# NOINLINE texts #-}
35+
36+-- Note that the non-ascii characters will be chopped
37+byteStrings :: [SB.ByteString]
38+byteStrings = take 200000 $ cycle ["foo", "λx", "由の"]
39+{-# NOINLINE byteStrings #-}
40+
41+-- Note that the non-ascii characters will be chopped
42+strings :: [String]
43+strings = take 200000 $ cycle ["foo", "λx", "由の"]
44+{-# NOINLINE strings #-}
tests/benchmarks/src/Data/Text/Benchmarks/CaseMap.hsnew file+15
@@ -0,0 +1,15 @@
1+-- | This benchmark converts a number of UTF-8 encoded files to uppercase
2+--
3+module Data.Text.Benchmarks.CaseMap
4+ ( benchmark
5+ ) where
6+
7+import Criterion (Benchmark, bench)
8+import System.IO (Handle)
9+import qualified Data.ByteString as B
10+import qualified Data.Text as T
11+import qualified Data.Text.Encoding as T
12+
13+benchmark :: FilePath -> Handle -> IO Benchmark
14+benchmark fp sink = return $ bench "CaseMap" $
15+ B.readFile fp >>= B.hPutStr sink . T.encodeUtf8 . T.toUpper . T.decodeUtf8
tests/benchmarks/src/Data/Text/Benchmarks/Cut.hsnew file+86
@@ -0,0 +1,86 @@
1+-- | Cut into a file, selecting certain columns (e.g. lines 10 to 40)
2+--
3+module Data.Text.Benchmarks.Cut
4+ ( benchmark
5+ ) where
6+
7+import Criterion (Benchmark, bgroup, bench)
8+import System.IO (Handle, hPutStr)
9+import qualified Data.ByteString as B
10+import qualified Data.ByteString.Char8 as BC
11+import qualified Data.ByteString.Lazy as BL
12+import qualified Data.ByteString.Lazy.Char8 as BLC
13+import qualified Data.Text as T
14+import qualified Data.Text.Encoding as T
15+import qualified Data.Text.IO as T
16+import qualified Data.Text.Lazy as TL
17+import qualified Data.Text.Lazy.Encoding as TL
18+import qualified Data.Text.Lazy.IO as TL
19+
20+benchmark :: FilePath -> Handle -> Int -> Int -> IO Benchmark
21+benchmark p sink from to = return $ bgroup "Cut"
22+ [ bench' "String" string
23+ , bench' "ByteString" byteString
24+ , bench' "LazyByteString" lazyByteString
25+ , bench' "Text" text
26+ , bench' "LazyText" lazyText
27+ , bench' "TextByteString" textByteString
28+ , bench' "LazyTextByteString" lazyTextByteString
29+ ]
30+ where
31+ bench' n s = bench n (s p sink from to)
32+
33+string :: FilePath -> Handle -> Int -> Int -> IO ()
34+string fp sink from to = do
35+ s <- readFile fp
36+ hPutStr sink $ cut s
37+ where
38+ cut = unlines . map (take (to - from) . drop from) . lines
39+
40+byteString :: FilePath -> Handle -> Int -> Int -> IO ()
41+byteString fp sink from to = do
42+ bs <- B.readFile fp
43+ B.hPutStr sink $ cut bs
44+ where
45+ cut = BC.unlines . map (B.take (to - from) . B.drop from) . BC.lines
46+
47+lazyByteString :: FilePath -> Handle -> Int -> Int -> IO ()
48+lazyByteString fp sink from to = do
49+ bs <- BL.readFile fp
50+ BL.hPutStr sink $ cut bs
51+ where
52+ cut = BLC.unlines . map (BL.take (to' - from') . BL.drop from') . BLC.lines
53+ from' = fromIntegral from
54+ to' = fromIntegral to
55+
56+text :: FilePath -> Handle -> Int -> Int -> IO ()
57+text fp sink from to = do
58+ t <- T.readFile fp
59+ T.hPutStr sink $ cut t
60+ where
61+ cut = T.unlines . map (T.take (to - from) . T.drop from) . T.lines
62+
63+lazyText :: FilePath -> Handle -> Int -> Int -> IO ()
64+lazyText fp sink from to = do
65+ t <- TL.readFile fp
66+ TL.hPutStr sink $ cut t
67+ where
68+ cut = TL.unlines . map (TL.take (to' - from') . TL.drop from') . TL.lines
69+ from' = fromIntegral from
70+ to' = fromIntegral to
71+
72+textByteString :: FilePath -> Handle -> Int -> Int -> IO ()
73+textByteString fp sink from to = do
74+ t <- T.decodeUtf8 `fmap` B.readFile fp
75+ B.hPutStr sink $ T.encodeUtf8 $ cut t
76+ where
77+ cut = T.unlines . map (T.take (to - from) . T.drop from) . T.lines
78+
79+lazyTextByteString :: FilePath -> Handle -> Int -> Int -> IO ()
80+lazyTextByteString fp sink from to = do
81+ t <- TL.decodeUtf8 `fmap` BL.readFile fp
82+ BL.hPutStr sink $ TL.encodeUtf8 $ cut t
83+ where
84+ cut = TL.unlines . map (TL.take (to' - from') . TL.drop from') . TL.lines
85+ from' = fromIntegral from
86+ to' = fromIntegral to
tests/benchmarks/src/Data/Text/Benchmarks/DecodeUtf8.hsnew file+95
@@ -0,0 +1,95 @@
1+module Data.Text.Benchmarks.DecodeUtf8
2+ ( benchmark
3+ ) where
4+
5+import Control.DeepSeq (rnf)
6+import Criterion (Benchmark, bgroup, bench)
7+import System.IO (IOMode (ReadMode), openFile, hGetContents, hSetEncoding, utf8)
8+import qualified Codec.Binary.UTF8.Generic as U8
9+import qualified Data.ByteString as B
10+import qualified Data.ByteString.Lazy as BL
11+import qualified Data.Text as T
12+import qualified Data.Text.Encoding as T
13+import qualified Data.Text.IO as T
14+import qualified Data.Text.Lazy as TL
15+import qualified Data.Text.Lazy.Encoding as TL
16+import qualified Data.Text.Lazy.IO as TL
17+
18+benchmark :: FilePath -> IO Benchmark
19+benchmark fp = return $ bgroup "DecodeUtf8"
20+ [ bench "Strict" $ do
21+ bs <- B.readFile fp
22+ rnf (T.decodeUtf8 bs) `seq` return ()
23+
24+ , bench "StrictLength" $ do
25+ bs <- B.readFile fp
26+ rnf (T.length $ T.decodeUtf8 bs) `seq` return ()
27+
28+ , bench "StrictInitLength" $ do
29+ bs <- B.readFile fp
30+ rnf (T.length $ T.init $ T.decodeUtf8 bs) `seq` return ()
31+
32+ , bench "StrictIO" $ do
33+ h <- openFile fp ReadMode
34+ hSetEncoding h utf8
35+ t <- T.hGetContents h
36+ rnf t `seq` return ()
37+
38+ , bench "StrictLengthIO" $ do
39+ h <- openFile fp ReadMode
40+ hSetEncoding h utf8
41+ t <- T.hGetContents h
42+ rnf (T.length t) `seq` return ()
43+
44+ , bench "Lazy" $ do
45+ bs <- BL.readFile fp
46+ rnf (TL.decodeUtf8 bs) `seq` return ()
47+
48+ , bench "LazyLength" $ do
49+ bs <- BL.readFile fp
50+ rnf (TL.length $ TL.decodeUtf8 bs) `seq` return ()
51+
52+ , bench "LazyInitLength" $ do
53+ bs <- BL.readFile fp
54+ rnf (TL.length $ TL.init $ TL.decodeUtf8 bs) `seq` return ()
55+
56+ , bench "LazyIO" $ do
57+ h <- openFile fp ReadMode
58+ hSetEncoding h utf8
59+ t <- TL.hGetContents h
60+ rnf t `seq` return ()
61+
62+ , bench "LazyLengthIO" $ do
63+ h <- openFile fp ReadMode
64+ hSetEncoding h utf8
65+ t <- TL.hGetContents h
66+ rnf (TL.length t) `seq` return ()
67+
68+ , bench "String" $ do
69+ h <- openFile fp ReadMode
70+ hSetEncoding h utf8
71+ t <- hGetContents h
72+ rnf t `seq` return ()
73+
74+ , bench "StringLength" $ do
75+ h <- openFile fp ReadMode
76+ hSetEncoding h utf8
77+ t <- hGetContents h
78+ rnf (length t) `seq` return ()
79+
80+ , bench "LazyStringUtf8" $ do
81+ s <- U8.toString `fmap` BL.readFile fp
82+ rnf s `seq` return ()
83+
84+ , bench "LazyStringUtf8Length" $ do
85+ s <- U8.toString `fmap` BL.readFile fp
86+ rnf (length s) `seq` return ()
87+
88+ , bench "StrictStringUtf8" $ do
89+ s <- U8.toString `fmap` B.readFile fp
90+ rnf s `seq` return ()
91+
92+ , bench "StrictStringUtf8Length" $ do
93+ s <- U8.toString `fmap` B.readFile fp
94+ rnf (length s) `seq` return ()
95+ ]
tests/benchmarks/src/Data/Text/Benchmarks/EncodeUtf8.hsnew file+33
@@ -0,0 +1,33 @@
1+module Data.Text.Benchmarks.EncodeUtf8
2+ ( benchmark
3+ ) where
4+
5+import Criterion (Benchmark, bgroup, bench)
6+import System.IO (Handle, hPutStr)
7+import qualified Data.ByteString as B
8+import qualified Data.ByteString.Lazy as BL
9+import qualified Data.Text as T
10+import qualified Data.Text.Encoding as T
11+import qualified Data.Text.IO as T
12+import qualified Data.Text.Lazy as TL
13+import qualified Data.Text.Lazy.Encoding as TL
14+import qualified Data.Text.Lazy.IO as TL
15+
16+benchmark :: Handle -> String -> IO Benchmark
17+benchmark sink string = return $ bgroup "EncodeUtf8"
18+ [ bench "String" $ hPutStr sink $ concat $ replicate k string
19+ , bench "Text" $ T.hPutStr sink $ T.replicate k text
20+ , bench "TextLazy" $ TL.hPutStr sink $
21+ TL.replicate (fromIntegral k) lazyText
22+ , bench "TextByteString" $ B.hPutStr sink $
23+ T.encodeUtf8 $ T.replicate k text
24+ , bench "TextByteStringLazy" $ BL.hPutStr sink $
25+ TL.encodeUtf8 $ TL.replicate (fromIntegral k) lazyText
26+ ]
27+ where
28+ -- The string in different formats
29+ text = T.pack string
30+ lazyText = TL.pack string
31+
32+ -- Amount
33+ k = 100000
tests/benchmarks/src/Data/Text/Benchmarks/Equality.hsnew file+32
@@ -0,0 +1,32 @@
1+-- | Take the first 100 lines from the file, and count the number of lines equal
2+-- to those lines
3+--
4+module Data.Text.Benchmarks.Equality
5+ ( benchmark
6+ ) where
7+
8+import Control.Exception (evaluate)
9+import Criterion (Benchmark, bgroup, bench)
10+import qualified Data.ByteString.Char8 as B
11+import qualified Data.ByteString.Lazy.Char8 as BL
12+import qualified Data.Text as T
13+import qualified Data.Text.Encoding as T
14+import qualified Data.Text.Lazy as TL
15+import qualified Data.Text.Lazy.Encoding as TL
16+
17+benchmark :: FilePath -> IO Benchmark
18+benchmark fp = return $ bgroup "Equality"
19+ [ bench "Text" $
20+ B.readFile fp >>= evaluate . func . T.lines . T.decodeUtf8
21+ , bench "LazyText" $
22+ BL.readFile fp >>= evaluate . func . TL.lines . TL.decodeUtf8
23+ , bench "ByteString" $
24+ B.readFile fp >>= evaluate . func . B.lines
25+ , bench "LazyByteString" $
26+ BL.readFile fp >>= evaluate . func . BL.lines
27+ ]
28+
29+-- | Frequency of most-appearing line (from the first 100 lines)
30+--
31+func :: (Eq a) => [a] -> Int
32+func ls = sum . map (\needle -> length . filter (== needle) $ ls) $ take 100 ls
tests/benchmarks/src/Data/Text/Benchmarks/FileIndices.hsnew file+28
@@ -0,0 +1,28 @@
1+-- | Search for a pattern in a file, find the number of occurences
2+--
3+module Data.Text.Benchmarks.FileIndices
4+ ( benchmark
5+ ) where
6+
7+import Control.Exception (evaluate)
8+import Criterion (Benchmark, bench, bgroup)
9+import qualified Data.ByteString as B
10+import qualified Data.ByteString.Lazy as BL
11+import qualified Data.ByteString.Lazy.Search as BL
12+import qualified Data.Text.Lazy as TL
13+import qualified Data.Text.Lazy.Encoding as TL
14+import qualified Data.Text.Lazy.IO as TL
15+
16+benchmark :: FilePath -> TL.Text -> IO Benchmark
17+benchmark fp t = return $ bgroup "FileIndices"
18+ [ bench "LazyText" $ TL.readFile fp >>= evaluate . text t
19+ , bench "LazyByteString" $ BL.readFile fp >>= evaluate . byteString b
20+ ]
21+ where
22+ b = B.concat $ BL.toChunks $ TL.encodeUtf8 t
23+
24+text :: TL.Text -> TL.Text -> Int
25+text needle = fromIntegral . TL.count needle
26+
27+byteString :: B.ByteString -> BL.ByteString -> Int
28+byteString needle = length . BL.indices needle
tests/benchmarks/src/Data/Text/Benchmarks/FileRead.hsnew file+29
@@ -0,0 +1,29 @@
1+-- | Benchmarks simple file reading
2+--
3+module Data.Text.Benchmarks.FileRead
4+ ( benchmark
5+ ) where
6+
7+import Control.Exception (evaluate)
8+import Criterion (Benchmark, bgroup, bench)
9+import qualified Data.ByteString as SB
10+import qualified Data.ByteString.Lazy as LB
11+import qualified Data.Text as T
12+import qualified Data.Text.Encoding as T
13+import qualified Data.Text.IO as T
14+import qualified Data.Text.Lazy as LT
15+import qualified Data.Text.Lazy.Encoding as LT
16+import qualified Data.Text.Lazy.IO as LT
17+
18+benchmark :: FilePath -> IO Benchmark
19+benchmark p = return $ bgroup "FileRead"
20+ [ bench "String" $ readFile p >>= evaluate . length
21+ , bench "ByteString" $ SB.readFile p >>= evaluate . SB.length
22+ , bench "LazyByteString" $ LB.readFile p >>= evaluate . LB.length
23+ , bench "Text" $ T.readFile p >>= evaluate . T.length
24+ , bench "LazyText" $ LT.readFile p >>= evaluate . LT.length
25+ , bench "TextByteString" $
26+ SB.readFile p >>= evaluate . T.length . T.decodeUtf8
27+ , bench "LazyTextByteString" $
28+ LB.readFile p >>= evaluate . LT.length . LT.decodeUtf8
29+ ]
tests/benchmarks/src/Data/Text/Benchmarks/FoldLines.hsnew file+53
@@ -0,0 +1,53 @@
1+-- | Fold over the lines in a file
2+--
3+{-# LANGUAGE BangPatterns #-}
4+module Data.Text.Benchmarks.FoldLines
5+ ( benchmark
6+ ) where
7+
8+import Criterion (Benchmark, bgroup, bench)
9+import System.IO
10+import qualified Data.ByteString as B
11+import qualified Data.Text as T
12+import qualified Data.Text.IO as T
13+
14+benchmark :: FilePath -> IO Benchmark
15+benchmark fp = return $ bgroup "FoldLines"
16+ [ bench "Text" $ withHandle $ foldLinesT (\n _ -> n + 1) (0 :: Int)
17+ , bench "ByteString" $ withHandle $ foldLinesB (\n _ -> n + 1) (0 :: Int)
18+ ]
19+ where
20+ withHandle f = do
21+ h <- openFile fp ReadMode
22+ hSetBuffering h (BlockBuffering (Just 16384))
23+ x <- f h
24+ hClose h
25+ return x
26+
27+-- Text line fold
28+--
29+foldLinesT :: (a -> T.Text -> a) -> a -> Handle -> IO a
30+foldLinesT f z0 h = go z0
31+ where
32+ go !z = do
33+ eof <- hIsEOF h
34+ if eof
35+ then return z
36+ else do
37+ l <- T.hGetLine h
38+ let z' = f z l in go z'
39+{-# INLINE foldLinesT #-}
40+
41+-- | ByteString line fold
42+--
43+foldLinesB :: (a -> B.ByteString -> a) -> a -> Handle -> IO a
44+foldLinesB f z0 h = go z0
45+ where
46+ go !z = do
47+ eof <- hIsEOF h
48+ if eof
49+ then return z
50+ else do
51+ l <- B.hGetLine h
52+ let z' = f z l in go z'
53+{-# INLINE foldLinesB #-}
tests/benchmarks/src/Data/Text/Benchmarks/HtmlCombinator.hsnew file+36
@@ -0,0 +1,36 @@
1+-- | Create a large HTML table and dump it to a handle
2+--
3+{-# LANGUAGE OverloadedStrings #-}
4+module Data.Text.Benchmarks.HtmlCombinator
5+ ( benchmark
6+ ) where
7+
8+import Criterion (Benchmark, bench)
9+import Data.Monoid (mappend, mconcat)
10+import Data.Text.Lazy.Builder (Builder, fromText, toLazyText)
11+import Data.Text.Lazy.IO (hPutStr)
12+import System.IO (Handle)
13+import qualified Data.Text as T
14+
15+benchmark :: Handle -> IO Benchmark
16+benchmark sink = return $ bench "HtmlCombinator" $ do
17+ hPutStr sink "Content-Type: text/html\n\n<table>"
18+ hPutStr sink . toLazyText . makeTable =<< rows
19+ hPutStr sink "</table>"
20+ where
21+ -- We provide the number of rows in IO so the builder value isn't shared
22+ -- between the benchmark samples.
23+ rows :: IO Int
24+ rows = return 20000
25+ {-# NOINLINE rows #-}
26+
27+makeTable :: Int -> Builder
28+makeTable n = mconcat $ replicate n $ mconcat $ map makeCol [1 .. 50]
29+
30+makeCol :: Int -> Builder
31+makeCol 1 = fromText "<tr><td>1</td>"
32+makeCol 50 = fromText "<td>50</td></tr>"
33+makeCol i = fromText "<td>" `mappend` (fromInt i `mappend` fromText "</td>")
34+
35+fromInt :: Int -> Builder
36+fromInt = fromText . T.pack . show
tests/benchmarks/src/Data/Text/Benchmarks/Ordering.hsnew file+58
@@ -0,0 +1,58 @@
1+-- | For every 1000th line of a file, check how many lines in the file are
2+-- lexicographically smaller
3+--
4+module Data.Text.Benchmarks.Ordering
5+ ( benchmark
6+ ) where
7+
8+import Control.Exception (evaluate)
9+import Criterion (Benchmark, bgroup, bench)
10+import qualified Data.ByteString.Char8 as B
11+import qualified Data.ByteString.Lazy.Char8 as BL
12+import qualified Data.Text as T
13+import qualified Data.Text.Encoding as T
14+import qualified Data.Text.Lazy as TL
15+import qualified Data.Text.Lazy.Encoding as TL
16+
17+benchmark :: FilePath -> IO Benchmark
18+benchmark fp = return $ bgroup "Ordering"
19+ [ bench "ByteString" $ B.readFile fp >>=
20+ evaluate . numSmaller . B.lines
21+ , bench "LazyByteString" $ BL.readFile fp >>=
22+ evaluate . numSmaller . BL.lines
23+
24+ , bench "Text" $ B.readFile fp >>=
25+ evaluate . numSmaller . T.lines . T.decodeUtf8
26+ , bench "TextFusion" $ B.readFile fp >>=
27+ evaluate . numSmallerFusion . T.lines . T.decodeUtf8
28+ , bench "LazyText" $ BL.readFile fp >>=
29+ evaluate . numSmaller . TL.lines . TL.decodeUtf8
30+
31+ , bench "String" $ readFile fp >>=
32+ evaluate . numSmaller . lines
33+ ]
34+
35+-- | Take every Nth item from a list
36+--
37+every :: Int -> [a] -> [a]
38+every k = go k
39+ where
40+ go n (x : xs)
41+ | n < k = go (n+1) xs
42+ | otherwise = x : go 1 xs
43+ go _ _ = []
44+
45+-- | Benchmark logic
46+--
47+numSmaller :: (Ord a) => [a] -> Int
48+numSmaller ls = sum . map f $ every 1000 ls
49+ where
50+ f x = length . filter ((== GT) . compare x) $ ls
51+
52+-- | Test a comparison that could be fused: compare (toLower a) (toLower b)
53+-- Currently, this funcion performs very badly!
54+--
55+numSmallerFusion :: [T.Text] -> Int
56+numSmallerFusion ls = sum . map f $ every 1000 ls
57+ where
58+ f x = length . filter ((== GT) . compare (T.toLower x) . T.toLower) $ ls
tests/benchmarks/src/Data/Text/Benchmarks/Pure.hsnew file+470
@@ -0,0 +1,470 @@
1+-- | Benchmarks various pure functions from the Text library
2+--
3+{-# LANGUAGE BangPatterns, GADTs, MagicHash #-}
4+{-# OPTIONS_GHC -fno-warn-orphans #-}
5+module Data.Text.Benchmarks.Pure
6+ ( benchmark
7+ ) where
8+
9+import Control.DeepSeq (NFData (..))
10+import Control.Exception (evaluate)
11+import Criterion (Benchmark, bgroup, bench, nf)
12+import Data.Char (toLower, toUpper)
13+import Data.Monoid (mappend, mempty)
14+import GHC.Base (Char (..), Int (..), chr#, ord#, (+#))
15+import qualified Data.ByteString.Char8 as BS
16+import qualified Data.ByteString.Lazy.Char8 as BL
17+import qualified Data.ByteString.Lazy.Internal as BL
18+import qualified Data.ByteString.UTF8 as UTF8
19+import qualified Data.List as L
20+import qualified Data.Text as T
21+import qualified Data.Text.Encoding as T
22+import qualified Data.Text.Lazy as TL
23+import qualified Data.Text.Lazy.Builder as TB
24+import qualified Data.Text.Lazy.Encoding as TL
25+
26+benchmark :: FilePath -> IO Benchmark
27+benchmark fp = do
28+ -- Evaluate stuff before actually running the benchmark, we don't want to
29+ -- count it here.
30+
31+ -- ByteString A
32+ bsa <- BS.readFile fp
33+
34+ -- Text A/B, LazyText A/B
35+ ta <- evaluate $ T.decodeUtf8 bsa
36+ tb <- evaluate $ T.toUpper ta
37+ tla <- evaluate $ TL.fromChunks (T.chunksOf 16376 ta)
38+ tlb <- evaluate $ TL.fromChunks (T.chunksOf 16376 tb)
39+
40+ -- ByteString B, LazyByteString A/B
41+ bsb <- evaluate $ T.encodeUtf8 tb
42+ bla <- evaluate $ BL.fromChunks (chunksOf 16376 bsa)
43+ blb <- evaluate $ BL.fromChunks (chunksOf 16376 bsb)
44+
45+ -- String A/B
46+ sa <- evaluate $ UTF8.toString bsa
47+ sb <- evaluate $ T.unpack tb
48+
49+ -- Lengths
50+ bsa_len <- evaluate $ BS.length bsa
51+ ta_len <- evaluate $ T.length ta
52+ bla_len <- evaluate $ BL.length bla
53+ tla_len <- evaluate $ TL.length tla
54+ sa_len <- evaluate $ L.length sa
55+
56+ -- Lines
57+ bsl <- evaluate $ BS.lines bsa
58+ bll <- evaluate $ BL.lines bla
59+ tl <- evaluate $ T.lines ta
60+ tll <- evaluate $ TL.lines tla
61+ sl <- evaluate $ L.lines sa
62+
63+ return $ bgroup "Pure"
64+ [ bgroup "append"
65+ [ benchT $ nf (T.append tb) ta
66+ , benchTL $ nf (TL.append tlb) tla
67+ , benchBS $ nf (BS.append bsb) bsa
68+ , benchBSL $ nf (BL.append blb) bla
69+ , benchS $ nf ((++) sb) sa
70+ ]
71+ , bgroup "concat"
72+ [ benchT $ nf T.concat tl
73+ , benchTL $ nf TL.concat tll
74+ , benchBS $ nf BS.concat bsl
75+ , benchBSL $ nf BL.concat bll
76+ , benchS $ nf L.concat sl
77+ ]
78+ , bgroup "cons"
79+ [ benchT $ nf (T.cons c) ta
80+ , benchTL $ nf (TL.cons c) tla
81+ , benchBS $ nf (BS.cons c) bsa
82+ , benchBSL $ nf (BL.cons c) bla
83+ , benchS $ nf (c:) sa
84+ ]
85+ , bgroup "concatMap"
86+ [ benchT $ nf (T.concatMap (T.replicate 3 . T.singleton)) ta
87+ , benchTL $ nf (TL.concatMap (TL.replicate 3 . TL.singleton)) tla
88+ , benchBS $ nf (BS.concatMap (BS.replicate 3)) bsa
89+ , benchBSL $ nf (BL.concatMap (BL.replicate 3)) bla
90+ , benchS $ nf (L.concatMap (L.replicate 3 . (:[]))) sa
91+ ]
92+ , bgroup "decode"
93+ [ benchT $ nf T.decodeUtf8 bsa
94+ , benchTL $ nf TL.decodeUtf8 bla
95+ , benchBS $ nf BS.unpack bsa
96+ , benchBSL $ nf BL.unpack bla
97+ , benchS $ nf UTF8.toString bsa
98+ ]
99+ , bgroup "drop"
100+ [ benchT $ nf (T.drop (ta_len `div` 3)) ta
101+ , benchTL $ nf (TL.drop (tla_len `div` 3)) tla
102+ , benchBS $ nf (BS.drop (bsa_len `div` 3)) bsa
103+ , benchBSL $ nf (BL.drop (bla_len `div` 3)) bla
104+ , benchS $ nf (L.drop (sa_len `div` 3)) sa
105+ ]
106+ , bgroup "encode"
107+ [ benchT $ nf T.encodeUtf8 ta
108+ , benchTL $ nf TL.encodeUtf8 tla
109+ , benchBS $ nf BS.pack sa
110+ , benchBSL $ nf BL.pack sa
111+ , benchS $ nf UTF8.fromString sa
112+ ]
113+ , bgroup "filter"
114+ [ benchT $ nf (T.filter p0) ta
115+ , benchTL $ nf (TL.filter p0) tla
116+ , benchBS $ nf (BS.filter p0) bsa
117+ , benchBSL $ nf (BL.filter p0) bla
118+ , benchS $ nf (L.filter p0) sa
119+ ]
120+ , bgroup "filter.filter"
121+ [ benchT $ nf (T.filter p1 . T.filter p0) ta
122+ , benchTL $ nf (TL.filter p1 . TL.filter p0) tla
123+ , benchBS $ nf (BS.filter p1 . BS.filter p0) bsa
124+ , benchBSL $ nf (BL.filter p1 . BL.filter p0) bla
125+ , benchS $ nf (L.filter p1 . L.filter p0) sa
126+ ]
127+ , bgroup "foldl'"
128+ [ benchT $ nf (T.foldl' len 0) ta
129+ , benchTL $ nf (TL.foldl' len 0) tla
130+ , benchBS $ nf (BS.foldl' len 0) bsa
131+ , benchBSL $ nf (BL.foldl' len 0) bla
132+ , benchS $ nf (L.foldl' len 0) sa
133+ ]
134+ , bgroup "foldr"
135+ [ benchT $ nf (L.length . T.foldr (:) []) ta
136+ , benchTL $ nf (L.length . TL.foldr (:) []) tla
137+ , benchBS $ nf (L.length . BS.foldr (:) []) bsa
138+ , benchBSL $ nf (L.length . BL.foldr (:) []) bla
139+ , benchS $ nf (L.length . L.foldr (:) []) sa
140+ ]
141+ , bgroup "head"
142+ [ benchT $ nf T.head ta
143+ , benchTL $ nf TL.head tla
144+ , benchBS $ nf BS.head bsa
145+ , benchBSL $ nf BL.head bla
146+ , benchS $ nf L.head sa
147+ ]
148+ , bgroup "init"
149+ [ benchT $ nf T.init ta
150+ , benchTL $ nf TL.init tla
151+ , benchBS $ nf BS.init bsa
152+ , benchBSL $ nf BL.init bla
153+ , benchS $ nf L.init sa
154+ ]
155+ , bgroup "intercalate"
156+ [ benchT $ nf (T.intercalate tsw) tl
157+ , benchTL $ nf (TL.intercalate tlw) tll
158+ , benchBS $ nf (BS.intercalate bsw) bsl
159+ , benchBSL $ nf (BL.intercalate blw) bll
160+ , benchS $ nf (L.intercalate lw) sl
161+ ]
162+ , bgroup "intersperse"
163+ [ benchT $ nf (T.intersperse c) ta
164+ , benchTL $ nf (TL.intersperse c) tla
165+ , benchBS $ nf (BS.intersperse c) bsa
166+ , benchBSL $ nf (BL.intersperse c) bla
167+ , benchS $ nf (L.intersperse c) sa
168+ ]
169+ , bgroup "isInfixOf"
170+ [ benchT $ nf (T.isInfixOf tsw) ta
171+ , benchTL $ nf (TL.isInfixOf tlw) tla
172+ , benchBS $ nf (BS.isInfixOf bsw) bsa
173+ -- no isInfixOf for lazy bytestrings
174+ , benchS $ nf (L.isInfixOf lw) sa
175+ ]
176+ , bgroup "last"
177+ [ benchT $ nf T.last ta
178+ , benchTL $ nf TL.last tla
179+ , benchBS $ nf BS.last bsa
180+ , benchBSL $ nf BL.last bla
181+ , benchS $ nf L.last sa
182+ ]
183+ , bgroup "map"
184+ [ benchT $ nf (T.map f) ta
185+ , benchTL $ nf (TL.map f) tla
186+ , benchBS $ nf (BS.map f) bsa
187+ , benchBSL $ nf (BL.map f) bla
188+ , benchS $ nf (L.map f) sa
189+ ]
190+ , bgroup "mapAccumL"
191+ [ benchT $ nf (T.mapAccumL g 0) ta
192+ , benchTL $ nf (TL.mapAccumL g 0) tla
193+ , benchBS $ nf (BS.mapAccumL g 0) bsa
194+ , benchBSL $ nf (BL.mapAccumL g 0) bla
195+ , benchS $ nf (L.mapAccumL g 0) sa
196+ ]
197+ , bgroup "mapAccumR"
198+ [ benchT $ nf (T.mapAccumR g 0) ta
199+ , benchTL $ nf (TL.mapAccumR g 0) tla
200+ , benchBS $ nf (BS.mapAccumR g 0) bsa
201+ , benchBSL $ nf (BL.mapAccumR g 0) bla
202+ , benchS $ nf (L.mapAccumR g 0) sa
203+ ]
204+ , bgroup "map.map"
205+ [ benchT $ nf (T.map f . T.map f) ta
206+ , benchTL $ nf (TL.map f . TL.map f) tla
207+ , benchBS $ nf (BS.map f . BS.map f) bsa
208+ , benchBSL $ nf (BL.map f . BL.map f) bla
209+ , benchS $ nf (L.map f . L.map f) sa
210+ ]
211+ , bgroup "replicate char"
212+ [ benchT $ nf (T.replicate bsa_len) (T.singleton c)
213+ , benchTL $ nf (TL.replicate (fromIntegral bsa_len)) (TL.singleton c)
214+ , benchBS $ nf (BS.replicate bsa_len) c
215+ , benchBSL $ nf (BL.replicate (fromIntegral bsa_len)) c
216+ , benchS $ nf (L.replicate bsa_len) c
217+ ]
218+ , bgroup "replicate string"
219+ [ benchT $ nf (T.replicate (bsa_len `div` T.length tsw)) tsw
220+ , benchTL $ nf (TL.replicate (fromIntegral bsa_len `div` TL.length tlw)) tlw
221+ , benchS $ nf (replicat (bsa_len `div` T.length tsw)) lw
222+ ]
223+ , bgroup "reverse"
224+ [ benchT $ nf T.reverse ta
225+ , benchTL $ nf TL.reverse tla
226+ , benchBS $ nf BS.reverse bsa
227+ , benchBSL $ nf BL.reverse bla
228+ , benchS $ nf L.reverse sa
229+ ]
230+ , bgroup "take"
231+ [ benchT $ nf (T.take (ta_len `div` 3)) ta
232+ , benchTL $ nf (TL.take (tla_len `div` 3)) tla
233+ , benchBS $ nf (BS.take (bsa_len `div` 3)) bsa
234+ , benchBSL $ nf (BL.take (bla_len `div` 3)) bla
235+ , benchS $ nf (L.take (sa_len `div` 3)) sa
236+ ]
237+ , bgroup "tail"
238+ [ benchT $ nf T.tail ta
239+ , benchTL $ nf TL.tail tla
240+ , benchBS $ nf BS.tail bsa
241+ , benchBSL $ nf BL.tail bla
242+ , benchS $ nf L.tail sa
243+ ]
244+ , bgroup "toLower"
245+ [ benchT $ nf T.toLower ta
246+ , benchTL $ nf TL.toLower tla
247+ , benchBS $ nf (BS.map toLower) bsa
248+ , benchBSL $ nf (BL.map toLower) bla
249+ , benchS $ nf (L.map toLower) sa
250+ ]
251+ , bgroup "toUpper"
252+ [ benchT $ nf T.toUpper ta
253+ , benchTL $ nf TL.toUpper tla
254+ , benchBS $ nf (BS.map toUpper) bsa
255+ , benchBSL $ nf (BL.map toUpper) bla
256+ , benchS $ nf (L.map toUpper) sa
257+ ]
258+ , bgroup "words"
259+ [ benchT $ nf T.words ta
260+ , benchTL $ nf TL.words tla
261+ , benchBS $ nf BS.words bsa
262+ , benchBSL $ nf BL.words bla
263+ , benchS $ nf L.words sa
264+ ]
265+ , bgroup "zipWith"
266+ [ benchT $ nf (T.zipWith min tb) ta
267+ , benchTL $ nf (TL.zipWith min tlb) tla
268+ , benchBS $ nf (BS.zipWith min bsb) bsa
269+ , benchBSL $ nf (BL.zipWith min blb) bla
270+ , benchS $ nf (L.zipWith min sb) sa
271+ ]
272+ , bgroup "length"
273+ [ bgroup "cons"
274+ [ benchT $ nf (T.length . T.cons c) ta
275+ , benchTL $ nf (TL.length . TL.cons c) tla
276+ , benchBS $ nf (BS.length . BS.cons c) bsa
277+ , benchBSL $ nf (BL.length . BL.cons c) bla
278+ , benchS $ nf (L.length . (:) c) sa
279+ ]
280+ , bgroup "decode"
281+ [ benchT $ nf (T.length . T.decodeUtf8) bsa
282+ , benchTL $ nf (TL.length . TL.decodeUtf8) bla
283+ , benchBS $ nf (L.length . BS.unpack) bsa
284+ , benchBSL $ nf (L.length . BL.unpack) bla
285+ , bench "StringUTF8" $ nf (L.length . UTF8.toString) bsa
286+ ]
287+ , bgroup "drop"
288+ [ benchT $ nf (T.length . T.drop (ta_len `div` 3)) ta
289+ , benchTL $ nf (TL.length . TL.drop (tla_len `div` 3)) tla
290+ , benchBS $ nf (BS.length . BS.drop (bsa_len `div` 3)) bsa
291+ , benchBSL $ nf (BL.length . BL.drop (bla_len `div` 3)) bla
292+ , benchS $ nf (L.length . L.drop (sa_len `div` 3)) sa
293+ ]
294+ , bgroup "filter"
295+ [ benchT $ nf (T.length . T.filter p0) ta
296+ , benchTL $ nf (TL.length . TL.filter p0) tla
297+ , benchBS $ nf (BS.length . BS.filter p0) bsa
298+ , benchBSL $ nf (BL.length . BL.filter p0) bla
299+ , benchS $ nf (L.length . L.filter p0) sa
300+ ]
301+ , bgroup "filter.filter"
302+ [ benchT $ nf (T.length . T.filter p1 . T.filter p0) ta
303+ , benchTL $ nf (TL.length . TL.filter p1 . TL.filter p0) tla
304+ , benchBS $ nf (BS.length . BS.filter p1 . BS.filter p0) bsa
305+ , benchBSL $ nf (BL.length . BL.filter p1 . BL.filter p0) bla
306+ , benchS $ nf (L.length . L.filter p1 . L.filter p0) sa
307+ ]
308+ , bgroup "init"
309+ [ benchT $ nf (T.length . T.init) ta
310+ , benchTL $ nf (TL.length . TL.init) tla
311+ , benchBS $ nf (BS.length . BS.init) bsa
312+ , benchBSL $ nf (BL.length . BL.init) bla
313+ , benchS $ nf (L.length . L.init) sa
314+ ]
315+ , bgroup "intercalate"
316+ [ benchT $ nf (T.length . T.intercalate tsw) tl
317+ , benchTL $ nf (TL.length . TL.intercalate tlw) tll
318+ , benchBS $ nf (BS.length . BS.intercalate bsw) bsl
319+ , benchBSL $ nf (BL.length . BL.intercalate blw) bll
320+ , benchS $ nf (L.length . L.intercalate lw) sl
321+ ]
322+ , bgroup "intersperse"
323+ [ benchT $ nf (T.length . T.intersperse c) ta
324+ , benchTL $ nf (TL.length . TL.intersperse c) tla
325+ , benchBS $ nf (BS.length . BS.intersperse c) bsa
326+ , benchBSL $ nf (BL.length . BL.intersperse c) bla
327+ , benchS $ nf (L.length . L.intersperse c) sa
328+ ]
329+ , bgroup "map"
330+ [ benchT $ nf (T.length . T.map f) ta
331+ , benchTL $ nf (TL.length . TL.map f) tla
332+ , benchBS $ nf (BS.length . BS.map f) bsa
333+ , benchBSL $ nf (BL.length . BL.map f) bla
334+ , benchS $ nf (L.length . L.map f) sa
335+ ]
336+ , bgroup "map.map"
337+ [ benchT $ nf (T.length . T.map f . T.map f) ta
338+ , benchTL $ nf (TL.length . TL.map f . TL.map f) tla
339+ , benchBS $ nf (BS.length . BS.map f . BS.map f) bsa
340+ , benchS $ nf (L.length . L.map f . L.map f) sa
341+ ]
342+ , bgroup "replicate char"
343+ [ benchT $ nf (T.length . T.replicate bsa_len) (T.singleton c)
344+ , benchTL $ nf (TL.length . TL.replicate (fromIntegral bsa_len)) (TL.singleton c)
345+ , benchBS $ nf (BS.length . BS.replicate bsa_len) c
346+ , benchBSL $ nf (BL.length . BL.replicate (fromIntegral bsa_len)) c
347+ , benchS $ nf (L.length . L.replicate bsa_len) c
348+ ]
349+ , bgroup "replicate string"
350+ [ benchT $ nf (T.length . T.replicate (bsa_len `div` T.length tsw)) tsw
351+ , benchTL $ nf (TL.length . TL.replicate (fromIntegral bsa_len `div` TL.length tlw)) tlw
352+ , benchS $ nf (L.length . replicat (bsa_len `div` T.length tsw)) lw
353+ ]
354+ , bgroup "take"
355+ [ benchT $ nf (T.length . T.take (ta_len `div` 3)) ta
356+ , benchTL $ nf (TL.length . TL.take (tla_len `div` 3)) tla
357+ , benchBS $ nf (BS.length . BS.take (bsa_len `div` 3)) bsa
358+ , benchBSL $ nf (BL.length . BL.take (bla_len `div` 3)) bla
359+ , benchS $ nf (L.length . L.take (sa_len `div` 3)) sa
360+ ]
361+ , bgroup "tail"
362+ [ benchT $ nf (T.length . T.tail) ta
363+ , benchTL $ nf (TL.length . TL.tail) tla
364+ , benchBS $ nf (BS.length . BS.tail) bsa
365+ , benchBSL $ nf (BL.length . BL.tail) bla
366+ , benchS $ nf (L.length . L.tail) sa
367+ ]
368+ , bgroup "toLower"
369+ [ benchT $ nf (T.length . T.toLower) ta
370+ , benchTL $ nf (TL.length . TL.toLower) tla
371+ , benchBS $ nf (BS.length . BS.map toLower) bsa
372+ , benchBSL $ nf (BL.length . BL.map toLower) bla
373+ , benchS $ nf (L.length . L.map toLower) sa
374+ ]
375+ , bgroup "toUpper"
376+ [ benchT $ nf (T.length . T.toUpper) ta
377+ , benchTL $ nf (TL.length . TL.toUpper) tla
378+ , benchBS $ nf (BS.length . BS.map toUpper) bsa
379+ , benchBSL $ nf (BL.length . BL.map toUpper) bla
380+ , benchS $ nf (L.length . L.map toUpper) sa
381+ ]
382+ , bgroup "words"
383+ [ benchT $ nf (L.length . T.words) ta
384+ , benchTL $ nf (L.length . TL.words) tla
385+ , benchBS $ nf (L.length . BS.words) bsa
386+ , benchBSL $ nf (L.length . BL.words) bla
387+ , benchS $ nf (L.length . L.words) sa
388+ ]
389+ , bgroup "zipWith"
390+ [ benchT $ nf (T.length . T.zipWith min tb) ta
391+ , benchTL $ nf (TL.length . TL.zipWith min tlb) tla
392+ , benchBS $ nf (L.length . BS.zipWith min bsb) bsa
393+ , benchBSL $ nf (L.length . BL.zipWith min blb) bla
394+ , benchS $ nf (L.length . L.zipWith min sb) sa
395+ ]
396+ ]
397+ , bgroup "Builder"
398+ [ bench "mappend char" $ nf (TL.length . TB.toLazyText . mappendNChar 'a') 10000
399+ , bench "mappend 8 char" $ nf (TL.length . TB.toLazyText . mappend8Char) 'a'
400+ , bench "mappend text" $ nf (TL.length . TB.toLazyText . mappendNText short) 10000
401+ ]
402+ ]
403+ where
404+ benchS = bench "String"
405+ benchT = bench "Text"
406+ benchTL = bench "LazyText"
407+ benchBS = bench "ByteString"
408+ benchBSL = bench "LazyByteString"
409+
410+ c = 'й'
411+ p0 = (== c)
412+ p1 = (/= 'д')
413+ lw = "право"
414+ bsw = UTF8.fromString lw
415+ blw = BL.fromChunks [bsw]
416+ tsw = T.pack lw
417+ tlw = TL.fromChunks [tsw]
418+ f (C# c#) = C# (chr# (ord# c# +# 1#))
419+ g (I# i#) (C# c#) = (I# (i# +# 1#), C# (chr# (ord# c# +# i#)))
420+ len l _ = l + (1::Int)
421+ replicat n = concat . L.replicate n
422+ short = T.pack "short"
423+
424+instance NFData BS.ByteString
425+
426+instance NFData BL.ByteString where
427+ rnf BL.Empty = ()
428+ rnf (BL.Chunk _ ts) = rnf ts
429+
430+data B where
431+ B :: NFData a => a -> B
432+
433+instance NFData B where
434+ rnf (B b) = rnf b
435+
436+-- | Split a bytestring in chunks
437+--
438+chunksOf :: Int -> BS.ByteString -> [BS.ByteString]
439+chunksOf k = go
440+ where
441+ go t = case BS.splitAt k t of
442+ (a,b) | BS.null a -> []
443+ | otherwise -> a : go b
444+
445+-- | Append a character n times
446+--
447+mappendNChar :: Char -> Int -> TB.Builder
448+mappendNChar c n = go 0
449+ where
450+ go i
451+ | i < n = TB.singleton c `mappend` go (i+1)
452+ | otherwise = mempty
453+
454+-- | Gives more opportunity for inlining and elimination of unnecesary
455+-- bounds checks.
456+--
457+mappend8Char :: Char -> TB.Builder
458+mappend8Char c = TB.singleton c `mappend` TB.singleton c `mappend`
459+ TB.singleton c `mappend` TB.singleton c `mappend`
460+ TB.singleton c `mappend` TB.singleton c `mappend`
461+ TB.singleton c `mappend` TB.singleton c
462+
463+-- | Append a text N times
464+--
465+mappendNText :: T.Text -> Int -> TB.Builder
466+mappendNText t n = go 0
467+ where
468+ go i
469+ | i < n = TB.fromText t `mappend` go (i+1)
470+ | otherwise = mempty
tests/benchmarks/src/Data/Text/Benchmarks/ReadNumbers.hsnew file+83
@@ -0,0 +1,83 @@
1+-- | Read numbers from a file with a just a number on each line, find the
2+-- minimum of those numbers.
3+--
4+module Data.Text.Benchmarks.ReadNumbers
5+ ( benchmark
6+ ) where
7+
8+import Control.Exception (evaluate)
9+import Criterion (Benchmark, bgroup, bench)
10+import Data.List (foldl')
11+import Numeric (readDec, readFloat, readHex)
12+import qualified Data.ByteString.Char8 as B
13+import qualified Data.ByteString.Lazy.Char8 as BL
14+import qualified Data.ByteString.Lex.Double as B
15+import qualified Data.ByteString.Lex.Lazy.Double 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+import qualified Data.Text.Lazy.Read as TL
21+import qualified Data.Text.Read as T
22+
23+benchmark :: FilePath -> IO Benchmark
24+benchmark fp = return $ bgroup "ReadNumbers"
25+ [ bench "DecimalString" $ readFile fp >>= evaluate .
26+ int . string readDec . lines
27+ , bench "HexadecimalString" $ readFile fp >>= evaluate .
28+ int . string readHex . lines
29+ , bench "DoubleString" $ readFile fp >>= evaluate .
30+ double . string readFloat . lines
31+
32+ , bench "DecimalText" $ B.readFile fp >>= evaluate .
33+ int . text (T.signed T.decimal) . T.lines . T.decodeUtf8
34+ , bench "HexadecimalText" $ B.readFile fp >>= evaluate .
35+ int . text (T.signed T.hexadecimal) . T.lines . T.decodeUtf8
36+ , bench "DoubleText" $ B.readFile fp >>= evaluate .
37+ double . text T.double . T.lines . T.decodeUtf8
38+ , bench "RationalText" $ B.readFile fp >>= evaluate .
39+ double . text T.rational . T.lines . T.decodeUtf8
40+
41+ , bench "DecimalLazyText" $ BL.readFile fp >>= evaluate .
42+ int . text (TL.signed TL.decimal) . TL.lines . TL.decodeUtf8
43+ , bench "HexadecimalLazyText" $ BL.readFile fp >>= evaluate .
44+ int . text (TL.signed TL.hexadecimal) . TL.lines . TL.decodeUtf8
45+ , bench "DoubleLazyText" $ BL.readFile fp >>= evaluate .
46+ double . text TL.double . TL.lines . TL.decodeUtf8
47+ , bench "RationalLazyText" $ BL.readFile fp >>= evaluate .
48+ double . text TL.rational . TL.lines . TL.decodeUtf8
49+
50+ , bench "DecimalByteString" $ B.readFile fp >>= evaluate .
51+ int . byteString B.readInt . B.lines
52+ , bench "DoubleByteString" $ B.readFile fp >>= evaluate .
53+ double . byteString B.readDouble . B.lines
54+
55+ , bench "DecimalLazyByteString" $ BL.readFile fp >>= evaluate .
56+ int . byteString BL.readInt . BL.lines
57+ , bench "DoubleLazyByteString" $ BL.readFile fp >>= evaluate .
58+ double . byteString BL.readDouble . BL.lines
59+ ]
60+ where
61+ -- Used for fixing types
62+ int :: Int -> Int
63+ int = id
64+ double :: Double -> Double
65+ double = id
66+
67+string :: (Ord a, Num a) => (t -> [(a, t)]) -> [t] -> a
68+string reader = foldl' go 1000000
69+ where
70+ go z t = case reader t of [(n, _)] -> min n z
71+ _ -> z
72+
73+text :: (Ord a, Num a) => (t -> Either String (a,t)) -> [t] -> a
74+text reader = foldl' go 1000000
75+ where
76+ go z t = case reader t of Left _ -> z
77+ Right (n, _) -> min n z
78+
79+byteString :: (Ord a, Num a) => (t -> Maybe (a,t)) -> [t] -> a
80+byteString reader = foldl' go 1000000
81+ where
82+ go z t = case reader t of Nothing -> z
83+ Just (n, _) -> min n z
tests/benchmarks/src/Data/Text/Benchmarks/Replace.hsnew file+33
@@ -0,0 +1,33 @@
1+-- | Replace a string by another string in a file
2+--
3+module Data.Text.Benchmarks.Replace
4+ ( benchmark
5+ ) where
6+
7+import Criterion (Benchmark, bgroup, bench)
8+import System.IO (Handle)
9+import qualified Data.ByteString.Char8 as B
10+import qualified Data.ByteString.Lazy as BL
11+import qualified Data.ByteString.Lazy.Search as BL
12+import qualified Data.Text.Lazy as TL
13+import qualified Data.Text.Lazy.Encoding as TL
14+import qualified Data.Text.Lazy.IO as TL
15+
16+benchmark :: FilePath -> Handle -> String -> String -> IO Benchmark
17+benchmark fp sink pat sub = return $ bgroup "Replace"
18+ -- We have benchmarks for lazy text and lazy bytestrings. We also benchmark
19+ -- without the acual replacement, so we can get an idea of what time is
20+ -- spent on IO and computations.
21+ [ bench "LazyText" $ TL.readFile fp >>=
22+ TL.hPutStr sink . TL.replace tpat tsub
23+ , bench "LazyTextNull" $ TL.readFile fp >>= TL.hPutStr sink
24+
25+ , bench "LazyByteString" $ BL.readFile fp >>=
26+ BL.hPutStr sink . BL.replace bpat bsub
27+ , bench "LazyByteStringNull" $ BL.readFile fp >>= BL.hPutStr sink
28+ ]
29+ where
30+ tpat = TL.pack pat
31+ tsub = TL.pack sub
32+ bpat = B.concat $ BL.toChunks $ TL.encodeUtf8 tpat
33+ bsub = B.concat $ BL.toChunks $ TL.encodeUtf8 tsub
tests/benchmarks/src/Data/Text/Benchmarks/Sort.hsnew file+27
@@ -0,0 +1,27 @@
1+-- | Implements the unix @sort@ program
2+--
3+{-# LANGUAGE OverloadedStrings #-}
4+module Data.Text.Benchmarks.Sort
5+ ( benchmark
6+ ) where
7+
8+import Criterion (Benchmark, bench)
9+import Data.Monoid (mconcat)
10+import System.IO (Handle)
11+import qualified Data.ByteString as B
12+import qualified Data.ByteString.Lazy as BL
13+import qualified Data.List as L
14+import qualified Data.Text as T
15+import qualified Data.Text.Encoding as T
16+import qualified Data.Text.Lazy as TL
17+import qualified Data.Text.Lazy.Builder as TLB
18+import qualified Data.Text.Lazy.Encoding as TL
19+
20+benchmark :: FilePath -> Handle -> IO Benchmark
21+benchmark fp sink = return $ bench "Sort" $ do
22+ t <- T.decodeUtf8 `fmap` B.readFile fp
23+ BL.hPutStr sink $ TL.encodeUtf8 $ sort t
24+
25+sort :: T.Text -> TL.Text
26+sort = TLB.toLazyText . mconcat . L.intersperse (TLB.fromText "\n") .
27+ map TLB.fromText . L.sort . T.lines
tests/benchmarks/src/Data/Text/Benchmarks/StripBrackets.hsnew file+33
@@ -0,0 +1,33 @@
1+-- | Program to replace everything between brackets by spaces
2+--
3+-- This program was originally contributed by Petr Prokhorenkov.
4+--
5+module Data.Text.Benchmarks.StripBrackets
6+ ( benchmark
7+ ) where
8+
9+import Criterion (Benchmark, bench)
10+import System.IO (Handle)
11+import qualified Data.ByteString as B
12+import qualified Data.Text as T
13+import qualified Data.Text.Encoding as T
14+
15+benchmark :: FilePath -> Handle -> IO Benchmark
16+benchmark fp sink = return $ bench "StripBrackets" $ do
17+ t <- T.decodeUtf8 `fmap` B.readFile fp
18+ B.hPutStr sink $ T.encodeUtf8 $ stripBrackets t
19+
20+stripBrackets :: T.Text -> T.Text
21+stripBrackets = snd . T.mapAccumL f (0 :: Int)
22+ where
23+ f depth c =
24+ let depth' = depth + d' c
25+ c' | depth > 0 || depth' > 0 = ' '
26+ | otherwise = c
27+ in (depth', c')
28+
29+ d' '{' = 1
30+ d' '[' = 1
31+ d' '}' = -1
32+ d' ']' = -1
33+ d' _ = 0
tests/benchmarks/src/Data/Text/Benchmarks/WordCount.hsnew file+22
@@ -0,0 +1,22 @@
1+-- | A word frequence count program
2+--
3+module Data.Text.Benchmarks.WordCount
4+ ( benchmark
5+ ) where
6+
7+import Control.Exception (evaluate)
8+import Criterion (Benchmark, bench)
9+import Data.List (foldl')
10+import Data.Map (Map)
11+import qualified Data.Map as M
12+import qualified Data.Text as T
13+import qualified Data.Text.IO as T
14+
15+benchmark :: FilePath -> IO Benchmark
16+benchmark fp = return $ bench "WordCount" $ do
17+ t <- T.readFile fp
18+ evaluate $ M.size $ wordCount t
19+
20+wordCount :: T.Text -> Map T.Text Int
21+wordCount =
22+ foldl' (\m k -> M.insertWith (+) k 1 m) M.empty . map T.toLower . T.words