From a9d6eacb3aaa0e7acc5abc931061e07549f1c20e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Roman=20Smr=C5=BE?= Date: Wed, 26 Aug 2026 20:56:55 +0200 Subject: Parse type annotations in expressions --- src/Parser/Expr.hs | 35 ++++++++++++++++++++++++++++++++++- test/asset/parser/type-annotation.et | 6 ++++++ test/script/parser.et | 1 + 3 files changed, 41 insertions(+), 1 deletion(-) create mode 100644 test/asset/parser/type-annotation.et diff --git a/src/Parser/Expr.hs b/src/Parser/Expr.hs index a0ae70d..6b458c4 100644 --- a/src/Parser/Expr.hs +++ b/src/Parser/Expr.hs @@ -18,6 +18,8 @@ module Parser.Expr ( functionArguments, applyFunctionArguments, + + typeExpr, ) where import Control.Applicative (liftA2) @@ -265,7 +267,7 @@ someExpr complexity = label "expression" $ do SimpleTerm -> join termSimple FunctionTerm -> join inner where - inner = makeExprParser termFunction table + inner = typeAnnotated $ makeExprParser termFunction table parens = between (symbol "(") (symbol ")") @@ -409,6 +411,24 @@ someExpr complexity = label "expression" $ do region (const err) $ foldl1 (<|>) $ map (\(SomeBinOp op) -> tryop op (proxyOf e) (proxyOf f)) ops + typeAnnotated :: TestParser (TestParser SomeExpr) -> TestParser (TestParser SomeExpr) + typeAnnotated p = do + off <- stateOffset <$> getParserState + p' <- p + choice + [ do + -- colon starts a type annotation, except when at the end of line + void $ try $ (string ":" <* notFollowedBy operatorChar <* sc <* notFollowedBy eol) + stype <- typeExpr + return $ do + se <- p' + unifySomeExpr off stype se + + , do + return p' + ] + + typedExpr :: forall a. ExprType a => TermComplexity -> TestParser (Expr a) typedExpr complexity = do off <- stateOffset <$> getParserState @@ -535,3 +555,16 @@ applyFunctionArguments args sexpr@(SomeExpr (expr :: Expr a)) case kw of Just (ArgumentKeyword tkw) -> "unexpected parameter with keyword ‘" <> tkw <> "’" Nothing -> "unexpected parameter" + + +typeExpr :: TestParser SomeExprType +typeExpr = do + off <- stateOffset <$> getParserState + name <- constrName "type constructor name" + + case textVarName name of + "String" -> return $ ExprTypePrim @Text Proxy + _ -> do + registerParseError $ FancyError off $ S.singleton $ ErrorFail $ T.unpack $ + "type constructor not in scope: ‘" <> textVarName name <> "’" + ExprTypeVar <$> newTypeVar diff --git a/test/asset/parser/type-annotation.et b/test/asset/parser/type-annotation.et new file mode 100644 index 0000000..5fbf323 --- /dev/null +++ b/test/asset/parser/type-annotation.et @@ -0,0 +1,6 @@ +def fun (a) and b: + let c = [ a : String, "x" ] + let d = [ b : String, "y" : String ] + +test Test: + let x = "" : String diff --git a/test/script/parser.et b/test/script/parser.et index a4e4e2f..d387877 100644 --- a/test/script/parser.et +++ b/test/script/parser.et @@ -23,3 +23,4 @@ test Parser: expect_load_success using p of "function" expect_load_failure using p of "function-fail" giving "parse-error" expect_load_success using p of "tags" + expect_load_success using p of "type-annotation" -- cgit v1.2.3