packages feed

utf8-string 0.3 → 0.3.1

raw patch · 7 files changed

+1084/−1 lines, 7 filesnew-uploader

Files

+ Codec/Binary/UTF8/Generic.hs view
@@ -0,0 +1,269 @@+{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}+-- | 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 Codec.Binary.UTF8.Generic+  ( UTF8Bytes(..)+  , decode+  , replacement_char+  , uncons+  , splitAt+  , take+  , drop+  , span+  , break+  , fromString+  , toString+  , foldl+  , foldr+  , length+  , lines+  , lines'+  ) where++import Data.Bits+import Data.Int+import Data.Word+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as L+import qualified Data.List as List+import Prelude hiding (take,drop,splitAt,span,break,foldr,foldl,length,lines,null,tail)++import Codec.Binary.UTF8.String(encode)++class (Num s, Ord s) => UTF8Bytes b s | b -> s where+  bsplit        :: s -> b -> (b,b)+  bdrop         :: s -> b -> b+  buncons       :: b -> Maybe (Word8,b)+  elemIndex     :: Word8 -> b -> Maybe s+  empty         :: b+  null          :: b -> Bool+  pack          :: [Word8] -> b+  tail          :: b -> b++instance UTF8Bytes B.ByteString Int where+  bsplit        = B.splitAt+  bdrop         = B.drop+  buncons       = B.uncons+  elemIndex     = B.elemIndex+  empty         = B.empty+  null          = B.null+  pack          = B.pack+  tail          = B.tail++instance UTF8Bytes L.ByteString Int64 where+  bsplit        = L.splitAt+  bdrop         = L.drop+  buncons       = L.uncons+  elemIndex     = L.elemIndex+  empty         = L.empty+  null          = L.null+  pack          = L.pack+  tail          = L.tail++instance UTF8Bytes [Word8] Int where+  bsplit          = List.splitAt+  bdrop           = List.drop+  buncons (x:xs)  = Just (x,xs)+  buncons []      = Nothing+  elemIndex x xs  = List.elemIndex (toEnum (fromEnum x)) xs+  empty           = []+  null            = List.null+  pack            = id+  tail            = List.tail++-- | Converts a Haskell string into a UTF8 encoded bytestring.+{-# SPECIALIZE fromString :: String -> B.ByteString  #-}+{-# SPECIALIZE fromString :: String -> L.ByteString  #-}+{-# SPECIALIZE fromString :: String -> [Word8] #-}+fromString :: UTF8Bytes b s => String -> b+fromString xs = pack (encode xs)++-- | Convert a UTF8 encoded bytestring into a Haskell string.+-- Invalid characters are replaced with '\xFFFD'.+{-# SPECIALIZE toString :: B.ByteString -> String #-}+{-# SPECIALIZE toString :: L.ByteString -> String #-}+{-# SPECIALIZE toString :: [Word8] -> String #-}+toString :: UTF8Bytes b s => b -> 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?+{-# SPECIALIZE decode :: B.ByteString -> Maybe (Char,Int) #-}+{-# SPECIALIZE decode :: L.ByteString -> Maybe (Char,Int64) #-}+{-# SPECIALIZE decode :: [Word8]      -> Maybe (Char,Int) #-}+decode :: UTF8Bytes b s => b -> Maybe (Char,s)+decode bs = do (c,cs) <- buncons bs+               return (choose (fromEnum c) cs)+  where+  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 c m = fromEnum (c .&. m)++  combine acc r = shiftL acc 6 .|. fromEnum (r .&. 0x3f)++  follower acc r | r .&. 0xc0 == 0x80 = Just (combine acc r)+  follower _ _                        = Nothing++  {-# INLINE get_follower #-}+  get_follower acc cs = do (x,xs) <- buncons cs+                           acc1 <- follower acc x+                           return (acc1,xs)++  bytes2 c cs = case get_follower c cs of+                  Just (d, _) | d >= 0x80  -> (toEnum d, 2)+                              | otherwise  -> (replacement_char, 1)+                  _ -> (replacement_char, 1)++  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 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.+{-# SPECIALIZE splitAt :: Int   -> B.ByteString -> (B.ByteString,B.ByteString) #-}+{-# SPECIALIZE splitAt :: Int64 -> L.ByteString -> (L.ByteString,L.ByteString) #-}+{-# SPECIALIZE splitAt :: Int   -> [Word8] -> ([Word8],[Word8])    #-}+splitAt :: UTF8Bytes b s => s -> b -> (b,b)+splitAt x bs = loop 0 x bs+  where loop a n _ | n <= 0 = bsplit a bs+        loop a n bs1 = case decode bs1 of+                         Just (_,y) -> loop (a+y) (n-1) (bdrop y bs1)+                         Nothing    -> (bs, 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@.+{-# INLINE take #-}+take :: UTF8Bytes b s => s -> b -> b+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.+{-# INLINE drop #-}+drop :: UTF8Bytes b s => s -> b -> b+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.+{-# 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])    #-}+span :: UTF8Bytes b s => (Char -> Bool) -> b -> (b,b)+span p bs = loop 0 bs+  where loop a cs = case decode cs of+                      Just (c,n) | p c -> loop (a+n) (bdrop n cs)+                      _ -> bsplit 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.+{-# 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'.+{-# INLINE uncons #-}+uncons :: UTF8Bytes b s => b -> Maybe (Char,b)+uncons bs = do (c,n) <- decode bs+               return (c, bdrop n bs)++-- | Traverse a bytestring (right biased).+{-# SPECIALIZE foldr :: (Char -> a -> a) -> a -> B.ByteString -> a #-}+{-# SPECIALIZE foldr :: (Char -> a -> a) -> a -> L.ByteString -> a #-}+{-# SPECIALIZE foldr :: (Char -> a -> a) -> a -> [Word8]      -> a #-}+foldr :: UTF8Bytes b s => (Char -> a -> a) -> a -> b -> 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.+{-# SPECIALIZE foldl :: (a -> Char -> a) -> a -> B.ByteString -> a #-}+{-# SPECIALIZE foldl :: (a -> Char -> a) -> a -> L.ByteString -> a #-}+{-# SPECIALIZE foldl :: (a -> Char -> a) -> a -> [Word8]      -> a #-}+foldl :: UTF8Bytes b s => (a -> Char -> a) -> a -> b -> 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.+{-# SPECIALIZE length :: B.ByteString -> Int #-}+{-# SPECIALIZE length :: L.ByteString -> Int64 #-}+{-# SPECIALIZE length :: [Word8]      -> Int #-}+length :: UTF8Bytes b s => b -> s+length b = loop 0 b+  where loop n xs = case decode xs of+                      Just (_,m) -> loop (n+1) (bdrop 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\''.+{-# SPECIALIZE lines :: B.ByteString -> [B.ByteString] #-}+{-# SPECIALIZE lines :: L.ByteString -> [L.ByteString] #-}+{-# SPECIALIZE lines :: [Word8]      -> [[Word8]]       #-}+lines :: UTF8Bytes b s => b -> [b]+lines bs | null bs  = []+lines bs = case elemIndex 10 bs of+             Just x -> let (xs,ys) = bsplit x bs+                       in xs : lines (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'.+{-# SPECIALIZE lines' :: B.ByteString -> [B.ByteString] #-}+{-# SPECIALIZE lines' :: L.ByteString -> [L.ByteString] #-}+{-# SPECIALIZE lines' :: [Word8]      -> [[Word8]]      #-}+lines' :: UTF8Bytes b s => b -> [b]+lines' bs | null bs  = []+lines' bs = case elemIndex 10 bs of+              Just x -> let (xs,ys) = bsplit (x+1) bs+                        in xs : lines' ys+              Nothing -> [bs]+
+ Data/ByteString/Lazy/UTF8.hs view
@@ -0,0 +1,199 @@+-- | 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.Lazy.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 Data.Int+import qualified Data.ByteString.Lazy 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,Int64)+decode bs = do (c,cs) <- B.uncons bs+               return (choose (fromEnum c) cs)+  where+  choose :: Int -> B.ByteString -> (Char, Int64)+  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, Int64)+  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, Int64)+  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, Int64)+  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 :: 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+                         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 :: Int64 -> 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 :: Int64 -> 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]+
+ Data/String/UTF8.hs view
@@ -0,0 +1,164 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# OPTIONS_GHC -fallow-undecidable-instances #-}+module Data.String.UTF8+  ( -- * Representation+    UTF8+  , UTF8Bytes()+  , fromString+  , toString+  , fromRep+  , toRep+  , G.replacement_char++  -- * Character based operations+  , uncons+  , splitAt+  , take+  , drop+  , span+  , break+  , foldl+  , foldr+  , length+  , lines+  , lines'++  -- * Representation based operations+  , null+  , decode+  , byteSplitAt+  , byteTake+  , byteDrop+  ) where++import Prelude hiding (null,take,drop,span,break+                      ,foldl,foldr,length,lines,splitAt)+import qualified Codec.Binary.UTF8.Generic as G+import Codec.Binary.UTF8.Generic (UTF8Bytes)++-- | The type of strngs that are represented using tthe UTF8 encoding.+-- The parameters is the type of the container for the representation.+newtype UTF8 string = Str string deriving (Eq,Ord)   -- XXX: Is this OK?++instance UTF8Bytes string index => Show (UTF8 string) where+  show x = show (toString x)++fromRep :: string -> UTF8 string+fromRep = Str++toRep :: UTF8 string -> string+toRep (Str x) = x++-- | Converts a Haskell string into a UTF8 encoded string.+-- Complexity: linear.+fromString :: UTF8Bytes string index => String -> UTF8 string+fromString xs = Str (G.fromString xs)++-- | Convert a UTF8 encoded string into a Haskell string.+-- Invalid characters are replaced by 'replacement_char'.+-- Complexity: linear.+toString :: UTF8Bytes string index => UTF8 string -> String+toString (Str xs) = G.toString xs++-- | Checks if there are no more bytes in the underlying representation.+null :: UTF8Bytes string index => UTF8 string -> Bool+null (Str x) = G.null x++-- | 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+                        (s1,s2) -> (Str s1, Str s2)++-- | Split after a given number of bytes in the underlying representation.+-- See also 'splitAt'.+byteSplitAt :: UTF8Bytes string index+             => index -> UTF8 string -> (UTF8 string, UTF8 string)+byteSplitAt n (Str x) = case G.bsplit n x of+                          (as,bs) -> (Str as, Str bs)++-- | Take only the given number of bytes from the underlying representation.+-- See also 'take'.+byteTake :: UTF8Bytes string index => index -> UTF8 string -> UTF8 string+byteTake n (Str x) = Str (fst (G.bsplit n x))++-- | Drop the given number of bytes from the underlying representation.+-- See also 'drop'.+byteDrop :: UTF8Bytes string index => index -> UTF8 string -> UTF8 string+byteDrop n (Str x) = Str (G.bdrop n x)+++-- | @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 :: UTF8Bytes string index => index -> UTF8 string -> UTF8 string+take n (Str bs) = Str (G.take 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 :: UTF8Bytes string index => index -> UTF8 string -> UTF8 string+drop n (Str bs) = Str (G.drop 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 :: UTF8Bytes string index+     => (Char -> Bool) -> UTF8 string -> (UTF8 string, UTF8 string)+span p (Str bs) = case G.span p bs of+                    (s1,s2) -> (Str s1, Str s2)++-- | 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.+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'.+uncons :: UTF8Bytes string index+       => UTF8 string -> Maybe (Char, UTF8 string)+uncons (Str x)  = do (c,y) <- G.uncons x+                     return (c, Str y)++-- | Extract the first character for the underlying representation,+-- if one is avaialble.  It also returns the number of bytes used+-- in the representation of the character.+-- See also 'uncons', 'dropBytes'.+decode :: UTF8Bytes string index => UTF8 string -> Maybe (Char, index)+decode (Str x)  = G.decode x++-- | Traverse a bytestring (right biased).+foldr :: UTF8Bytes string index => (Char -> a -> a) -> a -> UTF8 string -> a+foldr cons nil (Str cs) = G.foldr cons nil cs++-- | Traverse a bytestring (left biased).+-- This fuction is strict in the accumulator.+foldl :: UTF8Bytes string index => (a -> Char -> a) -> a -> UTF8 string -> a+foldl add acc (Str cs)  = G.foldl add acc cs++-- | Counts the number of characters encoded in the bytestring.+-- Note that this includes replacment characters.+-- The function is linear in the number of bytes in the representation.+length :: UTF8Bytes string index => UTF8 string -> index+length (Str b) = G.length b++-- | 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 :: 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 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' :: UTF8Bytes string index => UTF8 string -> [UTF8 string]+lines' (Str x)  = map Str (G.lines' x)  -- XXX: unnecessary map+
+ 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/BenchBytestring.hs view
@@ -0,0 +1,55 @@+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 view
@@ -0,0 +1,182 @@+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+Version:            0.3.1 Author:             Eric Mertens Maintainer:         emertens@galois.com License:            BSD3@@ -15,5 +15,8 @@ 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