Fix other <|> breakage

.github/workflows/ci.yml

@@ -22,7 +22,7 @@ jobs:
       - name: Cache PureScript dependencies
         uses: actions/cache@v2
         with:
-          key: ${{ runner.os }}-spago-${{ hashFiles('**/*.dhall') }}
+          key: ${{ runner.os }}-spago-${{ hashFiles('**/*.dhall') }}-2
           path: |
             .spago
             output

CHANGELOG.md

@@ -7,11 +7,12 @@ Notable changes to this project are documented in this file. The format is based
 Breaking changes:
 - Update project and deps to PureScript v0.15.0 (#160 by @JordanMartinez)
 - Drop deprecated `MonadZero` instance (#160 by @JordanMartinez)
-- Make `<?>` right-associative and increase prec from 3 to 2 (#163 by @JordanMartinez)
+- Make `<??>` right-associative (#164 by @JordanMartinez)
+- Drop `<?>` and `<~?>` prec from 3 to 4 (#163, #164 by @JordanMartinez)
 
-  `<|>` was made right associative. `<?>` was likewise changed to prevent a 
-  possible error and its precedence was increased so that `foo <|> bar <?> "err msg"`
-  works without parenthesis around `"err msg"` part.
+  `<|>` was made right associative. Decreasing these two operators
+  prevents a compiler error (i.e. `MixedAssociativityError`)
+  without causing issues with `<$>`.
 
 New features:
 

src/Text/Parsing/Parser/Combinators.purs

@@ -119,7 +119,7 @@ import Text.Parsing.Parser (ParseError(..), ParseState(..), ParserT(..), fail)
 withErrorMessage :: forall m s a. Monad m => ParserT s m a -> String -> ParserT s m a
 withErrorMessage p msg = p <|> fail ("Expected " <> msg)
 
-infixr 2 withErrorMessage as <?>
+infixl 4 withErrorMessage as <?>
 
 -- | Provide an error message in the case of failure, but lazily. This is handy
 -- | in cases where constructing the error message is expensive, so it's
@@ -132,13 +132,13 @@ infixr 2 withErrorMessage as <?>
 withLazyErrorMessage :: forall m s a. Monad m => ParserT s m a -> (Unit -> String) -> ParserT s m a
 withLazyErrorMessage p msg = p <|> defer \_ -> fail ("Expected " <> msg unit)
 
-infixl 3 withLazyErrorMessage as <~?>
+infixl 4 withLazyErrorMessage as <~?>
 
 -- | Flipped `(<?>)`.
 asErrorMessage :: forall m s a. Monad m => String -> ParserT s m a -> ParserT s m a
 asErrorMessage = flip (<?>)
 
-infixl 3 asErrorMessage as <??>
+infixr 3 asErrorMessage as <??>
 
 -- | Wrap a parser with opening and closing markers.
 -- |

test/Main.purs

@@ -21,7 +21,7 @@ import Effect.Console (logShow)
 import Partial.Unsafe (unsafePartial)
 import Test.Assert (assert')
 import Text.Parsing.Parser (ParseError(..), Parser, ParserT, 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, 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)
@@ -671,6 +671,44 @@ main = do
   parseTest "-6.0" (-6.0) number
   parseTest "+6.0" (6.0) number
 
+  -- test from issue #161
+  parseErrorTestMessage
+    (string " " <?> "failure")
+    "no"
+    "Expected failure"
+  parseErrorTestMessage
+    (string " " <|> string "-" <?> "failure")
+    "no"
+    "Expected failure"
+  parseErrorTestMessage
+    (string " " <?> "bad" <|> string "-" <?> "failure")
+    "no"
+    "Expected failure"
+  parseErrorTestMessage
+    (string " " <~?> \_ -> "failure")
+    "no"
+    "Expected failure"
+  parseErrorTestMessage
+    (string " " <|> string "-" <~?> \_ -> "failure")
+    "no"
+    "Expected failure"
+  parseErrorTestMessage
+    (string " " <~?> (\_ -> "bad") <|> string "-" <~?> \_ -> "failure")
+    "no"
+    "Expected failure"
+  parseErrorTestMessage
+    ("failure" <??> string " ")
+    "no"
+    "Expected failure"
+  parseErrorTestMessage
+    ("failure" <??> string " " <|> string "-")
+    "no"
+    "Expected failure"
+  parseErrorTestMessage
+    (string "x" <|> "failure" <??> string " " <|> "bad" <??> string "-")
+    "no"
+    "Expected failure"
+
   -- we can't test "NaN" with `parseTest` because nan doesn't compare equal
   case runParser "NaN" number of
     Right actual -> do