summaryrefslogtreecommitdiff
path: root/src/Parser/Statement.hs
diff options
context:
space:
mode:
authorRoman Smrž <roman.smrz@seznam.cz>2024-08-05 20:28:06 +0200
committerRoman Smrž <roman.smrz@seznam.cz>2024-08-07 21:51:10 +0200
commit18ced99f826746a19aa6c0b351673d132f86421a (patch)
treec85d07779ac4ee8d9578528c5cf4e555bd520119 /src/Parser/Statement.hs
parent7f35daac6a9b0c4e286f5b4bfc7010f074b52b57 (diff)
Parser: report multiple errors in some cases
Changelog: Report multiple parsing errors in single pass
Diffstat (limited to 'src/Parser/Statement.hs')
-rw-r--r--src/Parser/Statement.hs10
1 files changed, 8 insertions, 2 deletions
diff --git a/src/Parser/Statement.hs b/src/Parser/Statement.hs
index eef0848..8906cec 100644
--- a/src/Parser/Statement.hs
+++ b/src/Parser/Statement.hs
@@ -116,7 +116,13 @@ instance ParamType a => ParamType (Maybe a) where
instance (ParamType a, ParamType b) => ParamType (Either a b) where
type ParamRep (Either a b) = Either (ParamRep a) (ParamRep b)
- parseParam _ = try (Left <$> parseParam @a Proxy) <|> (Right <$> parseParam @b Proxy)
+ parseParam _ = try' (Left <$> parseParam @a Proxy) <|> (Right <$> parseParam @b Proxy)
+ where
+ try' act = try $ do
+ x <- act
+ (stateParseErrors <$> getParserState) >>= \case
+ [] -> return x
+ (_ : _) -> fail ""
showParamType _ = showParamType @a Proxy ++ " or " ++ showParamType @b Proxy
paramFromSomeExpr _ se = (Left <$> paramFromSomeExpr @a Proxy se) <|> (Right <$> paramFromSomeExpr @b Proxy se)
@@ -255,7 +261,7 @@ testWith = do
notAllowed <- flip allM expected $ \case
SomeExprType (Proxy :: Proxy a) | Just (Refl :: ctxe :~: a) <- eqT -> return False
_ -> return True
- when notAllowed $ parseError $ FancyError off $ S.singleton $ ErrorFail $ T.unpack $
+ when notAllowed $ registerParseError $ FancyError off $ S.singleton $ ErrorFail $ T.unpack $
"expected " <> T.intercalate ", " (map (("'"<>) . (<>"'") . textSomeExprType) expected) <> ", expression has type '" <> textExprType @ctxe Proxy <> "'"
symbol ":"