More stuff

cabal.project

@@ -12,10 +12,5 @@ package ghcup
 
 source-repository-package
   type: git
-  location: https://github.com/hasufell/streamly
+  location: https://github.com/composewell/streamly
-  tag: a343c4b99b20ea6f8207a220d5dccb3a88cecefa
+  tag: 4eb53e7f868bdc08afcc4b5210ab5916b9a4dfbc
-
-source-repository-package
-  type: git
-  location: https://github.com/psibi/streamly-bytestring
-  tag: fed14ce44e0219f68162f450b5c107fea20a6521

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
+  exe (fS "./configure") [fS "--prefix=" <> toFilePath inst] False (Just path)
-  executeOut c [fS "--prefix=" <> toFilePath inst] (Just path)
+  -- sh (fS "make") [fS "install"] (Just path)
-  let m = [rel|make|] :: Path Rel
-  executeOut m [fS "install"] (Just path)
   pure ()
 
 -- parseAvailableDownloads :: Maybe (Path Abs) -> IO AvailableDownloads

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
+  , _stdOut   :: ByteString
-  , _stdErr   :: L.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
+executeOut path args chdir = withRelPath path $ \fp -> captureOutStreams $ do
-  $ \fp -> captureOutStreams $ do
+  maybe (pure ()) (changeWorkingDirectory . toFilePath) chdir
-    maybe (pure ()) (changeWorkingDirectory . toFilePath) chdir
+  SPPB.executeFile fp True args Nothing
-    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
+          stdout' <- L.toStrict <$> readFd parentStdoutRead
-          stderr' <- readFd parentStderrRead
+          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
+