Fix choice error behavior (#168)

Author: natefaubion

src/Text/Parsing/Parser/Combinators.purs

@@ -105,7 +105,7 @@ import Data.Function.Uncurried (mkFn2, mkFn5, runFn2, runFn5)
 import Data.List (List(..), many, manyRec, reverse, (:))
 import Data.List.NonEmpty (NonEmptyList, cons')
 import Data.List.NonEmpty as NEL
-import Data.Maybe (Maybe(..))
+import Data.Maybe (Maybe(..), fromMaybe)
 import Data.Tuple (Tuple(..))
 import Data.Tuple.Nested (type (/\), (/\))
 import Data.Unfoldable (replicateA)
@@ -442,7 +442,11 @@ chainr1Rec p f = do
 
 -- | Parse one of a set of alternatives.
 choice :: forall f m s a. Foldable f => f (ParserT s m a) -> ParserT s m a
-choice = foldr (<|>) empty
+choice = fromMaybe empty <<< foldr go Nothing
+  where
+  go p1 = case _ of
+    Nothing -> Just p1
+    Just p2 -> Just (p1 <|> p2)
 
 -- | Skip many instances of a phrase.
 skipMany :: forall s a m. ParserT s m a -> ParserT s m Unit

test/Main.purs

@@ -22,7 +22,7 @@ import Effect.Console (logShow)
 import Partial.Unsafe (unsafePartial)
 import Test.Assert (assert')
 import Text.Parsing.Parser (ParseError(..), Parser, ParserT, fail, parseErrorMessage, parseErrorPosition, position, region, runParser)
-import Text.Parsing.Parser.Combinators (between, chainl, chainl1Rec, chainlRec, chainr1Rec, chainrRec, endBy1, endBy1Rec, endByRec, many1Rec, many1TillRec, many1TillRec_, many1Till_, manyTillRec, manyTillRec_, manyTill_, notFollowedBy, optionMaybe, sepBy1, sepBy1Rec, sepByRec, sepEndBy1Rec, sepEndByRec, skipMany1Rec, skipManyRec, try, (<?>), (<~?>), (<??>))
+import Text.Parsing.Parser.Combinators (between, chainl, chainl1Rec, chainlRec, chainr1Rec, chainrRec, choice, endBy1, endBy1Rec, endByRec, many1Rec, many1TillRec, many1TillRec_, many1Till_, manyTillRec, manyTillRec_, manyTill_, notFollowedBy, optionMaybe, sepBy1, sepBy1Rec, sepByRec, sepEndBy1Rec, sepEndByRec, skipMany1Rec, skipManyRec, try, (<?>), (<??>), (<~?>))
 import Text.Parsing.Parser.Expr (Assoc(..), Operator(..), buildExprParser)
 import Text.Parsing.Parser.Language (haskellDef, haskellStyle, javaStyle)
 import Text.Parsing.Parser.Pos (Position(..), initialPos)
@@ -727,6 +727,16 @@ main = do
     "no"
     "No alternative"
 
+  -- Choice shouldn't always yield "No alternative", that's what `oneOf` is for.
+  parseErrorTestMessage
+    ( choice
+        [ string "a"
+        , string "b"
+        ]
+    )
+    "c"
+    "Expected \"b\""
+
   -- we can't test "NaN" with `parseTest` because nan doesn't compare equal
   case runParser "NaN" number of
     Right actual -> do