From afd550dc8245e61ab6b148c72cdf133e6b7836d1 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Fri, 27 Sep 2024 20:30:25 +0200
Subject: Default and context-provided values for function arguments

---
 src/Parser/Core.hs | 18 +++++++++++++-----
 1 file changed, 13 insertions(+), 5 deletions(-)

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

diff --git a/src/Parser/Core.hs b/src/Parser/Core.hs
index ab6079a..f40889a 100644
--- a/src/Parser/Core.hs
+++ b/src/Parser/Core.hs
@@ -134,11 +134,19 @@ unifyExpr off pa expr = if
 
     | Just (Refl :: FunctionType a :~: b) <- eqT
     -> do
-        case exprArgs expr of
-            remaining
-                | anull remaining -> return (FunctionEval expr)
-                | otherwise -> parseError $ FancyError off $ S.singleton $ ErrorFail $ T.unpack $
-                    "missing function arguments"
+        let FunctionArguments remaining = exprArgs expr
+            showType ( Nothing, SomeArgumentType atype ) = "`<" <> textExprType atype <> ">'"
+            showType ( Just (ArgumentKeyword kw), SomeArgumentType atype ) = "`" <> kw <> " <" <> textExprType atype <> ">'"
+            err = parseError . FancyError off . S.singleton . ErrorFail . T.unpack
+
+        defaults <- forM (M.toAscList remaining) $ \case
+            arg@(_, SomeArgumentType NoDefault) -> err $ "missing " <> showType arg <> " argument"
+            (kw, SomeArgumentType (ExprDefault def)) -> return (kw, SomeExpr def)
+            (kw, SomeArgumentType atype@ContextDefault) -> do
+                SomeExpr context <- gets testContext
+                context' <- unifyExpr off atype context
+                return (kw, SomeExpr context')
+        return (FunctionEval $ ArgsApp (FunctionArguments $ M.fromAscList defaults) expr)
 
     | Just (Refl :: DynamicType :~: b) <- eqT
     , Undefined msg <- expr
-- 
cgit v1.2.3