utf8-string 0.3.7 → 1.0.2
raw patch · 10 files changed
Files
- CHANGELOG.markdown +22/−0
- Codec/Binary/UTF8/Generic.hs +12/−9
- Codec/Binary/UTF8/String.hs +20/−16
- Data/ByteString/Lazy/UTF8.hs +101/−14
- Data/ByteString/UTF8.hs +17/−8
- Data/String/UTF8.hs +16/−9
- System/Environment/UTF8.hs +0/−37
- System/IO/UTF8.hs +0/−126
- tests/Tests.hs +208/−0
- utf8-string.cabal +20/−13
+ CHANGELOG.markdown view
@@ -0,0 +1,22 @@+1.0.2+-----+* Add fromChar+* Add IsString UTF8 instance+* Fixup documentation and tests++1.0.1.1+-----+* Build correctly on GHC-7.0 (#14)++1.0.1+-----+* Improve the performance of Data.ByteString.Lazy.UTF8.fromString. (Thanks, ndmitchell)++1+-----+* Remove out all the old utf8 IO support. GHC supports utf8 now.++0.3.8+-----+* Performance tweaks+* bytestring-in-base flag default to False
Codec/Binary/UTF8/Generic.hs view
@@ -1,4 +1,7 @@-{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}+{-# LANGUAGE CPP, MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}+#if __GLASGOW_HASKELL__ >= 701+{-# LANGUAGE Trustworthy #-}+#endif -- -- | -- Module : Codec.Binary.UTF8.Generic@@ -91,7 +94,7 @@ fromString xs = pack (encode xs) -- | Convert a UTF8 encoded bytestring into a Haskell string.--- Invalid characters are replaced with '\xFFFD'.+-- Invalid characters are replaced with @\'\\0xFFFD\'@. {-# SPECIALIZE toString :: B.ByteString -> String #-} {-# SPECIALIZE toString :: L.ByteString -> String #-} {-# SPECIALIZE toString :: [Word8] -> String #-}@@ -106,7 +109,7 @@ -- Returns 'Nothing' if there are no more bytes in the byte string. -- Otherwise, it returns a decoded character and the number of -- bytes used in its representation.--- Errors are replaced by character '\0xFFFD'.+-- Errors are replaced by character @\'\\0xFFFD\'@. -- XXX: Should we combine sequences of errors into a single replacement -- character?@@ -192,7 +195,7 @@ -- | Split a string into two parts: the first is the longest prefix -- that contains only characters that satisfy the predicate; the second -- part is the rest of the string.--- Invalid characters are passed as '\0xFFFD' to the predicate.+-- Invalid characters are passed as @\'\\0xFFFD\'@ to the predicate. {-# SPECIALIZE span :: (Char -> Bool) -> B.ByteString -> (B.ByteString,B.ByteString) #-} {-# SPECIALIZE span :: (Char -> Bool) -> L.ByteString -> (L.ByteString,L.ByteString) #-} {-# SPECIALIZE span :: (Char -> Bool) -> [Word8] -> ([Word8],[Word8]) #-}@@ -205,13 +208,13 @@ -- | Split a string into two parts: the first is the longest prefix -- that contains only characters that do not satisfy the predicate; the second -- part is the rest of the string.--- Invalid characters are passed as '\0xFFFD' to the predicate.+-- Invalid characters are passed as @\'\\0xFFFD\'@ to the predicate. {-# INLINE break #-} break :: UTF8Bytes b s => (Char -> Bool) -> b -> (b,b) break p bs = span (not . p) bs -- | Get the first character of a byte string, if any.--- Malformed characters are replaced by '\0xFFFD'.+-- Malformed characters are replaced by @\'\\0xFFFD\'@. {-# INLINE uncons #-} uncons :: UTF8Bytes b s => b -> Maybe (Char,b) uncons bs = do (c,n) <- decode bs@@ -249,9 +252,9 @@ Nothing -> n -- | Split a string into a list of lines.--- Lines are terminated by '\n' or the end of the string.+-- Lines are terminated by @\'\\n\'@ or the end of the string. -- Empty lines may not be terminated by the end of the string.--- See also 'lines\''.+-- See also 'lines''. {-# SPECIALIZE lines :: B.ByteString -> [B.ByteString] #-} {-# SPECIALIZE lines :: L.ByteString -> [L.ByteString] #-} {-# SPECIALIZE lines :: [Word8] -> [[Word8]] #-}@@ -263,7 +266,7 @@ Nothing -> [bs] -- | Split a string into a list of lines.--- Lines are terminated by '\n' or the end of the string.+-- Lines are terminated by @\'\\n\'@ or the end of the string. -- Empty lines may not be terminated by the end of the string. -- This function preserves the terminators. -- See also 'lines'.
Codec/Binary/UTF8/String.hs view
@@ -1,14 +1,18 @@+{-# LANGUAGE CPP #-}+#if __GLASGOW_HASKELL__ >= 701+{-# LANGUAGE Trustworthy #-}+#endif -- -- | -- 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]@+-- Support for encoding UTF8 Strings to and from @['Word8']@ -- module Codec.Binary.UTF8.String (@@ -17,7 +21,7 @@ , encodeString , decodeString , encodeChar- + , isUTF8Encoded , utf8Encode ) where@@ -33,15 +37,15 @@ encodeString xs = map (toEnum . fromEnum) (encode xs) -- | Decode a string using 'decode' using a 'String' as input.--- | This is not safe but it is necessary if UTF-8 encoded text--- | has been loaded into a 'String' prior to being decoded.+-- This is not safe but it is necessary if UTF-8 encoded text+-- has been loaded into a 'String' prior to being decoded. decodeString :: String -> String decodeString xs = decode (map (toEnum . fromEnum) xs) replacement_character :: Char replacement_character = '\xfffd' --- | Encode a single Haskell Char to a list of Word8 values, in UTF8 format.+-- | Encode a single Haskell 'Char' to a list of 'Word8' values, in UTF8 format. encodeChar :: Char -> [Word8] encodeChar = map fromIntegral . go . ord where@@ -63,12 +67,12 @@ ] --- | Encode a Haskell String to a list of Word8 values, in UTF8 format.+-- | Encode a Haskell 'String' to a list of 'Word8' values, in UTF8 format. encode :: String -> [Word8] encode = concatMap encodeChar ----- | Decode a UTF8 string packed into a list of Word8 values, directly to String+-- | Decode a UTF8 string packed into a list of 'Word8' values, directly to 'String' -- decode :: [Word8] -> String decode [ ] = ""@@ -118,7 +122,7 @@ -- | @isUTF8Encoded str@ tries to recognize input string as being in UTF-8 form. isUTF8Encoded :: String -> Bool isUTF8Encoded [] = True-isUTF8Encoded (x:xs) = +isUTF8Encoded (x:xs) = case ox of _ | ox < 0x80 -> isUTF8Encoded xs | ox > 0xff -> False@@ -131,14 +135,14 @@ | otherwise -> False where ox = toW32 x- + toW32 :: Char -> Word32 toW32 ch = fromIntegral (fromEnum ch) - check1 = + check1 = case xs of [] -> False- c1 : ds + c1 : ds | oc .&. 0xc0 /= 0x80 || d < 0x000080 -> False | otherwise -> isUTF8Encoded ds where@@ -149,15 +153,15 @@ check_byte i mask overlong = aux i xs (ox .&. mask) where aux 0 rs acc- | overlong <= acc && - acc <= 0x10ffff &&+ | overlong <= acc &&+ acc <= 0x10ffff && (acc < 0xd800 || 0xdfff < acc) && (acc < 0xfffe || 0xffff < acc) = isUTF8Encoded rs | otherwise = False aux n (r:rs) acc- | toW32 r .&. 0xc0 == 0x80 = - aux (n-1) rs (acc `shiftL` 6 .|. (toW32 r .&. 0x3f))+ | toW32 r .&. 0xc0 == 0x80 =+ aux (n-1) rs (acc `shiftL` 6 .|. (toW32 r .&. 0x3f)) aux _ _ _ = False
Data/ByteString/Lazy/UTF8.hs view
@@ -1,3 +1,7 @@+{-# LANGUAGE CPP, BangPatterns #-}+#if __GLASGOW_HASKELL__ >= 701+{-# LANGUAGE Trustworthy #-}+#endif -- -- | -- Module : Data.ByteString.Lazy.UTF8@@ -34,18 +38,70 @@ import Data.Bits import Data.Word import Data.Int+import Foreign.Storable+import Foreign.Ptr+import Foreign.ForeignPtr+import Data.Char (ord)+import Control.Exception (assert) import qualified Data.ByteString.Lazy as B+import qualified Data.ByteString.Lazy.Internal as B+import qualified Data.ByteString.Internal as S import Prelude hiding (take,drop,splitAt,span,break,foldr,foldl,length,lines) -import Codec.Binary.UTF8.String(encode) import Codec.Binary.UTF8.Generic (buncons) +#if MIN_VERSION_base(4,4,0)+import System.IO.Unsafe (unsafeDupablePerformIO)+#else+import GHC.IO (unsafeDupablePerformIO)+#endif++---------------------------------------------------------------------+-- ENCODING+ -- | Converts a Haskell string into a UTF8 encoded bytestring. fromString :: String -> B.ByteString-fromString xs = B.pack (encode xs)+fromString [] = B.empty+fromString xs0 = packChunks 32 xs0+ where+ packChunks n xs = case packUptoLenBytes n xs of+ (bs, [] ) -> B.chunk bs B.Empty+ (bs, xs') -> B.Chunk bs (packChunks (min (n * 2) B.smallChunkSize) xs') + packUptoLenBytes :: Int -> String -> (S.ByteString, String)+ packUptoLenBytes len xs = unsafeCreateUptoN' len $ \ptr -> do+ (end, xs') <- go ptr (ptr `plusPtr` (len-4)) xs+ return (end `minusPtr` ptr, xs')++ -- end is the last position at which you can write a whole 4 byte sequence safely+ go :: Ptr Word8 -> Ptr Word8 -> String -> IO (Ptr Word8, String)+ go !ptr !end xs | ptr > end = return (ptr, xs)+ go !ptr !_ [] = return (ptr, [])+ go !ptr !end (x:xs)+ | x <= '\x7f' = poke ptr (S.c2w x) >> go (plusPtr ptr 1) end xs+ | otherwise = case ord x of+ oc | oc <= 0x7ff -> do+ poke ptr $ fromIntegral $ 0xc0 + (oc `shiftR` 6)+ pokeElemOff ptr 1 $ fromIntegral $ 0x80 + oc .&. 0x3f+ go (plusPtr ptr 2) end xs+ | oc <= 0xffff -> do+ poke ptr $ fromIntegral $ 0xe0 + (oc `shiftR` 12)+ pokeElemOff ptr 1 $ fromIntegral $ 0x80 + ((oc `shiftR` 6) .&. 0x3f)+ pokeElemOff ptr 2 $ fromIntegral $ 0x80 + oc .&. 0x3f+ go (plusPtr ptr 3) end xs+ | otherwise -> do+ poke ptr $ fromIntegral $ 0xf0 + (oc `shiftR` 18)+ pokeElemOff ptr 1 $ fromIntegral $ 0x80 + ((oc `shiftR` 12) .&. 0x3f)+ pokeElemOff ptr 2 $ fromIntegral $ 0x80 + ((oc `shiftR` 6) .&. 0x3f)+ pokeElemOff ptr 3 $ fromIntegral $ 0x80 + oc .&. 0x3f+ go (plusPtr ptr 4) end xs+++---------------------------------------------------------------------+-- DECODING+ -- | Convert a UTF8 encoded bytestring into a Haskell string.--- Invalid characters are replaced with '\xFFFD'.+-- Invalid characters are replaced with @\'\\0xFFFD\'@. toString :: B.ByteString -> String toString bs = foldr (:) [] bs @@ -57,7 +113,7 @@ -- Returns 'Nothing' if there are no more bytes in the byte string. -- Otherwise, it returns a decoded character and the number of -- bytes used in its representation.--- Errors are replaced by character '\0xFFFD'.+-- Errors are replaced by character @\'\\0xFFFD\'@. -- XXX: Should we combine sequences of errors into a single replacement -- character?@@ -119,31 +175,40 @@ _ -> (replacement_char, 3) _ -> (replacement_char, 2) _ -> (replacement_char, 1)+{-# INLINE decode #-} -- | Split after a given number of characters. -- Negative values are treated as if they are 0. splitAt :: Int64 -> B.ByteString -> (B.ByteString,B.ByteString) splitAt x bs = loop 0 x bs- where loop a n _ | n <= 0 = B.splitAt a bs- loop a n bs1 = case decode bs1 of+ where loop !a n _ | n <= 0 = B.splitAt a bs+ loop !a n bs1 = case decode bs1 of Just (_,y) -> loop (a+y) (n-1) (B.drop y bs1) Nothing -> (bs, B.empty) -- | @take n s@ returns the first @n@ characters of @s@. -- If @s@ has less than @n@ characters, then we return the whole of @s@. take :: Int64 -> B.ByteString -> B.ByteString-take n bs = fst (splitAt n bs)+take x bs = loop 0 x bs+ where loop !a n _ | n <= 0 = B.take a bs+ loop !a n bs1 = case decode bs1 of+ Just (_,y) -> loop (a+y) (n-1) (B.drop y bs1)+ Nothing -> bs -- | @drop n s@ returns the @s@ without its first @n@ characters. -- If @s@ has less than @n@ characters, then we return an empty string. drop :: Int64 -> B.ByteString -> B.ByteString-drop n bs = snd (splitAt n bs)+drop x bs = loop 0 x bs+ where loop !a n _ | n <= 0 = B.drop a bs+ loop !a n bs1 = case decode bs1 of+ Just (_,y) -> loop (a+y) (n-1) (B.drop y bs1)+ Nothing -> B.empty -- | Split a string into two parts: the first is the longest prefix -- that contains only characters that satisfy the predicate; the second -- part is the rest of the string.--- Invalid characters are passed as '\0xFFFD' to the predicate.+-- Invalid characters are passed as @\'\\0xFFFD\'@ to the predicate. span :: (Char -> Bool) -> B.ByteString -> (B.ByteString, B.ByteString) span p bs = loop 0 bs where loop a cs = case decode cs of@@ -153,12 +218,12 @@ -- | Split a string into two parts: the first is the longest prefix -- that contains only characters that do not satisfy the predicate; the second -- part is the rest of the string.--- Invalid characters are passed as '\0xFFFD' to the predicate.+-- Invalid characters are passed as @\'\\0xFFFD\'@ to the predicate. break :: (Char -> Bool) -> B.ByteString -> (B.ByteString, B.ByteString) break p bs = span (not . p) bs -- | Get the first character of a byte string, if any.--- Malformed characters are replaced by '\0xFFFD'.+-- Malformed characters are replaced by @\'\\0xFFFD\'@. uncons :: B.ByteString -> Maybe (Char,B.ByteString) uncons bs = do (c,n) <- decode bs return (c, B.drop n bs)@@ -186,9 +251,9 @@ Nothing -> n -- | Split a string into a list of lines.--- Lines are terminated by '\n' or the end of the string.+-- Lines are terminated by @\'\\n\'@ or the end of the string. -- Empty lines may not be terminated by the end of the string.--- See also 'lines\''.+-- See also 'lines''. lines :: B.ByteString -> [B.ByteString] lines bs | B.null bs = [] lines bs = case B.elemIndex 10 bs of@@ -197,7 +262,7 @@ Nothing -> [bs] -- | Split a string into a list of lines.--- Lines are terminated by '\n' or the end of the string.+-- Lines are terminated by @\'\\n\'@ or the end of the string. -- Empty lines may not be terminated by the end of the string. -- This function preserves the terminators. -- See also 'lines'.@@ -208,3 +273,25 @@ in xs : lines' ys Nothing -> [bs] ++---------------------------------------------------------------------+-- COPIED FROM BYTESTRING+-- These functions are copied verbatum from Data.ByteString.Internal+-- I suspect their lack of export is an oversight++unsafeCreateUptoN' :: Int -> (Ptr Word8 -> IO (Int, a)) -> (S.ByteString, a)+unsafeCreateUptoN' l f = unsafeDupablePerformIO (createUptoN' l f)+{-# INLINE unsafeCreateUptoN' #-}++-- | Create ByteString of up to size @l@ and use action @f@ to fill it's contents which returns its true size.+createUptoN' :: Int -> (Ptr Word8 -> IO (Int, a)) -> IO (S.ByteString, a)+createUptoN' l f = do+ fp <- S.mallocByteString l+ (l', res) <- withForeignPtr fp $ \p -> f p+#if MIN_VERSION_bytestring(0,11,0)+ let bs = S.BS fp l'+#else+ let bs = S.PS fp 0 l'+#endif+ assert (l' <= l) $ return (bs, res)+{-# INLINE createUptoN' #-}
Data/ByteString/UTF8.hs view
@@ -1,3 +1,7 @@+{-# LANGUAGE CPP #-}+#if __GLASGOW_HASKELL__ >= 701+{-# LANGUAGE Trustworthy #-}+#endif -- -- | -- Module : Data.ByteString.UTF8@@ -22,6 +26,7 @@ , drop , span , break+ , fromChar , fromString , toString , foldl@@ -39,12 +44,16 @@ import Codec.Binary.UTF8.String(encode) import Codec.Binary.UTF8.Generic (buncons) +-- | Converts a Haskell char into a UTF8 encoded bytestring.+fromChar :: Char -> B.ByteString+fromChar x = fromString [x]+ -- | Converts a Haskell string into a UTF8 encoded bytestring. fromString :: String -> B.ByteString fromString xs = B.pack (encode xs) -- | Convert a UTF8 encoded bytestring into a Haskell string.--- Invalid characters are replaced with '\xFFFD'.+-- Invalid characters are replaced with @\'\\0xFFFD\'@. toString :: B.ByteString -> String toString bs = foldr (:) [] bs @@ -56,7 +65,7 @@ -- Returns 'Nothing' if there are no more bytes in the byte string. -- Otherwise, it returns a decoded character and the number of -- bytes used in its representation.--- Errors are replaced by character '\0xFFFD'.+-- Errors are replaced by character @\'\\0xFFFD\'@. -- XXX: Should we combine sequences of errors into a single replacement -- character?@@ -142,7 +151,7 @@ -- | Split a string into two parts: the first is the longest prefix -- that contains only characters that satisfy the predicate; the second -- part is the rest of the string.--- Invalid characters are passed as '\0xFFFD' to the predicate.+-- Invalid characters are passed as @\'\\0xFFFD\'@ to the predicate. span :: (Char -> Bool) -> B.ByteString -> (B.ByteString, B.ByteString) span p bs = loop 0 bs where loop a cs = case decode cs of@@ -152,12 +161,12 @@ -- | Split a string into two parts: the first is the longest prefix -- that contains only characters that do not satisfy the predicate; the second -- part is the rest of the string.--- Invalid characters are passed as '\0xFFFD' to the predicate.+-- Invalid characters are passed as @\'\\0xFFFD\'@ to the predicate. break :: (Char -> Bool) -> B.ByteString -> (B.ByteString, B.ByteString) break p bs = span (not . p) bs -- | Get the first character of a byte string, if any.--- Malformed characters are replaced by '\0xFFFD'.+-- Malformed characters are replaced by @\'\\0xFFFD\'@. uncons :: B.ByteString -> Maybe (Char,B.ByteString) uncons bs = do (c,n) <- decode bs return (c, B.drop n bs)@@ -185,9 +194,9 @@ Nothing -> n -- | Split a string into a list of lines.--- Lines are terminated by '\n' or the end of the string.+-- Lines are terminated by @\'\\n\'@ or the end of the string. -- Empty lines may not be terminated by the end of the string.--- See also 'lines\''.+-- See also 'lines''. lines :: B.ByteString -> [B.ByteString] lines bs | B.null bs = [] lines bs = case B.elemIndex 10 bs of@@ -196,7 +205,7 @@ Nothing -> [bs] -- | Split a string into a list of lines.--- Lines are terminated by '\n' or the end of the string.+-- Lines are terminated by @\'\\n\'@ or the end of the string. -- Empty lines may not be terminated by the end of the string. -- This function preserves the terminators. -- See also 'lines'.
Data/String/UTF8.hs view
@@ -1,3 +1,7 @@+{-# LANGUAGE CPP #-}+#if __GLASGOW_HASKELL__ >= 701+{-# LANGUAGE Trustworthy #-}+#endif -- -- | -- Module : Data.String.UTF8@@ -44,6 +48,7 @@ ,foldl,foldr,length,lines,splitAt) import qualified Codec.Binary.UTF8.Generic as G import Codec.Binary.UTF8.Generic (UTF8Bytes)+import qualified Data.String as S -- | The type of strings that are represented using the UTF8 encoding. -- The parameter is the type of the container for the representation.@@ -52,6 +57,9 @@ instance UTF8Bytes string index => Show (UTF8 string) where show x = show (toString x) +instance UTF8Bytes string index => S.IsString (UTF8 string) where+ fromString = fromString+ fromRep :: string -> UTF8 string fromRep = Str @@ -64,7 +72,7 @@ fromString xs = Str (G.fromString xs) -- | Convert a UTF8 encoded string into a Haskell string.--- Invalid characters are replaced by 'replacement_char'.+-- Invalid characters are replaced by 'G.replacement_char'. -- Complexity: linear. toString :: UTF8Bytes string index => UTF8 string -> String toString (Str xs) = G.toString xs@@ -75,7 +83,6 @@ -- | Split after a given number of characters. -- Negative values are treated as if they are 0.--- See also 'bytesSplitAt'. splitAt :: UTF8Bytes string index => index -> UTF8 string -> (UTF8 string, UTF8 string) splitAt x (Str bs) = case G.splitAt x bs of@@ -112,7 +119,7 @@ -- | Split a string into two parts: the first is the longest prefix -- that contains only characters that satisfy the predicate; the second -- part is the rest of the string.--- Invalid characters are passed as '\0xFFFD' to the predicate.+-- Invalid characters are passed as @\'\\0xFFFD\'@ to the predicate. span :: UTF8Bytes string index => (Char -> Bool) -> UTF8 string -> (UTF8 string, UTF8 string) span p (Str bs) = case G.span p bs of@@ -121,14 +128,14 @@ -- | Split a string into two parts: the first is the longest prefix -- that contains only characters that do not satisfy the predicate; the second -- part is the rest of the string.--- Invalid characters are passed as 'replacement_char' to the predicate.+-- Invalid characters are passed as 'G.replacement_char' to the predicate. break :: UTF8Bytes string index => (Char -> Bool) -> UTF8 string -> (UTF8 string, UTF8 string) break p (Str bs) = case G.break p bs of (s1,s2) -> (Str s1, Str s2) -- | Get the first character of a byte string, if any.--- Invalid characters are replaced by 'replacement_char'.+-- Invalid characters are replaced by 'G.replacement_char'. uncons :: UTF8Bytes string index => UTF8 string -> Maybe (Char, UTF8 string) uncons (Str x) = do (c,y) <- G.uncons x@@ -137,7 +144,7 @@ -- | Extract the first character for the underlying representation, -- if one is available. It also returns the number of bytes used -- in the representation of the character.--- See also 'uncons', 'dropBytes'.+-- See also 'uncons'. decode :: UTF8Bytes string index => UTF8 string -> Maybe (Char, index) decode (Str x) = G.decode x @@ -157,14 +164,14 @@ length (Str b) = G.length b -- | Split a string into a list of lines.--- Lines are terminated by '\n' or the end of the string.+-- Lines are terminated by @\'\\n\'@ or the end of the string. -- Empty lines may not be terminated by the end of the string.--- See also 'lines\''.+-- See also 'lines''. lines :: UTF8Bytes string index => UTF8 string -> [UTF8 string] lines (Str b) = map Str (G.lines b) -- XXX: unnecessary map -- | Split a string into a list of lines.--- Lines are terminated by '\n' or the end of the string.+-- Lines are terminated by @\'\\n\'@ or the end of the string. -- Empty lines may not be terminated by the end of the string. -- This function preserves the terminators. -- See also 'lines'.
− System/Environment/UTF8.hs
@@ -1,37 +0,0 @@------ |--- Module : System.Environment.UTF8--- Copyright : (c) Eric Mertens 2009--- License : BSD3-style (see LICENSE)------ Maintainer: emertens@galois.com--- Stability : experimental--- Portability : portable------ Support for UTF-8 based environment manipulation----module System.Environment.UTF8- (getArgs, getProgName, getEnv, withArgs, withProgName, getEnvironment)- where--import Codec.Binary.UTF8.String (decodeString)-import qualified System.Environment as Sys--getArgs :: IO [String]-getArgs = map decodeString `fmap` Sys.getArgs--getProgName :: IO String-getProgName = decodeString `fmap` Sys.getProgName--getEnv :: String -> IO String-getEnv x = decodeString `fmap` Sys.getEnv x--withArgs :: [String] -> IO a -> IO a-withArgs = Sys.withArgs--withProgName :: String -> IO a -> IO a-withProgName = Sys.withProgName--getEnvironment :: IO [(String,String)]-getEnvironment = map f `fmap` Sys.getEnvironment- where f (a,b) = (decodeString a, decodeString b)
− System/IO/UTF8.hs
@@ -1,126 +0,0 @@--------------------------------------------------------------------------------- |--- 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- , openBinaryFile- , withBinaryFile- , readFile- , writeFile- , appendFile- , interact- , getContents- , hGetLine- , hGetContents- , hPutStr- , hPutStrLn- ) where--import Control.Monad (liftM)-import Data.Word (Word8)-import Prelude (String, (=<<), (.), map, Enum(toEnum, fromEnum), Read,- Show(..))-import System.IO (Handle, IO, FilePath, IOMode(AppendMode, ReadMode, WriteMode))-import qualified System.IO as IO-import Control.Exception (bracket)--import Codec.Binary.UTF8.String (encode, decode)----- | 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 (toEnum . fromEnum) xs---- | String to list of bytes.-stringToBytes :: String -> [Word8]-stringToBytes xs = map (toEnum . fromEnum) 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--openBinaryFile :: FilePath -> IOMode -> IO Handle-openBinaryFile n m = IO.openBinaryFile (encodeString n) m--withBinaryFile :: FilePath -> IOMode -> (Handle -> IO a) -> IO a-withBinaryFile n m f = bracket (openBinaryFile n m) IO.hClose f---- | 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 = hGetContents =<< openBinaryFile n ReadMode---- | The computation 'writeFile' @file str@ function writes the UTF8 string @str@,--- to the file @file@.-writeFile :: FilePath -> String -> IO ()-writeFile n s = withBinaryFile n WriteMode (\ h -> hPutStr h s)---- | The computation 'appendFile' @file str@ function appends the UTF8 string @str@,--- to the file @file@.-appendFile :: FilePath -> String -> IO ()-appendFile n s = withBinaryFile n AppendMode (\ h -> hPutStr h s)---- | 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--interact :: (String -> String) -> IO ()-interact f = IO.interact (encodeString . f . decodeString)
+ tests/Tests.hs view
@@ -0,0 +1,208 @@+import Codec.Binary.UTF8.String+import Test.HUnit (Test (TestCase, TestList, TestLabel), assertEqual, errors, failures, runTestTT)+import System.Exit (exitFailure)+import Control.Monad (when)++main :: IO ()+main = do counts <- runTestTT tests+ when (errors counts > 0 || failures counts > 0) exitFailure++tests :: Test+tests = TestList [test_1, test_2, test_3, test_4, test_5, test_6]++test_1 :: Test+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 :: Test+test_2 = TestLabel "2 Boundary condition test cases" $+ TestList [test_2_1, test_2_2, test_2_3]++test_2_1 :: Test+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 :: Test+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 :: Test+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 :: Test+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 :: Test+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 :: Test+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 :: Test+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 :: Test+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 :: Test+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 :: Test+test_4 = TestLabel "4 Overlong sequences" $+ TestList [test_4_1, test_4_2, test_4_3]++test_4_1 :: Test+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 :: Test+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 :: Test+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 :: Test+test_5 = TestLabel "Illegal code positions" $+ TestList [test_5_1, test_5_2, test_5_3]++test_5_1 :: Test+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 :: Test+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 :: Test+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_6 :: Test+test_6 = TestLabel "Encode then decode" $+ TestList $ map TestCase $+ [ assertEqual "6.1" encodeDecodeTest []+ ]++--+-- 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,35 +1,42 @@ Name: utf8-string-Version: 0.3.7+Version: 1.0.2 Author: Eric Mertens Maintainer: emertens@galois.com License: BSD3 License-file: LICENSE-Homepage: http://github.com/glguy/utf8-string/+Homepage: https://github.com/glguy/utf8-string/+Bug-Reports: https://github.com/glguy/utf8-string/issues Synopsis: Support for reading and writing UTF8 Strings-Description: A UTF8 layer for IO and Strings. The utf8-string+Description: A UTF8 layer for 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-type: Simple-cabal-version: >= 1.2+cabal-version: >= 1.10+Extra-Source-Files: CHANGELOG.markdown+Tested-With: GHC==7.0.4, GHC==7.4.2, GHC==7.6.3, GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.1 -flag bytestring-in-base+source-repository head+ type: git+ location: https://github.com/glguy/utf8-string library Ghc-options: -W -O2 - if flag(bytestring-in-base)- build-depends: base >= 2.0 && < 2.2- cpp-options: -DBYTESTRING_IN_BASE- else- build-depends: base < 2.0 || >= 3, bytestring >= 0.9+ build-depends: base >= 4.3 && < 5, bytestring >= 0.9 - Extensions: CPP Exposed-modules: Codec.Binary.UTF8.String Codec.Binary.UTF8.Generic- System.IO.UTF8- System.Environment.UTF8 Data.String.UTF8 Data.ByteString.UTF8 Data.ByteString.Lazy.UTF8++ default-language: Haskell2010++test-suite unit-tests+ type: exitcode-stdio-1.0+ hs-source-dirs: tests+ main-is: Tests.hs+ build-depends: base, HUnit >= 1.3 && < 1.7, utf8-string+ default-language: Haskell2010