Skip to content
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
117 changes: 103 additions & 14 deletions src/Data/Text.hs
Original file line number Diff line number Diff line change
Expand Up @@ -172,7 +172,9 @@ module Data.Text
-- ** Breaking into many substrings
-- $split
, splitOn
, splitOnNE
, split
, splitNE
, chunksOf

-- ** Breaking into lines and words
Expand Down Expand Up @@ -274,7 +276,7 @@ import qualified Data.Text.Lazy as L
#endif
import Data.Word (Word8)
import Foreign.C.Types
import GHC.Base (eqChar, neChar, eqInt, neInt, gtInt, geInt, ltInt, leInt)
import GHC.Base (eqChar, neChar, eqInt, neInt, gtInt, geInt, ltInt, leInt, NonEmpty ((:|)))
import qualified GHC.Exts as Exts
import GHC.Int (Int8)
import GHC.Stack (HasCallStack)
Expand Down Expand Up @@ -1063,6 +1065,12 @@ center k c t
--
-- >>> transpose ["blue","red"]
-- ["br","le","ud","e"]
--
-- >>> transpose [""]
-- []
--
-- >>> transpose []
-- []
transpose :: [Text] -> [Text]
transpose ts = P.map pack (L.transpose (P.map unpack ts))

Expand Down Expand Up @@ -1708,6 +1716,21 @@ spanEndM p t@(Text arr off len) = go (len-1)
{-# INLINE spanEndM #-}

-- | /O(n)/ Group characters in a string according to a predicate.
--
-- >>> groupBy (\a b -> a < b) "7890012"
-- ["789","0","012"]
--
-- >>> groupBy (\_ _ -> True) "hello"
-- ["hello"]
--
-- >>> groupBy (\_ _ -> False) "hello"
-- ["h","e","l","l","o"]
--
-- >>> groupBy (P.error "not called") ""
-- []
--
-- >>> groupBy (P.error "not called") ""
-- []
groupBy :: (Char -> Char -> Bool) -> Text -> [Text]
groupBy p = loop
where
Expand All @@ -1732,6 +1755,9 @@ group = groupBy (==)

-- | /O(n)/ Return all initial segments of the given 'Text', shortest
-- first.
--
-- >>> inits ""
-- [""]
inits :: Text -> [Text]
inits = (NonEmptyList.toList $!) . initsNE

Expand All @@ -1749,6 +1775,9 @@ initsNE t = empty NonEmptyList.:| case t of

-- | /O(n)/ Return all final segments of the given 'Text', longest
-- first.
--
-- >>> tails ""
-- [""]
tails :: Text -> [Text]
tails = (NonEmptyList.toList $!) . tailsNE

Expand Down Expand Up @@ -1791,27 +1820,62 @@ tailsNE t
--
-- In (unlikely) bad cases, this function's time complexity degrades
-- towards /O(n*m)/.
--
-- See also 'splitOnNE' for a version of this function returning 'NonEmpty Text'.
splitOn :: HasCallStack
=> Text
-- ^ String to split on. If this string is empty, an error
-- will occur.
-> Text
-- ^ Input text.
-> [Text]
splitOn pat@(Text _ _ l) src@(Text arr off len)
| l <= 0 = emptyError "splitOn"
| isSingleton pat = split (== unsafeHead pat) src
| otherwise = go 0 (indices pat src)
where
go !s (x:xs) = text arr (s+off) (x-s) : go (x+l) xs
go s _ = [text arr (s+off) (len-s)]
splitOn pat
| null pat = emptyError "splitOn"
| otherwise = NonEmptyList.toList . splitOnNE pat
{-# INLINE [1] splitOn #-}

{-# RULES
"TEXT splitOn/singleton -> split/==" [~1] forall c t.
splitOn (singleton c) t = split (==c) t
#-}

-- | Similar to 'splitOn', except that it returns @'NonEmpty' 'Text'@ instead
-- of @['Text']@..
--
-- Examples:
--
-- >>> splitOnNE "\r\n" "a\r\nb\r\nd\r\ne"
-- "a" :| ["b","d","e"]
--
-- >>> splitOnNE "aaa" "aaaXaaaXaaaXaaa"
-- "" :| ["X","X","X",""]
--
-- >>> splitOnNE "x" "x"
-- "" :| [""]
splitOnNE :: HasCallStack
=> Text
-- ^ String to split on. If this string is empty, an error
-- will occur.
-> Text
-- ^ Input text.
-> NonEmptyList.NonEmpty Text
splitOnNE pat@(Text _ _ l) src@(Text arr off len)
= case uncons pat of
Nothing -> emptyError "splitOnNE"
Just (c, cs) | null cs -> splitNE (== c) src
_ -> go 0 (indices pat src)
where
go :: Int -> [Int] -> NonEmptyList.NonEmpty Text
go !s (x:xs) = NonEmptyList.cons (text arr (s+off) (x-s))

Copy link
Copy Markdown
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

One more go that should return [Text].

(go (x+l) xs)
go s _ = text arr (s+off) (len-s) :| []
{-# INLINE [1] splitOnNE #-}

{-# RULES
"TEXT splitOnNE/singleton -> split/==" [~1] forall c t.
splitOnNE (singleton c) t = splitNE (==c) t
#-}

-- | /O(n)/ Splits a 'Text' into components delimited by separators,
-- where the predicate returns True for a separator element. The
-- resulting components do not contain the separators. Two adjacent
Expand All @@ -1822,19 +1886,44 @@ splitOn pat@(Text _ _ l) src@(Text arr off len)
--
-- >>> split (=='a') ""
-- [""]
--
-- See also 'splitNE' for a version of this function returning 'NonEmpty Text'.
split :: (Char -> Bool) -> Text -> [Text]
split p t
| null t = [empty]
| otherwise = loop t
where loop s | null s' = [l]
| otherwise = l : loop (unsafeTail s')
where (# l, s' #) = span_ (not . p) s
split p = NonEmptyList.toList . splitNE p
{-# INLINE split #-}

-- | Similar to 'split', except that it returns @'NonEmpty' 'Text'@ instead of
-- @['Text']@.
--
-- >>> splitNE (=='a') "aabbaca"
-- "" :| ["","bb","c",""]
--
-- >>> splitNE (=='a') ""
-- "" :| []
--
-- >>> splitNE (=='b') "aabbaca"
-- "aa" :| ["","aca"]
--
splitNE :: (Char -> Bool) -> Text -> NonEmptyList.NonEmpty Text
splitNE p t
| null t = empty :| []
| otherwise = let (# l, r #) = span_ (not . p) t
in l :| loop r
where
loop :: Text -> [Text]
loop s | null s = []
| null s' = [l']
| otherwise = l' : loop s'
where (# l', s' #) = span_ (not . p) (unsafeTail s)
{-# INLINE splitNE #-}

-- | /O(n)/ Splits a 'Text' into components of length @k@. The last
-- element may be shorter than the other chunks, depending on the
-- length of the input. Examples:
--
-- >>> chunksOf 3 ""
-- []
--
-- >>> chunksOf 3 "foobarbaz"
-- ["foo","bar","baz"]
--
Expand Down
3 changes: 2 additions & 1 deletion src/Data/Text/Internal/Lazy.hs
Original file line number Diff line number Diff line change
Expand Up @@ -53,7 +53,8 @@ data Text = Empty
--
-- @since 2.1.2
| Chunk {-# UNPACK #-} !T.Text Text
-- ^ Chunks must be non-empty, this invariant is not checked.
-- ^ The first argument of @Chunk@ must be non-empty; this invariant
-- is not checked. See also 'chunk'.

-- | Type synonym for the lazy flavour of 'Text'.
--
Expand Down
110 changes: 88 additions & 22 deletions src/Data/Text/Lazy.hs
Original file line number Diff line number Diff line change
Expand Up @@ -172,7 +172,9 @@ module Data.Text.Lazy
-- ** Breaking into many substrings
-- $split
, splitOn
, splitOnNE
, split
, splitNE
, chunksOf
-- , breakSubstring

Expand Down Expand Up @@ -303,7 +305,7 @@ import Text.Printf (PrintfArg, formatArg, formatString)
-- $setup
-- >>> :set -package transformers
-- >>> import Control.Monad.Trans.State
-- >>> import Data.Text
-- >>> import Data.Text.Lazy
-- >>> import qualified Data.Text as T
-- >>> :seti -XOverloadedStrings

Expand Down Expand Up @@ -428,7 +430,7 @@ textDataType = mkDataType "Data.Text.Lazy.Text" [packConstr]
--
-- Performs replacement on invalid scalar values, so @'unpack' . 'pack'@ is not 'id':
--
-- >>> Data.Text.Lazy.unpack (Data.Text.Lazy.pack "\55555")
-- >>> unpack (pack "\55555")
-- "\65533"
pack ::
#if defined(ASSERTS)
Expand Down Expand Up @@ -1599,9 +1601,14 @@ tailsNE ts@(Chunk t ts')
--
-- Examples:
--
-- > splitOn "\r\n" "a\r\nb\r\nd\r\ne" == ["a","b","d","e"]
-- > splitOn "aaa" "aaaXaaaXaaaXaaa" == ["","X","X","X",""]
-- > splitOn "x" "x" == ["",""]
-- >>> splitOn "\r\n" "a\r\nb\r\nd\r\ne"
-- ["a","b","d","e"]
--
-- >>> splitOn "aaa" "aaaXaaaXaaaXaaa"
-- ["","X","X","X",""]
--
-- >>> splitOn "x" "x"
-- ["",""]
--
-- and
--
Expand All @@ -1622,38 +1629,86 @@ splitOn :: HasCallStack
-> Text
-- ^ Input text.
-> [Text]
splitOn pat src
| null pat = emptyError "splitOn"
| isSingleton pat = split (== head pat) src
| otherwise = go 0 (indices pat src) src
where
go _ [] cs = [cs]
go !i (x:xs) cs = let h :*: t = splitAtWord (x-i) cs
in h : go (x+l) xs (dropWords l t)
l = foldlChunks (\a (T.Text _ _ b) -> a + intToInt64 b) 0 pat
splitOn pat
| null pat = emptyError "splitOn"
| otherwise = NE.toList . splitOnNE pat
{-# INLINE [1] splitOn #-}

{-# RULES
"LAZY TEXT splitOn/singleton -> split/==" [~1] forall c t.
splitOn (singleton c) t = split (==c) t
#-}

-- | Similar to 'splitOn', except that it returns @'NonEmpty' 'Text'@ instead
-- of @['Text']@.
--
-- Examples:
--
-- >>> splitOnNE "\r\n" "a\r\nb\r\nd\r\ne"
-- "a" :| ["b","d","e"]
--
-- >>> splitOnNE "aaa" "aaaXaaaXaaaXaaa"
-- "" :| ["X","X","X",""]
--
-- >>> splitOnNE "x" "x"
-- "" :| [""]
splitOnNE :: HasCallStack
=> Text
-- ^ String to split on. If this string is empty, an error
-- will occur.
-> Text
-- ^ Input text.
-> NE.NonEmpty Text
splitOnNE pat src = case uncons pat of
Nothing -> emptyError "splitOnNE"
Just (c, cs) | null cs -> splitNE (== c) src
_ -> go 0 (indices pat src) src
where
go :: Int64 -> [Int64] -> Text -> NE.NonEmpty Text
go _ [] cs = cs :| []
go !i (x:xs) cs = let h :*: t = splitAtWord (x-i) cs
in NE.cons h $ go (x+l) xs (dropWords l t)

Copy link
Copy Markdown
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

These loops should produce a list [Text] instead of NonEmpty Text. Here every go outputs a :| to be immediately consumed by NE.cons.

Copy link
Copy Markdown
Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Can you reconsider this and the other two comments in light of this earlier comment from Bodigrim?

TBH I'm not terribly happy with the partial NE.fromList here. Let's either make go to return NonEmpty Text (which will incur a bit of performance penalty for Data.List.NonEmpty.cons repacking the head of the list, but probably not significant), or unroll the first iteration of go manually.

l = foldlChunks (\a (T.Text _ _ b) -> a + intToInt64 b) 0 pat
{-# INLINE [1] splitOnNE #-}

{-# RULES
"LAZY TEXT splitOnNE/singleton -> split/==" [~1] forall c t.
splitOnNE (singleton c) t = splitNE (==c) t
#-}

-- | /O(n)/ Splits a 'Text' into components delimited by separators,
-- where the predicate returns True for a separator element. The
-- resulting components do not contain the separators. Two adjacent
-- separators result in an empty component in the output. eg.
--
-- > split (=='a') "aabbaca" == ["","","bb","c",""]
-- > split (=='a') [] == [""]
-- >>> split (=='a') "aabbaca"
-- ["","","bb","c",""]
--
-- >>> split (=='a') ""
-- [""]
--
split :: (Char -> Bool) -> Text -> [Text]
split _ Empty = [Empty]
split p (Chunk t0 ts0) = comb [] (T.split p t0) ts0
where comb acc (s:[]) Empty = revChunks (s:acc) : []
comb acc (s:[]) (Chunk t ts) = comb (s:acc) (T.split p t) ts
comb acc (s:ss) ts = revChunks (s:acc) : comb [] ss ts
comb _ [] _ = impossibleError "split"
split p = NE.toList . splitNE p
{-# INLINE split #-}

-- | Similar to 'split', except that it returns @'NonEmpty' 'Text'@ instead of
-- @['Text']@.
--
-- >>> splitNE (=='a') "aabbaca"
-- "" :| ["","bb","c",""]
--
-- >>> splitNE (=='a') ""
-- "" :| []
--
splitNE :: (Char -> Bool) -> Text -> NE.NonEmpty Text
splitNE _ Empty = Empty :| []
splitNE p (Chunk t0 ts0) = comb [] (T.splitNE p t0) ts0
where comb :: [T.Text] -> NE.NonEmpty T.Text -> Text -> NE.NonEmpty Text
comb acc (s :| []) Empty = revChunks (s:acc) :| []
comb acc (s :| []) (Chunk t ts) = comb (s:acc) (T.splitNE p t) ts
comb acc (s :| ss : sss) ts = NE.cons (revChunks (s:acc)) $ comb [] (ss :| sss) ts

Copy link
Copy Markdown
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Here too comb should produce [Text], otherwise every comp produces a :| only to be immediately consumed by NE.cons. Similarly the NonEmpty Text argument should be either left as a list or unpacked as two arguments.

{-# INLINE splitNE #-}

-- | /O(n)/ Splits a 'Text' into components of length @k@. The last
-- element may be shorter than the other chunks, depending on the
-- length of the input. Examples:
Expand Down Expand Up @@ -1928,6 +1983,17 @@ zipWith f t1 t2 = unstream (S.zipWith g (stream t1) (stream t2))
show :: Show a => a -> Text
show = pack . P.show

-- >>> revChunks ["one", "two"]
-- "twoone"
--
-- >>> revChunks ["one"]
-- "one"
--
-- >>> revChunks [""]
-- ""
--
-- >>> revChunks []
-- ""
revChunks :: [T.Text] -> Text
revChunks = L.foldl' (flip chunk) Empty

Expand Down