utf8-string 0.2 → 0.3
raw patch · 4 files changed
+329/−120 lines, 4 filesdep +bytestring
Dependencies added: bytestring
Files
- Codec/Binary/UTF8/String.hs +8/−1
- Data/ByteString/UTF8.hs +198/−0
- System/IO/UTF8.hs +118/−116
- utf8-string.cabal +5/−3
Codec/Binary/UTF8/String.hs view
@@ -66,13 +66,20 @@ decode (c:cs) | c < 0x80 = chr (fromEnum c) : decode cs | c < 0xc0 = replacement_character : decode cs- | c < 0xe0 = multi_byte 1 0x1f 0x80+ | c < 0xe0 = multi1 | 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+ multi1 = case cs of+ c1 : ds | c1 .&. 0xc0 == 0x80 ->+ let d = ((fromEnum c .&. 0x1f) `shiftL` 6) .|. fromEnum (c1 .&. 0x3f)+ in if d >= 0x000080 then toEnum d : decode ds+ else replacement_character : decode ds+ _ -> replacement_character : decode cs+ multi_byte :: Int -> Word8 -> Int -> [Char] multi_byte i mask overlong = aux i cs (fromEnum (c .&. mask)) where
+ Data/ByteString/UTF8.hs view
@@ -0,0 +1,198 @@+-- | This module provides fast, validated encoding and decoding functions+-- between 'ByteString's and 'String's. It does not exactly match the+-- output of the Codec.Binary.UTF8.String output for invalid encodings+-- as the number of replacement characters is sometimes longer.+module Data.ByteString.UTF8+ ( B.ByteString+ , decode+ , replacement_char+ , uncons+ , splitAt+ , take+ , drop+ , span+ , break+ , fromString+ , toString+ , foldl+ , foldr+ , length+ , lines+ , lines'+ ) where++import Data.Bits+import Data.Word+import qualified Data.ByteString as B+import Prelude hiding (take,drop,splitAt,span,break,foldr,foldl,length,lines)++import Codec.Binary.UTF8.String(encode)++-- | 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'.+toString :: B.ByteString -> String+toString bs = foldr (:) [] bs++-- | This character is used to mark errors in a UTF8 encoded string.+replacement_char :: Char+replacement_char = '\xfffd'++-- | Try to extract a character from a byte string.+-- 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'.++-- XXX: Should we combine sequences of errors into a single replacement+-- character?+decode :: B.ByteString -> Maybe (Char,Int)+decode bs = do (c,cs) <- B.uncons bs+ return (choose (fromEnum c) cs)+ where+ choose :: Int -> B.ByteString -> (Char, Int)+ choose c cs+ | c < 0x80 = (toEnum $ fromEnum c, 1)+ | c < 0xc0 = (replacement_char, 1)+ | c < 0xe0 = bytes2 (mask c 0x1f) cs+ | c < 0xf0 = bytes3 (mask c 0x0f) cs+ | c < 0xf8 = bytes4 (mask c 0x07) cs+ | otherwise = (replacement_char, 1)++ mask :: Int -> Int -> Int+ mask c m = fromEnum (c .&. m)++ combine :: Int -> Word8 -> Int+ combine acc r = shiftL acc 6 .|. fromEnum (r .&. 0x3f)++ follower :: Int -> Word8 -> Maybe Int+ follower acc r | r .&. 0xc0 == 0x80 = Just (combine acc r)+ follower _ _ = Nothing++ {-# INLINE get_follower #-}+ get_follower :: Int -> B.ByteString -> Maybe (Int, B.ByteString)+ get_follower acc cs = do (x,xs) <- B.uncons cs+ acc1 <- follower acc x+ return (acc1,xs)++ bytes2 :: Int -> B.ByteString -> (Char, Int)+ bytes2 c cs = case get_follower c cs of+ Just (d, _) | d >= 0x80 -> (toEnum d, 2)+ | otherwise -> (replacement_char, 1)+ _ -> (replacement_char, 1)++ bytes3 :: Int -> B.ByteString -> (Char, Int)+ bytes3 c cs =+ case get_follower c cs of+ Just (d1, cs1) ->+ case get_follower d1 cs1 of+ Just (d, _) | (d >= 0x800 && d < 0xd800) ||+ (d > 0xdfff && d < 0xfffe) -> (toEnum d, 3)+ | otherwise -> (replacement_char, 3)+ _ -> (replacement_char, 2)+ _ -> (replacement_char, 1)++ bytes4 :: Int -> B.ByteString -> (Char, Int)+ bytes4 c cs =+ case get_follower c cs of+ Just (d1, cs1) ->+ case get_follower d1 cs1 of+ Just (d2, cs2) ->+ case get_follower d2 cs2 of+ Just (d,_) | d >= 0x10000 -> (toEnum d, 4)+ | otherwise -> (replacement_char, 4)+ _ -> (replacement_char, 3)+ _ -> (replacement_char, 2)+ _ -> (replacement_char, 1)+++-- | Split after a given number of characters.+-- Negative values are treated as if they are 0.+splitAt :: Int -> 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+ 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 then @n@ characters, then we return the whole of @s@.+take :: Int -> B.ByteString -> B.ByteString+take n bs = fst (splitAt n bs)++-- | @drop n s@ returns the @s@ without its first @n@ characters.+-- If @s@ has less then @n@ characters, then we return the an empty string.+drop :: Int -> B.ByteString -> B.ByteString+drop n bs = snd (splitAt n bs)++-- | 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.+span :: (Char -> Bool) -> B.ByteString -> (B.ByteString, B.ByteString)+span p bs = loop 0 bs+ where loop a cs = case decode cs of+ Just (c,n) | p c -> loop (a+n) (B.drop n cs)+ _ -> B.splitAt a bs++-- | 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.+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'.+uncons :: B.ByteString -> Maybe (Char,B.ByteString)+uncons bs = do (c,n) <- decode bs+ return (c, B.drop n bs)++-- | Traverse a bytestring (right biased).+foldr :: (Char -> a -> a) -> a -> B.ByteString -> a+foldr cons nil cs = case uncons cs of+ Just (a,as) -> cons a (foldr cons nil as)+ Nothing -> nil++-- | Traverse a bytestring (left biased).+-- This fuction is strict in the acumulator.+foldl :: (a -> Char -> a) -> a -> B.ByteString -> a+foldl add acc cs = case uncons cs of+ Just (a,as) -> let v = add acc a+ in seq v (foldl add v as)+ Nothing -> acc++-- | Counts the number of characters encoded in the bytestring.+-- Note that this includes replacment characters.+length :: B.ByteString -> Int+length b = loop 0 b+ where loop n xs = case decode xs of+ Just (_,m) -> loop (n+1) (B.drop m xs)+ Nothing -> n++-- | Split a string into a list of lines.+-- Lines are termianted by '\n' or the end of the string.+-- Empty line may not be terminated by the end of the string.+-- See also 'lines\''.+lines :: B.ByteString -> [B.ByteString]+lines bs | B.null bs = []+lines bs = case B.elemIndex 10 bs of+ Just x -> let (xs,ys) = B.splitAt x bs+ in xs : lines (B.tail ys)+ Nothing -> [bs]++-- | Split a string into a list of lines.+-- Lines are termianted by '\n' or the end of the string.+-- Empty line may not be terminated by the end of the string.+-- This function preserves the terminators.+-- See also 'lines'.+lines' :: B.ByteString -> [B.ByteString]+lines' bs | B.null bs = []+lines' bs = case B.elemIndex 10 bs of+ Just x -> let (xs,ys) = B.splitAt (x+1) bs+ in xs : lines' ys+ Nothing -> [bs]+
System/IO/UTF8.hs view
@@ -1,116 +1,118 @@------------------------------------------------------------------------------ --- | --- 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 - +-----------------------------------------------------------------------------+-- |+-- 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 Control.Monad (liftM)+import Data.Char (ord, chr)+import Data.Word (Word8)+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)+++-- | 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.openBinaryFile n IO.ReadMode >>=+ IO.hGetContents)++-- | The computation 'writeFile' @file str@ function writes the UTF8 string @str@,+-- to the file @file@.+writeFile :: FilePath -> String -> IO ()+writeFile n c = IO.withBinaryFile n IO.WriteMode $ \ h ->+ 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++-- | 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+
utf8-string.cabal view
@@ -1,5 +1,5 @@ Name: utf8-string-Version: 0.2+Version: 0.3 Author: Eric Mertens Maintainer: emertens@galois.com License: BSD3@@ -11,7 +11,9 @@ 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+Build-depends: base>=1.0, bytestring>=0.9+Ghc-options: -W -O2+Build-type: Simple Exposed-modules: Codec.Binary.UTF8.String System.IO.UTF8+ Data.ByteString.UTF8