clean up code in Runner, fix a likely bug

This commit is contained in:
Filip Gralinski 2018-07-26 21:46:17 +02:00
parent 9808354094
commit ae75c806c7

View File

@ -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")