text 1.1.0.1 → 1.1.1.0
raw patch · 16 files changed
+257/−129 lines, 16 filesdep ~QuickCheck
Dependency ranges changed: QuickCheck
Files
- Data/Text.hs +82/−42
- Data/Text/Encoding.hs +3/−3
- Data/Text/Internal.hs +10/−6
- Data/Text/Internal/Fusion.hs +4/−4
- Data/Text/Internal/Fusion/Common.hs +4/−3
- Data/Text/Internal/Fusion/Size.hs +59/−46
- Data/Text/Internal/Private.hs +4/−4
- Data/Text/Lazy.hs +39/−4
- Data/Text/Unsafe.hs +11/−0
- benchmarks/text-benchmarks.cabal +2/−1
- cbits/cbits.c +6/−6
- tests/Tests/Properties.hs +16/−5
- tests/Tests/QuickCheckUtils.hs +1/−1
- tests/cabal.config +7/−0
- tests/text-tests.cabal +5/−2
- text.cabal +4/−2
Data/Text.hs view
@@ -122,7 +122,9 @@ -- ** Breaking strings , take+ , takeEnd , drop+ , dropEnd , takeWhile , dropWhile , dropWhileEnd@@ -200,8 +202,8 @@ import Control.Exception (assert) #endif import Data.Char (isSpace)-import Data.Data (Data(gfoldl, toConstr, gunfold, dataTypeOf))-import Data.Data (mkNoRepType)+import Data.Data (Data(gfoldl, toConstr, gunfold, dataTypeOf), constrIndex,+ Constr, mkConstr, DataType, mkDataType, Fixity(Prefix)) import Control.Monad (foldM) import qualified Data.Text.Array as A import qualified Data.List as L@@ -211,10 +213,10 @@ import qualified Data.Text.Internal.Fusion.Common as S import Data.Text.Internal.Fusion (stream, reverseStream, unstream) import Data.Text.Internal.Private (span_)-import Data.Text.Internal (Text(..), empty, firstf, safe, text, textP)+import Data.Text.Internal (Text(..), empty, firstf, safe, text) import qualified Prelude as P import Data.Text.Unsafe (Iter(..), iter, iter_, lengthWord16, reverseIter,- unsafeHead, unsafeTail)+ reverseIter_, unsafeHead, unsafeTail) import Data.Text.Internal.Unsafe.Char (unsafeChr) import qualified Data.Text.Internal.Functions as F import qualified Data.Text.Internal.Encoding.Utf16 as U16@@ -333,21 +335,32 @@ -- | This instance preserves data abstraction at the cost of inefficiency. -- We omit reflection services for the sake of data abstraction. ----- This instance was created by copying the behavior of Data.Set and--- Data.Map. If you feel a mistake has been made, please feel free to+-- This instance was created by copying the updated behavior of @Data.Set@ and+-- @Data.Map@. If you feel a mistake has been made, please feel free to -- submit improvements. -- -- Original discussion is archived here: ----- "could we get a Data instance for Data.Text.Text?"--- http://groups.google.com/group/haskell-cafe/browse_thread/thread/b5bbb1b28a7e525d/0639d46852575b93+-- <http://groups.google.com/group/haskell-cafe/browse_thread/thread/b5bbb1b28a7e525d/0639d46852575b93 could we get a Data instance for Data.Text.Text?>+--+-- The followup discussion that changed the behavior of @Data.Set@ and @Data.Map@ is archived here+--+-- <http://markmail.org/message/trovdc6zkphyi3cr#query:+page:1+mid:a46der3iacwjcf6n+state:results Proposal: Allow gunfold for Data.Map, ...> instance Data Text where gfoldl f z txt = z pack `f` (unpack txt)- toConstr _ = P.error "Data.Text.Text.toConstr"- gunfold _ _ = P.error "Data.Text.Text.gunfold"- dataTypeOf _ = mkNoRepType "Data.Text.Text"+ toConstr _ = packConstr+ gunfold k z c = case constrIndex c of+ 1 -> k (z pack)+ _ -> P.error "gunfold"+ dataTypeOf _ = textDataType +packConstr :: Constr+packConstr = mkConstr textDataType "pack" [] Prefix++textDataType :: DataType+textDataType = mkDataType "Data.Text.Text" [packConstr]+ -- | /O(n)/ Compare two 'Text' values lexicographically. compareText :: Text -> Text -> Ordering compareText ta@(Text _arrA _offA lenA) tb@(Text _arrB _offB lenB)@@ -450,7 +463,7 @@ uncons :: Text -> Maybe (Char, Text) uncons t@(Text arr off len) | len <= 0 = Nothing- | otherwise = Just (c, textP arr (off+d) (len-d))+ | otherwise = Just (c, text arr (off+d) (len-d)) where Iter c d = iter t 0 {-# INLINE [1] uncons #-} @@ -481,7 +494,7 @@ tail :: Text -> Text tail t@(Text arr off len) | len <= 0 = emptyError "tail"- | otherwise = textP arr (off+d) (len-d)+ | otherwise = text arr (off+d) (len-d) where d = iter_ t 0 {-# INLINE [1] tail #-} @@ -496,8 +509,8 @@ -- be non-empty. Subject to fusion. init :: Text -> Text init (Text arr off len) | len <= 0 = emptyError "init"- | n >= 0xDC00 && n <= 0xDFFF = textP arr off (len-2)- | otherwise = textP arr off (len-1)+ | n >= 0xDC00 && n <= 0xDFFF = text arr off (len-2)+ | otherwise = text arr off (len-1) where n = A.unsafeIndex arr (off+len-1) {-# INLINE [1] init #-}@@ -1002,14 +1015,16 @@ take n t@(Text arr off len) | n <= 0 = empty | n >= len = t- | otherwise = Text arr off (loop 0 0)- where- loop !i !cnt- | i >= len || cnt >= n = i- | otherwise = loop (i+d) (cnt+1)- where d = iter_ t i+ | otherwise = text arr off (iterN n t) {-# INLINE [1] take #-} +iterN :: Int -> Text -> Int+iterN n t@(Text _arr _off len) = loop 0 0+ where loop !i !cnt+ | i >= len || cnt >= n = i+ | otherwise = loop (i+d) (cnt+1)+ where d = iter_ t i+ {-# RULES "TEXT take -> fused" [~1] forall n t. take n t = unstream (S.take n (stream t))@@ -1017,6 +1032,27 @@ unstream (S.take n (stream t)) = take n t #-} +-- | /O(n)/ 'takeEnd' @n@ @t@ returns the suffix remaining after+-- taking @n@ characters from the end of @t@.+--+-- Examples:+--+-- > takeEnd 3 "foobar" == "bar"+takeEnd :: Int -> Text -> Text+takeEnd n t@(Text arr off len)+ | n <= 0 = empty+ | n >= len = t+ | otherwise = text arr (off+i) (len-i)+ where i = iterNEnd n t++iterNEnd :: Int -> Text -> Int+iterNEnd n t@(Text _arr _off len) = loop (len-1) n+ where loop i !m+ | i <= 0 = 0+ | m <= 1 = i+ | otherwise = loop (i+d) (m-1)+ where d = reverseIter_ t i+ -- | /O(n)/ 'drop' @n@, applied to a 'Text', returns the suffix of the -- 'Text' after the first @n@ characters, or the empty 'Text' if @n@ -- is greater than the length of the 'Text'. Subject to fusion.@@ -1024,11 +1060,8 @@ drop n t@(Text arr off len) | n <= 0 = t | n >= len = empty- | otherwise = loop 0 0- where loop !i !cnt- | i >= len || cnt >= n = Text arr (off+i) (len-i)- | otherwise = loop (i+d) (cnt+1)- where d = iter_ t i+ | otherwise = text arr (off+i) (len-i)+ where i = iterN n t {-# INLINE [1] drop #-} {-# RULES@@ -1038,6 +1071,18 @@ unstream (S.drop n (stream t)) = drop n t #-} +-- | /O(n)/ 'dropEnd' @n@ @t@ returns the prefix remaining after+-- dropping @n@ characters from the end of @t@.+--+-- Examples:+--+-- > dropEnd 3 "foobar" == "foo"+dropEnd :: Int -> Text -> Text+dropEnd n t@(Text arr off len)+ | n <= 0 = t+ | n >= len = empty+ | otherwise = text arr off (iterNEnd n t)+ -- | /O(n)/ 'takeWhile', applied to a predicate @p@ and a 'Text', -- returns the longest prefix (possibly empty) of elements that -- satisfy @p@. Subject to fusion.@@ -1045,7 +1090,7 @@ takeWhile p t@(Text arr off len) = loop 0 where loop !i | i >= len = t | p c = loop (i+d)- | otherwise = textP arr off i+ | otherwise = text arr off i where Iter c d = iter t i {-# INLINE [1] takeWhile #-} @@ -1130,13 +1175,8 @@ splitAt n t@(Text arr off len) | n <= 0 = (empty, t) | n >= len = (t, empty)- | otherwise = (Text arr off k, Text arr (off+k) (len-k))- where k = loop 0 0- loop !i !cnt- | i >= len || cnt >= n = i- | otherwise = loop (i+d) (cnt+1)- where d = iter_ t i-{-# INLINE splitAt #-}+ | otherwise = let k = iterN n t+ in (text arr off k, text arr (off+k) (len-k)) -- | /O(n)/ 'span', applied to a predicate @p@ and text @t@, returns -- a pair whose first element is the longest prefix (possibly empty)@@ -1218,8 +1258,8 @@ | isSingleton pat = split (== unsafeHead pat) src | otherwise = go 0 (indices pat src) where- go !s (x:xs) = textP arr (s+off) (x-s) : go (x+l) xs- go s _ = [textP arr (s+off) (len-s)]+ go !s (x:xs) = text arr (s+off) (x-s) : go (x+l) xs+ go s _ = [text arr (s+off) (len-s)] {-# INLINE [1] splitOn #-} {-# RULES@@ -1311,7 +1351,7 @@ | null pat = emptyError "breakOn" | otherwise = case indices pat src of [] -> (src, empty)- (x:_) -> (textP arr off x, textP arr (off+x) (len-x))+ (x:_) -> (text arr off x, text arr (off+x) (len-x)) {-# INLINE breakOn #-} -- | /O(n+m)/ Similar to 'breakOn', but searches from the end of the@@ -1353,7 +1393,7 @@ | otherwise = L.map step (indices pat src) where step x = (chunk 0 x, chunk x (slen-x))- chunk !n !l = textP arr (n+off) l+ chunk !n !l = text arr (n+off) l {-# INLINE breakOnAll #-} -------------------------------------------------------------------------------@@ -1553,7 +1593,7 @@ -- > fnordLength _ = -1 stripPrefix :: Text -> Text -> Maybe Text stripPrefix p@(Text _arr _off plen) t@(Text arr off len)- | p `isPrefixOf` t = Just $! textP arr (off+plen) (len-plen)+ | p `isPrefixOf` t = Just $! text arr (off+plen) (len-plen) | otherwise = Nothing -- | /O(n)/ Find the longest non-empty common prefix of two strings@@ -1573,8 +1613,8 @@ where go !i !j | i < len0 && j < len1 && a == b = go (i+d0) (j+d1) | i > 0 = Just (Text arr0 off0 i,- textP arr0 (off0+i) (len0-i),- textP arr1 (off1+j) (len1-j))+ text arr0 (off0+i) (len0-i),+ text arr1 (off1+j) (len1-j)) | otherwise = Nothing where Iter a d0 = iter t0 i Iter b d1 = iter t1 j@@ -1599,7 +1639,7 @@ -- > quuxLength _ = -1 stripSuffix :: Text -> Text -> Maybe Text stripSuffix p@(Text _arr _off plen) t@(Text arr off len)- | p `isSuffixOf` t = Just $! textP arr off (len-plen)+ | p `isSuffixOf` t = Just $! text arr off (len-plen) | otherwise = Nothing -- | Add a list of non-negative numbers. Errors out on overflow.
Data/Text/Encoding.hs view
@@ -86,7 +86,7 @@ import Data.ByteString.Internal as B hiding (c2w) import Data.Text () import Data.Text.Encoding.Error (OnDecodeError, UnicodeException, strictDecode)-import Data.Text.Internal (Text(..), safe, textP)+import Data.Text.Internal (Text(..), safe, text) import Data.Text.Internal.Private (runText) import Data.Text.Internal.Unsafe.Char (unsafeWrite) import Data.Text.Internal.Unsafe.Shift (shiftR)@@ -130,7 +130,7 @@ -- 'decodeLatin1' is semantically equivalent to -- @Data.Text.pack . Data.ByteString.Char8.unpack@ decodeLatin1 :: ByteString -> Text-decodeLatin1 (PS fp off len) = textP a 0 len+decodeLatin1 (PS fp off len) = text a 0 len where a = A.run (A.new len >>= unsafeIOToST . go) go dest = withForeignPtr fp $ \ptr -> do@@ -285,7 +285,7 @@ codepoint <- peek codepointPtr chunkText <- unsafeSTToIO $ do arr <- A.unsafeFreeze dest- return $! textP arr 0 (fromIntegral n)+ return $! text arr 0 (fromIntegral n) lastPtr <- peek curPtrPtr let left = lastPtr `minusPtr` curPtr undecoded = case state of
Data/Text/Internal.hs view
@@ -54,8 +54,8 @@ deriving (Typeable) -- | Smart constructor.-text :: A.Array -> Int -> Int -> Text-text arr off len =+text_ :: A.Array -> Int -> Int -> Text+text_ arr off len = #if defined(ASSERTS) let c = A.unsafeIndex arr off alen = A.length arr@@ -65,7 +65,7 @@ assert (len == 0 || c < 0xDC00 || c > 0xDFFF) $ #endif Text arr off len-{-# INLINE text #-}+{-# INLINE text_ #-} -- | /O(1)/ The empty 'Text'. empty :: Text@@ -74,10 +74,14 @@ -- | Construct a 'Text' without invisibly pinning its byte array in -- memory if its length has dwindled to zero.+text :: A.Array -> Int -> Int -> Text+text arr off len | len == 0 = empty+ | otherwise = text_ arr off len+{-# INLINE text #-}+ textP :: A.Array -> Int -> Int -> Text-textP arr off len | len == 0 = empty- | otherwise = text arr off len-{-# INLINE textP #-}+{-# DEPRECATED textP "Use text instead" #-}+textP = text -- | A useful 'show'-like function for debugging purposes. showText :: Text -> String
Data/Text/Internal/Fusion.hs view
@@ -68,7 +68,7 @@ -- | /O(n)/ Convert a 'Text' into a 'Stream Char'. stream :: Text -> Stream Char-stream (Text arr off len) = Stream next off (maxSize len)+stream (Text arr off len) = Stream next off (betweenSize (len `shiftR` 1) len) where !end = off+len next !i@@ -83,7 +83,7 @@ -- | /O(n)/ Convert a 'Text' into a 'Stream Char', but iterate -- backwards. reverseStream :: Text -> Stream Char-reverseStream (Text arr off len) = Stream next (off+len-1) (maxSize len)+reverseStream (Text arr off len) = Stream next (off+len-1) (betweenSize (len `shiftR` 1) len) where {-# INLINE next #-} next !i@@ -132,7 +132,7 @@ reverse :: Stream Char -> Text reverse (Stream next s len0) | isEmpty len0 = I.empty- | otherwise = I.textP arr off' len'+ | otherwise = I.text arr off' len' where len0' = upperBound 4 (larger len0 4) (arr, (off', len')) = A.run2 (A.new len0' >>= loop s (len0'-1) len0')@@ -210,7 +210,7 @@ -- function to each element of a 'Text', passing an accumulating -- parameter from left to right, and returns a final 'Text'. mapAccumL :: (a -> Char -> (a,Char)) -> a -> Stream Char -> (a, Text)-mapAccumL f z0 (Stream next0 s0 len) = (nz,I.textP na 0 nl)+mapAccumL f z0 (Stream next0 s0 len) = (nz, I.text na 0 nl) where (na,(nz,nl)) = A.run2 (A.new mlen >>= \arr -> outer arr mlen z0 s0 0) where mlen = upperBound 4 len
Data/Text/Internal/Fusion/Common.hs view
@@ -315,12 +315,13 @@ -- -- This function gives the same answer as comparing against the result -- of 'lengthI', but can short circuit if the count of characters is--- greater than the number, and hence be more efficient.+-- greater than the number or if the stream can't possibly be as long+-- as the number supplied, and hence be more efficient. compareLengthI :: Integral a => Stream Char -> a -> Ordering compareLengthI (Stream next s0 len) n =- case exactly len of+ case compareSize len (fromIntegral n) of+ Just o -> o Nothing -> loop_cmp 0 s0- Just i -> compare (fromIntegral i) n where loop_cmp !z s = case next s of Done -> compare z n
Data/Text/Internal/Fusion/Size.hs view
@@ -22,10 +22,13 @@ , exactly , exactSize , maxSize+ , betweenSize , unknownSize , smaller , larger , upperBound+ , lowerBound+ , compareSize , isEmpty ) where @@ -33,14 +36,13 @@ import Control.Exception (assert) #endif -data Size = Exact {-# UNPACK #-} !Int -- ^ Exact size.- | Max {-# UNPACK #-} !Int -- ^ Upper bound on size.- | Unknown -- ^ Unknown size.+data Size = Between {-# UNPACK #-} !Int {-# UNPACK #-} !Int -- ^ Lower and upper bounds on size.+ | Unknown -- ^ Unknown size. deriving (Eq, Show) exactly :: Size -> Maybe Int-exactly (Exact n) = Just n-exactly _ = Nothing+exactly (Between na nb) | na == nb = Just na+exactly _ = Nothing {-# INLINE exactly #-} exactSize :: Int -> Size@@ -48,7 +50,7 @@ #if defined(ASSERTS) assert (n >= 0) #endif- Exact n+ Between n n {-# INLINE exactSize #-} maxSize :: Int -> Size@@ -56,9 +58,18 @@ #if defined(ASSERTS) assert (n >= 0) #endif- Max n+ Between 0 n {-# INLINE maxSize #-} +betweenSize :: Int -> Int -> Size+betweenSize m n =+#if defined(ASSERTS)+ assert (m >= 0)+ assert (n >= m)+#endif+ Between m n+{-# INLINE betweenSize #-}+ unknownSize :: Size unknownSize = Unknown {-# INLINE unknownSize #-}@@ -68,7 +79,7 @@ (-) = subtractSize (*) = mulSize - fromInteger = f where f = Exact . fromInteger+ fromInteger = f where f = exactSize . fromInteger {-# INLINE f #-} add :: Int -> Int -> Int@@ -78,20 +89,15 @@ {-# INLINE add #-} addSize :: Size -> Size -> Size-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+addSize (Between ma mb) (Between na nb) = Between (add ma na) (add mb nb)+addSize _ _ = Unknown {-# INLINE addSize #-} subtractSize :: Size -> Size -> Size-subtractSize (Exact m) (Exact n) = Exact (max (m-n) 0)-subtractSize (Exact m) (Max _) = Max m-subtractSize (Max m) (Exact n) = Max (max (m-n) 0)-subtractSize a@(Max _) (Max _) = a-subtractSize a@(Max _) Unknown = a-subtractSize _ _ = Unknown+subtractSize (Between ma mb) (Between na nb) = Between (max (ma-nb) 0) (max (mb-na) 0)+subtractSize a@(Between 0 _) Unknown = a+subtractSize (Between _ mb) Unknown = Between 0 mb+subtractSize _ _ = Unknown {-# INLINE subtractSize #-} mul :: Int -> Int -> Int@@ -101,48 +107,55 @@ {-# INLINE mul #-} mulSize :: Size -> Size -> Size-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+mulSize (Between ma mb) (Between na nb) = Between (mul ma na) (mul mb nb)+mulSize _ _ = Unknown {-# INLINE mulSize #-} -- | Minimum of two size hints. smaller :: Size -> Size -> Size-smaller (Exact m) (Exact n) = Exact (m `min` n)-smaller (Exact m) (Max n) = Max (m `min` n)-smaller (Exact m) Unknown = Max m-smaller (Max m) (Exact n) = Max (m `min` n)-smaller (Max m) (Max n) = Max (m `min` n)-smaller a@(Max _) Unknown = a-smaller Unknown (Exact n) = Max n-smaller Unknown (Max n) = Max n-smaller Unknown Unknown = Unknown+smaller a@(Between ma mb) b@(Between na nb)+ | mb <= na = a+ | nb <= ma = b+ | otherwise = Between (ma `min` na) (mb `min` nb)+smaller a@(Between 0 _) Unknown = a+smaller (Between _ mb) Unknown = Between 0 mb+smaller Unknown b@(Between 0 _) = b+smaller Unknown (Between _ nb) = Between 0 nb+smaller Unknown Unknown = Unknown {-# INLINE smaller #-} -- | Maximum of two size hints. larger :: Size -> Size -> Size-larger (Exact m) (Exact n) = Exact (m `max` n)-larger a@(Exact m) b@(Max n) | m >= n = a- | otherwise = b-larger a@(Max m) b@(Exact n) | n >= m = b- | otherwise = a-larger (Max m) (Max n) = Max (m `max` n)-larger _ _ = Unknown+larger a@(Between ma mb) b@(Between na nb)+ | ma >= nb = a+ | na >= mb = b+ | otherwise = Between (ma `max` na) (mb `max` nb)+larger _ _ = Unknown {-# INLINE larger #-} -- | Compute the maximum size from a size hint, if possible. upperBound :: Int -> Size -> Int-upperBound _ (Exact n) = n-upperBound _ (Max n) = n-upperBound k _ = k+upperBound _ (Between n _) = n+upperBound k _ = k {-# INLINE upperBound #-} +-- | Compute the maximum size from a size hint, if possible.+lowerBound :: Int -> Size -> Int+lowerBound _ (Between n _) = n+lowerBound k _ = k+{-# INLINE lowerBound #-}++compareSize :: Size -> Int -> Maybe Ordering+compareSize (Between ma mb) n+ | mb < n = Just LT+ | ma > n = Just GT+ | ma == n && mb == n = Just EQ+compareSize _ _ = Nothing++ isEmpty :: Size -> Bool-isEmpty (Exact n) = n <= 0-isEmpty (Max n) = n <= 0-isEmpty _ = False+isEmpty (Between _ n) = n <= 0+isEmpty _ = False {-# INLINE isEmpty #-} overflowError :: Int
Data/Text/Internal/Private.hs view
@@ -16,14 +16,14 @@ ) where import Control.Monad.ST (ST, runST)-import Data.Text.Internal (Text(..), textP)+import Data.Text.Internal (Text(..), text) import Data.Text.Unsafe (Iter(..), iter) import qualified Data.Text.Array as A span_ :: (Char -> Bool) -> Text -> (# Text, Text #) span_ p t@(Text arr off len) = (# hd,tl #)- where hd = textP arr off k- tl = textP arr (off+k) (len-k)+ where hd = text arr off k+ tl = text arr (off+k) (len-k) !k = loop 0 loop !i | i < len && p c = loop (i+d) | otherwise = i@@ -33,5 +33,5 @@ runText :: (forall s. (A.MArray s -> Int -> ST s Text) -> ST s Text) -> Text runText act = runST (act $ \ !marr !len -> do arr <- A.unsafeFreeze marr- return $! textP arr 0 len)+ return $! text arr 0 len) {-# INLINE runText #-}
Data/Text/Lazy.hs view
@@ -129,7 +129,9 @@ -- ** Breaking strings , take+ , takeEnd , drop+ , dropEnd , takeWhile , dropWhile , dropWhileEnd@@ -213,7 +215,7 @@ import Data.Text.Internal.Fusion.Types (PairS(..)) import Data.Text.Internal.Lazy.Fusion (stream, unstream) import Data.Text.Internal.Lazy (Text(..), chunk, empty, foldlChunks, foldrChunks)-import Data.Text.Internal (firstf, safe, textP)+import Data.Text.Internal (firstf, safe, text) import qualified Data.Text.Internal.Functions as F import Data.Text.Internal.Lazy.Search (indices) #if __GLASGOW_HASKELL__ >= 702@@ -935,6 +937,22 @@ unstream (S.take n (stream t)) = take n t #-} +-- | /O(n)/ 'takeEnd' @n@ @t@ returns the suffix remaining after+-- taking @n@ characters from the end of @t@.+--+-- Examples:+--+-- > takeEnd 3 "foobar" == "bar"+takeEnd :: Int64 -> Text -> Text+takeEnd n t0+ | n <= 0 = empty+ | otherwise = takeChunk n empty . L.reverse . toChunks $ t0+ where takeChunk _ acc [] = acc+ takeChunk i acc (t:ts)+ | i <= l = chunk (T.takeEnd (fromIntegral i) t) acc+ | otherwise = takeChunk (i-l) (Chunk t acc) ts+ where l = fromIntegral (T.length t)+ -- | /O(n)/ 'drop' @n@, applied to a 'Text', returns the suffix of the -- 'Text' after the first @n@ characters, or the empty 'Text' if @n@ -- is greater than the length of the 'Text'. Subject to fusion.@@ -957,6 +975,23 @@ unstream (S.drop n (stream t)) = drop n t #-} +-- | /O(n)/ 'dropEnd' @n@ @t@ returns the prefix remaining after+-- dropping @n@ characters from the end of @t@.+--+-- Examples:+--+-- > dropEnd 3 "foobar" == "foo"+dropEnd :: Int64 -> Text -> Text+dropEnd n t0+ | n <= 0 = t0+ | otherwise = dropChunk n . L.reverse . toChunks $ t0+ where dropChunk _ [] = empty+ dropChunk m (t:ts)+ | m >= l = dropChunk (m-l) ts+ | otherwise = fromChunks . L.reverse $+ T.dropEnd (fromIntegral m) t : ts+ where l = fromIntegral (T.length t)+ -- | /O(n)/ 'dropWords' @n@ returns the suffix with @n@ 'Word16' -- values dropped, or the empty 'Text' if @n@ is greater than the -- number of 'Word16' values present.@@ -967,7 +1002,7 @@ where drop' 0 ts = ts drop' _ Empty = Empty drop' n (Chunk (T.Text arr off len) ts)- | n < len' = chunk (textP arr (off+n') (len-n')) ts+ | n < len' = chunk (text arr (off+n') (len-n')) ts | otherwise = drop' (n - len') ts where len' = fromIntegral len n' = fromIntegral n@@ -1078,8 +1113,8 @@ splitAtWord x (Chunk c@(T.Text arr off len) cs) | y >= len = let h :*: t = splitAtWord (x-fromIntegral len) cs in Chunk c h :*: t- | otherwise = chunk (textP arr off y) empty :*:- chunk (textP arr (off+y) (len-y)) cs+ | otherwise = chunk (text arr off y) empty :*:+ chunk (text arr (off+y) (len-y)) cs where y = fromIntegral x -- | /O(n+m)/ Find the first instance of @needle@ (which must be
Data/Text/Unsafe.hs view
@@ -18,6 +18,7 @@ , iter , iter_ , reverseIter+ , reverseIter_ , unsafeHead , unsafeTail , lengthWord16@@ -93,6 +94,16 @@ j = off + i k = j - 1 {-# INLINE reverseIter #-}++-- | /O(1)/ Iterate one step backwards through a UTF-16 array,+-- returning the delta to add (i.e. a negative number) to give the+-- next offset to iterate at.+reverseIter_ :: Text -> Int -> Int+reverseIter_ (Text arr off _len) i+ | m < 0xDC00 || m > 0xDFFF = -1+ | otherwise = -2+ where m = A.unsafeIndex arr (off+i)+{-# INLINE reverseIter_ #-} -- | /O(1)/ Return the length of a 'Text' in units of 'Word16'. This -- is useful for sizing a target array appropriately before using
benchmarks/text-benchmarks.cabal view
@@ -18,6 +18,7 @@ flag llvm description: use LLVM default: False+ manual: True executable text-benchmarks hs-source-dirs: haskell ..@@ -25,7 +26,7 @@ cbits/time_iconv.c include-dirs: ../include main-is: Benchmarks.hs- ghc-options: -Wall -O2+ ghc-options: -Wall -O2 -rtsopts if flag(llvm) ghc-options: -fllvm cpp-options: -DHAVE_DEEPSEQ -DINTEGER_GMP
cbits/cbits.c view
@@ -68,8 +68,8 @@ * an UTF16 array */ void-_hs_text_decode_latin1(uint16_t *dest, const uint8_t const *src,- const uint8_t const *srcend)+_hs_text_decode_latin1(uint16_t *dest, const uint8_t *src,+ const uint8_t *srcend) { const uint8_t *p = src; @@ -130,14 +130,14 @@ #if defined(__GNUC__) || defined(__clang__) static inline uint8_t const * _hs_text_decode_utf8_int(uint16_t *const dest, size_t *destoff,- const uint8_t const **src, const uint8_t const *srcend,+ const uint8_t **src, const uint8_t *srcend, uint32_t *codepoint0, uint32_t *state0) __attribute((always_inline)); #endif static inline uint8_t const * _hs_text_decode_utf8_int(uint16_t *const dest, size_t *destoff,- const uint8_t const **src, const uint8_t const *srcend,+ const uint8_t **src, const uint8_t *srcend, uint32_t *codepoint0, uint32_t *state0) { uint16_t *d = dest + *destoff;@@ -202,8 +202,8 @@ uint8_t const * _hs_text_decode_utf8_state(uint16_t *const dest, size_t *destoff,- const uint8_t const **src,- const uint8_t const *srcend,+ const uint8_t **src,+ const uint8_t *srcend, uint32_t *codepoint0, uint32_t *state0) { uint8_t const *ret = _hs_text_decode_utf8_int(dest, destoff, src, srcend,
tests/Tests/Properties.hs view
@@ -30,6 +30,7 @@ import Test.Framework.Providers.QuickCheck2 (testProperty) import Test.QuickCheck hiding ((.&.)) import Test.QuickCheck.Monadic+import Test.QuickCheck.Property (Property(..)) import Tests.QuickCheckUtils import Tests.Utils import Text.Show.Functions ()@@ -94,9 +95,7 @@ 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+t_utf8_incr = forAll genUnicode $ \s (Positive n) -> (recode n `eq` id) s where recode n = T.concat . map fst . feedChunksOf n E.streamDecodeUtf8 . E.encodeUtf8 @@ -127,9 +126,9 @@ Leading -> B.append <$> genInvalidUTF8 <*> genUTF8 Trailing -> B.append <$> genUTF8 <*> genInvalidUTF8 genUTF8 = E.encodeUtf8 <$> genUnicode- forAll gen $ \bs -> do+ forAll gen $ \bs -> MkProperty $ do onErr <- genDecodeErr de- monadicIO $ do+ unProperty . monadicIO $ do l <- run $ let len = T.length (E.decodeUtf8With onErr bs) in (len `seq` return (Right len)) `Exception.catch` (\(e::UnicodeException) -> return (Left e))@@ -462,14 +461,22 @@ sf_take p n = (L.take n . L.filter p) `eqP` (unpackS . S.take n . S.filter p) t_take n = L.take n `eqP` (unpackS . T.take n)+t_takeEnd n = (L.reverse . L.take n . L.reverse) `eqP`+ (unpackS . T.takeEnd n) tl_take n = L.take n `eqP` (unpackS . TL.take (fromIntegral n))+tl_takeEnd n = (L.reverse . L.take (fromIntegral n) . L.reverse) `eqP`+ (unpackS . TL.takeEnd n) s_drop n = L.drop n `eqP` (unpackS . S.drop n) s_drop_s m = L.drop n `eqP` (unpackS . S.unstream . S.drop n) where n = small m sf_drop p n = (L.drop n . L.filter p) `eqP` (unpackS . S.drop n . S.filter p) t_drop n = L.drop n `eqP` (unpackS . T.drop n)+t_dropEnd n = (L.reverse . L.drop n . L.reverse) `eqP`+ (unpackS . T.dropEnd n) tl_drop n = L.drop n `eqP` (unpackS . TL.drop (fromIntegral n))+tl_dropEnd n = (L.reverse . L.drop n . L.reverse) `eqP`+ (unpackS . TL.dropEnd (fromIntegral n)) s_take_drop m = (L.take n . L.drop n) `eqP` (unpackS . S.take n . S.drop n) where n = small m s_take_drop_s m = (L.take n . L.drop n) `eqP`@@ -1056,12 +1063,16 @@ testProperty "s_take_s" s_take_s, testProperty "sf_take" sf_take, testProperty "t_take" t_take,+ testProperty "t_takeEnd" t_takeEnd, testProperty "tl_take" tl_take,+ testProperty "tl_takeEnd" tl_takeEnd, testProperty "s_drop" s_drop, testProperty "s_drop_s" s_drop_s, testProperty "sf_drop" sf_drop, testProperty "t_drop" t_drop,+ testProperty "t_dropEnd" t_dropEnd, testProperty "tl_drop" tl_drop,+ testProperty "tl_dropEnd" tl_dropEnd, testProperty "s_take_drop" s_take_drop, testProperty "s_take_drop_s" s_take_drop_s, testProperty "s_takeWhile" s_takeWhile,
tests/Tests/QuickCheckUtils.hs view
@@ -47,7 +47,7 @@ import Data.Word (Word8, Word16) import Debug.Trace (trace) import System.Random (Random (..), RandomGen)-import Test.QuickCheck hiding ((.&.))+import Test.QuickCheck hiding (Small (..), (.&.)) import Test.QuickCheck.Monadic (assert, monadicIO, run) import Tests.Utils import qualified Data.ByteString as B
+ tests/cabal.config view
@@ -0,0 +1,7 @@+-- These flags help to speed up building the test suite.++documentation: False+executable-profiling: False+executable-stripping: False+flags: developer+library-profiling: False
tests/text-tests.cabal view
@@ -2,7 +2,7 @@ version: 0.0.0.0 synopsis: Functional tests for the text package description: Functional tests for the text package-homepage: https://bitbucket.org/bos/text+homepage: https://github.com/bos/text license: BSD3 license-file: ../LICENSE author: Jasper Van der Jeugt <jaspervdj@gmail.com>,@@ -18,6 +18,7 @@ flag hpc description: Enable HPC to generate coverage reports default: False+ manual: True executable text-tests main-is: Tests.hs@@ -36,7 +37,7 @@ build-depends: HUnit >= 1.2,- QuickCheck >= 2.4,+ QuickCheck >= 2.7, base == 4.*, bytestring, deepseq,@@ -66,6 +67,7 @@ hs-source-dirs: .. c-sources: ../cbits/cbits.c include-dirs: ../include+ ghc-options: -Wall exposed-modules: Data.Text Data.Text.Array@@ -102,6 +104,7 @@ Data.Text.Internal.Lazy.Search Data.Text.Internal.Private Data.Text.Read+ Data.Text.Internal.Read Data.Text.Internal.Search Data.Text.Unsafe Data.Text.Internal.Unsafe
text.cabal view
@@ -1,5 +1,5 @@ name: text-version: 1.1.0.1+version: 1.1.1.0 homepage: https://github.com/bos/text bug-reports: https://github.com/bos/text/issues synopsis: An efficient packed Unicode text type.@@ -59,12 +59,14 @@ tests/.ghci tests/Makefile tests/Tests/*.hs+ tests/cabal.config tests/scripts/*.sh tests/text-tests.cabal flag developer description: operate in developer mode default: False+ manual: True flag integer-simple description: Use the simple integer library instead of GMP@@ -159,7 +161,7 @@ build-depends: HUnit >= 1.2,- QuickCheck >= 2.4,+ QuickCheck >= 2.7, array, base, bytestring,