Use ghc-debug

.gitlab/script/ghcup_version.sh

@@ -97,23 +97,17 @@ 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
-
-# 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}" ]
+[ "`eghcup run --cabal ${CABAL_VERSION} -- cabal --numeric-version`" = "${CABAL_VERSION}" ]
 
 if [ "${OS}" != "FREEBSD" ] ; then
 	if [ "${ARCH}" = "64" ] ; then

app/ghcup/GHCup/OptParse/Common.hs

@@ -440,11 +440,9 @@ tagCompleter tool add = listIOCompleter $ do
       pure $ nub $ (add ++) $ fmap tagToString allTags
     VLeft _ -> pure  (nub $ ["recommended", "latest"] ++ add)
 
-versionCompleter :: Maybe ListCriteria -> Tool -> Completer
-versionCompleter criteria tool = versionCompleter' criteria tool (const True)
 
-versionCompleter' :: Maybe ListCriteria -> Tool -> (Version -> Bool) -> Completer
-versionCompleter' criteria tool filter' = listIOCompleter $ do
+versionCompleter :: Maybe ListCriteria -> Tool -> Completer
+versionCompleter criteria tool = listIOCompleter $ do
   dirs' <- liftIO getAllDirs
   let loggerConfig = LoggerConfig
         { lcPrintDebug   = False
@@ -473,7 +471,7 @@ versionCompleter' criteria tool filter' = listIOCompleter $ do
           runEnv = flip runReaderT appState
 
       installedVersions <- runEnv $ listVersions (Just tool) criteria
-      return $ fmap (T.unpack . prettyVer) . filter filter' . fmap lVer $ installedVersions
+      return $ T.unpack . prettyVer . lVer <$> installedVersions
 
 
 toolDlCompleter :: Tool -> Completer

app/ghcup/GHCup/OptParse/Compile.hs

@@ -12,8 +12,6 @@ module GHCup.OptParse.Compile where
 
 
 import           GHCup
-import qualified GHCup.GHC as GHC
-import qualified GHCup.HLS as HLS
 import           GHCup.Errors
 import           GHCup.Types
 import           GHCup.Types.Optics
@@ -32,8 +30,7 @@ import           Control.Monad.Trans.Resource
 import           Data.Bifunctor
 import           Data.Functor
 import           Data.Maybe
-import           Data.Versions                  ( Version, prettyVer, version, pvp )
-import qualified Data.Versions as V
+import           Data.Versions                  ( Version, prettyVer, version )
 import           Data.Text                      ( Text )
 import           Haskus.Utils.Variant.Excepts
 import           Options.Applicative     hiding ( style )
@@ -44,7 +41,7 @@ import           Text.PrettyPrint.HughesPJClass ( prettyShow )
 
 import           URI.ByteString          hiding ( uriParser )
 import qualified Data.Text                     as T
-import Control.Exception.Safe (MonadMask, displayException)
+import Control.Exception.Safe (MonadMask)
 import System.FilePath (isPathSeparator)
 import Text.Read (readEither)
 
@@ -67,7 +64,7 @@ data CompileCommand = CompileGHC GHCCompileOptions
 
 
 data GHCCompileOptions = GHCCompileOptions
-  { targetGhc    :: GHC.GHCVer Version
+  { targetGhc    :: Either Version GitBranch
   , bootstrapGhc :: Either Version FilePath
   , jobs         :: Maybe Int
   , buildConfig  :: Maybe FilePath
@@ -81,13 +78,11 @@ data GHCCompileOptions = GHCCompileOptions
   , isolateDir   :: Maybe FilePath
   }
 
-
 data HLSCompileOptions = HLSCompileOptions
-  { targetHLS    :: HLS.HLSVer
+  { targetHLS    :: Either Version GitBranch
   , jobs         :: Maybe Int
   , setCompile   :: Bool
-  , updateCabal  :: Bool
-  , ovewrwiteVer :: Either Bool Version
+  , ovewrwiteVer :: Maybe Version
   , isolateDir   :: Maybe FilePath
   , cabalProject :: Maybe (Either FilePath URI)
   , cabalProjectLocal :: Maybe URI
@@ -150,22 +145,20 @@ Examples:
 
   compileHLSFooter = [s|Discussion:
   Compiles and installs the specified HLS version.
-  The --ghc arguments are necessary to specify which GHC version to build for/against.
+  The last argument is a list of GHC versions to compile for.
   These need to be available in PATH prior to compilation.
 
 Examples:
-  # compile 1.7.0.0 from hackage for 8.10.7, running 'cabal update' before the build
-  ghcup compile hls --version 1.7.0.0 --ghc 8.10.7 --cabal-update
-  # compile from master for ghc 9.2.3 using 'git describe' to name the binary and ignore the pinned index state
-  ghcup compile hls -g master --git-describe-version --ghc 9.2.3 -- --index-state=@(date '+%s')
-  # compile a specific commit for ghc 9.2.3 and set a specifc version for the binary name
-  ghcup compile hls -g a32db0b -o 1.7.0.0-p1 --ghc 9.2.3|]
+  # compile 1.4.0 for ghc 8.10.5 and 8.10.7
+  ghcup compile hls -v 1.4.0 -j 12 --ghc 8.10.5 --ghc 8.10.7
+  # compile from master for ghc 8.10.7, linking everything dynamically
+  ghcup compile hls -g master -j 12 --ghc 8.10.7 -- --ghc-options='-dynamic'|]
 
 
 ghcCompileOpts :: Parser GHCCompileOptions
 ghcCompileOpts =
   GHCCompileOptions
-    <$> ((GHC.SourceDist <$> option
+    <$> ((Left <$> option
           (eitherReader
             (first (const "Not a valid version") . version . T.pack)
           )
@@ -174,7 +167,7 @@ ghcCompileOpts =
             <> (completer $ versionCompleter Nothing GHC)
           )
           ) <|>
-          (GHC.GitDist <$> (GitBranch <$> option
+          (Right <$> (GitBranch <$> option
           str
           (short 'g' <> long "git-ref" <> metavar "GIT_REFERENCE" <> help
             "The git commit/branch/ref to build from"
@@ -183,18 +176,7 @@ ghcCompileOpts =
             short 'r' <> long "repository" <> metavar "GIT_REPOSITORY" <> help "The git repository to build from (defaults to GHC upstream)"
             <> completer (gitFileUri ["https://gitlab.haskell.org/ghc/ghc.git"])
             ))
-          ))
-          <|>
-          (
-           GHC.RemoteDist <$> (option
-            (eitherReader uriParser)
-            (long "remote-source-dist" <> metavar "URI" <> help
-              "URI (https/http/file) to a GHC source distribution"
-              <> completer fileUri
-            )
-          )
-          )
-          )
+          )))
     <*> option
           (eitherReader
             (\x ->
@@ -286,46 +268,24 @@ ghcCompileOpts =
 hlsCompileOpts :: Parser HLSCompileOptions
 hlsCompileOpts =
   HLSCompileOptions
-    <$> ((HLS.HackageDist <$> option
+    <$> ((Left <$> option
           (eitherReader
-            ((>>= first displayException . V.version . V.prettyPVP) . first (const "Not a valid PVP version") . pvp . T.pack)
+            (first (const "Not a valid version") . version . T.pack)
           )
           (short 'v' <> long "version" <> metavar "VERSION" <> help
-            "The version to compile (pulled from hackage)"
-            <> (completer $ versionCompleter' Nothing HLS (either (const False) (const True) . V.pvp . V.prettyVer))
+            "The tool version to compile"
+            <> (completer $ versionCompleter Nothing HLS)
           )
-          )
-          <|>
-          (HLS.GitDist <$> (GitBranch <$> option
+          ) <|>
+          (Right <$> (GitBranch <$> option
           str
           (short 'g' <> long "git-ref" <> metavar "GIT_REFERENCE" <> help
-            "The git commit/branch/ref to build from (accepts anything 'git checkout' accepts)"
+            "The git commit/branch/ref to build from"
           ) <*>
           optional (option str (short 'r' <> long "repository" <> metavar "GIT_REPOSITORY" <> help "The git repository to build from (defaults to HLS upstream)"
             <> completer (gitFileUri ["https://github.com/haskell/haskell-language-server.git"])
           ))
-          ))
-          <|>
-          (HLS.SourceDist <$> (option
-            (eitherReader
-              (first (const "Not a valid version") . version . T.pack)
-            )
-          (long "source-dist" <> metavar "VERSION" <> help
-            "The version to compile (pulled from packaged git sources)"
-            <> (completer $ versionCompleter Nothing HLS)
-          )
-          ))
-          <|>
-          (
-           HLS.RemoteDist <$> (option
-            (eitherReader uriParser)
-            (long "remote-source-dist" <> metavar "URI" <> help
-              "URI (https/http/file) to a HLS source distribution"
-              <> completer fileUri
-            )
-          )
-          )
-          )
+          )))
     <*> optional
           (option
             (eitherReader (readEither @Int))
@@ -335,10 +295,8 @@ hlsCompileOpts =
             )
           )
     <*> fmap (fromMaybe True) (invertableSwitch "set" Nothing True (help "Don't set as active version after install"))
-    <*> switch (long "cabal-update" <> help "Run 'cabal update' before the build")
-    <*>
-         (
-          (Right <$> option
+    <*> optional
+          (option
             (eitherReader
               (first (const "Not a valid version") . version . T.pack)
             )
@@ -347,14 +305,6 @@ hlsCompileOpts =
             <> (completer $ versionCompleter Nothing HLS)
             )
           )
-          <|>
-          (Left <$> (switch
-                      (long "git-describe-version"
-                         <> help "Use the output of 'git describe' (if building from git) as the VERSION component of the installed binary."
-                      )
-                    )
-          )
-          )
     <*> optional
           (option
             (eitherReader isolateParser)
@@ -507,7 +457,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
     (CompileHLS HLSCompileOptions { .. }) -> do
       runCompileHLS runAppState (do
         case targetHLS of
-          HLS.SourceDist targetVer -> do
+          Left targetVer -> do
             GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
             let vi = getVersionInfo targetVer HLS dls
             forM_ (_viPreCompile =<< vi) $ \msg -> do
@@ -515,7 +465,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
               lift $ logInfo
                 "...waiting for 5 seconds, you can still abort..."
               liftIO $ threadDelay 5000000 -- for compilation, give the user a sec to intervene
-          _ -> pure ()
+          Right _ -> pure ()
         ghcs <- liftE $ forM targetGHCs (\ghc -> fmap (_tvVersion . fst) . fromVersion (Just ghc) $ GHC)
         targetVer <- liftE $ compileHLS
                     targetHLS
@@ -525,7 +475,6 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
                     (maybe GHCupInternal IsolateDir isolateDir)
                     cabalProject
                     cabalProjectLocal
-                    updateCabal
                     patches
                     cabalArgs
         GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
@@ -559,7 +508,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
     (CompileGHC GHCCompileOptions {..}) ->
       runCompileGHC runAppState (do
         case targetGhc of
-          GHC.SourceDist targetVer -> do
+          Left targetVer -> do
             GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
             let vi = getVersionInfo targetVer GHC dls
             forM_ (_viPreCompile =<< vi) $ \msg -> do
@@ -567,12 +516,9 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
               lift $ logInfo
                 "...waiting for 5 seconds, you can still abort..."
               liftIO $ threadDelay 5000000 -- for compilation, give the user a sec to intervene
-          _ -> pure ()
+          Right _ -> pure ()
         targetVer <- liftE $ compileGHC
-                    ((\case
-                        GHC.SourceDist v -> GHC.SourceDist $ GHCTargetVersion crossTarget v
-                        GHC.GitDist g -> GHC.GitDist g
-                        GHC.RemoteDist r -> GHC.RemoteDist r) targetGhc)
+                    (first (GHCTargetVersion crossTarget) targetGhc)
                     ovewrwiteVer
                     bootstrapGhc
                     jobs

app/ghcup/GHCup/OptParse/Run.hs

@@ -18,7 +18,6 @@ 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
@@ -59,7 +58,6 @@ 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
@@ -84,8 +82,6 @@ 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)
@@ -253,9 +249,7 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
                void $ liftIO $ SPP.executeFile cmd True args (Just newEnv)
                pure ExitSuccess
 #else
-               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)
+               r' <- runLeanRUN leanAppstate $ liftE $ lEM @_ @'[ProcessError] $ exec cmd args Nothing (Just newEnv)
                case r' of
                  VRight _ -> pure ExitSuccess
                  VLeft e -> do

app/ghcup/Main.hs

@@ -14,8 +14,6 @@ module Main where
 import           BrickMain                    ( brickMain )
 #endif
 
-import qualified GHCup.GHC as GHC
-import qualified GHCup.HLS as HLS
 import           GHCup.OptParse
 
 import           GHCup.Download
@@ -28,6 +26,7 @@ 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
@@ -122,7 +121,7 @@ plan_json = $( do
 
 
 main :: IO ()
-main = do
+main = withGhcDebug $ do
   -- https://gitlab.haskell.org/ghc/ghc/issues/8118
   setLocaleEncoding utf8
 
@@ -340,13 +339,11 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
   alreadyInstalling (Install (Left (InstallStack InstallOptions{..})))   (Stack, ver) = cmp' Stack instVer ver
   alreadyInstalling (Compile (CompileGHC GHCCompileOptions{ ovewrwiteVer = Just over }))
     (GHC, ver)   = cmp' GHC (Just $ ToolVersion (mkTVer over)) ver
-  alreadyInstalling (Compile (CompileGHC GHCCompileOptions{ targetGhc = GHC.SourceDist tver }))
+  alreadyInstalling (Compile (CompileGHC GHCCompileOptions{ targetGhc = Left tver }))
     (GHC, ver)   = cmp' GHC (Just $ ToolVersion (mkTVer tver)) ver
-  alreadyInstalling (Compile (CompileHLS HLSCompileOptions{ ovewrwiteVer = Right over }))
+  alreadyInstalling (Compile (CompileHLS HLSCompileOptions{ ovewrwiteVer = Just over }))
     (HLS, ver)   = cmp' HLS (Just $ ToolVersion (mkTVer over)) ver
-  alreadyInstalling (Compile (CompileHLS HLSCompileOptions{ targetHLS = HLS.SourceDist tver }))
-    (HLS, ver)   = cmp' HLS (Just $ ToolVersion (mkTVer tver)) ver
-  alreadyInstalling (Compile (CompileHLS HLSCompileOptions{ targetHLS = HLS.HackageDist tver }))
+  alreadyInstalling (Compile (CompileHLS HLSCompileOptions{ targetHLS = Left tver }))
     (HLS, ver)   = cmp' HLS (Just $ ToolVersion (mkTVer tver)) ver
   alreadyInstalling (Upgrade _ _ _) (GHCup, _) = pure True
   alreadyInstalling _ _ = pure False

cabal.project

@@ -32,4 +32,7 @@ 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

docs/about.md

@@ -74,15 +74,12 @@ cabal-install/HLS/stack are installed in `~/.ghcup/bin/<tool>-<ver>` and have un
 
 ## Known users
 
-* CI:
-	- [Github actions/virtual-environments](https://github.com/actions/virtual-environments)
-	- [Github haskell/actions/setup](https://github.com/haskell/actions/tree/main/setup)
-	- [haskell-ci](https://github.com/haskell-CI/haskell-ci)
+* Github actions:
+	- [actions/virtual-environments](https://github.com/actions/virtual-environments)
+	- [haskell/actions/setup](https://github.com/haskell/actions/tree/main/setup)
 * mirrors:
 	- [sjtug](https://mirror.sjtu.edu.cn/docs/ghcup)
 * tools:
-	- [vscode-haskell](https://github.com/haskell/vscode-haskell)
-	- [nvim-lsp-installer](https://github.com/williamboman/nvim-lsp-installer)
 	- [vabal](https://github.com/Franciman/vabal)
 
 ## Known problems

docs/guide.md

@@ -202,9 +202,7 @@ and produce the binaries `ghc-8.10.2-eff` and `ghc-head` respectively.
 GHCup always needs to know which version the bindist corresponds to (this is not automatically
 detected).
 
-## Compiling from source
-
-### GHC
+## Compiling GHC from source
 
 Compiling from source is supported for both source tarballs and arbitrary git refs. See `ghcup compile ghc --help`
 for a list of all available options.
@@ -216,47 +214,6 @@ Common `build.mk` options are explained [here](https://gitlab.haskell.org/ghc/gh
 
 Make sure your system meets all the [prerequisites](https://gitlab.haskell.org/ghc/ghc/-/wikis/building/preparation).
 
-### HLS
-
-There are 3 main ways to compile HLS from source.
-
-1. from hackage (should have up to date version bounds)
-    - `ghcup compile hls --version 1.7.0.0 --ghc 9.2.3`
-2. from git (allows to build latest sources and PRs)
-    - `ghcup compile hls --git-ref master --ghc 9.2.3`
-    - `ghcup compile hls --git-ref a32db0b --ghc 9.2.3`
-    - `ghcup compile hls --git-ref 1.7.0.0 --ghc 9.2.3`
-3. from source distribution that's packaged during release from the corresponding git sources
-    - `ghcup compile hls --source-dist 1.7.0.0 --ghc 9.2.3`
-
-All these use `cabal v2-install` under the hood, so all build components are cached.
-You can pass arbitrary arguments to cabal, e.g. set the index state like so:
-
-```sh
-ghcup compile hls --git-ref master --ghc 9.2.3 -- --index-state=2022-06-12T00:00:00Z --allow-newer
-```
-
-You can pass `--ghc <ver>` multiple times to install for many GHCs at once.
-
-When building from git sources, ghcup will auto-detect the HLS version that the git commit corresponds to
-from the `haskell-language-server.cabal` file. This version might not have been updated since the last release.
-If you want to avoid overwriting the existing installed HLS version, you can instruct ghcup to use `git describe`
-to set the HLS version instead:
-
-```sh
-ghcup compile hls --git-ref master --ghc 9.2.3 --git-describe-version
-```
-
-You can also set the version explicitly:
-
-```sh
-ghcup compile hls --git-ref master --ghc 9.2.3 --overwrite-version 1.7.0.0-p1
-```
-
-To instruct cabal to run `cabal update` before building, run `ghcup compile hls --version 1.7.0.0 --ghc 9.2.3 --cabal-update`
-
-As always, check `ghcup compile hls --help`.
-
 ### Cross support
 
 ghcup can compile and install a cross GHC for any target. However, this

docs/install.md

@@ -200,14 +200,6 @@ export PATH="$HOME/.cabal/bin:$HOME/.ghcup/bin:$PATH"
 
 See [ghcup.vim](https://github.com/hasufell/ghcup.vim).
 
-## VSCode integration
-The developers of the Haskell Language Server offer an [extension](https://github.com/haskell/vscode-haskell) tightly integrated with the [Haskell Language Server](https://github.com/haskell/haskell-language-server). To get started:
-
-1. Install GHCup. During installation, opt in to install the Haskell Language Server (HLS).
-2. Install the extension (from VSCode: Ctrl + P and then `ext install haskell.haskell`).
-3. Make sure your project uses the GHC version installed from GHCup (otherwise HLS is likely to fail on launch):
-    - instructions for [stack](https://docs.haskellstack.org/en/stable/yaml_configuration/#system-ghc)
-
 ## Get help
 
 * [Libera IRC chat on #haskell-ghcup or #haskell](https://kiwiirc.com/nextclient/irc.libera.chat/?nick=Guest%7C?#haskell,#haskell-ghcup)

ghcup.cabal

@@ -109,7 +109,7 @@ library
     , base16-bytestring     >=0.1.1.6    && <1.1
     , binary                ^>=0.8.6.0
     , bytestring            >=0.10       && <0.12
-    , Cabal                 ^>=3.0.0.0 || ^>=3.2.0.0 || ^>=3.4.0.0 || ^>=3.6.0.0
+    , Cabal                 ^>=3.6.2.0
     , case-insensitive      ^>=1.2.1.0
     , casing                ^>=0.1.4.1
     , containers            ^>=0.6
@@ -164,10 +164,8 @@ library
     cpp-options:   -DIS_WINDOWS
     other-modules:
       GHCup.Prelude.File.Windows
-      GHCup.Prelude.Windows
-    -- GHCup.OptParse.Run uses this
-    exposed-modules:
       GHCup.Prelude.Process.Windows
+      GHCup.Prelude.Windows
 
     build-depends:
       , bzlib
@@ -242,6 +240,7 @@ 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.hs

@@ -33,8 +33,8 @@ module GHCup (
 
 
 import           GHCup.Cabal
-import           GHCup.GHC             hiding ( GHCVer(..) )
-import           GHCup.HLS             hiding ( HLSVer(..) )
+import           GHCup.GHC
+import           GHCup.HLS
 import           GHCup.Stack
 import           GHCup.List
 import           GHCup.Download
@@ -206,8 +206,9 @@ rmGhcupDirs = do
       | isWindows = removeDirIfEmptyOrIsSymlink binDir
       | otherwise = do
           isXDGStyle <- liftIO useXDG
-          when (not isXDGStyle) $
-            removeDirIfEmptyOrIsSymlink binDir
+          if not isXDGStyle
+            then removeDirIfEmptyOrIsSymlink binDir
+            else pure ()
 
     reportRemainingFiles :: (MonadMask m, MonadIO m) => FilePath -> m [FilePath]
     reportRemainingFiles dir = do

lib/GHCup/GHC.hs

@@ -80,12 +80,6 @@ import qualified Data.Text.Encoding            as E
 import qualified Text.Megaparsec               as MP
 
 
-data GHCVer v = SourceDist v
-              | GitDist GitBranch
-              | RemoteDist URI
-
-
-
     ---------------------
     --[ Tool fetching ]--
     ---------------------
@@ -572,11 +566,8 @@ rmGHCVer ver = do
       lift $ recycleFile f
       when (not (null survivors)) $ throwE $ UninstallFailed dir survivors
     Nothing -> do
-      isDir <- liftIO $ doesDirectoryExist dir
-      isSyml <- liftIO $ handleIO (\_ -> pure False) $ pathIsSymbolicLink dir
-      when (isDir && not isSyml) $ do
-        lift $ logInfo $ "Removing legacy directory recursively: " <> T.pack dir
-        recyclePathForcibly dir'
+      lift $ logInfo $ "Removing legacy directory recursively: " <> T.pack dir
+      lift $ recyclePathForcibly dir'
 
   v' <-
     handle
@@ -613,7 +604,7 @@ compileGHC :: ( MonadMask m
               , MonadUnliftIO m
               , MonadFail m
               )
-           => GHCVer GHCTargetVersion
+           => Either GHCTargetVersion GitBranch          -- ^ version to install
            -> Maybe Version            -- ^ overwrite version
            -> Either Version FilePath  -- ^ version to bootstrap with
            -> Maybe Int                -- ^ jobs
@@ -656,7 +647,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
 
     (workdir, tmpUnpack, tver) <- case targetGhc of
       -- unpack from version tarball
-      SourceDist tver -> do
+      Left tver -> do
         lift $ logDebug $ "Requested to compile: " <> tVerToText tver <> " with " <> either prettyVer T.pack bstrap
 
         -- download source tarball
@@ -677,31 +668,8 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
 
         pure (workdir, tmpUnpack, tver)
 
-      RemoteDist uri -> do
-        lift $ logDebug $ "Requested to compile (from uri): " <> T.pack (show uri)
-
-        -- download source tarball
-        tmpDownload <- lift withGHCupTmpDir
-        tmpUnpack <- lift mkGhcupTmpDir
-        tar <- liftE $ download uri Nothing Nothing (fromGHCupPath tmpDownload) Nothing False
-        (bf, tver) <- liftE $ cleanUpOnError @'[UnknownArchive, ArchiveResult, ProcessError] tmpUnpack $ do
-          liftE $ unpackToDir (fromGHCupPath tmpUnpack) tar
-          let regex = [s|^(.*/)*boot$|] :: B.ByteString
-          [bootFile] <- liftIO $ findFilesDeep
-            tmpUnpack
-            (makeRegexOpts compExtended
-                           execBlank
-                           regex
-            )
-          tver <- liftE $ getGHCVer (appendGHCupPath tmpUnpack (takeDirectory bootFile))
-          pure (bootFile, tver)
-
-        let workdir = appendGHCupPath tmpUnpack (takeDirectory bf)
-
-        pure (workdir, tmpUnpack, mkTVer tver)
-
       -- clone from git
-      GitDist GitBranch{..} -> do
+      Right GitBranch{..} -> do
         tmpUnpack <- lift mkGhcupTmpDir
         let git args = execLogged "git" ("--no-pager":args) (Just $ fromGHCupPath tmpUnpack) "git" Nothing
         tver <- reThrowAll @_ @'[PatchFailed, ProcessError, NotFoundInPATH, DigestError, DownloadFailed, GPGError] DownloadFailed $ do
@@ -713,46 +681,28 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
                     , "origin"
                     , fromString rep ]
 
-          -- figure out if we can do a shallow clone
-          remoteBranches <- catchE @ProcessError @'[PatchFailed, ProcessError, NotFoundInPATH, DigestError, DownloadFailed, GPGError] @'[PatchFailed, NotFoundInPATH, DigestError, DownloadFailed, GPGError] (\(_ :: ProcessError) -> pure [])
-              $ fmap processBranches $ gitOut ["ls-remote", "--heads", "origin"] (fromGHCupPath tmpUnpack)
-          let shallow_clone
-                | isCommitHash ref                     = True
-                | fromString ref `elem` remoteBranches = True
-                | otherwise                            = False
-          lift $ logDebug $ "Shallow clone: " <> T.pack (show shallow_clone)
-
-          -- fetch
-          let fetch_args
-                | shallow_clone = ["fetch", "--depth", "1", "--quiet", "origin", fromString ref]
-                | otherwise     = ["fetch", "--tags",       "--quiet", "origin"                ]
+          let fetch_args =
+                    [ "fetch"
+                    , "--depth"
+                    , "1"
+                    , "--quiet"
+                    , "origin"
+                    , fromString ref ]
           lEM $ git fetch_args
 
-          -- initial checkout
-          lEM $ git [ "checkout", fromString ref ]
-
-          -- gather some info
-          git_describe <- if shallow_clone
-                          then pure Nothing
-                          else fmap Just $ liftE $ gitOut ["describe", "--tags"] (fromGHCupPath tmpUnpack)
-          chash <- liftE $ gitOut ["rev-parse", "HEAD" ] (fromGHCupPath tmpUnpack)
-
-          -- clone submodules
+          lEM $ git [ "checkout", "FETCH_HEAD" ]
           lEM $ git [ "submodule", "update", "--init", "--depth", "1" ]
-
-          -- apply patches
           liftE $ applyAnyPatch patches (fromGHCupPath tmpUnpack)
+          lEM $ execWithGhcEnv "python3" ["./boot"] (Just $ fromGHCupPath tmpUnpack) "ghc-bootstrap"
+          lEM $ execWithGhcEnv "sh" ["./configure"] (Just $ fromGHCupPath tmpUnpack) "ghc-bootstrap"
+          CapturedProcess {..} <- lift $ makeOut
+            ["show!", "--quiet", "VALUE=ProjectVersion" ] (Just $ fromGHCupPath tmpUnpack)
+          case _exitCode of
+            ExitSuccess -> throwEither . MP.parse ghcProjectVersion "" . decUTF8Safe' $ _stdOut
+            ExitFailure c -> fail ("Could not figure out GHC project version. Exit code was: " <> show c <> ". Error was: " <> T.unpack (decUTF8Safe' _stdErr))
 
-          -- bootstrap
-          tver <- liftE $ getGHCVer tmpUnpack
-          liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform (fromGHCupPath tmpUnpack)
-          lift $ logInfo $ "Examining git ref " <> T.pack ref <> "\n  " <>
-                           "GHC version (from Makefile): " <> prettyVer tver <>
-                           (if not shallow_clone then "\n  " <> "'git describe' output: " <> fromJust git_describe else mempty) <>
-                           (if isCommitHash ref then mempty else "\n  " <> "commit hash: " <> chash)
-          liftIO $ threadDelay 5000000 -- give the user a sec to intervene
-
-          pure tver
+        liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform (fromGHCupPath tmpUnpack)
+        lift $ logInfo $ "Git version " <> T.pack ref <> " corresponds to GHC version " <> prettyVer tver
 
         pure (tmpUnpack, tmpUnpack, GHCTargetVersion Nothing tver)
     -- the version that's installed may differ from the
@@ -817,29 +767,11 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
     pure installVer
 
  where
-  getGHCVer :: ( MonadReader env m
-               , HasSettings env
-               , HasDirs env
-               , HasLog env
-               , MonadIO m
-               , MonadThrow m
-               )
-            => GHCupPath
-            -> Excepts '[ProcessError] m Version
-  getGHCVer tmpUnpack = do
-    lEM $ execWithGhcEnv "python3" ["./boot"] (Just $ fromGHCupPath tmpUnpack) "ghc-bootstrap"
-    lEM $ execWithGhcEnv "sh" ["./configure"] (Just $ fromGHCupPath tmpUnpack) "ghc-bootstrap"
-    CapturedProcess {..} <- lift $ makeOut
-      ["show!", "--quiet", "VALUE=ProjectVersion" ] (Just $ fromGHCupPath tmpUnpack)
-    case _exitCode of
-      ExitSuccess -> throwEither . MP.parse ghcProjectVersion "" . T.pack . stripNewlineEnd . T.unpack . decUTF8Safe' $ _stdOut
-      ExitFailure c -> throwE $ NonZeroExit c "make" ["show!", "--quiet", "VALUE=ProjectVersion" ]
-
   defaultConf =
     let cross_mk = $(LitE . StringL <$> (qAddDependentFile "data/build_mk/cross" >> runIO (readFile "data/build_mk/cross")))
         default_mk = $(LitE . StringL <$> (qAddDependentFile "data/build_mk/default" >> runIO (readFile "data/build_mk/default")))
     in case targetGhc of
-         SourceDist (GHCTargetVersion (Just _) _) -> cross_mk
+         Left (GHCTargetVersion (Just _) _) -> cross_mk
          _ -> default_mk
 
   compileHadrianBindist :: ( MonadReader env m
@@ -1016,7 +948,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
 
    -- for cross, we need Stage1Only
     case targetGhc of
-      SourceDist (GHCTargetVersion (Just _) _) -> when ("Stage1Only = YES" `notElem` lines') $ throwE
+      Left (GHCTargetVersion (Just _) _) -> when ("Stage1Only = YES" `notElem` lines') $ throwE
         (InvalidBuildConfig
           [s|Cross compiling needs to be a Stage1 build, add "Stage1Only = YES" to your config!|]
         )

lib/GHCup/HLS.hs

@@ -71,12 +71,6 @@ import qualified Text.Megaparsec               as MP
 import Text.PrettyPrint.HughesPJClass (prettyShow)
 
 
-data HLSVer = SourceDist Version
-            | GitDist GitBranch
-            | HackageDist Version
-            | RemoteDist URI
-
-
 
     --------------------
     --[ Installation ]--
@@ -330,14 +324,13 @@ compileHLS :: ( MonadMask m
               , MonadUnliftIO m
               , MonadFail m
               )
-           => HLSVer
+           => Either Version GitBranch
            -> [Version]
            -> Maybe Int
-           -> Either Bool Version
+           -> Maybe Version
            -> InstallDir
            -> Maybe (Either FilePath URI)
            -> Maybe URI
-           -> Bool
            -> Maybe (Either FilePath [URI])  -- ^ patches
            -> [Text]                   -- ^ additional args to cabal install
            -> Excepts '[ NoDownload
@@ -350,18 +343,15 @@ compileHLS :: ( MonadMask m
                        , BuildFailed
                        , NotInstalled
                        ] m Version
-compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal updateCabal patches cabalArgs = do
+compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal patches cabalArgs = do
   PlatformRequest { .. } <- lift getPlatformReq
   GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
   Dirs { .. } <- lift getDirs
 
-  when updateCabal $ reThrowAll @_ @'[ProcessError] DownloadFailed $ do
-    lift $ logInfo "Updating cabal DB"
-    lEM $ exec "cabal" ["update"] (Just $ fromGHCupPath tmpDir) Nothing
 
-  (workdir, tmpUnpack, tver, git_describe) <- case targetHLS of
+  (workdir, tver) <- case targetHLS of
     -- unpack from version tarball
-    SourceDist tver -> do
+    Left tver -> do
       lift $ logDebug $ "Requested to compile: " <> prettyVer tver
 
       -- download source tarball
@@ -379,50 +369,13 @@ compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal upda
                        (liftE . intoSubdir tmpUnpack)
                        (view dlSubdir dlInfo)
 
-      pure (workdir, tmpUnpack, tver, Nothing)
-
-    HackageDist tver -> do
-      lift $ logDebug $ "Requested to compile (from hackage): " <> prettyVer tver
-
-      -- download source tarball
-      tmpUnpack <- lift mkGhcupTmpDir
-      let hls = "haskell-language-server-" <> T.unpack (prettyVer tver)
-      reThrowAll @_ @'[ProcessError] DownloadFailed $ do
-        -- unpack
-        lEM $ exec "cabal" ["unpack", hls] (Just $ fromGHCupPath tmpUnpack) Nothing
-
-      let workdir = appendGHCupPath tmpUnpack hls
-
-      pure (workdir, tmpUnpack, tver, Nothing)
-
-    RemoteDist uri -> do
-      lift $ logDebug $ "Requested to compile (from uri): " <> T.pack (show uri)
-
-      -- download source tarball
-      tmpDownload <- lift withGHCupTmpDir
-      tmpUnpack <- lift mkGhcupTmpDir
-      tar <- liftE $ download uri Nothing Nothing (fromGHCupPath tmpDownload) Nothing False
-      (cf, tver) <- liftE $ cleanUpOnError tmpUnpack $ do
-        unpackToDir (fromGHCupPath tmpUnpack) tar
-        let regex = [s|^(.*/)*haskell-language-server\.cabal$|] :: B.ByteString
-        [cabalFile] <- liftIO $ findFilesDeep
-          tmpUnpack
-          (makeRegexOpts compExtended
-                         execBlank
-                         regex
-          )
-        tver <- getCabalVersion (fromGHCupPath tmpUnpack </> cabalFile)
-        pure (cabalFile, tver)
-
-      let workdir = appendGHCupPath tmpUnpack (takeDirectory cf)
-
-      pure (workdir, tmpUnpack, tver, Nothing)
+      pure (workdir, tver)
 
     -- clone from git
-    GitDist GitBranch{..} -> do
+    Right GitBranch{..} -> do
       tmpUnpack <- lift mkGhcupTmpDir
       let git args = execLogged "git" ("--no-pager":args) (Just $ fromGHCupPath tmpUnpack) "git" Nothing
-      reThrowAll @_ @'[ProcessError] DownloadFailed $ do
+      tver <- reThrowAll @_ @'[ProcessError] DownloadFailed $ do
         let rep = fromMaybe "https://github.com/haskell/haskell-language-server.git" repo
         lift $ logInfo $ "Fetching git repo " <> T.pack rep <> " at ref " <> T.pack ref <> " (this may take a while)"
         lEM $ git [ "init" ]
@@ -431,56 +384,36 @@ compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal upda
                   , "origin"
                   , fromString rep ]
 
-        -- figure out if we can do a shallow clone
-        remoteBranches <- catchE @ProcessError @'[ProcessError] @'[] (\_ -> pure [])
-            $ fmap processBranches $ gitOut ["ls-remote", "--heads", "origin"] (fromGHCupPath tmpUnpack)
-        let shallow_clone
-              | gitDescribeRequested                 = False
-              | isCommitHash ref                     = True
-              | fromString ref `elem` remoteBranches = True
-              | otherwise                            = False
-
-        lift $ logDebug $ "Shallow clone: " <> T.pack (show shallow_clone)
-
-        -- fetch
-        let fetch_args
-              | shallow_clone = ["fetch", "--depth", "1", "--quiet", "origin", fromString ref]
-              | otherwise     = ["fetch", "--tags",       "--quiet", "origin"                ]
+        let fetch_args =
+                  [ "fetch"
+                  , "--depth"
+                  , "1"
+                  , "--quiet"
+                  , "origin"
+                  , fromString ref ]
         lEM $ git fetch_args
 
-        -- checkout
-        lEM $ git [ "checkout", fromString ref ]
+        lEM $ git [ "checkout", "FETCH_HEAD" ]
+        (Just gpd) <- parseGenericPackageDescriptionMaybe <$> liftIO (B.readFile (fromGHCupPath tmpUnpack </> "haskell-language-server.cabal"))
+        pure . (\c -> Version Nothing c [] Nothing)
+          . NE.fromList . fmap (NE.fromList . (:[]) . digits . fromIntegral)
+          . versionNumbers
+          . pkgVersion
+          . package
+          . packageDescription
+          $ gpd
 
-        -- gather some info
-        git_describe <- if shallow_clone
-                        then pure Nothing
-                        else fmap Just $ gitOut ["describe", "--tags"] (fromGHCupPath tmpUnpack)
-        chash <- gitOut ["rev-parse", "HEAD" ] (fromGHCupPath tmpUnpack)
-        tver <- getCabalVersion (fromGHCupPath tmpUnpack </> "haskell-language-server.cabal")
+      liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform (fromGHCupPath tmpUnpack)
+      lift $ logInfo $ "Git version " <> T.pack ref <> " corresponds to HLS version " <> prettyVer tver
 
-        liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform (fromGHCupPath tmpUnpack)
-        lift $ logInfo $ "Examining git ref " <> T.pack ref <> "\n  " <>
-                                    "HLS version (from cabal file): " <> prettyVer tver <>
-                                    (if not shallow_clone then "\n  " <> "'git describe' output: " <> fromJust git_describe else mempty) <>
-                                    (if isCommitHash ref then mempty else "\n  " <> "commit hash: " <> chash)
-
-        pure (tmpUnpack, tmpUnpack, tver, git_describe)
+      pure (tmpUnpack, tver)
 
   -- the version that's installed may differ from the
   -- compiled version, so the user can overwrite it
-  installVer <- case ov of
-                  Left True -> case git_describe of
-                                 -- git describe
-                                 Just h -> either (fail . displayException) pure . version $ h
-                                 -- git describe, but not building from git, lol
-                                 Nothing -> pure tver
-                  -- default: use detected version
-                  Left False -> pure tver
-                  -- overwrite version with users value
-                  Right v -> pure v
+  let installVer = fromMaybe tver ov
 
   liftE $ runBuildAction
-    tmpUnpack
+    workdir
     (reThrowAll @_ @'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError, FileAlreadyExistsError, CopyError] @'[BuildFailed] (BuildFailed $ fromGHCupPath workdir) $ do
       let tmpInstallDir = fromGHCupPath workdir </> "out"
       liftIO $ createDirRecursive' tmpInstallDir
@@ -496,22 +429,14 @@ compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal upda
               pure "cabal.project"
           | otherwise -> pure (takeFileName cp)
         Just (Right uri) -> do
-          tmpUnpack' <- lift withGHCupTmpDir
-          cp <- liftE $ download uri Nothing Nothing (fromGHCupPath tmpUnpack') (Just "cabal.project") False
+          tmpUnpack <- lift withGHCupTmpDir
+          cp <- liftE $ download uri Nothing Nothing (fromGHCupPath tmpUnpack) (Just "cabal.project") False
           copyFileE cp (fromGHCupPath workdir </> "cabal.project") False
           pure "cabal.project"
-        Nothing
-          | HackageDist _ <- targetHLS -> do
-              liftIO $ B.writeFile (fromGHCupPath workdir </> "cabal.project") "packages: ./"
-              pure "cabal.project"
-          | RemoteDist _ <- targetHLS -> do
-              let cabalFile = fromGHCupPath workdir </> "cabal.project"
-              liftIO $ whenM (not <$> doesFileExist cabalFile) $ B.writeFile cabalFile "packages: ./"
-              pure "cabal.project"
-          | otherwise -> pure "cabal.project"
+        Nothing -> pure "cabal.project"
       forM_ cabalProjectLocal $ \uri -> do
-        tmpUnpack' <- lift withGHCupTmpDir
-        cpl <- liftE $ download uri Nothing Nothing (fromGHCupPath tmpUnpack') (Just (cp <.> "local")) False
+        tmpUnpack <- lift withGHCupTmpDir
+        cpl <- liftE $ download uri Nothing Nothing (fromGHCupPath tmpUnpack) (Just (cp <.> "local")) False
         copyFileE cpl (fromGHCupPath workdir </> cp <.> "local") False
       artifacts <- forM (sort ghcs) $ \ghc -> do
         let ghcInstallDir = tmpInstallDir </> T.unpack (prettyVer ghc)
@@ -539,7 +464,7 @@ compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal upda
         pure ghcInstallDir
 
       forM_ artifacts $ \artifact -> do
-        logDebug $ T.pack (show artifact)
+        logInfo $ T.pack (show artifact)
         liftIO $ renameFile (artifact </> "haskell-language-server" <.> exeExt)
           (tmpInstallDir </> "haskell-language-server-" <> takeFileName artifact <.> exeExt)
         liftIO $ renameFile (artifact </> "haskell-language-server-wrapper" <.> exeExt)
@@ -554,10 +479,6 @@ compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal upda
     )
 
   pure installVer
- where
-  gitDescribeRequested = case ov of
-                           Left b -> b
-                           _      -> False
 
 
     -----------------
@@ -693,11 +614,8 @@ rmHLSVer ver = do
       lift $ recycleFile f
       when (not (null survivors)) $ throwE $ UninstallFailed hlsDir survivors
     Nothing -> do
-      isDir <- liftIO $ doesDirectoryExist hlsDir
-      isSyml <- liftIO $ handleIO (\_ -> pure False) $ pathIsSymbolicLink hlsDir
-      when (isDir && not isSyml) $ do
-        lift $ logInfo $ "Removing legacy directory recursively: " <> T.pack hlsDir
-        recyclePathForcibly hlsDir'
+      lift $ logInfo $ "Removing legacy directory recursively: " <> T.pack hlsDir
+      recyclePathForcibly hlsDir'
 
   when (Just ver == isHlsSet) $ do
     -- set latest hls
@@ -705,19 +623,3 @@ rmHLSVer ver = do
     case headMay . reverse . sort $ hlsVers of
       Just latestver -> liftE $ setHLS latestver SetHLSOnly Nothing
       Nothing        -> pure ()
-
-
-getCabalVersion :: (MonadIO m, MonadFail m) => FilePath -> m Version
-getCabalVersion fp = do
-  contents <- liftIO $ B.readFile fp
-  gpd <- case parseGenericPackageDescriptionMaybe contents of
-           Nothing -> fail $ "could not parse cabal file: " <> fp
-           Just r -> pure r
-  let tver = (\c -> Version Nothing c [] Nothing)
-           . NE.fromList . fmap (NE.fromList . (:[]) . digits . fromIntegral)
-           . versionNumbers
-           . pkgVersion
-           . package
-           . packageDescription
-           $ gpd
-  pure tver

lib/GHCup/Prelude/Process/Windows.hs

@@ -206,36 +206,10 @@ 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
-    liftIO $ setEnv "PATH" ""
-    liftIO $ 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
-    liftIO $ setEnv "PATH" ""
-    liftIO $ 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

lib/GHCup/Types.hs

@@ -654,3 +654,10 @@ isSafeDir (IsolateDirResolved _) = False
 isSafeDir (GHCupDir _)           = True
 isSafeDir (GHCupBinDir _)        = False
 
+
+
+
+
+
+
+

lib/GHCup/Utils.hs

@@ -61,7 +61,6 @@ import           Control.Monad.Reader
 import           Control.Monad.Trans.Resource
                                          hiding ( throwM )
 import           Control.Monad.IO.Unlift        ( MonadUnliftIO( withRunInIO ) )
-import           Data.Char                      ( isHexDigit )
 import           Data.Bifunctor                 ( first )
 import           Data.ByteString                ( ByteString )
 import           Data.Either
@@ -1097,8 +1096,7 @@ runBuildAction bdir action = do
 
 -- | Clean up the given directory if the action fails,
 -- depending on the Settings.
-cleanUpOnError :: forall e m a env .
-                  ( MonadReader env m
+cleanUpOnError :: ( MonadReader env m
                   , HasDirs env
                   , HasSettings env
                   , MonadIO m
@@ -1277,35 +1275,3 @@ warnAboutHlsCompatibility = do
         T.pack (prettyShow supportedGHC)
 
     _ -> return ()
-
-
-
-    -----------
-    --[ Git ]--
-    -----------
-
-
-
-isCommitHash :: String -> Bool
-isCommitHash str' = let hex = all isHexDigit str'
-                        len = length str'
-                    in hex && len == 40
-
-
-gitOut :: (MonadReader env m, HasLog env, MonadIO m) => [String] -> FilePath -> Excepts '[ProcessError] m T.Text
-gitOut args dir = do
-  CapturedProcess {..} <- lift $ executeOut "git" args (Just dir)
-  case _exitCode of
-    ExitSuccess   -> pure $ T.pack $ stripNewlineEnd $ T.unpack $ decUTF8Safe' _stdOut
-    ExitFailure c -> do
-      let pe = NonZeroExit c "git" args
-      lift $ logDebug $ T.pack (prettyShow pe)
-      throwE pe
-
-processBranches :: T.Text -> [String]
-processBranches str' = let lines'   = lines (T.unpack str')
-                           words'   = fmap words lines'
-                           refs     = catMaybes $ fmap (`atMay` 1) words'
-                           branches = catMaybes $ fmap (stripPrefix "refs/heads/") $ filter (isPrefixOf "refs/heads/") refs
-                       in branches
-

scripts/bootstrap/bootstrap-haskell

@@ -133,15 +133,6 @@ _eghcup() {
     fi
 }
 
-ecabal() {
-	edo _ecabal "$@"
-}
-
-_ecabal() {
-    # shellcheck disable=SC2086
-    "${GHCUP_BIN}/cabal" "$@"
-}
-
 _done() {
 	echo
 	echo "==============================================================================="
@@ -546,7 +537,7 @@ adjust_cabal_config() {
     else
         cabal_bin="$HOME/AppData/Roaming/cabal/bin"
     fi
-    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
+    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
 }
 
 ask_cabal_config_init() {
@@ -697,7 +688,7 @@ find_shell
 echo
 echo "Welcome to Haskell!"
 echo
-echo "This script can download and install the following binaries:"
+echo "This script will download and install the following binaries:"
 echo "  * ghcup - The Haskell toolchain installer"
 echo "  * ghc   - The Glasgow Haskell Compiler"
 echo "  * cabal - The Cabal build tool for managing Haskell software"

scripts/bootstrap/bootstrap-haskell.ps1

@@ -242,7 +242,7 @@ if ($Silent -and !($InstallDir)) {
 	Print-Msg -color Magenta -msg (@'
 Welcome to Haskell!
 
-This script can download and install the following programs:
+This script will download and install the following programs:
   * ghcup - The Haskell toolchain installer
   * ghc   - The Glasgow Haskell Compiler
   * msys2 - A linux-style toolchain environment required for many operations