0816c04 · text · git.iko.soy

tests/Benchmarks.hsdeleted−463

@@ -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 | \

2323

2424cabal := $(shell which cabal 2>/dev/null)

2525

26−all: bm qc coverage regressions

26+all: qc coverage regressions

2727

2828lib: $(lib)

2929

@@ -78,11 +78,6 @@ Regressions.o: TestUtils.o

7878regressions: Regressions.o TestUtils.o

7979 $(ghc) $(ghc-test-flags) -o $@ $^ $(lib)

8080

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−

8681SlowFunctions.o: ghc-opt-flags = -O2

8782SearchBench.o: ghc-opt-flags = -O

8883%.o: %.hs

@@ -98,4 +93,4 @@ text-testdata.tar.bz2:

9893 curl -O http://projects.haskell.org/text/text-testdata.tar.bz2

9994

10095clean:

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