Added file write benchmarks

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

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
+    )
+

text.cabal

@@ -332,6 +332,7 @@ benchmark text-benchmarks
     Benchmarks.EncodeUtf8
     Benchmarks.Equality
     Benchmarks.FileRead
+    Benchmarks.FileWrite
     Benchmarks.FoldLines
     Benchmarks.Micro
     Benchmarks.Multilang