diff options
| author | Roman Smrž <roman.smrz@seznam.cz> | 2024-08-05 20:28:06 +0200 |
|---|---|---|
| committer | Roman Smrž <roman.smrz@seznam.cz> | 2024-08-07 21:51:10 +0200 |
| commit | 18ced99f826746a19aa6c0b351673d132f86421a (patch) | |
| tree | c85d07779ac4ee8d9578528c5cf4e555bd520119 /src/Parser/Expr.hs | |
| parent | 7f35daac6a9b0c4e286f5b4bfc7010f074b52b57 (diff) | |
Parser: report multiple errors in some cases
Changelog: Report multiple parsing errors in single pass
Diffstat (limited to 'src/Parser/Expr.hs')
| -rw-r--r-- | src/Parser/Expr.hs | 14 |
1 files changed, 9 insertions, 5 deletions
diff --git a/src/Parser/Expr.hs b/src/Parser/Expr.hs index fee5c25..6659895 100644 --- a/src/Parser/Expr.hs +++ b/src/Parser/Expr.hs @@ -48,7 +48,7 @@ newVarName = do addVarName :: forall a. ExprType a => Int -> TypedVarName a -> TestParser () addVarName off (TypedVarName name) = do gets (lookup name . testVars) >>= \case - Just _ -> parseError $ FancyError off $ S.singleton $ ErrorFail $ T.unpack $ + Just _ -> registerParseError $ FancyError off $ S.singleton $ ErrorFail $ T.unpack $ T.pack "variable '" <> textVarName name <> T.pack "' already exists" Nothing -> return () modify $ \s -> s { testVars = (name, SomeExprType @a Proxy) : testVars s } @@ -67,8 +67,10 @@ stringExpansion :: ExprType a => Text -> (forall b. ExprType b => Expr b -> [May stringExpansion tname conv = do off <- stateOffset <$> getParserState SomeExpr e <- someExpansion - let err = parseError $ FancyError off $ S.singleton $ ErrorFail $ T.unpack $ T.concat - [ tname, T.pack " expansion not defined for '", textExprType e, T.pack "'" ] + let err = do + registerParseError $ FancyError off $ S.singleton $ ErrorFail $ T.unpack $ T.concat + [ tname, T.pack " expansion not defined for '", textExprType e, T.pack "'" ] + return $ Pure emptyVarValue maybe err return $ listToMaybe $ catMaybes $ conv e @@ -312,6 +314,8 @@ typedExpr :: forall a. ExprType a => TestParser (Expr a) typedExpr = do off <- stateOffset <$> getParserState SomeExpr e <- someExpr - let err = parseError $ FancyError off $ S.singleton $ ErrorFail $ T.unpack $ T.concat - [ T.pack "expected '", textExprType @a Proxy, T.pack "', expression has type '", textExprType e, T.pack "'" ] + let err = do + registerParseError $ FancyError off $ S.singleton $ ErrorFail $ T.unpack $ T.concat + [ T.pack "expected '", textExprType @a Proxy, T.pack "', expression has type '", textExprType e, T.pack "'" ] + return $ Pure emptyVarValue maybe err return $ cast e |