From 2143eb381fc28e2d676a9c9a433426b1b2dbf737 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Fri, 7 Oct 2022 11:09:44 +0200
Subject: Process variables and expression type

---
 src/Main.hs | 25 ++++++++++---------------
 1 file changed, 10 insertions(+), 15 deletions(-)

(limited to 'src/Main.hs')

diff --git a/src/Main.hs b/src/Main.hs
index 221bfb4..46fdaa6 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -7,7 +7,6 @@ import Control.Monad
 import Control.Monad.Except
 import Control.Monad.Reader
 
-import Data.List
 import Data.Maybe
 import Data.Scientific
 import Data.Text (Text)
@@ -90,6 +89,9 @@ instance MonadEval TestRun where
 instance MonadOutput TestRun where
     getOutput = asks $ teOutput . fst
 
+withVar :: ExprType e => VarName -> e -> TestRun a -> TestRun a
+withVar name value = local (fmap $ \s -> s { tsVars = (name, SomeVarValue value) : tsVars s })
+
 forkTest :: TestRun () -> TestRun ()
 forkTest act = do
     tenv <- ask
@@ -181,8 +183,7 @@ createNode (TypedVarName vname) inner = do
         callOn node $ "ip link set dev lo up"
         return node
 
-    local (fmap $ \s -> s { tsVars = (vname, SomeVarValue node) : tsVars s }) $ do
-        inner node
+    withVar vname node $ inner node
 
 callOn :: Node -> String -> IO ()
 callOn node cmd = callCommand $ "ip netns exec \"" ++ unpackNodeName (nodeName node) ++ "\" " ++ cmd
@@ -235,12 +236,6 @@ spawnOn target pname killWith cmd = do
     liftIO $ modifyMVar_ (netProcesses net) $ return . (process:)
     return process
 
-getProcess :: ProcName -> TestRun Process
-getProcess pname = do
-    net <- asks $ tsNetwork . snd
-    Just p <- find ((pname==).procName) <$> liftIO (readMVar (netProcesses net))
-    return p
-
 tryMatch :: Regex -> [Text] -> Maybe ((Text, [Text]), [Text])
 tryMatch re (x:xs) | Right (Just (_, _, _, capture)) <- regexec re x = Just ((x, capture), xs)
                    | otherwise = fmap (x:) <$> tryMatch re xs
@@ -309,27 +304,27 @@ evalSteps = mapM_ $ \case
             outLine OutputError T.empty $ T.pack "variable '" `T.append` textVarName name `T.append` T.pack "' already exists on " `T.append` sline
             throwError ()
         value <- eval expr
-        local (fmap $ \s -> s { tsVars = (name, SomeVarValue value) : tsVars s }) $ do
-            evalSteps inner
+        withVar name value $ evalSteps inner
 
-    Spawn pname nname inner -> do
+    Spawn (TypedVarName vname@(VarName tname)) nname inner -> do
         either createNode ((>>=) . eval) nname $ \node -> do
+            let pname = ProcName tname
             opts <- asks $ teOptions . fst
             p <- spawnOn (Right node) pname Nothing $
                 fromMaybe (optDefaultTool opts) (lookup pname $ optProcTools opts)
-            evalSteps inner `finally` do
+            withVar vname p (evalSteps inner) `finally` do
                 net <- asks $ tsNetwork . snd
                 ps <- liftIO $ takeMVar (netProcesses net)
                 closeProcess p `finally` do
                     liftIO $ putMVar (netProcesses net) $ filter (/=p) ps
 
     Send pname expr -> do
-        p <- getProcess pname
+        p <- eval pname
         line <- eval expr
         send p line
 
     Expect line pname expr captures inner -> do
-        p <- getProcess pname
+        p <- eval pname
         expect line p expr captures $ evalSteps inner
 
     Guard line expr -> do
-- 
cgit v1.2.3