Add --disable-ld-override for darwin bindists

Fixes #391

.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

@@ -17,6 +17,7 @@ import           GHCup.Prelude ( decUTF8Safe )
 import           GHCup.Prelude.File
 import           GHCup.Prelude.Logger
 import           GHCup.Prelude.Process
+import           GHCup.Prompts
 
 import           Brick
 import           Brick.Widgets.Border
@@ -52,6 +53,8 @@ import           Text.PrettyPrint.HughesPJClass ( prettyShow )
 import           URI.ByteString
 
 import qualified Data.Text                     as T
+import qualified Data.Text.Lazy.Builder        as B
+import qualified Data.Text.Lazy                as L
 import qualified Graphics.Vty                  as Vty
 import qualified Data.Vector                   as V
 import System.Environment (getExecutablePath)
@@ -98,7 +101,7 @@ keyHandlers KeyBindings {..} =
   [ (bQuit, const "Quit"     , halt)
   , (bInstall, const "Install"  , withIOAction install')
   , (bUninstall, const "Uninstall", withIOAction del')
-  , (bSet, const "Set"      , withIOAction ((liftIO .) . set'))
+  , (bSet, const "Set"      , withIOAction set')
   , (bChangelog, const "ChangeLog", withIOAction changelog')
   , ( bShowAllVersions
     , \BrickSettings {..} ->
@@ -486,9 +489,12 @@ install' _ (_, ListResult {..}) = do
             <> "Also check the logs in ~/.ghcup/logs"
 
 
-set' :: BrickState -> (Int, ListResult) -> IO (Either String ())
+set' :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadFail m, MonadMask m, MonadUnliftIO m)
-set' _ (_, ListResult {..}) = do
+     => BrickState
-  settings <- readIORef settings'
+     -> (Int, ListResult)
+     -> m (Either String ())
+set' bs input@(_, ListResult {..}) = do
+  settings <- liftIO $ readIORef settings'
 
   let run =
         flip runReaderT settings
@@ -504,7 +510,28 @@ set' _ (_, ListResult {..}) = do
     )
     >>= \case
           VRight _ -> pure $ Right ()
-          VLeft  e -> pure $ Left (prettyShow e)
+          VLeft  e -> case e of
+            (V (NotInstalled tool _)) -> do
+              promptAnswer <- getUserPromptResponse userPrompt
+              case promptAnswer of
+                PromptYes -> do
+                  res <- install' bs input
+                  case res of
+                    (Left err) -> pure $ Left err
+                    (Right _) -> do
+                      logInfo "Setting now..."
+                      set' bs input
+
+                PromptNo -> pure $ Left (prettyShow e)
+              where
+                userPrompt = L.toStrict . B.toLazyText . B.fromString $
+                  "This Version of "
+                  <> show tool
+                  <> " you are trying to set is not installed.\n"
+                  <> "Would you like to install it first? [Y/N]: "
+
+            _ -> pure $ Left (prettyShow e)
+
 
 
 del' :: (MonadReader AppState m, MonadIO m, MonadFail m, MonadMask m, MonadUnliftIO m)

app/ghcup/GHCup/OptParse/ChangeLog.hs

@@ -71,15 +71,16 @@ changelogP =
                 "cabal" -> Right Cabal
                 "ghcup" -> Right GHCup
                 "stack" -> Right Stack
+                "hls"   -> Right HLS
                 e       -> Left e
               )
             )
-            (short 't' <> long "tool" <> metavar "<ghc|cabal|ghcup>" <> help
+            (short 't' <> long "tool" <> metavar "<ghc|cabal|hls|ghcup>" <> help
               "Open changelog for given tool (default: ghc)"
               <> completer toolCompleter
             )
           )
-    <*> optional (toolVersionArgument Nothing Nothing)
+    <*> optional (toolVersionTagArgument Nothing Nothing)
 
 
 
@@ -116,7 +117,8 @@ changelog ChangeLogOptions{..} runAppState runLogger = do
       ver' = maybe
         (Right Latest)
         (\case
-          ToolVersion tv -> Left (_tvVersion tv) -- FIXME: ugly sharing of ToolVersion
+          GHCVersion tv  -> Left (_tvVersion tv)
+          ToolVersion tv -> Left tv
           ToolTag     t  -> Right t
         )
         clToolVer

app/ghcup/GHCup/OptParse/Common.hs

@@ -70,20 +70,24 @@ import Control.Exception (evaluate)
     --[ Types ]--
     -------------
 
-data ToolVersion = ToolVersion GHCTargetVersion -- target is ignored for cabal
+data ToolVersion = GHCVersion GHCTargetVersion
+                 | ToolVersion Version
                  | ToolTag Tag
 
 -- a superset of ToolVersion
-data SetToolVersion = SetToolVersion GHCTargetVersion
+data SetToolVersion = SetGHCVersion GHCTargetVersion
+                    | SetToolVersion Version
                     | SetToolTag Tag
                     | SetRecommended
                     | SetNext
 
 prettyToolVer :: ToolVersion -> String
-prettyToolVer (ToolVersion v') = T.unpack $ tVerToText v'
+prettyToolVer (GHCVersion v') = T.unpack $ tVerToText v'
+prettyToolVer (ToolVersion v') = T.unpack $ prettyVer v'
 prettyToolVer (ToolTag t) = show t
 
 toSetToolVer :: Maybe ToolVersion -> SetToolVersion
+toSetToolVer (Just (GHCVersion v')) = SetGHCVersion v'
 toSetToolVer (Just (ToolVersion v')) = SetToolVersion v'
 toSetToolVer (Just (ToolTag t')) = SetToolTag t'
 toSetToolVer Nothing = SetRecommended
@@ -96,10 +100,9 @@ toSetToolVer Nothing = SetRecommended
     --------------
 
 
--- | same as toolVersionParser, except as an argument.
+toolVersionTagArgument :: Maybe ListCriteria -> Maybe Tool -> Parser ToolVersion
-toolVersionArgument :: Maybe ListCriteria -> Maybe Tool -> Parser ToolVersion
+toolVersionTagArgument criteria tool =
-toolVersionArgument criteria tool =
+  argument (eitherReader (parser tool))
-  argument (eitherReader toolVersionEither)
     (metavar (mv tool)
     <> completer (tagCompleter (fromMaybe GHC tool) [])
     <> foldMap (completer . versionCompleter criteria) tool)
@@ -108,20 +111,19 @@ toolVersionArgument criteria tool =
   mv (Just HLS) = "HLS_VERSION|TAG"
   mv _          = "VERSION|TAG"
 
+  parser (Just GHC) = ghcVersionTagEither
+  parser Nothing    = ghcVersionTagEither
+  parser _          = toolVersionTagEither
 
-versionParser :: Parser GHCTargetVersion
-versionParser = option
-  (eitherReader tVersionEither)
-  (short 'v' <> long "version" <> metavar "VERSION" <> help "The target version"
-  )
 
 versionParser' :: Maybe ListCriteria -> Maybe Tool -> Parser Version
 versionParser' criteria tool = argument
   (eitherReader (first show . version . T.pack))
   (metavar "VERSION"  <> foldMap (completer . versionCompleter criteria) tool)
 
-versionArgument :: Maybe ListCriteria -> Maybe Tool -> Parser GHCTargetVersion
+ghcVersionArgument :: Maybe ListCriteria -> Maybe Tool -> Parser GHCTargetVersion
-versionArgument criteria tool = argument (eitherReader tVersionEither) (metavar "VERSION" <> foldMap (completer . versionCompleter criteria) tool)
+ghcVersionArgument criteria tool = argument (eitherReader ghcVersionEither)
+                                            (metavar "VERSION" <> foldMap (completer . versionCompleter criteria) tool)
 
 
 -- https://github.com/pcapriotti/optparse-applicative/issues/148
@@ -230,9 +232,15 @@ isolateParser f = case isValid f && isAbsolute f of
               True -> Right $ normalise f
               False -> Left "Please enter a valid filepath for isolate dir."
 
-toolVersionEither :: String -> Either String ToolVersion
+-- this accepts cross prefix
-toolVersionEither s' =
+ghcVersionTagEither :: String -> Either String ToolVersion
-  second ToolTag (tagEither s') <|> second ToolVersion (tVersionEither s')
+ghcVersionTagEither s' =
+  second ToolTag (tagEither s') <|> second GHCVersion (ghcVersionEither s')
+
+-- this ignores cross prefix
+toolVersionTagEither :: String -> Either String ToolVersion
+toolVersionTagEither s' =
+  second ToolTag (tagEither s') <|> second ToolVersion (toolVersionEither s')
 
 tagEither :: String -> Either String Tag
 tagEither s' = case fmap toLower s' of
@@ -244,10 +252,14 @@ tagEither s' = case fmap toLower s' of
   other         -> Left $ "Unknown tag " <> other
 
 
-tVersionEither :: String -> Either String GHCTargetVersion
+ghcVersionEither :: String -> Either String GHCTargetVersion
-tVersionEither =
+ghcVersionEither =
   first (const "Not a valid version") . MP.parse ghcTargetVerP "" . T.pack
 
+toolVersionEither :: String -> Either String Version
+toolVersionEither =
+  first (const "Not a valid version") . MP.parse version' "" . T.pack
+
 
 toolParser :: String -> Either String Tool
 toolParser s' | t == T.pack "ghc"   = Right GHC
@@ -440,9 +452,11 @@ 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 = listIOCompleter $ do
+versionCompleter criteria tool = versionCompleter' criteria tool (const True)
+
+versionCompleter' :: Maybe ListCriteria -> Tool -> (Version -> Bool) -> Completer
+versionCompleter' criteria tool filter' = listIOCompleter $ do
   dirs' <- liftIO getAllDirs
   let loggerConfig = LoggerConfig
         { lcPrintDebug   = False
@@ -471,7 +485,7 @@ versionCompleter criteria tool = listIOCompleter $ do
           runEnv = flip runReaderT appState
 
       installedVersions <- runEnv $ listVersions (Just tool) criteria
-      return $ T.unpack . prettyVer . lVer <$> installedVersions
+      return $ fmap (T.unpack . prettyVer) . filter filter' . fmap lVer $ installedVersions
 
 
 toolDlCompleter :: Tool -> Completer
@@ -663,7 +677,7 @@ fromVersion' SetRecommended tool = do
   GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
   bimap mkTVer Just <$> getRecommended dls tool
     ?? TagNotFound Recommended tool
-fromVersion' (SetToolVersion v) tool = do
+fromVersion' (SetGHCVersion v) tool = do
   GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
   let vi = getVersionInfo (_tvVersion v) tool dls
   case pvp $ prettyVer (_tvVersion v) of -- need to be strict here
@@ -675,6 +689,18 @@ fromVersion' (SetToolVersion v) tool = do
           when (v' /= _tvVersion v) $ lift $ logWarn ("Assuming you meant version " <> prettyVer v')
           pure (GHCTargetVersion (_tvTarget v) v', Just vi')
         Nothing -> pure (v, vi)
+fromVersion' (SetToolVersion v) tool = do
+  GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
+  let vi = getVersionInfo v tool dls
+  case pvp $ prettyVer v of -- need to be strict here
+    Left _ -> pure (mkTVer v, vi)
+    Right pvpIn ->
+      lift (getLatestToolFor tool pvpIn dls) >>= \case
+        Just (pvp_, vi') -> do
+          v' <- lift $ pvpToVersion pvp_ ""
+          when (v' /= v) $ lift $ logWarn ("Assuming you meant version " <> prettyVer v')
+          pure (GHCTargetVersion mempty v', Just vi')
+        Nothing -> pure (mkTVer v, vi)
 fromVersion' (SetToolTag Latest) tool = do
   GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
   bimap mkTVer Just <$> getLatest dls tool ?? TagNotFound Latest tool

app/ghcup/GHCup/OptParse/Compile.hs

@@ -12,6 +12,8 @@ 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
@@ -30,7 +32,8 @@ import           Control.Monad.Trans.Resource
 import           Data.Bifunctor
 import           Data.Functor
 import           Data.Maybe
-import           Data.Versions                  ( Version, prettyVer, version )
+import           Data.Versions                  ( Version, prettyVer, version, pvp )
+import qualified Data.Versions as V
 import           Data.Text                      ( Text )
 import           Haskus.Utils.Variant.Excepts
 import           Options.Applicative     hiding ( style )
@@ -41,7 +44,7 @@ import           Text.PrettyPrint.HughesPJClass ( prettyShow )
 
 import           URI.ByteString          hiding ( uriParser )
 import qualified Data.Text                     as T
-import Control.Exception.Safe (MonadMask)
+import Control.Exception.Safe (MonadMask, displayException)
 import System.FilePath (isPathSeparator)
 import Text.Read (readEither)
 
@@ -64,7 +67,7 @@ data CompileCommand = CompileGHC GHCCompileOptions
 
 
 data GHCCompileOptions = GHCCompileOptions
-  { targetGhc    :: Either Version GitBranch
+  { targetGhc    :: GHC.GHCVer Version
   , bootstrapGhc :: Either Version FilePath
   , jobs         :: Maybe Int
   , buildConfig  :: Maybe FilePath
@@ -78,11 +81,13 @@ data GHCCompileOptions = GHCCompileOptions
   , isolateDir   :: Maybe FilePath
   }
 
+
 data HLSCompileOptions = HLSCompileOptions
-  { targetHLS    :: Either Version GitBranch
+  { targetHLS    :: HLS.HLSVer
   , jobs         :: Maybe Int
   , setCompile   :: Bool
-  , ovewrwiteVer :: Maybe Version
+  , updateCabal  :: Bool
+  , ovewrwiteVer :: Either Bool Version
   , isolateDir   :: Maybe FilePath
   , cabalProject :: Maybe (Either FilePath URI)
   , cabalProjectLocal :: Maybe URI
@@ -145,20 +150,22 @@ Examples:
 
   compileHLSFooter = [s|Discussion:
   Compiles and installs the specified HLS version.
-  The last argument is a list of GHC versions to compile for.
+  The --ghc arguments are necessary to specify which GHC version to build for/against.
   These need to be available in PATH prior to compilation.
 
 Examples:
-  # compile 1.4.0 for ghc 8.10.5 and 8.10.7
+  # compile 1.7.0.0 from hackage for 8.10.7, running 'cabal update' before the build
-  ghcup compile hls -v 1.4.0 -j 12 --ghc 8.10.5 --ghc 8.10.7
+  ghcup compile hls --version 1.7.0.0 --ghc 8.10.7 --cabal-update
-  # compile from master for ghc 8.10.7, linking everything dynamically
+  # 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 -j 12 --ghc 8.10.7 -- --ghc-options='-dynamic'|]
+  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|]
 
 
 ghcCompileOpts :: Parser GHCCompileOptions
 ghcCompileOpts =
   GHCCompileOptions
-    <$> ((Left <$> option
+    <$> ((GHC.SourceDist <$> option
           (eitherReader
             (first (const "Not a valid version") . version . T.pack)
           )
@@ -167,7 +174,7 @@ ghcCompileOpts =
             <> (completer $ versionCompleter Nothing GHC)
           )
           ) <|>
-          (Right <$> (GitBranch <$> option
+          (GHC.GitDist <$> (GitBranch <$> option
           str
           (short 'g' <> long "git-ref" <> metavar "GIT_REFERENCE" <> help
             "The git commit/branch/ref to build from"
@@ -176,7 +183,18 @@ 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 ->
@@ -268,24 +286,46 @@ ghcCompileOpts =
 hlsCompileOpts :: Parser HLSCompileOptions
 hlsCompileOpts =
   HLSCompileOptions
-    <$> ((Left <$> option
+    <$> ((HLS.HackageDist <$> option
           (eitherReader
-            (first (const "Not a valid version") . version . T.pack)
+            ((>>= first displayException . V.version . V.prettyPVP) . first (const "Not a valid PVP version") . pvp . T.pack)
           )
           (short 'v' <> long "version" <> metavar "VERSION" <> help
-            "The tool version to compile"
+            "The version to compile (pulled from hackage)"
-            <> (completer $ versionCompleter Nothing HLS)
+            <> (completer $ versionCompleter' Nothing HLS (either (const False) (const True) . V.pvp . V.prettyVer))
           )
-          ) <|>
+          )
-          (Right <$> (GitBranch <$> option
+          <|>
+          (HLS.GitDist <$> (GitBranch <$> option
           str
           (short 'g' <> long "git-ref" <> metavar "GIT_REFERENCE" <> help
-            "The git commit/branch/ref to build from"
+            "The git commit/branch/ref to build from (accepts anything 'git checkout' accepts)"
           ) <*>
           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))
@@ -295,8 +335,10 @@ hlsCompileOpts =
             )
           )
     <*> fmap (fromMaybe True) (invertableSwitch "set" Nothing True (help "Don't set as active version after install"))
-    <*> optional
+    <*> switch (long "cabal-update" <> help "Run 'cabal update' before the build")
-          (option
+    <*>
+         (
+          (Right <$> option
             (eitherReader
               (first (const "Not a valid version") . version . T.pack)
             )
@@ -305,6 +347,14 @@ 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)
@@ -351,7 +401,7 @@ hlsCompileOpts =
           )
         )
     <*> some (
-          option (eitherReader toolVersionEither)
+          option (eitherReader ghcVersionTagEither)
             (  long "ghc" <> metavar "GHC_VERSION|TAG" <> help "For which GHC version to compile for (can be specified multiple times)"
             <> completer (tagCompleter GHC [])
             <> completer (versionCompleter Nothing GHC))
@@ -457,7 +507,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
     (CompileHLS HLSCompileOptions { .. }) -> do
       runCompileHLS runAppState (do
         case targetHLS of
-          Left targetVer -> do
+          HLS.SourceDist targetVer -> do
             GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
             let vi = getVersionInfo targetVer HLS dls
             forM_ (_viPreCompile =<< vi) $ \msg -> do
@@ -465,7 +515,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
-          Right _ -> pure ()
+          _ -> pure ()
         ghcs <- liftE $ forM targetGHCs (\ghc -> fmap (_tvVersion . fst) . fromVersion (Just ghc) $ GHC)
         targetVer <- liftE $ compileHLS
                     targetHLS
@@ -475,6 +525,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
                     (maybe GHCupInternal IsolateDir isolateDir)
                     cabalProject
                     cabalProjectLocal
+                    updateCabal
                     patches
                     cabalArgs
         GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
@@ -508,7 +559,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
     (CompileGHC GHCCompileOptions {..}) ->
       runCompileGHC runAppState (do
         case targetGhc of
-          Left targetVer -> do
+          GHC.SourceDist targetVer -> do
             GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
             let vi = getVersionInfo targetVer GHC dls
             forM_ (_viPreCompile =<< vi) $ \msg -> do
@@ -516,9 +567,12 @@ 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
-          Right _ -> pure ()
+          _ -> pure ()
         targetVer <- liftE $ compileGHC
-                    (first (GHCTargetVersion crossTarget) targetGhc)
+                    ((\case
+                        GHC.SourceDist v -> GHC.SourceDist $ GHCTargetVersion crossTarget v
+                        GHC.GitDist g -> GHC.GitDist g
+                        GHC.RemoteDist r -> GHC.RemoteDist r) targetGhc)
                     ovewrwiteVer
                     bootstrapGhc
                     jobs

app/ghcup/GHCup/OptParse/Install.hs

@@ -196,7 +196,7 @@ installOpts tool =
                       <> completer (toolDlCompleter (fromMaybe GHC tool))
                     )
                   )
-            <*> (Just <$> toolVersionArgument Nothing tool)
+            <*> (Just <$> toolVersionTagArgument Nothing tool)
             )
         <|> pure (Nothing, Nothing)
         )

app/ghcup/GHCup/OptParse/Prefetch.hs

@@ -84,7 +84,7 @@ prefetchP = subparser
           <$> (PrefetchGHCOptions
                 <$> ( switch (short 's' <> long "source" <> help "Download source tarball instead of bindist") <**> helper )
                 <*> optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)" <> completer (bashCompleter "directory"))))
-          <*>  optional (toolVersionArgument Nothing (Just GHC)) )
+          <*>  optional (toolVersionTagArgument Nothing (Just GHC)) )
         ( progDesc "Download GHC assets for installation")
       )
       <>
@@ -93,7 +93,7 @@ prefetchP = subparser
       (info
         (PrefetchCabal
           <$> fmap PrefetchOptions (optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)" <> completer (bashCompleter "directory"))))
-          <*> ( optional (toolVersionArgument Nothing (Just Cabal)) <**> helper ))
+          <*> ( optional (toolVersionTagArgument Nothing (Just Cabal)) <**> helper ))
         ( progDesc "Download cabal assets for installation")
       )
       <>
@@ -102,7 +102,7 @@ prefetchP = subparser
       (info
         (PrefetchHLS
           <$> fmap PrefetchOptions (optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)" <> completer (bashCompleter "directory"))))
-          <*> ( optional (toolVersionArgument Nothing (Just HLS)) <**> helper ))
+          <*> ( optional (toolVersionTagArgument Nothing (Just HLS)) <**> helper ))
         ( progDesc "Download HLS assets for installation")
       )
       <>
@@ -111,7 +111,7 @@ prefetchP = subparser
       (info
         (PrefetchStack
           <$> fmap PrefetchOptions (optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)" <> completer (bashCompleter "directory"))))
-          <*> ( optional (toolVersionArgument Nothing (Just Stack)) <**> helper ))
+          <*> ( optional (toolVersionTagArgument Nothing (Just Stack)) <**> helper ))
         ( progDesc "Download stack assets for installation")
       )
       <>

app/ghcup/GHCup/OptParse/Rm.hs

@@ -103,7 +103,7 @@ rmParser =
 
 
 rmOpts :: Maybe Tool -> Parser RmOptions
-rmOpts tool = RmOptions <$> versionArgument (Just ListInstalled) tool
+rmOpts tool = RmOptions <$> ghcVersionArgument (Just ListInstalled) tool
 
 
 

app/ghcup/GHCup/OptParse/Run.hs

@@ -5,6 +5,7 @@
 {-# LANGUAGE RankNTypes        #-}
 {-# LANGUAGE FlexibleContexts  #-}
 {-# LANGUAGE TypeFamilies      #-}
+{-# LANGUAGE ViewPatterns      #-}
 module GHCup.OptParse.Run where
 
 
@@ -18,6 +19,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
@@ -45,6 +47,7 @@ import qualified Data.Text                     as T
 #ifndef IS_WINDOWS
 import qualified System.Posix.Process          as SPP
 #endif
+import Data.Versions ( prettyVer, Version )
 
 
 
@@ -58,6 +61,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,9 +86,11 @@ 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)
+            (eitherReader ghcVersionTagEither)
             (metavar "GHC_VERSION" <> long "ghc" <> help "The ghc version"
             <> completer (tagCompleter GHC [])
             <> (completer $ versionCompleter Nothing GHC)
@@ -92,7 +98,7 @@ runOpts =
           )
     <*> optional
           (option
-            (eitherReader toolVersionEither)
+            (eitherReader toolVersionTagEither)
             (metavar "CABAL_VERSION" <> long "cabal" <> help "The cabal version"
             <> completer (tagCompleter Cabal [])
             <> (completer $ versionCompleter Nothing Cabal)
@@ -100,7 +106,7 @@ runOpts =
           )
     <*> optional
           (option
-            (eitherReader toolVersionEither)
+            (eitherReader toolVersionTagEither)
             (metavar "HLS_VERSION" <> long "hls" <> help "The HLS version"
             <> completer (tagCompleter HLS [])
             <> (completer $ versionCompleter Nothing HLS)
@@ -108,7 +114,7 @@ runOpts =
           )
     <*> optional
           (option
-            (eitherReader toolVersionEither)
+            (eitherReader toolVersionTagEither)
             (metavar "STACK_VERSION" <> long "stack" <> help "The stack version"
             <> completer (tagCompleter Stack [])
             <> (completer $ versionCompleter Nothing Stack)
@@ -213,7 +219,7 @@ runRUN appState action' = do
 
 
 
-run :: forall m. 
+run :: forall m .
        ( MonadFail m
        , MonadMask m
        , MonadCatch m
@@ -229,12 +235,16 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
    r <- if not runQuick
         then runRUN runAppState $ do
          toolchain <- liftE resolveToolchainFull
-         tmp <- liftIO $ createTmpDir toolchain
+
+         -- oh dear
+         r <- lift ask
+         tmp <- lift . lift . lift . flip runReaderT (fromAppState r) $ createTmpDir toolchain
+
          liftE $ installToolChainFull toolchain tmp
          pure tmp
         else runLeanRUN leanAppstate $ do
          toolchain <- resolveToolchain
-         tmp <- liftIO $ createTmpDir toolchain
+         tmp <- lift $ createTmpDir toolchain
          liftE $ installToolChain toolchain tmp
          pure tmp
    case r of
@@ -249,7 +259,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
@@ -262,17 +274,6 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
 
   where
 
-   createTmpDir :: Toolchain -> IO FilePath
-   createTmpDir toolchain =
-     case runBinDir of
-           Just bindir -> do
-             createDirRecursive' bindir
-             canonicalizePath bindir
-           Nothing -> do
-             d <- predictableTmpDir toolchain
-             createDirRecursive' d
-             canonicalizePath d
-
    -- TODO: doesn't work for cross
    resolveToolchainFull :: ( MonadFail m
                            , MonadThrow m
@@ -290,29 +291,33 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
            pure v
          cabalVer <- forM runCabalVer $ \ver -> do
            (v, _) <- liftE $ fromVersion (Just ver) Cabal
-           pure v
+           pure (_tvVersion v)
          hlsVer <- forM runHLSVer $ \ver -> do
            (v, _) <- liftE $ fromVersion (Just ver) HLS
-           pure v
+           pure (_tvVersion v)
          stackVer <- forM runStackVer $ \ver -> do
            (v, _) <- liftE $ fromVersion (Just ver) Stack
-           pure v
+           pure (_tvVersion v)
          pure Toolchain{..}
 
    resolveToolchain = do
          ghcVer <- case runGHCVer of
-            Just (ToolVersion v) -> pure $ Just v
+            Just (GHCVersion v) -> pure $ Just v
+            Just (ToolVersion v) -> pure $ Just (mkTVer v)
             Nothing -> pure Nothing
             _ -> fail "Internal error"
          cabalVer <- case runCabalVer of
+            Just (GHCVersion v) -> pure $ Just (_tvVersion v)
             Just (ToolVersion v) -> pure $ Just v
             Nothing -> pure Nothing
             _ -> fail "Internal error"
          hlsVer <- case runHLSVer of
+            Just (GHCVersion v) -> pure $ Just (_tvVersion v)
             Just (ToolVersion v) -> pure $ Just v
             Nothing -> pure Nothing
             _ -> fail "Internal error"
          stackVer <- case runStackVer of
+            Just (GHCVersion v) -> pure $ Just (_tvVersion v)
             Just (ToolVersion v) -> pure $ Just v
             Nothing -> pure Nothing
             _ -> fail "Internal error"
@@ -347,35 +352,43 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
                               , MergeFileTreeError
                               ] (ResourceT (ReaderT AppState m)) ()
    installToolChainFull Toolchain{..} tmp = do
-         forM_ [(GHC,) <$> ghcVer, (Cabal,) <$> cabalVer, (HLS,) <$> hlsVer, (Stack,) <$> stackVer] $ \mt -> do
+         case ghcVer of
-           isInstalled <- maybe (pure False) (\(tool, v) -> lift $ checkIfToolInstalled' tool v) mt
+           Just v -> do
-           case mt of
+             isInstalled <- lift $ checkIfToolInstalled' GHC v
-             Just (GHC, v) -> do
+             unless isInstalled $ when (runInstTool' && isNothing (_tvTarget v)) $ void $ liftE $ installGHCBin
-               unless isInstalled $ when (runInstTool' && isNothing (_tvTarget v)) $ void $ liftE $ installGHCBin
+               (_tvVersion v)
-                 (_tvVersion v)
+               GHCupInternal
-                 GHCupInternal
+               False
-                 False
+               []
-                 []
+             setGHC' v tmp
-               setTool GHC v tmp
+           _ -> pure ()
-             Just (Cabal, v) -> do
+         case cabalVer of
-               unless isInstalled $ when runInstTool' $ void $ liftE $ installCabalBin
+           Just v -> do
-                 (_tvVersion v)
+             isInstalled <- lift $ checkIfToolInstalled' Cabal (mkTVer v)
-                 GHCupInternal
+             unless isInstalled $ when runInstTool' $ void $ liftE $ installCabalBin
-                 False
+               v
-               setTool Cabal v tmp
+               GHCupInternal
-             Just (Stack, v) -> do
+               False
-               unless isInstalled $ when runInstTool' $ void $ liftE $ installStackBin
+             setCabal' v tmp
-                 (_tvVersion v)
+           _ -> pure ()
-                 GHCupInternal
+         case stackVer of
-                 False
+           Just v -> do
-               setTool Stack v tmp
+             isInstalled <- lift $ checkIfToolInstalled' Stack (mkTVer v)
-             Just (HLS, v) -> do
+             unless isInstalled $ when runInstTool' $ void $ liftE $ installStackBin
-               unless isInstalled $ when runInstTool' $ void $ liftE $ installHLSBin
+               v
-                 (_tvVersion v)
+               GHCupInternal
-                 GHCupInternal
+               False
-                 False
+             setStack' v tmp
-               setTool HLS v tmp
+           _ -> pure ()
-             _ -> pure ()
+         case hlsVer of
+           Just v -> do
+             isInstalled <- lift $ checkIfToolInstalled' HLS (mkTVer v)
+             unless isInstalled $ when runInstTool' $ void $ liftE $ installHLSBin
+               v
+               GHCupInternal
+               False
+             setHLS' v tmp
+           _ -> pure ()
 
    installToolChain :: ( MonadFail m
                        , MonadThrow m
@@ -386,45 +399,46 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
                     -> FilePath
                     -> Excepts '[NotInstalled] (ReaderT LeanAppState m) ()
    installToolChain Toolchain{..} tmp = do
-         forM_ [(GHC,) <$> ghcVer, (Cabal,) <$> cabalVer, (HLS,) <$> hlsVer, (Stack,) <$> stackVer] $ \mt -> do
+         case ghcVer of
-           case mt of
+           Just v -> setGHC' v tmp
-             Just (GHC, v)   -> setTool GHC v tmp
+           _ -> pure ()
-             Just (Cabal, v) -> setTool Cabal v tmp
+         case cabalVer of
-             Just (Stack, v) -> setTool Stack v tmp
+           Just v -> setCabal' v tmp
-             Just (HLS, v)   -> setTool HLS v tmp
+           _ -> pure ()
-             _ -> pure ()
+         case stackVer of
+           Just v -> setStack' v tmp
+           _ -> pure ()
+         case hlsVer of
+           Just v -> setHLS' v tmp
+           _ -> pure ()
 
-   setTool tool v tmp =
+   setGHC' v tmp = do
-      case tool of
-        GHC -> do
           void $ liftE $ setGHC v SetGHC_XYZ (Just tmp)
           void $ liftE $ setGHC v SetGHCOnly (Just tmp)
-        Cabal -> do
+   setCabal' v tmp = do
-          bin  <- liftE $ whereIsTool Cabal v
+          bin  <- liftE $ whereIsTool Cabal (mkTVer v)
           cbin <- liftIO $ canonicalizePath bin
           lift $ createLink (relativeSymlink tmp cbin) (tmp </> ("cabal" <.> exeExt))
-        Stack -> do
+   setStack' v tmp = do
-          bin  <- liftE $ whereIsTool Stack v
+          bin  <- liftE $ whereIsTool Stack (mkTVer v)
           cbin <- liftIO $ canonicalizePath bin
           lift $ createLink (relativeSymlink tmp cbin) (tmp </> ("stack" <.> exeExt))
-        HLS -> do
+   setHLS' v tmp = do
           Dirs {..}  <- getDirs
-          let v' = _tvVersion v
+          legacy <- isLegacyHLS v
-          legacy <- isLegacyHLS v'
           if legacy
           then do
             -- TODO: factor this out
-            hlsWrapper <- liftE @_ @'[NotInstalled] $ hlsWrapperBinary v' !? (NotInstalled HLS (mkTVer v'))
+            hlsWrapper <- liftE @_ @'[NotInstalled] $ hlsWrapperBinary v !? (NotInstalled HLS (mkTVer v))
             cw <- liftIO $ canonicalizePath (binDir </> hlsWrapper)
             lift $ createLink (relativeSymlink tmp cw) (tmp </> takeFileName cw)
-            hlsBins <- hlsServerBinaries v' Nothing >>= liftIO . traverse (canonicalizePath . (binDir </>))
+            hlsBins <- hlsServerBinaries v Nothing >>= liftIO . traverse (canonicalizePath . (binDir </>))
             forM_ hlsBins $ \bin ->
               lift $ createLink (relativeSymlink tmp bin) (tmp </> takeFileName bin)
-            liftE $ setHLS (_tvVersion v) SetHLSOnly (Just tmp)
+            liftE $ setHLS v SetHLSOnly (Just tmp)
           else do
-            liftE $ setHLS (_tvVersion v) SetHLS_XYZ (Just tmp)
+            liftE $ setHLS v SetHLS_XYZ (Just tmp)
-            liftE $ setHLS (_tvVersion v) SetHLSOnly (Just tmp)
+            liftE $ setHLS v SetHLSOnly (Just tmp)
-        GHCup -> pure ()
 
    addToPath path = do
     cEnv <- Map.fromList <$> getEnvironment
@@ -437,16 +451,38 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
     liftIO $ setEnv pathVar newPath
     return envWithNewPath
 
-   predictableTmpDir (Toolchain Nothing Nothing Nothing Nothing) =
+   createTmpDir :: ( MonadUnliftIO m
-     liftIO (getTemporaryDirectory >>= \tmp -> pure (tmp </> "ghcup-none"))
+                   , MonadCatch m
+                   , MonadThrow m
+                   , MonadMask m
+                   , MonadIO m
+                   )
+                => Toolchain
+                -> ReaderT LeanAppState m FilePath
+   createTmpDir toolchain =
+     case runBinDir of
+           Just bindir -> do
+             liftIO $ createDirRecursive' bindir
+             liftIO $ canonicalizePath bindir
+           Nothing -> do
+             d <- predictableTmpDir toolchain
+             liftIO $ createDirRecursive' d
+             liftIO $ canonicalizePath d
+
+   predictableTmpDir :: Monad m
+                     => Toolchain
+                     -> ReaderT LeanAppState m FilePath
+   predictableTmpDir (Toolchain Nothing Nothing Nothing Nothing) = do
+     Dirs { tmpDir } <- getDirs
+     pure (fromGHCupPath tmpDir </> "ghcup-none")
    predictableTmpDir Toolchain{..} = do
-      tmp <- getTemporaryDirectory
+      Dirs { tmpDir } <- getDirs
-      pure $ tmp
+      pure $ fromGHCupPath tmpDir
         </> ("ghcup-" <> intercalate "_"
               (  maybe [] ( (:[]) . ("ghc-"   <>) . T.unpack . tVerToText) ghcVer
-              <> maybe [] ( (:[]) . ("cabal-" <>) . T.unpack . tVerToText) cabalVer
+              <> maybe [] ( (:[]) . ("cabal-" <>) . T.unpack . prettyVer) cabalVer
-              <> maybe [] ( (:[]) . ("hls-"   <>) . T.unpack . tVerToText) hlsVer
+              <> maybe [] ( (:[]) . ("hls-"   <>) . T.unpack . prettyVer) hlsVer
-              <> maybe [] ( (:[]) . ("stack-" <>) . T.unpack . tVerToText) stackVer
+              <> maybe [] ( (:[]) . ("stack-" <>) . T.unpack . prettyVer) stackVer
               )
             )
 
@@ -460,7 +496,7 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
 
 data Toolchain = Toolchain
   { ghcVer     :: Maybe GHCTargetVersion
-  , cabalVer   :: Maybe GHCTargetVersion
+  , cabalVer   :: Maybe Version
-  , hlsVer     :: Maybe GHCTargetVersion
+  , hlsVer     :: Maybe Version
-  , stackVer   :: Maybe GHCTargetVersion
+  , stackVer   :: Maybe Version
-  }
+  } deriving Show

app/ghcup/GHCup/OptParse/Set.hs

@@ -82,7 +82,7 @@ setParser =
           "ghc"
           (   SetGHC
           <$> info
-                (setOpts (Just GHC) <**> helper)
+                (setOpts GHC <**> helper)
                 (  progDesc "Set GHC version"
                 <> footerDoc (Just $ text setGHCFooter)
                 )
@@ -91,7 +91,7 @@ setParser =
            "cabal"
            (   SetCabal
            <$> info
-                 (setOpts (Just Cabal) <**> helper)
+                 (setOpts Cabal <**> helper)
                  (  progDesc "Set Cabal version"
                  <> footerDoc (Just $ text setCabalFooter)
                  )
@@ -100,7 +100,7 @@ setParser =
            "hls"
            (   SetHLS
            <$> info
-                 (setOpts (Just HLS) <**> helper)
+                 (setOpts HLS <**> helper)
                  (  progDesc "Set haskell-language-server version"
                  <> footerDoc (Just $ text setHLSFooter)
                  )
@@ -109,14 +109,14 @@ setParser =
            "stack"
            (   SetStack
            <$> info
-                 (setOpts (Just Stack) <**> helper)
+                 (setOpts Stack <**> helper)
                  (  progDesc "Set stack version"
                  <> footerDoc (Just $ text setStackFooter)
                  )
            )
       )
     )
-    <|> (Right <$> setOpts Nothing)
+    <|> (Right <$> setOpts GHC)
  where
   setGHCFooter :: String
   setGHCFooter = [s|Discussion:
@@ -137,22 +137,25 @@ setParser =
     Sets the the current haskell-language-server version.|]
 
 
-setOpts :: Maybe Tool -> Parser SetOptions
+setOpts :: Tool -> Parser SetOptions
 setOpts tool = SetOptions <$>
     (fromMaybe SetRecommended <$>
       optional (setVersionArgument (Just ListInstalled) tool))
 
-setVersionArgument :: Maybe ListCriteria -> Maybe Tool -> Parser SetToolVersion
+setVersionArgument :: Maybe ListCriteria -> Tool -> Parser SetToolVersion
 setVersionArgument criteria tool =
   argument (eitherReader setEither)
     (metavar "VERSION|TAG|next"
-    <> completer (tagCompleter (fromMaybe GHC tool) ["next"])
+    <> completer (tagCompleter tool ["next"])
-    <> foldMap (completer . versionCompleter criteria) tool)
+    <> (completer . versionCompleter criteria) tool)
  where
   setEither s' =
         parseSet s'
     <|> second SetToolTag (tagEither s')
-    <|> second SetToolVersion (tVersionEither s')
+    <|> se s'
+  se s' = case tool of
+           GHC -> second SetGHCVersion (ghcVersionEither s')
+           _   -> second SetToolVersion (toolVersionEither s')
   parseSet s' = case fmap toLower s' of
                   "next" -> Right SetNext
                   other  -> Left $ "Unknown tag/version " <> other
@@ -261,9 +264,9 @@ set setCommand runAppState runLeanAppState runLogger = case setCommand of
   (Right sopts) -> do
     runLogger (logWarn "This is an old-style command for setting GHC. Use 'ghcup set ghc' instead.")
     setGHC' sopts
-  (Left (SetGHC sopts)) -> setGHC' sopts
+  (Left (SetGHC sopts))   -> setGHC'   sopts
   (Left (SetCabal sopts)) -> setCabal' sopts
-  (Left (SetHLS sopts)) -> setHLS' sopts
+  (Left (SetHLS sopts))   -> setHLS'   sopts
   (Left (SetStack sopts)) -> setStack' sopts
 
  where
@@ -271,7 +274,7 @@ set setCommand runAppState runLeanAppState runLogger = case setCommand of
           -> m ExitCode
   setGHC' SetOptions{ sToolVer } =
     case sToolVer of
-      (SetToolVersion v) -> runSetGHC runLeanAppState (liftE $ setGHC v SetGHCOnly Nothing >> pure v)
+      (SetGHCVersion v) -> runSetGHC runLeanAppState (liftE $ setGHC v SetGHCOnly Nothing >> pure v)
       _ -> runSetGHC runAppState (do
           v <- liftE $ fst <$> fromVersion' sToolVer GHC
           liftE $ setGHC v SetGHCOnly Nothing
@@ -291,17 +294,17 @@ set setCommand runAppState runLeanAppState runLogger = case setCommand of
             -> m ExitCode
   setCabal' SetOptions{ sToolVer } =
     case sToolVer of
-      (SetToolVersion v) -> runSetCabal runLeanAppState (liftE $ setCabal (_tvVersion v) >> pure v)
+      (SetToolVersion v) -> runSetCabal runLeanAppState (liftE $ setCabal v >> pure (mkTVer v))
       _ -> runSetCabal runAppState (do
           v <- liftE $ fst <$> fromVersion' sToolVer Cabal
           liftE $ setCabal (_tvVersion v)
           pure v
         )
       >>= \case
-            VRight GHCTargetVersion{..} -> do
+            VRight v -> do
               runLogger
                 $ logInfo $
-                    "Cabal " <> prettyVer _tvVersion <> " successfully set as default version"
+                    "Cabal " <> prettyVer (_tvVersion v) <> " successfully set as default version"
               pure ExitSuccess
             VLeft  e -> do
               runLogger $ logError $ T.pack $ prettyShow e
@@ -311,17 +314,17 @@ set setCommand runAppState runLeanAppState runLogger = case setCommand of
           -> m ExitCode
   setHLS' SetOptions{ sToolVer } =
     case sToolVer of
-      (SetToolVersion v) -> runSetHLS runLeanAppState (liftE $ setHLS (_tvVersion v) SetHLSOnly Nothing >> pure v)
+      (SetToolVersion v) -> runSetHLS runLeanAppState (liftE $ setHLS v SetHLSOnly Nothing >> pure (mkTVer v))
       _ -> runSetHLS runAppState (do
           v <- liftE $ fst <$> fromVersion' sToolVer HLS
           liftE $ setHLS (_tvVersion v) SetHLSOnly Nothing
           pure v
         )
       >>= \case
-            VRight GHCTargetVersion{..} -> do
+            VRight v -> do
               runLogger
                 $ logInfo $
-                    "HLS " <> prettyVer _tvVersion <> " successfully set as default version"
+                    "HLS " <> prettyVer (_tvVersion v) <> " successfully set as default version"
               pure ExitSuccess
             VLeft  e -> do
               runLogger $ logError $ T.pack $ prettyShow e
@@ -332,17 +335,17 @@ set setCommand runAppState runLeanAppState runLogger = case setCommand of
             -> m ExitCode
   setStack' SetOptions{ sToolVer } =
     case sToolVer of
-      (SetToolVersion v) -> runSetStack runLeanAppState (liftE $ setStack (_tvVersion v) >> pure v)
+      (SetToolVersion v) -> runSetStack runLeanAppState (liftE $ setStack v >> pure (mkTVer v))
       _ -> runSetStack runAppState (do
             v <- liftE $ fst <$> fromVersion' sToolVer Stack
             liftE $ setStack (_tvVersion v)
             pure v
           )
       >>= \case
-            VRight GHCTargetVersion{..} -> do
+            VRight v -> do
               runLogger
                 $ logInfo $
-                    "Stack " <> prettyVer _tvVersion <> " successfully set as default version"
+                    "Stack " <> prettyVer (_tvVersion v) <> " successfully set as default version"
               pure ExitSuccess
             VLeft  e -> do
               runLogger $ logError $ T.pack $ prettyShow e

app/ghcup/GHCup/OptParse/Whereis.hs

@@ -82,7 +82,7 @@ whereisP = subparser
     command
       "ghc"
       (WhereisTool GHC <$> info
-        ( optional (toolVersionArgument Nothing (Just GHC)) <**> helper )
+        ( optional (toolVersionTagArgument Nothing (Just GHC)) <**> helper )
         ( progDesc "Get GHC location"
         <> footerDoc (Just $ text whereisGHCFooter ))
       )
@@ -90,7 +90,7 @@ whereisP = subparser
      command
       "cabal"
       (WhereisTool Cabal <$> info
-        ( optional (toolVersionArgument Nothing (Just Cabal)) <**> helper )
+        ( optional (toolVersionTagArgument Nothing (Just Cabal)) <**> helper )
         ( progDesc "Get cabal location"
         <> footerDoc (Just $ text whereisCabalFooter ))
       )
@@ -98,7 +98,7 @@ whereisP = subparser
      command
       "hls"
       (WhereisTool HLS <$> info
-        ( optional (toolVersionArgument Nothing (Just HLS)) <**> helper )
+        ( optional (toolVersionTagArgument Nothing (Just HLS)) <**> helper )
         ( progDesc "Get HLS location"
         <> footerDoc (Just $ text whereisHLSFooter ))
       )
@@ -106,7 +106,7 @@ whereisP = subparser
      command
       "stack"
       (WhereisTool Stack <$> info
-        ( optional (toolVersionArgument Nothing (Just Stack)) <**> helper )
+        ( optional (toolVersionTagArgument Nothing (Just Stack)) <**> helper )
         ( progDesc "Get stack location"
         <> footerDoc (Just $ text whereisStackFooter ))
       )
@@ -268,7 +268,7 @@ whereis :: ( Monad m
 whereis whereisCommand whereisOptions runAppState leanAppstate runLogger = do
   Dirs{ .. }  <- runReaderT getDirs leanAppstate
   case (whereisCommand, whereisOptions) of
-    (WhereisTool tool (Just (ToolVersion v)), WhereisOptions{..}) ->
+    (WhereisTool tool (Just (GHCVersion v)), WhereisOptions{..}) ->
       runLeanWhereIs leanAppstate (do
         loc <- liftE $ whereIsTool tool v
         if directory
@@ -282,6 +282,20 @@ whereis whereisCommand whereisOptions runAppState leanAppstate runLogger = do
               VLeft e -> do
                 runLogger $ logError $ T.pack $ prettyShow e
                 pure $ ExitFailure 30
+    (WhereisTool tool (Just (ToolVersion v)), WhereisOptions{..}) ->
+      runLeanWhereIs leanAppstate (do
+        loc <- liftE $ whereIsTool tool (mkTVer v)
+        if directory
+        then pure $ takeDirectory loc
+        else pure loc
+        )
+        >>= \case
+              VRight r -> do
+                liftIO $ putStr r
+                pure ExitSuccess
+              VLeft e -> do
+                runLogger $ logError $ T.pack $ prettyShow e
+                pure $ ExitFailure 30
 
     (WhereisTool tool whereVer, WhereisOptions{..}) -> do
       runWhereIs runAppState (do

app/ghcup/Main.hs

@@ -14,6 +14,8 @@ 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
@@ -337,14 +339,16 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
   alreadyInstalling (Install (Left (InstallHLS InstallOptions{..})))     (HLS, ver)   = cmp' HLS instVer ver
   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
+    (GHC, ver)   = cmp' GHC (Just $ GHCVersion (mkTVer over)) ver
-  alreadyInstalling (Compile (CompileGHC GHCCompileOptions{ targetGhc = Left tver }))
+  alreadyInstalling (Compile (CompileGHC GHCCompileOptions{ targetGhc = GHC.SourceDist tver }))
-    (GHC, ver)   = cmp' GHC (Just $ ToolVersion (mkTVer tver)) ver
+    (GHC, ver)   = cmp' GHC (Just $ ToolVersion tver) ver
-  alreadyInstalling (Compile (CompileHLS HLSCompileOptions{ ovewrwiteVer = Just over }))
+  alreadyInstalling (Compile (CompileHLS HLSCompileOptions{ ovewrwiteVer = Right over }))
-    (HLS, ver)   = cmp' HLS (Just $ ToolVersion (mkTVer over)) ver
+    (HLS, ver)   = cmp' HLS (Just $ ToolVersion over) ver
-  alreadyInstalling (Compile (CompileHLS HLSCompileOptions{ targetHLS = Left tver }))
+  alreadyInstalling (Compile (CompileHLS HLSCompileOptions{ targetHLS = HLS.SourceDist tver }))
-    (HLS, ver)   = cmp' HLS (Just $ ToolVersion (mkTVer tver)) ver
+    (HLS, ver)   = cmp' HLS (Just $ ToolVersion tver) ver
-  alreadyInstalling (Upgrade _ _ _) (GHCup, _) = pure True
+  alreadyInstalling (Compile (CompileHLS HLSCompileOptions{ targetHLS = HLS.HackageDist tver }))
+    (HLS, ver)   = cmp' HLS (Just $ ToolVersion tver) ver
+  alreadyInstalling (Upgrade {}) (GHCup, _) = pure True
   alreadyInstalling _ _ = pure False
 
   cmp' :: ( HasLog env

docs/about.md

@@ -74,12 +74,15 @@ cabal-install/HLS/stack are installed in `~/.ghcup/bin/<tool>-<ver>` and have un
 
 ## Known users
 
-* Github actions:
+* CI:
-	- [actions/virtual-environments](https://github.com/actions/virtual-environments)
+	- [Github actions/virtual-environments](https://github.com/actions/virtual-environments)
-	- [haskell/actions/setup](https://github.com/haskell/actions/tree/main/setup)
+	- [Github haskell/actions/setup](https://github.com/haskell/actions/tree/main/setup)
+	- [haskell-ci](https://github.com/haskell-CI/haskell-ci)
 * 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

@@ -4,7 +4,7 @@ This is a more in-depth guide specific to GHCup. `ghcup --help` is your friend.
 
 ## Basic usage
 
-For the simple interactive TUI (not available on windows), run:
+For the simple, interactive, text-based user interface (TUI) (not available on windows), run:
 
 ```sh
 ghcup tui
@@ -186,6 +186,51 @@ url-source:
 
 # More on installation
 
+## Customisation of the installation scripts
+
+The scripts offered to install GHCup are available here:
+
+* [bootstrap-haskell](https://gitlab.haskell.org/haskell/ghcup-hs/-/blob/master/scripts/bootstrap/bootstrap-haskell#L7)
+  for Unix-like operating systems
+* [bootstrap-haskell.ps1](https://gitlab.haskell.org/haskell/ghcup-hs/-/blob/master/scripts/bootstrap/bootstrap-haskell.ps1#L17)
+  for Windows (PowerShell). This will, in turn, run the final bootstrap script
+  (by default, that for the Unix-like operating systems).
+
+The effect of the scripts can be customised by setting one or more
+`BOOTSTRAP_HASKELL_*` environment variables (as set out in the first script)
+and, in the case of Windows, by specifying parameters (as set out in the
+PowerShell script).
+
+For example, you can toggle:
+
+* non-interactive installation
+* a more verbose installation
+* whether to install only GHCup (and, on Windows, MSYS2)
+* not to trigger the upgrade of GHCup
+* whether to install the latest version of HLS
+* whether to install the latest version of Stack
+* whether to respect the XDG Base Directory Specification
+* whether to adjust (prepend) the PATH in `bashrc`
+* on Windows, whether to adjust MINGW paths in `cabal.config`
+
+You can also specify:
+
+* the GHC version to install
+* the Cabal version to install
+* which downloader to use (the default is `curl`)
+* the base URL for the download of the GHCup binary distribution
+
+On Windows, you can also use the parameters to:
+
+* toggle whether to overwrite a previous installation
+* specify the GHCup installation root directory
+* specify the Cabal root directory
+* specify the directory of an existing installation of MSYS2 (for example,
+  the one supplied by Stack)
+* specify the URL of the final bootstrap script
+* toggle whether to run the final bootstrap script via `bash` (instead of in a
+  new MSYS2 shell)
+
 ## Installing custom bindists
 
 There are a couple of good use cases to install custom bindists:
@@ -202,7 +247,9 @@ 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 GHC from source
+## Compiling from source
+
+### GHC
 
 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.
@@ -214,6 +261,47 @@ 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
@@ -258,7 +346,9 @@ Examples:
 
 ## Continuous integration
 
-On windows, ghcup can be installed automatically on a CI runner non-interactively like so:
+On Windows, GHCup can be installed automatically on a CI runner
+non-interactively, as below. The paramaters to the PowerShell script are
+specified positionally, after `-ArgumentList`:
 
 ```ps
 Set-ExecutionPolicy Bypass -Scope Process -Force;[System.Net.ServicePointManager]::SecurityProtocol = [System.Net.ServicePointManager]::SecurityProtocol -bor 3072;Invoke-Command -ScriptBlock ([ScriptBlock]::Create((Invoke-WebRequest https://www.haskell.org/ghcup/sh/bootstrap-haskell.ps1 -UseBasicParsing))) -ArgumentList $false,$true,$true,$false,$false,$false,$false,"C:\"
@@ -270,12 +360,10 @@ On linux/darwin/freebsd, run the following on your runner:
 curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | BOOTSTRAP_HASKELL_NONINTERACTIVE=1 BOOTSTRAP_HASKELL_MINIMAL=1 sh
 ```
 
-This will just install `ghcup` and on windows additionally `msys2`.
+This will just install `ghcup` and on Windows additionally MSYS2.
 
-For the full list of env variables and parameters to tweak the script behavior, see:
+See the installation scripts referred to above for the full list of environment
-
+variables and, in the case of Windows, parameters to tweak the script behavior.
-* [bootstrap-haskell for linux/darwin/freebsd](https://gitlab.haskell.org/haskell/ghcup-hs/-/blob/master/scripts/bootstrap/bootstrap-haskell#L7)
-* [bootstrap-haskell.ps1 for windows](https://gitlab.haskell.org/haskell/ghcup-hs/-/blob/master/scripts/bootstrap/bootstrap-haskell.ps1#L17)
 
 ### github workflows
 
@@ -324,3 +412,34 @@ ghcup run --ghc 8.10.7 --cabal latest --hls latest --stack latest --install -- c
 ```
 
 This will execute vscode with GHC set to 8.10.7 and all other tools to their latest version.
+
+# Troubleshooting
+
+## Script immediately exits on windows
+
+There are two possible reasons:
+
+1. your company blocks the script (some have a whitelist)... ask your administrator
+2. your Antivirus or Windows Defender interfere with the installation. Disable them temporarily.
+
+## C compiler cannot create executables
+
+### Darwin
+
+You need to update your XCode command line tools, e.g. [like this](https://stackoverflow.com/questions/34617452/how-to-update-xcode-from-command-line).
+
+## Certificate authority errors (curl)
+
+If your certificates are outdated or improperly configured, curl may be unable
+to download ghcup.
+
+There are two known workarounds:
+
+1. Tell curl to ignore certificate errors (dangerous): `curl -k https://gitlab.haskell.org/haskell/ghcup-hs/-/raw/master/scripts/bootstrap/bootstrap-haskell | GHCUP_CURL_OPTS="-k" sh`
+2. Try to use wget instead: `wget -O /dev/stdout https://gitlab.haskell.org/haskell/ghcup-hs/-/raw/master/scripts/bootstrap/bootstrap-haskell | BOOTSTRAP_HASKELL_DOWNLOADER=wget sh`
+
+On windows, you can disable curl like so:
+
+```pwsh
+Set-ExecutionPolicy Bypass -Scope Process -Force;[System.Net.ServicePointManager]::SecurityProtocol = [System.Net.ServicePointManager]::SecurityProtocol -bor 3072;Invoke-Command -ScriptBlock ([ScriptBlock]::Create((Invoke-WebRequest https://www.haskell.org/ghcup/sh/bootstrap-haskell.ps1 -UseBasicParsing))) -ArgumentList $true,$false,$false,$false,$false,$false,$false,"","","","",$true
+```

docs/index.md

@@ -57,7 +57,7 @@ hide:
 </section>
 
 <p id="help" class="ghcup-help">
-  Need help? Ask on
+  Need help? Check the <a href="guide/#troubleshooting">Troubleshooting section</a> or ask on
   <span>
     <a href="https://kiwiirc.com/nextclient/irc.libera.chat/?nick=Guest%7C?#haskell,#haskell-ghcup">
       <img src="irc.svg" alt="" />

docs/install.md

@@ -200,6 +200,14 @@ 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

@@ -69,6 +69,7 @@ library
     GHCup.Prelude.Process
     GHCup.Prelude.String.QQ
     GHCup.Prelude.Version.QQ
+    GHCup.Prompts
     GHCup.Requirements
     GHCup.Stack
     GHCup.Types
@@ -109,7 +110,7 @@ library
     , base16-bytestring     >=0.1.1.6    && <1.1
     , binary                ^>=0.8.6.0
     , bytestring            >=0.10       && <0.12
-    , Cabal                 ^>=3.6.2.0
+    , Cabal                 ^>=3.0.0.0 || ^>=3.2.0.0 || ^>=3.4.0.0 || ^>=3.6.0.0
     , case-insensitive      ^>=1.2.1.0
     , casing                ^>=0.1.4.1
     , containers            ^>=0.6
@@ -164,8 +165,10 @@ library
     cpp-options:   -DIS_WINDOWS
     other-modules:
       GHCup.Prelude.File.Windows
-      GHCup.Prelude.Process.Windows
       GHCup.Prelude.Windows
+    -- GHCup.OptParse.Run uses this
+    exposed-modules:
+      GHCup.Prelude.Process.Windows
 
     build-depends:
       , bzlib

lib/GHCup.hs

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

lib/GHCup/Errors.hs

@@ -137,7 +137,7 @@ data AlreadyInstalled = AlreadyInstalled Tool Version
 
 instance Pretty AlreadyInstalled where
   pPrint (AlreadyInstalled tool ver') =
-    pPrint tool <+> text "-" <+> pPrint ver' <+> text "is already installed;"
+    (pPrint tool <> text "-" <> pPrint ver') <+> text "is already installed;"
     <+> text "if you really want to reinstall it, you may want to run 'ghcup install cabal --force" <+> (pPrint ver' <> text "'")
 
 

lib/GHCup/GHC.hs

@@ -80,6 +80,12 @@ import qualified Data.Text.Encoding            as E
 import qualified Text.Megaparsec               as MP
 
 
+data GHCVer v = SourceDist v
+              | GitDist GitBranch
+              | RemoteDist URI
+
+
+
     ---------------------
     --[ Tool fetching ]--
     ---------------------
@@ -295,8 +301,9 @@ installUnpackedGHC path inst ver forceInstall addConfArgs
   | otherwise = do
       PlatformRequest {..} <- lift getPlatformReq
 
-      let alpineArgs
+      let ldOverride
-           | ver >= [vver|8.2.2|], Linux Alpine <- _rPlatform
+           | ver >= [vver|8.2.2|]
+           , _rPlatform `elem` [Linux Alpine, Darwin]
            = ["--disable-ld-override"]
            | otherwise
            = []
@@ -304,7 +311,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))
+                        : (ldOverride <> (T.unpack <$> addConfArgs))
                        )
                        (Just $ fromGHCupPath path)
                        "ghc-configure"
@@ -566,8 +573,11 @@ rmGHCVer ver = do
       lift $ recycleFile f
       when (not (null survivors)) $ throwE $ UninstallFailed dir survivors
     Nothing -> do
-      lift $ logInfo $ "Removing legacy directory recursively: " <> T.pack dir
+      isDir <- liftIO $ doesDirectoryExist dir
-      lift $ recyclePathForcibly dir'
+      isSyml <- liftIO $ handleIO (\_ -> pure False) $ pathIsSymbolicLink dir
+      when (isDir && not isSyml) $ do
+        lift $ logInfo $ "Removing legacy directory recursively: " <> T.pack dir
+        recyclePathForcibly dir'
 
   v' <-
     handle
@@ -604,7 +614,7 @@ compileGHC :: ( MonadMask m
               , MonadUnliftIO m
               , MonadFail m
               )
-           => Either GHCTargetVersion GitBranch          -- ^ version to install
+           => GHCVer GHCTargetVersion
            -> Maybe Version            -- ^ overwrite version
            -> Either Version FilePath  -- ^ version to bootstrap with
            -> Maybe Int                -- ^ jobs
@@ -647,7 +657,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
 
     (workdir, tmpUnpack, tver) <- case targetGhc of
       -- unpack from version tarball
-      Left tver -> do
+      SourceDist tver -> do
         lift $ logDebug $ "Requested to compile: " <> tVerToText tver <> " with " <> either prettyVer T.pack bstrap
 
         -- download source tarball
@@ -668,8 +678,31 @@ 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
-      Right GitBranch{..} -> do
+      GitDist 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
@@ -681,28 +714,46 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
                     , "origin"
                     , fromString rep ]
 
-          let fetch_args =
+          -- figure out if we can do a shallow clone
-                    [ "fetch"
+          remoteBranches <- catchE @ProcessError @'[PatchFailed, ProcessError, NotFoundInPATH, DigestError, DownloadFailed, GPGError] @'[PatchFailed, NotFoundInPATH, DigestError, DownloadFailed, GPGError] (\(_ :: ProcessError) -> pure [])
-                    , "--depth"
+              $ fmap processBranches $ gitOut ["ls-remote", "--heads", "origin"] (fromGHCupPath tmpUnpack)
-                    , "1"
+          let shallow_clone
-                    , "--quiet"
+                | isCommitHash ref                     = True
-                    , "origin"
+                | fromString ref `elem` remoteBranches = True
-                    , fromString ref ]
+                | 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"                ]
           lEM $ git fetch_args
 
-          lEM $ git [ "checkout", "FETCH_HEAD" ]
+          -- initial checkout
-          lEM $ git [ "submodule", "update", "--init", "--depth", "1" ]
+          lEM $ git [ "checkout", fromString ref ]
-          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))
 
-        liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform (fromGHCupPath tmpUnpack)
+          -- gather some info
-        lift $ logInfo $ "Git version " <> T.pack ref <> " corresponds to GHC version " <> prettyVer tver
+          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 [ "submodule", "update", "--init", "--depth", "1" ]
+
+          -- apply patches
+          liftE $ applyAnyPatch patches (fromGHCupPath tmpUnpack)
+
+          -- 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
 
         pure (tmpUnpack, tmpUnpack, GHCTargetVersion Nothing tver)
     -- the version that's installed may differ from the
@@ -767,11 +818,29 @@ 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
-         Left (GHCTargetVersion (Just _) _) -> cross_mk
+         SourceDist (GHCTargetVersion (Just _) _) -> cross_mk
          _ -> default_mk
 
   compileHadrianBindist :: ( MonadReader env m
@@ -948,7 +1017,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
 
    -- for cross, we need Stage1Only
     case targetGhc of
-      Left (GHCTargetVersion (Just _) _) -> when ("Stage1Only = YES" `notElem` lines') $ throwE
+      SourceDist (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,6 +71,12 @@ import qualified Text.Megaparsec               as MP
 import Text.PrettyPrint.HughesPJClass (prettyShow)
 
 
+data HLSVer = SourceDist Version
+            | GitDist GitBranch
+            | HackageDist Version
+            | RemoteDist URI
+
+
 
     --------------------
     --[ Installation ]--
@@ -324,13 +330,14 @@ compileHLS :: ( MonadMask m
               , MonadUnliftIO m
               , MonadFail m
               )
-           => Either Version GitBranch
+           => HLSVer
            -> [Version]
            -> Maybe Int
-           -> Maybe Version
+           -> Either Bool Version
            -> InstallDir
            -> Maybe (Either FilePath URI)
            -> Maybe URI
+           -> Bool
            -> Maybe (Either FilePath [URI])  -- ^ patches
            -> [Text]                   -- ^ additional args to cabal install
            -> Excepts '[ NoDownload
@@ -343,15 +350,18 @@ compileHLS :: ( MonadMask m
                        , BuildFailed
                        , NotInstalled
                        ] m Version
-compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal patches cabalArgs = do
+compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal updateCabal 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, tver) <- case targetHLS of
+  (workdir, tmpUnpack, tver, git_describe) <- case targetHLS of
     -- unpack from version tarball
-    Left tver -> do
+    SourceDist tver -> do
       lift $ logDebug $ "Requested to compile: " <> prettyVer tver
 
       -- download source tarball
@@ -369,13 +379,50 @@ compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal patc
                        (liftE . intoSubdir tmpUnpack)
                        (view dlSubdir dlInfo)
 
-      pure (workdir, tver)
+      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)
 
     -- clone from git
-    Right GitBranch{..} -> do
+    GitDist GitBranch{..} -> do
       tmpUnpack <- lift mkGhcupTmpDir
       let git args = execLogged "git" ("--no-pager":args) (Just $ fromGHCupPath tmpUnpack) "git" Nothing
-      tver <- reThrowAll @_ @'[ProcessError] DownloadFailed $ do
+      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" ]
@@ -384,36 +431,56 @@ compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal patc
                   , "origin"
                   , fromString rep ]
 
-        let fetch_args =
+        -- figure out if we can do a shallow clone
-                  [ "fetch"
+        remoteBranches <- catchE @ProcessError @'[ProcessError] @'[] (\_ -> pure [])
-                  , "--depth"
+            $ fmap processBranches $ gitOut ["ls-remote", "--heads", "origin"] (fromGHCupPath tmpUnpack)
-                  , "1"
+        let shallow_clone
-                  , "--quiet"
+              | gitDescribeRequested                 = False
-                  , "origin"
+              | isCommitHash ref                     = True
-                  , fromString ref ]
+              | 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"                ]
         lEM $ git fetch_args
 
-        lEM $ git [ "checkout", "FETCH_HEAD" ]
+        -- checkout
-        (Just gpd) <- parseGenericPackageDescriptionMaybe <$> liftIO (B.readFile (fromGHCupPath tmpUnpack </> "haskell-language-server.cabal"))
+        lEM $ git [ "checkout", fromString ref ]
-        pure . (\c -> Version Nothing c [] Nothing)
-          . NE.fromList . fmap (NE.fromList . (:[]) . digits . fromIntegral)
-          . versionNumbers
-          . pkgVersion
-          . package
-          . packageDescription
-          $ gpd
 
-      liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform (fromGHCupPath tmpUnpack)
+        -- gather some info
-      lift $ logInfo $ "Git version " <> T.pack ref <> " corresponds to HLS version " <> prettyVer tver
+        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")
 
-      pure (tmpUnpack, 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)
 
   -- the version that's installed may differ from the
   -- compiled version, so the user can overwrite it
-  let installVer = fromMaybe tver ov
+  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
 
   liftE $ runBuildAction
-    workdir
+    tmpUnpack
     (reThrowAll @_ @'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError, FileAlreadyExistsError, CopyError] @'[BuildFailed] (BuildFailed $ fromGHCupPath workdir) $ do
       let tmpInstallDir = fromGHCupPath workdir </> "out"
       liftIO $ createDirRecursive' tmpInstallDir
@@ -429,14 +496,22 @@ compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal patc
               pure "cabal.project"
           | otherwise -> pure (takeFileName cp)
         Just (Right uri) -> do
-          tmpUnpack <- lift withGHCupTmpDir
+          tmpUnpack' <- lift withGHCupTmpDir
-          cp <- liftE $ download uri Nothing Nothing (fromGHCupPath tmpUnpack) (Just "cabal.project") False
+          cp <- liftE $ download uri Nothing Nothing (fromGHCupPath tmpUnpack') (Just "cabal.project") False
           copyFileE cp (fromGHCupPath workdir </> "cabal.project") False
           pure "cabal.project"
-        Nothing -> 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"
       forM_ cabalProjectLocal $ \uri -> do
-        tmpUnpack <- lift withGHCupTmpDir
+        tmpUnpack' <- lift withGHCupTmpDir
-        cpl <- liftE $ download uri Nothing Nothing (fromGHCupPath tmpUnpack) (Just (cp <.> "local")) False
+        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)
@@ -464,7 +539,7 @@ compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal patc
         pure ghcInstallDir
 
       forM_ artifacts $ \artifact -> do
-        logInfo $ T.pack (show artifact)
+        logDebug $ 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)
@@ -479,6 +554,10 @@ compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal patc
     )
 
   pure installVer
+ where
+  gitDescribeRequested = case ov of
+                           Left b -> b
+                           _      -> False
 
 
     -----------------
@@ -614,8 +693,11 @@ rmHLSVer ver = do
       lift $ recycleFile f
       when (not (null survivors)) $ throwE $ UninstallFailed hlsDir survivors
     Nothing -> do
-      lift $ logInfo $ "Removing legacy directory recursively: " <> T.pack hlsDir
+      isDir <- liftIO $ doesDirectoryExist hlsDir
-      recyclePathForcibly hlsDir'
+      isSyml <- liftIO $ handleIO (\_ -> pure False) $ pathIsSymbolicLink hlsDir
+      when (isDir && not isSyml) $ do
+        lift $ logInfo $ "Removing legacy directory recursively: " <> T.pack hlsDir
+        recyclePathForcibly hlsDir'
 
   when (Just ver == isHlsSet) $ do
     -- set latest hls
@@ -623,3 +705,19 @@ 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,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
+    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/Prompts.hs

@@ -0,0 +1,28 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE FlexibleContexts #-}
+
+module GHCup.Prompts
+  ( PromptQuestion,
+    PromptResponse (..),
+    getUserPromptResponse,
+  )
+where
+
+import Control.Monad.Reader
+import qualified Data.Text.IO as TIO
+import GHCup.Prelude.Logger
+import GHCup.Types.Optics
+import GHCup.Types (PromptQuestion, PromptResponse(..))
+
+getUserPromptResponse :: ( HasLog env
+                         , MonadReader env m
+                         , MonadIO m)
+                      => PromptQuestion
+                      -> m PromptResponse
+
+getUserPromptResponse prompt = do
+  logInfo prompt
+  resp <- liftIO TIO.getLine
+  if resp `elem` ["YES", "yes", "y", "Y"]
+    then pure PromptYes
+    else pure PromptNo

lib/GHCup/Types.hs

@@ -407,6 +407,9 @@ data AppState = AppState
 
 instance NFData AppState
 
+fromAppState :: AppState -> LeanAppState
+fromAppState AppState {..} = LeanAppState {..}
+
 data LeanAppState = LeanAppState
   { settings :: Settings
   , dirs :: Dirs
@@ -654,10 +657,7 @@ isSafeDir (IsolateDirResolved _) = False
 isSafeDir (GHCupDir _)           = True
 isSafeDir (GHCupBinDir _)        = False
 
+type PromptQuestion = Text
 
-
+data PromptResponse = PromptYes | PromptNo
-
+  deriving (Show, Eq)
-
-
-
-

lib/GHCup/Utils.hs

@@ -61,6 +61,7 @@ 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
@@ -1096,7 +1097,8 @@ runBuildAction bdir action = do
 
 -- | Clean up the given directory if the action fails,
 -- depending on the Settings.
-cleanUpOnError :: ( MonadReader env m
+cleanUpOnError :: forall e m a env .
+                  ( MonadReader env m
                   , HasDirs env
                   , HasSettings env
                   , MonadIO m
@@ -1275,3 +1277,35 @@ 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

@@ -16,6 +16,7 @@
 #   * BOOTSTRAP_HASKELL_INSTALL_HLS - whether to install latest hls
 #   * BOOTSTRAP_HASKELL_ADJUST_BASHRC - whether to adjust PATH in bashrc (prepend)
 #   * BOOTSTRAP_HASKELL_ADJUST_CABAL_CONFIG - whether to adjust mingw paths in cabal.config on windows
+#   * BOOTSTRAP_HASKELL_DOWNLOADER - which downloader to use (default: curl)
 #   * GHCUP_BASE_URL - the base url for ghcup binary download (use this to overwrite https://downloads.haskell.org/~ghcup with a mirror)
 
 # License: LGPL-3.0
@@ -30,6 +31,7 @@ ghver="0.1.17.8"
 : "${GHCUP_BASE_URL:=https://downloads.haskell.org/~ghcup}"
 
 export GHCUP_SKIP_UPDATE_CHECK=yes
+: "${BOOTSTRAP_HASKELL_DOWNLOADER:=curl}"
 
 case "${plat}" in
         MSYS*|MINGW*)
@@ -133,6 +135,19 @@ _eghcup() {
     fi
 }
 
+ecabal() {
+	edo _ecabal "$@"
+}
+
+_ecabal() {
+    if [ -n "${CABAL_BIN}" ] ; then
+        "${CABAL_BIN}" "$@"
+    else
+        # shellcheck disable=SC2086
+        "${GHCUP_BIN}/cabal" "$@"
+    fi
+}
+
 _done() {
 	echo
 	echo "==============================================================================="
@@ -313,11 +328,35 @@ download_ghcup() {
     esac
     case "${plat}" in
         MSYS*|MINGW*)
-			edo curl -Lf "${_url}" > "${GHCUP_BIN}"/ghcup.exe
+            case "${BOOTSTRAP_HASKELL_DOWNLOADER}" in
+                "curl")
+	                # shellcheck disable=SC2086
+                    edo curl -Lf ${GHCUP_CURL_OPTS} "${_url}" > "${GHCUP_BIN}"/ghcup.exe
+                    ;;
+                "wget")
+	                # shellcheck disable=SC2086
+                    edo wget -O /dev/stdout ${GHCUP_WGET_OPTS} "${_url}" > "${GHCUP_BIN}"/ghcup.exe
+                    ;;
+                *)
+                    die "Unknown downloader: ${BOOTSTRAP_HASKELL_DOWNLOADER}"
+                    ;;
+            esac
 			edo chmod +x "${GHCUP_BIN}"/ghcup.exe
 			;;
 		*)
-			edo curl -Lf "${_url}" > "${GHCUP_BIN}"/ghcup
+            case "${BOOTSTRAP_HASKELL_DOWNLOADER}" in
+                "curl")
+	                # shellcheck disable=SC2086
+                    edo curl -Lf ${GHCUP_CURL_OPTS} "${_url}" > "${GHCUP_BIN}"/ghcup
+                    ;;
+                "wget")
+	                # shellcheck disable=SC2086
+                    edo wget -O /dev/stdout ${GHCUP_WGET_OPTS} "${_url}" > "${GHCUP_BIN}"/ghcup
+                    ;;
+                *)
+                    die "Unknown downloader: ${BOOTSTRAP_HASKELL_DOWNLOADER}"
+                    ;;
+            esac
 			edo chmod +x "${GHCUP_BIN}"/ghcup
 			;;
 	esac
@@ -344,6 +383,17 @@ download_ghcup() {
 
 	# shellcheck disable=SC1090
     edo . "${GHCUP_DIR}"/env
+    case "${BOOTSTRAP_HASKELL_DOWNLOADER}" in
+        "curl")
+            eghcup config set downloader Curl
+            ;;
+        "wget")
+            eghcup config set downloader Wget
+            ;;
+        *)
+            die "Unknown downloader: ${BOOTSTRAP_HASKELL_DOWNLOADER}"
+            ;;
+    esac
     eghcup upgrade
 }
 
@@ -537,7 +587,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() {
@@ -688,7 +738,7 @@ find_shell
 echo
 echo "Welcome to Haskell!"
 echo
-echo "This script will download and install the following binaries:"
+echo "This script can 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"
@@ -771,7 +821,7 @@ else # don't install ghc and cabal
 				# we'll remove it afterwards
 				tmp_dir="$(mktemp -d)"
 				eghcup --cache install cabal -i "${tmp_dir}" "${BOOTSTRAP_HASKELL_CABAL_VERSION}"
-				PATH="${tmp_dir}:$PATH" do_cabal_config_init $ask_cabal_config_init_answer
+				CABAL_BIN="${tmp_dir}/cabal" do_cabal_config_init $ask_cabal_config_init_answer
 				rm "${tmp_dir}/cabal"
 				unset tmp_dir
 				;;

scripts/bootstrap/bootstrap-haskell.ps1

@@ -36,7 +36,9 @@ param (
     # Instead of installing a new MSys2, use an existing installation
     [string]$ExistingMsys2Dir,
     # Specify the cabal root directory (default: '$InstallDir\cabal')
-    [string]$CabalDir
+    [string]$CabalDir,
+    # Whether to disable use of curl.exe
+    [switch]$DisableCurl
 )
 
 $Silent = !$Interactive
@@ -242,7 +244,7 @@ if ($Silent -and !($InstallDir)) {
 	Print-Msg -color Magenta -msg (@'
 Welcome to Haskell!
 
-This script will download and install the following programs:
+This script can 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
@@ -425,7 +427,7 @@ if (!(Test-Path -Path ('{0}' -f $MsysDir))) {
     $archive = 'msys2-x86_64-latest.sfx.exe'
     $archivePath = ('{0}\{1}' -f ([IO.Path]::GetTempPath()), "$archive")
     
-    if (Get-Command -Name 'curl.exe' -ErrorAction SilentlyContinue) {
+    if ((Get-Command -Name 'curl.exe' -ErrorAction SilentlyContinue) -and !($DisableCurl)) {
       Exec "curl.exe" '-o' "$archivePath" ('https://repo.msys2.org/distrib/{0}' -f "$archive")
     } else {
       Get-FileWCSynchronous -url ('https://repo.msys2.org/distrib/{0}' -f $archive) -destinationFolder ([IO.Path]::GetTempPath()) -includeStats
@@ -591,10 +593,17 @@ if ($Minimal) {
   $MinimalExport = 'export BOOTSTRAP_HASKELL_MINIMAL=1 ;'
 }
 
-if ((Get-Process -ID $PID).ProcessName.StartsWith("bootstrap-haskell") -Or $InBash) {
+if ($DisableCurl) {
-  Exec "$Bash" '-lc' ('{4} {6} {7} {8} {9} [ -n ''{1}'' ] && export GHCUP_MSYS2=$(cygpath -m ''{1}'') ; [ -n ''{2}'' ] && export GHCUP_INSTALL_BASE_PREFIX=$(cygpath -m ''{2}/'') ; export PATH=$(cygpath -u ''{3}/bin''):$PATH ; export CABAL_DIR=''{5}'' ; [[ ''{0}'' = https* ]]  && curl --proto ''=https'' --tlsv1.2 -sSf {0} | bash || cat $(cygpath -m ''{0}'') | bash' -f $BootstrapUrl, $MsysDir, $GhcupBasePrefix, $GhcupDir, $SilentExport, $CabalDirFull, $StackInstallExport, $HLSInstallExport, $AdjustCabalConfigExport, $MinimalExport)
+  $BootstrapDownloader = 'export BOOTSTRAP_HASKELL_DOWNLOADER=wget ;'
+  $DownloadScript = 'wget -O /dev/stdout'
 } else {
-  Exec "$Msys2Shell" '-mingw64' '-mintty' '-c' ('{4} {6} {7} {8} {9} [ -n ''{1}'' ] && export GHCUP_MSYS2=$(cygpath -m ''{1}'') ; [ -n ''{2}'' ] && export GHCUP_INSTALL_BASE_PREFIX=$(cygpath -m ''{2}/'') ; export PATH=$(cygpath -u ''{3}/bin''):$PATH ; export CABAL_DIR=''{5}'' ; trap ''echo Press any key to exit && read -n 1 && exit'' 2 ; [[ ''{0}'' = https* ]]  && curl --proto ''=https'' --tlsv1.2 -sSf {0} | bash || cat $(cygpath -m ''{0}'') | bash ; echo ''Press any key to exit'' && read -n 1' -f $BootstrapUrl, $MsysDir, $GhcupBasePrefix, $GhcupDir, $SilentExport, $CabalDirFull, $StackInstallExport, $HLSInstallExport, $AdjustCabalConfigExport, $MinimalExport)
+  $DownloadScript = 'curl --proto ''=https'' --tlsv1.2 -sSf'
+}
+
+if ((Get-Process -ID $PID).ProcessName.StartsWith("bootstrap-haskell") -Or $InBash) {
+  Exec "$Bash" '-lc' ('{4} {6} {7} {8} {9} {10} [ -n ''{1}'' ] && export GHCUP_MSYS2=$(cygpath -m ''{1}'') ; [ -n ''{2}'' ] && export GHCUP_INSTALL_BASE_PREFIX=$(cygpath -m ''{2}/'') ; export PATH=$(cygpath -u ''{3}/bin''):$PATH ; export CABAL_DIR=''{5}'' ; [[ ''{0}'' = https* ]]  && {11} {0} | bash || cat $(cygpath -m ''{0}'') | bash' -f $BootstrapUrl, $MsysDir, $GhcupBasePrefix, $GhcupDir, $SilentExport, $CabalDirFull, $StackInstallExport, $HLSInstallExport, $AdjustCabalConfigExport, $MinimalExport, $BootstrapDownloader, $DownloadScript)
+} else {
+  Exec "$Msys2Shell" '-mingw64' '-mintty' '-c' ('{4} {6} {7} {8} {9} {10} [ -n ''{1}'' ] && export GHCUP_MSYS2=$(cygpath -m ''{1}'') ; [ -n ''{2}'' ] && export GHCUP_INSTALL_BASE_PREFIX=$(cygpath -m ''{2}/'') ; export PATH=$(cygpath -u ''{3}/bin''):$PATH ; export CABAL_DIR=''{5}'' ; trap ''echo Press any key to exit && read -n 1 && exit'' 2 ; [[ ''{0}'' = https* ]]  && {11} {0} | bash || cat $(cygpath -m ''{0}'') | bash ; echo ''Press any key to exit'' && read -n 1' -f $BootstrapUrl, $MsysDir, $GhcupBasePrefix, $GhcupDir, $SilentExport, $CabalDirFull, $StackInstallExport, $HLSInstallExport, $AdjustCabalConfigExport, $MinimalExport, $BootstrapDownloader, $DownloadScript)
 }