Skip to content

Commit 05044ba

Browse files
UnisayUnisay
committed
Improve parser error handling with Megaparsec best practices
Remove redundant try wrappers: - symbol is auto-backtracking since Megaparsec 4.4.0 - Removed 10 redundant try wrappers from keyword and delimiter parsing - Fixed duplicate "constr" entry bug Add strategic labels for better error messages: - Use <?> operator for two-level labeling (delimiters + keywords) - Replace explicit fail with <?> in type parser (more idiomatic) - Labels provide clearer context in parse errors Refactor to use between combinator: - Cleaner, more declarative code structure - Standard Megaparsec pattern for delimited parsing - Eliminates intermediate bindings Expand test coverage: - Add 6 new error message tests covering common error scenarios - Extract testParseError helper to reduce duplication - Organize error tests into dedicated test group - Verify labels appear correctly in error messages All 2,973 tests pass (781 UPLC + 1,864 PLC + 328 PlutusIR)
1 parent 5799445 commit 05044ba

File tree

3 files changed

+139
-80
lines changed
  • plutus-core

3 files changed

+139
-80
lines changed

‎plutus-core/plutus-core/src/PlutusCore/Parser/Type.hs‎

Lines changed: 23 additions & 23 deletions
Original file line numberDiff line numberDiff line change
@@ -135,29 +135,29 @@ i.e. parse into @Tree Text@ and do the kind checking afterwards, but given that
135135
to do the kind checking of builtins regardless (even for UPLC), we don't win much by deferring
136136
doing it. -}
137137
defaultUni :: Parser (SomeTypeIn (Kinded DefaultUni))
138-
defaultUni = do
139-
choice $
140-
map
141-
try
142-
[ trailingWhitespace (inParens defaultUniApplication)
143-
, someType @_ @Integer <$ symbol "integer"
144-
, someType @_ @ByteString <$ symbol "bytestring"
145-
, someType @_ @Text <$ symbol "string"
146-
, someType @_ @() <$ symbol "unit"
147-
, someType @_ @Bool <$ symbol "bool"
148-
, someType @_ @[] <$ symbol "list"
149-
, someType @_ @Strict.Vector <$ symbol "array"
150-
, someType @_ @(,) <$ symbol "pair"
151-
, someType @_ @Data <$ symbol "data"
152-
, someType @_ @BLS12_381.G1.Element <$ symbol "bls12_381_G1_element"
153-
, someType @_ @BLS12_381.G2.Element <$ symbol "bls12_381_G2_element"
154-
, someType @_ @BLS12_381.Pairing.MlResult <$ symbol "bls12_381_mlresult"
155-
, someType @_ @Value <$ symbol "value"
156-
, -- We include an explicit failure case here to produce clearer error messages.
157-
-- Without this, using `choice` with `symbol` results in error messages that cover the longest possible SrcSpan,
158-
-- which in this context would be 20 characters spanning the entire "bls12_381_G2_element" token.
159-
fail "Unknown type, expected one of: bool, integer, bytestring, string, unit, list, array, pair, data, value, bls12_381_G1_element, bls12_381_G2_element, bls12_381_mlresult, or a type application in parens"
160-
]
138+
defaultUni =
139+
( choice $
140+
map
141+
try
142+
[ trailingWhitespace (inParens defaultUniApplication)
143+
, someType @_ @Integer <$ symbol "integer"
144+
, someType @_ @ByteString <$ symbol "bytestring"
145+
, someType @_ @Text <$ symbol "string"
146+
, someType @_ @() <$ symbol "unit"
147+
, someType @_ @Bool <$ symbol "bool"
148+
, someType @_ @[] <$ symbol "list"
149+
, someType @_ @Strict.Vector <$ symbol "array"
150+
, someType @_ @(,) <$ symbol "pair"
151+
, someType @_ @Data <$ symbol "data"
152+
, someType @_ @BLS12_381.G1.Element <$ symbol "bls12_381_G1_element"
153+
, someType @_ @BLS12_381.G2.Element <$ symbol "bls12_381_G2_element"
154+
, someType @_ @BLS12_381.Pairing.MlResult <$ symbol "bls12_381_mlresult"
155+
, someType @_ @Value <$ symbol "value"
156+
]
157+
)
158+
<?> "type name (integer, bytestring, string, unit, bool, list, array, pair,\
159+
\ data, value, bls12_381_G1_element, bls12_381_G2_element,\
160+
\ bls12_381_mlresult, or type application)"
161161

162162
tyName :: Parser TyName
163163
tyName = TyName <$> name

‎plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Parser.hs‎

Lines changed: 22 additions & 22 deletions
Original file line numberDiff line numberDiff line change
@@ -100,31 +100,31 @@ term =
100100
]
101101
where
102102
tryAppTerm :: Parser PTerm
103-
tryAppTerm = do
104-
withSpan $ \sp -> do
105-
_ <- try (symbol "[")
106-
t <- appTerm sp
107-
_ <- char ']'
108-
return t
103+
tryAppTerm =
104+
withSpan $ \sp ->
105+
between
106+
(symbol "[" <?> "opening bracket '['")
107+
(char ']' <?> "closing bracket ']'")
108+
(appTerm sp)
109109

110110
tryTermInParens :: Parser PTerm
111111
tryTermInParens =
112-
withSpan $ \sp -> do
113-
_ <- try (symbol "(")
114-
t <-
115-
choice
116-
[ try (symbol "builtin") *> builtinTerm sp
117-
, try (symbol "lam") *> lamTerm sp
118-
, try (symbol "constr") *> constrTerm sp -- "constr" must come before "con"
119-
, try (symbol "con") *> conTerm sp
120-
, try (symbol "delay") *> delayTerm sp
121-
, try (symbol "force") *> forceTerm sp
122-
, try (symbol "error") *> errorTerm sp
123-
, try (symbol "constr") *> constrTerm sp
124-
, try (symbol "case") *> caseTerm sp
125-
]
126-
_ <- char ')'
127-
return t
112+
withSpan $ \sp ->
113+
between
114+
(symbol "(" <?> "opening parenthesis '('")
115+
(char ')' <?> "closing parenthesis ')'")
116+
( choice
117+
[ symbol "builtin" *> builtinTerm sp
118+
, symbol "lam" *> lamTerm sp
119+
, symbol "constr" *> constrTerm sp -- "constr" must come before "con"
120+
, symbol "con" *> conTerm sp
121+
, symbol "delay" *> delayTerm sp
122+
, symbol "force" *> forceTerm sp
123+
, symbol "error" *> errorTerm sp
124+
, symbol "case" *> caseTerm sp
125+
]
126+
<?> "term keyword (builtin, lam, constr, con, delay, force, error, case)"
127+
)
128128

129129
-- | Parser for UPLC programs.
130130
program :: Parser (UPLC.Program PLC.Name PLC.DefaultUni PLC.DefaultFun SrcSpan)

‎plutus-core/untyped-plutus-core/testlib/Generators/Spec.hs‎

Lines changed: 94 additions & 35 deletions
Original file line numberDiff line numberDiff line change
@@ -133,19 +133,14 @@ propDefaultUni =
133133
. parseGen defaultUni
134134
. T.pack
135135

136-
{-| Test that parser errors for list element type mismatches point to the correct location.
137-
This uses the exact example from the issue report. -}
138-
propListElementErrorLocation :: TestTree
139-
propListElementErrorLocation =
140-
testCase "List element error location" $ do
141-
let code =
142-
T.unlines
143-
[ "(program 1.1.0 "
144-
, "["
145-
, " (force (builtin mkCons)) (con integer 4) (con (list integer) [true]) ]"
146-
, ")"
147-
]
148-
expectedErrorParts = ["unexpected 't'", "expecting '+', '-', ']', or integer"]
136+
--------------------------------------------------------------------------------
137+
-- Helper Functions ------------------------------------------------------------
138+
139+
{-| Helper function to test parser error messages.
140+
Tests that parsing fails with an error message containing all expected parts. -}
141+
testParseError :: String -> T.Text -> [T.Text] -> TestTree
142+
testParseError testName code expectedErrorParts =
143+
testCase testName $ do
149144
case runQuoteT (parseProgram code) of
150145
Right _ -> error "Expected parse error, but parsing succeeded"
151146
Left (ParseErrorB errBundle) -> do
@@ -159,30 +154,85 @@ propListElementErrorLocation =
159154
<> "\nGot error message:\n"
160155
<> T.unpack errMsg
161156

157+
--------------------------------------------------------------------------------
158+
-- Error Message Tests ---------------------------------------------------------
159+
160+
{-| Test that parser errors for list element type mismatches point to the correct location.
161+
This uses the exact example from the issue report. -}
162+
propListElementErrorLocation :: TestTree
163+
propListElementErrorLocation =
164+
testParseError
165+
"List element error location"
166+
( T.unlines
167+
[ "(program 1.1.0 "
168+
, "["
169+
, " (force (builtin mkCons)) (con integer 4) (con (list integer) [true]) ]"
170+
, ")"
171+
]
172+
)
173+
["unexpected 't'", "expecting '+', '-', ']', or integer"]
174+
162175
{-| Test that parser errors for typos in type names point to the correct location.
163176
This tests the case where "boot" is used instead of "bool". -}
164177
propTypeNameTypoErrorLocation :: TestTree
165178
propTypeNameTypoErrorLocation =
166-
testCase "Type name typo error location" $ do
167-
let code =
168-
T.unlines
169-
[ "(program 1.1.0"
170-
, "[ (builtin integerToByteString) (con boot True) (con integer 0) (con integer 712372356934756347862573452345342345) ]"
171-
, ")"
172-
]
173-
expectedErrorParts = ["Unknown type", "expected", "bool"]
174-
case runQuoteT (parseProgram code) of
175-
Right _ -> error "Expected parse error, but parsing succeeded"
176-
Left (ParseErrorB errBundle) -> do
177-
let errMsg = T.pack $ errorBundlePretty errBundle
178-
let hasAllParts = all (`T.isInfixOf` errMsg) expectedErrorParts
179-
unless hasAllParts $
180-
error $
181-
"Error message does not match expected format.\n"
182-
<> "Expected to contain: "
183-
<> show expectedErrorParts
184-
<> "\nGot error message:\n"
185-
<> T.unpack errMsg
179+
testParseError
180+
"Type name typo error location"
181+
( T.unlines
182+
[ "(program 1.1.0"
183+
, "[ (builtin integerToByteString) (con boot True) (con integer 0) (con integer 712372356934756347862573452345342345) ]"
184+
, ")"
185+
]
186+
)
187+
["type name", "bool"]
188+
189+
-- | Test that parser errors for missing closing parenthesis are clear.
190+
propMissingClosingParen :: TestTree
191+
propMissingClosingParen =
192+
testParseError
193+
"Missing closing parenthesis error"
194+
"(program 1.1.0 (lam x (var x))"
195+
["unexpected", "expecting", "term keyword"]
196+
197+
-- | Test that parser errors for missing closing bracket are clear.
198+
propMissingClosingBracket :: TestTree
199+
propMissingClosingBracket =
200+
testParseError
201+
"Missing closing bracket error"
202+
"(program 1.1.0 [(builtin addInteger) (con integer 1) (con integer 2))"
203+
["expecting", "closing bracket ']'"]
204+
205+
-- | Test that parser errors for missing builtin operand are clear.
206+
propMissingBuiltinOperand :: TestTree
207+
propMissingBuiltinOperand =
208+
testParseError
209+
"Missing builtin function name error"
210+
"(program 1.1.0 (builtin))"
211+
["Unknown built-in function"]
212+
213+
-- | Test that parser errors for missing con operands are clear.
214+
propMissingConOperands :: TestTree
215+
propMissingConOperands =
216+
testParseError
217+
"Missing con operands error"
218+
"(program 1.1.0 (con))"
219+
["unexpected", "expecting"]
220+
221+
-- | Test that parser errors for invalid keywords are clear.
222+
propInvalidKeyword :: TestTree
223+
propInvalidKeyword =
224+
testParseError
225+
"Invalid keyword error"
226+
"(program 1.1.0 (foo x))"
227+
["unexpected", "term keyword"]
228+
229+
-- | Test that parser errors for bracket mismatches are clear.
230+
propBracketMismatch :: TestTree
231+
propBracketMismatch =
232+
testParseError
233+
"Bracket type mismatch error"
234+
"(program 1.1.0 [(var x))"
235+
["unexpected", "expecting", "term keyword"]
186236

187237
test_parsing :: TestTree
188238
test_parsing =
@@ -193,6 +243,15 @@ test_parsing =
193243
, propTermSrcSpan
194244
, propUnit
195245
, propDefaultUni
196-
, propListElementErrorLocation
197-
, propTypeNameTypoErrorLocation
246+
, testGroup
247+
"Error Messages"
248+
[ propListElementErrorLocation
249+
, propTypeNameTypoErrorLocation
250+
, propMissingClosingParen
251+
, propMissingClosingBracket
252+
, propMissingBuiltinOperand
253+
, propMissingConOperands
254+
, propInvalidKeyword
255+
, propBracketMismatch
256+
]
198257
]

0 commit comments

Comments
 (0)