Merge branch 'issue-375'

.gitlab/script/ghcup_version.sh

@@ -97,17 +97,23 @@ rm -rf "${GHCUP_DIR}"
 eghcup --numeric-version
 
 eghcup install ghc ${GHC_VERSION}
+eghcup unset ghc ${GHC_VERSION}
 ls -lah "$(eghcup whereis -d ghc ${GHC_VERSION})"
 [ "`$(eghcup whereis ghc ${GHC_VERSION}) --numeric-version`" = "${GHC_VERSION}" ]
 [ "`eghcup run --ghc ${GHC_VERSION} -- ghc --numeric-version`" = "${GHC_VERSION}" ]
+[ "`ghcup run --ghc ${GHC_VERSION} -- ghc -e 'Control.Monad.join (Control.Monad.fmap System.IO.putStr System.Environment.getExecutablePath)'`" = "`$(ghcup whereis ghc ${GHC_VERSION}) -e 'Control.Monad.join (Control.Monad.fmap System.IO.putStr System.Environment.getExecutablePath)'`" ]
 eghcup set ghc ${GHC_VERSION}
 eghcup install cabal ${CABAL_VERSION}
 [ "`$(eghcup whereis cabal ${CABAL_VERSION}) --numeric-version`" = "${CABAL_VERSION}" ]
 eghcup unset cabal
 "$GHCUP_BIN"/cabal --version && exit 1 || echo yes
-eghcup set cabal ${CABAL_VERSION}
-[ "`$(eghcup whereis cabal ${CABAL_VERSION}) --numeric-version`" = "${CABAL_VERSION}" ]
+
+# make sure no cabal is set when running 'ghcup run' to check that PATH propagages properly
+# https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/375
 [ "`eghcup run --cabal ${CABAL_VERSION} -- cabal --numeric-version`" = "${CABAL_VERSION}" ]
+eghcup set cabal ${CABAL_VERSION}
+
+[ "`$(eghcup whereis cabal ${CABAL_VERSION}) --numeric-version`" = "${CABAL_VERSION}" ]
 
 if [ "${OS}" != "FREEBSD" ] ; then
 	if [ "${ARCH}" = "64" ] ; then

app/ghcup/GHCup/OptParse/Run.hs

@@ -18,6 +18,7 @@ import           GHCup.Prelude
 import           GHCup.Prelude.File
 #ifdef IS_WINDOWS
 import           GHCup.Prelude.Process
+import           GHCup.Prelude.Process.Windows ( execNoMinGW )
 #endif
 import           GHCup.Prelude.Logger
 import           GHCup.Prelude.String.QQ
@@ -58,6 +59,7 @@ import qualified System.Posix.Process          as SPP
 data RunOptions = RunOptions
   { runAppendPATH :: Bool
   , runInstTool'  :: Bool
+  , runMinGWPath  :: Bool
   , runGHCVer     :: Maybe ToolVersion
   , runCabalVer   :: 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)")
     <*> switch
           (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
           (option
             (eitherReader toolVersionEither)
@@ -249,7 +253,9 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
                void $ liftIO $ SPP.executeFile cmd True args (Just newEnv)
                pure ExitSuccess
 #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
                  VRight _ -> pure ExitSuccess
                  VLeft e -> do

lib/GHCup/Prelude/Process/Windows.hs

@@ -206,10 +206,36 @@ exec :: MonadIO m
      -> Maybe [(String, String)] -- ^ optional environment
      -> m (Either ProcessError ())
 exec 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
   cp <- createProcessWithMingwPath ((proc exe args) { cwd = chdir, env = env })
   exit_code <- liftIO $ withCreateProcess cp $ \_ _ _ p -> waitForProcess p
   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`.
 execShell :: MonadIO m

scripts/bootstrap/bootstrap-haskell

@@ -133,6 +133,15 @@ _eghcup() {
     fi
 }
 
+ecabal() {
+	edo _ecabal "$@"
+}
+
+_ecabal() {
+    # shellcheck disable=SC2086
+    "${GHCUP_BIN}/cabal" "$@"
+}
+
 _done() {
 	echo
 	echo "==============================================================================="
@@ -537,7 +546,7 @@ adjust_cabal_config() {
     else
         cabal_bin="$HOME/AppData/Roaming/cabal/bin"
     fi
-    edo cabal user-config -a "extra-prog-path: $(cygpath -w "$GHCUP_BIN"), $(cygpath -w "$cabal_bin"), $(cygpath -w "$GHCUP_MSYS2"/mingw64/bin), $(cygpath -w "$GHCUP_MSYS2"/usr/bin)" -a "extra-include-dirs: $(cygpath -w "$GHCUP_MSYS2"/mingw64/include)" -a "extra-lib-dirs: $(cygpath -w "$GHCUP_MSYS2"/mingw64/lib)" -f init
+    ecabal user-config -a "extra-prog-path: $(cygpath -w "$GHCUP_BIN"), $(cygpath -w "$cabal_bin"), $(cygpath -w "$GHCUP_MSYS2"/mingw64/bin), $(cygpath -w "$GHCUP_MSYS2"/usr/bin)" -a "extra-include-dirs: $(cygpath -w "$GHCUP_MSYS2"/mingw64/include)" -a "extra-lib-dirs: $(cygpath -w "$GHCUP_MSYS2"/mingw64/lib)" -f init
 }
 
 ask_cabal_config_init() {