1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
|
-- | Benchmarks simple file writing
--
-- Tested in this benchmark:
--
-- * Writing a file to the disk
--
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-}
module Benchmarks.FileWrite
( mkFileWriteBenchmarks
) where
import Control.DeepSeq (NFData, deepseq)
import Data.Bifunctor (first)
import Data.List (intercalate, intersperse)
import Data.String (fromString)
import Data.Text (StrictText)
import Data.Text.Internal.Lazy (LazyText, defaultChunkSize)
import System.IO (Handle, Newline(CRLF,LF), NewlineMode(NewlineMode), BufferMode(..), hSetBuffering, hSetNewlineMode)
import Test.Tasty.Bench (Benchmark, bgroup, bench, whnfAppIO)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Data.Text.IO.Utf8 as Utf8
import qualified Data.Text.Lazy as L
import qualified Data.Text.Lazy.IO as L
mkFileWriteBenchmarks :: IO (Handle, IO ()) -> IO (Benchmark, IO ())
mkFileWriteBenchmarks mkSinkNRemove = do
let writeData = L.cycle $ fromString [minBound..maxBound]
#ifdef ExtendedBenchmarks
lengths = [0..5] <> [10,20..100] <> [1000,3000,10000,100000]
#else
lengths = [0,1,100,3000,10000,100000]
#endif
testGroup :: NFData text => (Handle -> text -> IO ()) -> ((String, StrictText -> text)) -> Newline -> BufferMode -> IO (Benchmark, IO ())
testGroup hPutStr (textCharacteristics, select) nl mode = do
(h, removeFile) <- mkSinkNRemove
hSetBuffering h mode
hSetNewlineMode h $ NewlineMode nl nl
pure
( bgroup (intercalate " " [textCharacteristics, show nl, show mode]) $
lengths <&> \n -> let
t = select $ L.toStrict $ L.take n writeData
in bench ("length " <> show n)
$ deepseq t
$ whnfAppIO (hPutStr h) t
, removeFile
)
sequenceGroup "FileWrite hPutStr"
#ifdef ExtendedBenchmarks
[ testGroup T.hPutStr strict LF NoBuffering
, testGroup L.hPutStr lazy LF NoBuffering
, testGroup T.hPutStr strict LF LineBuffering
, testGroup T.hPutStr strict CRLF LineBuffering
, testGroup T.hPutStr strictNewlines LF LineBuffering
, testGroup T.hPutStr strictNewlines CRLF LineBuffering
, testGroup L.hPutStr lazy LF LineBuffering
, testGroup L.hPutStr lazy CRLF LineBuffering
, testGroup L.hPutStr lazySmallChunks LF LineBuffering
, testGroup L.hPutStr lazySmallChunks CRLF LineBuffering
, testGroup L.hPutStr lazyNewlines LF LineBuffering
, testGroup L.hPutStr lazyNewlines CRLF LineBuffering
, testGroup L.hPutStr lazySmallChunksNewlines LF LineBuffering
, testGroup L.hPutStr lazySmallChunksNewlines CRLF LineBuffering
, testGroup T.hPutStr strict LF (BlockBuffering Nothing)
, testGroup T.hPutStr strict CRLF (BlockBuffering Nothing)
, testGroup T.hPutStr strictNewlines LF (BlockBuffering Nothing)
, testGroup T.hPutStr strictNewlines CRLF (BlockBuffering Nothing)
, testGroup L.hPutStr lazy LF (BlockBuffering Nothing)
, testGroup L.hPutStr lazy CRLF (BlockBuffering Nothing)
, testGroup L.hPutStr lazySmallChunks LF (BlockBuffering Nothing)
, testGroup L.hPutStr lazySmallChunks CRLF (BlockBuffering Nothing)
, testGroup L.hPutStr lazyNewlines LF (BlockBuffering Nothing)
, testGroup L.hPutStr lazyNewlines CRLF (BlockBuffering Nothing)
, testGroup L.hPutStr lazySmallChunksNewlines LF (BlockBuffering Nothing)
, testGroup L.hPutStr lazySmallChunksNewlines CRLF (BlockBuffering Nothing)
, sequenceGroup "UTF-8"
[ testGroup Utf8.hPutStr strict LF NoBuffering
, testGroup Utf8.hPutStr strict LF LineBuffering
, testGroup Utf8.hPutStr strict LF (BlockBuffering Nothing)
]
]
#else
[ testGroup T.hPutStr strictNewlines LF LineBuffering
, testGroup T.hPutStr strictNewlines CRLF LineBuffering
, testGroup T.hPutStr strict LF (BlockBuffering Nothing)
, testGroup T.hPutStr strictNewlines CRLF (BlockBuffering Nothing)
, testGroup L.hPutStr lazyNewlines LF LineBuffering
, testGroup L.hPutStr lazyNewlines CRLF LineBuffering
, testGroup L.hPutStr lazy LF (BlockBuffering Nothing)
, testGroup L.hPutStr lazyNewlines CRLF (BlockBuffering Nothing)
, sequenceGroup "UTF-8"
[ testGroup Utf8.hPutStr strict LF LineBuffering
, testGroup Utf8.hPutStr strict LF (BlockBuffering Nothing)
]
]
#endif
where
lazy, lazyNewlines :: (String, StrictText -> LazyText)
lazy = ("lazy", L.fromChunks . T.chunksOf defaultChunkSize)
lazyNewlines = ("lazy many newlines", snd lazy . snd strictNewlines)
#ifdef ExtendedBenchmarks
lazySmallChunks, lazySmallChunksNewlines :: (String, StrictText -> LazyText)
lazySmallChunks = ("lazy small chunks", L.fromChunks . T.chunksOf 10)
lazySmallChunksNewlines = ("lazy small chunks many newlines", snd lazySmallChunks . snd strictNewlines)
#endif
strict, strictNewlines :: (String, StrictText -> StrictText)
strict = ("strict", id)
strictNewlines = ("strict many newlines", mconcat . intersperse "\n" . T.chunksOf 5)
sequenceGroup groupName tgs
= first (bgroup groupName)
. foldr (\(b,r) (bs,rs) -> (b:bs,r>>rs)) ([], return ())
<$> sequence tgs
(<&>) :: Functor f => f a -> (a -> b) -> f b
(<&>) = flip fmap
|
