Small refactor and build fixes
This commit is contained in:
		
							parent
							
								
									adec7b2398
								
							
						
					
					
						commit
						f78e7b1cbc
					
				@ -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
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
@ -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
 | 
			
		||||
 | 
			
		||||
@ -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
 | 
			
		||||
@ -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
 | 
			
		||||
 | 
			
		||||
		Loading…
	
		Reference in New Issue
	
	Block a user