From 18ced99f826746a19aa6c0b351673d132f86421a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Mon, 5 Aug 2024 20:28:06 +0200
Subject: Parser: report multiple errors in some cases

Changelog: Report multiple parsing errors in single pass
---
 src/Parser/Expr.hs | 14 +++++++++-----
 1 file changed, 9 insertions(+), 5 deletions(-)

(limited to 'src/Parser/Expr.hs')

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
-- 
cgit v1.2.3