Fix parsing of variables with keyword prefixes (#1584)

* Fix parsing of variables with keyword prefixes

Fixes #1583

Note that one prefix is not yet supported: `missing`, since fixing that is
not easy for the current parsing implementation (as far as I can tell).

* Add regression test

... as suggested by @sjakobi

I'm not upstreaming this into the standard test suite yet because the
current parser cannot handle `missing`, which would be necessary to
generate the corresponding CBOR

Author: Gabriella439

dhall/src/Dhall/Parser/Expression.hs

@@ -162,24 +162,19 @@ parsers embedded = Parsers {..}
             return (Lam a b c)
 
         alternative1 = do
-            _if
-            nonemptyWhitespace
+            try (_if *> nonemptyWhitespace)
             a <- expression
             whitespace
-            _then
-            nonemptyWhitespace
+            try (_then *> nonemptyWhitespace)
             b <- expression
             whitespace
-            _else
-            nonemptyWhitespace
+            try (_else *> nonemptyWhitespace)
             c <- expression
             return (BoolIf a b c)
 
         alternative2 = do
             let binding = do
-                    _let
-
-                    src0 <- src nonemptyWhitespace
+                    src0 <- try (_let *> src nonemptyWhitespace)
 
                     c <- label
 
@@ -208,9 +203,7 @@ parsers embedded = Parsers {..}
 
             as <- Data.List.NonEmpty.some1 binding
 
-            _in
-
-            nonemptyWhitespace
+            try (_in *> nonemptyWhitespace)
 
             b <- expression
 
@@ -234,9 +227,7 @@ parsers embedded = Parsers {..}
             return (Dhall.Syntax.wrapInLets as b)
 
         alternative3 = do
-            _forall
-            whitespace
-            _openParens
+            try (_forall *> whitespace *> _openParens)
             whitespace
             a <- label
             whitespace
@@ -252,9 +243,7 @@ parsers embedded = Parsers {..}
             return (Pi a b c)
 
         alternative4 = do
-            _assert
-            whitespace
-            _colon
+            try (_assert *> whitespace *> _colon)
             nonemptyWhitespace
             a <- expression
             return (Assert a)
@@ -321,7 +310,7 @@ parsers embedded = Parsers {..}
         ]
 
     applicationExpression = do
-            f <-    (Some <$ _Some <* nonemptyWhitespace)
+            f <-    (Some <$ try (_Some <* nonemptyWhitespace))
                 <|> return id
             a <- noted importExpression_
             bs <- Text.Megaparsec.many . try $ do
@@ -433,16 +422,14 @@ parsers embedded = Parsers {..}
             alternative06 = listLiteral
 
             alternative07 = do
-                _merge
-                nonemptyWhitespace
+                try (_merge *> nonemptyWhitespace)
                 a <- importExpression_
                 nonemptyWhitespace
                 b <- importExpression_ <?> "second argument to ❰merge❱"
                 return (Merge a b Nothing)
 
             alternative08 = do
-                _toMap
-                nonemptyWhitespace
+                try (_toMap *> nonemptyWhitespace)
                 a <- importExpression_
                 return (ToMap a Nothing)
 

dhall/tests/Dhall/Test/Regression.hs

@@ -42,6 +42,7 @@ tests =
         , issue1131a
         , issue1131b
         , issue1341
+        , issue1584
         , parsing0
         , typeChecking0
         , typeChecking1
@@ -180,6 +181,13 @@ issue1341 = Test.Tasty.HUnit.testCase "Issue #1341" (do
     let msg    = "NaN shouldn't contain any free variables"
     Test.Tasty.HUnit.assertEqual msg False actual)
 
+issue1584 :: TestTree
+issue1584 = Test.Tasty.HUnit.testCase "Issue #1584" (do
+    -- This test ensures that we can parse variables with keyword prefixes
+    -- (e.g. `ifX`)
+    _ <- Util.code "./tests/regression/issue1584.dhall"
+    return () )
+
 parsing0 :: TestTree
 parsing0 = Test.Tasty.HUnit.testCase "Parsing regression #0" (do
     -- Verify that parsing should not fail

dhall/tests/regression/issue1584.dhall

@@ -0,0 +1,19 @@
+[ let ifX = 1 in ifX
+, let thenX = 1 in thenX
+, let elseX = 1 in elseX
+, let letX = 1 in letX
+, let inX = 1 in inX
+, let usingX = 1 in usingX
+{- Fixing this case appears to be difficult for the current parser
+   implementation
+-}
+-- , let missingX = 1 in missingX
+, let asX = 1 in asX
+, let InfinityX = 1 in InfinityX
+, let NaNX = 1 in NaNX
+, let mergeX = 1 in mergeX
+, let SomeX = 1 in SomeX
+, let toMapX = 1 in toMapX
+, let assertX = 1 in assertX
+, let forallX = 1 in forallX
+]