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

---
 erebos-tester.cabal |  1 +
 src/Main.hs         | 25 ++++++++-----------------
 src/Process.hs      | 35 +++++++++++++++++++++++++++++++++++
 src/Test.hs         | 11 ++---------
 4 files changed, 46 insertions(+), 26 deletions(-)
 create mode 100644 src/Process.hs

diff --git a/erebos-tester.cabal b/erebos-tester.cabal
index 4e09485..6817c72 100644
--- a/erebos-tester.cabal
+++ b/erebos-tester.cabal
@@ -35,6 +35,7 @@ executable erebos-tester-core
   main-is:             Main.hs
   other-modules:       Output
                        Parser
+                       Process
                        Test
   -- other-extensions:
   default-extensions:  ImportQualifiedPost
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)
diff --git a/src/Process.hs b/src/Process.hs
new file mode 100644
index 0000000..f409720
--- /dev/null
+++ b/src/Process.hs
@@ -0,0 +1,35 @@
+module Process (
+    Process(..),
+    ProcName(..),
+    textProcName, unpackProcName,
+) where
+
+import Control.Concurrent.STM
+
+import Data.Text (Text)
+import qualified Data.Text as T
+
+import System.IO
+import System.Posix.Signals
+import System.Process
+
+data Process = Process
+    { procName :: ProcName
+    , procHandle :: ProcessHandle
+    , procStdin :: Handle
+    , procOutput :: TVar [Text]
+    , procKillWith :: Maybe Signal
+    }
+
+data ProcName = ProcName Text
+              | ProcNameTcpdump
+              | ProcNameGDB
+    deriving (Eq, Ord)
+
+textProcName :: ProcName -> Text
+textProcName (ProcName name) = name
+textProcName ProcNameTcpdump = T.pack "tcpdump"
+textProcName ProcNameGDB = T.pack "gdb"
+
+unpackProcName :: ProcName -> String
+unpackProcName = T.unpack . textProcName
diff --git a/src/Test.hs b/src/Test.hs
index 4988098..465b424 100644
--- a/src/Test.hs
+++ b/src/Test.hs
@@ -11,6 +11,8 @@ import qualified Data.Text as T
 
 import Text.Regex.TDFA
 
+import Process
+
 data Test = Test
     { testName :: Text
     , testSteps :: [TestStep]
@@ -21,15 +23,6 @@ data TestStep = Spawn ProcName NodeName
               | Expect ProcName Regex Text
               | Wait
 
-newtype ProcName = ProcName Text
-    deriving (Eq, Ord)
-
-textProcName :: ProcName -> Text
-textProcName (ProcName name) = name
-
-unpackProcName :: ProcName -> String
-unpackProcName (ProcName tname) = T.unpack tname
-
 newtype NodeName = NodeName Text
     deriving (Eq, Ord)
 
-- 
cgit v1.2.3