Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

103 lines (82 sloc) 3.803 kb
{-# 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
Jump to Line
Something went wrong with that request. Please try again.