clean up code in Runner, fix a likely bug
This commit is contained in:
parent
9808354094
commit
ae75c806c7
@ -108,19 +108,19 @@ gatherOutput ph hout herr chan = work mempty mempty
|
|||||||
-- Get any last bit written between the read and the status
|
-- Get any last bit written between the read and the status
|
||||||
-- check.
|
-- check.
|
||||||
_ <- takeFinalBit herr resterr
|
_ <- takeFinalBit herr resterr
|
||||||
all <- takeFinalBit hout restout
|
allTheRest <- takeFinalBit hout restout
|
||||||
return (ec, all)
|
return (ec, allTheRest)
|
||||||
takeABit h acc = do
|
takeABit h acc = do
|
||||||
bs <- liftIO $ BS.hGetNonBlocking hout (64 * 1024)
|
bs <- liftIO $ BS.hGetNonBlocking h (64 * 1024)
|
||||||
let acc' = acc <> (decodeUtf8 bs)
|
let acc' = acc <> (decodeUtf8 bs)
|
||||||
let (fullLines, rest) = processOutput acc'
|
let (fullLines, rest) = processOutput acc'
|
||||||
mapM_ (msg chan) fullLines
|
mapM_ (msg chan) fullLines
|
||||||
return rest
|
return rest
|
||||||
takeFinalBit h rest = do
|
takeFinalBit h rest = do
|
||||||
last <- liftIO $ BS.hGetContents h
|
lastPart <- liftIO $ BS.hGetContents h
|
||||||
let all = rest <> (decodeUtf8 last)
|
let allTheRest = rest <> (decodeUtf8 lastPart)
|
||||||
mapM_ (msg chan) $ lines all
|
mapM_ (msg chan) $ lines allTheRest
|
||||||
return all
|
return allTheRest
|
||||||
|
|
||||||
msg :: Channel -> Text -> Handler ()
|
msg :: Channel -> Text -> Handler ()
|
||||||
msg chan m = liftIO $ atom $ writeTChan chan $ Just (m ++ "\n")
|
msg chan m = liftIO $ atom $ writeTChan chan $ Just (m ++ "\n")
|
||||||
|
Loading…
Reference in New Issue
Block a user