packages feed

text 0.11.3.1 → 1.0.0.0

raw patch · 39 files changed

+1031/−236 lines, 39 filesdep −extensible-exceptionsdep −integerdep ~arraydep ~basedep ~ghc-prim

Dependencies removed: extensible-exceptions, integer

Dependency ranges changed: array, base, ghc-prim

Files

Data/Text.hs view
@@ -79,6 +79,7 @@     , toCaseFold     , toLower     , toUpper+    , toTitle      -- ** Justification     , justifyLeft@@ -177,7 +178,7 @@     , findIndex     , count -    -- * Zipping and unzipping+    -- * Zipping     , zip     , zipWith @@ -201,11 +202,7 @@ #endif import Data.Char (isSpace) import Data.Data (Data(gfoldl, toConstr, gunfold, dataTypeOf))-#if __GLASGOW_HASKELL__ >= 612 import Data.Data (mkNoRepType)-#else-import Data.Data (mkNorepType)-#endif import Control.Monad (foldM) import qualified Data.Text.Array as A import qualified Data.List as L@@ -350,11 +347,7 @@   gfoldl f z txt = z pack `f` (unpack txt)   toConstr _     = P.error "Data.Text.Text.toConstr"   gunfold _ _    = P.error "Data.Text.Text.gunfold"-#if __GLASGOW_HASKELL__ >= 612   dataTypeOf _   = mkNoRepType "Data.Text.Text"-#else-  dataTypeOf _   = mkNorepType "Data.Text.Text"-#endif  -- | /O(n)/ Compare two 'Text' values lexicographically. compareText :: Text -> Text -> Ordering@@ -623,12 +616,29 @@ -- -- In (unlikely) bad cases, this function's time complexity degrades -- towards /O(n*m)/.-replace :: Text                 -- ^ Text to search for-        -> Text                 -- ^ Replacement text-        -> Text                 -- ^ Input text-        -> Text-replace s d = intercalate d . splitOn s-{-# INLINE replace #-}+replace :: Text -> Text -> Text -> Text+replace needle@(Text _      _      neeLen)+               (Text repArr repOff repLen)+      haystack@(Text hayArr hayOff hayLen)+  | neeLen == 0 = emptyError "replace"+  | L.null ixs  = haystack+  | len > 0     = Text (A.run x) 0 len+  | len < 0     = overflowError "replace"+  | otherwise   = empty+  where+    ixs = indices needle haystack+    len = hayLen - (neeLen - repLen) * L.length ixs+    x = do+      marr <- A.new len+      let loop (i:is) o d = do+            let d0 = d + i - o+                d1 = d0 + repLen+            A.copyI marr d  hayArr (hayOff+o) d0+            A.copyI marr d0 repArr repOff d1+            loop is (i + neeLen) d1+          loop []     o d = A.copyI marr d hayArr (hayOff+o) len+      loop ixs 0 0+      return marr  -- ---------------------------------------------------------------------------- -- ** Case conversions (folds)@@ -651,10 +661,11 @@ -- functions from the @text-icu@ package: -- <http://hackage.haskell.org/package/text-icu> --- | /O(n)/ Convert a string to folded case.  This function is mainly--- useful for performing caseless (also known as case insensitive)--- string comparisons.+-- | /O(n)/ Convert a string to folded case.  Subject to fusion. --+-- This function is mainly useful for performing caseless (also known+-- as case insensitive) string comparisons.+-- -- A string @x@ is a caseless match for a string @y@ if and only if: -- -- @toCaseFold x == toCaseFold y@@@ -671,21 +682,47 @@ {-# INLINE [0] toCaseFold #-}  -- | /O(n)/ Convert a string to lower case, using simple case--- conversion.  The result string may be longer than the input string.--- For instance, \"&#x130;\" (Latin capital letter I with dot above,--- U+0130) maps to the sequence \"i\" (Latin small letter i, U+0069) followed--- by \" &#x307;\" (combining dot above, U+0307).+-- conversion.  Subject to fusion.+--+-- The result string may be longer than the input string.  For+-- instance, \"&#x130;\" (Latin capital letter I with dot above,+-- U+0130) maps to the sequence \"i\" (Latin small letter i, U+0069)+-- followed by \" &#x307;\" (combining dot above, U+0307). toLower :: Text -> Text toLower t = unstream (S.toLower (stream t)) {-# INLINE toLower #-}  -- | /O(n)/ Convert a string to upper case, using simple case--- conversion.  The result string may be longer than the input string.--- For instance, the German \"&#xdf;\" (eszett, U+00DF) maps to the+-- conversion.  Subject to fusion.+--+-- The result string may be longer than the input string.  For+-- instance, the German \"&#xdf;\" (eszett, U+00DF) maps to the -- two-letter sequence \"SS\". toUpper :: Text -> Text toUpper t = unstream (S.toUpper (stream t)) {-# INLINE toUpper #-}++-- | /O(n)/ Convert a string to title case, using simple case+-- conversion. Subject to fusion.+--+-- The first letter of the input is converted to title case, as is+-- every subsequent letter that immediately follows a non-letter.+-- Every letter that immediately follows another letter is converted+-- to lower case.+--+-- The result string may be longer than the input string. For example,+-- the Latin small ligature &#xfb02; (U+FB02) is converted to the+-- sequence Latin capital letter F (U+0046) followed by Latin small+-- letter l (U+006C).+--+-- /Note/: this function does not take language or culture specific+-- rules into account. For instance, in English, different style+-- guides disagree on whether the book name \"The Hill of the Red+-- Fox\" is correctly title cased&#x2014;but this function will+-- capitalize /every/ word.+toTitle :: Text -> Text+toTitle t = unstream (S.toTitle (stream t))+{-# INLINE toTitle #-}  -- | /O(n)/ Left-justify a string to the given length, using the -- specified fill character on the right. Subject to fusion.
Data/Text/Encoding.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE BangPatterns, CPP, ForeignFunctionInterface, MagicHash,+{-# LANGUAGE BangPatterns, CPP, ForeignFunctionInterface, GeneralizedNewtypeDeriving, MagicHash,     UnliftedFFITypes #-} #if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-}@@ -43,6 +43,12 @@     , decodeUtf32LEWith     , decodeUtf32BEWith +    -- ** Stream oriented decoding+    -- $stream+    , streamDecodeUtf8+    , streamDecodeUtf8With+    , Decoding(..)+     -- * Encoding Text to ByteStrings     , encodeUtf8     , encodeUtf16LE@@ -57,20 +63,22 @@ #else import Control.Monad.ST (unsafeIOToST, unsafeSTToIO) #endif+import Control.Monad.ST (runST) import Data.Bits ((.&.)) import Data.ByteString as B import Data.ByteString.Internal as B+import Data.Text () import Data.Text.Encoding.Error (OnDecodeError, UnicodeException, strictDecode) import Data.Text.Internal (Text(..), safe, textP) import Data.Text.Private (runText) import Data.Text.UnsafeChar (ord, unsafeWrite) import Data.Text.UnsafeShift (shiftL, shiftR)-import Data.Word (Word8)+import Data.Word (Word8, Word32) import Foreign.C.Types (CSize) import Foreign.ForeignPtr (withForeignPtr) import Foreign.Marshal.Utils (with)-import Foreign.Ptr (Ptr, minusPtr, plusPtr)-import Foreign.Storable (peek, poke)+import Foreign.Ptr (Ptr, minusPtr, nullPtr, plusPtr)+import Foreign.Storable (Storable, peek, poke) import GHC.Base (MutableByteArray#) import qualified Data.Text.Array as A import qualified Data.Text.Encoding.Fusion as E@@ -78,6 +86,8 @@ import qualified Data.Text.Fusion as F import Data.Text.Unsafe (unsafeDupablePerformIO) +#include "text_cbits.h"+ -- $strict -- -- All of the single-parameter functions for decoding bytestrings@@ -139,6 +149,126 @@   desc = "Data.Text.Encoding.decodeUtf8: Invalid UTF-8 stream" {- INLINE[0] decodeUtf8With #-} +-- $stream+--+-- The 'streamDecodeUtf8' and 'streamDecodeUtf8With' functions accept+-- a 'ByteString' that represents a possibly incomplete input (e.g. a+-- packet from a network stream) that may not end on a UTF-8 boundary.+--+-- The first element of the result is the maximal chunk of 'Text' that+-- can be decoded from the given input. The second is a function which+-- accepts another 'ByteString'. That string will be assumed to+-- directly follow the string that was passed as input to the original+-- function, and it will in turn be decoded.+--+-- To help understand the use of these functions, consider the Unicode+-- string @\"hi &#9731;\"@. If encoded as UTF-8, this becomes @\"hi+-- \\xe2\\x98\\x83\"@; the final @\'&#9731;\'@ is encoded as 3 bytes.+--+-- Now suppose that we receive this encoded string as 3 packets that+-- are split up on untidy boundaries: @[\"hi \\xe2\", \"\\x98\",+-- \"\\x83\"]@. We cannot decode the entire Unicode string until we+-- have received all three packets, but we would like to make progress+-- as we receive each one.+--+-- @+-- let 'Some' t0 f0 = 'streamDecodeUtf8' \"hi \\xe2\"+-- t0 == \"hi \" :: 'Text'+-- @+--+-- We use the continuation @f0@ to decode our second packet.+--+-- @+-- let 'Some' t1 f1 = f0 \"\\x98\"+-- t1 == \"\"+-- @+--+-- We could not give @f0@ enough input to decode anything, so it+-- returned an empty string. Once we feed our second continuation @f1@+-- the last byte of input, it will make progress.+--+-- @+-- let 'Some' t2 f2 = f1 \"\\x83\"+-- t2 == \"&#9731;\"+-- @+--+-- If given invalid input, an exception will be thrown by the function+-- or continuation where it is encountered.++-- | A stream oriented decoding result.+data Decoding = Some Text ByteString (ByteString -> Decoding)++instance Show Decoding where+    showsPrec d (Some t bs _) = showParen (d > prec) $+                                showString "Some " . showsPrec prec' t .+                                showChar ' ' . showsPrec prec' bs .+                                showString " _"+      where prec = 10; prec' = prec + 1++newtype CodePoint = CodePoint Word32 deriving (Eq, Show, Num, Storable)+newtype DecoderState = DecoderState Word32 deriving (Eq, Show, Num, Storable)++-- | Decode, in a stream oriented way, a 'ByteString' containing UTF-8+-- encoded text that is known to be valid.+--+-- If the input contains any invalid UTF-8 data, an exception will be+-- thrown (either by this function or a continuation) that cannot be+-- caught in pure code.  For more control over the handling of invalid+-- data, use 'streamDecodeUtf8With'.+streamDecodeUtf8 :: ByteString -> Decoding+streamDecodeUtf8 = streamDecodeUtf8With strictDecode++-- | Decode, in a stream oriented way, a 'ByteString' containing UTF-8+-- encoded text.+streamDecodeUtf8With :: OnDecodeError -> ByteString -> Decoding+streamDecodeUtf8With onErr = decodeChunk 0 0+ where+  -- We create a slightly larger than necessary buffer to accommodate a+  -- potential surrogate pair started in the last buffer+  decodeChunk :: CodePoint -> DecoderState -> ByteString -> Decoding+  decodeChunk codepoint0 state0 bs@(PS fp off len) =+    runST $ (unsafeIOToST . decodeChunkToBuffer) =<< A.new (len+1)+   where+    decodeChunkToBuffer :: A.MArray s -> IO Decoding+    decodeChunkToBuffer dest = withForeignPtr fp $ \ptr ->+      with (0::CSize) $ \destOffPtr ->+      with codepoint0 $ \codepointPtr ->+      with state0 $ \statePtr ->+      with nullPtr $ \curPtrPtr ->+        let end = ptr `plusPtr` (off + len)+            loop curPtr = do+              poke curPtrPtr curPtr+              curPtr' <- c_decode_utf8_with_state (A.maBA dest) destOffPtr+                         curPtrPtr end codepointPtr statePtr+              state <- peek statePtr+              case state of+                UTF8_REJECT -> do+                  -- We encountered an encoding error+                  x <- peek curPtr'+                  case onErr desc (Just x) of+                    Nothing -> loop $ curPtr' `plusPtr` 1+                    Just c -> do+                      destOff <- peek destOffPtr+                      w <- unsafeSTToIO $+                           unsafeWrite dest (fromIntegral destOff) (safe c)+                      poke destOffPtr (destOff + fromIntegral w)+                      poke statePtr 0+                      loop $ curPtr' `plusPtr` 1++                _ -> do+                  -- We encountered the end of the buffer while decoding+                  n <- peek destOffPtr+                  codepoint <- peek codepointPtr+                  chunkText <- unsafeSTToIO $ do+                      arr <- A.unsafeFreeze dest+                      return $! textP arr 0 (fromIntegral n)+                  lastPtr <- peek curPtrPtr+                  let left = lastPtr `minusPtr` curPtr+                  return $ Some chunkText (B.drop left bs)+                           (decodeChunk codepoint state)+        in loop (ptr `plusPtr` off)+  desc = "Data.Text.Encoding.streamDecodeUtf8With: Invalid UTF-8 stream"+ -- | Decode a 'ByteString' containing UTF-8 encoded text that is known -- to be valid. --@@ -152,7 +282,7 @@ {-# RULES "STREAM stream/decodeUtf8 fusion" [1]     forall bs. F.stream (decodeUtf8 bs) = E.streamUtf8 strictDecode bs #-} --- | Decode a 'ByteString' containing UTF-8 encoded text..+-- | Decode a 'ByteString' containing UTF-8 encoded text. -- -- If the input contains any invalid UTF-8 data, the relevant -- exception will be returned, otherwise the decoded text.@@ -295,6 +425,11 @@ foreign import ccall unsafe "_hs_text_decode_utf8" c_decode_utf8     :: MutableByteArray# s -> Ptr CSize     -> Ptr Word8 -> Ptr Word8 -> IO (Ptr Word8)++foreign import ccall unsafe "_hs_text_decode_utf8_state" c_decode_utf8_with_state+    :: MutableByteArray# s -> Ptr CSize+    -> Ptr (Ptr Word8) -> Ptr Word8+    -> Ptr CodePoint -> Ptr DecoderState -> IO (Ptr Word8)  foreign import ccall unsafe "_hs_text_decode_latin1" c_decode_latin1     :: MutableByteArray# s -> Ptr Word8 -> Ptr Word8 -> IO ()
Data/Text/Encoding/Error.hs view
@@ -39,11 +39,7 @@     ) where  import Control.DeepSeq (NFData (..))-#if __GLASGOW_HASKELL__ >= 610 import Control.Exception (Exception, throw)-#else-import Control.Exception.Extensible (Exception, throw)-#endif import Data.Typeable (Typeable) import Data.Word (Word8) import Numeric (showHex)
Data/Text/Foreign.hs view
@@ -21,6 +21,9 @@     , fromPtr     , useAsPtr     , asForeignPtr+    -- ** Encoding as UTF-8+    , peekCStringLen+    , withCStringLen     -- * Unsafe conversion code     , lengthWord16     , unsafeCopyToPtr@@ -38,14 +41,17 @@ #else import Control.Monad.ST (unsafeIOToST) #endif+import Data.ByteString.Unsafe (unsafePackCStringLen, unsafeUseAsCStringLen)+import Data.Text.Encoding (decodeUtf8, encodeUtf8) import Data.Text.Internal (Text(..), empty) import Data.Text.Unsafe (lengthWord16)-import qualified Data.Text.Array as A import Data.Word (Word16)+import Foreign.C.String (CStringLen)+import Foreign.ForeignPtr (ForeignPtr, mallocForeignPtrArray, withForeignPtr) import Foreign.Marshal.Alloc (allocaBytes) import Foreign.Ptr (Ptr, castPtr, plusPtr)-import Foreign.ForeignPtr (ForeignPtr, mallocForeignPtrArray, withForeignPtr) import Foreign.Storable (peek, poke)+import qualified Data.Text.Array as A  -- $interop --@@ -148,3 +154,21 @@   fp <- mallocForeignPtrArray len   withForeignPtr fp $ unsafeCopyToPtr t   return (fp, I16 len)++-- | /O(n)/ Decode a C string with explicit length, which is assumed+-- to have been encoded as UTF-8. If decoding fails, a+-- 'UnicodeException' is thrown.+peekCStringLen :: CStringLen -> IO Text+peekCStringLen cs = do+  bs <- unsafePackCStringLen cs+  return $! decodeUtf8 bs++-- | Marshal a 'Text' into a C string encoded as UTF-8 in temporary+-- storage, with explicit length information. The encoded string may+-- contain NUL bytes, and is not followed by a trailing NUL byte.+--+-- The temporary storage is freed when the subcomputation terminates+-- (either normally or via an exception), so the pointer to the+-- temporary storage must /not/ be used after this function returns.+withCStringLen :: Text -> (CStringLen -> IO a) -> IO a+withCStringLen t act = unsafeUseAsCStringLen (encodeUtf8 t) act
Data/Text/Fusion.hs view
@@ -223,9 +223,9 @@                                arr' <- A.new top'                                A.copyM arr' 0 arr 0 top                                outer arr' top' z s i-                | otherwise -> do let (z',c) = f z x-                                  d <- unsafeWrite arr i c+                | otherwise -> do d <- unsafeWrite arr i c                                   loop z' s' (i+d)-                where j | ord x < 0x10000 = i+                where (z',c) = f z x+                      j | ord c < 0x10000 = i                         | otherwise       = i + 1 {-# INLINE [0] mapAccumL #-}
Data/Text/Fusion/CaseMapping.hs view
@@ -1,6 +1,11 @@ {-# LANGUAGE Rank2Types #-} -- AUTOMATICALLY GENERATED - DO NOT EDIT -- Generated by scripts/SpecialCasing.hs+-- CaseFolding-6.3.0.txt+-- Date: 2012-12-20, 22:14:35 GMT [MD]+-- SpecialCasing-6.3.0.txt+-- Date: 2013-05-08, 13:54:51 GMT [MD]+ module Data.Text.Fusion.CaseMapping where import Data.Char import Data.Text.Fusion.Internal@@ -217,6 +222,105 @@ -- LATIN CAPITAL LETTER I WITH DOT ABOVE lowerMapping '\x0130' s = Yield '\x0069' (CC s '\x0307' '\x0000') lowerMapping c s = Yield (toLower c) (CC s '\0' '\0')+titleMapping :: forall s. Char -> s -> Step (CC s) Char+{-# INLINE titleMapping #-}+-- LATIN SMALL LETTER SHARP S+titleMapping '\x00df' s = Yield '\x0053' (CC s '\x0073' '\x0000')+-- LATIN SMALL LIGATURE FF+titleMapping '\xfb00' s = Yield '\x0046' (CC s '\x0066' '\x0000')+-- LATIN SMALL LIGATURE FI+titleMapping '\xfb01' s = Yield '\x0046' (CC s '\x0069' '\x0000')+-- LATIN SMALL LIGATURE FL+titleMapping '\xfb02' s = Yield '\x0046' (CC s '\x006c' '\x0000')+-- LATIN SMALL LIGATURE FFI+titleMapping '\xfb03' s = Yield '\x0046' (CC s '\x0066' '\x0069')+-- LATIN SMALL LIGATURE FFL+titleMapping '\xfb04' s = Yield '\x0046' (CC s '\x0066' '\x006c')+-- LATIN SMALL LIGATURE LONG S T+titleMapping '\xfb05' s = Yield '\x0053' (CC s '\x0074' '\x0000')+-- LATIN SMALL LIGATURE ST+titleMapping '\xfb06' s = Yield '\x0053' (CC s '\x0074' '\x0000')+-- ARMENIAN SMALL LIGATURE ECH YIWN+titleMapping '\x0587' s = Yield '\x0535' (CC s '\x0582' '\x0000')+-- ARMENIAN SMALL LIGATURE MEN NOW+titleMapping '\xfb13' s = Yield '\x0544' (CC s '\x0576' '\x0000')+-- ARMENIAN SMALL LIGATURE MEN ECH+titleMapping '\xfb14' s = Yield '\x0544' (CC s '\x0565' '\x0000')+-- ARMENIAN SMALL LIGATURE MEN INI+titleMapping '\xfb15' s = Yield '\x0544' (CC s '\x056b' '\x0000')+-- ARMENIAN SMALL LIGATURE VEW NOW+titleMapping '\xfb16' s = Yield '\x054e' (CC s '\x0576' '\x0000')+-- ARMENIAN SMALL LIGATURE MEN XEH+titleMapping '\xfb17' s = Yield '\x0544' (CC s '\x056d' '\x0000')+-- LATIN SMALL LETTER N PRECEDED BY APOSTROPHE+titleMapping '\x0149' s = Yield '\x02bc' (CC s '\x004e' '\x0000')+-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND TONOS+titleMapping '\x0390' s = Yield '\x0399' (CC s '\x0308' '\x0301')+-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND TONOS+titleMapping '\x03b0' s = Yield '\x03a5' (CC s '\x0308' '\x0301')+-- LATIN SMALL LETTER J WITH CARON+titleMapping '\x01f0' s = Yield '\x004a' (CC s '\x030c' '\x0000')+-- LATIN SMALL LETTER H WITH LINE BELOW+titleMapping '\x1e96' s = Yield '\x0048' (CC s '\x0331' '\x0000')+-- LATIN SMALL LETTER T WITH DIAERESIS+titleMapping '\x1e97' s = Yield '\x0054' (CC s '\x0308' '\x0000')+-- LATIN SMALL LETTER W WITH RING ABOVE+titleMapping '\x1e98' s = Yield '\x0057' (CC s '\x030a' '\x0000')+-- LATIN SMALL LETTER Y WITH RING ABOVE+titleMapping '\x1e99' s = Yield '\x0059' (CC s '\x030a' '\x0000')+-- LATIN SMALL LETTER A WITH RIGHT HALF RING+titleMapping '\x1e9a' s = Yield '\x0041' (CC s '\x02be' '\x0000')+-- GREEK SMALL LETTER UPSILON WITH PSILI+titleMapping '\x1f50' s = Yield '\x03a5' (CC s '\x0313' '\x0000')+-- GREEK SMALL LETTER UPSILON WITH PSILI AND VARIA+titleMapping '\x1f52' s = Yield '\x03a5' (CC s '\x0313' '\x0300')+-- GREEK SMALL LETTER UPSILON WITH PSILI AND OXIA+titleMapping '\x1f54' s = Yield '\x03a5' (CC s '\x0313' '\x0301')+-- GREEK SMALL LETTER UPSILON WITH PSILI AND PERISPOMENI+titleMapping '\x1f56' s = Yield '\x03a5' (CC s '\x0313' '\x0342')+-- GREEK SMALL LETTER ALPHA WITH PERISPOMENI+titleMapping '\x1fb6' s = Yield '\x0391' (CC s '\x0342' '\x0000')+-- GREEK SMALL LETTER ETA WITH PERISPOMENI+titleMapping '\x1fc6' s = Yield '\x0397' (CC s '\x0342' '\x0000')+-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND VARIA+titleMapping '\x1fd2' s = Yield '\x0399' (CC s '\x0308' '\x0300')+-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND OXIA+titleMapping '\x1fd3' s = Yield '\x0399' (CC s '\x0308' '\x0301')+-- GREEK SMALL LETTER IOTA WITH PERISPOMENI+titleMapping '\x1fd6' s = Yield '\x0399' (CC s '\x0342' '\x0000')+-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND PERISPOMENI+titleMapping '\x1fd7' s = Yield '\x0399' (CC s '\x0308' '\x0342')+-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND VARIA+titleMapping '\x1fe2' s = Yield '\x03a5' (CC s '\x0308' '\x0300')+-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND OXIA+titleMapping '\x1fe3' s = Yield '\x03a5' (CC s '\x0308' '\x0301')+-- GREEK SMALL LETTER RHO WITH PSILI+titleMapping '\x1fe4' s = Yield '\x03a1' (CC s '\x0313' '\x0000')+-- GREEK SMALL LETTER UPSILON WITH PERISPOMENI+titleMapping '\x1fe6' s = Yield '\x03a5' (CC s '\x0342' '\x0000')+-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND PERISPOMENI+titleMapping '\x1fe7' s = Yield '\x03a5' (CC s '\x0308' '\x0342')+-- GREEK SMALL LETTER OMEGA WITH PERISPOMENI+titleMapping '\x1ff6' s = Yield '\x03a9' (CC s '\x0342' '\x0000')+-- GREEK SMALL LETTER ALPHA WITH VARIA AND YPOGEGRAMMENI+titleMapping '\x1fb2' s = Yield '\x1fba' (CC s '\x0345' '\x0000')+-- GREEK SMALL LETTER ALPHA WITH OXIA AND YPOGEGRAMMENI+titleMapping '\x1fb4' s = Yield '\x0386' (CC s '\x0345' '\x0000')+-- GREEK SMALL LETTER ETA WITH VARIA AND YPOGEGRAMMENI+titleMapping '\x1fc2' s = Yield '\x1fca' (CC s '\x0345' '\x0000')+-- GREEK SMALL LETTER ETA WITH OXIA AND YPOGEGRAMMENI+titleMapping '\x1fc4' s = Yield '\x0389' (CC s '\x0345' '\x0000')+-- GREEK SMALL LETTER OMEGA WITH VARIA AND YPOGEGRAMMENI+titleMapping '\x1ff2' s = Yield '\x1ffa' (CC s '\x0345' '\x0000')+-- GREEK SMALL LETTER OMEGA WITH OXIA AND YPOGEGRAMMENI+titleMapping '\x1ff4' s = Yield '\x038f' (CC s '\x0345' '\x0000')+-- GREEK SMALL LETTER ALPHA WITH PERISPOMENI AND YPOGEGRAMMENI+titleMapping '\x1fb7' s = Yield '\x0391' (CC s '\x0342' '\x0345')+-- GREEK SMALL LETTER ETA WITH PERISPOMENI AND YPOGEGRAMMENI+titleMapping '\x1fc7' s = Yield '\x0397' (CC s '\x0342' '\x0345')+-- GREEK SMALL LETTER OMEGA WITH PERISPOMENI AND YPOGEGRAMMENI+titleMapping '\x1ff7' s = Yield '\x03a9' (CC s '\x0342' '\x0345')+titleMapping c s = Yield (toTitle c) (CC s '\0' '\0') foldMapping :: forall s. Char -> s -> Step (CC s) Char {-# INLINE foldMapping #-} -- MICRO SIGN@@ -255,6 +359,10 @@ foldMapping '\x03f5' s = Yield '\x03b5' (CC s '\x0000' '\x0000') -- ARMENIAN SMALL LIGATURE ECH YIWN foldMapping '\x0587' s = Yield '\x0565' (CC s '\x0582' '\x0000')+-- GEORGIAN CAPITAL LETTER YN+foldMapping '\x10c7' s = Yield '\x2d27' (CC s '\x0000' '\x0000')+-- GEORGIAN CAPITAL LETTER AEN+foldMapping '\x10cd' s = Yield '\x2d2d' (CC s '\x0000' '\x0000') -- LATIN SMALL LETTER H WITH LINE BELOW foldMapping '\x1e96' s = Yield '\x0068' (CC s '\x0331' '\x0000') -- LATIN SMALL LETTER T WITH DIAERESIS@@ -429,6 +537,12 @@ foldMapping '\x1ff7' s = Yield '\x03c9' (CC s '\x0342' '\x03b9') -- GREEK CAPITAL LETTER OMEGA WITH PROSGEGRAMMENI foldMapping '\x1ffc' s = Yield '\x03c9' (CC s '\x03b9' '\x0000')+-- COPTIC CAPITAL LETTER BOHAIRIC KHEI+foldMapping '\x2cf2' s = Yield '\x2cf3' (CC s '\x0000' '\x0000')+-- LATIN CAPITAL LETTER C WITH BAR+foldMapping '\xa792' s = Yield '\xa793' (CC s '\x0000' '\x0000')+-- LATIN CAPITAL LETTER H WITH HOOK+foldMapping '\xa7aa' s = Yield '\x0266' (CC s '\x0000' '\x0000') -- LATIN SMALL LIGATURE FF foldMapping '\xfb00' s = Yield '\x0066' (CC s '\x0066' '\x0000') -- LATIN SMALL LIGATURE FI
Data/Text/Fusion/Common.hs view
@@ -42,6 +42,7 @@     -- $case     , toCaseFold     , toLower+    , toTitle     , toUpper      -- ** Justification@@ -102,13 +103,15 @@  import Prelude (Bool(..), Char, Eq(..), Int, Integral, Maybe(..),                 Ord(..), Ordering(..), String, (.), ($), (+), (-), (*), (++),-                (&&), fromIntegral, otherwise)+                (&&), fromIntegral, not, otherwise) import qualified Data.List as L import qualified Prelude as P import Data.Bits (shiftL)+import Data.Char (isLetter) import Data.Int (Int64) import Data.Text.Fusion.Internal-import Data.Text.Fusion.CaseMapping (foldMapping, lowerMapping, upperMapping)+import Data.Text.Fusion.CaseMapping (foldMapping, lowerMapping, titleMapping,+                                     upperMapping) import Data.Text.Fusion.Size import GHC.Prim (Addr#, chr#, indexCharOffAddr#, ord#) import GHC.Types (Char(..), Int(..))@@ -431,6 +434,40 @@ toLower :: Stream Char -> Stream Char toLower = caseConvert lowerMapping {-# INLINE [0] toLower #-}++-- | /O(n)/ Convert a string to title case, using simple case+-- conversion.+--+-- The first letter of the input is converted to title case, as is+-- every subsequent letter that immediately follows a non-letter.+-- Every letter that immediately follows another letter is converted+-- to lower case.+--+-- The result string may be longer than the input string. For example,+-- the Latin small ligature &#xfb02; (U+FB02) is converted to the+-- sequence Latin capital letter F (U+0046) followed by Latin small+-- letter l (U+006C).+--+-- /Note/: this function does not take language or culture specific+-- rules into account. For instance, in English, different style+-- guides disagree on whether the book name \"The Hill of the Red+-- Fox\" is correctly title cased&#x2014;but this function will+-- capitalize /every/ word.+toTitle :: Stream Char -> Stream Char+toTitle (Stream next0 s0 len) = Stream next (CC (False :*: s0) '\0' '\0') len+  where+    next (CC (letter :*: s) '\0' _) =+      case next0 s of+        Done           -> Done+        Skip s'        -> Skip (CC (letter :*: s') '\0' '\0')+        Yield c s'+          | letter'    -> if letter+                          then lowerMapping c (letter' :*: s')+                          else titleMapping c (letter' :*: s')+          | otherwise  -> Yield c (CC (letter' :*: s') '\0' '\0')+          where letter' = isLetter c+    next (CC s a b)     = Yield a (CC s b '\0')+{-# INLINE [0] toTitle #-}  justifyLeftI :: Integral a => a -> Char -> Stream Char -> Stream Char justifyLeftI k c (Stream next0 s0 len) =
Data/Text/IO.hs view
@@ -46,10 +46,6 @@                        putStr, putStrLn, readFile, writeFile) import System.IO (Handle, IOMode(..), hPutChar, openFile, stdin, stdout,                   withFile)-#if __GLASGOW_HASKELL__ <= 610-import qualified Data.ByteString.Char8 as B-import Data.Text.Encoding (decodeUtf8, encodeUtf8)-#else import qualified Control.Exception as E import Control.Monad (liftM2, when) import Data.IORef (readIORef, writeIORef)@@ -68,7 +64,6 @@                             HandleType(..), Newline(..)) import System.IO (hGetBuffering, hFileSize, hSetBuffering, hTell) import System.IO.Error (isEOFError)-#endif  -- $performance -- #performance#@@ -137,9 +132,6 @@ -- result to construct its result.  For files more than a half of -- available RAM in size, this may result in memory exhaustion. hGetContents :: Handle -> IO Text-#if __GLASGOW_HASKELL__ <= 610-hGetContents = fmap decodeUtf8 . B.hGetContents-#else hGetContents h = do   chooseGoodBuffering h   wantReadableHandle "hGetContents" h readAll@@ -171,21 +163,13 @@            else E.throwIO e       when (d > 0) . hSetBuffering h . BlockBuffering . Just . fromIntegral $ d     _ -> return ()-#endif  -- | Read a single line from a handle. hGetLine :: Handle -> IO Text-#if __GLASGOW_HASKELL__ <= 610-hGetLine = fmap decodeUtf8 . B.hGetLine-#else hGetLine = hGetLineWith T.concat-#endif  -- | Write a string to a handle. hPutStr :: Handle -> Text -> IO ()-#if __GLASGOW_HASKELL__ <= 610-hPutStr h = B.hPutStr h . encodeUtf8-#else -- This function is lifted almost verbatim from GHC.IO.Handle.Text. hPutStr h t = do   (buffer_mode, nl) <-@@ -295,7 +279,6 @@   wantWritableHandle "commitAndReleaseBuffer" hdl $      commitBuffer' raw sz count flush release {-# INLINE commitBuffer #-}-#endif  -- | Write a string to a handle, followed by a newline. hPutStrLn :: Handle -> Text -> IO ()
Data/Text/IO/Internal.hs view
@@ -12,13 +12,10 @@  module Data.Text.IO.Internal     (-#if __GLASGOW_HASKELL__ >= 612       hGetLineWith     , readChunk-#endif     ) where -#if __GLASGOW_HASKELL__ >= 612 import qualified Control.Exception as E import Data.IORef (readIORef, writeIORef) import Data.Text (Text)@@ -163,4 +160,3 @@  sizeError :: String -> a sizeError loc = error $ "Data.Text.IO." ++ loc ++ ": bad internal buffer size"-#endif
Data/Text/Lazy.hs view
@@ -86,6 +86,7 @@     , toCaseFold     , toLower     , toUpper+    , toTitle      -- ** Justification     , justifyLeft@@ -202,11 +203,7 @@ import qualified Data.List as L import Data.Char (isSpace) import Data.Data (Data(gfoldl, toConstr, gunfold, dataTypeOf))-#if __GLASGOW_HASKELL__ >= 612 import Data.Data (mkNoRepType)-#else-import Data.Data (mkNorepType)-#endif import Data.Monoid (Monoid(..)) import Data.String (IsString(..)) import qualified Data.Text as T@@ -341,11 +338,7 @@   gfoldl f z txt = z pack `f` (unpack txt)   toConstr _     = error "Data.Text.Lazy.Text.toConstr"   gunfold _ _    = error "Data.Text.Lazy.Text.gunfold"-#if __GLASGOW_HASKELL__ >= 612   dataTypeOf _   = mkNoRepType "Data.Text.Lazy.Text"-#else-  dataTypeOf _   = mkNorepType "Data.Text.Lazy.Text"-#endif  -- | /O(n)/ Convert a 'String' into a 'Text'. --@@ -670,10 +663,11 @@ -- functions may map one input character to two or three output -- characters. --- | /O(n)/ Convert a string to folded case.  This function is mainly--- useful for performing caseless (or case insensitive) string--- comparisons.+-- | /O(n)/ Convert a string to folded case.  Subject to fusion. --+-- This function is mainly useful for performing caseless (or case+-- insensitive) string comparisons.+-- -- A string @x@ is a caseless match for a string @y@ if and only if: -- -- @toCaseFold x == toCaseFold y@@@ -689,21 +683,48 @@ {-# INLINE [0] toCaseFold #-}  -- | /O(n)/ Convert a string to lower case, using simple case--- conversion.  The result string may be longer than the input string.--- For instance, the Latin capital letter I with dot above (U+0130)--- maps to the sequence Latin small letter i (U+0069) followed by--- combining dot above (U+0307).+-- conversion.  Subject to fusion.+--+-- The result string may be longer than the input string.  For+-- instance, the Latin capital letter I with dot above (U+0130) maps+-- to the sequence Latin small letter i (U+0069) followed by combining+-- dot above (U+0307). toLower :: Text -> Text toLower t = unstream (S.toLower (stream t)) {-# INLINE toLower #-}  -- | /O(n)/ Convert a string to upper case, using simple case--- conversion.  The result string may be longer than the input string.--- For instance, the German eszett (U+00DF) maps to the two-letter+-- conversion.  Subject to fusion.+--+-- The result string may be longer than the input string.  For+-- instance, the German eszett (U+00DF) maps to the two-letter -- sequence SS. toUpper :: Text -> Text toUpper t = unstream (S.toUpper (stream t)) {-# INLINE toUpper #-}+++-- | /O(n)/ Convert a string to title case, using simple case+-- conversion.  Subject to fusion.+--+-- The first letter of the input is converted to title case, as is+-- every subsequent letter that immediately follows a non-letter.+-- Every letter that immediately follows another letter is converted+-- to lower case.+--+-- The result string may be longer than the input string. For example,+-- the Latin small ligature &#xfb02; (U+FB02) is converted to the+-- sequence Latin capital letter F (U+0046) followed by Latin small+-- letter l (U+006C).+--+-- /Note/: this function does not take language or culture specific+-- rules into account. For instance, in English, different style+-- guides disagree on whether the book name \"The Hill of the Red+-- Fox\" is correctly title cased&#x2014;but this function will+-- capitalize /every/ word.+toTitle :: Text -> Text+toTitle t = unstream (S.toTitle (stream t))+{-# INLINE toTitle #-}  -- | /O(n)/ 'foldl', applied to a binary operator, a starting value -- (typically the left-identity of the operator), and a 'Text',
Data/Text/Lazy/Builder.hs view
@@ -1,4 +1,7 @@ {-# LANGUAGE BangPatterns, CPP, Rank2Types #-}+#if __GLASGOW_HASKELL__ >= 702+{-# LANGUAGE Trustworthy #-}+#endif  ----------------------------------------------------------------------------- -- |@@ -26,8 +29,14 @@ -- -- > singleton 'a' `mappend` singleton 'b' `mappend` singleton 'c' ----- as the latter associates @mappend@ to the left.+-- as the latter associates @mappend@ to the left. Or, equivalently,+-- prefer --+--  > singleton 'a' <> singleton 'b' <> singleton 'c'+--+-- since the '<>' from recent versions of 'Data.Monoid' associates +-- to the right.+ -----------------------------------------------------------------------------  module Data.Text.Lazy.Builder
Data/Text/Lazy/Builder/Int.hs view
@@ -1,4 +1,7 @@ {-# LANGUAGE BangPatterns, CPP, MagicHash, RankNTypes, UnboxedTuples #-}+#if __GLASGOW_HASKELL__ >= 702+{-# LANGUAGE Trustworthy #-}+#endif  -- Module:      Data.Text.Lazy.Builder.Int -- Copyright:   (c) 2013 Bryan O'Sullivan@@ -30,9 +33,7 @@ import Control.Monad.ST  #ifdef  __GLASGOW_HASKELL__-# if __GLASGOW_HASKELL__ < 611-import GHC.Integer.Internals-# elif defined(INTEGER_GMP)+# if defined(INTEGER_GMP) import GHC.Integer.GMP.Internals # elif defined(INTEGER_SIMPLE) import GHC.Integer
Data/Text/Lazy/Builder/RealFloat.hs view
@@ -1,4 +1,7 @@-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE CPP, OverloadedStrings #-}+#if __GLASGOW_HASKELL__ >= 702+{-# LANGUAGE Trustworthy #-}+#endif  -- | -- Module:    Data.Text.Lazy.Builder.RealFloat
Data/Text/Lazy/Encoding.hs view
@@ -49,15 +49,14 @@     ) where  import Control.Exception (evaluate, try)-import Data.Bits ((.&.)) import Data.Text.Encoding.Error (OnDecodeError, UnicodeException, 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.ByteString.Unsafe as B import qualified Data.Text.Encoding as TE+import qualified Data.Text.Lazy as L import qualified Data.Text.Lazy.Encoding.Fusion as E import qualified Data.Text.Lazy.Fusion as F import Data.Text.Unsafe (unsafeDupablePerformIO)@@ -89,41 +88,20 @@  -- | Decode a 'ByteString' containing UTF-8 encoded text. decodeUtf8With :: OnDecodeError -> B.ByteString -> Text-decodeUtf8With onErr bs0 = fast bs0+decodeUtf8With onErr (B.Chunk b0 bs0) =+    case TE.streamDecodeUtf8With onErr b0 of+      TE.Some t l f -> chunk t (go f l 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)+    go f0 _ (B.Chunk b bs) =+      case f0 b of+        TE.Some t l f -> chunk t (go f l bs)+    go _ l _+      | S.null l  = empty+      | otherwise = case onErr desc (Just (B.unsafeHead l)) of+                      Nothing -> empty+                      Just c  -> L.singleton c     desc = "Data.Text.Lazy.Encoding.decodeUtf8With: Invalid UTF-8 stream"-{-# INLINE[0] decodeUtf8With #-}+decodeUtf8With _ _ = empty  -- | Decode a 'ByteString' containing UTF-8 encoded text that is known -- to be valid.
Data/Text/Lazy/IO.hs view
@@ -47,11 +47,6 @@                   withFile) import qualified Data.Text.IO as T import qualified Data.Text.Lazy as L-#if __GLASGOW_HASKELL__ <= 610-import Data.Text.Lazy.Encoding (decodeUtf8)-import qualified Data.ByteString.Char8 as S8-import qualified Data.ByteString.Lazy.Char8 as L8-#else import qualified Control.Exception as E import Control.Monad (when) import Data.IORef (readIORef)@@ -65,7 +60,6 @@ import System.IO (BufferMode(..), hGetBuffering, hSetBuffering) import System.IO.Error (isEOFError) import System.IO.Unsafe (unsafeInterleaveIO)-#endif  -- $performance --@@ -99,9 +93,6 @@ -- | Lazily read the remaining contents of a 'Handle'.  The 'Handle' -- will be closed after the read completes, or on error. hGetContents :: Handle -> IO Text-#if __GLASGOW_HASKELL__ <= 610-hGetContents = fmap decodeUtf8 . L8.hGetContents-#else hGetContents h = do   chooseGoodBuffering h   wantReadableHandle "hGetContents" h $ \hh -> do@@ -138,15 +129,10 @@                          then (hh', empty)                          else (hh', L.singleton '\r')            else E.throwIO (augmentIOError e "hGetContents" h)-#endif  -- | Read a single line from a handle. hGetLine :: Handle -> IO Text-#if __GLASGOW_HASKELL__ <= 610-hGetLine = fmap (decodeUtf8 . L8.fromChunks . (:[])) . S8.hGetLine-#else hGetLine = hGetLineWith L.fromChunks-#endif  -- | Write a string to a handle. hPutStr :: Handle -> Text -> IO ()
Data/Text/Search.hs view
@@ -42,7 +42,8 @@  -- | /O(n+m)/ Find the offsets of all non-overlapping indices of -- @needle@ within @haystack@.  The offsets returned represent--- locations in the low-level array.+-- uncorrected indices in the low-level \"needle\" array, to which its+-- offset must be added. -- -- In (unlikely) bad cases, this algorithm's complexity degrades -- towards /O(n*m)/.
Data/Text/Unsafe.hs view
@@ -34,11 +34,7 @@ import Data.Text.Unsafe.Base (inlineInterleaveST, inlinePerformIO) import Data.Text.UnsafeChar (unsafeChr) import qualified Data.Text.Array as A-#if __GLASGOW_HASKELL__ >= 611 import GHC.IO (unsafeDupablePerformIO)-#else-import GHC.IOBase (unsafeDupablePerformIO)-#endif  -- | /O(1)/ A variant of 'head' for non-empty 'Text'. 'unsafeHead' -- omits the check for the empty case, so there is an obligation on@@ -51,7 +47,7 @@           n = A.unsafeIndex arr (off+1) {-# INLINE unsafeHead #-} --- | /O(1)/ A variant of 'tail' for non-empty 'Text'. 'unsafeHead'+-- | /O(1)/ A variant of 'tail' for non-empty 'Text'. 'unsafeTail' -- omits the check for the empty case, so there is an obligation on -- the programmer to provide a proof that the 'Text' is non-empty. unsafeTail :: Text -> Text
Data/Text/Unsafe/Base.hs view
@@ -18,11 +18,7 @@  import GHC.ST (ST(..)) #if defined(__GLASGOW_HASKELL__)-# if __GLASGOW_HASKELL__ >= 611 import GHC.IO (IO(IO))-# else-import GHC.IOBase (IO(IO))-# endif import GHC.Base (realWorld#) #endif
benchmarks/haskell/Benchmarks/DecodeUtf8.hs view
@@ -20,6 +20,7 @@  import Foreign.C.Types import Data.ByteString.Internal (ByteString(..))+import Data.ByteString.Lazy.Internal (ByteString(..)) import Foreign.Ptr (Ptr, plusPtr) import Foreign.ForeignPtr (withForeignPtr) import Data.Word (Word8)@@ -38,8 +39,15 @@     bs  <- B.readFile fp     lbs <- BL.readFile fp     let bench name = C.bench (name ++ "+" ++ kind)+        decodeStream (Chunk b0 bs0) = case T.streamDecodeUtf8 b0 of+                                        T.Some t0 _ f0 -> t0 : go f0 bs0+          where go f (Chunk b bs1) = case f b of+                                       T.Some t1 _ f1 -> t1 : go f1 bs1+                go _ _ = []+        decodeStream _ = []     return $ bgroup "DecodeUtf8"         [ bench "Strict" $ nf T.decodeUtf8 bs+        , bench "Stream" $ nf decodeStream lbs         , bench "IConv" $ iconv bs         , bench "StrictLength" $ nf (T.length . T.decodeUtf8) bs         , bench "StrictInitLength" $ nf (T.length . T.init . T.decodeUtf8) bs@@ -52,7 +60,7 @@         , bench "LazyStringUtf8Length" $ nf (length . U8.toString) lbs         ] -iconv :: ByteString -> IO CInt+iconv :: B.ByteString -> IO CInt iconv (PS fp off len) = withForeignPtr fp $ \ptr ->                         time_iconv (ptr `plusPtr` off) (fromIntegral len)
+ benchmarks/haskell/Benchmarks/Programs/BigTable.hs view
@@ -0,0 +1,42 @@+-- | Create a large HTML table and dump it to a handle+--+-- Tested in this benchmark:+--+-- * Creating a large HTML document using a builder+--+-- * Writing to a handle+--+{-# LANGUAGE OverloadedStrings #-}+module Benchmarks.Programs.BigTable+    ( benchmark+    ) where++import Criterion (Benchmark, bench)+import Data.Monoid (mappend, mconcat)+import Data.Text.Lazy.Builder (Builder, fromText, toLazyText)+import Data.Text.Lazy.IO (hPutStr)+import System.IO (Handle)+import qualified Data.Text as T++benchmark :: Handle -> IO Benchmark+benchmark sink = return $ bench "BigTable" $ do+    hPutStr sink "Content-Type: text/html\n\n<table>"+    hPutStr sink . toLazyText . makeTable =<< rows+    hPutStr sink "</table>"+  where+    -- We provide the number of rows in IO so the builder value isn't shared+    -- between the benchmark samples.+    rows :: IO Int+    rows = return 20000+    {-# NOINLINE rows #-}++makeTable :: Int -> Builder+makeTable n = mconcat $ replicate n $ mconcat $ map makeCol [1 .. 50]++makeCol :: Int -> Builder+makeCol 1 = fromText "<tr><td>1</td>"+makeCol 50 = fromText "<td>50</td></tr>"+makeCol i = fromText "<td>" `mappend` (fromInt i `mappend` fromText "</td>")++fromInt :: Int -> Builder+fromInt = fromText . T.pack . show
+ benchmarks/haskell/Benchmarks/Programs/Cut.hs view
@@ -0,0 +1,98 @@+-- | Cut into a file, selecting certain columns (e.g. columns 10 to 40)+--+-- Tested in this benchmark:+--+-- * Reading the file+--+-- * Splitting into lines+--+-- * Taking a number of characters from the lines+--+-- * Joining the lines+--+-- * Writing back to a handle+--+module Benchmarks.Programs.Cut+    ( benchmark+    ) where++import Criterion (Benchmark, bgroup, bench)+import System.IO (Handle, hPutStr)+import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as BC+import qualified Data.ByteString.Lazy as BL+import qualified Data.ByteString.Lazy.Char8 as BLC+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import qualified Data.Text.IO 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++benchmark :: FilePath -> Handle -> Int -> Int -> IO Benchmark+benchmark p sink from to = return $ bgroup "Cut"+    [ bench' "String" string+    , bench' "ByteString" byteString+    , bench' "LazyByteString" lazyByteString+    , bench' "Text" text+    , bench' "LazyText" lazyText+    , bench' "TextByteString" textByteString+    , bench' "LazyTextByteString" lazyTextByteString+    ]+  where+    bench' n s = bench n (s p sink from to)++string :: FilePath -> Handle -> Int -> Int -> IO ()+string fp sink from to = do+    s <- readFile fp+    hPutStr sink $ cut s+  where+    cut = unlines . map (take (to - from) . drop from) . lines++byteString :: FilePath -> Handle -> Int -> Int -> IO ()+byteString fp sink from to = do+    bs <- B.readFile fp+    B.hPutStr sink $ cut bs+  where+    cut = BC.unlines . map (B.take (to - from) . B.drop from) . BC.lines++lazyByteString :: FilePath -> Handle -> Int -> Int -> IO ()+lazyByteString fp sink from to = do+    bs <- BL.readFile fp+    BL.hPutStr sink $ cut bs+  where+    cut = BLC.unlines . map (BL.take (to' - from') . BL.drop from') . BLC.lines+    from' = fromIntegral from+    to' = fromIntegral to++text :: FilePath -> Handle -> Int -> Int -> IO ()+text fp sink from to = do+    t <- T.readFile fp+    T.hPutStr sink $ cut t+  where+    cut = T.unlines . map (T.take (to - from) . T.drop from) . T.lines++lazyText :: FilePath -> Handle -> Int -> Int -> IO ()+lazyText fp sink from to = do+    t <- TL.readFile fp+    TL.hPutStr sink $ cut t+  where+    cut = TL.unlines . map (TL.take (to' - from') . TL.drop from') . TL.lines+    from' = fromIntegral from+    to' = fromIntegral to++textByteString :: FilePath -> Handle -> Int -> Int -> IO ()+textByteString fp sink from to = do+    t <- T.decodeUtf8 `fmap` B.readFile fp+    B.hPutStr sink $ T.encodeUtf8 $ cut t+  where+    cut = T.unlines . map (T.take (to - from) . T.drop from) . T.lines++lazyTextByteString :: FilePath -> Handle -> Int -> Int -> IO ()+lazyTextByteString fp sink from to = do+    t <- TL.decodeUtf8 `fmap` BL.readFile fp+    BL.hPutStr sink $ TL.encodeUtf8 $ cut t+  where+    cut = TL.unlines . map (TL.take (to' - from') . TL.drop from') . TL.lines+    from' = fromIntegral from+    to' = fromIntegral to
+ benchmarks/haskell/Benchmarks/Programs/Fold.hs view
@@ -0,0 +1,68 @@+-- | Benchmark which formats paragraph, like the @sort@ unix utility.+--+-- Tested in this benchmark:+--+-- * Reading the file+--+-- * Splitting into paragraphs+--+-- * Reformatting the paragraphs to a certain line width+--+-- * Concatenating the results using the text builder+--+-- * Writing back to a handle+--+{-# LANGUAGE OverloadedStrings #-}+module Benchmarks.Programs.Fold+    ( benchmark+    ) where++import Data.List (foldl')+import Data.List (intersperse)+import Data.Monoid (mempty, mappend, mconcat)+import System.IO (Handle)+import Criterion (Benchmark, bench)+import qualified Data.Text as T+import qualified Data.Text.IO as T+import qualified Data.Text.Lazy.Builder as TLB+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.IO as TL++benchmark :: FilePath -> Handle -> IO Benchmark+benchmark i o = return $+    bench "Fold" $ T.readFile i >>= TL.hPutStr o . fold 80++-- | We represent a paragraph by a word list+--+type Paragraph = [T.Text]++-- | Fold a text+--+fold :: Int -> T.Text -> TL.Text+fold maxWidth = TLB.toLazyText . mconcat .+    intersperse "\n\n" . map (foldParagraph maxWidth) . paragraphs++-- | Fold a paragraph+--+foldParagraph :: Int -> Paragraph -> TLB.Builder+foldParagraph _    []       = mempty+foldParagraph max' (w : ws) = fst $ foldl' go (TLB.fromText w, T.length w) ws+  where+    go (builder, width) word+        | width + len + 1 <= max' =+            (builder `mappend` " " `mappend` word', width + len + 1)+        | otherwise =+            (builder `mappend` "\n" `mappend` word', len)+      where+        word' = TLB.fromText word+        len = T.length word++-- | Divide a text into paragraphs+--+paragraphs :: T.Text -> [Paragraph]+paragraphs = splitParagraphs . map T.words . T.lines+  where+    splitParagraphs ls = case break null ls of+        ([], []) -> []+        (p,  []) -> [concat p]+        (p,  lr) -> concat p : splitParagraphs (dropWhile null lr)
+ benchmarks/haskell/Benchmarks/Programs/Sort.hs view
@@ -0,0 +1,70 @@+-- | This benchmark sorts the lines of a file, like the @sort@ unix utility.+--+-- Tested in this benchmark:+--+-- * Reading the file+--+-- * Splitting into lines+--+-- * Sorting the lines+--+-- * Joining the lines+--+-- * Writing back to a handle+--+{-# LANGUAGE OverloadedStrings #-}+module Benchmarks.Programs.Sort+    ( benchmark+    ) where++import Criterion (Benchmark, bgroup, bench)+import Data.Monoid (mconcat)+import System.IO (Handle, hPutStr)+import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as BC+import qualified Data.ByteString.Lazy as BL+import qualified Data.ByteString.Lazy.Char8 as BLC+import qualified Data.List as L+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import qualified Data.Text.IO as T+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Builder as TLB+import qualified Data.Text.Lazy.Encoding as TL+import qualified Data.Text.Lazy.IO as TL++benchmark :: FilePath -> Handle -> IO Benchmark+benchmark i o = return $ bgroup "Sort"+    [ bench "String" $ readFile i >>= hPutStr o . string+    , bench "ByteString" $ B.readFile i >>= B.hPutStr o . byteString+    , bench "LazyByteString" $ BL.readFile i >>= BL.hPutStr o . lazyByteString+    , bench "Text" $ T.readFile i >>= T.hPutStr o . text+    , bench "LazyText" $ TL.readFile i >>= TL.hPutStr o . lazyText+    , bench "TextByteString" $ B.readFile i >>=+        B.hPutStr o . T.encodeUtf8 . text . T.decodeUtf8+    , bench "LazyTextByteString" $ BL.readFile i >>=+        BL.hPutStr o . TL.encodeUtf8 . lazyText .  TL.decodeUtf8+    , bench "TextBuilder" $ B.readFile i >>=+        BL.hPutStr o . TL.encodeUtf8 . textBuilder . T.decodeUtf8+    ]++string :: String -> String+string = unlines . L.sort . lines++byteString :: B.ByteString -> B.ByteString+byteString = BC.unlines . L.sort . BC.lines++lazyByteString :: BL.ByteString -> BL.ByteString+lazyByteString = BLC.unlines . L.sort . BLC.lines++text :: T.Text -> T.Text+text = T.unlines . L.sort . T.lines++lazyText :: TL.Text -> TL.Text+lazyText = TL.unlines . L.sort . TL.lines++-- | Text variant using a builder monoid for the final concatenation+--+textBuilder :: T.Text -> TL.Text+textBuilder = TLB.toLazyText . mconcat . L.intersperse (TLB.singleton '\n') .+    map TLB.fromText . L.sort . T.lines
+ benchmarks/haskell/Benchmarks/Programs/StripTags.hs view
@@ -0,0 +1,53 @@+-- | Program to replace HTML tags by whitespace+--+-- This program was originally contributed by Petr Prokhorenkov.+--+-- Tested in this benchmark:+--+-- * Reading the file+--+-- * Replacing text between HTML tags (<>) with whitespace+--+-- * Writing back to a handle+--+{-# OPTIONS_GHC -fspec-constr-count=5 #-}+module Benchmarks.Programs.StripTags+    ( benchmark+    ) where++import Criterion (Benchmark, bgroup, bench)+import Data.List (mapAccumL)+import System.IO (Handle, hPutStr)+import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as BC+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import qualified Data.Text.IO as T++benchmark :: FilePath -> Handle -> IO Benchmark+benchmark i o = return $ bgroup "StripTags"+    [ bench "String" $ readFile i >>= hPutStr o . string+    , bench "ByteString" $ B.readFile i >>= B.hPutStr o . byteString+    , bench "Text" $ T.readFile i >>= T.hPutStr o . text+    , bench "TextByteString" $+        B.readFile i >>= B.hPutStr o . T.encodeUtf8 . text . T.decodeUtf8+    ]++string :: String -> String+string = snd . mapAccumL step 0++text :: T.Text -> T.Text+text = snd . T.mapAccumL step 0++byteString :: B.ByteString -> B.ByteString+byteString = snd . BC.mapAccumL step 0++step :: Int -> Char -> (Int, Char)+step d c+    | d > 0 || d' > 0 = (d', ' ')+    | otherwise       = (d', c)+  where+    d' = d + depth c+    depth '>' = 1+    depth '<' = -1+    depth _   = 0
+ benchmarks/haskell/Benchmarks/Programs/Throughput.hs view
@@ -0,0 +1,41 @@+-- | This benchmark simply reads and writes a file using the various string+-- libraries. The point of it is that we can make better estimations on how+-- much time the other benchmarks spend doing IO.+--+-- Note that we expect ByteStrings to be a whole lot faster, since they do not+-- do any actual encoding/decoding here, while String and Text do have UTF-8+-- encoding/decoding.+--+-- Tested in this benchmark:+--+-- * Reading the file+--+-- * Replacing text between HTML tags (<>) with whitespace+--+-- * Writing back to a handle+--+module Benchmarks.Programs.Throughput+    ( benchmark+    ) where++import Criterion (Benchmark, bgroup, bench)+import System.IO (Handle, hPutStr)+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as BL+import qualified Data.Text.Encoding as T+import qualified Data.Text.IO as T+import qualified Data.Text.Lazy.Encoding as TL+import qualified Data.Text.Lazy.IO as TL++benchmark :: FilePath -> Handle -> IO Benchmark+benchmark fp sink = return $ bgroup "Throughput"+    [ bench "String" $ readFile fp >>= hPutStr sink+    , bench "ByteString" $ B.readFile fp >>= B.hPutStr sink+    , bench "LazyByteString" $ BL.readFile fp >>= BL.hPutStr sink+    , bench "Text" $ T.readFile fp >>= T.hPutStr sink+    , bench "LazyText" $ TL.readFile fp >>= TL.hPutStr sink+    , bench "TextByteString" $+        B.readFile fp >>= B.hPutStr sink . T.encodeUtf8 .  T.decodeUtf8+    , bench "LazyTextByteString" $+        BL.readFile fp >>= BL.hPutStr sink . TL.encodeUtf8 . TL.decodeUtf8+    ]
benchmarks/haskell/Benchmarks/Pure.hs view
@@ -18,7 +18,6 @@ import GHC.Base (Char (..), Int (..), chr#, ord#, (+#)) import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy.Char8 as BL-import qualified Data.ByteString.Lazy.Internal as BL import qualified Data.ByteString.UTF8 as UTF8 import qualified Data.List as L import qualified Data.Text as T
benchmarks/haskell/Benchmarks/Replace.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE BangPatterns #-} -- | Replace a string by another string -- -- Tested in this benchmark:@@ -12,6 +13,9 @@ import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy.Search as BL+import qualified Data.ByteString.Search as B+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 import qualified Data.Text.Lazy.IO as TL@@ -20,12 +24,20 @@ benchmark fp pat sub = do     tl <- TL.readFile fp     bl <- BL.readFile fp-    return $ bgroup "Replace"-        [ bench "LazyText"       $ nf (TL.length . TL.replace tpat tsub) tl-        , bench "LazyByteString" $ nf (BL.length . BL.replace bpat bsub) bl+    let !t = TL.toStrict tl+        !b = T.encodeUtf8 t+    return $ bgroup "Replace" [+          bench "Text"           $ nf (T.length . T.replace tpat tsub) t+        , bench "ByteString"     $ nf (BL.length . B.replace bpat bsub) b+        , bench "LazyText"       $ nf (TL.length . TL.replace tlpat tlsub) tl+        , bench "LazyByteString" $ nf (BL.length . BL.replace blpat blsub) bl         ]   where-    tpat = TL.pack pat-    tsub = TL.pack sub-    bpat = B.concat $ BL.toChunks $ TL.encodeUtf8 tpat-    bsub = B.concat $ BL.toChunks $ TL.encodeUtf8 tsub+    tpat  = T.pack pat+    tsub  = T.pack sub+    tlpat = TL.pack pat+    tlsub = TL.pack sub+    bpat = T.encodeUtf8 tpat+    bsub = T.encodeUtf8 tsub+    blpat = B.concat $ BL.toChunks $ TL.encodeUtf8 tlpat+    blsub = B.concat $ BL.toChunks $ TL.encodeUtf8 tlsub
benchmarks/text-benchmarks.cabal view
@@ -23,6 +23,7 @@   hs-source-dirs: haskell ..   c-sources:      ../cbits/cbits.c                   cbits/time_iconv.c+  include-dirs:   ../include   main-is:        Benchmarks.hs   ghc-options:    -Wall -O2   if flag(llvm)
cbits/cbits.c view
@@ -9,6 +9,7 @@ #include <string.h> #include <stdint.h> #include <stdio.h>+#include "text_cbits.h"  void _hs_text_memcpy(void *dest, size_t doff, const void *src, size_t soff, 		     size_t n)@@ -103,20 +104,41 @@  * A best-effort decoder. Runs until it hits either end of input or  * the start of an invalid byte sequence.  *- * At exit, updates *destoff with the next offset to write to, and- * returns the next source offset to read from.+ * At exit, we update *destoff with the next offset to write to, *src+ * with the next source location past the last one successfully+ * decoded, and return the next source location to read from.+ *+ * Moreover, we expose the internal decoder state (state0 and+ * codepoint0), allowing one to restart the decoder after it+ * terminates (say, due to a partial codepoint).+ *+ * In particular, there are a few possible outcomes,+ *+ *   1) We decoded the buffer entirely:+ *      In this case we return srcend+ *      state0 == UTF8_ACCEPT+ *+ *   2) We met an invalid encoding+ *      In this case we return the address of the first invalid byte+ *      state0 == UTF8_REJECT+ *+ *   3) We reached the end of the buffer while decoding a codepoint+ *      In this case we return a pointer to the first byte of the partial codepoint+ *      state0 != UTF8_ACCEPT, UTF8_REJECT+ *  */-uint8_t const *-_hs_text_decode_utf8(uint16_t *dest, size_t *destoff,-		     const uint8_t const *src, const uint8_t const *srcend)+const uint8_t *+_hs_text_decode_utf8_state(uint16_t *const dest, size_t *destoff,+                           const uint8_t **const src,+                           const uint8_t *const srcend,+                           uint32_t *codepoint0, uint32_t *state0) {   uint16_t *d = dest + *destoff;-  const uint8_t const *s = src;-  uint32_t state = UTF8_ACCEPT;+  const uint8_t *s = *src, *last = *src;+  uint32_t state = *state0;+  uint32_t codepoint = *codepoint0;    while (s < srcend) {-    uint32_t codepoint;- #if defined(__i386__) || defined(__x86_64__)     /*      * This code will only work on a little-endian system that@@ -144,6 +166,7 @@ 	*d++ = (uint16_t) ((codepoint >> 16) & 0xff); 	*d++ = (uint16_t) ((codepoint >> 24) & 0xff);       }+      last = s;     } #endif @@ -159,13 +182,29 @@       *d++ = (uint16_t) (0xD7C0 + (codepoint >> 10));       *d++ = (uint16_t) (0xDC00 + (codepoint & 0x3FF));     }+    last = s;   } -  /* Error recovery - if we're not in a valid finishing state, back up. */-  if (state != UTF8_ACCEPT)+  /* Invalid encoding, back up to the errant character */+  if (state == UTF8_REJECT)     s -= 1;    *destoff = d - dest;+  *codepoint0 = codepoint;+  *state0 = state;+  *src = last;    return s;+}++/*+ * Helper to decode buffer and discard final decoder state+ */+const uint8_t *+_hs_text_decode_utf8(uint16_t *const dest, size_t *destoff,+                     const uint8_t *src, const uint8_t *const srcend)+{+  uint32_t codepoint;+  uint32_t state = UTF8_ACCEPT;+  return _hs_text_decode_utf8_state(dest, destoff, &src, srcend, &codepoint, &state); }
+ changelog view
@@ -0,0 +1,16 @@+1.0.0.0++	* Added support for Unicode 6.3.0 to case conversion functions++	* New function toTitle converts words in a string to title case++	* New functions peekCStringLen and withCStringLen simplify+	  interoperability with C functionns++	* Added support for decoding UTF-8 in stream-friendly fashion++	* Fixed a bug in mapAccumL++	* Added trusted Haskell support++	* Removed support for GHC 6.10 (released in 2008) and older
+ include/text_cbits.h view
@@ -0,0 +1,11 @@+/*+ * Copyright (c) 2013 Bryan O'Sullivan <bos@serpentine.com>.+ */++#ifndef _text_cbits_h+#define _text_cbits_h++#define UTF8_ACCEPT 0+#define UTF8_REJECT 12++#endif
scripts/Arsec.hs view
@@ -1,6 +1,7 @@ module Arsec     (-      comment+      Comment+    , comment     , semi     , showC     , unichar@@ -23,13 +24,7 @@ import Text.ParserCombinators.Parsec.Error import Text.ParserCombinators.Parsec.Prim hiding ((<|>), many) -instance Applicative (GenParser s a) where-    pure = return-    (<*>) = ap--instance Alternative (GenParser s a) where-    empty = mzero-    (<|>) = mplus+type Comment = String  unichar :: Parser Char unichar = chr . fst . head . readHex <$> many1 hexDigit@@ -40,7 +35,7 @@ semi :: Parser () semi = char ';' *> spaces *> pure () -comment :: Parser String+comment :: Parser Comment comment = (char '#' *> manyTill anyToken (char '\n')) <|> string "\n"  showC :: Char -> String
scripts/CaseFolding.hs view
@@ -4,7 +4,8 @@  module CaseFolding     (-      Fold(..)+      CaseFolding(..)+    , Fold(..)     , parseCF     , mapCF     ) where@@ -18,19 +19,22 @@     , name :: String     } deriving (Eq, Ord, Show) -entries :: Parser [Fold]-entries = many comment *> many (entry <* many comment)+data CaseFolding = CF { cfComments :: [Comment], cfFolding :: [Fold] }+                 deriving (Show)++entries :: Parser CaseFolding+entries = CF <$> many comment <*> many (entry <* many comment)   where     entry = Fold <$> unichar <* semi                  <*> oneOf "CFST" <* semi                  <*> unichars                  <*> (string "# " *> manyTill anyToken (char '\n')) -parseCF :: FilePath -> IO (Either ParseError [Fold])+parseCF :: FilePath -> IO (Either ParseError CaseFolding) parseCF name = parse entries name <$> readFile name -mapCF :: [Fold] -> [String]-mapCF ms = typ ++ (map nice . filter p $ ms) ++ [last]+mapCF :: CaseFolding -> [String]+mapCF (CF _ ms) = typ ++ (map nice . filter p $ ms) ++ [last]   where     typ = ["foldMapping :: forall s. Char -> s -> Step (CC s) Char"            ,"{-# INLINE foldMapping #-}"]
scripts/CaseMapping.hs view
@@ -19,14 +19,20 @@            Left err -> print err >> return undefined            Right ms -> return ms   h <- openFile oname WriteMode-  mapM_ (hPutStrLn h) ["{-# LANGUAGE Rank2Types #-}"+  let comments = map ("--" ++) $+                 take 2 (cfComments cfs) ++ take 2 (scComments scs)+  mapM_ (hPutStrLn h) $+                      ["{-# LANGUAGE Rank2Types #-}"                       ,"-- AUTOMATICALLY GENERATED - DO NOT EDIT"-                      ,"-- Generated by scripts/SpecialCasing.hs"+                      ,"-- Generated by scripts/SpecialCasing.hs"] +++                      comments +++                      [""                       ,"module Data.Text.Fusion.CaseMapping where"                       ,"import Data.Char"                       ,"import Data.Text.Fusion.Internal"                       ,""]   mapM_ (hPutStrLn h) (mapSC "upper" upper toUpper scs)   mapM_ (hPutStrLn h) (mapSC "lower" lower toLower scs)+  mapM_ (hPutStrLn h) (mapSC "title" title toTitle scs)   mapM_ (hPutStrLn h) (mapCF cfs)   hClose h
scripts/SpecialCasing.hs view
@@ -4,13 +4,17 @@  module SpecialCasing     (-      Case(..)+      SpecialCasing(..)+    , Case(..)     , parseSC     , mapSC     ) where  import Arsec +data SpecialCasing = SC { scComments :: [Comment], scCasing :: [Case] }+                   deriving (Show)+ data Case = Case {       code :: Char     , lower :: [Char]@@ -20,8 +24,8 @@     , name :: String     } deriving (Eq, Ord, Show) -entries :: Parser [Case]-entries = many comment *> many (entry <* many comment)+entries :: Parser SpecialCasing+entries = SC <$> many comment <*> many (entry <* many comment)   where     entry = Case <$> unichar <* semi                  <*> unichars@@ -30,11 +34,13 @@                  <*> manyTill anyToken (string "# ")                  <*> manyTill anyToken (char '\n') -parseSC :: FilePath -> IO (Either ParseError [Case])+parseSC :: FilePath -> IO (Either ParseError SpecialCasing) parseSC name = parse entries name <$> readFile name -mapSC :: String -> (Case -> String) -> (Char -> Char) -> [Case] -> [String]-mapSC which access twiddle ms = typ ++ (map nice . filter p $ ms) ++ [last]+mapSC :: String -> (Case -> String) -> (Char -> Char) -> SpecialCasing+         -> [String]+mapSC which access twiddle (SC _ ms) =+    typ ++ (map nice . filter p $ ms) ++ [last]   where     typ = [which ++ "Mapping :: forall s. Char -> s -> Step (CC s) Char"            ,"{-# INLINE " ++ which ++ "Mapping #-}"]
tests/Tests/Properties.hs view
@@ -1,7 +1,7 @@ -- | General quicktest properties for the text library ---{-# LANGUAGE BangPatterns, FlexibleInstances, OverloadedStrings,-             ScopedTypeVariables, TypeSynonymInstances, CPP #-}+{-# LANGUAGE BangPatterns, CPP, FlexibleInstances, OverloadedStrings,+             ScopedTypeVariables, TypeSynonymInstances #-} {-# OPTIONS_GHC -fno-enable-rewrite-rules #-} {-# OPTIONS_GHC -fno-warn-missing-signatures #-} module Tests.Properties@@ -27,7 +27,6 @@ import Data.Text.Search (indices) import Data.Word (Word, Word8, Word16, Word32, Word64) import Numeric (showHex)-import Prelude hiding (catch, replicate) import Test.Framework (Test, testGroup) import Test.Framework.Providers.QuickCheck2 (testProperty) import qualified Data.Bits as Bits (shiftL, shiftR)@@ -54,6 +53,12 @@ import Tests.Utils import qualified Tests.SlowFunctions as Slow +#if MIN_VERSION_base(4,6,0)+import Prelude hiding (replicate)+#else+import Prelude hiding (catch, replicate)+#endif+ t_pack_unpack       = (T.unpack . T.pack) `eq` id tl_pack_unpack      = (TL.unpack . TL.pack) `eq` id t_stream_unstream   = (S.unstream . S.stream) `eq` id@@ -93,6 +98,18 @@ t_utf32BE    = forAll genUnicode $ (E.decodeUtf32BE . E.encodeUtf32BE) `eq` id tl_utf32BE   = forAll genUnicode $ (EL.decodeUtf32BE . EL.encodeUtf32BE) `eq` id +t_utf8_incr  = do+        Positive n <- arbitrary+        forAll genUnicode $ recode n `eq` id+    where recode n = T.concat . feedChunksOf n E.streamDecodeUtf8 . E.encodeUtf8+          feedChunksOf :: Int -> (B.ByteString -> E.Decoding) -> B.ByteString+                       -> [T.Text]+          feedChunksOf n f bs+            | B.null bs  = []+            | otherwise  = let (a,b) = B.splitAt n bs+                               E.Some t _ f' = f a+                           in t : feedChunksOf n f' b+ -- This is a poor attempt to ensure that the error handling paths on -- decode are exercised in some way.  Proper testing would be rather -- more involved.@@ -222,7 +239,7 @@  splitOn :: (Eq a) => [a] -> [a] -> [[a]] splitOn pat src0-    | l == 0    = error "empty"+    | l == 0    = error "splitOn: empty"     | otherwise = go src0   where     l           = length pat@@ -771,6 +788,7 @@       testProperty "tl_latin1" tl_latin1,       testProperty "t_utf8" t_utf8,       testProperty "t_utf8'" t_utf8',+      testProperty "t_utf8_incr" t_utf8_incr,       testProperty "tl_utf8" tl_utf8,       testProperty "tl_utf8'" tl_utf8',       testProperty "t_utf16LE" t_utf16LE,
tests/Tests/Regressions.hs view
@@ -8,7 +8,7 @@  import Control.Exception (SomeException, handle) import System.IO-import Test.HUnit (assertBool, assertFailure)+import Test.HUnit (assertBool, assertEqual, assertFailure) import qualified Data.ByteString as B import Data.ByteString.Char8 () import qualified Data.ByteString.Lazy as LB@@ -17,6 +17,7 @@ import qualified Data.Text.IO as T import qualified Data.Text.Lazy as LT import qualified Data.Text.Lazy.Encoding as LE+import qualified Data.Text.Unsafe as T import qualified Test.Framework as F import qualified Test.Framework.Providers.HUnit as F @@ -59,10 +60,23 @@   let t = TE.decodeUtf8With (\_ _ -> Just '\xdc00') "\x80"   assertBool "broken error recovery shouldn't break us" (t == "\xfffd") +-- Reported by Eric Seidel: we mishandled mapping Chars that fit in a+-- single Word16 to Chars that require two.+mapAccumL_resize :: IO ()+mapAccumL_resize = do+  let f a _ = (a, '\65536')+      count = 5+      val   = T.mapAccumL f (0::Int) (T.replicate count "a")+  assertEqual "mapAccumL should correctly fill buffers for two-word results"+             (0, T.replicate count "\65536") val+  assertEqual "mapAccumL should correctly size buffers for two-word results"+             (count * 2) (T.lengthWord16 (snd val))+ tests :: F.Test tests = F.testGroup "Regressions"     [ F.testCase "hGetContents_crash" hGetContents_crash     , F.testCase "lazy_encode_crash" lazy_encode_crash+    , F.testCase "mapAccumL_resize" mapAccumL_resize     , F.testCase "replicate_crash" replicate_crash     , F.testCase "utf8_decode_unsafe" utf8_decode_unsafe     ]
tests/text-tests.cabal view
@@ -64,6 +64,7 @@ library   hs-source-dirs: ..   c-sources: ../cbits/cbits.c+  include-dirs: ../include   exposed-modules:     Data.Text     Data.Text.Array
text.cabal view
@@ -1,5 +1,5 @@ name:           text-version:        0.11.3.1+version:        1.0.0.0 homepage:       https://github.com/bos/text bug-reports:    https://github.com/bos/text/issues synopsis:       An efficient packed Unicode text type.@@ -30,16 +30,7 @@     non-standard encodings, text breaking, and locales), see     the @text-icu@ package:     <http://hackage.haskell.org/package/text-icu>-    .-    &#8212;&#8212; RELEASE NOTES &#8212;&#8212;-    .-    Changes in 0.11.2.0:-    .-    * String literals are now converted directly from the format in-      which GHC stores them into 'Text', without an intermediate-      transformation through 'String', and without inlining of-      conversion code at each site where a string literal is declared.-    .+ license:        BSD3 license-file:   LICENSE author:         Bryan O'Sullivan <bos@serpentine.com>@@ -56,9 +47,12 @@     benchmarks/cbits/*.c     benchmarks/haskell/*.hs     benchmarks/haskell/Benchmarks/*.hs+    benchmarks/haskell/Benchmarks/Programs/*.hs     benchmarks/python/*.py     benchmarks/ruby/*.rb     benchmarks/text-benchmarks.cabal+    changelog+    include/*.h     scripts/*.hs     tests-and-benchmarks.markdown     tests/*.hs@@ -77,7 +71,8 @@   default: False  library-  c-sources: cbits/cbits.c+  c-sources:    cbits/cbits.c+  include-dirs: include    exposed-modules:     Data.Text@@ -124,42 +119,32 @@     Data.Text.Util    build-depends:-    array,-    base       < 5,-    bytestring >= 0.9-  if impl(ghc >= 6.10)-    build-depends:-      ghc-prim, base >= 4, deepseq >= 1.1.0.0-    cpp-options: -DHAVE_DEEPSEQ-  else-    build-depends: extensible-exceptions-    extensions: ScopedTypeVariables+    array      >= 0.3,+    base       >= 4.2 && < 5,+    bytestring >= 0.9,+    deepseq    >= 1.1.0.0,+    ghc-prim   >= 0.2 -  ghc-options: -Wall -funbox-strict-fields -O2-  if impl(ghc >= 6.8)-    ghc-options: -fwarn-tabs+  cpp-options: -DHAVE_DEEPSEQ+  ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2   if flag(developer)     ghc-prof-options: -auto-all     ghc-options: -Werror     cpp-options: -DASSERTS -  if impl(ghc >= 6.11)-    if flag(integer-simple)-      cpp-options: -DINTEGER_SIMPLE-      build-depends: integer-simple >= 0.1 && < 0.5-    else-      cpp-options: -DINTEGER_GMP-      build-depends: integer-gmp >= 0.2--  if impl(ghc >= 6.9) && impl(ghc < 6.11)+  if flag(integer-simple)+    cpp-options: -DINTEGER_SIMPLE+    build-depends: integer-simple >= 0.1 && < 0.5+  else     cpp-options: -DINTEGER_GMP-    build-depends: integer >= 0.1 && < 0.2+    build-depends: integer-gmp >= 0.2  test-suite tests   type:           exitcode-stdio-1.0   hs-source-dirs: tests .   main-is:        Tests.hs   c-sources:      cbits/cbits.c+  include-dirs:   include    ghc-options:     -Wall -threaded -O0 -rtsopts@@ -181,17 +166,12 @@     test-framework-hunit >= 0.2,     test-framework-quickcheck2 >= 0.2 -  if impl(ghc >= 6.11)-    if flag(integer-simple)-      cpp-options: -DINTEGER_SIMPLE-      build-depends: integer-simple >= 0.1 && < 0.5-    else-      cpp-options: -DINTEGER_GMP-      build-depends: integer-gmp >= 0.2--  if impl(ghc >= 6.9) && impl(ghc < 6.11)+  if flag(integer-simple)+    cpp-options: -DINTEGER_SIMPLE+    build-depends: integer-simple >= 0.1 && < 0.5+  else     cpp-options: -DINTEGER_GMP-    build-depends: integer >= 0.1 && < 0.2+    build-depends: integer-gmp >= 0.2  source-repository head   type:     git