More stuff

This commit is contained in:
Julian Ospald 2020-02-19 13:30:18 +01:00
parent d4ed158acb
commit 57cf985e05
3 changed files with 48 additions and 23 deletions

View File

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

View File

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

View File

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