text 0.8.0.0 → 0.8.1.0
raw patch · 26 files changed
+770/−128 lines, 26 files
Files
- Data/Text.hs +76/−31
- Data/Text/Array.hs +8/−14
- Data/Text/Encoding/Error.hs +7/−3
- Data/Text/Fusion.hs +30/−0
- Data/Text/Fusion/Internal.hs +3/−1
- Data/Text/Fusion/Size.hs +1/−16
- Data/Text/IO.hs +3/−3
- Data/Text/IO/Internal.hs +3/−2
- Data/Text/Lazy.hs +40/−31
- Data/Text/Lazy/Search.hs +7/−5
- Data/Text/Util.hs +27/−0
- tests/Makefile +1/−1
- tests/Properties.hs +13/−14
- tests/StdioCoverage.hs +25/−0
- tests/TestUtils.hs +31/−0
- tests/benchmarks/Cut.hs +60/−0
- tests/benchmarks/FileIndices.hs +25/−0
- tests/benchmarks/FileRead.hs +57/−0
- tests/benchmarks/FoldLines.hs +47/−0
- tests/benchmarks/HtmlCombinator.hs +24/−0
- tests/benchmarks/Makefile +18/−0
- tests/benchmarks/Replace.hs +23/−0
- tests/benchmarks/fileread.py +41/−0
- tests/benchmarks/fileread_c.c +96/−0
- tests/cover-stdio.sh +57/−0
- text.cabal +47/−7
Data/Text.hs view
@@ -24,6 +24,9 @@ module Data.Text (+ -- * Strict vs lazy types+ -- $strict+ -- * Fusion -- $fusion @@ -142,8 +145,8 @@ , isInfixOf -- ** View patterns- , prefixed- , suffixed+ , stripPrefix+ , stripSuffix -- * Searching , filter@@ -198,14 +201,58 @@ import Data.Text.Unsafe (Iter(..), iter, iter_, lengthWord16, reverseIter, unsafeHead, unsafeTail) import Data.Text.UnsafeChar (unsafeChr)+import qualified Data.Text.Util as U import qualified Data.Text.Encoding.Utf16 as U16 import Data.Text.Search (indices)+#if defined(__HADDOCK__)+import Data.ByteString (ByteString)+import qualified Data.Text.Lazy as L+import Data.Int (Int64)+#endif +-- $strict+--+-- This package provides both strict and lazy 'Text' types. The+-- strict type is provided by the 'Data.Text' package, while the lazy+-- type is provided by the 'Data.Text.Lazy' package. Internally, the+-- lazy @Text@ type consists of a list of strict chunks.+--+-- The strict 'Text' type requires that an entire string fit into+-- memory at once. The lazy @Text@ type is capable of streaming+-- strings that are larger than memory using a small memory footprint.+-- In many cases, the overhead of chunked streaming makes the lazy+-- @Text@ type slower than its strict counterpart, but this is not+-- always the case. Sometimes, the time complexity of a function in+-- one module may be different from the other, due to their differing+-- internal structures.+--+-- Each module provides an almost identical API, with the main+-- difference being that the strict module uses 'Int' values for+-- lengths and counts, while the lazy module uses 'Int64' lengths.+ -- $fusion -- -- Most of the functions in this module are subject to /fusion/, -- meaning that a pipeline of such functions will usually allocate at -- most one 'Text' value.+--+-- As an example, consider the following pipeline:+--+-- > import Data.Text as T+-- > import Data.Text.Encoding as E+-- >+-- > countChars :: ByteString -> Int+-- > countChars = T.length . T.toUpper . E.decodeUtf8+--+-- From the type signatures involved, this looks like it should+-- allocate one 'ByteString' value, and two 'Text' values. However,+-- when a module is compiled with optimisation enabled under GHC, the+-- two intermediate 'Text' values will be optimised away, and the+-- function will be compiled down to a single loop over the source+-- 'ByteString'.+--+-- Functions that can be fused by the compiler are marked with the+-- phrase \"Subject to fusion\". instance Eq Text where t1 == t2 = stream t1 == stream t2@@ -299,7 +346,7 @@ x = do arr <- A.unsafeNew len A.copyI arr 0 arr1 off1 len1- A.copyI arr len1 arr2 off2 (len1+len2)+ A.copyI arr len1 arr2 off2 len return arr {-# INLINE append #-} @@ -473,7 +520,7 @@ -- 'Text's and concatenates the list after interspersing the first -- argument between each element of the list. intercalate :: Text -> [Text] -> Text-intercalate t = concat . (L.intersperse t)+intercalate t = concat . (U.intersperse t) {-# INLINE intercalate #-} -- | /O(n)/ The 'intersperse' function takes a character and places it@@ -488,6 +535,9 @@ {-# INLINE reverse #-} -- | /O(m+n)/ Replace every occurrence of one substring with another.+--+-- 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@@ -610,12 +660,12 @@ -- (typically the left-identity of the operator), and a 'Text', -- reduces the 'Text' using the binary operator, from left to right. -- Subject to fusion.-foldl :: (b -> Char -> b) -> b -> Text -> b+foldl :: (a -> Char -> a) -> a -> Text -> a foldl f z t = S.foldl f z (stream t) {-# INLINE foldl #-} -- | /O(n)/ A strict version of 'foldl'. Subject to fusion.-foldl' :: (b -> Char -> b) -> b -> Text -> b+foldl' :: (a -> Char -> a) -> a -> Text -> a foldl' f z t = S.foldl' f z (stream t) {-# INLINE foldl' #-} @@ -634,7 +684,7 @@ -- (typically the right-identity of the operator), and a 'Text', -- reduces the 'Text' using the binary operator, from right to left. -- Subject to fusion.-foldr :: (Char -> b -> b) -> b -> Text -> b+foldr :: (Char -> a -> a) -> a -> Text -> a foldr f z t = S.foldr f z (stream t) {-# INLINE foldr #-} @@ -731,26 +781,21 @@ | otherwise = scanr f (last t) (init t) {-# INLINE scanr1 #-} --- | /O(n)/ Like a combination of 'map' and 'foldl'. Applies a+-- | /O(n)/ Like a combination of 'map' and 'foldl''. Applies a -- 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 -> Text -> (a, Text)-mapAccumL f s t = case uncons t of- Nothing -> (s, empty)- Just (x, xs) -> (s'', cons y ys)- where (s', y ) = f s x- (s'',ys) = mapAccumL f s' xs+mapAccumL f z0 = S.mapAccumL f z0 . stream+{-# INLINE mapAccumL #-} -- | The 'mapAccumR' function behaves like a combination of 'map' and--- 'foldr'; it applies a function to each element of a 'Text', passing--- an accumulating parameter from right to left, and returning a final--- value of this accumulator together with the new 'Text'.+-- a strict 'foldr'; it applies a function to each element of a+-- 'Text', passing an accumulating parameter from right to left, and+-- returning a final value of this accumulator together with the new+-- 'Text'. mapAccumR :: (a -> Char -> (a,Char)) -> a -> Text -> (a, Text)-mapAccumR f s t = case uncons t of- Nothing -> (s, empty)- Just (x, xs) -> (s'', cons y ys)- where (s'',y ) = f s' x- (s', ys) = mapAccumR f s xs+mapAccumR f z0 = second reverse . S.mapAccumL f z0 . reverseStream+{-# INLINE mapAccumR #-} -- ----------------------------------------------------------------------------- -- ** Generating and unfolding 'Text's@@ -1354,8 +1399,8 @@ -- -- Examples: ----- > prefixed "foo" "foobar" == Just "bar"--- > prefixed "foo" "quux" == Nothing+-- > stripPrefix "foo" "foobar" == Just "bar"+-- > stripPrefix "foo" "quux" == Nothing -- -- This is particularly useful with the @ViewPatterns@ extension to -- GHC, as follows:@@ -1364,10 +1409,10 @@ -- > import Data.Text as T -- > -- > fnordLength :: Text -> Int--- > fnordLength (prefixed "fnord" -> Just suf) = T.length suf+-- > fnordLength (stripPrefix "fnord" -> Just suf) = T.length suf -- > fnordLength _ = -1-prefixed :: Text -> Text -> Maybe Text-prefixed p@(Text _arr _off plen) t@(Text arr off len)+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) | otherwise = Nothing @@ -1376,8 +1421,8 @@ -- -- Examples: ----- > suffixed "bar" "foobar" == Just "foo"--- > suffixed "foo" "quux" == Nothing+-- > stripSuffix "bar" "foobar" == Just "foo"+-- > stripSuffix "foo" "quux" == Nothing -- -- This is particularly useful with the @ViewPatterns@ extension to -- GHC, as follows:@@ -1386,10 +1431,10 @@ -- > import Data.Text as T -- > -- > quuxLength :: Text -> Int--- > quuxLength (suffixed "quux" -> Just pre) = T.length pre+-- > quuxLength (stripSuffix "quux" -> Just pre) = T.length pre -- > quuxLength _ = -1-suffixed :: Text -> Text -> Maybe Text-suffixed p@(Text _arr _off plen) t@(Text arr off len)+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) | otherwise = Nothing
Data/Text/Array.hs view
@@ -102,22 +102,16 @@ -- | Create an uninitialized mutable array. unsafeNew :: forall s. Int -> ST s (MArray s)-unsafeNew n =-#if defined(ASSERTS)- assert (n >= 0) .-#endif- ST $ \s1# ->- case bytesInArray n of- len@(I# len#) ->-#if defined(ASSERTS)- if len < 0 then error (show ("unsafeNew",len)) else-#endif- case newByteArray# len# s1# of- (# s2#, marr# #) -> (# s2#, MArray marr#+unsafeNew n+ | len < 0 = error $ "Data.Text.Array.unsafeNew: invalid length " ++ show n+ | otherwise = ST $ \s1# ->+ case newByteArray# len# s1# of+ (# s2#, marr# #) -> (# s2#, MArray marr# #if defined(ASSERTS)- n+ n #endif- #)+ #)+ where !len@(I# len#) = bytesInArray n {-# INLINE unsafeNew #-} -- | Freeze a mutable array. Do not mutate the 'MArray' afterwards!
Data/Text/Encoding/Error.hs view
@@ -62,7 +62,11 @@ -- use the description provided to construct a more helpful error -- report. type OnError a b = String -> Maybe a -> Maybe b++-- | A handler for a decoding error. type OnDecodeError = OnError Word8 Char++-- | A handler for an encoding error. type OnEncodeError = OnError Char Word8 -- | An exception type for representing Unicode encoding errors.@@ -91,16 +95,16 @@ instance Exception UnicodeException -- | Throw a 'UnicodeException' if decoding fails.-strictDecode :: OnError Word8 Char+strictDecode :: OnDecodeError strictDecode desc c = throw (DecodeError desc c) -- | Replace an invalid input byte with the Unicode replacement -- character U+FFFD.-lenientDecode :: OnError Word8 Char+lenientDecode :: OnDecodeError lenientDecode _ _ = Just '\xfffd' -- | Throw a 'UnicodeException' if encoding fails.-strictEncode :: OnError Char Word8+strictEncode :: OnEncodeError strictEncode desc c = throw (EncodeError desc c) -- | Ignore an invalid input, substituting nothing in the output.
Data/Text/Fusion.hs view
@@ -34,6 +34,9 @@ -- ** Scans , reverseScanr + -- ** Accumulating maps+ , mapAccumL+ -- ** Generation and unfolding , unfoldrN @@ -199,3 +202,30 @@ countChar :: Char -> Stream Char -> Int countChar = S.countCharI {-# INLINE [0] countChar #-}++-- | /O(n)/ Like a combination of 'map' and 'foldl''. Applies a+-- 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)+ where+ (na,(nz,nl)) = A.run2 (A.unsafeNew mlen >>= \arr -> outer arr mlen z0 s0 0)+ where mlen = upperBound 4 len+ outer arr top = loop+ where+ loop !z !s !i =+ case next0 s of+ Done -> return (arr, (z,i))+ Skip s' -> loop z s' i+ Yield x s'+ | j >= top -> {-# SCC "mapAccumL/resize" #-} do+ let top' = (top + 1) `shiftL` 1+ arr' <- A.unsafeNew 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+ loop z' s' (i+d)+ where j | ord x < 0x10000 = i+ | otherwise = i + 1+{-# INLINE [0] mapAccumL #-}
Data/Text/Fusion/Internal.hs view
@@ -43,7 +43,7 @@ infixl 2 :*: data PairS a b = !a :*: !b- deriving (Eq, Ord, Show)+ -- deriving (Eq, Ord, Show) -- | Allow a function over a stream to switch between two states. data Switch = S1 | S2@@ -52,10 +52,12 @@ | Skip !s | Yield !a !s +{- instance (Show a) => Show (Step s a) where show Done = "Done" show (Skip _) = "Skip" show (Yield x _) = "Yield " ++ show x+-} instance (Eq a) => Eq (Stream a) where (==) = eq
Data/Text/Fusion/Size.hs view
@@ -22,9 +22,7 @@ , unknownSize , smaller , larger- , toMax , upperBound- , lowerBound , isEmpty ) where @@ -92,7 +90,7 @@ mulSize (Exact m) (Max n) = Max (m*n) mulSize (Max m) (Exact n) = Max (m*n) mulSize (Max m) (Max n) = Max (m*n)-mulSize _ _ = Unknown+mulSize _ _ = Unknown {-# INLINE mulSize #-} -- | Minimum of two size hints.@@ -118,19 +116,6 @@ larger (Max m) (Max n) = Max (m `max` n) larger _ _ = Unknown {-# INLINE larger #-}---- | Convert a size hint to an upper bound.-toMax :: Size -> Size-toMax (Exact n) = Max n-toMax a@(Max _) = a-toMax Unknown = Unknown-{-# INLINE toMax #-}---- | Compute the minimum size from a size hint.-lowerBound :: Size -> Int-lowerBound (Exact n) = n-lowerBound _ = 0-{-# INLINE lowerBound #-} -- | Compute the maximum size from a size hint, if possible. upperBound :: Int -> Size -> Int
Data/Text/IO.hs view
@@ -111,7 +111,6 @@ ts <- readChunks (hh', _) <- hClose_help hh return (hh'{haType=ClosedHandle}, T.concat ts)-#endif -- | Use a more efficient buffer size if we're reading in -- block-buffered mode with the default buffer size. When we can@@ -129,6 +128,7 @@ else throw e when (d > 0) . hSetBuffering h . BlockBuffering . Just . fromIntegral $ d _ -> return ()+#endif -- | Read a single line from a handle. hGetLine :: Handle -> IO Text@@ -289,8 +289,8 @@ -- Beginning with GHC 6.12, text I\/O is performed using the system or -- handle's current locale and line ending conventions. ----- Under GHC 6.10 and earlier, the system I\/O libraries /do not--- support/ locale-sensitive I\/O or line ending conversion. On these+-- Under GHC 6.10 and earlier, the system I\/O libraries do not+-- support locale-sensitive I\/O or line ending conversion. On these -- versions of GHC, functions in this library all use UTF-8. What -- does this mean in practice? --
Data/Text/IO/Internal.hs view
@@ -44,7 +44,8 @@ go hh@Handle__{..} = readIORef haCharBuffer >>= fmap f . hGetLineLoop hh [] hGetLineLoop :: Handle__ -> [Text] -> CharBuffer -> IO [Text]-hGetLineLoop hh@Handle__{..} ts buf@Buffer{ bufL=r0, bufR=w, bufRaw=raw0 } = do+hGetLineLoop hh@Handle__{..} = go where+ go ts buf@Buffer{ bufL=r0, bufR=w, bufRaw=raw0 } = do let findEOL raw r | r == w = return (False, w) | otherwise = do (c,r') <- readCharBuf raw r@@ -76,7 +77,7 @@ if null str then ioe_EOF else return str- Just new_buf -> hGetLineLoop hh (t:ts) new_buf+ Just new_buf -> go (t:ts) new_buf -- This function is lifted almost verbatim from GHC.IO.Handle.Text. maybeFillReadBuffer :: Handle__ -> CharBuffer -> IO (Maybe CharBuffer)
Data/Text/Lazy.hs view
@@ -27,7 +27,7 @@ -- This module is intended to be imported @qualified@, to avoid name -- clashes with "Prelude" functions. eg. ----- > import qualified Data.Text.Lazy as B+-- > import qualified Data.Text.Lazy as L module Data.Text.Lazy (@@ -150,8 +150,8 @@ , isInfixOf -- ** View patterns- , prefixed- , suffixed+ , stripPrefix+ , stripSuffix -- * Searching , filter@@ -201,6 +201,7 @@ import Data.Text.Lazy.Fusion (stream, unstream) import Data.Text.Lazy.Internal (Text(..), chunk, empty, foldlChunks, foldrChunks) import Data.Text.Internal (textP)+import qualified Data.Text.Util as U import Data.Text.Lazy.Search (indices) instance Eq Text where@@ -447,7 +448,7 @@ -- 'Text's and concatenates the list after interspersing the first -- argument between each element of the list. intercalate :: Text -> [Text] -> Text-intercalate t = concat . (L.intersperse t)+intercalate t = concat . (U.intersperse t) {-# INLINE intercalate #-} -- | /O(n)/ The 'intersperse' function takes a character and places it@@ -517,6 +518,9 @@ rev a (Chunk t ts) = rev (Chunk (T.reverse t) a) ts -- | /O(m+n)/ Replace every occurrence of one substring with another.+--+-- 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@@ -575,13 +579,13 @@ -- (typically the left-identity of the operator), and a 'Text', -- reduces the 'Text' using the binary operator, from left to right. -- Subject to array fusion.-foldl :: (b -> Char -> b) -> b -> Text -> b+foldl :: (a -> Char -> a) -> a -> Text -> a foldl f z t = S.foldl f z (stream t) {-# INLINE foldl #-} -- | /O(n)/ A strict version of 'foldl'. -- Subject to array fusion.-foldl' :: (b -> Char -> b) -> b -> Text -> b+foldl' :: (a -> Char -> a) -> a -> Text -> a foldl' f z t = S.foldl' f z (stream t) {-# INLINE foldl' #-} @@ -602,7 +606,7 @@ -- (typically the right-identity of the operator), and a 'Text', -- reduces the 'Text' using the binary operator, from right to left. -- Subject to array fusion.-foldr :: (Char -> b -> b) -> b -> Text -> b+foldr :: (Char -> a -> a) -> a -> Text -> a foldr f z t = S.foldr f z (stream t) {-# INLINE foldr #-} @@ -688,26 +692,31 @@ scanr1 f t | null t = empty | otherwise = scanr f (last t) (init t) --- | /O(n)/ Like a combination of 'map' and 'foldl'. Applies a+-- | /O(n)/ Like a combination of 'map' and 'foldl''. Applies a -- 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 -> Text -> (a, Text)-mapAccumL f s t = case uncons t of- Nothing -> (s, empty)- Just (x, xs) -> (s'', cons y ys)- where (s', y ) = f s x- (s'',ys) = mapAccumL f s' xs+mapAccumL f = go+ where+ go z (Chunk c cs) = (z'', Chunk c' cs')+ where (z', c') = T.mapAccumL f z c+ (z'', cs') = go z' cs+ go z Empty = (z, Empty)+{-# INLINE mapAccumL #-} -- | The 'mapAccumR' function behaves like a combination of 'map' and--- 'foldr'; it applies a function to each element of a 'Text', passing--- an accumulating parameter from right to left, and returning a final--- value of this accumulator together with the new 'Text'.+-- a strict 'foldr'; it applies a function to each element of a+-- 'Text', passing an accumulating parameter from right to left, and+-- returning a final value of this accumulator together with the new+-- 'Text'. mapAccumR :: (a -> Char -> (a,Char)) -> a -> Text -> (a, Text)-mapAccumR f s t = case uncons t of- Nothing -> (s, empty)- Just (x, xs) -> (s'', cons y ys)- where (s'',y ) = f s' x- (s', ys) = mapAccumR f s xs+mapAccumR f = go+ where+ go z (Chunk c cs) = (z'', Chunk c' cs')+ where (z'', c') = T.mapAccumR f z' c+ (z', cs') = go z cs+ go z Empty = (z, Empty)+{-# INLINE mapAccumR #-} -- | /O(n*m)/ 'replicate' @n@ @t@ is a 'Text' consisting of the input -- @t@ repeated @n@ times.@@ -1209,8 +1218,8 @@ -- -- Examples: ----- > prefixed "foo" "foobar" == Just "bar"--- > prefixed "foo" "quux" == Nothing+-- > stripPrefix "foo" "foobar" == Just "bar"+-- > stripPrefix "foo" "quux" == Nothing -- -- This is particularly useful with the @ViewPatterns@ extension to -- GHC, as follows:@@ -1219,11 +1228,11 @@ -- > import Data.Text as T -- > -- > fnordLength :: Text -> Int--- > fnordLength (prefixed "fnord" -> Just suf) = T.length suf+-- > fnordLength (stripPrefix "fnord" -> Just suf) = T.length suf -- > fnordLength _ = -1-prefixed :: Text -> Text -> Maybe Text+stripPrefix :: Text -> Text -> Maybe Text -- Yes, this could be much more efficient.-prefixed p t+stripPrefix p t | p `isPrefixOf` t = Just (drop (length p) t) | otherwise = Nothing @@ -1232,8 +1241,8 @@ -- -- Examples: ----- > suffixed "bar" "foobar" == Just "foo"--- > suffixed "foo" "quux" == Nothing+-- > stripSuffix "bar" "foobar" == Just "foo"+-- > stripSuffix "foo" "quux" == Nothing -- -- This is particularly useful with the @ViewPatterns@ extension to -- GHC, as follows:@@ -1242,11 +1251,11 @@ -- > import Data.Text as T -- > -- > quuxLength :: Text -> Int--- > quuxLength (suffixed "quux" -> Just pre) = T.length pre+-- > quuxLength (stripSuffix "quux" -> Just pre) = T.length pre -- > quuxLength _ = -1-suffixed :: Text -> Text -> Maybe Text+stripSuffix :: Text -> Text -> Maybe Text -- Yes, this could be much more efficient.-suffixed p t+stripSuffix p t | p `isSuffixOf` t = Just (take (length t - length p) t) | otherwise = Nothing
Data/Text/Lazy/Search.hs view
@@ -42,15 +42,17 @@ indices needle@(Chunk n ns) _haystack@(Chunk k ks) | nlen <= 0 = [] | nlen == 1 = indicesOne (nindex 0) 0 k ks- | otherwise = scan 0 0 k ks+ | otherwise = advance k ks 0 0 where- scan !g !i x@(T.Text _ _ l) xs+ advance x@(T.Text _ _ l) xs = scan+ where+ scan !g !i | i >= m = case xs of Empty -> []- Chunk y ys -> scan g (i-m) y ys+ Chunk y ys -> advance y ys g (i-m) | lackingHay (i + nlen) x xs = []- | c == z && candidateMatch 0 = g : scan (g+nlen) (i+nlen) x xs- | otherwise = scan (g+delta) (i+delta) x xs+ | c == z && candidateMatch 0 = g : scan (g+nlen) (i+nlen)+ | otherwise = scan (g+delta) (i+delta) where m = fromIntegral l c = hindex (i + nlast)
+ Data/Text/Util.hs view
@@ -0,0 +1,27 @@+{-# LANGUAGE CPP, DeriveDataTypeable #-}++-- |+-- Module : Data.Text.Util+-- Copyright : 2010 Bryan O'Sullivan+--+-- License : BSD-style+-- Maintainer : bos@serpentine.com+-- Stability : experimental+-- Portability : GHC+--+-- Useful functions.++module Data.Text.Util+ (+ intersperse+ ) where++-- | A lazier version of Data.List.intersperse. The other version+-- causes space leaks!+intersperse :: a -> [a] -> [a]+intersperse _ [] = []+intersperse sep (x:xs) = x : go xs+ where+ go [] = []+ go (y:ys) = sep : y: go ys+{-# INLINE intersperse #-}
tests/Makefile view
@@ -57,7 +57,7 @@ coverage: coverage-html/hpc_index.html -coverage-html/hpc_index.html: qc-hpc+coverage-html/hpc_index.html: qc-hpc stdio-hpc @rm -f qc-hpc.tix stdio-hpc.tix coverage.tix ./qc-hpc -a 100 +RTS -N bash ./cover-stdio.sh
tests/Properties.hs view
@@ -184,6 +184,8 @@ tl_mappend s = mappend s`eqP` (unpackS . mappend (TL.pack s)) t_mconcat = mconcat `eq` (unpackS . mconcat . L.map T.pack) tl_mconcat = mconcat `eq` (unpackS . mconcat . L.map TL.pack)+t_mempty = mempty == (unpackS (mempty :: T.Text))+tl_mempty = mempty == (unpackS (mempty :: TL.Text)) t_IsString = fromString `eqP` (T.unpack . fromString) tl_IsString = fromString `eqP` (TL.unpack . fromString) @@ -581,18 +583,13 @@ t_isInfixOf s = L.isInfixOf s `eqP` T.isInfixOf (packS s) tl_isInfixOf s = L.isInfixOf s `eqP` TL.isInfixOf (packS s) -prefixed (p:ps) (t:ts)- | p == t = prefixed ps ts-prefixed [] ts = Just ts-prefixed _ _ = Nothing--t_prefixed s = (fmap packS . prefixed s) `eqP` T.prefixed (packS s)-tl_prefixed s = (fmap packS . prefixed s) `eqP` TL.prefixed (packS s)+t_stripPrefix s = (fmap packS . L.stripPrefix s) `eqP` T.stripPrefix (packS s)+tl_stripPrefix s = (fmap packS . L.stripPrefix s) `eqP` TL.stripPrefix (packS s) -suffixed p t = reverse `fmap` prefixed (reverse p) (reverse t)+stripSuffix p t = reverse `fmap` L.stripPrefix (reverse p) (reverse t) -t_suffixed s = (fmap packS . suffixed s) `eqP` T.suffixed (packS s)-tl_suffixed s = (fmap packS . suffixed s) `eqP` TL.suffixed (packS s)+t_stripSuffix s = (fmap packS . stripSuffix s) `eqP` T.stripSuffix (packS s)+tl_stripSuffix s = (fmap packS . stripSuffix s) `eqP` TL.stripSuffix (packS s) sf_elem p c = (L.elem c . L.filter p) `eqP` (S.elem c . S.filter p) sf_filter q p = (L.filter p . L.filter q) `eqP`@@ -809,6 +806,8 @@ testProperty "tl_mappend" tl_mappend, testProperty "t_mconcat" t_mconcat, testProperty "tl_mconcat" tl_mconcat,+ testProperty "t_mempty" t_mempty,+ testProperty "tl_mempty" tl_mempty, testProperty "t_IsString" t_IsString, testProperty "tl_IsString" tl_IsString ],@@ -1082,10 +1081,10 @@ testProperty "tl_isInfixOf" tl_isInfixOf, testGroup "view" [- testProperty "t_prefixed" t_prefixed,- testProperty "tl_prefixed" tl_prefixed,- testProperty "t_suffixed" t_suffixed,- testProperty "tl_suffixed" tl_suffixed+ testProperty "t_stripPrefix" t_stripPrefix,+ testProperty "tl_stripPrefix" tl_stripPrefix,+ testProperty "t_stripSuffix" t_stripSuffix,+ testProperty "tl_stripSuffix" tl_stripSuffix ] ],
+ tests/StdioCoverage.hs view
@@ -0,0 +1,25 @@+import qualified Data.Text as T+import qualified Data.Text.IO as T+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.IO as TL+import System.Environment (getArgs)+import System.Exit (exitFailure)+import System.IO (hPutStrLn, stderr)++main = do+ args <- getArgs+ case args of+ ["T.readFile", name] -> T.putStr =<< T.readFile name+ ["T.writeFile", name, t] -> T.writeFile name (T.pack t)+ ["T.appendFile", name, t] -> T.appendFile name (T.pack t)+ ["T.interact"] -> T.interact id+ ["T.getContents"] -> T.putStr =<< T.getContents+ ["T.getLine"] -> T.putStrLn =<< T.getLine++ ["TL.readFile", name] -> TL.putStr =<< TL.readFile name+ ["TL.writeFile", name, t] -> TL.writeFile name (TL.pack t)+ ["TL.appendFile", name, t] -> TL.appendFile name (TL.pack t)+ ["TL.interact"] -> TL.interact id+ ["TL.getContents"] -> TL.putStr =<< TL.getContents+ ["TL.getLine"] -> TL.putStrLn =<< TL.getLine+ _ -> hPutStrLn stderr "invalid directive!" >> exitFailure
+ tests/TestUtils.hs view
@@ -0,0 +1,31 @@+module TestUtils+ (+ withRedirect+ , withTempFile+ ) where++import Control.Exception (bracket, bracket_)+import Control.Monad (when)+import GHC.IO.Handle.Internals (withHandle)+import System.Directory (removeFile)+import System.IO++withTempFile :: (FilePath -> Handle -> IO a) -> IO a+withTempFile = bracket (openTempFile "." "crashy.txt") cleanupTemp . uncurry+ where+ cleanupTemp (path,h) = do+ open <- hIsOpen h+ when open (hClose h)+ removeFile path++withRedirect :: Handle -> Handle -> IO a -> IO a+withRedirect tmp h = bracket_ swap swap+ where+ whenM p a = p >>= (`when` a)+ swap = do+ whenM (hIsOpen tmp) $ whenM (hIsWritable tmp) $ hFlush tmp+ whenM (hIsOpen h) $ whenM (hIsWritable h) $ hFlush h+ withHandle "spam" tmp $ \tmph -> do+ hh <- withHandle "spam" h $ \hh ->+ return (tmph,hh)+ return (hh,())
+ tests/benchmarks/Cut.hs view
@@ -0,0 +1,60 @@+import qualified Data.ByteString.Char8 as B+import qualified Data.ByteString.Lazy.Char8 as BL+import qualified Data.Text.IO as T+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import qualified Data.Text.Lazy.Encoding as TL+import qualified Data.Text.Lazy.IO as TL+import qualified Data.Text.Lazy as TL+import Data.Int (Int64)+import Numeric (readDec)+import System.Environment (getArgs)++bytestring file s e = do+ t <- B.readFile file+ B.putStr (cut t)+ where+ cut = B.unlines . map (B.take (e - s) . B.drop s) . B.lines++lazyBytestring file s e = do+ t <- BL.readFile file+ BL.putStr (cut (fromIntegral s) (fromIntegral e) t)+ where+ cut s e = BL.unlines . map (BL.take (e - s) . BL.drop s) . BL.lines++lazyText file s e = do+ t <- TL.readFile file+ TL.putStr (cut (fromIntegral s) (fromIntegral e) t)+ where+ cut s e = TL.unlines . map (TL.take (e - s) . TL.drop s) . TL.lines++text file s e = do+ t <- T.readFile file+ T.putStr (cut t)+ where+ cut = T.unlines . map (T.take (e - s) . T.drop s) . T.lines++textBS file s e = do+ bs <- B.readFile file+ T.putStr . cut . T.decodeUtf8 $ bs+ where+ cut = T.unlines . map (T.take (e - s) . T.drop s) . T.lines++lazyTextBS file s e = do+ t <- BL.readFile file+ TL.putStr (cut (fromIntegral s) (fromIntegral e) (TL.decodeUtf8 t))+ where+ cut s e = TL.unlines . map (TL.take (e - s) . TL.drop s) . TL.lines++main = do+ (name : ss : es : file : _) <- getArgs+ let [(s',"")] = readDec ss+ [(e,"")] = readDec es+ s = s' - 1+ case name of+ "bs" -> bytestring file s e+ "lbs" -> lazyBytestring file s e+ "ltext" -> lazyText file s e+ "text" -> text file s e+ "ltextBS" -> lazyTextBS file s e+ "textBS" -> textBS file s e
+ tests/benchmarks/FileIndices.hs view
@@ -0,0 +1,25 @@+{-# LANGUAGE BangPatterns #-}++import System.Environment (getArgs)+import qualified Data.Text.Lazy.IO as T+import qualified Data.Text.Lazy as T+import qualified Data.Text.Lazy.Encoding as T+import qualified Data.ByteString.Lazy.Char8 as B+import qualified Data.ByteString.Char8 as BS+import qualified Data.ByteString.Lazy.Search as B++text :: FilePath -> String -> IO ()+text file pat = T.readFile file >>= print . T.count (T.pack pat)++textBS :: FilePath -> String -> IO ()+textBS file pat = B.readFile file >>= print . T.count (T.pack pat) . T.decodeUtf8++bytestring :: FilePath -> String -> IO ()+bytestring file pat = B.readFile file >>= print . length . B.indices (BS.pack pat)++main = do+ (name : file : pat : _) <- getArgs+ case name of+ "bs" -> bytestring file pat+ "text" -> text file pat+ "textBS" -> textBS file pat
+ tests/benchmarks/FileRead.hs view
@@ -0,0 +1,57 @@+{-# LANGUAGE BangPatterns #-}++import System.Environment (getArgs)+import qualified Data.Text.IO as T+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import qualified Data.Text.Lazy.IO as TL+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Encoding as TL+import qualified Data.ByteString.Char8 as B+import qualified Data.ByteString.Lazy.Char8 as BL+import System.IO++string :: Handle -> IO ()+string h = hGetContents h >>= print . length++ltext :: Handle -> IO ()+ltext h = do+ t <- {-# SCC "TL.hGetContents" #-} TL.hGetContents h+ print (TL.length t)++ltextBS :: Handle -> IO ()+ltextBS h = do+ bs <- {-# SCC "B.hGetContents" #-} BL.hGetContents h+ print . TL.length . TL.decodeUtf8 $ bs++text :: Handle -> IO ()+text h = do+ t <- {-# SCC "T.hGetContents" #-} T.hGetContents h+ print (T.length t)++textBS :: Handle -> IO ()+textBS h = do+ bs <- {-# SCC "B.hGetContents" #-} B.hGetContents h+ print . T.length . T.decodeUtf8 $ bs++lbytestring :: Handle -> IO ()+lbytestring h = do+ bs <- {-# SCC "BL.hGetContents" #-} BL.hGetContents h+ print (BL.length bs)++bytestring :: Handle -> IO ()+bytestring h = do+ bs <- {-# SCC "B.hGetContents" #-} B.hGetContents h+ print (B.length bs)++main = do+ (name : file : _) <- getArgs+ h <- openFile file ReadMode+ case name of+ "bs" -> bytestring h+ "lbs" -> lbytestring h+ "ltext" -> ltext h+ "ltextBS" -> ltextBS h+ "string" -> string h+ "text" -> text h+ "textBS" -> textBS h
+ tests/benchmarks/FoldLines.hs view
@@ -0,0 +1,47 @@+{-# LANGUAGE BangPatterns #-}++import System.Environment+import System.IO+import qualified Data.Text as T+import qualified Data.Text.IO as T+import qualified Data.ByteString as S++-- Text+foldLinesT :: (a -> T.Text -> a) -> a -> Handle -> IO a+foldLinesT f z0 h = go z0+ where+ go !z = do+ eof <- hIsEOF h+ if eof+ then return z+ else do+ l <- T.hGetLine h+ let z' = f z l in go z'+{-# INLINE foldLinesT #-}++testT :: Handle -> IO Int+testT = foldLinesT (\n _ -> n + 1) 0++--ByteString+foldLinesB :: (a -> S.ByteString -> a) -> a -> Handle -> IO a+foldLinesB f z0 h = go z0+ where+ go !z = do+ eof <- hIsEOF h+ if eof+ then return z+ else do+ l <- S.hGetLine h+ let z' = f z l in go z'+{-# INLINE foldLinesB #-}++testB :: Handle -> IO Int+testB = foldLinesB (\n _ -> n + 1) 0++main = do+ (name : file : _) <- getArgs+ h <- openFile file ReadMode+ hSetBuffering h (BlockBuffering (Just 16384))+ case name of+ "bs" -> testB h+ "text" -> testT h
+ tests/benchmarks/HtmlCombinator.hs view
@@ -0,0 +1,24 @@+{-# LANGUAGE BangPatterns, OverloadedStrings #-}+import Data.Monoid (mappend, mconcat)+import Prelude hiding (putStr)+import Data.Text.Lazy.Builder (Builder, fromText, toLazyText)+import Data.Text.Lazy.IO (putStr)++import qualified Data.Text as T++main :: IO ()+main = do+ putStr "Content-Type: text/html\n\n<table>"+ putStr . toLazyText $ mconcat (replicate 20000 makeRow) + putStr "</table>"++makeRow :: Builder+makeRow = 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` (textInt i `mappend` fromText "</td>")++textInt :: Int -> Builder+textInt = fromText . T.pack . show
+ tests/benchmarks/Makefile view
@@ -0,0 +1,18 @@+CC := $(shell icu-config --cc)+CFLAGS := -g $(shell icu-config --cflags)+CPPFLAGS := $(shell icu-config --cppflags)+LDFLAGS := $(CFLAGS) $(shell icu-config --ldflags --ldflags-icuio)+ghc := ghc++all := FileRead FileRead_prof Replace Replace_prof fileread_c++all: $(all)++%: %.hs+ $(ghc) -O --make -o $@ $^++%_prof: %.hs+ $(ghc) -prof -auto-all -O --make -o $@ $^++clean:+ -rm -f *.hi *.o $(all)
+ tests/benchmarks/Replace.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE BangPatterns #-}+module Main (main) where++import System.Environment (getArgs)+import qualified Data.Text.Lazy as LT+import qualified Data.Text.Lazy.IO as LT+import qualified Data.ByteString.Lazy.Search as LB+import qualified Data.ByteString.Lazy.Char8 as LB+import qualified Data.ByteString.Char8 as B++lazyText file pat sub =+ LT.readFile file >>= LT.putStr . LT.replace (LT.pack pat) (LT.pack sub)++lazyBS file pat sub =+ LB.readFile file >>= LB.putStr . LB.replace (B.pack pat) (LB.pack sub)++main = do+ (kind : file : pat : sub : _) <- getArgs+ case kind of+ "lazyText" -> lazyText file pat sub+ "lazyTextNull" -> LT.readFile file >>= LT.putStr+ "lazyBS" -> lazyBS file pat sub+ "lazyBSNull" -> LB.readFile file >>= LB.putStr
+ tests/benchmarks/fileread.py view
@@ -0,0 +1,41 @@+#!/usr/bin/env python++import sys++def string(name):+ print len(open(name).read())++def lazystring(name):+ fp = open(name)+ n = 0+ d = True+ bs = 128 * 1024+ read = fp.read+ while d:+ d = len(read(bs))+ n += d+ print n++def lazytext(name):+ fp = open(name)+ n = 0+ d = True+ bs = 128 * 1024+ read = fp.read+ while d:+ s = read(bs)+ d = len(s.decode('utf-8', 'replace'))+ n += d+ print n++def text(name):+ print len(open(name).read().decode('utf-8', 'replace'))++if sys.argv[1] == 'bs':+ string(sys.argv[2])+if sys.argv[1] == 'lbs':+ lazystring(sys.argv[2])+elif sys.argv[1] == 'lazytext':+ lazytext(sys.argv[2])+elif sys.argv[1] == 'text':+ text(sys.argv[2])
+ tests/benchmarks/fileread_c.c view
@@ -0,0 +1,96 @@+#include <unicode/ustdio.h>+#include <stdio.h>+#include <stdlib.h>+#include <string.h>++void lazystring(const char *name)+{+ FILE *ufp = fopen(name, "r");+ const size_t bufsize = sizeof(char) * 32 * 1024;+ char *str = malloc(bufsize);+ long len = 0;+ int32_t n;++ do {+ n = fread(str, sizeof(char), bufsize, ufp);+ len += n;+ } while (n > 0);++ printf("%ld\n", len);+}++void lazytext(const char *name)+{+ UFILE *ufp = u_fopen(name, "r", NULL, "UTF-8");+ const size_t bufsize = sizeof(UChar) * 32 * 1024;+ UChar *str = malloc(bufsize);+ long len = 0;+ int32_t n;++ do {+ n = u_file_read(str, bufsize, ufp);+ len += n;+ } while (n > 0);++ printf("%ld\n", len);+}++void text(const char *name)+{+ UFILE *ufp = u_fopen(name, "r", NULL, "UTF-8");+ FILE *fp = u_fgetfile(ufp);+ UChar *str;+ long fsize;+ int32_t n;++ fseek(fp, 0, SEEK_END);+ fsize = ftell(fp);+ u_frewind(ufp);++ str = malloc(sizeof(*str) * fsize);++ n = u_file_read(str, fsize, ufp);++ printf("%d\n", n);+}++void string(const char *name)+{+ FILE *fp = fopen(name, "r");+ char *str;+ long fsize;+ int32_t n;++ fseek(fp, 0, SEEK_END);+ fsize = ftell(fp);+ fseek(fp, 0, SEEK_SET);++ str = malloc(sizeof(*str) * fsize);++ n = fread(str, sizeof(char), fsize, fp);++ printf("%d\n", n);+}++int main(int argc, char **argv)+{+ if (argc != 3) {+ fprintf(stderr, "Usage: %s handler filename\n", argv[0]);+ exit(1);+ }++ if (strcmp(argv[1], "lazystring") == 0)+ lazystring(argv[2]);+ else if (strcmp(argv[1], "lazytext") == 0)+ lazytext(argv[2]);+ else if (strcmp(argv[1], "string") == 0)+ string(argv[2]);+ else if (strcmp(argv[1], "text") == 0)+ text(argv[2]);+ else {+ fprintf(stderr, "no matching handler\n");+ return 1;+ }++ return 0;+}
+ tests/cover-stdio.sh view
@@ -0,0 +1,57 @@+#!/bin/bash++exe=./stdio-hpc++rm -f $exe.tix++f=$(mktemp stdio-f.XXXXXX)+g=$(mktemp stdio-g.XXXXXX)++for t in T TL; do+ echo $t.readFile > $f+ $exe $t.readFile $f > $g+ if ! diff -u $f $g; then+ errs=$((errs+1))+ echo FAIL: $t.readFile 1>&2+ fi++ $exe $t.writeFile $f $t.writeFile+ echo -n $t.writeFile > $g+ if ! diff -u $f $g; then+ errs=$((errs+1))+ echo FAIL: $t.writeFile 1>&2+ fi++ echo -n quux > $f+ $exe $t.appendFile $f $t.appendFile+ echo -n quux$t.appendFile > $g+ if ! diff -u $f $g; then+ errs=$((errs+1))+ echo FAIL: $t.appendFile 1>&2+ fi++ echo $t.interact | $exe $t.interact > $f+ echo $t.interact > $g+ if ! diff -u $f $g; then+ errs=$((errs+1))+ echo FAIL: $t.interact 1>&2+ fi++ echo $t.getContents | $exe $t.getContents > $f+ echo $t.getContents > $g+ if ! diff -u $f $g; then+ errs=$((errs+1))+ echo FAIL: $t.getContents 1>&2+ fi++ echo $t.getLine | $exe $t.getLine > $f+ echo $t.getLine > $g+ if ! diff -u $f $g; then+ errs=$((errs+1))+ echo FAIL: $t.getLine 1>&2+ fi+done++rm -f $f $g++exit $errs
text.cabal view
@@ -1,7 +1,30 @@ name: text-version: 0.8.0.0-synopsis: An efficient packed Unicode text type-description: An efficient packed Unicode text type.+version: 0.8.1.0+homepage: http://code.haskell.org/text+synopsis: An efficient packed Unicode text type.+description: + .+ An efficient packed, immutable Unicode text type (both strict and+ lazy), with a powerful loop fusion optimization framework.+ .+ The 'Text' type represents Unicode character strings, in a time and+ space-efficient manner. This package provides text processing+ capabilities that are optimized for performance critical use, both+ in terms of large data quantities and high speed.+ .+ The 'Text' type provides character-encoding, type-safe case+ conversion via whole-string case conversion functions. It also+ provides a range of functions for converting Text values to and from+ 'ByteStrings', using several standard encodings (see the 'text-icu'+ package for a much larger variety of encoding functions).+ .+ Efficient locale-sensitive support for text IO is also supported.+ .+ This module is intended to be imported qualified, to avoid name+ clashes with Prelude functions, e.g.+ .+ > import qualified Data.Text as T+ . license: BSD3 license-file: LICENSE author: Tom Harper <rtomharper@googlemail.com>@@ -11,22 +34,34 @@ copyright: 2008-2009 Tom Harper, 2009-2010 Bryan O'Sullivan category: Data, Text build-type: Simple-cabal-version: >= 1.2.3+cabal-version: >= 1.6 extra-source-files: README TODO+ -- scripts/CaseFolding.txt+ -- scripts/SpecialCasing.txt scripts/ApiCompare.hs scripts/Arsec.hs scripts/CaseFolding.hs- -- scripts/CaseFolding.txt scripts/CaseMapping.hs scripts/SpecialCasing.hs- -- scripts/SpecialCasing.txt- tests/Makefile tests/Benchmarks.hs+ tests/Makefile tests/Properties.hs tests/QuickCheckUtils.hs tests/SlowFunctions.hs+ tests/StdioCoverage.hs+ tests/TestUtils.hs+ tests/benchmarks/Cut.hs+ tests/benchmarks/FileIndices.hs+ tests/benchmarks/FileRead.hs+ tests/benchmarks/FoldLines.hs+ tests/benchmarks/HtmlCombinator.hs+ tests/benchmarks/Makefile+ tests/benchmarks/Replace.hs+ tests/benchmarks/fileread.py+ tests/benchmarks/fileread_c.c+ tests/cover-stdio.sh flag developer description: operate in developer mode@@ -65,6 +100,7 @@ Data.Text.Unsafe Data.Text.UnsafeChar Data.Text.UnsafeShift+ Data.Text.Util build-depends: base < 5,@@ -86,3 +122,7 @@ if flag(developer) ghc-options: -Werror cpp-options: -DASSERTS++source-repository head+ type: darcs+ location: http://code.haskell.org/text/