@@ -3,6 +3,9 @@
3#if __GLASGOW_HASKELL__ >= 702
3#if __GLASGOW_HASKELL__ >= 702
4{-# LANGUAGE Trustworthy #-}
4{-# LANGUAGE Trustworthy #-}
6+#if __GLASGOW_HASKELL__ >= 708
7+{-# LANGUAGE TypeFamilies #-}
8-- Module : Data.Text
11-- Module : Data.Text
@@ -126,6 +129,7 @@ module Data.Text
127 , dropEnd
130 , dropEnd
128 , takeWhile
131 , takeWhile
129 , dropWhile
133 , dropWhile
130 , dropWhileEnd
134 , dropWhileEnd
131 , dropAround
135 , dropAround
@@ -188,15 +192,16 @@ module Data.Text
189 -- * Low level operations
193 -- * Low level operations
193import Prelude (Char, Bool(..), Int, Maybe(..), String,
198import Prelude (Char, Bool(..), Int, Maybe(..), String,
194 Eq(..), Ord(..), Ordering(..), (++),
199 Eq(..), Ord(..), Ordering(..), (++),
195− Read(..), Show(..),
200+ Read(..),
196 (&&), (||), (+), (-), (.), ($), ($!), (>>),
201 (&&), (||), (+), (-), (.), ($), ($!), (>>),
197− maxBound, not, return, otherwise, quot)
202+ not, return, otherwise, quot)
198#if defined(HAVE_DEEPSEQ)
203#if defined(HAVE_DEEPSEQ)
199−import Control.DeepSeq (NFData)
204+import Control.DeepSeq (NFData(rnf))
201#if defined(ASSERTS)
206#if defined(ASSERTS)
202import Control.Exception (assert)
207import Control.Exception (assert)
@@ -205,15 +210,22 @@ import Data.Char (isSpace)
205import Data.Data (Data(gfoldl, toConstr, gunfold, dataTypeOf), constrIndex,
210import Data.Data (Data(gfoldl, toConstr, gunfold, dataTypeOf), constrIndex,
206 Constr, mkConstr, DataType, mkDataType, Fixity(Prefix))
211 Constr, mkConstr, DataType, mkDataType, Fixity(Prefix))
207import Control.Monad (foldM)
212import Control.Monad (foldM)
213+import Control.Monad.ST (ST)
208import qualified Data.Text.Array as A
214import qualified Data.Text.Array as A
209import qualified Data.List as L
215import qualified Data.List as L
216+import Data.Binary (Binary(get, put))
210import Data.Monoid (Monoid(..))
217import Data.Monoid (Monoid(..))
218+#if MIN_VERSION_base(4,9,0)
219+import Data.Semigroup (Semigroup(..))
211import Data.String (IsString(..))
221import Data.String (IsString(..))
212import qualified Data.Text.Internal.Fusion as S
222import qualified Data.Text.Internal.Fusion as S
213import qualified Data.Text.Internal.Fusion.Common as S
223import qualified Data.Text.Internal.Fusion.Common as S
224+import Data.Text.Encoding (decodeUtf8', encodeUtf8)
214import Data.Text.Internal.Fusion (stream, reverseStream, unstream)
225import Data.Text.Internal.Fusion (stream, reverseStream, unstream)
215import Data.Text.Internal.Private (span_)
226import Data.Text.Internal.Private (span_)
216import Data.Text.Internal (Text(..), empty, firstf, mul, safe, text)
227import Data.Text.Internal (Text(..), empty, firstf, mul, safe, text)
228+import Data.Text.Show (singleton, unpack, unpackCString#)
217import qualified Prelude as P
229import qualified Prelude as P
218import Data.Text.Unsafe (Iter(..), iter, iter_, lengthWord16, reverseIter,
230import Data.Text.Unsafe (Iter(..), iter, iter_, lengthWord16, reverseIter,
219 reverseIter_, unsafeHead, unsafeTail)
231 reverseIter_, unsafeHead, unsafeTail)
@@ -226,12 +238,13 @@ import Data.ByteString (ByteString)
226import qualified Data.Text.Lazy as L
238import qualified Data.Text.Lazy as L
227import Data.Int (Int64)
239import Data.Int (Int64)
241+import GHC.Base (eqInt, neInt, gtInt, geInt, ltInt, leInt)
229−#if __GLASGOW_HASKELL__ >= 702
242+#if __GLASGOW_HASKELL__ >= 708
230−import qualified GHC.CString as GHC
243+import qualified GHC.Exts as Exts
232−import qualified GHC.Base as GHC
245+#if MIN_VERSION_base(4,7,0)
246+import Text.Printf (PrintfArg, formatArg, formatString)
234−import GHC.Prim (Addr#)
236-- $strict
249-- $strict
@@ -317,24 +330,48 @@ instance Eq Text where
317instance Ord Text where
330instance Ord Text where
318 compare = compareText
331 compare = compareText
320−instance Show Text where
321− showsPrec p ps r = showsPrec p (unpack ps) r
323instance Read Text where
333instance Read Text where
324 readsPrec p str = [(pack x,y) | (x,y) <- readsPrec p str]
334 readsPrec p str = [(pack x,y) | (x,y) <- readsPrec p str]
336+#if MIN_VERSION_base(4,9,0)
337+-- Semigroup orphan instances for older GHCs are provided by
338+-- 'semigroups` package
340+instance Semigroup Text where
326instance Monoid Text where
344instance Monoid Text where
327 mempty = empty
345 mempty = empty
346+#if MIN_VERSION_base(4,9,0)
347+ mappend = (<>) -- future-proof definition
328 mappend = append
349 mappend = append
329 mconcat = concat
351 mconcat = concat
331instance IsString Text where
353instance IsString Text where
332 fromString = pack
354 fromString = pack
356+#if __GLASGOW_HASKELL__ >= 708
357+instance Exts.IsList Text where
358+ type Item Text = Char
334#if defined(HAVE_DEEPSEQ)
363#if defined(HAVE_DEEPSEQ)
335−instance NFData Text
364+instance NFData Text where rnf !_ = ()
367+instance Binary Text where
368+ put t = put (encodeUtf8 t)
371+ case decodeUtf8' bs of
372+ P.Left exn -> P.fail (P.show exn)
373+ P.Right a -> P.return a
338-- | This instance preserves data abstraction at the cost of inefficiency.
375-- | This instance preserves data abstraction at the cost of inefficiency.
339-- We omit reflection services for the sake of data abstraction.
376-- We omit reflection services for the sake of data abstraction.
@@ -358,6 +395,12 @@ instance Data Text where
358 _ -> P.error "gunfold"
395 _ -> P.error "gunfold"
359 dataTypeOf _ = textDataType
396 dataTypeOf _ = textDataType
398+#if MIN_VERSION_base(4,7,0)
399+-- | Only defined for @base-4.7.0.0@ and later
400+instance PrintfArg Text where
401+ formatArg txt = formatString $ unpack txt
361packConstr :: Constr
404packConstr :: Constr
362packConstr = mkConstr textDataType "pack" [] Prefix
405packConstr = mkConstr textDataType "pack" [] Prefix
@@ -387,30 +430,6 @@ pack :: String -> Text
387pack = unstream . S.map safe . S.streamList
430pack = unstream . S.map safe . S.streamList
388{-# INLINE [1] pack #-}
431{-# INLINE [1] pack #-}
390−-- | /O(n)/ Convert a 'Text' into a 'String'. Subject to fusion.
391−unpack :: Text -> String
392−unpack = S.unstreamList . stream
393−{-# INLINE [1] unpack #-}
395−-- | /O(n)/ Convert a literal string into a Text. Subject to fusion.
396−unpackCString# :: Addr# -> Text
397−unpackCString# addr# = unstream (S.streamCString# addr#)
398−{-# NOINLINE unpackCString# #-}
400−{-# RULES "TEXT literal" forall a.
401− unstream (S.map safe (S.streamList (GHC.unpackCString# a)))
402− = unpackCString# a #-}
404−{-# RULES "TEXT literal UTF8" forall a.
405− unstream (S.map safe (S.streamList (GHC.unpackCStringUtf8# a)))
406− = unpackCString# a #-}
408−-- | /O(1)/ Convert a character into a Text. Subject to fusion.
409−-- Performs replacement on invalid scalar values.
410−singleton :: Char -> Text
411−singleton = unstream . S.singleton . safe
412−{-# INLINE [1] singleton #-}
414-- -----------------------------------------------------------------------------
433-- -----------------------------------------------------------------------------
415-- * Basic functions
434-- * Basic functions
@@ -441,6 +460,7 @@ append a@(Text arr1 off1 len1) b@(Text arr2 off2 len2)
441 | otherwise = overflowError "append"
460 | otherwise = overflowError "append"
443 len = len1+len2
462 len = len1+len2
463+ x :: ST s (A.MArray s)
445 arr <- A.new len
465 arr <- A.new len
446 A.copyI arr 0 arr1 off1 len1
466 A.copyI arr 0 arr1 off1 len1
@@ -466,8 +486,8 @@ head t = S.head (stream t)
466uncons :: Text -> Maybe (Char, Text)
486uncons :: Text -> Maybe (Char, Text)
467uncons t@(Text arr off len)
487uncons t@(Text arr off len)
468 | len <= 0 = Nothing
488 | len <= 0 = Nothing
489+ | otherwise = Just $ let !(Iter c d) = iter t 0
469− | otherwise = Just (c, text arr (off+d) (len-d))
490+ in (c, text arr (off+d) (len-d))
470− where Iter c d = iter t 0
471{-# INLINE [1] uncons #-}
491{-# INLINE [1] uncons #-}
473-- | Lifted from Control.Arrow and specialized.
493-- | Lifted from Control.Arrow and specialized.
@@ -552,7 +572,9 @@ isSingleton = S.isSingleton . stream
552-- Subject to fusion.
572-- Subject to fusion.
553length :: Text -> Int
573length :: Text -> Int
554length t = S.length (stream t)
574length t = S.length (stream t)
555−{-# INLINE length #-}
575+{-# INLINE [0] length #-}
576+-- length needs to be phased after the compareN/length rules otherwise
577+-- it may inline before the rules have an opportunity to fire.
557-- | /O(n)/ Compare the count of characters in a 'Text' to a number.
579-- | /O(n)/ Compare the count of characters in a 'Text' to a number.
558-- Subject to fusion.
580-- Subject to fusion.
@@ -571,32 +593,32 @@ compareLength t n = S.compareLengthI (stream t) n
573"TEXT ==N/length -> compareLength/==EQ" [~1] forall t n.
595"TEXT ==N/length -> compareLength/==EQ" [~1] forall t n.
574− (==) (length t) n = compareLength t n == EQ
596+ eqInt (length t) n = compareLength t n == EQ
578"TEXT /=N/length -> compareLength//=EQ" [~1] forall t n.
600"TEXT /=N/length -> compareLength//=EQ" [~1] forall t n.
579− (/=) (length t) n = compareLength t n /= EQ
601+ neInt (length t) n = compareLength t n /= EQ
583"TEXT <N/length -> compareLength/==LT" [~1] forall t n.
605"TEXT <N/length -> compareLength/==LT" [~1] forall t n.
584− (<) (length t) n = compareLength t n == LT
606+ ltInt (length t) n = compareLength t n == LT
588"TEXT <=N/length -> compareLength//=GT" [~1] forall t n.
610"TEXT <=N/length -> compareLength//=GT" [~1] forall t n.
589− (<=) (length t) n = compareLength t n /= GT
611+ leInt (length t) n = compareLength t n /= GT
593"TEXT >N/length -> compareLength/==GT" [~1] forall t n.
615"TEXT >N/length -> compareLength/==GT" [~1] forall t n.
594− (>) (length t) n = compareLength t n == GT
616+ gtInt (length t) n = compareLength t n == GT
598"TEXT >=N/length -> compareLength//=LT" [~1] forall t n.
620"TEXT >=N/length -> compareLength//=LT" [~1] forall t n.
599− (>=) (length t) n = compareLength t n /= LT
621+ geInt (length t) n = compareLength t n /= LT
602-- -----------------------------------------------------------------------------
624-- -----------------------------------------------------------------------------
@@ -627,11 +649,37 @@ reverse :: Text -> Text
627reverse t = S.reverse (stream t)
649reverse t = S.reverse (stream t)
628{-# INLINE reverse #-}
650{-# INLINE reverse #-}
630−-- | /O(m+n)/ Replace every occurrence of one substring with another.
652+-- | /O(m+n)/ Replace every non-overlapping occurrence of @needle@ in
653+-- @haystack@ with @replacement@.
655+-- This function behaves as though it was defined as follows:
658+-- replace needle replacement haystack =
659+-- 'intercalate' replacement ('splitOn' needle haystack)
662+-- As this suggests, each occurrence is replaced exactly once. So if
663+-- @needle@ occurs in @replacement@, that occurrence will /not/ itself
664+-- be replaced recursively:
666+-- > replace "oo" "foo" "oo" == "foo"
668+-- In cases where several instances of @needle@ overlap, only the
669+-- first one will be replaced:
671+-- > replace "ofo" "bar" "ofofo" == "barfo"
632-- In (unlikely) bad cases, this function's time complexity degrades
673-- In (unlikely) bad cases, this function's time complexity degrades
633-- towards /O(n*m)/.
674-- towards /O(n*m)/.
634−replace :: Text -> Text -> Text -> Text
675+replace :: Text
676+ -- ^ @needle@ to search for. If this string is empty, an
677+ -- error will occur.
679+ -- ^ @replacement@ to replace @needle@ with.
681+ -- ^ @haystack@ in which to search.
635replace needle@(Text _ _ neeLen)
683replace needle@(Text _ _ neeLen)
636 (Text repArr repOff repLen)
684 (Text repArr repOff repLen)
637 haystack@(Text hayArr hayOff hayLen)
685 haystack@(Text hayArr hayOff hayLen)
@@ -642,6 +690,7 @@ replace needle@(Text _ _ neeLen)
643 ixs = indices needle haystack
691 ixs = indices needle haystack
644 len = hayLen - (neeLen - repLen) `mul` L.length ixs
692 len = hayLen - (neeLen - repLen) `mul` L.length ixs
693+ x :: ST s (A.MArray s)
646 marr <- A.new len
695 marr <- A.new len
647 let loop (i:is) o d = do
696 let loop (i:is) o d = do
@@ -692,7 +741,7 @@ replace needle@(Text _ _ neeLen)
692-- instead of itself.
741-- instead of itself.
693toCaseFold :: Text -> Text
742toCaseFold :: Text -> Text
694toCaseFold t = unstream (S.toCaseFold (stream t))
743toCaseFold t = unstream (S.toCaseFold (stream t))
695−{-# INLINE [0] toCaseFold #-}
744+{-# INLINE toCaseFold #-}
697-- | /O(n)/ Convert a string to lower case, using simple case
746-- | /O(n)/ Convert a string to lower case, using simple case
698-- conversion. Subject to fusion.
747-- conversion. Subject to fusion.
@@ -852,6 +901,7 @@ concat ts = case ts' of
853 ts' = L.filter (not . null) ts
902 ts' = L.filter (not . null) ts
854 len = sumP "concat" $ L.map lengthWord16 ts'
903 len = sumP "concat" $ L.map lengthWord16 ts'
904+ go :: ST s (A.MArray s)
856 arr <- A.new len
906 arr <- A.new len
857 let step i (Text a o l) =
907 let step i (Text a o l) =
@@ -865,13 +915,13 @@ concatMap f = concat . foldr ((:) . f) []
865{-# INLINE concatMap #-}
915{-# INLINE concatMap #-}
867-- | /O(n)/ 'any' @p@ @t@ determines whether any character in the
917-- | /O(n)/ 'any' @p@ @t@ determines whether any character in the
868−-- 'Text' @t@ satisifes the predicate @p@. Subject to fusion.
918+-- 'Text' @t@ satisfies the predicate @p@. Subject to fusion.
869any :: (Char -> Bool) -> Text -> Bool
919any :: (Char -> Bool) -> Text -> Bool
870any p t = S.any p (stream t)
920any p t = S.any p (stream t)
871{-# INLINE any #-}
921{-# INLINE any #-}
873-- | /O(n)/ 'all' @p@ @t@ determines whether all characters in the
923-- | /O(n)/ 'all' @p@ @t@ determines whether all characters in the
874−-- 'Text' @t@ satisify the predicate @p@. Subject to fusion.
924+-- 'Text' @t@ satisfy the predicate @p@. Subject to fusion.
875all :: (Char -> Bool) -> Text -> Bool
925all :: (Char -> Bool) -> Text -> Bool
876all p t = S.all p (stream t)
926all p t = S.all p (stream t)
877{-# INLINE all #-}
927{-# INLINE all #-}
@@ -965,6 +1015,7 @@ replicate n t@(Text a o l)
965 | otherwise = Text (A.run x) 0 len
1015 | otherwise = Text (A.run x) 0 len
967 len = l `mul` n
1017 len = l `mul` n
1018+ x :: ST s (A.MArray s)
969 arr <- A.new len
1020 arr <- A.new len
970 let loop !d !i | i >= n = return arr
1021 let loop !d !i | i >= n = return arr
@@ -1101,6 +1152,27 @@ takeWhile p t@(Text arr off len) = loop 0
1101 unstream (S.takeWhile p (stream t)) = takeWhile p t
1152 unstream (S.takeWhile p (stream t)) = takeWhile p t
1155+-- | /O(n)/ 'takeWhileEnd', applied to a predicate @p@ and a 'Text',
1156+-- returns the longest suffix (possibly empty) of elements that
1157+-- satisfy @p@. Subject to fusion.
1160+-- > takeWhileEnd (=='o') "foo" == "oo"
1161+takeWhileEnd :: (Char -> Bool) -> Text -> Text
1162+takeWhileEnd p t@(Text arr off len) = loop (len-1) len
1163+ where loop !i !l | l <= 0 = t
1164+ | p c = loop (i+d) (l+d)
1165+ | otherwise = text arr (off+l) (len-l)
1166+ where (c,d) = reverseIter t i
1167+{-# INLINE [1] takeWhileEnd #-}
1170+"TEXT takeWhileEnd -> fused" [~1] forall p t.
1171+ takeWhileEnd p t = S.reverse (S.takeWhile p (S.reverseStream t))
1172+"TEXT takeWhileEnd -> unfused" [1] forall p t.
1173+ S.reverse (S.takeWhile p (S.reverseStream t)) = takeWhileEnd p t
1104-- | /O(n)/ 'dropWhile' @p@ @t@ returns the suffix remaining after
1176-- | /O(n)/ 'dropWhile' @p@ @t@ returns the suffix remaining after
1105-- 'takeWhile' @p@ @t@. Subject to fusion.
1177-- 'takeWhile' @p@ @t@. Subject to fusion.
1106dropWhile :: (Char -> Bool) -> Text -> Text
1178dropWhile :: (Char -> Bool) -> Text -> Text
@@ -1119,8 +1191,9 @@ dropWhile p t@(Text arr off len) = loop 0 0
1121-- | /O(n)/ 'dropWhileEnd' @p@ @t@ returns the prefix remaining after
1193-- | /O(n)/ 'dropWhileEnd' @p@ @t@ returns the prefix remaining after
1122−-- dropping characters that fail the predicate @p@ from the end of
1194+-- dropping characters that satisfy the predicate @p@ from the end of
1123-- @t@. Subject to fusion.
1195-- @t@. Subject to fusion.
1124-- Examples:
1197-- Examples:
1126-- > dropWhileEnd (=='.') "foo..." == "foo"
1199-- > dropWhileEnd (=='.') "foo..." == "foo"
@@ -1140,7 +1213,7 @@ dropWhileEnd p t@(Text arr off len) = loop (len-1) len
1142-- | /O(n)/ 'dropAround' @p@ @t@ returns the substring remaining after
1215-- | /O(n)/ 'dropAround' @p@ @t@ returns the substring remaining after
1143−-- dropping characters that fail the predicate @p@ from both the
1216+-- dropping characters that satisfy the predicate @p@ from both the
1144-- beginning and end of @t@. Subject to fusion.
1217-- beginning and end of @t@. Subject to fusion.
1145dropAround :: (Char -> Bool) -> Text -> Text
1218dropAround :: (Char -> Bool) -> Text -> Text
1146dropAround p = dropWhile p . dropWhileEnd p
1219dropAround p = dropWhile p . dropWhileEnd p
@@ -1235,9 +1308,9 @@ tails t | null t = [empty]
1235-- copies to create substrings; they just construct new 'Text's that
1308-- copies to create substrings; they just construct new 'Text's that
1236-- are slices of the original.
1309-- are slices of the original.
1238−-- | /O(m+n)/ Break a 'Text' into pieces separated by the first
1311+-- | /O(m+n)/ Break a 'Text' into pieces separated by the first 'Text'
1239−-- 'Text' argument, consuming the delimiter. An empty delimiter is
1312+-- argument (which cannot be empty), consuming the delimiter. An empty
1240−-- invalid, and will cause an error to be raised.
1313+-- delimiter is invalid, and will cause an error to be raised.
1242-- Examples:
1315-- Examples:
@@ -1250,9 +1323,16 @@ tails t | null t = [empty]
1250-- > intercalate s . splitOn s == id
1323-- > intercalate s . splitOn s == id
1251-- > splitOn (singleton c) == split (==c)
1324-- > splitOn (singleton c) == split (==c)
1326+-- (Note: the string @s@ to split on above cannot be empty.)
1253-- In (unlikely) bad cases, this function's time complexity degrades
1328-- In (unlikely) bad cases, this function's time complexity degrades
1254-- towards /O(n*m)/.
1329-- towards /O(n*m)/.
1255−splitOn :: Text -> Text -> [Text]
1330+splitOn :: Text
1331+ -- ^ String to split on. If this string is empty, an error
1256splitOn pat@(Text _ _ l) src@(Text arr off len)
1336splitOn pat@(Text _ _ l) src@(Text arr off len)
1257 | l <= 0 = emptyError "splitOn"
1337 | l <= 0 = emptyError "splitOn"
1258 | isSingleton pat = split (== unsafeHead pat) src
1338 | isSingleton pat = split (== unsafeHead pat) src
@@ -1460,7 +1540,7 @@ countChar c t = S.countChar c (stream t)
1460-- equivalent to a pair of 'unpack' operations.
1540-- equivalent to a pair of 'unpack' operations.
1461zip :: Text -> Text -> [(Char,Char)]
1541zip :: Text -> Text -> [(Char,Char)]
1462zip a b = S.unstreamList $ S.zipWith (,) (stream a) (stream b)
1542zip a b = S.unstreamList $ S.zipWith (,) (stream a) (stream b)
1463−{-# INLINE [0] zip #-}
1543+{-# INLINE zip #-}
1465-- | /O(n)/ 'zipWith' generalises 'zip' by zipping with the function
1545-- | /O(n)/ 'zipWith' generalises 'zip' by zipping with the function
1466-- given as the first argument, instead of a tupling function.
1546-- given as the first argument, instead of a tupling function.
@@ -1468,7 +1548,7 @@ zip a b = S.unstreamList $ S.zipWith (,) (stream a) (stream b)
1468zipWith :: (Char -> Char -> Char) -> Text -> Text -> Text
1548zipWith :: (Char -> Char -> Char) -> Text -> Text -> Text
1469zipWith f t1 t2 = unstream (S.zipWith g (stream t1) (stream t2))
1549zipWith f t1 t2 = unstream (S.zipWith g (stream t1) (stream t2))
1470 where g a b = safe (f a b)
1550 where g a b = safe (f a b)
1471−{-# INLINE [0] zipWith #-}
1551+{-# INLINE zipWith #-}
1473-- | /O(n)/ Breaks a 'Text' up into a list of words, delimited by 'Char's
1553-- | /O(n)/ Breaks a 'Text' up into a list of words, delimited by 'Char's
1474-- representing white space.
1554-- representing white space.
@@ -1668,6 +1748,7 @@ overflowError fun = P.error $ "Data.Text." ++ fun ++ ": size overflow"
1668copy :: Text -> Text
1748copy :: Text -> Text
1669copy (Text arr off len) = Text (A.run go) 0 len
1749copy (Text arr off len) = Text (A.run go) 0 len
1751+ go :: ST s (A.MArray s)
1672 marr <- A.new len
1753 marr <- A.new len
1673 A.copyI marr 0 arr off len
1754 A.copyI marr 0 arr off len