summaryrefslogtreecommitdiff
path: root/Propellor
diff options
context:
space:
mode:
authorJoey Hess2014-05-09 12:02:05 -0300
committerJoey Hess2014-05-09 12:02:05 -0300
commitee06f4ce46074989b0f65d788805bcb9198ffc82 (patch)
treecfb89b428a8f4077afb591da3d175d482ab3d7c0 /Propellor
parent201aa34d85575ec1a430a4543c3afa1cc37ec88c (diff)
propellor spin
Diffstat (limited to 'Propellor')
-rw-r--r--Propellor/SimpleSh.hs35
1 files changed, 18 insertions, 17 deletions
diff --git a/Propellor/SimpleSh.hs b/Propellor/SimpleSh.hs
index 73ff41ae..d99268d1 100644
--- a/Propellor/SimpleSh.hs
+++ b/Propellor/SimpleSh.hs
@@ -35,14 +35,7 @@ simpleSh namedpipe = do
maybe noop (run h) . readish =<< hGetLine h
where
run h (Cmd cmd params) = do
- let p = (proc cmd params)
- { std_in = Inherit
- , std_out = CreatePipe
- , std_err = CreatePipe
- }
- (Nothing, Just outh, Just errh, pid) <- createProcess p
chan <- newChan
-
let runwriter = do
v <- readChan chan
hPutStrLn h (show v)
@@ -52,20 +45,28 @@ simpleSh namedpipe = do
_ -> runwriter
writer <- async runwriter
- let mkreader t from = maybe noop (const $ mkreader t from)
- =<< catchMaybeIO (writeChan chan . t =<< hGetLine from)
- void $ concurrently
- (mkreader StdoutLine outh)
- (mkreader StderrLine errh)
+ flip catchIO (\_e -> writeChan chan Done) $ do
+ let p = (proc cmd params)
+ { std_in = Inherit
+ , std_out = CreatePipe
+ , std_err = CreatePipe
+ }
+ (Nothing, Just outh, Just errh, pid) <- createProcess p
+
+ let mkreader t from = maybe noop (const $ mkreader t from)
+ =<< catchMaybeIO (writeChan chan . t =<< hGetLine from)
+ void $ concurrently
+ (mkreader StdoutLine outh)
+ (mkreader StderrLine errh)
- void $ tryIO $ waitForProcess pid
+ void $ tryIO $ waitForProcess pid
- writeChan chan Done
+ writeChan chan Done
- wait writer
+ hClose outh
+ hClose errh
- hClose outh
- hClose errh
+ wait writer
hClose h
simpleShClient :: FilePath -> String -> [String] -> ([Resp] -> IO a) -> IO a