utf8-string (empty) → 0.1
raw patch · 7 files changed
+465/−0 lines, 7 filesdep +basebuild-type:Customsetup-changed
Dependencies added: base
Files
- Codec/Binary/UTF8/String.hs +78/−0
- LICENSE +24/−0
- Setup.lhs +3/−0
- System/IO/UTF8.hs +116/−0
- tests/Bench.hs +211/−0
- tests/Tests.hs +16/−0
- utf8-string.cabal +17/−0
+ Codec/Binary/UTF8/String.hs view
@@ -0,0 +1,78 @@+--+-- |+-- Module : Codec.Binary.UTF8.String+-- Copyright : (c) Eric Mertens 2007+-- License : BSD3-style (see LICENSE)+-- +-- Maintainer: emertens@galois.com+-- Stability : experimental+-- Portability : portable+--+-- Support for encoding UTF8 Strings to and from @[Word8]@+--++module Codec.Binary.UTF8.String (+ encode+ , decode+ ) where++import Data.Word (Word8)+import Data.Bits ((.|.),(.&.),shiftL,shiftR)+import Data.Char (chr,ord)++default(Int)++replacement_character :: Char+replacement_character = '\xfffd'++-- | Encode a Haskell String to a list of Word8 values, in UTF8 format.+encode :: String -> [Word8]+encode = concatMap (map fromIntegral . go . ord)+ where+ go oc+ | oc <= 0x7f = [oc]++ | oc <= 0x7ff = [ 0xc0 + (oc `shiftR` 6)+ , 0x80 + oc .&. 0x3f+ ]++ | oc <= 0xffff = [ 0xe0 + (oc `shiftR` 12)+ , 0x80 + ((oc `shiftR` 6) .&. 0x3f)+ , 0x80 + oc .&. 0x3f+ ]+ | otherwise = [ 0xf0 + (oc `shiftR` 18)+ , 0x80 + ((oc `shiftR` 12) .&. 0x3f)+ , 0x80 + ((oc `shiftR` 6) .&. 0x3f)+ , 0x80 + oc .&. 0x3f+ ]++--+-- | Decode a UTF8 string packed into a list of Word8 values, directly to String+--+decode :: [Word8] -> String+decode [ ] = ""+decode (c:cs)+ | c < 0x80 = chr (fromEnum c) : decode cs+ | c < 0xc0 = replacement_character : decode cs+ | c < 0xe0 = multi_byte 1 0x1f 0x80+ | c < 0xf0 = multi_byte 2 0xf 0x800+ | c < 0xf8 = multi_byte 3 0x7 0x10000+ | c < 0xfc = multi_byte 4 0x3 0x200000+ | c < 0xfe = multi_byte 5 0x1 0x4000000+ | otherwise = replacement_character : decode cs+ where+ multi_byte :: Int -> Word8 -> Int -> [Char]+ multi_byte i mask overlong = aux i cs (fromEnum (c .&. mask))+ where+ aux 0 rs acc+ | overlong <= acc && acc <= 0x10ffff &&+ (acc < 0xd800 || 0xdfff < acc) &&+ (acc < 0xfffe || 0xffff < acc) = chr acc : decode rs+ | otherwise = replacement_character : decode rs++ aux n (r:rs) acc+ | r .&. 0xc0 == 0x80 = aux (n-1) rs+ $ shiftL acc 6 .|. fromEnum (r .&. 0x3f)++ aux _ rs _ = replacement_character : decode rs+
+ LICENSE view
@@ -0,0 +1,24 @@+* Copyright (c) 2007, Galois Inc.+* All rights reserved.+*+* Redistribution and use in source and binary forms, with or without+* modification, are permitted provided that the following conditions are met:+* * Redistributions of source code must retain the above copyright+* notice, this list of conditions and the following disclaimer.+* * Redistributions in binary form must reproduce the above copyright+* notice, this list of conditions and the following disclaimer in the+* documentation and/or other materials provided with the distribution.+* * Neither the name of Galois Inc. nor the+* names of its contributors may be used to endorse or promote products+* derived from this software without specific prior written permission.+*+* THIS SOFTWARE IS PROVIDED BY Galois Inc. ``AS IS'' AND ANY+* EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+* WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+* DISCLAIMED. IN NO EVENT SHALL Galois Inc. BE LIABLE FOR ANY+* DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES+* (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;+* LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND+* ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+* SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.lhs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain
+ System/IO/UTF8.hs view
@@ -0,0 +1,116 @@+----------------------------------------------------------------------------- +-- | +-- Module : System.IO.UTF8 +-- Copyright : (c) Eric Mertens 2007 +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer: emertens@galois.com +-- Stability : experimental +-- Portability : portable +-- +-- String IO preserving UTF8 encoding. +-- + +module System.IO.UTF8 ( + print + , putStr + , putStrLn + , getLine + , readLn + , readFile + , writeFile + , appendFile + , getContents + , hGetLine + , hGetContents + , hPutStr + , hPutStrLn + ) where + +import Prelude (String, (=<<), (.), map, toEnum, fromEnum, Read, Show(..)) + +import System.IO (Handle, IO, FilePath) +import qualified System.IO as IO + +import Codec.Binary.UTF8.String (encode, decode) + +import Data.Char (ord, chr) +import Data.Word (Word8) + +import Control.Monad (liftM) + +-- | Encode a string in UTF8 form. +encodeString :: String -> String +encodeString xs = bytesToString (encode xs) + +-- | Decode a string from UTF8 +decodeString :: String -> String +decodeString xs = decode (stringToBytes xs) + +-- | Convert a list of bytes to a String +bytesToString :: [Word8] -> String +bytesToString xs = map (chr . fromEnum) xs + +-- | String to list of bytes. +stringToBytes :: String -> [Word8] +stringToBytes xs = map (toEnum . ord) xs + +-- | The 'print' function outputs a value of any printable type to the +-- standard output device. This function differs from the +-- System.IO.print in that it preserves any UTF8 encoding of the shown value. +-- +print :: Show a => a -> IO () +print x = putStrLn (show x) + +-- | Write a UTF8 string to the standard output device +putStr :: String -> IO () +putStr x = IO.putStr (encodeString x) + +-- | The same as 'putStr', but adds a newline character. +putStrLn :: String -> IO () +putStrLn x = IO.putStrLn (encodeString x) + +-- | Read a UTF8 line from the standard input device +getLine :: IO String +getLine = liftM decodeString IO.getLine + +-- | The 'readLn' function combines 'getLine' and 'readIO', preserving UTF8 +readLn :: Read a => IO a +readLn = IO.readIO =<< getLine + +-- | The 'readFile' function reads a file and +-- returns the contents of the file as a UTF8 string. +-- The file is read lazily, on demand, as with 'getContents'. +readFile :: FilePath -> IO String +readFile n = liftM decodeString (IO.readFile n) + +-- | The computation 'writeFile' @file str@ function writes the UTF8 string @str@, +-- to the file @file@. +writeFile :: FilePath -> String -> IO () +writeFile n c = IO.writeFile n (encodeString c) + +-- | The computation 'appendFile' @file str@ function appends the UTF8 string @str@, +-- to the file @file@. +appendFile :: FilePath -> String -> IO () +appendFile n c = IO.appendFile n (encodeString c) + +-- | Read a UTF8 line from a Handle +hGetLine :: Handle -> IO String +hGetLine h = liftM decodeString (IO.hGetLine h) + +-- | Lazily read a UTF8 string from a Handle +hGetContents :: Handle -> IO String +hGetContents h = liftM decodeString (IO.hGetContents h) + +-- | Write a UTF8 string to a Handle. +hPutStr :: Handle -> String -> IO () +hPutStr h s = IO.hPutStr h (encodeString s) + +-- | Write a UTF8 string to a Handle, appending a newline. +hPutStrLn :: Handle -> String -> IO () +hPutStrLn h s = IO.hPutStrLn h (encodeString s) + +-- | Lazily read stdin as a UTF8 string. +getContents :: IO String +getContents = liftM decodeString IO.getContents +
+ tests/Bench.hs view
@@ -0,0 +1,211 @@+{-# OPTIONS -cpp -fglasgow-exts #-}++{-+$ ghc --make -O2 Bench.hs -o bench ++$ ./bench +Size of test data: 2428k+Char Optimal byteString decode+ 1 0.102 0.109 0.102 0.109 0.102 + 0.063 0.063 0.070 0.055 0.070 # "decode" +-}++--+-- Benchmark tool.+-- Compare a function against equivalent code from other libraries for+-- space and time.+--++import Data.ByteString (ByteString)+import qualified Data.ByteString as P+-- import qualified Data.ByteString as L++import Data.List+import Data.Char+import Data.Word+import Data.Int++import System.Mem+import Control.Concurrent++import System.IO+import System.CPUTime+import System.IO.Unsafe+import Control.Monad+import Control.Exception+import Text.Printf++------------------------------------------------------------------------+-- a reference (incorrect, but fast) implementation:++import GHC.Ptr+import qualified GHC.Base as GHC+import qualified Data.ByteString as B+import qualified Data.ByteString.Base as B++import Data.ByteString (ByteString)+import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as C+import qualified Data.ByteString.Lazy as L++import Data.List+import Data.Char+import Data.Word+import Data.Int++import System.IO+import Control.Monad+import Text.Printf++import qualified Codec.Binary.UTF8.String as UTF8++------------------------------------------------------------------------++main :: IO ()+main = do+ force (fps,chars,strs)+ printf "# Size of test data: %dk\n" ((floor $ (fromIntegral (B.length fps)) / 1024) :: Int)+ printf "#Char\t Optimal byteString decode\n"+ run 5 (fps,chars,strs) tests++--+-- Measure the difference building an decoded String from+-- bytestring+GHC's inbuilt decoder, and ours.+--+-- Most cost is in building the String.+--+tests =+ [ ("decode",+ [F ( app UTF8.decode)+ ,F ( app unpackCStringUTF8) ])++ , ("encode",+ [F ( app UTF8.encode) ])+ ]+++-- unpackCStringUtf8# wants \0 termianted strings. rewrite it to take a+-- length instead, and we avoid the copy in useAsCString.+unpackCStringUTF8 :: B.ByteString -> [Char]+unpackCStringUTF8 b = unsafePerformIO $ B.unsafeUseAsCString b $ \(Ptr a) ->+ return (GHC.unpackCStringUtf8# a)+++------------------------------------------------------------------------++run c x tests = sequence_ $ zipWith (doit c x) [1..] tests++doit :: Int -> a -> Int -> (String, [F a]) -> IO ()+doit count x n (s,ls) = do+ printf "%2d " n+ fn ls+ printf "\t# %-16s\n" (show s)+ hFlush stdout+ where fn xs = case xs of+ [f,g] -> runN count f x >> putStr "\n "+ >> runN count g x >> putStr "\t"+ [f] -> runN count f x >> putStr "\t"+ _ -> return ()+ run f x = dirtyCache fps >> performGC >> threadDelay 100 >> time f x+ runN 0 f x = return ()+ runN c f x = run f x >> runN (c-1) f x++dirtyCache x = evaluate (P.foldl1' (+) x)+{-# NOINLINE dirtyCache #-}++time :: F a -> a -> IO ()+time (F f) a = do+ start <- getCPUTime+ v <- force (f a)+ case v of+ B -> printf "--\t"+ _ -> do+ end <- getCPUTime+ let diff = (fromIntegral (end - start)) / (10^12)+ printf "%0.3f " (diff :: Double)+ hFlush stdout++------------------------------------------------------------------------+-- +-- an existential list+--+data F a = forall b . Forceable b => F (a -> b)++data Result = T | B++--+-- a bit deepSeqish+--+class Forceable a where+ force :: a -> IO Result+ force v = v `seq` return T++#if !defined(HEAD)+instance Forceable P.ByteString where+ force v = P.length v `seq` return T+#endif++instance Forceable L.ByteString where+ force v = L.length v `seq` return T++-- instance Forceable SPS.PackedString where+-- force v = SPS.length v `seq` return T++-- instance Forceable PS.PackedString where+-- force v = PS.lengthPS v `seq` return T++instance Forceable a => Forceable (Maybe a) where+ force Nothing = return T+ force (Just v) = force v `seq` return T++instance Forceable [a] where+ force v = length v `seq` return T++instance (Forceable a, Forceable b) => Forceable (a,b) where+ force (a,b) = force a >> force b++instance (Forceable a, Forceable b, Forceable c) => Forceable (a,b,c) where+ force (a,b,c) = force a >> force b >> force c++instance Forceable Int+instance Forceable Int64+instance Forceable Bool+instance Forceable Char+instance Forceable Word8+instance Forceable Ordering++-- used to signal undefinedness+instance Forceable () where force () = return B++------------------------------------------------------------------------+--+-- some large strings to play with+--++fps :: P.ByteString+fps = unsafePerformIO $ P.readFile dict+{-# NOINLINE fps #-}++chars :: [Word8]+chars = B.unpack fps+{-# NOINLINE chars #-}++strs :: String+strs = C.unpack fps+{-# NOINLINE strs #-}++dict = "/usr/share/dict/words"++------------------------------------------------------------------------++type Input = (B.ByteString,[Word8],String)++class (Eq a, Ord a) => Ap a where app :: (a -> b) -> Input -> b++instance Ap B.ByteString where app f x = f (fst3 x)+instance Ap [Word8] where app f x = f (snd3 x)+instance Ap String where app f x = f (thd3 x)++fst3 (a,_,_) = a+snd3 (_,a,_) = a+thd3 (_,_,a) = a
+ tests/Tests.hs view
@@ -0,0 +1,16 @@+import Codec.Binary.UTF8.String++main = let v = encodeDecodeTest+ in putStrLn $ case v of+ [] -> "Ok. All passed."+ s -> "Encode/decode failures: " ++ show s++--+-- test decode . encode == id for the class of chars we know that to be true of+--+encodeDecodeTest :: [Char]+encodeDecodeTest = filter (\x -> [x] /= decode (encode [x])) legal_codepoints +++ filter (\x -> ['\xfffd'] /= decode (encode [x])) illegal_codepoints+ where+ legal_codepoints = ['\0'..'\xd7ff'] ++ ['\xe000'..'\xfffd'] ++ ['\x10000'..'\x10ffff']+ illegal_codepoints = '\xffff' : '\xfffe' : ['\xd800'..'\xdfff']
+ utf8-string.cabal view
@@ -0,0 +1,17 @@+Name: utf8-string+Version: 0.1+Author: Eric Mertens+Maintainer: emertens@galois.com+License: BSD3+License-file: LICENSE+Homepage: http://code.haskell.org/utf8-string/+Synopsis: Support for reading and writing UTF8 Strings+Description: A UTF8 layer for IO and Strings. The utf8-string+ package provides operations for encoding UTF8+ strings to Word8 lists and back, and for reading and+ writing UTF8 without truncation.+Category: Codec+Build-depends: base>=1.0+Ghc-options: -Wall -Werror -O2+Exposed-modules: Codec.Binary.UTF8.String+ System.IO.UTF8