From a699c3ddd443a2d6113fe3b08f7ae81c510239e6 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Fri, 9 Jan 2026 21:35:28 +0100
Subject: Improve displayed values for process, network and node types

---
 src/GDB.hs          |  3 ++-
 src/Network.hs      |  4 ++--
 src/Process.hs      | 20 ++++++++++++++++----
 src/Run.hs          |  2 ++
 src/Run/Monad.hs    |  1 +
 src/Script/Shell.hs |  3 +++
 6 files changed, 26 insertions(+), 7 deletions(-)

(limited to 'src')

diff --git a/src/GDB.hs b/src/GDB.hs
index 8d50d7f..ccb9dc3 100644
--- a/src/GDB.hs
+++ b/src/GDB.hs
@@ -75,7 +75,8 @@ gdbStart onCrash = do
     ignore <- liftIO $ newTVarIO ( 0, [] )
 
     let process = Process
-            { procName = ProcNameGDB
+            { procId = ProcessId (-2)
+            , procName = ProcNameGDB
             , procHandle = Left handle
             , procStdin = hin
             , procOutput = pout
diff --git a/src/Network.hs b/src/Network.hs
index e12231d..fdc83c6 100644
--- a/src/Network.hs
+++ b/src/Network.hs
@@ -102,11 +102,11 @@ instance HasNetns Node where getNetns = nodeNetns
 
 instance ExprType Network where
     textExprType _ = T.pack "network"
-    textExprValue n = "s:" <> textNetworkName (netPrefix n)
+    textExprValue n = "<network:" <> textNetworkName (netPrefix n) <> ">"
 
 instance ExprType Node where
     textExprType _ = T.pack "node"
-    textExprValue n = T.pack "n:" <> textNodeName (nodeName n)
+    textExprValue n = T.pack "<node:" <> textNodeName (nodeName n) <> ">"
 
     recordMembers = map (first T.pack)
         [ ( "ifname", RecordSelector $ const ("veth0" :: Text) )
diff --git a/src/Process.hs b/src/Process.hs
index a575e76..7d09b61 100644
--- a/src/Process.hs
+++ b/src/Process.hs
@@ -1,7 +1,7 @@
 module Process (
     Process(..),
-    ProcName(..),
-    textProcName, unpackProcName,
+    ProcessId(..), textProcId,
+    ProcName(..), textProcName, unpackProcName,
     send,
     outProc, outProcName,
     lineReadingLoop,
@@ -48,7 +48,8 @@ import Script.Expr.Class
 import Script.Object
 
 data Process = Process
-    { procName :: ProcName
+    { procId :: ProcessId
+    , procName :: ProcName
     , procHandle :: Either ProcessHandle ( ThreadId, MVar ExitCode )
     , procStdin :: Handle
     , procOutput :: TVar [ Text ]
@@ -62,18 +63,23 @@ instance Eq Process where
 
 instance ExprType Process where
     textExprType _ = T.pack "proc"
-    textExprValue n = T.pack "p:" <> textProcName (procName n)
+    textExprValue p = "<process:" <> textProcName (procName p) <> "#" <> textProcId (procId p) <> ">"
 
     recordMembers = map (first T.pack)
         [ ("node", RecordSelector $ procNode)
         ]
 
 
+newtype ProcessId = ProcessId Int
+
 data ProcName = ProcName Text
               | ProcNameTcpdump
               | ProcNameGDB
     deriving (Eq, Ord)
 
+textProcId :: ProcessId -> Text
+textProcId (ProcessId pid) = T.pack (show pid)
+
 textProcName :: ProcName -> Text
 textProcName (ProcName name) = name
 textProcName ProcNameTcpdump = T.pack "tcpdump"
@@ -139,6 +145,12 @@ spawnOn target procName procKillWith cmd = do
                     return (path' ++ rest)
             _ -> return cmd
 
+    procId <- case procName of
+        ProcNameTcpdump -> return $ ProcessId (-1)
+        _ -> do
+            idVar <- asks $ teNextProcId . fst
+            liftIO $ modifyMVar idVar (\x -> return ( x + 1, ProcessId x ))
+
     let netns = either getNetns getNetns target
     currentEnv <- liftIO $ getEnvironment
     (Just procStdin, Just hout, Just herr, handle) <- liftIO $ do
diff --git a/src/Run.hs b/src/Run.hs
index 45eec46..54df37b 100644
--- a/src/Run.hs
+++ b/src/Run.hs
@@ -59,6 +59,7 @@ runTest out opts gdefs test = do
 
     failedVar <- newTVarIO Nothing
     objIdVar <- newMVar 1
+    procIdVar <- newMVar 1
     procVar <- newMVar []
     timeoutVar <- newMVar ( optTimeout opts, 0 )
 
@@ -73,6 +74,7 @@ runTest out opts gdefs test = do
             , teFailed = failedVar
             , teOptions = opts
             , teNextObjId = objIdVar
+            , teNextProcId = procIdVar
             , teProcesses = procVar
             , teTimeout = timeoutVar
             , teGDB = fst <$> mgdb
diff --git a/src/Run/Monad.hs b/src/Run/Monad.hs
index c742987..f506b62 100644
--- a/src/Run/Monad.hs
+++ b/src/Run/Monad.hs
@@ -44,6 +44,7 @@ data TestEnv = TestEnv
     , teFailed :: TVar (Maybe Failed)
     , teOptions :: TestOptions
     , teNextObjId :: MVar Int
+    , teNextProcId :: MVar Int
     , teProcesses :: MVar [ Process ]
     , teTimeout :: MVar ( Scientific, Integer ) -- ( positive timeout, number of zero multiplications )
     , teGDB :: Maybe (MVar GDB)
diff --git a/src/Script/Shell.hs b/src/Script/Shell.hs
index 15c0c2c..dea3fe9 100644
--- a/src/Script/Shell.hs
+++ b/src/Script/Shell.hs
@@ -183,6 +183,9 @@ executeScript sei@ShellExecInfo {..} pstdin pstdout pstderr (ShellScript stateme
 
 spawnShell :: Node -> ProcName -> ShellScript -> TestRun Process
 spawnShell procNode procName script = do
+    idVar <- asks $ teNextProcId . fst
+    procId <- liftIO $ modifyMVar idVar (\x -> return ( x + 1, ProcessId x ))
+
     procOutput <- liftIO $ newTVarIO []
     procIgnore <- liftIO $ newTVarIO ( 0, [] )
     seiStatusVar <- liftIO $ newEmptyMVar
-- 
cgit v1.2.3