From c82fe103c29f907d36762fce930e10f4a3474b14 Mon Sep 17 00:00:00 2001
From: William Rusnack <williamrusnack@gmail.com>
Date: Tue, 23 Apr 2024 10:23:14 -0400
Subject: [PATCH] Added file write benchmarks

---
 benchmarks/haskell/Benchmarks.hs           | 15 ++++++++++
 benchmarks/haskell/Benchmarks/FileWrite.hs | 33 ++++++++++++++++++++++
 text.cabal                                 |  1 +
 3 files changed, 49 insertions(+)
 create mode 100644 benchmarks/haskell/Benchmarks/FileWrite.hs

diff --git a/benchmarks/haskell/Benchmarks.hs b/benchmarks/haskell/Benchmarks.hs
index 33e6a025..8c398c8a 100644
--- a/benchmarks/haskell/Benchmarks.hs
+++ b/benchmarks/haskell/Benchmarks.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE NumericUnderscores #-}
 
 module Main
     ( main
@@ -8,6 +9,8 @@ module Main
 import Test.Tasty.Bench (defaultMain, bgroup, env)
 import System.FilePath ((</>))
 import System.IO
+import qualified Data.Text.Lazy as LT
+import Data.String (fromString)
 
 #ifdef mingw32_HOST_OS
 import System.Directory (removeFile)
@@ -19,6 +22,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 +63,13 @@ main = do
     let tf = ("benchmarks/text-test-data" </>)
     -- Cannot use envWithCleanup, because there is no instance NFData Handle
     (sinkFn, sink) <- mkSink
+    (noBufFP, noBufH) <- mkSink
+    hSetBuffering noBufH NoBuffering
+    (lineBufFP, lineBufH) <- mkSink
+    hSetBuffering lineBufH LineBuffering
+    (blockBufFP, blockBufH) <- mkSink
+    hSetBuffering blockBufH $ BlockBuffering Nothing
+    let writeData = LT.take 500_000 $ LT.cycle $ fromString [minBound..maxBound]
     defaultMain
         [ Builder.benchmark
         , Concat.benchmark
@@ -77,6 +88,7 @@ main = do
             ]
         , env (Equality.initEnv (tf "japanese.txt")) Equality.benchmark
         , FileRead.benchmark (tf "russian.txt")
+        , FileWrite.benchmark (LT.toStrict writeData) writeData noBufH lineBufH blockBufH
         , FoldLines.benchmark (tf "russian.txt")
         , Multilang.benchmark
         , bgroup "Pure"
@@ -102,3 +114,6 @@ main = do
             ]
         ]
     rmSink sinkFn
+    rmSink noBufFP
+    rmSink lineBufFP
+    rmSink blockBufFP
diff --git a/benchmarks/haskell/Benchmarks/FileWrite.hs b/benchmarks/haskell/Benchmarks/FileWrite.hs
new file mode 100644
index 00000000..a152bc45
--- /dev/null
+++ b/benchmarks/haskell/Benchmarks/FileWrite.hs
@@ -0,0 +1,33 @@
+-- | Benchmarks simple file writing
+--
+-- Tested in this benchmark:
+--
+-- * Writing a file to the disk
+--
+
+{-# LANGUAGE BangPatterns #-}
+
+module Benchmarks.FileWrite
+    ( benchmark
+    ) where
+
+import Test.Tasty.Bench (Benchmark, bgroup, bench, nfIO)
+import Data.Text (StrictText)
+import qualified Data.Text.IO as T
+import Data.Text.Lazy (LazyText)
+import qualified Data.Text.Lazy.IO as LT
+import System.IO (Handle)
+
+benchmark :: StrictText -> LazyText -> Handle -> Handle -> Handle -> Benchmark
+benchmark !st !lt !noBufH !lineBufH !blockBufH = bgroup "FileWrite"
+  [ bgroup "StrictText"
+    [ bench "NoBuffering" $ nfIO $ T.hPutStr noBufH st
+    , bench "LineBuffering" $ nfIO $ T.hPutStr lineBufH st
+    , bench "BlockBuffering" $ nfIO $ T.hPutStr blockBufH st
+    ]
+  , bgroup "LazyText"
+    [ bench "NoBuffering" $ nfIO $ LT.hPutStr noBufH lt
+    , bench "LineBuffering" $ nfIO $ LT.hPutStr lineBufH lt
+    , bench "BlockBuffering" $ nfIO $ LT.hPutStr blockBufH lt
+    ]
+  ]
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