From f91ff15b9551cd0d325dbd03f066d48dfd70ed25 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Sat, 28 Sep 2024 11:53:34 +0200
Subject: Implement "send" as a builtin

---
 src/Parser/Statement.hs |  6 ------
 src/Test/Builtins.hs    | 14 +++++++++++++-
 2 files changed, 13 insertions(+), 7 deletions(-)

(limited to 'src')

diff --git a/src/Parser/Statement.hs b/src/Parser/Statement.hs
index 912366b..67ffd76 100644
--- a/src/Parser/Statement.hs
+++ b/src/Parser/Statement.hs
@@ -312,11 +312,6 @@ testSpawn = command "spawn" $ Spawn
     <*> paramOrContext "on"
     <*> innerBlock
 
-testSend :: TestParser [TestStep]
-testSend = command "send" $ Send
-    <$> paramOrContext "to"
-    <*> param ""
-
 testExpect :: TestParser [TestStep]
 testExpect = command "expect" $ Expect
     <$> cmdLine
@@ -376,7 +371,6 @@ testStep = choice
     , testSubnet
     , testNode
     , testSpawn
-    , testSend
     , testExpect
     , testFlush
     , testDisconnectNode
diff --git a/src/Test/Builtins.hs b/src/Test/Builtins.hs
index 3f42335..774ad70 100644
--- a/src/Test/Builtins.hs
+++ b/src/Test/Builtins.hs
@@ -3,13 +3,16 @@ module Test.Builtins (
 ) where
 
 import Data.Map qualified as M
+import Data.Text (Text)
 import Data.Typeable
 
+import Process (Process)
 import Test
 
 builtins :: [ ( VarName, SomeVarValue ) ]
 builtins =
-    [ ( VarName "guard", builtinGuard )
+    [ ( VarName "send", builtinSend )
+    , ( VarName "guard", builtinGuard )
     , ( VarName "wait", builtinWait )
     ]
 
@@ -19,6 +22,15 @@ getArg (FunctionArguments args) kw =
         Just (SomeExpr expr) | Just expr' <- cast expr -> expr'
         _ -> error "parameter mismatch"
 
+builtinSend :: SomeVarValue
+builtinSend = SomeVarValue (FunctionArguments $ M.fromList atypes) $
+    \_ args -> TestBlock [ Send (getArg args (Just "to")) (getArg args Nothing) ]
+  where
+    atypes =
+        [ ( Just "to", SomeArgumentType (ContextDefault @Process) )
+        , ( Nothing, SomeArgumentType (NoDefault @Text) )
+        ]
+
 builtinGuard :: SomeVarValue
 builtinGuard = SomeVarValue (FunctionArguments $ M.singleton Nothing (SomeArgumentType (NoDefault @Bool))) $
     \sline args -> TestBlock [ Guard sline (getArg args Nothing) ]
-- 
cgit v1.2.3