Small refactor and build fixes

This commit is contained in:
Julian Ospald 2020-04-09 18:26:02 +02:00
parent adec7b2398
commit f78e7b1cbc
No known key found for this signature in database
GPG Key ID: 511B62C09D50CD28
3 changed files with 15 additions and 21 deletions

View File

@ -21,9 +21,7 @@ import GHCup.Types
import GHCup.Types.JSON ( )
import GHCup.Types.Optics
import GHCup.Utils
#if defined(CURL)
import GHCup.Utils.File
#endif
import GHCup.Utils.Prelude
import GHCup.Version

View File

@ -13,6 +13,7 @@ module GHCup.Download.IOStreams where
import GHCup.Download.Utils
import GHCup.Errors
import GHCup.Types.Optics
import GHCup.Types.JSON ( )
import GHCup.Utils.File
import GHCup.Utils.Prelude

View File

@ -59,6 +59,7 @@ import qualified "unix-bytestring" System.Posix.IO.ByteString
as SPIB
-- | Bool signals whether the regions should be cleaned.
data StopThread = StopThread Bool
deriving Show
@ -190,7 +191,10 @@ execLogged exe spath args lfile chdir env = do
when b (forM_ rs closeConsoleRegion)
EX.throw (StopThread b)
)
$ readForever (lineAction ref rs) fdIn
$ do
hideError eofErrorType $ readTilEOF (lineAction ref rs) fdIn
-- wait for explicit stop from the parent to signal what cleanup to run
forever (threadDelay 5000)
where
-- action to perform line by line
@ -220,26 +224,16 @@ execLogged exe spath args lfile chdir env = do
-- read an entire line from the file descriptor (removes the newline char)
readLine fd' = do
bs <-
handle
(\(e :: IOError) -> do
if isEOFError e then threadDelay 1000 >> pure "" else throw e
)
$ SPIB.fdRead fd' 1
bs <- SPIB.fdRead fd' 1
if
| bs == "\n" -> pure ""
| bs == "" -> pure ""
| otherwise -> fmap (bs <>) $ readLine fd'
readForever action' fd' = do
bs <- readLine fd'
if not $ BS.null bs
then action' bs >> readForever action' fd'
else readForever action' fd'
readTilEOF action' fd' = do
bs <- readLine fd'
when (not $ BS.null bs) (action' bs >> readTilEOF action' fd')
action' bs
readTilEOF action' fd'
-- | Capture the stdout and stderr of the given action, which
@ -274,7 +268,7 @@ captureOutStreams action = do
refOut <- newIORef BS.empty
refErr <- newIORef BS.empty
done <- newEmptyMVar
_ <-
_ <-
forkIO
$ EX.handle (\(_ :: StopThread) -> pure ())
$ EX.handle (\(_ :: IOException) -> pure ())
@ -301,21 +295,22 @@ captureOutStreams action = do
doneOut <- newEmptyMVar
void
$ forkIO
$ EX.handle (\(_ :: IOException) -> pure ())
$ hideError eofErrorType
$ flip finally (putMVar doneOut ())
$ readTilEOF (\x -> modifyIORef' rout (<> x)) pout
doneErr <- newEmptyMVar
void
$ forkIO
$ EX.handle (\(_ :: IOException) -> pure ())
$ hideError eofErrorType
$ flip finally (putMVar doneErr ())
$ readTilEOF (\x -> modifyIORef' rerr (<> x)) perr
takeMVar doneOut
takeMVar doneErr
readTilEOF action' fd' = do
readTilEOF ~action' fd' = do
bs <- SPIB.fdRead fd' 512
when (not $ BS.null bs) (action' bs >> readTilEOF action' fd')
action' bs
readTilEOF action' fd'
actionWithPipes :: ((Fd, Fd) -> IO b) -> IO b