Add --mingw-path switch to 'ghcup run'
This commit is contained in:
parent
565bb59f45
commit
d1c72cdff4
@ -18,6 +18,7 @@ import GHCup.Prelude
|
|||||||
import GHCup.Prelude.File
|
import GHCup.Prelude.File
|
||||||
#ifdef IS_WINDOWS
|
#ifdef IS_WINDOWS
|
||||||
import GHCup.Prelude.Process
|
import GHCup.Prelude.Process
|
||||||
|
import GHCup.Prelude.Process.Windows ( execNoMinGW )
|
||||||
#endif
|
#endif
|
||||||
import GHCup.Prelude.Logger
|
import GHCup.Prelude.Logger
|
||||||
import GHCup.Prelude.String.QQ
|
import GHCup.Prelude.String.QQ
|
||||||
@ -58,6 +59,7 @@ import qualified System.Posix.Process as SPP
|
|||||||
data RunOptions = RunOptions
|
data RunOptions = RunOptions
|
||||||
{ runAppendPATH :: Bool
|
{ runAppendPATH :: Bool
|
||||||
, runInstTool' :: Bool
|
, runInstTool' :: Bool
|
||||||
|
, runMinGWPath :: Bool
|
||||||
, runGHCVer :: Maybe ToolVersion
|
, runGHCVer :: Maybe ToolVersion
|
||||||
, runCabalVer :: Maybe ToolVersion
|
, runCabalVer :: Maybe ToolVersion
|
||||||
, runHLSVer :: Maybe ToolVersion
|
, runHLSVer :: Maybe ToolVersion
|
||||||
@ -82,6 +84,8 @@ runOpts =
|
|||||||
(short 'a' <> long "append" <> help "Append bin/ dir to PATH instead of prepending (this means that e.g. a system installation may take precedence)")
|
(short 'a' <> long "append" <> help "Append bin/ dir to PATH instead of prepending (this means that e.g. a system installation may take precedence)")
|
||||||
<*> switch
|
<*> switch
|
||||||
(short 'i' <> long "install" <> help "Install the tool, if missing")
|
(short 'i' <> long "install" <> help "Install the tool, if missing")
|
||||||
|
<*> switch
|
||||||
|
(short 'm' <> long "mingw-path" <> help "On windows, add mingw64 PATHs to environment (does nothing on unix)")
|
||||||
<*> optional
|
<*> optional
|
||||||
(option
|
(option
|
||||||
(eitherReader toolVersionEither)
|
(eitherReader toolVersionEither)
|
||||||
@ -249,7 +253,9 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
|
|||||||
void $ liftIO $ SPP.executeFile cmd True args (Just newEnv)
|
void $ liftIO $ SPP.executeFile cmd True args (Just newEnv)
|
||||||
pure ExitSuccess
|
pure ExitSuccess
|
||||||
#else
|
#else
|
||||||
r' <- runLeanRUN leanAppstate $ liftE $ lEM @_ @'[ProcessError] $ exec cmd args Nothing (Just newEnv)
|
r' <- if runMinGWPath
|
||||||
|
then runLeanRUN leanAppstate $ liftE $ lEM @_ @'[ProcessError] $ exec cmd args Nothing (Just newEnv)
|
||||||
|
else runLeanRUN leanAppstate $ liftE $ lEM @_ @'[ProcessError] $ execNoMinGW cmd args Nothing (Just newEnv)
|
||||||
case r' of
|
case r' of
|
||||||
VRight _ -> pure ExitSuccess
|
VRight _ -> pure ExitSuccess
|
||||||
VLeft e -> do
|
VLeft e -> do
|
||||||
|
@ -217,6 +217,25 @@ exec exe args chdir env = do
|
|||||||
exit_code <- liftIO $ withCreateProcess cp $ \_ _ _ p -> waitForProcess p
|
exit_code <- liftIO $ withCreateProcess cp $ \_ _ _ p -> waitForProcess p
|
||||||
pure $ toProcessError exe args exit_code
|
pure $ toProcessError exe args exit_code
|
||||||
|
|
||||||
|
-- | Like 'exec', except doesn't add msys2 stuff to PATH.
|
||||||
|
execNoMinGW :: MonadIO m
|
||||||
|
=> FilePath -- ^ thing to execute
|
||||||
|
-> [FilePath] -- ^ args for the thing
|
||||||
|
-> Maybe FilePath -- ^ optionally chdir into this
|
||||||
|
-> Maybe [(String, String)] -- ^ optional environment
|
||||||
|
-> m (Either ProcessError ())
|
||||||
|
execNoMinGW exe args chdir env = do
|
||||||
|
-- https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/375
|
||||||
|
forM_ (Map.fromList <$> env) $ \cEnv -> do
|
||||||
|
let paths = ["PATH", "Path"]
|
||||||
|
curPaths = (\x -> maybe [] splitSearchPath (Map.lookup x cEnv)) =<< paths
|
||||||
|
newPath = intercalate [searchPathSeparator] curPaths
|
||||||
|
setEnv "PATH" ""
|
||||||
|
setEnv "Path" newPath
|
||||||
|
let cp = (proc exe args) { cwd = chdir, env = env }
|
||||||
|
exit_code <- liftIO $ withCreateProcess cp $ \_ _ _ p -> waitForProcess p
|
||||||
|
pure $ toProcessError exe args exit_code
|
||||||
|
|
||||||
|
|
||||||
-- | Thin wrapper around `executeFile`.
|
-- | Thin wrapper around `executeFile`.
|
||||||
execShell :: MonadIO m
|
execShell :: MonadIO m
|
||||||
|
Loading…
Reference in New Issue
Block a user