summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorRoman Smrž <roman.smrz@seznam.cz>2022-10-07 11:38:01 +0200
committerRoman Smrž <roman.smrz@seznam.cz>2022-10-07 18:27:33 +0200
commit23f206cf1fa9e4e9398aba47707024368c13ca60 (patch)
tree17906a3c679258f3a1da49c563a95a001051747c /src
parent2143eb381fc28e2d676a9c9a433426b1b2dbf737 (diff)
Process node record accessor
Diffstat (limited to 'src')
-rw-r--r--src/Main.hs1
-rw-r--r--src/Network.hs2
-rw-r--r--src/Process.hs9
3 files changed, 10 insertions, 2 deletions
diff --git a/src/Main.hs b/src/Main.hs
index 46fdaa6..b19796a 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -203,6 +203,7 @@ spawnOn target pname killWith cmd = do
, procStdin = hin
, procOutput = pout
, procKillWith = killWith
+ , procNode = either (const undefined) id target
}
let readingLoop :: Handle -> (Text -> TestRun ()) -> TestRun ()
diff --git a/src/Network.hs b/src/Network.hs
index a3c7120..d1d00bc 100644
--- a/src/Network.hs
+++ b/src/Network.hs
@@ -11,7 +11,7 @@ import Control.Concurrent
import Data.Text (Text)
import Data.Text qualified as T
-import Process
+import {-# SOURCE #-} Process
import Test
data Network = Network
diff --git a/src/Process.hs b/src/Process.hs
index 04c5076..0a2c861 100644
--- a/src/Process.hs
+++ b/src/Process.hs
@@ -7,6 +7,7 @@ module Process (
closeProcess,
) where
+import Control.Arrow
import Control.Concurrent.STM
import Control.Monad.Except
@@ -20,6 +21,7 @@ import System.IO
import System.Posix.Signals
import System.Process
+import Network
import Output
import Test
@@ -29,6 +31,7 @@ data Process = Process
, procStdin :: Handle
, procOutput :: TVar [Text]
, procKillWith :: Maybe Signal
+ , procNode :: Node
}
instance Eq Process where
@@ -37,7 +40,11 @@ instance Eq Process where
instance ExprType Process where
textExprType _ = T.pack "proc"
textExprValue n = T.pack "p:" <> textProcName (procName n)
- emptyVarValue = Process (ProcName T.empty) undefined undefined undefined undefined
+ emptyVarValue = Process (ProcName T.empty) undefined undefined undefined undefined emptyVarValue
+
+ recordMembers = map (first T.pack)
+ [ ("node", RecordSelector $ procNode)
+ ]
data ProcName = ProcName Text