@@ -0,0 +1,68 @@
1+-- | Benchmark which formats paragraph, like the @sort@ unix utility.
2+--
3+-- Tested in this benchmark:
4+--
5+-- * Reading the file
6+--
7+-- * Splitting into paragraphs
8+--
9+-- * Reformatting the paragraphs to a certain line width
10+--
11+-- * Concatenating the results using the text builder
12+--
13+-- * Writing back to a handle
14+--
15+{-# LANGUAGE OverloadedStrings #-}
16+module Data.Text.Benchmarks.Programs.Fold
17+ ( benchmark
18+ ) where
19+
20+import Data.List (foldl')
21+import Data.List (intersperse)
22+import Data.Monoid (mempty, mappend, mconcat)
23+import System.IO (Handle)
24+import Criterion (Benchmark, bench)
25+import qualified Data.Text as T
26+import qualified Data.Text.IO as T
27+import qualified Data.Text.Lazy.Builder as TLB
28+import qualified Data.Text.Lazy as TL
29+import qualified Data.Text.Lazy.IO as TL
30+
31+benchmark :: FilePath -> Handle -> IO Benchmark
32+benchmark i o = return $
33+ bench "Fold" $ T.readFile i >>= TL.hPutStr o . fold 80
34+
35+-- | We represent a paragraph by a word list
36+--
37+type Paragraph = [T.Text]
38+
39+-- | Fold a text
40+--
41+fold :: Int -> T.Text -> TL.Text
42+fold maxWidth = TLB.toLazyText . mconcat .
43+ intersperse "\n\n" . map (foldParagraph maxWidth) . paragraphs
44+
45+-- | Fold a paragraph
46+--
47+foldParagraph :: Int -> Paragraph -> TLB.Builder
48+foldParagraph _ [] = mempty
49+foldParagraph max' (w : ws) = fst $ foldl' go (TLB.fromText w, T.length w) ws
50+ where
51+ go (builder, width) word
52+ | width + len + 1 <= max' =
53+ (builder `mappend` " " `mappend` word', width + len + 1)
54+ | otherwise =
55+ (builder `mappend` "\n" `mappend` word', len)
56+ where
57+ word' = TLB.fromText word
58+ len = T.length word
59+
60+-- | Divide a text into paragraphs
61+--
62+paragraphs :: T.Text -> [Paragraph]
63+paragraphs = splitParagraphs . map T.words . T.lines
64+ where
65+ splitParagraphs ls = case break null ls of
66+ ([], []) -> []
67+ (p, []) -> [concat p]
68+ (p, lr) -> concat p : splitParagraphs (dropWhile null lr)