From 18ced99f826746a19aa6c0b351673d132f86421a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Roman=20Smr=C5=BE?= 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/Statement.hs | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) (limited to 'src/Parser/Statement.hs') 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 ":" -- cgit v1.2.3