Commit 0630bd31 authored by Bodigrim's avatar Bodigrim Committed by Xia Li-yao
Browse files

Restore laziness of Data.Text.Lazy.lines (broken in 55358a4c)

parent 478fe5b9
......@@ -203,6 +203,7 @@ import Prelude (Char, Bool(..), Maybe(..), String,
(&&), (+), (-), (.), ($), (++),
error, flip, fmap, fromIntegral, not, otherwise, quot)
import qualified Prelude as P
import Control.Arrow (first)
import Control.DeepSeq (NFData(..))
import Data.Bits (finiteBitSize)
import Data.Int (Int64)
......@@ -211,6 +212,8 @@ import Data.Char (isSpace)
import Data.Data (Data(gfoldl, toConstr, gunfold, dataTypeOf), constrIndex,
Constr, mkConstr, DataType, mkDataType, Fixity(Prefix))
import Data.Binary (Binary(get, put))
import Data.List.NonEmpty (NonEmpty(..))
import qualified Data.List.NonEmpty as NE
import Data.Monoid (Monoid(..))
import Data.Semigroup (Semigroup(..))
import Data.String (IsString(..))
......@@ -1415,23 +1418,26 @@ chunksOf k = go
-- 'lines' __does not__ treat @'\\r'@ (CR, carriage return) as a newline character.
lines :: Text -> [Text]
lines Empty = []
lines (Chunk c cs)
| hasNlEnd c = P.map fromStrict (T.lines c) ++ lines cs
| otherwise = case T.lines c of
[] -> error "lines: unexpected empty chunk"
l : ls -> go l ls cs
lines t = NE.toList $ go t
where
go l [] Empty = [fromStrict l]
go l [] (Chunk x xs) = case T.lines x of
[] -> error "lines: unexpected empty chunk"
[xl]
| hasNlEnd x -> chunk l (fromStrict xl) : lines xs
| otherwise -> go (l `T.append` xl) [] xs
xl : yl : yls -> chunk l (fromStrict xl) :
if hasNlEnd x
then P.map fromStrict (yl : yls) ++ lines xs
else go yl yls xs
go l (m : ms) xs = fromStrict l : go m ms xs
go :: Text -> NonEmpty Text
go Empty = Empty :| []
go (Chunk x xs)
-- x is non-empty, so T.lines x is non-empty as well
| hasNlEnd x = NE.fromList $ P.map fromStrict (T.lines x) ++ lines xs
| otherwise = case unsnocList (T.lines x) of
Nothing -> error "lines: unexpected empty chunk"
Just (ls, l) -> P.foldr (NE.cons . fromStrict) (prependToHead l (go xs)) ls
prependToHead :: T.Text -> NonEmpty Text -> NonEmpty Text
prependToHead l ~(x :| xs) = chunk l x :| xs -- Lazy pattern is crucial!
unsnocList :: [a] -> Maybe ([a], a)
unsnocList [] = Nothing
unsnocList (x : xs) = Just $ go x xs
where
go y [] = ([], y)
go y (z : zs) = first (y :) (go z zs)
hasNlEnd :: T.Text -> Bool
hasNlEnd (T.Text arr off len) = A.unsafeIndex arr (off + len - 1) == 0x0A
......
......@@ -16,6 +16,7 @@ import qualified Data.List as L
import qualified Data.Text as T
import qualified Data.Text.Internal.Fusion as S
import qualified Data.Text.Internal.Fusion.Common as S
import qualified Data.Text.Internal.Lazy as TL (Text(..))
import qualified Data.Text.Internal.Lazy.Fusion as SL
import qualified Data.Text.Lazy as TL
import qualified Tests.SlowFunctions as Slow
......@@ -204,6 +205,10 @@ tl_lines = L.lines `eqP` (map unpackS . TL.lines)
t_lines_spacy = (L.lines `eqP` (map unpackS . T.lines)) . getSpacyString
tl_lines_spacy = (L.lines `eqP` (map unpackS . TL.lines)) . getSpacyString
tl_lines_laziness = TL.head (head (TL.lines (TL.replicate 1000000000000000 (TL.singleton 'a')))) === 'a'
tl_lines_specialCase = TL.lines (TL.Chunk (T.pack "foo") $ TL.Chunk (T.pack "bar\nbaz\n") $ TL.Empty) === [TL.pack "foobar", TL.pack "baz"]
t_words = L.words `eqP` (map unpackS . T.words)
tl_words = L.words `eqP` (map unpackS . TL.words)
t_words_spacy = (L.words `eqP` (map unpackS . T.words)) . getSpacyString
......@@ -351,6 +356,8 @@ testSubstrings =
testProperty "tl_lines" tl_lines,
testProperty "t_lines_spacy" t_lines_spacy,
testProperty "tl_lines_spacy" tl_lines_spacy,
testProperty "tl_lines_laziness" tl_lines_laziness,
testProperty "tl_lines_specialCase" tl_lines_specialCase,
testProperty "t_words" t_words,
testProperty "tl_words" tl_words,
testProperty "t_words_spacy" t_words_spacy,
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment