Browse Source

More stuff

dev
Julian Ospald 4 years ago
parent
commit
57cf985e05
3 changed files with 48 additions and 23 deletions
  1. +2
    -7
      cabal.project
  2. +8
    -5
      lib/GHCup.hs
  3. +38
    -11
      lib/GHCup/File.hs

+ 2
- 7
cabal.project 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

+ 8
- 5
lib/GHCup.hs 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


+ 38
- 11
lib/GHCup/File.hs 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


Loading…
Cancel
Save