Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
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.