Add --mingw-path switch to 'ghcup run'

.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/BrickMain.hs

@@ -449,7 +449,7 @@ install' _ (_, ListResult {..}) = do
       case lTool of
         GHC   -> do
           let vi = getVersionInfo lVer GHC dls
-          liftE $ installGHCBin lVer GHCupInternal False [] $> (vi, dirs, ce)
+          liftE $ installGHCBin lVer GHCupInternal False $> (vi, dirs, ce)
         Cabal -> do
           let vi = getVersionInfo lVer Cabal dls
           liftE $ installCabalBin lVer GHCupInternal False $> (vi, dirs, ce)

app/ghcup/GHCup/OptParse/Compile.hs

@@ -232,7 +232,7 @@ ghcCompileOpts =
               "Build cross-compiler for this platform"
             )
           )
-    <*> many (argument str (metavar "CONFIGURE_ARGS" <> help "Additional arguments to compile configure, prefix with '-- ' (longopts)"))
+    <*> many (argument str (metavar "CONFIGURE_ARGS" <> help "Additional arguments to configure, prefix with '-- ' (longopts)"))
     <*> fmap (fromMaybe False) (invertableSwitch "set" Nothing False (help "Set as active version after install"))
     <*> optional
           (option

app/ghcup/GHCup/OptParse/Install.hs

@@ -71,7 +71,6 @@ data InstallOptions = InstallOptions
   , instSet      :: Bool
   , isolateDir   :: Maybe FilePath
   , forceInstall :: Bool
-  , addConfArgs  :: [T.Text]
   }
 
 
@@ -214,7 +213,6 @@ installOpts tool =
           )
     <*> switch
           (short 'f' <> long "force" <> help "Force install (THIS IS UNSAFE, only use it in Dockerfiles or CI)")
-    <*> many (argument str (metavar "CONFIGURE_ARGS" <> help "Additional arguments to bindist configure, prefix with '-- ' (longopts)"))
  where
   setDefault = case tool of
     Nothing  -> False
@@ -337,7 +335,6 @@ install installCommand settings getAppState' runLogger = case installCommand of
                      (_tvVersion v)
                      (maybe GHCupInternal IsolateDir isolateDir)
                      forceInstall
-                     addConfArgs
                    )
                    $ when instSet $ when (isNothing isolateDir) $ liftE $ void $ setGHC v SetGHCOnly Nothing
          pure vi
@@ -349,7 +346,6 @@ install installCommand settings getAppState' runLogger = case installCommand of
                        (_tvVersion v)
                        (maybe GHCupInternal IsolateDir isolateDir)
                        forceInstall
-                       addConfArgs
                      )
                      $ when instSet $ when (isNothing isolateDir) $ liftE $ void $ setGHC v SetGHCOnly Nothing
            pure vi

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
@@ -355,7 +361,6 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
                  (_tvVersion v)
                  GHCupInternal
                  False
-                 []
                setTool GHC v tmp
              Just (Cabal, v) -> do
                unless isInstalled $ when runInstTool' $ void $ liftE $ installCabalBin

app/ghcup/Main.hs

@@ -26,7 +26,6 @@ import           GHCup.Prelude
 import           GHCup.Prelude.Logger
 import           GHCup.Prelude.String.QQ
 import           GHCup.Version
-import GHC.Debug.Stub
 
 import           Cabal.Plan ( findPlanJson, SearchPlanJson(..) )
 import           Control.Concurrent
@@ -121,7 +120,7 @@ plan_json = $( do
 
 
 main :: IO ()
-main = withGhcDebug $ do
+main = do
   -- https://gitlab.haskell.org/ghc/ghc/issues/8118
   setLocaleEncoding utf8
 

cabal.project

@@ -32,7 +32,4 @@ package aeson
 package streamly
   flags: +use-unliftio
 
-package *
-  ghc-options: -finfo-table-map -fdistinct-constructor-tables
-
 allow-newer: base, ghc-prim, template-haskell, language-c

ghcup.cabal

@@ -240,7 +240,6 @@ executable ghcup
     , deepseq               ^>=1.4
     , directory             ^>=1.3.6.0
     , filepath              ^>=1.4.2.1
-    , ghc-debug-stub
     , ghcup
     , haskus-utils-types    ^>=1.5
     , haskus-utils-variant  ^>=3.2.1

lib/GHCup/GHC.hs

@@ -141,7 +141,6 @@ installGHCBindist :: ( MonadFail m
                   -> Version         -- ^ the version to install
                   -> InstallDir
                   -> Bool            -- ^ Force install
-                  -> [T.Text]        -- ^ additional configure args for bindist
                   -> Excepts
                        '[ AlreadyInstalled
                         , BuildFailed
@@ -160,7 +159,7 @@ installGHCBindist :: ( MonadFail m
                         ]
                        m
                        ()
-installGHCBindist dlinfo ver installDir forceInstall addConfArgs = do
+installGHCBindist dlinfo ver installDir forceInstall = do
   let tver = mkTVer ver
 
   lift $ logDebug $ "Requested to install GHC with " <> prettyVer ver
@@ -190,12 +189,12 @@ installGHCBindist dlinfo ver installDir forceInstall addConfArgs = do
   case installDir of
     IsolateDir isoDir -> do                        -- isolated install
       lift $ logInfo $ "isolated installing GHC to " <> T.pack isoDir
-      liftE $ installPackedGHC dl (view dlSubdir dlinfo) (IsolateDirResolved isoDir) ver forceInstall addConfArgs
+      liftE $ installPackedGHC dl (view dlSubdir dlinfo) (IsolateDirResolved isoDir) ver forceInstall
     GHCupInternal -> do                            -- regular install
       -- prepare paths
       ghcdir <- lift $ ghcupGHCDir tver
 
-      liftE $ installPackedGHC dl (view dlSubdir dlinfo) (GHCupDir ghcdir) ver forceInstall addConfArgs
+      liftE $ installPackedGHC dl (view dlSubdir dlinfo) (GHCupDir ghcdir) ver forceInstall
 
       -- make symlinks & stuff when regular install,
       liftE $ postGHCInstall tver
@@ -231,7 +230,6 @@ installPackedGHC :: ( MonadMask m
                  -> InstallDirResolved
                  -> Version           -- ^ The GHC version
                  -> Bool              -- ^ Force install
-                 -> [T.Text]          -- ^ additional configure args for bindist
                  -> Excepts
                       '[ BuildFailed
                        , UnknownArchive
@@ -241,7 +239,7 @@ installPackedGHC :: ( MonadMask m
                        , ProcessError
                        , MergeFileTreeError
                        ] m ()
-installPackedGHC dl msubdir inst ver forceInstall addConfArgs = do
+installPackedGHC dl msubdir inst ver forceInstall = do
   PlatformRequest {..} <- lift getPlatformReq
 
   unless forceInstall
@@ -258,7 +256,7 @@ installPackedGHC dl msubdir inst ver forceInstall addConfArgs = do
                    msubdir
 
   liftE $ runBuildAction tmpUnpack
-                         (installUnpackedGHC workdir inst ver forceInstall addConfArgs)
+                         (installUnpackedGHC workdir inst ver forceInstall)
 
 
 -- | Install an unpacked GHC distribution. This only deals with the GHC
@@ -279,9 +277,8 @@ installUnpackedGHC :: ( MonadReader env m
                    -> InstallDirResolved  -- ^ Path to install to
                    -> Version             -- ^ The GHC version
                    -> Bool                -- ^ Force install
-                   -> [T.Text]          -- ^ additional configure args for bindist
                    -> Excepts '[ProcessError, MergeFileTreeError] m ()
-installUnpackedGHC path inst ver forceInstall addConfArgs
+installUnpackedGHC path inst ver forceInstall
   | isWindows = do
       lift $ logInfo "Installing GHC (this may take a while)"
       -- Windows bindists are relocatable and don't need
@@ -304,7 +301,7 @@ installUnpackedGHC path inst ver forceInstall addConfArgs
       lift $ logInfo "Installing GHC (this may take a while)"
       lEM $ execLogged "sh"
                        ("./configure" : ("--prefix=" <> fromInstallDir inst)
-                        : (alpineArgs <> (T.unpack <$> addConfArgs))
+                        : alpineArgs
                        )
                        (Just $ fromGHCupPath path)
                        "ghc-configure"
@@ -345,7 +342,6 @@ installGHCBin :: ( MonadFail m
               => Version         -- ^ the version to install
               -> InstallDir
               -> Bool            -- ^ force install
-              -> [T.Text]        -- ^ additional configure args for bindist
               -> Excepts
                    '[ AlreadyInstalled
                     , BuildFailed
@@ -364,9 +360,9 @@ installGHCBin :: ( MonadFail m
                     ]
                    m
                    ()
-installGHCBin ver installDir forceInstall addConfArgs = do
+installGHCBin ver installDir forceInstall = do
   dlinfo <- liftE $ getDownloadInfo GHC ver
-  liftE $ installGHCBindist dlinfo ver installDir forceInstall addConfArgs
+  liftE $ installGHCBindist dlinfo ver installDir forceInstall
 
 
 
@@ -751,7 +747,6 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
                                ghcdir
                                (installVer ^. tvVersion)
                                False       -- not a force install, since we already overwrite when compiling.
-                               []
 
     liftIO $ B.writeFile (fromInstallDir ghcdir </> ghcUpSrcBuiltFile) bmk
 

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
@@ -231,9 +257,8 @@ createProcessWithMingwPath :: MonadIO m
 createProcessWithMingwPath cp = do
   msys2Dir <- liftIO ghcupMsys2Dir
   cEnv <- Map.fromList <$> maybe (liftIO getEnvironment) pure (env cp)
-  let mingWPaths = [msys2Dir </> "mingw64" </> "bin"
-                   ,msys2Dir </> "usr" </> "bin"
-                   ]
+  let mingWPaths = [msys2Dir </> "usr" </> "bin"
+                   ,msys2Dir </> "mingw64" </> "bin"]
       paths = ["PATH", "Path"]
       curPaths = (\x -> maybe [] splitSearchPath (Map.lookup x cEnv)) =<< paths
       newPath = intercalate [searchPathSeparator] (mingWPaths ++ curPaths)

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"/usr/bin), $(cygpath -w "$GHCUP_MSYS2"/mingw64/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() {
@@ -763,7 +772,7 @@ if [ -z "${BOOTSTRAP_HASKELL_MINIMAL}" ] ; then
 
 	do_cabal_config_init $ask_cabal_config_init_answer
 
-	edo cabal update --ignore-project
+	ecabal update --ignore-project
 else # don't install ghc and cabal
 	case "${plat}" in
 			MSYS*|MINGW*)