Merge pull request #24 from purescript-contrib/monadrec-many

Use MonadRec for many

Author: garyb

bower.json

@@ -25,11 +25,12 @@
     "purescript-strings": "^2.0.2",
     "purescript-foldable-traversable": "^2.0.0",
     "purescript-either": "^2.0.0",
-    "purescript-lists": "^3.0.1",
+    "purescript-lists": "^3.1.0",
     "purescript-tailrec": "^2.0.0"
   },
   "devDependencies": {
     "purescript-math": "^2.0.0",
-    "purescript-console": "^2.0.0"
+    "purescript-console": "^2.0.0",
+    "purescript-assert": "^2.0.0"
   }
 }

src/Text/Parsing/StringParser/Combinators.purs

@@ -1,17 +1,42 @@
 -- | This module defines combinators for building string parsers.
 
-module Text.Parsing.StringParser.Combinators where
+module Text.Parsing.StringParser.Combinators
+  ( lookAhead
+  , many
+  , many1
+  , withError, (<?>)
+  , between
+  , option
+  , optional
+  , optionMaybe
+  , sepBy
+  , sepBy1
+  , sepEndBy
+  , sepEndBy1
+  , endBy1
+  , endBy
+  , chainr
+  , chainl
+  , chainl1
+  , chainl1'
+  , chainr1
+  , chainr1'
+  , choice
+  , manyTill
+  , module Control.Lazy
+  ) where
 
 import Prelude
 
+import Control.Alt ((<|>))
+import Control.Lazy (fix)
+
 import Data.Either (Either(..))
-import Data.Maybe (Maybe(..))
-import Data.List (List(..), singleton)
 import Data.Foldable (class Foldable, foldl)
+import Data.List (List(..), singleton, manyRec)
+import Data.Maybe (Maybe(..))
 
-import Control.Alt ((<|>))
-
-import Text.Parsing.StringParser (Parser(..), fail, unParser)
+import Text.Parsing.StringParser (Parser(..), fail)
 
 -- | Read ahead without consuming input.
 lookAhead :: forall a. Parser a -> Parser a
@@ -22,25 +47,18 @@ lookAhead (Parser p) = Parser \s ->
 
 -- | Match zero or more times.
 many :: forall a. Parser a -> Parser (List a)
-many p = many1 p <|> pure Nil
+many = manyRec
 
 -- | Match one or more times.
 many1 :: forall a. Parser a -> Parser (List a)
-many1 p = do
-  a <- p
-  as <- many p
-  pure (Cons a as)
+many1 p = Cons <$> p <*> many p
 
 -- | Provide an error message in case of failure.
 withError :: forall a. Parser a -> String -> Parser a
 withError p msg = p <|> fail msg
 
 infixl 3 withError as <?>
 
--- | Take the fixed point of a parser function. This function is sometimes useful when building recursive parsers.
-fix :: forall a. (Parser a -> Parser a) -> Parser a
-fix f = Parser \s -> unParser (f (fix f)) s
-
 -- | Parse a string between opening and closing markers.
 between :: forall a open close. Parser open -> Parser close -> Parser a -> Parser a
 between open close p = do

test/Main.purs

@@ -1,15 +1,21 @@
 module Test.Main where
 
 import Prelude hiding (between)
+
 import Control.Alt ((<|>))
 import Control.Monad.Eff (Eff)
-import Control.Monad.Eff.Console (CONSOLE, logShow)
-import Data.Either (Either(..))
-import Data.String (singleton)
-import Text.Parsing.StringParser (Parser, ParseError(..), try, runParser)
+import Control.Monad.Eff.Console (CONSOLE)
+
+import Data.Either (isLeft, isRight, Either(..))
+import Data.List (List(Nil), (:))
+import Data.String (joinWith, singleton)
+import Data.Unfoldable (replicate)
+
+import Test.Assert (assert', ASSERT, assert)
+import Text.Parsing.StringParser (Parser, runParser, try)
 import Text.Parsing.StringParser.Combinators (many1, endBy1, sepBy1, optionMaybe, many, chainl, fix, between)
 import Text.Parsing.StringParser.Expr (Assoc(..), Operator(..), buildExprParser)
-import Text.Parsing.StringParser.String (anyDigit, eof, string, anyChar, anyLetter, alphaNum)
+import Text.Parsing.StringParser.String (anyDigit, eof, string, anyChar)
 
 parens :: forall a. Parser a -> Parser a
 parens = between (string "(") (string ")")
@@ -19,12 +25,6 @@ nested = fix $ \p -> (do
   string "a"
   pure 0) <|> ((+) 1) <$> parens p
 
-parseTest :: forall a eff. Show a => Parser a -> String -> Eff (console :: CONSOLE | eff) Unit
-parseTest p input =
-  case runParser p input of
-    Left (ParseError err) -> logShow err
-    Right result -> logShow result
-
 opTest :: Parser String
 opTest = chainl (singleton <$> anyChar) (string "+" $> append) ""
 
@@ -51,22 +51,36 @@ tryTest :: Parser String
 tryTest = try ((<>) <$> string "aa" <*> string "bb") <|>
           (<>) <$> string "aa" <*> string "cc"
 
-main :: forall e. Eff (console :: CONSOLE | e) Unit
+canParse :: forall a. Parser a -> String -> Boolean
+canParse p input = isRight $ runParser p input
+
+parseFail :: forall a. Parser a -> String -> Boolean
+parseFail p input = isLeft $ runParser p input
+
+expectResult :: forall a. (Eq a) => a -> Parser a -> String -> Boolean
+expectResult res p input = runParser p input == Right res
+
+main :: forall e. Eff (console :: CONSOLE, assert :: ASSERT | e) Unit
 main = do
-  parseTest nested "(((a)))"
-  parseTest (many (string "a")) "aaa"
-  parseTest (parens (do
+  assert' "many should not blow the stack" $ canParse (many (string "a")) (joinWith "" $ replicate 100000 "a")
+  assert' "many failing after" $ parseFail (do
+    as <- many (string "a")
+    eof
+    pure as) (joinWith "" (replicate 100000 "a") <> "b" )
+
+  assert $ expectResult 3 nested "(((a)))"
+  assert $ expectResult ("a":"a":"a":Nil)  (many (string "a")) "aaa"
+  assert $ parseFail (many1 (string "a")) ""
+  assert $ canParse (parens (do
     string "a"
     optionMaybe $ string "b")) "(ab)"
-  parseTest (string "a" `sepBy1` string ",") "a,a,a"
-  parseTest (do
+  assert $ expectResult ("a":"a":"a":Nil) (string "a" `sepBy1` string ",") "a,a,a"
+  assert $ canParse (do
     as <- string "a" `endBy1` string ","
     eof
     pure as) "a,a,a,"
-  parseTest opTest "a+b+c"
-  parseTest exprTest "1*2+3/4-5"
-  parseTest tryTest "aacc"
-  parseTest (many1 anyDigit) "01234/"
-  parseTest (many1 anyDigit) "56789:"
-  parseTest (many anyLetter) "aB"
-  parseTest (many alphaNum) "aB3"
+  assert' "opTest" $ expectResult "abc" opTest "a+b+c"
+  assert' "exprTest" $ expectResult (-3) exprTest "1*2+3/4-5"
+  assert' "tryTest "$ canParse tryTest "aacc"
+  assert $ expectResult ('0':'1':'2':'3':'4':Nil) (many1 anyDigit) "01234/"
+  assert $ expectResult ('5':'6':'7':'8':'9':Nil) (many1 anyDigit) "56789:"