diff --git a/cabal.project b/cabal.project index 74db8d3..debba56 100644 --- a/cabal.project +++ b/cabal.project @@ -12,10 +12,5 @@ package ghcup source-repository-package type: git - location: https://github.com/hasufell/streamly - tag: a343c4b99b20ea6f8207a220d5dccb3a88cecefa - -source-repository-package - type: git - location: https://github.com/psibi/streamly-bytestring - tag: fed14ce44e0219f68162f450b5c107fea20a6521 + location: https://github.com/composewell/streamly + tag: 4eb53e7f868bdc08afcc4b5210ab5916b9a4dfbc diff --git a/lib/GHCup.hs b/lib/GHCup.hs index bdda943..91b72b1 100644 --- a/lib/GHCup.hs +++ b/lib/GHCup.hs @@ -36,6 +36,7 @@ import Prelude hiding ( abs import System.Info import System.IO.Error import qualified Data.Text as T +import qualified Data.Text.Encoding as E import qualified Data.Text.ICU as ICU import Data.Maybe import qualified Data.Map.Strict as Map @@ -72,6 +73,10 @@ import qualified Codec.Compression.Lzma as Lzma import qualified Codec.Compression.BZip as BZip import qualified Data.ByteString.UTF8 as UTF8 +import qualified System.Posix.Process.ByteString + as SPPB +import System.Posix.Directory.ByteString (changeWorkingDirectory) + @@ -399,7 +404,7 @@ getLinuxDistro = do $ executeOut lsb_release_cmd [fS "-si"] Nothing ver <- (fmap . fmap) _stdOut $ executeOut lsb_release_cmd [fS "-sr"] Nothing - pure (lBS2sT name, fmap lBS2sT ver) + pure (E.decodeUtf8 name, fmap E.decodeUtf8 ver) try_lsb_release :: IO (Text, Maybe Text) try_lsb_release = do @@ -482,10 +487,8 @@ installGHC :: Path Abs -- ^ Path to the unpacked GHC bindist -> Path Abs -- ^ Path to install to -> IO () installGHC path inst = do - let c = [rel|./configure|] :: Path Rel - executeOut c [fS "--prefix=" <> toFilePath inst] (Just path) - let m = [rel|make|] :: Path Rel - executeOut m [fS "install"] (Just path) + exe (fS "./configure") [fS "--prefix=" <> toFilePath inst] False (Just path) + -- sh (fS "make") [fS "install"] (Just path) pure () -- parseAvailableDownloads :: Maybe (Path Abs) -> IO AvailableDownloads diff --git a/lib/GHCup/File.hs b/lib/GHCup/File.hs index 62ee1b3..6b6f703 100644 --- a/lib/GHCup/File.hs +++ b/lib/GHCup/File.hs @@ -25,6 +25,7 @@ import "unix" System.Posix.IO.ByteString import qualified System.Posix.Process.ByteString as SPPB import System.Posix.Directory.ByteString +import System.Posix.Process ( ProcessStatus(..) ) import System.Posix.Types import qualified Streamly.Internal.Memory.ArrayStream @@ -42,10 +43,17 @@ import Control.Concurrent import System.Posix.FD as FD +data ProcessError = NonZeroExit Int + | PTerminated + | PStopped + | NoSuchPid + deriving Show + + data CapturedProcess = CapturedProcess { _exitCode :: ExitCode - , _stdOut :: L.ByteString - , _stdErr :: L.ByteString + , _stdOut :: ByteString + , _stdErr :: ByteString } deriving (Eq, Show) makeLenses ''CapturedProcess @@ -92,10 +100,9 @@ executeOut :: Path Rel -- ^ command as filename, e.g. 'ls' -> [ByteString] -- ^ arguments to the command -> Maybe (Path Abs) -- ^ chdir to this path -> IO (Maybe CapturedProcess) -executeOut path args chdir = withRelPath path - $ \fp -> captureOutStreams $ do - maybe (pure ()) (changeWorkingDirectory . toFilePath) chdir - SPPB.executeFile fp True args Nothing +executeOut path args chdir = withRelPath path $ \fp -> captureOutStreams $ do + maybe (pure ()) (changeWorkingDirectory . toFilePath) chdir + SPPB.executeFile fp True args Nothing -- | Capture the stdout and stderr of the given action, which @@ -108,9 +115,6 @@ captureOutStreams action = actionWithPipes $ \(parentStdoutRead, childStdoutWrite) -> actionWithPipes $ \(parentStderrRead, childStderrWrite) -> do pid <- SPPB.forkProcess $ do - -- don't mess up stdin from the parent - closeFd stdInput - -- dup stdout void $ dupTo childStdoutWrite stdOutput closeFd childStdoutWrite @@ -131,8 +135,8 @@ captureOutStreams action = SPPB.getProcessStatus True True pid >>= \case -- readFd will take care of closing the fd Just (SPPB.Exited es) -> do - stdout' <- readFd parentStdoutRead - stderr' <- readFd parentStderrRead + stdout' <- L.toStrict <$> readFd parentStdoutRead + stderr' <- L.toStrict <$> readFd parentStderrRead pure $ Just $ CapturedProcess { _exitCode = es , _stdOut = stdout' , _stdErr = stderr' @@ -153,3 +157,26 @@ captureOutStreams action = createRegularFileFd :: FileMode -> Path b -> IO Fd createRegularFileFd fm dest = FD.openFd (toFilePath dest) WriteOnly [oExcl] (Just fm) + + +exe :: ByteString + -> [ByteString] + -> Bool + -> Maybe (Path Abs) + -> IO (Either ProcessError ()) +exe exe' args spath chdir = do + pid <- SPPB.forkProcess $ do + maybe (pure ()) (changeWorkingDirectory . toFilePath) chdir + SPPB.executeFile exe' spath args Nothing + + fmap toProcessError $ SPPB.getProcessStatus True True pid + + +toProcessError :: Maybe ProcessStatus -> Either ProcessError () +toProcessError mps = case mps of + Just (SPPB.Exited (ExitFailure i)) -> Left $ NonZeroExit i + Just (SPPB.Exited ExitSuccess ) -> Right () + Just (Terminated _ _ ) -> Left $ PTerminated + Just (Stopped _ ) -> Left $ PStopped + Nothing -> Left $ NoSuchPid +