From 7ebc8b9ce95f6eb78e19ed173475115f390d27f5 Mon Sep 17 00:00:00 2001 From: William Rusnack Date: Tue, 23 Apr 2024 10:23:14 -0400 Subject: [PATCH 1/8] Added file write benchmarks --- benchmarks/haskell/Benchmarks.hs | 6 ++ benchmarks/haskell/Benchmarks/FileWrite.hs | 67 ++++++++++++++++++++++ text.cabal | 1 + 3 files changed, 74 insertions(+) create mode 100644 benchmarks/haskell/Benchmarks/FileWrite.hs diff --git a/benchmarks/haskell/Benchmarks.hs b/benchmarks/haskell/Benchmarks.hs index 33e6a025..8c8be643 100644 --- a/benchmarks/haskell/Benchmarks.hs +++ b/benchmarks/haskell/Benchmarks.hs @@ -19,6 +19,7 @@ import qualified Benchmarks.DecodeUtf8 as DecodeUtf8 import qualified Benchmarks.EncodeUtf8 as EncodeUtf8 import qualified Benchmarks.Equality as Equality import qualified Benchmarks.FileRead as FileRead +import qualified Benchmarks.FileWrite as FileWrite import qualified Benchmarks.FoldLines as FoldLines import qualified Benchmarks.Micro as Micro import qualified Benchmarks.Multilang as Multilang @@ -59,6 +60,9 @@ main = do let tf = ("benchmarks/text-test-data" ) -- Cannot use envWithCleanup, because there is no instance NFData Handle (sinkFn, sink) <- mkSink + (fileWriteBenchmarks, fileWriteCleanup) <- FileWrite.mkFileWriteBenchmarks $ do + (fp, h) <- mkSink + return (h, rmSink fp) defaultMain [ Builder.benchmark , Concat.benchmark @@ -77,6 +81,7 @@ main = do ] , env (Equality.initEnv (tf "japanese.txt")) Equality.benchmark , FileRead.benchmark (tf "russian.txt") + , fileWriteBenchmarks , FoldLines.benchmark (tf "russian.txt") , Multilang.benchmark , bgroup "Pure" @@ -102,3 +107,4 @@ main = do ] ] rmSink sinkFn + fileWriteCleanup diff --git a/benchmarks/haskell/Benchmarks/FileWrite.hs b/benchmarks/haskell/Benchmarks/FileWrite.hs new file mode 100644 index 00000000..bc7cd960 --- /dev/null +++ b/benchmarks/haskell/Benchmarks/FileWrite.hs @@ -0,0 +1,67 @@ +-- | Benchmarks simple file writing +-- +-- Tested in this benchmark: +-- +-- * Writing a file to the disk +-- + +{-# LANGUAGE BangPatterns #-} + +module Benchmarks.FileWrite + ( mkFileWriteBenchmarks + ) where + +import System.IO +import Data.String (fromString) +import qualified Data.Text.Lazy as LT +import Test.Tasty.Bench (Benchmark, bgroup, bench, nfIO) +import qualified Data.Text.IO as T +import qualified Data.Text.Lazy.IO as LT +import Control.DeepSeq (deepseq) +import Data.Functor ((<&>)) + +mkFileWriteBenchmarks :: IO (Handle, IO ()) -> IO (Benchmark, IO ()) +mkFileWriteBenchmarks mkSinkNRemove = do + let writeDate = LT.cycle $ fromString [minBound..maxBound] + lengths = [0..5] <> [10,20..100] <> [1000,10000,100000] + newlineSelect nl = do + let nlm = NewlineMode nl nl + (!noBufH, noBufRm) <- mkSinkNRemove + hSetBuffering noBufH NoBuffering + hSetNewlineMode noBufH nlm + (!lineBufH, lineBufRm) <- mkSinkNRemove + hSetBuffering lineBufH LineBuffering + hSetNewlineMode lineBufH nlm + (!blockBufH, blockBufRm) <- mkSinkNRemove + hSetBuffering blockBufH $ BlockBuffering Nothing + hSetNewlineMode blockBufH nlm + + return + ( bgroup ("Newline " <> show nl) $ lengths <&> \n -> let + st = LT.toStrict lt + lt = LT.take n writeDate + in bgroup ("length " <> show n) + [ deepseq st $ bgroup "StrictText" + [ bench "NoBuffering" $ nfIO $ T.hPutStr noBufH st + , bench "LineBuffering" $ nfIO $ T.hPutStr lineBufH st + , bench "BlockBuffering" $ nfIO $ T.hPutStr blockBufH st + ] + , deepseq lt $ bgroup "LazyText" + [ bench "NoBuffering" $ nfIO $ LT.hPutStr noBufH lt + , bench "LineBuffering" $ nfIO $ LT.hPutStr lineBufH lt + , bench "BlockBuffering" $ nfIO $ LT.hPutStr blockBufH lt + ] + ] + , do + noBufRm + lineBufRm + blockBufRm + ) + + (lfB, lfR) <- newlineSelect LF + (crlfB, crlfR) <- newlineSelect CRLF + return + ( bgroup "FileWrite" [lfB, crlfB] + , lfR >> crlfR + ) + diff --git a/text.cabal b/text.cabal index 9b10c97c..ce21808c 100644 --- a/text.cabal +++ b/text.cabal @@ -332,6 +332,7 @@ benchmark text-benchmarks Benchmarks.EncodeUtf8 Benchmarks.Equality Benchmarks.FileRead + Benchmarks.FileWrite Benchmarks.FoldLines Benchmarks.Micro Benchmarks.Multilang From 43e6883846b883ff31e713219de3e555cde5f18c Mon Sep 17 00:00:00 2001 From: William Rusnack Date: Thu, 25 Apr 2024 12:37:49 -0400 Subject: [PATCH 2/8] added Data.Text.IO.Utf8.hPutStr to benchmarks --- benchmarks/haskell/Benchmarks/FileWrite.hs | 49 ++++++++++++---------- 1 file changed, 26 insertions(+), 23 deletions(-) diff --git a/benchmarks/haskell/Benchmarks/FileWrite.hs b/benchmarks/haskell/Benchmarks/FileWrite.hs index bc7cd960..79db1bd3 100644 --- a/benchmarks/haskell/Benchmarks/FileWrite.hs +++ b/benchmarks/haskell/Benchmarks/FileWrite.hs @@ -14,17 +14,22 @@ module Benchmarks.FileWrite import System.IO import Data.String (fromString) import qualified Data.Text.Lazy as LT -import Test.Tasty.Bench (Benchmark, bgroup, bench, nfIO) +import Test.Tasty.Bench (Benchmark, bgroup, bench, nfAppIO) import qualified Data.Text.IO as T import qualified Data.Text.Lazy.IO as LT -import Control.DeepSeq (deepseq) +import Control.DeepSeq (NFData, deepseq) import Data.Functor ((<&>)) +import Data.Text (StrictText) +import Data.Text.Lazy (LazyText) +import qualified Data.Text.IO.Utf8 as Utf8 +import Data.Bifunctor (first) mkFileWriteBenchmarks :: IO (Handle, IO ()) -> IO (Benchmark, IO ()) mkFileWriteBenchmarks mkSinkNRemove = do let writeDate = LT.cycle $ fromString [minBound..maxBound] lengths = [0..5] <> [10,20..100] <> [1000,10000,100000] - newlineSelect nl = do + testGroup :: NFData text => String -> (Handle -> text -> IO ()) -> ((StrictText,LazyText) -> text) -> Newline -> IO (Benchmark, IO ()) + testGroup groupName hPutStr select nl = do let nlm = NewlineMode nl nl (!noBufH, noBufRm) <- mkSinkNRemove hSetBuffering noBufH NoBuffering @@ -37,31 +42,29 @@ mkFileWriteBenchmarks mkSinkNRemove = do hSetNewlineMode blockBufH nlm return - ( bgroup ("Newline " <> show nl) $ lengths <&> \n -> let + ( bgroup (groupName <> " " <> show nl) $ lengths <&> \n -> let st = LT.toStrict lt lt = LT.take n writeDate - in bgroup ("length " <> show n) - [ deepseq st $ bgroup "StrictText" - [ bench "NoBuffering" $ nfIO $ T.hPutStr noBufH st - , bench "LineBuffering" $ nfIO $ T.hPutStr lineBufH st - , bench "BlockBuffering" $ nfIO $ T.hPutStr blockBufH st - ] - , deepseq lt $ bgroup "LazyText" - [ bench "NoBuffering" $ nfIO $ LT.hPutStr noBufH lt - , bench "LineBuffering" $ nfIO $ LT.hPutStr lineBufH lt - , bench "BlockBuffering" $ nfIO $ LT.hPutStr blockBufH lt - ] - ] + t = select (st, lt) + in bgroup ("length " <> show n) $ deepseq t + [ bench "NoBuffering" $ nfAppIO (hPutStr noBufH) t + , bench "LineBuffering" $ nfAppIO (hPutStr lineBufH) t + , bench "BlockBuffering" $ nfAppIO (hPutStr blockBufH) t + ] , do noBufRm lineBufRm blockBufRm ) + first (bgroup "FileWrite") + . foldr (\(b,r) (bs,rs) -> (b:bs,r>>rs)) ([], return ()) + <$> sequence + [ testGroup "Strict hPutStr" T.hPutStr strict LF + , testGroup "Lazy hPutStr" LT.hPutStr lazy LF + , testGroup "Strict hPutStr" T.hPutStr strict CRLF + , testGroup "Lazy hPutStr" LT.hPutStr lazy CRLF + , testGroup "Utf-8 hPutStr" Utf8.hPutStr strict LF + ] - (lfB, lfR) <- newlineSelect LF - (crlfB, crlfR) <- newlineSelect CRLF - return - ( bgroup "FileWrite" [lfB, crlfB] - , lfR >> crlfR - ) - +strict = fst +lazy = snd From 067b43de51e6897bf853732be7f272b2c02c8c5c Mon Sep 17 00:00:00 2001 From: William Rusnack Date: Sun, 28 Apr 2024 12:08:30 -0400 Subject: [PATCH 3/8] minor improvements --- benchmarks/haskell/Benchmarks/FileWrite.hs | 21 +++++++++++---------- 1 file changed, 11 insertions(+), 10 deletions(-) diff --git a/benchmarks/haskell/Benchmarks/FileWrite.hs b/benchmarks/haskell/Benchmarks/FileWrite.hs index 79db1bd3..b3948a5b 100644 --- a/benchmarks/haskell/Benchmarks/FileWrite.hs +++ b/benchmarks/haskell/Benchmarks/FileWrite.hs @@ -11,18 +11,18 @@ module Benchmarks.FileWrite ( mkFileWriteBenchmarks ) where -import System.IO -import Data.String (fromString) -import qualified Data.Text.Lazy as LT -import Test.Tasty.Bench (Benchmark, bgroup, bench, nfAppIO) -import qualified Data.Text.IO as T -import qualified Data.Text.Lazy.IO as LT import Control.DeepSeq (NFData, deepseq) +import Data.Bifunctor (first) import Data.Functor ((<&>)) +import Data.String (fromString) import Data.Text (StrictText) import Data.Text.Lazy (LazyText) +import System.IO (Handle, Newline(CRLF,LF), NewlineMode(NewlineMode), BufferMode(NoBuffering,LineBuffering,BlockBuffering), hSetBuffering, hSetNewlineMode) +import Test.Tasty.Bench (Benchmark, bgroup, bench, nfAppIO) +import qualified Data.Text.IO as T import qualified Data.Text.IO.Utf8 as Utf8 -import Data.Bifunctor (first) +import qualified Data.Text.Lazy as LT +import qualified Data.Text.Lazy.IO as LT mkFileWriteBenchmarks :: IO (Handle, IO ()) -> IO (Benchmark, IO ()) mkFileWriteBenchmarks mkSinkNRemove = do @@ -41,7 +41,7 @@ mkFileWriteBenchmarks mkSinkNRemove = do hSetBuffering blockBufH $ BlockBuffering Nothing hSetNewlineMode blockBufH nlm - return + pure ( bgroup (groupName <> " " <> show nl) $ lengths <&> \n -> let st = LT.toStrict lt lt = LT.take n writeDate @@ -66,5 +66,6 @@ mkFileWriteBenchmarks mkSinkNRemove = do , testGroup "Utf-8 hPutStr" Utf8.hPutStr strict LF ] -strict = fst -lazy = snd + where + strict = fst + lazy = snd From 3817d2c9dae3d4669e86907ae839e86e781a6dbe Mon Sep 17 00:00:00 2001 From: William Rusnack Date: Tue, 30 Apr 2024 09:42:49 -0400 Subject: [PATCH 4/8] defined <&> for old versions of base --- benchmarks/haskell/Benchmarks/FileWrite.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/benchmarks/haskell/Benchmarks/FileWrite.hs b/benchmarks/haskell/Benchmarks/FileWrite.hs index b3948a5b..c08c759d 100644 --- a/benchmarks/haskell/Benchmarks/FileWrite.hs +++ b/benchmarks/haskell/Benchmarks/FileWrite.hs @@ -13,7 +13,6 @@ module Benchmarks.FileWrite import Control.DeepSeq (NFData, deepseq) import Data.Bifunctor (first) -import Data.Functor ((<&>)) import Data.String (fromString) import Data.Text (StrictText) import Data.Text.Lazy (LazyText) @@ -69,3 +68,6 @@ mkFileWriteBenchmarks mkSinkNRemove = do where strict = fst lazy = snd + +(<&>) :: Functor f => f a -> (a -> b) -> f b +(<&>) = flip fmap From 2d41b1636987e5f482f419c73c1de01e7c8f325f Mon Sep 17 00:00:00 2001 From: William Rusnack Date: Tue, 30 Apr 2024 09:47:13 -0400 Subject: [PATCH 5/8] import <> --- benchmarks/haskell/Benchmarks/FileWrite.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/benchmarks/haskell/Benchmarks/FileWrite.hs b/benchmarks/haskell/Benchmarks/FileWrite.hs index c08c759d..c3a443f1 100644 --- a/benchmarks/haskell/Benchmarks/FileWrite.hs +++ b/benchmarks/haskell/Benchmarks/FileWrite.hs @@ -13,6 +13,7 @@ module Benchmarks.FileWrite import Control.DeepSeq (NFData, deepseq) import Data.Bifunctor (first) +import Data.Semigroup ((<>)) import Data.String (fromString) import Data.Text (StrictText) import Data.Text.Lazy (LazyText) From 5af6f5fb069d8963a13b6f495168585e6a86168b Mon Sep 17 00:00:00 2001 From: William Rusnack Date: Tue, 30 Apr 2024 16:33:44 -0400 Subject: [PATCH 6/8] added small chunks for hPutStr benchmarks --- benchmarks/haskell/Benchmarks/FileWrite.hs | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/benchmarks/haskell/Benchmarks/FileWrite.hs b/benchmarks/haskell/Benchmarks/FileWrite.hs index c3a443f1..c51c989b 100644 --- a/benchmarks/haskell/Benchmarks/FileWrite.hs +++ b/benchmarks/haskell/Benchmarks/FileWrite.hs @@ -19,6 +19,7 @@ import Data.Text (StrictText) import Data.Text.Lazy (LazyText) import System.IO (Handle, Newline(CRLF,LF), NewlineMode(NewlineMode), BufferMode(NoBuffering,LineBuffering,BlockBuffering), hSetBuffering, hSetNewlineMode) import Test.Tasty.Bench (Benchmark, bgroup, bench, nfAppIO) +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 LT @@ -60,15 +61,18 @@ mkFileWriteBenchmarks mkSinkNRemove = do . foldr (\(b,r) (bs,rs) -> (b:bs,r>>rs)) ([], return ()) <$> sequence [ testGroup "Strict hPutStr" T.hPutStr strict LF - , testGroup "Lazy hPutStr" LT.hPutStr lazy LF + , testGroup "Lazy hPutStr large chunks" LT.hPutStr lazyLargeChunks LF + , testGroup "Lazy hPutStr small chunks" LT.hPutStr lazySmallChunks LF , testGroup "Strict hPutStr" T.hPutStr strict CRLF - , testGroup "Lazy hPutStr" LT.hPutStr lazy CRLF + , testGroup "Lazy hPutStr large chunks" LT.hPutStr lazyLargeChunks CRLF + , testGroup "Lazy hPutStr small chunks" LT.hPutStr lazySmallChunks CRLF , testGroup "Utf-8 hPutStr" Utf8.hPutStr strict LF ] where strict = fst - lazy = snd + lazyLargeChunks = snd + lazySmallChunks = LT.fromChunks . T.chunksOf 10 . fst (<&>) :: Functor f => f a -> (a -> b) -> f b (<&>) = flip fmap From e1992d07f8cd7884a0dac5b8e252a14b2b9d04f9 Mon Sep 17 00:00:00 2001 From: William Rusnack Date: Wed, 1 May 2024 00:29:53 -0400 Subject: [PATCH 7/8] more flexible FileWrite benchmarks --- benchmarks/haskell/Benchmarks/FileWrite.hs | 142 ++++++++++++++------- text.cabal | 7 + 2 files changed, 105 insertions(+), 44 deletions(-) diff --git a/benchmarks/haskell/Benchmarks/FileWrite.hs b/benchmarks/haskell/Benchmarks/FileWrite.hs index c51c989b..c7922d76 100644 --- a/benchmarks/haskell/Benchmarks/FileWrite.hs +++ b/benchmarks/haskell/Benchmarks/FileWrite.hs @@ -5,7 +5,8 @@ -- * Writing a file to the disk -- -{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE CPP #-} module Benchmarks.FileWrite ( mkFileWriteBenchmarks @@ -13,66 +14,119 @@ module Benchmarks.FileWrite import Control.DeepSeq (NFData, deepseq) import Data.Bifunctor (first) +import Data.List (intercalate, intersperse) import Data.Semigroup ((<>)) import Data.String (fromString) import Data.Text (StrictText) -import Data.Text.Lazy (LazyText) +import Data.Text.Internal.Lazy (LazyText, defaultChunkSize) import System.IO (Handle, Newline(CRLF,LF), NewlineMode(NewlineMode), BufferMode(NoBuffering,LineBuffering,BlockBuffering), hSetBuffering, hSetNewlineMode) import Test.Tasty.Bench (Benchmark, bgroup, bench, nfAppIO) 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 LT -import qualified Data.Text.Lazy.IO as LT +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 writeDate = LT.cycle $ fromString [minBound..maxBound] - lengths = [0..5] <> [10,20..100] <> [1000,10000,100000] - testGroup :: NFData text => String -> (Handle -> text -> IO ()) -> ((StrictText,LazyText) -> text) -> Newline -> IO (Benchmark, IO ()) - testGroup groupName hPutStr select nl = do - let nlm = NewlineMode nl nl - (!noBufH, noBufRm) <- mkSinkNRemove - hSetBuffering noBufH NoBuffering - hSetNewlineMode noBufH nlm - (!lineBufH, lineBufRm) <- mkSinkNRemove - hSetBuffering lineBufH LineBuffering - hSetNewlineMode lineBufH nlm - (!blockBufH, blockBufRm) <- mkSinkNRemove - hSetBuffering blockBufH $ BlockBuffering Nothing - hSetNewlineMode blockBufH nlm + 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 (groupName <> " " <> show nl) $ lengths <&> \n -> let - st = LT.toStrict lt - lt = LT.take n writeDate - t = select (st, lt) - in bgroup ("length " <> show n) $ deepseq t - [ bench "NoBuffering" $ nfAppIO (hPutStr noBufH) t - , bench "LineBuffering" $ nfAppIO (hPutStr lineBufH) t - , bench "BlockBuffering" $ nfAppIO (hPutStr blockBufH) t - ] - , do - noBufRm - lineBufRm - blockBufRm + ( 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 + $ nfAppIO (hPutStr h) t + , removeFile ) - first (bgroup "FileWrite") - . foldr (\(b,r) (bs,rs) -> (b:bs,r>>rs)) ([], return ()) - <$> sequence - [ testGroup "Strict hPutStr" T.hPutStr strict LF - , testGroup "Lazy hPutStr large chunks" LT.hPutStr lazyLargeChunks LF - , testGroup "Lazy hPutStr small chunks" LT.hPutStr lazySmallChunks LF - , testGroup "Strict hPutStr" T.hPutStr strict CRLF - , testGroup "Lazy hPutStr large chunks" LT.hPutStr lazyLargeChunks CRLF - , testGroup "Lazy hPutStr small chunks" LT.hPutStr lazySmallChunks CRLF - , testGroup "Utf-8 hPutStr" Utf8.hPutStr strict LF + + 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 - strict = fst - lazyLargeChunks = snd - lazySmallChunks = LT.fromChunks . T.chunksOf 10 . fst + lazy, lazyNewlines, lazySmallChunks, lazySmallChunksNewlines :: (String, StrictText -> LazyText) + lazy = ("lazy", L.fromChunks . T.chunksOf defaultChunkSize) + lazyNewlines = ("lazy many newlines", snd lazy . snd strictNewlines) + lazySmallChunks = ("lazy small chunks", L.fromChunks . T.chunksOf 10) + lazySmallChunksNewlines = ("lazy small chunks many newlines", snd lazySmallChunks . snd strictNewlines) + + 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 + diff --git a/text.cabal b/text.cabal index ce21808c..1a871386 100644 --- a/text.cabal +++ b/text.cabal @@ -93,6 +93,11 @@ flag pure-haskell default: False manual: True +flag ExtendedBenchmarks + description: Runs extra benchmarks which can be very slow. + default: False + manual: True + library if arch(javascript) || flag(pure-haskell) cpp-options: -DPURE_HASKELL @@ -312,6 +317,8 @@ benchmark text-benchmarks ghc-options: -Wall -O2 -rtsopts "-with-rtsopts=-A32m" if impl(ghc >= 8.6) ghc-options: -fproc-alignment=64 + if flag(ExtendedBenchmarks) + cpp-options: -DExtendedBenchmarks build-depends: base, bytestring >= 0.10.4, From 1ea9f72fb8d5b018b731571c8f6a0e54e960ecf2 Mon Sep 17 00:00:00 2001 From: William Rusnack Date: Sat, 4 May 2024 16:35:49 -0400 Subject: [PATCH 8/8] whnfAppIO --- benchmarks/haskell/Benchmarks/FileWrite.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/benchmarks/haskell/Benchmarks/FileWrite.hs b/benchmarks/haskell/Benchmarks/FileWrite.hs index c7922d76..b56392fc 100644 --- a/benchmarks/haskell/Benchmarks/FileWrite.hs +++ b/benchmarks/haskell/Benchmarks/FileWrite.hs @@ -20,7 +20,7 @@ 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(NoBuffering,LineBuffering,BlockBuffering), hSetBuffering, hSetNewlineMode) -import Test.Tasty.Bench (Benchmark, bgroup, bench, nfAppIO) +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 @@ -48,7 +48,7 @@ mkFileWriteBenchmarks mkSinkNRemove = do t = select $ L.toStrict $ L.take n writeData in bench ("length " <> show n) $ deepseq t - $ nfAppIO (hPutStr h) t + $ whnfAppIO (hPutStr h) t , removeFile )