summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorRoman Smrž <roman.smrz@seznam.cz>2022-12-09 20:52:01 +0100
committerRoman Smrž <roman.smrz@seznam.cz>2022-12-15 22:18:28 +0100
commit739d8e3f7b2e418a17e13c908aefcbb4c6c150f6 (patch)
treed7d27edbcefaf77816ec26962305155ec70942fb /src
parent66e6f51b732d351577bc04b4d6e21c8c20807840 (diff)
Use process variable name for node created by spawn
Diffstat (limited to 'src')
-rw-r--r--src/Main.hs15
1 files changed, 7 insertions, 8 deletions
diff --git a/src/Main.hs b/src/Main.hs
index 211be8d..8864883 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -158,13 +158,12 @@ withNetwork inner = do
return res
-createNode :: Expr Network -> Maybe (TypedVarName Node) -> (Node -> TestRun a) -> TestRun a
+createNode :: Expr Network -> Either (TypedVarName Node) (TypedVarName Process) -> (Node -> TestRun a) -> TestRun a
createNode netexpr tvname inner = do
- let vname = fromTypedVarName <$> tvname
net <- eval netexpr
node <- liftIO $ do
node <- modifyMVar (netNodes net) $ \nodes -> do
- let nname = nextNodeName (fromMaybe (VarName "node") vname) $ map nodeName nodes
+ let nname = nextNodeName (either fromTypedVarName fromTypedVarName tvname) $ map nodeName nodes
ip = "192.168.0." ++ show (11 + length nodes)
node = Node { nodeName = nname
, nodeIp = T.pack ip
@@ -188,7 +187,7 @@ createNode netexpr tvname inner = do
callOn node $ "ip link set dev lo up"
return node
- maybe id (flip withVar node) vname $ inner node
+ either (flip withVar node . fromTypedVarName) (const id) tvname $ inner node
callOn :: Node -> String -> IO ()
callOn node cmd = callCommand $ "ip netns exec \"" ++ unpackNodeName (nodeName node) ++ "\" " ++ cmd
@@ -298,13 +297,13 @@ evalSteps = mapM_ $ \case
withVar name value $ evalSteps inner
DeclNode name@(TypedVarName vname) net inner -> do
- createNode net (Just name) $ \node -> do
+ createNode net (Left name) $ \node -> do
withVar vname node $ evalSteps inner
- Spawn (TypedVarName vname@(VarName tname)) target inner -> do
+ Spawn tvname@(TypedVarName vname@(VarName tname)) target inner -> do
case target of
- Left nname -> createNode RootNetwork (Just nname) go
- Right (Left net) -> createNode net Nothing go
+ Left nname -> createNode RootNetwork (Left nname) go
+ Right (Left net) -> createNode net (Right tvname) go
Right (Right node) -> go =<< eval node
where
go node = do