{-# LANGUAGE OverloadedStrings #-} -- | -- Copyright : (c) 2011 Simon Meier -- License : BSD3-style (see LICENSE) -- -- Maintainer : Simon Meier <iridcode@gmail.com> -- Stability : experimental -- Portability : tested on GHC only -- -- Benchmarking IO output speed of writing a string in Utf8 encoding to a file. module Utf8IO (main) where import Control.Monad import Control.Exception (evaluate) import qualified Codec.Binary.UTF8.Light as Utf8Light import Data.Char (chr) import Data.Time.Clock import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy.UTF8 as Utf8String import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Encoding as TL import System.IO import System.Environment import Blaze.ByteString.Builder import Blaze.ByteString.Builder.Internal (defaultBufferSize) import qualified Blaze.ByteString.Builder.Char.Utf8 as Blaze -- | Write using the standard text utf8 encoding function built into 'base'. writeUtf8_base :: String -> FilePath -> IO () writeUtf8_base cs file = withFile file WriteMode $ \h -> do hSetEncoding h utf8 hPutStr h cs -- | Write using utf8 encoding as provided by the 'blaze-builder' library. writeUtf8_blaze :: String -> FilePath -> IO () writeUtf8_blaze cs file = L.writeFile file $ toLazyByteString $ Blaze.fromString cs -- | Write using utf8 encoding as provided by the 'text' library. writeUtf8_text :: TL.Text -> FilePath -> IO () writeUtf8_text tx file = L.writeFile file $ TL.encodeUtf8 tx -- | Write using utf8 encoding as provided by the 'utf8-string' library. writeUtf8_string :: String -> FilePath -> IO () writeUtf8_string cs file = L.writeFile file $ Utf8String.fromString cs -- | Write using utf8 encoding as provided by the 'utf8-light' library. Note -- that this library only allows encoding the whole string as a strict -- bytestring. That might make it unusable in some circumstances. {-# NOINLINE writeUtf8_light #-} writeUtf8_light :: String -> FilePath -> IO () writeUtf8_light cs file = Utf8Light.writeUTF8File file cs main :: IO () main = do [how, len, file] <- getArgs let blocksize = 32000 block = map chr [0..blocksize] n = read len cs = take n $ cycle $ block tx = TL.pack cs writer <- case how of "base" -> return $ writeUtf8_base cs "blaze" -> return $ writeUtf8_blaze cs "utf8-string" -> return $ writeUtf8_string cs -- utf8-light is missing support for lazy bytestrings => test 100 times -- writing a 100 times smaller string to avoid out-of-memory errors. "utf8-light" -> return $ \f -> sequence_ $ replicate 100 $ writeUtf8_light (take (n `div` 100) cs) f "via-text" -> do return $ writeUtf8_text tx -- Here, we ensure that the text tx is already packed before timing. "text" -> do _ <- evaluate (TL.length tx) return $ writeUtf8_text tx _ -> error $ "unknown writer '" ++ how ++ "'" t <- timed_ $ writer file putStrLn $ how ++ ": " ++ show t ------------------------------------------------------------------------------ -- Timing ------------------------------------------------------------------------------ -- | Execute an IO action and return its result plus the time it took to execute it. timed :: IO a -> IO (a, NominalDiffTime) timed io = do t0 <- getCurrentTime x <- io t1 <- getCurrentTime return (x, diffUTCTime t1 t0) -- | Execute an IO action and return the time it took to execute it. timed_ :: IO a -> IO NominalDiffTime timed_ = (snd `liftM`) . timed