text 0.9.0.1 → 0.9.1.0
raw patch · 23 files changed
+1036/−141 lines, 23 files
Files
- Data/Text.hs +31/−21
- Data/Text/Array.hs +33/−3
- Data/Text/Encoding.hs +97/−13
- Data/Text/Encoding/Utf8.hs +11/−16
- Data/Text/Foreign.hs +9/−0
- Data/Text/Fusion/Size.hs +23/−8
- Data/Text/Lazy.hs +27/−10
- Data/Text/Lazy/Encoding.hs +52/−10
- Data/Text/Lazy/Fusion.hs +6/−4
- Data/Text/Lazy/Internal.hs +2/−2
- Data/Text/Lazy/Read.hs +159/−0
- Data/Text/Read.hs +159/−0
- Data/Text/Unsafe.hs +12/−0
- README +0/−43
- README.markdown +42/−0
- scripts/ApiCompare.hs +6/−2
- tests/Properties.hs +51/−1
- tests/QuickCheckUtils.hs +10/−2
- tests/benchmarks/DecodeUtf8.hs +107/−0
- tests/benchmarks/EncodeUtf8.hs +55/−0
- tests/benchmarks/Equality.hs +36/−0
- tests/benchmarks/ReplaceTags.hs +91/−0
- text.cabal +17/−6
Data/Text.hs view
@@ -170,11 +170,11 @@ -- , sort ) where -import Prelude (Char, Bool(..), Functor(..), Int, Maybe(..), String,+import Prelude (Char, Bool(..), Int, Maybe(..), String, Eq(..), Ord(..), Ordering(..), (++), Read(..), Show(..), (&&), (||), (+), (-), (.), ($), ($!), (>>), (*),- div, error, not, return, otherwise)+ div, maxBound, not, return, otherwise) #if defined(HAVE_DEEPSEQ) import Control.DeepSeq (NFData) #endif@@ -255,7 +255,9 @@ -- phrase \"Subject to fusion\". instance Eq Text where- t1 == t2 = stream t1 == stream t2+ Text arrA offA lenA == Text arrB offB lenB+ | lenA == lenB = A.equal arrA offA arrB offB lenA+ | otherwise = False {-# INLINE (==) #-} instance Ord Text where@@ -294,8 +296,8 @@ instance Data Text where gfoldl f z txt = z pack `f` (unpack txt)- toConstr _ = error "Data.Text.Text.toConstr"- gunfold _ _ = error "Data.Text.Text.gunfold"+ toConstr _ = P.error "Data.Text.Text.toConstr"+ gunfold _ _ = P.error "Data.Text.Text.gunfold" #if __GLASGOW_HASKELL__ >= 612 dataTypeOf _ = mkNoRepType "Data.Text.Text" #else@@ -340,7 +342,11 @@ -- | /O(n)/ Appends one 'Text' to the other by copying both of them -- into a new 'Text'. Subject to fusion. append :: Text -> Text -> Text-append (Text arr1 off1 len1) (Text arr2 off2 len2) = Text (A.run x) 0 len+append a@(Text arr1 off1 len1) b@(Text arr2 off2 len2)+ | len1 == 0 = b+ | len2 == 0 = a+ | len > 0 = Text (A.run x) 0 len+ | otherwise = overflowError "append" where len = len1+len2 x = do@@ -376,13 +382,6 @@ second :: (b -> c) -> (a,b) -> (a,c) second f (a, b) = (a, f b) -{-# RULES-"TEXT uncons -> fused" [~1] forall t.- uncons t = fmap (second unstream) (S.uncons (stream t))-"TEXT uncons -> unfused" [1] forall t.- fmap (second unstream) (S.uncons (stream t)) = uncons t- #-}- -- | /O(1)/ Returns the last character of a 'Text', which must be -- non-empty. Subject to fusion. last :: Text -> Char@@ -706,7 +705,7 @@ _ -> Text (A.run go) 0 len where ts' = L.filter (not . null) ts- len = L.sum $ L.map lengthWord16 ts'+ len = sumP "concat" $ L.map lengthWord16 ts' go = do arr <- A.new len let step i (Text a o l) =@@ -804,12 +803,11 @@ -- @t@ repeated @n@ times. replicate :: Int -> Text -> Text replicate n t@(Text a o l)- | n <= 0 || l <= 0 = empty- | n == 1 = t- | isSingleton t = replicateChar n (unsafeHead t)- | len < n = error $ "Data.Text.replicate: invalid length " ++- show n -- multiplication overflow- | otherwise = Text (A.run x) 0 len+ | n <= 0 || l <= 0 = empty+ | n == 1 = t+ | isSingleton t = replicateChar n (unsafeHead t)+ | n <= maxBound `div` l = Text (A.run x) 0 len+ | otherwise = overflowError "replicate" where len = l * n x = do@@ -1440,5 +1438,17 @@ | p `isSuffixOf` t = Just $! textP arr off (len-plen) | otherwise = Nothing +-- | Add a list of non-negative numbers. Errors out on overflow.+sumP :: String -> [Int] -> Int+sumP fun = go 0+ where go !a (x:xs)+ | ax >= 0 = go ax xs+ | otherwise = overflowError fun+ where ax = a + x+ go a _ = a+ emptyError :: String -> a-emptyError fun = P.error ("Data.Text." ++ fun ++ ": empty input")+emptyError fun = P.error $ "Data.Text." ++ fun ++ ": empty input"++overflowError :: String -> a+overflowError fun = P.error $ "Data.Text." ++ fun ++ ": size overflow"
Data/Text/Array.hs view
@@ -33,6 +33,7 @@ , copyM , copyI , empty+ , equal #if defined(ASSERTS) , length #endif@@ -59,7 +60,7 @@ #if defined(ASSERTS) import Control.Exception (assert) #endif-import Data.Bits ((.&.))+import Data.Bits ((.&.), xor) import Data.Text.UnsafeShift (shiftL, shiftR) import GHC.Base (ByteArray#, MutableByteArray#, Int(..), indexWord16Array#, indexWordArray#, newByteArray#,@@ -103,7 +104,7 @@ -- | Create an uninitialized mutable array. new :: forall s. Int -> ST s (MArray s) new n- | len < n = error $ "Data.Text.Array.unsafeNew: invalid length " ++ show n+ | n < 0 || n .&. highBit /= 0 = error $ "Data.Text.Array.new: size overflow" | otherwise = ST $ \s1# -> case newByteArray# len# s1# of (# s2#, marr# #) -> (# s2#, MArray marr#@@ -111,7 +112,8 @@ n #endif #)- where !len@(I# len#) = bytesInArray n+ where !(I# len#) = bytesInArray n+ highBit = maxBound `xor` (maxBound `shiftR` 1) {-# INLINE new #-} -- | Freeze a mutable array. Do not mutate the 'MArray' afterwards!@@ -264,3 +266,31 @@ | i >= top = return () | otherwise = do unsafeWrite dest i (src `unsafeIndex` j) slow (i+1) (j+1)++-- | Compare portions of two arrays for equality. No bounds checking+-- is performed.+equal :: Array -- ^ First+ -> Int -- ^ Offset into first+ -> Array -- ^ Second+ -> Int -- ^ Offset into second+ -> Int -- ^ Count+ -> Bool+equal arrA offA arrB offB count+ | wordAligned offA && wordAligned offB = fast 0+ | otherwise = slow 0+ where+ countWords = count `div` wordFactor+ fast !i+ | i >= countWords = slow (i * wordFactor)+ | a /= b = False+ | otherwise = fast (i+1)+ where a = unsafeIndexWord arrA (offAW+i)+ b = unsafeIndexWord arrB (offBW+i)+ offAW = offA `div` wordFactor+ offBW = offB `div` wordFactor+ slow !i+ | i >= count = True+ | a /= b = False+ | otherwise = slow (i+1)+ where a = unsafeIndex arrA (offA+i)+ b = unsafeIndex arrB (offB+i)
Data/Text/Encoding.hs view
@@ -1,8 +1,9 @@+{-# LANGUAGE BangPatterns #-} -- | -- Module : Data.Text.Encoding--- Copyright : (c) Tom Harper 2008-2009,--- (c) Bryan O'Sullivan 2009,--- (c) Duncan Coutts 2009+-- Copyright : (c) 2008, 2009 Tom Harper,+-- (c) 2009, 2010 Bryan O'Sullivan,+-- (c) 2009 Duncan Coutts -- -- License : BSD-style -- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,@@ -39,32 +40,115 @@ , encodeUtf32LE , encodeUtf32BE ) where- -import Data.ByteString (ByteString)-import qualified Data.Text.Fusion as F++import Data.Bits ((.&.))+import Data.ByteString as B+import Data.ByteString.Internal as B+import Data.ByteString.Unsafe as B import Data.Text.Encoding.Error (OnDecodeError, strictDecode)+import Data.Text.Internal (Text(..), textP)+import Data.Text.UnsafeChar (ord, unsafeWrite)+import Data.Text.UnsafeShift (shiftL, shiftR)+import Data.Word (Word8)+import Foreign.ForeignPtr (withForeignPtr)+import Foreign.Ptr (plusPtr)+import Foreign.Storable (poke)+import System.IO.Unsafe (unsafePerformIO)+import qualified Data.Text.Array as A import qualified Data.Text.Encoding.Fusion as E-import Data.Text.Internal (Text)+import qualified Data.Text.Encoding.Utf16 as U16+import qualified Data.Text.Encoding.Utf8 as U8+import qualified Data.Text.Fusion as F -- | Decode a 'ByteString' containing 7-bit ASCII encoded text. decodeASCII :: ByteString -> Text decodeASCII bs = F.unstream (E.streamASCII bs) {-# INLINE decodeASCII #-} --- | Decode a 'ByteString' containing UTF-8 encoded text. decodeUtf8With :: OnDecodeError -> ByteString -> Text-decodeUtf8With onErr bs = F.unstream (E.streamUtf8 onErr bs)-{-# INLINE decodeUtf8With #-}+decodeUtf8With onErr bs = textP (fst a) 0 (snd a)+ where+ a = A.run2 (A.new len >>= outer 0 0)+ len = B.length bs+ outer n0 m0 arr = go n0 m0+ where+ go !n !m = do+ let x1 = idx m+ x2 = idx (m + 1)+ x3 = idx (m + 2)+ x4 = idx (m + 3)+ idx = B.unsafeIndex bs+ case undefined of+ _| m >= len -> return (arr,n)+ | U8.validate1 x1 -> do+ A.unsafeWrite arr n (fromIntegral x1)+ go (n+1) (m+1)+ | m+1 < len && U8.validate2 x1 x2 -> do+ w <- unsafeWrite arr n (U8.chr2 x1 x2)+ go (n+w) (m+2)+ | m+2 < len && U8.validate3 x1 x2 x3 -> do+ w <- unsafeWrite arr n (U8.chr3 x1 x2 x3)+ go (n+w) (m+3)+ | m+3 < len && U8.validate4 x1 x2 x3 x4 -> do+ w <- unsafeWrite arr n (U8.chr4 x1 x2 x3 x4)+ go (n+w) (m+4)+ | otherwise -> case onErr desc (Just x1) of+ Nothing -> go n (m+1)+ Just c -> do+ w <- unsafeWrite arr n c+ go (n+w) (m+1)+ desc = "Data.Text.Encoding.decodeUtf8: Invalid UTF-8 stream"+{-# INLINE[0] decodeUtf8With #-} -- | Decode a 'ByteString' containing UTF-8 encoded text. decodeUtf8 :: ByteString -> Text decodeUtf8 = decodeUtf8With strictDecode-{-# INLINE decodeUtf8 #-}+{-# INLINE[0] decodeUtf8 #-} +{-# RULES "STREAM stream/decodeUtf8 fusion" [1]+ forall bs. F.stream (decodeUtf8 bs) = E.streamUtf8 strictDecode bs #-}+ -- | Encode text using UTF-8 encoding. encodeUtf8 :: Text -> ByteString-encodeUtf8 txt = E.unstream (E.restreamUtf8 (F.stream txt))-{-# INLINE encodeUtf8 #-}+encodeUtf8 (Text arr off len) = unsafePerformIO $ do+ let size0 = min len 4+ mallocByteString size0 >>= start size0 off 0+ where+ start size n0 m0 fp = withForeignPtr fp $ loop n0 m0+ where+ loop n1 m1 ptr = go n1 m1+ where+ go !n !m+ | n-off == len = return $! PS fp 0 m+ | size-m < 4 = {-# SCC "encodeUtf8/resize" #-} do+ let newSize = size `shiftL` 1+ fp' <- mallocByteString newSize+ withForeignPtr fp' $ \ptr' -> memcpy ptr' ptr (fromIntegral m)+ start newSize n m fp'+ | otherwise = do+ let poke8 k v = poke (ptr `plusPtr` k) (fromIntegral v :: Word8)+ w = A.unsafeIndex arr n+ case undefined of+ _| w <= 0x7F -> do+ poke8 m w+ go (n+1) (m+1)+ | w <= 0x7FF -> do+ poke8 m $ (w `shiftR` 6) + 0xC0+ poke8 (m+1) $ (w .&. 0x3f) + 0x80+ go (n+1) (m+2)+ | 0xD800 <= w && w <= 0xDBFF -> do+ let c = ord $ U16.chr2 w (A.unsafeIndex arr (n+1))+ poke8 m $ (c `shiftR` 18) + 0xF0+ poke8 (m+1) $ ((c `shiftR` 12) .&. 0x3F) + 0x80+ poke8 (m+2) $ ((c `shiftR` 6) .&. 0x3F) + 0x80+ poke8 (m+3) $ (c .&. 0x3F) + 0x80+ go (n+2) (m+4)+ | otherwise -> do+ poke8 m $ (w `shiftR` 12) + 0xE0+ poke8 (m+1) $ ((w `shiftR` 6) .&. 0x3F) + 0x80+ poke8 (m+2) $ (w .&. 0x3F) + 0x80+ go (n+1) (m+3)+{- INLINE encodeUtf8 #-} -- | Decode text from little endian UTF-16 encoding. decodeUtf16LEWith :: OnDecodeError -> ByteString -> Text
Data/Text/Encoding/Utf8.hs view
@@ -48,7 +48,7 @@ between x y z = x >= y && x <= z {-# INLINE between #-} -ord2 :: Char -> (Word8,Word8)+ord2 :: Char -> (Word8,Word8) ord2 c = #if defined(ASSERTS) assert (n >= 0x80 && n <= 0x07ff)@@ -59,7 +59,7 @@ x1 = fromIntegral $ (n `shiftR` 6) + 0xC0 x2 = fromIntegral $ (n .&. 0x3F) + 0x80 -ord3 :: Char -> (Word8,Word8,Word8)+ord3 :: Char -> (Word8,Word8,Word8) ord3 c = #if defined(ASSERTS) assert (n >= 0x0800 && n <= 0xffff)@@ -71,7 +71,7 @@ x2 = fromIntegral $ ((n `shiftR` 6) .&. 0x3F) + 0x80 x3 = fromIntegral $ (n .&. 0x3F) + 0x80 -ord4 :: Char -> (Word8,Word8,Word8,Word8)+ord4 :: Char -> (Word8,Word8,Word8,Word8) ord4 c = #if defined(ASSERTS) assert (n >= 0x10000)@@ -84,7 +84,7 @@ x3 = fromIntegral $ ((n `shiftR` 6) .&. 0x3F) + 0x80 x4 = fromIntegral $ (n .&. 0x3F) + 0x80 -chr2 :: Word8 -> Word8 -> Char+chr2 :: Word8 -> Word8 -> Char chr2 (W8# x1#) (W8# x2#) = C# (chr# (z1# +# z2#)) where !y1# = word2Int# x1#@@ -93,7 +93,7 @@ !z2# = y2# -# 0x80# {-# INLINE chr2 #-} -chr3 :: Word8 -> Word8 -> Word8 -> Char+chr3 :: Word8 -> Word8 -> Word8 -> Char chr3 (W8# x1#) (W8# x2#) (W8# x3#) = C# (chr# (z1# +# z2# +# z3#)) where !y1# = word2Int# x1#@@ -118,20 +118,17 @@ !z4# = y4# -# 0x80# {-# INLINE chr4 #-} -validate1 :: Word8 -> Bool+validate1 :: Word8 -> Bool validate1 x1 = x1 <= 0x7F {-# INLINE validate1 #-} -validate2 :: Word8 -> Word8 -> Bool+validate2 :: Word8 -> Word8 -> Bool validate2 x1 x2 = between x1 0xC2 0xDF && between x2 0x80 0xBF {-# INLINE validate2 #-} -validate3 :: Word8 -> Word8 -> Word8 -> Bool+validate3 :: Word8 -> Word8 -> Word8 -> Bool {-# INLINE validate3 #-}-validate3 x1 x2 x3 = validate3_1 ||- validate3_2 ||- validate3_3 ||- validate3_4+validate3 x1 x2 x3 = validate3_1 || validate3_2 || validate3_3 || validate3_4 where validate3_1 = (x1 == 0xE0) && between x2 0xA0 0xBF &&@@ -146,11 +143,9 @@ between x2 0x80 0xBF && between x3 0x80 0xBF -validate4 :: Word8 -> Word8 -> Word8 -> Word8 -> Bool+validate4 :: Word8 -> Word8 -> Word8 -> Word8 -> Bool {-# INLINE validate4 #-}-validate4 x1 x2 x3 x4 = validate4_1 ||- validate4_2 ||- validate4_3+validate4 x1 x2 x3 x4 = validate4_1 || validate4_2 || validate4_3 where validate4_1 = x1 == 0xF0 && between x2 0x90 0xBF &&
Data/Text/Foreign.hs view
@@ -20,6 +20,7 @@ -- * Safe conversion functions , fromPtr , useAsPtr+ , asForeignPtr -- * Unsafe conversion code , lengthWord16 , unsafeCopyToPtr@@ -39,6 +40,7 @@ import Data.Word (Word16) import Foreign.Marshal.Alloc (allocaBytes) import Foreign.Ptr (Ptr, castPtr, plusPtr)+import Foreign.ForeignPtr (ForeignPtr, mallocForeignPtrArray, withForeignPtr) import Foreign.Storable (peek, poke) -- $interop@@ -135,3 +137,10 @@ allocaBytes (len * 2) $ \buf -> do unsafeCopyToPtr t buf action (castPtr buf) (fromIntegral len)++-- | /O(n)/ Make a mutable copy of a 'Text'.+asForeignPtr :: Text -> IO (ForeignPtr Word16, I16)+asForeignPtr t@(Text _arr _off len) = do+ fp <- mallocForeignPtrArray len+ withForeignPtr fp $ unsafeCopyToPtr t+ return (fp, I16 len)
Data/Text/Fusion/Size.hs view
@@ -68,11 +68,17 @@ fromInteger = f where f = Exact . fromInteger {-# INLINE f #-} +add :: Int -> Int -> Int+add m n | mn > 0 = mn+ | otherwise = overflowError+ where mn = m + n+{-# INLINE add #-}+ addSize :: Size -> Size -> Size-addSize (Exact m) (Exact n) = Exact (m+n)-addSize (Exact m) (Max n) = Max (m+n)-addSize (Max m) (Exact n) = Max (m+n)-addSize (Max m) (Max n) = Max (m+n)+addSize (Exact m) (Exact n) = Exact (add m n)+addSize (Exact m) (Max n) = Max (add m n)+addSize (Max m) (Exact n) = Max (add m n)+addSize (Max m) (Max n) = Max (add m n) addSize _ _ = Unknown {-# INLINE addSize #-} @@ -85,11 +91,17 @@ subtractSize _ _ = Unknown {-# INLINE subtractSize #-} +mul :: Int -> Int -> Int+mul m n+ | m <= maxBound `div` n = m * n+ | otherwise = overflowError+{-# INLINE mul #-}+ mulSize :: Size -> Size -> Size-mulSize (Exact m) (Exact n) = Exact (m*n)-mulSize (Exact m) (Max n) = Max (m*n)-mulSize (Max m) (Exact n) = Max (m*n)-mulSize (Max m) (Max n) = Max (m*n)+mulSize (Exact m) (Exact n) = Exact (mul m n)+mulSize (Exact m) (Max n) = Max (mul m n)+mulSize (Max m) (Exact n) = Max (mul m n)+mulSize (Max m) (Max n) = Max (mul m n) mulSize _ _ = Unknown {-# INLINE mulSize #-} @@ -129,3 +141,6 @@ isEmpty (Max n) = n <= 0 isEmpty _ = False {-# INLINE isEmpty #-}++overflowError :: Int+overflowError = error "Data.Text.Fusion.Size: size overflow"
Data/Text/Lazy.hs view
@@ -174,8 +174,8 @@ ) where import Prelude (Char, Bool(..), Maybe(..), String,- Eq(..), Ord(..), Ordering, Read(..), Show(..),- (&&), (+), (-), (.), ($), (++),+ Eq(..), Ord(..), Ordering(..), Read(..), Show(..),+ (&&), (||), (+), (-), (.), ($), (++), div, error, flip, fromIntegral, not, otherwise) import qualified Prelude as P #if defined(HAVE_DEEPSEQ)@@ -204,8 +204,22 @@ import qualified Data.Text.Util as U import Data.Text.Lazy.Search (indices) +equal :: Text -> Text -> Bool+equal Empty Empty = True+equal Empty _ = False+equal _ Empty = False+equal (Chunk a as) (Chunk b bs) =+ case compare lenA lenB of+ LT -> a == (T.takeWord16 lenA b) &&+ as `equal` Chunk (T.dropWord16 lenA b) bs+ EQ -> a == b && as `equal` bs+ GT -> T.takeWord16 lenB a == b &&+ Chunk (T.dropWord16 lenB a) as `equal` bs+ where lenA = T.lengthWord16 a+ lenB = T.lengthWord16 b+ instance Eq Text where- t1 == t2 = stream t1 == stream t2+ (==) = equal {-# INLINE (==) #-} instance Ord Text where@@ -332,10 +346,10 @@ -- | /O(1)/ Returns the first character and rest of a 'Text', or -- 'Nothing' if empty. Subject to array fusion. uncons :: Text -> Maybe (Char, Text)-uncons Empty = Nothing-uncons (Chunk t ts) =- Just (T.unsafeHead t,- if T.length t == 1 then ts else Chunk (T.unsafeTail t) ts)+uncons Empty = Nothing+uncons (Chunk t ts) = Just (T.unsafeHead t, ts')+ where ts' | T.compareLength t 1 == EQ = ts+ | otherwise = Chunk (T.unsafeTail t) ts {-# INLINE uncons #-} -- | /O(1)/ Returns the first character of a 'Text', which must be@@ -721,9 +735,12 @@ -- | /O(n*m)/ 'replicate' @n@ @t@ is a 'Text' consisting of the input -- @t@ repeated @n@ times. replicate :: Int64 -> Text -> Text-replicate n t = concat (rep 0)- where rep i | i >= n = []- | otherwise = t : rep (i+1)+replicate n t+ | null t || n <= 0 = empty+ | isSingleton t = replicateChar n (head t)+ | otherwise = concat (rep 0)+ where rep !i | i >= n = []+ | otherwise = t : rep (i+1) {-# INLINE replicate #-} -- | /O(n)/ 'replicateChar' @n@ @c@ is a 'Text' of length @n@ with @c@ the
Data/Text/Lazy/Encoding.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE BangPatterns #-} -- | -- Module : Data.Text.Lazy.Encoding -- Copyright : (c) 2009, 2010 Bryan O'Sullivan@@ -38,32 +39,73 @@ , encodeUtf32BE ) where -import qualified Data.ByteString.Lazy as B+import Data.Bits ((.&.)) import Data.Text.Encoding.Error (OnDecodeError, strictDecode)+import Data.Text.Lazy.Internal (Text(..), chunk, empty, foldrChunks)+import qualified Data.ByteString as S+import qualified Data.ByteString.Lazy as B+import qualified Data.ByteString.Lazy.Internal as B+import qualified Data.ByteString.Unsafe as S+import qualified Data.Text as T import qualified Data.Text.Encoding as TE-import qualified Data.Text.Lazy.Fusion as F-import Data.Text.Lazy.Internal (Text(..), chunk, foldrChunks) import qualified Data.Text.Lazy.Encoding.Fusion as E+import qualified Data.Text.Lazy.Fusion as F -- | Decode a 'ByteString' containing 7-bit ASCII encoded text. decodeASCII :: B.ByteString -> Text-decodeASCII bs = foldr (chunk . TE.decodeASCII) Empty (B.toChunks bs)+decodeASCII bs = foldr (chunk . TE.decodeASCII) empty (B.toChunks bs) {-# INLINE decodeASCII #-} -- | Decode a 'ByteString' containing UTF-8 encoded text. decodeUtf8With :: OnDecodeError -> B.ByteString -> Text-decodeUtf8With onErr bs = F.unstream (E.streamUtf8 onErr bs)-{-# INLINE decodeUtf8With #-}+decodeUtf8With onErr bs0 = fast bs0+ where+ decode = TE.decodeUtf8With onErr+ fast (B.Chunk p ps) | isComplete p = chunk (decode p) (fast ps)+ | otherwise = chunk (decode h) (slow t ps)+ where (h,t) = S.splitAt pivot p+ pivot | at 1 = len-1+ | at 2 = len-2+ | otherwise = len-3+ len = S.length p+ at n = len >= n && S.unsafeIndex p (len-n) .&. 0xc0 == 0xc0+ fast B.Empty = empty+ slow i bs = {-# SCC "decodeUtf8With'/slow" #-}+ case B.uncons bs of+ Just (w,bs') | isComplete i' -> chunk (decode i') (fast bs')+ | otherwise -> slow i' bs'+ where i' = S.snoc i w+ Nothing -> case S.uncons i of+ Just (j,i') ->+ case onErr desc (Just j) of+ Nothing -> slow i' bs+ Just c -> Chunk (T.singleton c) (slow i' bs)+ Nothing ->+ case onErr desc Nothing of+ Nothing -> empty+ Just c -> Chunk (T.singleton c) empty+ isComplete bs = {-# SCC "decodeUtf8With'/isComplete" #-}+ ix 1 .&. 0x80 == 0 ||+ (len >= 2 && ix 2 .&. 0xe0 == 0xc0) ||+ (len >= 3 && ix 3 .&. 0xf0 == 0xe0) ||+ (len >= 4 && ix 4 .&. 0xf8 == 0xf0)+ where len = S.length bs+ ix n = S.unsafeIndex bs (len-n)+ desc = "Data.Text.Lazy.Encoding.decodeUtf8With: Invalid UTF-8 stream"+{-# INLINE[0] decodeUtf8With #-} -- | Decode a 'ByteString' containing UTF-8 encoded text. decodeUtf8 :: B.ByteString -> Text decodeUtf8 = decodeUtf8With strictDecode-{-# INLINE decodeUtf8 #-}+{-# INLINE[0] decodeUtf8 #-} --- | Encode text using UTF-8 encoding.+-- This rule seems to cause performance loss.+{- RULES "LAZY STREAM stream/decodeUtf8' fusion" [1]+ forall bs. F.stream (decodeUtf8' bs) = E.streamUtf8 strictDecode bs #-}+ encodeUtf8 :: Text -> B.ByteString-encodeUtf8 txt = E.unstream (E.restreamUtf8 (F.stream txt))-{-# INLINE encodeUtf8 #-}+encodeUtf8 (Chunk c cs) = B.Chunk (TE.encodeUtf8 c) (encodeUtf8 cs)+encodeUtf8 Empty = B.Empty -- | Decode text from little endian UTF-16 encoding. decodeUtf16LEWith :: OnDecodeError -> B.ByteString -> Text
Data/Text/Lazy/Fusion.hs view
@@ -25,7 +25,7 @@ import Prelude hiding (length) import qualified Data.Text.Fusion.Common as S import Data.Text.Fusion.Internal-import Data.Text.Fusion.Size (isEmpty)+import Data.Text.Fusion.Size (isEmpty, unknownSize) import Data.Text.Lazy.Internal import qualified Data.Text.Internal as I import qualified Data.Text.Array as A@@ -38,7 +38,7 @@ -- | /O(n)/ Convert a 'Text' into a 'Stream Char'. stream :: Text -> Stream Char-stream text = Stream next (text :*: 0) 4 -- random HINT+stream text = Stream next (text :*: 0) unknownSize where next (Empty :*: _) = Done next (txt@(Chunk t@(I.Text _ _ len) ts) :*: i)@@ -54,7 +54,8 @@ | isEmpty len0 = Empty | otherwise = outer s0 where- outer s = case next s of+ outer s = {-# SCC "unstreamChunks/outer" #-}+ case next s of Done -> Empty Skip s' -> outer s' Yield x s' -> I.Text arr 0 len `chunk` outer s''@@ -64,12 +65,13 @@ unknownLength = 4 inner marr len s !i | i + 1 >= chunkSize = return (marr, (s,i))- | i + 1 >= len = do+ | i + 1 >= len = {-# SCC "unstreamChunks/resize" #-} do let newLen = min (len `shiftL` 1) chunkSize marr' <- A.new newLen A.copyM marr' 0 marr 0 len inner marr' newLen s i | otherwise =+ {-# SCC "unstreamChunks/inner" #-} case next s of Done -> return (marr,(s,i)) Skip s' -> inner marr len s' i
Data/Text/Lazy/Internal.hs view
@@ -33,11 +33,11 @@ , chunkOverhead ) where -import qualified Data.Text.Internal as T import Data.Text ()-import Data.Text.UnsafeShift+import Data.Text.UnsafeShift (shiftL) import Data.Typeable (Typeable) import Foreign.Storable (sizeOf)+import qualified Data.Text.Internal as T data Text = Empty | Chunk {-# UNPACK #-} !T.Text Text
+ Data/Text/Lazy/Read.hs view
@@ -0,0 +1,159 @@+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module : Data.Text.Lazy.Read+-- Copyright : (c) 2010 Bryan O'Sullivan+--+-- License : BSD-style+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,+-- duncan@haskell.org+-- Stability : experimental+-- Portability : GHC+--+-- Functions used frequently when reading textual data.+module Data.Text.Lazy.Read+ (+ Reader+ , decimal+ , hexadecimal+ , signed+ , rational+ , double+ ) where++import Control.Monad (liftM)+import Data.Char (digitToInt, isDigit, isHexDigit, ord)+import Data.Ratio+import Data.Text.Lazy as T++-- | Read some text, and if the read succeeds, return its value and+-- the remaining text.+type Reader a = Text -> Either String (a,Text)++-- | Read a decimal integer.+--+-- This function does not handle leading sign characters. If you need+-- to handle signed input, use @'signed' 'decimal'@.+decimal :: Integral a => Reader a+{-# SPECIALIZE decimal :: Reader Int #-}+{-# SPECIALIZE decimal :: Reader Integer #-}+decimal txt+ | T.null h = Left "no digits in input"+ | otherwise = Right (T.foldl' go 0 h, t)+ where (h,t) = T.spanBy isDigit txt+ go n d = (n * 10 + fromIntegral (digitToInt d))++-- | Read a hexadecimal number, with optional leading @\"0x\"@. This+-- function is case insensitive.+--+-- This function does not handle leading sign characters. If you need+-- to handle signed input, use @'signed' 'hexadecimal'@.+hexadecimal :: Integral a => Reader a+{-# SPECIALIZE hex :: Reader Int #-}+{-# SPECIALIZE hex :: Reader Integer #-}+hexadecimal txt+ | T.toLower h == "0x" = hex t+ | otherwise = hex txt+ where (h,t) = T.splitAt 2 txt++-- | Read a leading sign character (@\'-\'@ or @\'+\'@) and apply it+-- to the result of applying the given reader.+signed :: Num a => Reader a -> Reader a+{-# INLINE signed #-}+signed f = runP (signa (P f))++-- | Read a rational number.+--+-- This function accepts an optional leading sign character.+rational :: RealFloat a => Reader a+{-# SPECIALIZE rational :: Reader Double #-}+rational = floaty $ \real frac fracDenom -> fromRational $+ real % 1 + frac % fracDenom++-- | Read a rational number.+--+-- This function accepts an optional leading sign character.+--+-- /Note/: This function is almost ten times faster than 'rational',+-- but is slightly less accurate.+--+-- The 'Double' type supports about 16 decimal places of accuracy.+-- For 94.2% of numbers, this function and 'rational' give identical+-- results, but for the remaining 5.8%, this function loses precision+-- around the 15th decimal place. For 0.001% of numbers, this+-- function will lose precision at the 13th or 14th decimal place.+double :: Reader Double+double = floaty $ \real frac fracDenom ->+ fromIntegral real ++ fromIntegral frac / fromIntegral fracDenom++hex :: Integral a => Reader a+{-# SPECIALIZE hex :: Reader Int #-}+{-# SPECIALIZE hex :: Reader Integer #-}+hex txt+ | T.null h = Left "no digits in input"+ | otherwise = Right (T.foldl' go 0 h, t)+ where (h,t) = T.spanBy isHexDigit txt+ go n d = (n * 16 + fromIntegral (hexDigitToInt d))++hexDigitToInt :: Char -> Int+hexDigitToInt c+ | c >= '0' && c <= '9' = ord c - ord '0'+ | c >= 'a' && c <= 'f' = ord c - (ord 'a' - 10)+ | c >= 'A' && c <= 'F' = ord c - (ord 'A' - 10)+ | otherwise = error "Data.Text.Lex.hexDigitToInt: bad input"++signa :: Num a => Parser a -> Parser a+{-# SPECIALIZE signa :: Parser Int -> Parser Int #-}+{-# SPECIALIZE signa :: Parser Integer -> Parser Integer #-}+signa p = do+ sign <- perhaps '+' $ char (\c -> c == '-' || c == '+')+ if sign == '+' then p else negate `liftM` p++newtype Parser a = P {+ runP :: Text -> Either String (a,Text)+ }++instance Monad Parser where+ return a = P $ \t -> Right (a,t)+ {-# INLINE return #-}+ m >>= k = P $ \t -> case runP m t of+ Left err -> Left err+ Right (a,t') -> runP (k a) t'+ {-# INLINE (>>=) #-}+ fail msg = P $ \_ -> Left msg++perhaps :: a -> Parser a -> Parser a+perhaps def m = P $ \t -> case runP m t of+ Left _ -> Right (def,t)+ r@(Right _) -> r++char :: (Char -> Bool) -> Parser Char+char p = P $ \t -> case T.uncons t of+ Just (c,t') | p c -> Right (c,t')+ _ -> Left "char"++data T = T !Integer !Int++floaty :: RealFloat a => (Integer -> Integer -> Integer -> a) -> Reader a+{-# INLINE floaty #-}+floaty f = runP $ do+ sign <- perhaps '+' $ char (\c -> c == '-' || c == '+')+ real <- P decimal+ T fraction fracDigits <- perhaps (T 0 0) $ do+ _ <- char (=='.')+ digits <- P $ \t -> Right (fromIntegral . T.length $ T.takeWhile isDigit t, t)+ n <- P decimal+ return $ T n digits+ let e c = c == 'e' || c == 'E'+ power <- perhaps 0 (char e >> signa (P decimal) :: Parser Int)+ let n = if fracDigits == 0+ then if power == 0+ then fromIntegral real+ else fromIntegral real * (10 ^^ power)+ else if power == 0+ then f real fraction (10 ^ fracDigits)+ else f real fraction (10 ^ fracDigits) * (10 ^^ power)+ return $! if sign == '+'+ then n+ else -n
+ Data/Text/Read.hs view
@@ -0,0 +1,159 @@+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module : Data.Text.Read+-- Copyright : (c) 2010 Bryan O'Sullivan+--+-- License : BSD-style+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,+-- duncan@haskell.org+-- Stability : experimental+-- Portability : GHC+--+-- Functions used frequently when reading textual data.+module Data.Text.Read+ (+ Reader+ , decimal+ , hexadecimal+ , signed+ , rational+ , double+ ) where++import Control.Monad (liftM)+import Data.Char (digitToInt, isDigit, isHexDigit, ord)+import Data.Ratio+import Data.Text as T++-- | Read some text, and if the read succeeds, return its value and+-- the remaining text.+type Reader a = Text -> Either String (a,Text)++-- | Read a decimal integer.+--+-- This function does not handle leading sign characters. If you need+-- to handle signed input, use @'signed' 'decimal'@.+decimal :: Integral a => Reader a+{-# SPECIALIZE decimal :: Reader Int #-}+{-# SPECIALIZE decimal :: Reader Integer #-}+decimal txt+ | T.null h = Left "no digits in input"+ | otherwise = Right (T.foldl' go 0 h, t)+ where (h,t) = T.spanBy isDigit txt+ go n d = (n * 10 + fromIntegral (digitToInt d))++-- | Read a hexadecimal number, with optional leading @\"0x\"@. This+-- function is case insensitive.+--+-- This function does not handle leading sign characters. If you need+-- to handle signed input, use @'signed' 'hexadecimal'@.+hexadecimal :: Integral a => Reader a+{-# SPECIALIZE hex :: Reader Int #-}+{-# SPECIALIZE hex :: Reader Integer #-}+hexadecimal txt+ | T.toLower h == "0x" = hex t+ | otherwise = hex txt+ where (h,t) = T.splitAt 2 txt++-- | Read a leading sign character (@\'-\'@ or @\'+\'@) and apply it+-- to the result of applying the given reader.+signed :: Num a => Reader a -> Reader a+{-# INLINE signed #-}+signed f = runP (signa (P f))++-- | Read a rational number.+--+-- This function accepts an optional leading sign character.+rational :: RealFloat a => Reader a+{-# SPECIALIZE rational :: Reader Double #-}+rational = floaty $ \real frac fracDenom -> fromRational $+ real % 1 + frac % fracDenom++-- | Read a rational number.+--+-- This function accepts an optional leading sign character.+--+-- /Note/: This function is almost ten times faster than 'rational',+-- but is slightly less accurate.+--+-- The 'Double' type supports about 16 decimal places of accuracy.+-- For 94.2% of numbers, this function and 'rational' give identical+-- results, but for the remaining 5.8%, this function loses precision+-- around the 15th decimal place. For 0.001% of numbers, this+-- function will lose precision at the 13th or 14th decimal place.+double :: Reader Double+double = floaty $ \real frac fracDenom ->+ fromIntegral real ++ fromIntegral frac / fromIntegral fracDenom++hex :: Integral a => Reader a+{-# SPECIALIZE hex :: Reader Int #-}+{-# SPECIALIZE hex :: Reader Integer #-}+hex txt+ | T.null h = Left "no digits in input"+ | otherwise = Right (T.foldl' go 0 h, t)+ where (h,t) = T.spanBy isHexDigit txt+ go n d = (n * 16 + fromIntegral (hexDigitToInt d))++hexDigitToInt :: Char -> Int+hexDigitToInt c+ | c >= '0' && c <= '9' = ord c - ord '0'+ | c >= 'a' && c <= 'f' = ord c - (ord 'a' - 10)+ | c >= 'A' && c <= 'F' = ord c - (ord 'A' - 10)+ | otherwise = error "Data.Text.Lex.hexDigitToInt: bad input"++signa :: Num a => Parser a -> Parser a+{-# SPECIALIZE signa :: Parser Int -> Parser Int #-}+{-# SPECIALIZE signa :: Parser Integer -> Parser Integer #-}+signa p = do+ sign <- perhaps '+' $ char (\c -> c == '-' || c == '+')+ if sign == '+' then p else negate `liftM` p++newtype Parser a = P {+ runP :: Text -> Either String (a,Text)+ }++instance Monad Parser where+ return a = P $ \t -> Right (a,t)+ {-# INLINE return #-}+ m >>= k = P $ \t -> case runP m t of+ Left err -> Left err+ Right (a,t') -> runP (k a) t'+ {-# INLINE (>>=) #-}+ fail msg = P $ \_ -> Left msg++perhaps :: a -> Parser a -> Parser a+perhaps def m = P $ \t -> case runP m t of+ Left _ -> Right (def,t)+ r@(Right _) -> r++char :: (Char -> Bool) -> Parser Char+char p = P $ \t -> case T.uncons t of+ Just (c,t') | p c -> Right (c,t')+ _ -> Left "char"++data T = T !Integer !Int++floaty :: RealFloat a => (Integer -> Integer -> Integer -> a) -> Reader a+{-# INLINE floaty #-}+floaty f = runP $ do+ sign <- perhaps '+' $ char (\c -> c == '-' || c == '+')+ real <- P decimal+ T fraction fracDigits <- perhaps (T 0 0) $ do+ _ <- char (=='.')+ digits <- P $ \t -> Right (T.length $ T.takeWhile isDigit t, t)+ n <- P decimal+ return $ T n digits+ let e c = c == 'e' || c == 'E'+ power <- perhaps 0 (char e >> signa (P decimal) :: Parser Int)+ let n = if fracDigits == 0+ then if power == 0+ then fromIntegral real+ else fromIntegral real * (10 ^^ power)+ else if power == 0+ then f real fraction (10 ^ fracDigits)+ else f real fraction (10 ^ fracDigits) * (10 ^^ power)+ return $! if sign == '+'+ then n+ else -n
Data/Text/Unsafe.hs view
@@ -21,6 +21,8 @@ , unsafeHead , unsafeTail , lengthWord16+ , takeWord16+ , dropWord16 ) where #if defined(ASSERTS)@@ -132,3 +134,13 @@ lengthWord16 :: Text -> Int lengthWord16 (Text _arr _off len) = len {-# INLINE lengthWord16 #-}++-- | /O(1)/ Unchecked take of 'k' 'Word16's from the front of a 'Text'.+takeWord16 :: Int -> Text -> Text+takeWord16 k (Text arr off _len) = Text arr off k+{-# INLINE takeWord16 #-}++-- | /O(1)/ Unchecked drop of 'k' 'Word16's from the front of a 'Text'.+dropWord16 :: Int -> Text -> Text+dropWord16 k (Text arr off len) = Text arr (off+k) (len-k)+{-# INLINE dropWord16 #-}
− README
@@ -1,43 +0,0 @@-Text: Fast, packed Unicode strings, using stream fusion----------------------------------------------------------This package provides the Data.Text library, a library for the space--and time-efficient manipulation of Unicode text in Haskell.---Normalization, conversion, and collation, oh my!---------------------------------------------------This library intentionally provides a simple API based on the Haskell-prelude's list manipulation functions. For more complicated-real-world tasks, such as Unicode normalization, conversion to and-from a larger variety of encodings, and collation, use the text-icu-package:-- http://hackage.haskell.org/cgi-bin/hackage-scripts/package/text-icu--That library uses the well-respected and liberally licensed ICU-library to provide these facilities.---Source code--------------darcs get http://code.haskell.org/text---Reporting bugs, asking for enhancements------------------------------------------http://trac.haskell.org/text/---Authors----------The base code for this library was originally written by Tom Harper,-based on the stream fusion framework developed by Roman Leshchinskiy,-Duncan Coutts, and Don Stewart.--The core library was fleshed out, debugged, and tested by Bryan-O'Sullivan, and he is the current maintainer.
+ README.markdown view
@@ -0,0 +1,42 @@+# Text: Fast, packed Unicode strings, using stream fusion++This package provides the Data.Text library, a library for the space-+and time-efficient manipulation of Unicode text in Haskell.+++# Normalization, conversion, and collation, oh my!++This library intentionally provides a simple API based on the+Haskell prelude's list manipulation functions. For more complicated+real-world tasks, such as Unicode normalization, conversion to and+from a larger variety of encodings, and collation, use the [text-icu+package](http://hackage.haskell.org/cgi-bin/hackage-scripts/package/text-icu).++That library uses the well-respected and liberally licensed ICU+library to provide these facilities.+++# Get involved!++Please report bugs via the+[bitbucket issue tracker](http://bitbucket.org/bos/attoparsec/statistics).++Master [Mercurial repository](http://bitbucket.org/bos/statistics):++* `hg clone http://bitbucket.org/bos/statistics`++There's also a [git mirror](http://github.com/bos/statistics):++* `git clone git://github.com/bos/statistics.git`++(You can create and contribute changes using either Mercurial or git.)+++# Authors++The base code for this library was originally written by Tom Harper,+based on the stream fusion framework developed by Roman Leshchinskiy,+Duncan Coutts, and Don Stewart.++The core library was fleshed out, debugged, and tested by Bryan+O'Sullivan <bos@serpentine.com>, and he is the current maintainer.
scripts/ApiCompare.hs view
@@ -17,8 +17,12 @@ S.difference a b text <- tidy "Data.Text" lazy <- tidy "Data.Text.Lazy"- putStrLn "In Data.Text:"+ list <- tidy "Data.List"+ putStrLn "Text \\ List:"+ diff text list+ putStrLn ""+ putStrLn "Text \\ Lazy:" diff text lazy putStrLn ""- putStrLn "In Data.Text.Lazy:"+ putStrLn "Lazy \\ Text:" diff lazy text
tests/Properties.hs view
@@ -7,7 +7,8 @@ import Text.Show.Functions () import qualified Data.Bits as Bits (shiftL, shiftR)-import Data.Char (chr, isLower, isSpace, isUpper, ord)+import Numeric (showHex)+import Data.Char (chr, isDigit, isHexDigit, isLower, isSpace, isUpper, ord) import Data.Monoid (Monoid(..)) import Data.String (fromString) import Debug.Trace (trace)@@ -21,6 +22,8 @@ import qualified Data.Text.Lazy.Internal as TL import qualified Data.Text.Lazy.Builder as TB import qualified Data.Text.Encoding as E+import Data.Text.Read as T+import Data.Text.Lazy.Read as TL import Data.Text.Encoding.Error import Control.Exception (SomeException, bracket, catch, evaluate, try) import Data.Text.Foreign@@ -658,6 +661,42 @@ b2 = TB.fromText (packS s2) b3 = TB.fromText (packS s3) +-- Reading.++t_decimal (n::Int) s =+ T.signed T.decimal (T.pack (show n) `T.append` t) == Right (n,t)+ where t = T.dropWhile isDigit s+tl_decimal (n::Int) s =+ TL.signed TL.decimal (TL.pack (show n) `TL.append` t) == Right (n,t)+ where t = TL.dropWhile isDigit s+t_hexadecimal (n::Positive Int) s ox =+ T.hexadecimal (T.concat [p, T.pack (showHex n ""), t]) == Right (n,t)+ where t = T.dropWhile isHexDigit s+ p = if ox then "0x" else ""+tl_hexadecimal (n::Positive Int) s ox =+ TL.hexadecimal (TL.concat [p, TL.pack (showHex n ""), t]) == Right (n,t)+ where t = TL.dropWhile isHexDigit s+ p = if ox then "0x" else ""++isFloaty c = c `elem` "+-.0123456789eE"++t_read_rational p tol (n::Double) s =+ case p (T.pack (show n) `T.append` t) of+ Left err -> False+ Right (n',t') -> t == t' && abs (n-n') <= tol+ where t = T.dropWhile isFloaty s++tl_read_rational p tol (n::Double) s =+ case p (TL.pack (show n) `TL.append` t) of+ Left err -> False+ Right (n',t') -> t == t' && abs (n-n') <= tol+ where t = TL.dropWhile isFloaty s++t_double = t_read_rational T.double 1e-13+tl_double = tl_read_rational TL.double 1e-13+t_rational = t_read_rational T.rational 1e-16+tl_rational = tl_read_rational TL.rational 1e-16+ -- Input and output. -- Work around lack of Show instance for TextEncoding.@@ -1137,6 +1176,17 @@ testProperty "t_builderSingleton" t_builderSingleton, testProperty "t_builderFromText" t_builderFromText, testProperty "t_builderAssociative" t_builderAssociative+ ],++ testGroup "read" [+ testProperty "t_decimal" t_decimal,+ testProperty "tl_decimal" tl_decimal,+ testProperty "t_hexadecimal" t_hexadecimal,+ testProperty "tl_hexadecimal" tl_hexadecimal,+ testProperty "t_double" t_double,+ testProperty "tl_double" tl_double,+ testProperty "t_rational" t_rational,+ testProperty "tl_rational" tl_rational ], testGroup "input-output" [
tests/QuickCheckUtils.hs view
@@ -9,6 +9,7 @@ import Data.Word (Word8, Word16, Word32) import Data.String (IsString, fromString) import qualified Data.Text as T+import Data.Text.Foreign (I16) import qualified Data.Text.Lazy as TL import System.Random (Random(..), RandomGen) import Test.QuickCheck hiding ((.&.))@@ -21,6 +22,13 @@ instance Arbitrary Int64 where arbitrary = choose (minBound,maxBound) +instance Random I16 where+ randomR = integralRandomR+ random = randomR (minBound,maxBound)++instance Arbitrary I16 where+ arbitrary = choose (minBound,maxBound)+ instance Random Word8 where randomR = integralRandomR random = randomR (minBound,maxBound)@@ -137,8 +145,8 @@ | S24 | S25 | S26 | S27 | S28 | S29 | S30 | S31 deriving (Eq, Ord, Enum, Bounded) -small :: Small -> Int-small = fromEnum+small :: Integral a => Small -> a+small = fromIntegral . fromEnum intf f a b = toEnum ((fromEnum a `f` fromEnum b) `mod` 32)
+ tests/benchmarks/DecodeUtf8.hs view
@@ -0,0 +1,107 @@+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as BL+import qualified Data.Text as T+import qualified Data.Text.IO as T+import qualified Data.Text.Encoding as T+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Encoding as TL+import qualified Data.Text.Lazy.IO as TL+import qualified Codec.Binary.UTF8.Generic as U8+import Control.DeepSeq+import System.Environment+import System.IO++strict h = do+ bs <- B.hGetContents h+ rnf (T.decodeUtf8 bs) `seq` return ()++strict_len h = do+ bs <- B.hGetContents h+ print . T.length . T.decodeUtf8 $ bs++strict_init_len h = do+ bs <- B.hGetContents h+ print . T.length . T.init . T.decodeUtf8 $ bs++strict_io h = do+ hSetEncoding h utf8+ t <- T.hGetContents h+ rnf t `seq` return ()++strict_len_io h = do+ hSetEncoding h utf8+ t <- T.hGetContents h+ print (T.length t)++lazy h = do+ bs <- BL.hGetContents h+ rnf (TL.decodeUtf8 bs) `seq` return ()++lazy_len h = do+ bs <- BL.hGetContents h+ print . TL.length . TL.decodeUtf8 $ bs++lazy_init_len h = do+ bs <- BL.hGetContents h+ print . TL.length . TL.init . TL.decodeUtf8 $ bs++lazy_io h = do+ hSetEncoding h utf8+ t <- TL.hGetContents h+ rnf t `seq` return ()++lazy_len_io h = do+ hSetEncoding h utf8+ t <- TL.hGetContents h+ print (TL.length t)++string h = do+ hSetEncoding h utf8+ t <- hGetContents h+ rnf t `seq` return ()++string_len h = do+ hSetEncoding h utf8+ t <- hGetContents h+ print (length t)++lazy_string_utf8 h = do+ bs <- BL.hGetContents h+ let t = U8.toString bs+ rnf t `seq` return ()++lazy_string_utf8_len h = do+ bs <- BL.hGetContents h+ let t = U8.toString bs+ print (length t)++strict_string_utf8 h = do+ bs <- B.hGetContents h+ let t = U8.toString bs+ rnf t `seq` return ()++strict_string_utf8_len h = do+ bs <- B.hGetContents h+ let t = U8.toString bs+ print (length t)++main = do+ [kind,name] <- getArgs+ h <- openFile name ReadMode+ case kind of+ "strict" -> strict h+ "strict_len" -> strict_len h+ "strict_init_len" -> strict_init_len h+ "strict_io" -> strict_io h+ "strict_len_io" -> strict_len_io h+ "lazy" -> lazy h+ "lazy_len" -> lazy_len h+ "lazy_init_len" -> lazy_init_len h+ "lazy_io" -> lazy_io h+ "lazy_len_io" -> lazy_len_io h+ "string" -> string h+ "string_len" -> string_len h+ "lazy_string_utf8" -> lazy_string_utf8 h+ "lazy_string_utf8_len" -> lazy_string_utf8_len h+ "strict_string_utf8" -> strict_string_utf8 h+ "strict_string_utf8_len" -> strict_string_utf8_len h
+ tests/benchmarks/EncodeUtf8.hs view
@@ -0,0 +1,55 @@+{-# LANGUAGE OverloadedStrings #-}+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as BL+import qualified Data.Text as T+import qualified Data.Text.IO as T+import qualified Data.Text.Encoding as T+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Encoding as TL+import qualified Data.Text.Lazy.IO as TL+import qualified Codec.Binary.UTF8.Generic as U8+import System.Environment+import System.IO++strict_bytestring k s = do+ let t = T.replicate k (T.pack s)+ B.putStr (T.encodeUtf8 t)++lazy_bytestring k s = do+ let t = TL.replicate (fromIntegral k) (TL.pack s)+ BL.putStr (TL.encodeUtf8 t)++strict_io k s = do+ let t = T.replicate k (T.pack s)+ hSetEncoding stdout utf8+ T.putStr t++lazy_io k s = do+ let t = TL.replicate (fromIntegral k) (TL.pack s)+ hSetEncoding stdout utf8+ TL.putStr t++string k s = do+ let t = concat $ replicate k s+ hSetEncoding stdout utf8+ putStr t++lazy_string_utf8 k s = do+ let t = concat $ replicate k s+ BL.putStr (U8.fromString t)++strict_string_utf8 k s = do+ let t = concat $ replicate k s+ B.putStr (U8.fromString t)++main = do+ [kind,str,kstr] <- getArgs+ let k = read kstr * 1000000+ case kind of+ "strict" -> strict_bytestring k str+ "lazy" -> lazy_bytestring k str+ "strict_io" -> strict_io k str+ "lazy_io" -> lazy_io k str+ "string" -> string k str+ "lazy_string_utf8" -> lazy_string_utf8 k str+ "strict_string_utf8" -> strict_string_utf8 k str
+ tests/benchmarks/Equality.hs view
@@ -0,0 +1,36 @@+import System.Environment+import qualified Data.ByteString.Char8 as B+import qualified Data.ByteString.Lazy.Char8 as BL+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Encoding as TL++bytestring haystack = do+ ls <- B.lines `fmap` B.readFile haystack+ print . sum . map (\needle -> length . filter (==needle) $ ls) $ take 100 ls++lazyBytestring haystack = do+ ls <- BL.lines `fmap` BL.readFile haystack+ print . sum . map (\needle -> length . filter (==needle) $ ls) $ take 100 ls++text haystack = do+ ls <- (T.lines . T.decodeUtf8) `fmap` B.readFile haystack+ print . sum . map (\needle -> length . filter (==needle) $ ls) $ take 100 ls++lazyText haystack = do+ ls <- (TL.lines . TL.decodeUtf8) `fmap` BL.readFile haystack+ print . sum . map (\needle -> length . filter (==needle) $ ls) $ take 100 ls++string haystack = do+ ls <- lines `fmap` readFile haystack+ print . sum . map (\needle -> length . filter (==needle) $ ls) $ take 100 ls++main = do+ args <- getArgs+ case args of+ ["bs",h] -> bytestring h+ ["lazybs",h] -> lazyBytestring h+ ["text",h] -> text h+ ["lazytext",h] -> lazyText h+ ["string",h] -> string h
+ tests/benchmarks/ReplaceTags.hs view
@@ -0,0 +1,91 @@+-- Contributed by Ken Friis Larsen and Morten Ib Nielsen.++{-# LANGUAGE BangPatterns #-}+module Main (main) where++import System.Environment (getArgs)+import qualified Char++import qualified Data.Text as T+import qualified Data.Text.IO as T++import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.IO as TL+import qualified Data.ByteString.Lazy as BL+import qualified Data.Text.Lazy.Encoding as TLE+++import qualified Data.ByteString.Char8 as BC+import qualified Data.ByteString as B+import qualified Data.Text.Encoding as TE++replaceTagsM file tag sub = + BC.readFile file >>= BC.putStr . replaceTags tag sub . TE.encodeUtf8 . T.toLower . TE.decodeUtf8 + where + replaceTags tag replacement str = B.concat $ reverse $ replaceTags' [] (BC.pack $ '<' : tag) '>' (BC.pack replacement) str+ replaceTags' !res start end repl str =+ let (pre, post) = BC.breakSubstring start str+ in if BC.null post+ then pre : res+ else replaceTags' (repl : pre : res) start end repl $ BC.drop 1 $+ BC.dropWhile (/= end) post++splitB sep str = seplen `seq` splitter str + where + splitter str = h : if B.null t then [] else splitter (B.drop seplen t)+ where (h,t) = B.breakSubstring sep str+ seplen = B.length sep+ +replaceTagsWrong file tagName sub = do+ content <- BC.readFile file+ let frags = map (BC.drop 1 . BC.dropWhile (/= '>')) + $ splitB (BC.pack $ '<' : tagName) (BC.map Char.toLower content)+ BC.putStr $ BC.intercalate (BC.pack sub) frags+ +replaceTagsK file tagName sub = do+ raw <- BC.readFile file + let content = (TE.encodeUtf8 . T.toLower . TE.decodeUtf8) raw+ let frags = map (BC.drop 1 . BC.dropWhile (/= '>')) + $ splitB (BC.pack $ '<' : tagName) content+ BC.putStr $ BC.intercalate (BC.pack sub) frags++replaceTagsO file tagName sub = do+ raw <- BC.readFile file + let content = (TE.encodeUtf8 . T.toLower . TE.decodeUtf8) raw+ let frags = splitB (BC.pack $ '<' : tagName) content+ BC.putStr $ BC.intercalate (BC.pack sub) frags+ where + splitB sep str = splitter str + where + splitter str = h : if BC.null t then [] else splitter (BC.drop 1 $ BC.dropWhile (/= '>') t)+ where (h,t) = B.breakSubstring sep str+++ +replaceTagsT file tagName sub = do+ raw <- B.readFile file + let content = TE.decodeUtf8 raw+ let frags = map (T.drop 1 . T.dropWhile (/= '>')) + $ T.split (T.pack $ '<' : tagName) (T.toLower content)+ T.putStr $ T.intercalate (T.pack sub) frags+ +replaceTagsTL file tagName sub = do+ raw <- BL.readFile file + let content = TLE.decodeUtf8 raw+ let frags = map (TL.drop 1 . TL.dropWhile (/= '>')) + $ TL.split (TL.pack $ '<' : tagName) (TL.toLower content)+ TL.putStr $ TL.intercalate (TL.pack sub) frags+++main = do+ (kind : file : tag : sub : _) <- getArgs+ case kind of+ "Text" -> replaceTagsT file tag sub+ "TextLazy" -> replaceTagsTL file tag sub+ "BytestringM" -> replaceTagsM file tag sub+ "BytestringK" -> replaceTagsK file tag sub+ "BytestringO" -> replaceTagsO file tag sub+ "TextNull" -> T.readFile file >>= T.putStr+ "ByteNull" -> B.readFile file >>= B.putStr+ "EncodeNull" -> B.readFile file >>= T.putStr . T.toLower . TE.decodeUtf8 +
text.cabal view
@@ -1,6 +1,7 @@ name: text-version: 0.9.0.1-homepage: http://code.haskell.org/text+version: 0.9.1.0+homepage: http://bitbucket.org/bos/text+bug-reports: http://bitbucket.org/bos/text/issues synopsis: An efficient packed Unicode text type. description: .@@ -27,7 +28,7 @@ . license: BSD3 license-file: LICENSE-author: Tom Harper <rtomharper@googlemail.com>+author: Bryan O'Sullivan <bos@serpentine.com> maintainer: Bryan O'Sullivan <bos@serpentine.com> Tom Harper <rrtomharper@googlemail.com> Duncan Coutts <duncan@haskell.org>@@ -36,7 +37,7 @@ build-type: Simple cabal-version: >= 1.6 extra-source-files:- README+ README.markdown TODO -- scripts/CaseFolding.txt -- scripts/SpecialCasing.txt@@ -53,12 +54,16 @@ tests/StdioCoverage.hs tests/TestUtils.hs tests/benchmarks/Cut.hs+ tests/benchmarks/DecodeUtf8.hs+ tests/benchmarks/EncodeUtf8.hs+ tests/benchmarks/Equality.hs tests/benchmarks/FileIndices.hs tests/benchmarks/FileRead.hs tests/benchmarks/FoldLines.hs tests/benchmarks/HtmlCombinator.hs tests/benchmarks/Makefile tests/benchmarks/Replace.hs+ tests/benchmarks/ReplaceTags.hs tests/benchmarks/fileread.py tests/benchmarks/fileread_c.c tests/cover-stdio.sh@@ -78,6 +83,8 @@ Data.Text.Lazy.Builder Data.Text.Lazy.Encoding Data.Text.Lazy.IO+ Data.Text.Lazy.Read+ Data.Text.Read other-modules: Data.Text.Array Data.Text.Encoding.Fusion@@ -124,5 +131,9 @@ cpp-options: -DASSERTS source-repository head- type: darcs- location: http://code.haskell.org/text/+ type: mercurial+ location: http://bitbucket.org/bos/text++source-repository head+ type: git+ location: http://github.com/bos/text