diff options
| author | Roman Smrž <roman.smrz@seznam.cz> | 2022-12-09 20:52:01 +0100 |
|---|---|---|
| committer | Roman Smrž <roman.smrz@seznam.cz> | 2022-12-15 22:18:28 +0100 |
| commit | 739d8e3f7b2e418a17e13c908aefcbb4c6c150f6 (patch) | |
| tree | d7d27edbcefaf77816ec26962305155ec70942fb /src/Main.hs | |
| parent | 66e6f51b732d351577bc04b4d6e21c8c20807840 (diff) | |
Use process variable name for node created by spawn
Diffstat (limited to 'src/Main.hs')
| -rw-r--r-- | src/Main.hs | 15 |
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 |