From dc2202f36f8ee220293cc6f230be604a19be8cbb Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Wed, 7 Aug 2024 20:59:18 +0200
Subject: Replace first command (wait) with a builtin

---
 src/Parser.hs           |  3 ++-
 src/Parser/Core.hs      |  3 ---
 src/Parser/Statement.hs | 12 ++++++------
 src/Run.hs              |  3 ++-
 src/Test.hs             | 21 +++++++++++++++++----
 src/Test/Builtins.hs    | 13 +++++++++++++
 6 files changed, 40 insertions(+), 15 deletions(-)
 create mode 100644 src/Test/Builtins.hs

(limited to 'src')

diff --git a/src/Parser.hs b/src/Parser.hs
index 4fd60b5..405622e 100644
--- a/src/Parser.hs
+++ b/src/Parser.hs
@@ -22,6 +22,7 @@ import Parser.Core
 import Parser.Expr
 import Parser.Statement
 import Test
+import Test.Builtins
 
 parseTestDefinition :: TestParser Test
 parseTestDefinition = label "test definition" $ toplevel $ do
@@ -55,7 +56,7 @@ parseTestFile path = do
     content <- TL.readFile path
     absPath <- makeAbsolute path
     let initState = TestParserState
-            { testVars = []
+            { testVars = map (fmap someVarValueType) builtins
             , testContext = SomeExpr RootNetwork
             }
     case evalState (runParserT (parseTestModule absPath) path content) initState of
diff --git a/src/Parser/Core.hs b/src/Parser/Core.hs
index da93905..b932523 100644
--- a/src/Parser/Core.hs
+++ b/src/Parser/Core.hs
@@ -24,9 +24,6 @@ data TestParserState = TestParserState
     , testContext :: SomeExpr
     }
 
-data SomeExpr = forall a. ExprType a => SomeExpr (Expr a)
-data SomeExprType = forall a. ExprType a => SomeExprType (Proxy a)
-
 someEmptyVar :: SomeExprType -> SomeVarValue
 someEmptyVar (SomeExprType (Proxy :: Proxy a)) = SomeVarValue $ emptyVarValue @a
 
diff --git a/src/Parser/Statement.hs b/src/Parser/Statement.hs
index 8906cec..8dd285a 100644
--- a/src/Parser/Statement.hs
+++ b/src/Parser/Statement.hs
@@ -75,6 +75,11 @@ forStatement = do
         body <- testBlock indent
         return [For line tname (unpack <$> e) body]
 
+exprStatement :: TestParser [ TestStep ]
+exprStatement  = do
+    expr <- typedExpr
+    return [ ExprStatement expr ]
+
 class (Typeable a, Typeable (ParamRep a)) => ParamType a where
     type ParamRep a :: Type
     type ParamRep a = a
@@ -335,11 +340,6 @@ testPacketLoss = command "packet_loss" $ PacketLoss
     <*> innerBlock
 
 
-testWait :: TestParser [TestStep]
-testWait = do
-    wsymbol "wait"
-    return [Wait]
-
 testBlock :: Pos -> TestParser [TestStep]
 testBlock indent = concat <$> go
   where
@@ -369,5 +369,5 @@ testStep = choice
     , testDisconnectNodes
     , testDisconnectUpstream
     , testPacketLoss
-    , testWait
+    , exprStatement
     ]
diff --git a/src/Run.hs b/src/Run.hs
index a69ba75..2bee6ec 100644
--- a/src/Run.hs
+++ b/src/Run.hs
@@ -32,6 +32,7 @@ import Output
 import Process
 import Run.Monad
 import Test
+import Test.Builtins
 
 runTest :: Output -> TestOptions -> Test -> IO Bool
 runTest out opts test = do
@@ -60,7 +61,7 @@ runTest out opts test = do
             }
         tstate = TestState
             { tsNetwork = error "network not initialized"
-            , tsVars = []
+            , tsVars = builtins
             , tsNodePacketLoss = M.empty
             , tsDisconnectedUp = S.empty
             , tsDisconnectedBridge = S.empty
diff --git a/src/Test.hs b/src/Test.hs
index a54bbbd..e2f829b 100644
--- a/src/Test.hs
+++ b/src/Test.hs
@@ -7,8 +7,8 @@ module Test (
 
     MonadEval(..),
     VarName(..), TypedVarName(..), textVarName, unpackVarName,
-    ExprType(..),
-    SomeVarValue(..), fromSomeVarValue, textSomeVarValue,
+    ExprType(..), SomeExpr(..), SomeExprType(..), someExprType,
+    SomeVarValue(..), fromSomeVarValue, textSomeVarValue, someVarValueType,
     RecordSelector(..),
     ExprListUnpacker(..),
     ExprEnumerator(..),
@@ -135,9 +135,16 @@ instance ExprType TestBlock where
     textExprValue _ = "<test block>"
     emptyVarValue = TestBlock []
 
-data SomeVarValue = forall a. ExprType a => SomeVarValue a
 
-data RecordSelector a = forall b. ExprType b => RecordSelector (a -> b)
+data SomeExpr = forall a. ExprType a => SomeExpr (Expr a)
+
+data SomeExprType = forall a. ExprType a => SomeExprType (Proxy a)
+
+someExprType :: SomeExpr -> SomeExprType
+someExprType (SomeExpr (_ :: Expr a)) = SomeExprType (Proxy @a)
+
+
+data SomeVarValue = forall a. ExprType a => SomeVarValue a
 
 fromSomeVarValue :: forall a m. (ExprType a, MonadFail m) => VarName -> SomeVarValue -> m a
 fromSomeVarValue name (SomeVarValue value) = maybe (fail err) return $ cast value
@@ -146,6 +153,12 @@ fromSomeVarValue name (SomeVarValue value) = maybe (fail err) return $ cast valu
 textSomeVarValue :: SomeVarValue -> Text
 textSomeVarValue (SomeVarValue value) = textExprValue value
 
+someVarValueType :: SomeVarValue -> SomeExprType
+someVarValueType (SomeVarValue (_ :: a)) = SomeExprType (Proxy @a)
+
+
+data RecordSelector a = forall b. ExprType b => RecordSelector (a -> b)
+
 data ExprListUnpacker a = forall e. ExprType e => ExprListUnpacker (a -> [e]) (Proxy a -> Proxy e)
 
 data ExprEnumerator a = ExprEnumerator (a -> a -> [a]) (a -> a -> a -> [a])
diff --git a/src/Test/Builtins.hs b/src/Test/Builtins.hs
new file mode 100644
index 0000000..9deb2df
--- /dev/null
+++ b/src/Test/Builtins.hs
@@ -0,0 +1,13 @@
+module Test.Builtins (
+    builtins,
+) where
+
+import Test
+
+builtins :: [ ( VarName, SomeVarValue ) ]
+builtins =
+    [ ( VarName "wait", SomeVarValue builtinWait )
+    ]
+
+builtinWait :: TestBlock
+builtinWait = TestBlock [ Wait ]
-- 
cgit v1.2.3