cadey
/
propellor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

propellor spin

This commit is contained in:
Joey Hess 2014-05-09 12:02:05 -03:00
parent 201aa34d85
commit ee06f4ce46
Failed to extract signature
1 changed files with 19 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
Propellor/SimpleSh.hs
View File

@ -35,14 +35,7 @@ simpleSh namedpipe = do
maybe noop (run h) . readish =<< hGetLine h maybe noop (run h) . readish =<< hGetLine h
where where
run h (Cmd cmd params) = do 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 chan <- newChan
let runwriter = do let runwriter = do
v <- readChan chan v <- readChan chan
hPutStrLn h (show v) hPutStrLn h (show v)
@ -52,6 +45,14 @@ simpleSh namedpipe = do
_ -> runwriter _ -> runwriter
writer <- async runwriter writer <- async runwriter
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) let mkreader t from = maybe noop (const $ mkreader t from)
=<< catchMaybeIO (writeChan chan . t =<< hGetLine from) =<< catchMaybeIO (writeChan chan . t =<< hGetLine from)
void $ concurrently void $ concurrently
@ -62,10 +63,10 @@ simpleSh namedpipe = do
writeChan chan Done writeChan chan Done
wait writer
hClose outh hClose outh
hClose errh hClose errh
wait writer
hClose h hClose h
simpleShClient :: FilePath -> String -> [String] -> ([Resp] -> IO a) -> IO a simpleShClient :: FilePath -> String -> [String] -> ([Resp] -> IO a) -> IO a