fix overflow caused by manyTill implementation

Author: justinwoo

src/Text/Parsing/StringParser/Combinators.purs

@@ -31,10 +31,11 @@ import Prelude
 
 import Control.Alt ((<|>))
 import Control.Lazy (fix)
+import Control.Monad.Rec.Class (Step(..), tailRecM)
 
 import Data.Either (Either(..))
 import Data.Foldable (class Foldable, foldl)
-import Data.List (List(..), singleton, manyRec)
+import Data.List (List(..), singleton, manyRec, reverse)
 import Data.Maybe (Maybe(..))
 
 import Text.Parsing.StringParser (Parser(..), fail)
@@ -151,5 +152,12 @@ manyTill p end = (end *> pure Nil) <|> many1Till p end
 many1Till :: forall a end. Parser a -> Parser end -> Parser (List a)
 many1Till p end = do
   x <- p
-  xs <- manyTill p end
-  pure (Cons x xs)
+  tailRecM inner (pure x)
+  where
+    ending acc = do
+      _ <- end
+      pure $ Done (reverse acc)
+    continue acc = do
+      c <- p
+      pure $ Loop (Cons c acc)
+    inner acc = ending acc <|> continue acc

test/Main.purs

@@ -7,7 +7,9 @@ import Control.Monad.Eff (Eff)
 import Control.Monad.Eff.Console (CONSOLE)
 
 import Data.Either (isLeft, isRight, Either(..))
+import Data.Foldable (fold)
 import Data.List (List(Nil), (:))
+import Data.List.Lazy (take, repeat)
 import Data.String (joinWith, singleton)
 import Data.Unfoldable (replicate)
 
@@ -90,3 +92,7 @@ main = do
   assert $ expectResult Nil (manyTill (string "a") (string "b")) "b"
   assert $ expectResult ("a":"a":"a":Nil)  (many1Till (string "a") (string "b")) "aaab"
   assert $ parseFail (many1Till (string "a") (string "b")) "b"
+  -- check against overflow
+  assert $ canParse (many1Till (string "a") (string "and")) $ (fold <<< take 10000 $ repeat "a") <> "and"
+  -- check correct order
+  assert $ expectResult ('a':'b':'c':Nil)  (many1Till anyChar (string "d")) "abcd"