utf8-string 0.3.1 → 0.3.1.1
raw patch · 5 files changed
+21/−459 lines, 5 filesdep ~base
Dependency ranges changed: base
Files
- System/IO/UTF8.hs +2/−2
- tests/Bench.hs +0/−211
- tests/BenchBytestring.hs +0/−55
- tests/Tests.hs +0/−182
- utf8-string.cabal +19/−9
System/IO/UTF8.hs view
@@ -88,13 +88,13 @@ -- to the file @file@. writeFile :: FilePath -> String -> IO () writeFile n c = IO.withBinaryFile n IO.WriteMode $ \ h ->- hPutStr h $ encodeString c+ IO.hPutStr h $ 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.withBinaryFile n IO.AppendMode $ \h ->- hPutStr h $ encodeString c+ IO.hPutStr h $ encodeString c -- | Read a UTF8 line from a Handle hGetLine :: Handle -> IO String
− tests/Bench.hs
@@ -1,211 +0,0 @@-{-# 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/BenchBytestring.hs
@@ -1,55 +0,0 @@-import qualified Data.ByteString as S-import qualified Data.ByteString.Lazy as L-import qualified Data.String.UTF8 as UTF8-import qualified Codec.Binary.UTF8.String as List--import System.Environment(getArgs)-import System.IO-import Data.Word--main = mapM_ run_test =<< getArgs--run_test x = case reads x of- [(n,"")] | n < test_num -> tests !! n- _ -> hPutStrLn stderr ("Invalid test: " ++ x)--tests = [ main0, main1, main2, main3, main4 ]-test_num = length tests---main0 = do putStrLn "Correctness: Data.ByteString"- putStrLn ("Errors: " ++ show encodeDecodeTest)--main1 = do putStrLn "Speed: Data.ByteString"- txt <- S.readFile "test"- print (UTF8.length $ UTF8.fromRep txt)--main2 = do putStrLn "Speed: Data.ByteString.Lazy"- txt <- L.readFile "test"- print (UTF8.length $ UTF8.fromRep txt)--main3 = do putStrLn "Speed: [Word8]"- txt <- hGetContents =<< openBinaryFile "test" ReadMode- let bytes :: [Word8]- bytes = map (fromIntegral . fromEnum) txt- print (UTF8.length $ UTF8.fromRep bytes)--main4 = do putStrLn "Speed: [Word8] (direct)"- txt <- hGetContents =<< openBinaryFile "test" ReadMode- let bytes :: [Word8]- bytes = map (fromIntegral . fromEnum) txt- print (length $ List.decode bytes)--encodeDecodeTest :: String-encodeDecodeTest =- filter (\x -> enc x /= [x]) legal_codepoints- ++ filter (\x -> enc x /= [UTF8.replacement_char]) illegal_codepoints- where- legal_codepoints = ['\0'..'\xd7ff'] ++ ['\xe000'..'\xfffd']- ++ ['\x10000'..'\x10ffff']- illegal_codepoints = '\xffff' : '\xfffe' : ['\xd800'..'\xdfff']--{-# INLINE enc #-}-enc x = UTF8.toString (UTF8.fromString [x] :: UTF8.UTF8 S.ByteString)--
− tests/Tests.hs
@@ -1,182 +0,0 @@-import Codec.Binary.UTF8.String-import Test.HUnit-import System.Exit (exitFailure)-import Control.Monad (when)--main = do counts <- runTestTT tests- when (errors counts > 0 || failures counts > 0) exitFailure--tests = TestList [test_1, test_2, test_3, test_4, test_5]--test_1 = TestLabel "1 Some correct UTF-8 text" $- TestCase $ assertEqual "kosme, " "\x03ba\x1f79\x03c3\x03bc\x03b5 "- (decode [0xce,0xba,0xe1,0xbd,0xb9,0xcf,0x83,0xce,0xbc,0xce,0xb5,0x20])--test_2 = TestLabel "2 Boundary condition test cases" $- TestList [test_2_1, test_2_2, test_2_3]--test_2_1 = TestLabel "2.1 First possible sequence of a certain length" $- TestList $ map TestCase $ - [ assertEqual "2.1.1, " "\0\0" (decode [0, 0])- , assertEqual "2.1.2, " "\x80\0" (decode [0xc2, 0x80, 0])- , assertEqual "2.1.3, " "\x800\0" (decode [0xe0, 0xa0, 0x80, 0])- , assertEqual "2.1.4, " "\x10000\0" (decode [0xf0, 0x90, 0x80, 0x80, 0])- , assertEqual "2.1.5, " "\xfffd\0" (decode [0xf8, 0x88, 0x80, 0x80, 0x80, 0])- , assertEqual "2.1.6, " "\xfffd\0" (decode [0xfc,0x84,0x80,0x80,0x80,0x80,0])- ]--test_2_2 = TestLabel "2.2 Last possible sequence of a certain length" $- TestList $ map TestCase $ - [ assertEqual "2.2.1, " "\x7f\0" (decode [0x7f, 0])- , assertEqual "2.2.2, " "\x7ff\0" (decode [0xdf, 0xbf, 0])- , assertEqual "2.2.3, " "\xfffd\0" (decode [0xef, 0xbf, 0xbf, 0])- , assertEqual "2.2.4, " "\xfffd\0" (decode [0xf7, 0xbf, 0xbf, 0xbf, 0])- , assertEqual "2.2.5, " "\xfffd\0" (decode [0xfb, 0xbf, 0xbf, 0xbf, 0xbf, 0])- , assertEqual "2.2.6, " "\xfffd\0" (decode [0xfd,0xbf,0xbf,0xbf,0xbf,0xbf,0])- ]--test_2_3 = TestLabel "2.3 Other boundary conditions" $- TestList $ map TestCase $ - [ assertEqual "2.3.1, " "\xd7ff\0" (decode [0xed, 0x9f, 0xbf, 0])- , assertEqual "2.3.2, " "\xe000\0" (decode [0xee, 0x80, 0x80, 0])- , assertEqual "2.3.3, " "\xfffd\0" (decode [0xef, 0xbf, 0xbd, 0])- , assertEqual "2.3.4, " "\x10ffff\0" (decode [0xf4, 0x8f, 0xbf, 0xbf, 0])- , assertEqual "2.3.5, " "\xfffd\0" (decode [0xf4, 0x90, 0x80, 0x80, 0])- ]--test_3 = TestLabel "3 Malformed sequences" $- TestList [test_3_1, test_3_2, test_3_3, test_3_4, test_3_5]--test_3_1 = TestLabel "3.1 Unexpected continuation bytes" $- TestList $ map TestCase $- [ assertEqual "3.1.1, " "\xfffd\0" (decode [0x80, 0])- , assertEqual "3.1.2, " "\xfffd\0" (decode [0xbf, 0])- , assertEqual "3.1.3, " "\xfffd\xfffd\0" (decode [0x80, 0xbf, 0])- , assertEqual "3.1.4, " "\xfffd\xfffd\xfffd\0" (decode [0x80, 0xbf, 0x80, 0])- , assertEqual "3.1.5, " "\xfffd\xfffd\xfffd\xfffd\0"- (decode [0x80, 0xbf, 0x80, 0xbf, 0])- , assertEqual "3.1.6, " "\xfffd\xfffd\xfffd\xfffd\xfffd\0"- (decode [0x80, 0xbf, 0x80, 0xbf, 0x80, 0])- , assertEqual "3.1.7, " "\xfffd\xfffd\xfffd\xfffd\xfffd\xfffd\0"- (decode [0x80, 0xbf, 0x80, 0xbf, 0x80, 0xbf, 0])- , assertEqual "3.1.8, " "\xfffd\xfffd\xfffd\xfffd\xfffd\xfffd\xfffd\0"- (decode [0x80, 0xbf, 0x80, 0xbf, 0x80, 0xbf, 0x80, 0])- , assertEqual "3.1.9, " (replicate 64 '\xfffd') (decode [0x80..0xbf])- ]--test_3_2 = TestLabel "3.2 Lonely start characters" $- TestList $ map TestCase $- [ assertEqual "3.2.1, " (concat (replicate 32 "\xfffd "))- (decode (concat [[x,0x20] | x <- [0xc0..0xdf]]))- , assertEqual "3.2.2, " (concat (replicate 16 "\xfffd "))- (decode (concat [[x,0x20] | x <- [0xe0..0xef]]))- , assertEqual "3.2.3, " (concat (replicate 8 "\xfffd "))- (decode (concat [[x,0x20] | x <- [0xf0..0xf7]]))- , assertEqual "3.2.4, " "\xfffd \xfffd \xfffd \xfffd "- (decode (concat [[x,0x20] | x <- [0xf8..0xfb]]))- , assertEqual "3.2.5, " "\xfffd \xfffd " (decode [0xfc, 0x20, 0xfd, 0x20])- ]--test_3_3 = TestLabel "3.3 Sequences with last continuation byte missing" $- TestList $ map TestCase $- [ assertEqual "3.3.1, " "\xfffd " (decode [0xc0, 0x20])- , assertEqual "3.3.2, " "\xfffd " (decode [0xe0, 0x80, 0x20])- , assertEqual "3.3.3, " "\xfffd " (decode [0xf0, 0x80, 0x80, 0x20])- , assertEqual "3.3.4, " "\xfffd " (decode [0xf8, 0x80, 0x80, 0x80, 0x20])- , assertEqual "3.3.5, " "\xfffd " (decode [0xfc, 0x80, 0x80, 0x80,0x80,0x20])- , assertEqual "3.3.6, " "\xfffd " (decode [0xdf, 0x20])- , assertEqual "3.3.7, " "\xfffd " (decode [0xef, 0xbf, 0x20])- , assertEqual "3.3.8, " "\xfffd " (decode [0xf7, 0xbf, 0xbf, 0x20])- , assertEqual "3.3.9, " "\xfffd " (decode [0xfb, 0xbf, 0xbf, 0xbf, 0x20])- , assertEqual "3.3.10, " "\xfffd " (decode [0xfd, 0xbf, 0xbf, 0xbf,0xbf,0x20])- ]--test_3_4 = TestLabel "3.4 Concatenation of incomplete sequences" $- TestCase $ assertEqual "3.4, " - (replicate 10 '\xfffd')- (decode [0xc0, 0xe0, 0x80, 0xf0, 0x80, 0x80, 0xf8, 0x80, 0x80, 0x80,- 0xfc, 0x80, 0x80, 0x80,0x80, 0xdf, 0xef, 0xbf, 0xf7, 0xbf, 0xbf,- 0xfb, 0xbf, 0xbf, 0xbf, 0xfd, 0xbf, 0xbf, 0xbf,0xbf])--test_3_5 = TestLabel "3.5 Impossible bytes" $- TestList $ map TestCase $- [ assertEqual "3.5.1, " "\xfffd " (decode [0xfe, 0x20])- , assertEqual "3.5.2, " "\xfffd " (decode [0xff, 0x20])- , assertEqual "3.5.3, " "\xfffd\xfffd\xfffd\xfffd "- (decode [0xfe, 0xfe, 0xff, 0xff, 0x20])- ]--test_4 = TestLabel "4 Overlong sequences" $- TestList [test_4_1, test_4_2, test_4_3]--test_4_1 = TestLabel "4.1" $ TestList $ map TestCase $- [ assertEqual "4.1.1, " "\xfffd " (decode [0xc0, 0xaf, 0x20])- , assertEqual "4.1.2, " "\xfffd " (decode [0xe0, 0x80, 0xaf, 0x20])- , assertEqual "4.1.3, " "\xfffd " (decode [0xf0, 0x80, 0x80, 0xaf, 0x20])- , assertEqual "4.1.4, " "\xfffd " (decode [0xf8, 0x80, 0x80,0x80,0xaf, 0x20])- , assertEqual "4.1.5, " "\xfffd " (decode[0xfc,0x80,0x80,0x80,0x80,0xaf,0x20])- ]--test_4_2 = TestLabel "4.2 Maximum overlong sequences" $- TestList $ map TestCase $- [ assertEqual "4.2.1, " "\xfffd " (decode [0xc1, 0xbf, 0x20])- , assertEqual "4.2.2, " "\xfffd " (decode [0xe0, 0x9f, 0xbf, 0x20])- , assertEqual "4.2.3, " "\xfffd " (decode [0xf0, 0x8f, 0xbf, 0xbf, 0x20])- , assertEqual "4.2.4, " "\xfffd " (decode [0xf8, 0x87, 0xbf, 0xbf,0xbf,0x20])- , assertEqual "4.2.5, " "\xfffd "(decode[0xfc,0x83,0xbf,0xbf,0xbf,0xbf,0x20])- ]--test_4_3 = TestLabel "4.2 Overlong NUL" $- TestList $ map TestCase $- [ assertEqual "4.3.1, " "\xfffd " (decode [0xc0, 0x80, 0x20])- , assertEqual "4.3.2, " "\xfffd " (decode [0xe0, 0x80, 0x80, 0x20])- , assertEqual "4.3.3, " "\xfffd " (decode [0xf0, 0x80, 0x80, 0x80, 0x20])- , assertEqual "4.3.4, " "\xfffd " (decode [0xf8, 0x80, 0x80, 0x80,0x80,0x20])- , assertEqual "4.3.5, " "\xfffd "(decode[0xfc,0x80,0x80,0x80,0x80,0x80,0x20])- ]--test_5 = TestLabel "Illegal code positions" $- TestList [test_5_1, test_5_2, test_5_3]--test_5_1 = TestLabel "5.1 Single UTF-16 surrogates" $- TestList $ map TestCase $- [ assertEqual "5.1.1, " "\xfffd " (decode [0xed,0xa0,0x80,0x20])- , assertEqual "5.1.2, " "\xfffd " (decode [0xed,0xad,0xbf,0x20])- , assertEqual "5.1.3, " "\xfffd " (decode [0xed,0xae,0x80,0x20])- , assertEqual "5.1.4, " "\xfffd " (decode [0xed,0xaf,0xbf,0x20])- , assertEqual "5.1.5, " "\xfffd " (decode [0xed,0xb0,0x80,0x20])- , assertEqual "5.1.6, " "\xfffd " (decode [0xed,0xbe,0x80,0x20])- , assertEqual "5.1.7, " "\xfffd " (decode [0xed,0xbf,0xbf,0x20])- ]- -test_5_2 = TestLabel "5.2 Paired UTF-16 surrogates" $- TestList $ map TestCase $- [ assertEqual "5.2.1, " res (decode [0xed,0xa0,0x80,0xed,0xb0,0x80,0x20])- , assertEqual "5.2.2, " res (decode [0xed,0xa0,0x80,0xed,0xbf,0xbf,0x20])- , assertEqual "5.2.3, " res (decode [0xed,0xad,0xbf,0xed,0xb0,0x80,0x20])- , assertEqual "5.2.4, " res (decode [0xed,0xad,0xbf,0xed,0xbf,0xbf,0x20])- , assertEqual "5.2.5, " res (decode [0xed,0xae,0x80,0xed,0xb0,0x80,0x20])- , assertEqual "5.2.6, " res (decode [0xed,0xae,0x80,0xed,0xbf,0xbf,0x20])- , assertEqual "5.2.7, " res (decode [0xed,0xaf,0xbf,0xed,0xb0,0x80,0x20])- , assertEqual "5.2.8, " res (decode [0xed,0xaf,0xbf,0xed,0xbf,0xbf,0x20])- ]- where res = "\xfffd\xfffd "- -test_5_3 = TestLabel "5.3 Other illegal code positions" $- TestList $ map TestCase $- [ assertEqual "5.3.1, " "\xfffd " (decode [0xef, 0xbf, 0xbe, 0x20])- , assertEqual "5.3.2, " "\xfffd " (decode [0xef, 0xbf, 0xbf, 0x20])- ]-------- 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
@@ -1,5 +1,5 @@ Name: utf8-string-Version: 0.3.1+Version: 0.3.1.1 Author: Eric Mertens Maintainer: emertens@galois.com License: BSD3@@ -11,12 +11,22 @@ strings to Word8 lists and back, and for reading and writing UTF8 without truncation. Category: Codec-Build-depends: base>=1.0, bytestring>=0.9-Ghc-options: -W -O2 Build-type: Simple-Exposed-modules: Codec.Binary.UTF8.String- Codec.Binary.UTF8.Generic- System.IO.UTF8- Data.String.UTF8- Data.ByteString.UTF8- Data.ByteString.Lazy.UTF8+cabal-version: >= 1.2++flag bytestring-in-base++library+ Ghc-options: -W -O2++ if flag(bytestring-in-base)+ build-depends: base >= 2.0 && < 2.2+ else+ build-depends: base < 2.0 || >= 3, bytestring >= 0.9++ Exposed-modules: Codec.Binary.UTF8.String+ Codec.Binary.UTF8.Generic+ System.IO.UTF8+ Data.String.UTF8+ Data.ByteString.UTF8+ Data.ByteString.Lazy.UTF8