From 5c5eda9e8333bd652d0ea9cdbeb6fc4d5bdfe5b7 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Fri, 26 Nov 2021 22:34:40 +0100
Subject: Separate constructors for internal process names

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

(limited to 'src/Main.hs')

diff --git a/src/Main.hs b/src/Main.hs
index ae4ca4c..c7be179 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -26,6 +26,7 @@ import System.Process
 
 import Output
 import Parser
+import Process
 import Test
 
 data Network = Network
@@ -40,15 +41,6 @@ data Node = Node
     , nodeDir :: FilePath
     }
 
-data Process = Process
-    { procName :: ProcName
-    , procHandle :: ProcessHandle
-    , procNode :: Either Network Node
-    , procStdin :: Handle
-    , procOutput :: TVar [Text]
-    , procKillWith :: Maybe Signal
-    }
-
 data Options = Options
     { optGDB :: Bool
     }
@@ -73,11 +65,11 @@ initNetwork out useGDB = do
     callCommand "ip link set dev lo up"
     net <- Network <$> newMVar [] <*> newMVar [] <*> pure testDir
 
-    void $ spawnOn out (Left net) (ProcName (T.pack "tcpdump")) (Just softwareTermination) $
+    void $ spawnOn out (Left net) (ProcNameTcpdump) (Just softwareTermination) $
         "tcpdump -i br0 -w '" ++ testDir ++ "/br0.pcap' -U -Z root"
 
     when useGDB $ do
-        gdb <- spawnOn out (Left net) (ProcName (T.pack "gdb")) Nothing $
+        gdb <- spawnOn out (Left net) (ProcNameGDB) Nothing $
             "gdb --quiet --interpreter=mi3"
         send gdb $ T.pack "-gdb-set schedule-multiple on"
         send gdb $ T.pack "-gdb-set mi-async on"
@@ -89,7 +81,7 @@ exitNetwork :: Output -> Network -> Bool -> IO ()
 exitNetwork out net okTest = do
     processes <- readMVar (netProcesses net)
     forM_ processes $ \p -> do
-        when (procName p /= ProcName (T.pack "gdb")) $ do
+        when (procName p /= ProcNameGDB) $ do
             hClose (procStdin p)
         case procKillWith p of
              Nothing -> return ()
@@ -98,7 +90,7 @@ exitNetwork out net okTest = do
                 Just pid -> signalProcess sig pid
 
     forM_ processes $ \p -> do
-        when (procName p == ProcName (T.pack "gdb")) $ do
+        when (procName p == ProcNameGDB) $ do
             let gdbSession = do
                     catchIOError (Just <$> T.getLine) (\e -> if isEOFError e then return Nothing else ioError e) >>= \case
                         Just line -> do
@@ -175,25 +167,24 @@ spawnOn out target pname killWith cmd = do
         atomically $ modifyTVar pout (++[line])
     void $ forkIO $ readingLoop herr $ \line -> do
         case pname of
-             ProcName tname | tname == T.pack "tcpdump" -> return ()
+             ProcNameTcpdump -> return ()
              _ -> outLine out OutputChildStderr (Just pname) line
 
     let process = Process
             { procName = pname
             , procHandle = handle
-            , procNode = target
             , procStdin = hin
             , procOutput = pout
             , procKillWith = killWith
             }
 
     let net = either id nodeNetwork target
-    when (pname /= ProcName (T.pack "gdb")) $ do
+    when (pname /= ProcNameGDB) $ do
         getPid handle >>= \case
             Just pid -> void $ do
                 ps <- readMVar (netProcesses net)
                 forM_ ps $ \gdb -> do
-                    when (procName gdb == ProcName (T.pack "gdb")) $ do
+                    when (procName gdb == ProcNameGDB) $ do
                         send gdb $ T.pack $ "-add-inferior"
                         send gdb $ T.pack $ "-target-attach --thread-group i" ++ show (length ps) ++ " " ++ show pid
                         send gdb $ T.pack $ "-exec-continue --thread-group i" ++ show (length ps)
-- 
cgit v1.2.3