Fix parsing issues with 'ghcup run' and non-PVP versions

This is a major refactor of some CLI code. We try to distinguish
GHC versions from other versions, so that we can use distinct parsers.

Hopefully this doesn't introduce new bugs.

This also forces ghcup run to use the new internal ~/.ghcup/tmp dir.

app/ghcup/GHCup/OptParse/ChangeLog.hs

@@ -58,7 +58,7 @@ data ChangeLogOptions = ChangeLogOptions
     --[ Parsers ]--
     ---------------
 
-          
+
 changelogP :: Parser ChangeLogOptions
 changelogP =
   (\x y -> ChangeLogOptions x y)
@@ -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,11 +452,9 @@ tagCompleter tool add = listIOCompleter $ do
       pure $ nub $ (add ++) $ fmap tagToString allTags
     VLeft _ -> pure  (nub $ ["recommended", "latest"] ++ add)
 
-versionCompleter :: Maybe ListCriteria -> Tool -> Completer
-versionCompleter criteria tool = versionCompleter' criteria tool (const True)
 
-versionCompleter' :: Maybe ListCriteria -> Tool -> (Version -> Bool) -> Completer
+versionCompleter :: Maybe ListCriteria -> Tool -> Completer
-versionCompleter' criteria tool filter' = listIOCompleter $ do
+versionCompleter criteria tool = listIOCompleter $ do
   dirs' <- liftIO getAllDirs
   let loggerConfig = LoggerConfig
         { lcPrintDebug   = False
@@ -473,7 +483,7 @@ versionCompleter' criteria tool filter' = listIOCompleter $ do
           runEnv = flip runReaderT appState
 
       installedVersions <- runEnv $ listVersions (Just tool) criteria
-      return $ fmap (T.unpack . prettyVer) . filter filter' . fmap lVer $ installedVersions
+      return $ T.unpack . prettyVer . lVer <$> installedVersions
 
 
 toolDlCompleter :: Tool -> Completer
@@ -665,7 +675,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
@@ -677,6 +687,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,8 +12,6 @@ module GHCup.OptParse.Compile where
 
 
 import           GHCup
-import qualified GHCup.GHC as GHC
-import qualified GHCup.HLS as HLS
 import           GHCup.Errors
 import           GHCup.Types
 import           GHCup.Types.Optics
@@ -32,8 +30,7 @@ import           Control.Monad.Trans.Resource
 import           Data.Bifunctor
 import           Data.Functor
 import           Data.Maybe
-import           Data.Versions                  ( Version, prettyVer, version, pvp )
+import           Data.Versions                  ( Version, prettyVer, version )
-import qualified Data.Versions as V
 import           Data.Text                      ( Text )
 import           Haskus.Utils.Variant.Excepts
 import           Options.Applicative     hiding ( style )
@@ -44,7 +41,7 @@ import           Text.PrettyPrint.HughesPJClass ( prettyShow )
 
 import           URI.ByteString          hiding ( uriParser )
 import qualified Data.Text                     as T
-import Control.Exception.Safe (MonadMask, displayException)
+import Control.Exception.Safe (MonadMask)
 import System.FilePath (isPathSeparator)
 import Text.Read (readEither)
 
@@ -67,7 +64,7 @@ data CompileCommand = CompileGHC GHCCompileOptions
 
 
 data GHCCompileOptions = GHCCompileOptions
-  { targetGhc    :: GHC.GHCVer Version
+  { targetGhc    :: Either Version GitBranch
   , bootstrapGhc :: Either Version FilePath
   , jobs         :: Maybe Int
   , buildConfig  :: Maybe FilePath
@@ -81,12 +78,10 @@ data GHCCompileOptions = GHCCompileOptions
   , isolateDir   :: Maybe FilePath
   }
 
-
 data HLSCompileOptions = HLSCompileOptions
-  { targetHLS    :: HLS.HLSVer
+  { targetHLS    :: Either Version GitBranch
   , jobs         :: Maybe Int
   , setCompile   :: Bool
-  , updateCabal  :: Bool
   , ovewrwiteVer :: Either Bool Version
   , isolateDir   :: Maybe FilePath
   , cabalProject :: Maybe (Either FilePath URI)
@@ -154,10 +149,10 @@ Examples:
   These need to be available in PATH prior to compilation.
 
 Examples:
-  # compile 1.7.0.0 from hackage for 8.10.7, running 'cabal update' before the build
+  # compile 1.7.0.0 for ghc 8.10.5 and 8.10.7, passing '--allow-newer' to cabal
-  ghcup compile hls --version 1.7.0.0 --ghc 8.10.7 --cabal-update
+  ghcup compile hls -v 1.7.0.0 -j 12 --ghc 8.10.5 --ghc 8.10.7 -- --allow-newer
-  # compile from master for ghc 9.2.3 using 'git describe' to name the binary and ignore the pinned index state
+  # compile from master for ghc 9.2.3 and use 'git describe' to name the binary
-  ghcup compile hls -g master --git-describe-version --ghc 9.2.3 -- --index-state=@(date '+%s')
+  ghcup compile hls -g master --git-describe-version --ghc 9.2.3
   # 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|]
 
@@ -165,7 +160,7 @@ Examples:
 ghcCompileOpts :: Parser GHCCompileOptions
 ghcCompileOpts =
   GHCCompileOptions
-    <$> ((GHC.SourceDist <$> option
+    <$> ((Left <$> option
           (eitherReader
             (first (const "Not a valid version") . version . T.pack)
           )
@@ -174,7 +169,7 @@ ghcCompileOpts =
             <> (completer $ versionCompleter Nothing GHC)
           )
           ) <|>
-          (GHC.GitDist <$> (GitBranch <$> option
+          (Right <$> (GitBranch <$> option
           str
           (short 'g' <> long "git-ref" <> metavar "GIT_REFERENCE" <> help
             "The git commit/branch/ref to build from"
@@ -183,18 +178,7 @@ ghcCompileOpts =
             short 'r' <> long "repository" <> metavar "GIT_REPOSITORY" <> help "The git repository to build from (defaults to GHC upstream)"
             <> completer (gitFileUri ["https://gitlab.haskell.org/ghc/ghc.git"])
             ))
-          ))
+          )))
-          <|>
-          (
-           GHC.RemoteDist <$> (option
-            (eitherReader uriParser)
-            (long "remote-source-dist" <> metavar "URI" <> help
-              "URI (https/http/file) to a GHC source distribution"
-              <> completer fileUri
-            )
-          )
-          )
-          )
     <*> option
           (eitherReader
             (\x ->
@@ -286,17 +270,16 @@ ghcCompileOpts =
 hlsCompileOpts :: Parser HLSCompileOptions
 hlsCompileOpts =
   HLSCompileOptions
-    <$> ((HLS.HackageDist <$> option
+    <$> ((Left <$> option
           (eitherReader
-            ((>>= first displayException . V.version . V.prettyPVP) . first (const "Not a valid PVP version") . pvp . T.pack)
+            (first (const "Not a valid version") . version . T.pack)
           )
           (short 'v' <> long "version" <> metavar "VERSION" <> help
-            "The version to compile (pulled from hackage)"
+            "The tool version to compile"
-            <> (completer $ versionCompleter' Nothing HLS (either (const False) (const True) . V.pvp . V.prettyVer))
+            <> (completer $ versionCompleter Nothing HLS)
           )
-          )
+          ) <|>
-          <|>
+          (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 (accepts anything 'git checkout' accepts)"
@@ -304,28 +287,7 @@ hlsCompileOpts =
           optional (option str (short 'r' <> long "repository" <> metavar "GIT_REPOSITORY" <> help "The git repository to build from (defaults to HLS upstream)"
             <> completer (gitFileUri ["https://github.com/haskell/haskell-language-server.git"])
           ))
-          ))
+          )))
-          <|>
-          (HLS.SourceDist <$> (option
-            (eitherReader
-              (first (const "Not a valid version") . version . T.pack)
-            )
-          (long "source-dist" <> metavar "VERSION" <> help
-            "The version to compile (pulled from packaged git sources)"
-            <> (completer $ versionCompleter Nothing HLS)
-          )
-          ))
-          <|>
-          (
-           HLS.RemoteDist <$> (option
-            (eitherReader uriParser)
-            (long "remote-source-dist" <> metavar "URI" <> help
-              "URI (https/http/file) to a HLS source distribution"
-              <> completer fileUri
-            )
-          )
-          )
-          )
     <*> optional
           (option
             (eitherReader (readEither @Int))
@@ -335,7 +297,6 @@ hlsCompileOpts =
             )
           )
     <*> fmap (fromMaybe True) (invertableSwitch "set" Nothing True (help "Don't set as active version after install"))
-    <*> switch (long "cabal-update" <> help "Run 'cabal update' before the build")
     <*>
          (
           (Right <$> option
@@ -401,7 +362,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))
@@ -507,7 +468,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
     (CompileHLS HLSCompileOptions { .. }) -> do
       runCompileHLS runAppState (do
         case targetHLS of
-          HLS.SourceDist targetVer -> do
+          Left targetVer -> do
             GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
             let vi = getVersionInfo targetVer HLS dls
             forM_ (_viPreCompile =<< vi) $ \msg -> do
@@ -515,7 +476,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
               lift $ logInfo
                 "...waiting for 5 seconds, you can still abort..."
               liftIO $ threadDelay 5000000 -- for compilation, give the user a sec to intervene
-          _ -> pure ()
+          Right _ -> pure ()
         ghcs <- liftE $ forM targetGHCs (\ghc -> fmap (_tvVersion . fst) . fromVersion (Just ghc) $ GHC)
         targetVer <- liftE $ compileHLS
                     targetHLS
@@ -525,7 +486,6 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
                     (maybe GHCupInternal IsolateDir isolateDir)
                     cabalProject
                     cabalProjectLocal
-                    updateCabal
                     patches
                     cabalArgs
         GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
@@ -559,7 +519,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
     (CompileGHC GHCCompileOptions {..}) ->
       runCompileGHC runAppState (do
         case targetGhc of
-          GHC.SourceDist targetVer -> do
+          Left targetVer -> do
             GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
             let vi = getVersionInfo targetVer GHC dls
             forM_ (_viPreCompile =<< vi) $ \msg -> do
@@ -567,12 +527,9 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
               lift $ logInfo
                 "...waiting for 5 seconds, you can still abort..."
               liftIO $ threadDelay 5000000 -- for compilation, give the user a sec to intervene
-          _ -> pure ()
+          Right _ -> pure ()
         targetVer <- liftE $ compileGHC
-                    ((\case
+                    (first (GHCTargetVersion crossTarget) targetGhc)
-                        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

@@ -74,44 +74,44 @@ data PrefetchGHCOptions = PrefetchGHCOptions {
     --[ Parsers ]--
     ---------------
 
-          
+
 prefetchP :: Parser PrefetchCommand
 prefetchP = subparser
   (  command
       "ghc"
-      (info 
+      (info
         (PrefetchGHC
           <$> (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")
       )
       <>
      command
       "cabal"
-      (info 
+      (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")
       )
       <>
      command
       "hls"
-      (info 
+      (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")
       )
       <>
      command
       "stack"
-      (info 
+      (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

@@ -71,7 +71,7 @@ data RmOptions = RmOptions
     --[ Parsers ]--
     ---------------
 
-          
+
 rmParser :: Parser (Either RmCommand RmOptions)
 rmParser =
   (Left <$> subparser
@@ -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
 
 
@@ -46,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 )
 
 
 
@@ -88,7 +90,7 @@ runOpts =
           (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)
@@ -96,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)
@@ -104,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)
@@ -112,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)
@@ -217,7 +219,7 @@ runRUN appState action' = do
 
 
 
-run :: forall m. 
+run :: forall m .
        ( MonadFail m
        , MonadMask m
        , MonadCatch m
@@ -233,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
@@ -268,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
@@ -296,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"
@@ -353,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
@@ -392,46 +399,47 @@ 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
     let paths          = ["PATH", "Path"]
@@ -443,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
               )
             )
 
@@ -466,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

@@ -74,7 +74,7 @@ data SetOptions = SetOptions
     --[ Parsers ]--
     ---------------
 
-          
+
 setParser :: Parser (Either SetCommand SetOptions)
 setParser =
   (Left <$> subparser
@@ -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

@@ -75,14 +75,14 @@ data WhereisOptions = WhereisOptions {
     --[ Parsers ]--
     ---------------
 
-          
+
 whereisP :: Parser WhereisCommand
 whereisP = subparser
-  (commandGroup "Tools locations:" <> 
+  (commandGroup "Tools locations:" <>
     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,8 +14,6 @@ module Main where
 import           BrickMain                    ( brickMain )
 #endif
 
-import qualified GHCup.GHC as GHC
-import qualified GHCup.HLS as HLS
 import           GHCup.OptParse
 
 import           GHCup.Download
@@ -238,7 +236,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                     | Just False <- optVerbose -> pure ()
                     | otherwise -> lookupEnv "GHCUP_SKIP_UPDATE_CHECK" >>= \case
                          Nothing -> void . flip runReaderT s' . runE @'[TagNotFound, NextVerNotFound, NoToolVersionSet] $ do
-                           newTools <- lift checkForUpdates 
+                           newTools <- lift checkForUpdates
                            forM_ newTools $ \newTool@(t, l) -> do
                              -- https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/283
                              alreadyInstalling' <- alreadyInstalling optCommand newTool
@@ -279,7 +277,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
               runAppState action' = do
                 s' <- liftIO appState
                 runReaderT action' s'
-                  
+
 
           -----------------
           -- Run command --
@@ -339,16 +337,14 @@ 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 = GHC.SourceDist tver }))
+  alreadyInstalling (Compile (CompileGHC GHCCompileOptions{ targetGhc = Left tver }))
-    (GHC, ver)   = cmp' GHC (Just $ ToolVersion (mkTVer tver)) ver
+    (GHC, ver)   = cmp' GHC (Just $ ToolVersion tver) ver
   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 = HLS.SourceDist tver }))
+  alreadyInstalling (Compile (CompileHLS HLSCompileOptions{ targetHLS = Left tver }))
-    (HLS, ver)   = cmp' HLS (Just $ ToolVersion (mkTVer tver)) ver
+    (HLS, ver)   = cmp' HLS (Just $ ToolVersion tver) ver
-  alreadyInstalling (Compile (CompileHLS HLSCompileOptions{ targetHLS = HLS.HackageDist tver }))
+  alreadyInstalling (Upgrade {}) (GHCup, _) = pure True
-    (HLS, ver)   = cmp' HLS (Just $ ToolVersion (mkTVer tver)) ver
-  alreadyInstalling (Upgrade _ _ _) (GHCup, _) = pure True
   alreadyInstalling _ _ = pure False
 
   cmp' :: ( HasLog env

docs/guide.md

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

lib/GHCup.hs

@@ -33,8 +33,8 @@ module GHCup (
 
 
 import           GHCup.Cabal
-import           GHCup.GHC             hiding ( GHCVer(..) )
+import           GHCup.GHC
-import           GHCup.HLS             hiding ( HLSVer(..) )
+import           GHCup.HLS
 import           GHCup.Stack
 import           GHCup.List
 import           GHCup.Download
@@ -206,8 +206,9 @@ rmGhcupDirs = do
       | isWindows = removeDirIfEmptyOrIsSymlink binDir
       | otherwise = do
           isXDGStyle <- liftIO useXDG
-          when (not isXDGStyle) $
+          if not isXDGStyle
-            removeDirIfEmptyOrIsSymlink binDir
+            then 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,12 +80,6 @@ import qualified Data.Text.Encoding            as E
 import qualified Text.Megaparsec               as MP
 
 
-data GHCVer v = SourceDist v
-              | GitDist GitBranch
-              | RemoteDist URI
-
-
-
     ---------------------
     --[ Tool fetching ]--
     ---------------------
@@ -613,7 +607,7 @@ compileGHC :: ( MonadMask m
               , MonadUnliftIO m
               , MonadFail m
               )
-           => GHCVer GHCTargetVersion
+           => Either GHCTargetVersion GitBranch          -- ^ version to install
            -> Maybe Version            -- ^ overwrite version
            -> Either Version FilePath  -- ^ version to bootstrap with
            -> Maybe Int                -- ^ jobs
@@ -656,7 +650,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
 
     (workdir, tmpUnpack, tver) <- case targetGhc of
       -- unpack from version tarball
-      SourceDist tver -> do
+      Left tver -> do
         lift $ logDebug $ "Requested to compile: " <> tVerToText tver <> " with " <> either prettyVer T.pack bstrap
 
         -- download source tarball
@@ -677,31 +671,8 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
 
         pure (workdir, tmpUnpack, tver)
 
-      RemoteDist uri -> do
-        lift $ logDebug $ "Requested to compile (from uri): " <> T.pack (show uri)
-
-        -- download source tarball
-        tmpDownload <- lift withGHCupTmpDir
-        tmpUnpack <- lift mkGhcupTmpDir
-        tar <- liftE $ download uri Nothing Nothing (fromGHCupPath tmpDownload) Nothing False
-        (bf, tver) <- liftE $ cleanUpOnError @'[UnknownArchive, ArchiveResult, ProcessError] tmpUnpack $ do
-          liftE $ unpackToDir (fromGHCupPath tmpUnpack) tar
-          let regex = [s|^(.*/)*boot$|] :: B.ByteString
-          [bootFile] <- liftIO $ findFilesDeep
-            tmpUnpack
-            (makeRegexOpts compExtended
-                           execBlank
-                           regex
-            )
-          tver <- liftE $ getGHCVer (appendGHCupPath tmpUnpack (takeDirectory bootFile))
-          pure (bootFile, tver)
-
-        let workdir = appendGHCupPath tmpUnpack (takeDirectory bf)
-
-        pure (workdir, tmpUnpack, mkTVer tver)
-
       -- clone from git
-      GitDist GitBranch{..} -> do
+      Right GitBranch{..} -> do
         tmpUnpack <- lift mkGhcupTmpDir
         let git args = execLogged "git" ("--no-pager":args) (Just $ fromGHCupPath tmpUnpack) "git" Nothing
         tver <- reThrowAll @_ @'[PatchFailed, ProcessError, NotFoundInPATH, DigestError, DownloadFailed, GPGError] DownloadFailed $ do
@@ -744,7 +715,14 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
           liftE $ applyAnyPatch patches (fromGHCupPath tmpUnpack)
 
           -- bootstrap
-          tver <- liftE $ getGHCVer 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)
+          tver <- case _exitCode of
+            ExitSuccess -> throwEither . MP.parse ghcProjectVersion "" . T.pack . stripNewlineEnd . T.unpack . 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)
           lift $ logInfo $ "Examining git ref " <> T.pack ref <> "\n  " <>
                            "GHC version (from Makefile): " <> prettyVer tver <>
@@ -817,29 +795,11 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
     pure installVer
 
  where
-  getGHCVer :: ( MonadReader env m
-               , HasSettings env
-               , HasDirs env
-               , HasLog env
-               , MonadIO m
-               , MonadThrow m
-               )
-            => GHCupPath
-            -> Excepts '[ProcessError] m Version
-  getGHCVer tmpUnpack = do
-    lEM $ execWithGhcEnv "python3" ["./boot"] (Just $ fromGHCupPath tmpUnpack) "ghc-bootstrap"
-    lEM $ execWithGhcEnv "sh" ["./configure"] (Just $ fromGHCupPath tmpUnpack) "ghc-bootstrap"
-    CapturedProcess {..} <- lift $ makeOut
-      ["show!", "--quiet", "VALUE=ProjectVersion" ] (Just $ fromGHCupPath tmpUnpack)
-    case _exitCode of
-      ExitSuccess -> throwEither . MP.parse ghcProjectVersion "" . T.pack . stripNewlineEnd . T.unpack . decUTF8Safe' $ _stdOut
-      ExitFailure c -> throwE $ NonZeroExit c "make" ["show!", "--quiet", "VALUE=ProjectVersion" ]
-
   defaultConf =
     let cross_mk = $(LitE . StringL <$> (qAddDependentFile "data/build_mk/cross" >> runIO (readFile "data/build_mk/cross")))
         default_mk = $(LitE . StringL <$> (qAddDependentFile "data/build_mk/default" >> runIO (readFile "data/build_mk/default")))
     in case targetGhc of
-         SourceDist (GHCTargetVersion (Just _) _) -> cross_mk
+         Left (GHCTargetVersion (Just _) _) -> cross_mk
          _ -> default_mk
 
   compileHadrianBindist :: ( MonadReader env m
@@ -1016,7 +976,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
 
    -- for cross, we need Stage1Only
     case targetGhc of
-      SourceDist (GHCTargetVersion (Just _) _) -> when ("Stage1Only = YES" `notElem` lines') $ throwE
+      Left (GHCTargetVersion (Just _) _) -> when ("Stage1Only = YES" `notElem` lines') $ throwE
         (InvalidBuildConfig
           [s|Cross compiling needs to be a Stage1 build, add "Stage1Only = YES" to your config!|]
         )

lib/GHCup/HLS.hs

@@ -71,12 +71,6 @@ import qualified Text.Megaparsec               as MP
 import Text.PrettyPrint.HughesPJClass (prettyShow)
 
 
-data HLSVer = SourceDist Version
-            | GitDist GitBranch
-            | HackageDist Version
-            | RemoteDist URI
-
-
 
     --------------------
     --[ Installation ]--
@@ -330,14 +324,13 @@ compileHLS :: ( MonadMask m
               , MonadUnliftIO m
               , MonadFail m
               )
-           => HLSVer
+           => Either Version GitBranch
            -> [Version]
            -> Maybe Int
            -> Either Bool Version
            -> InstallDir
            -> Maybe (Either FilePath URI)
            -> Maybe URI
-           -> Bool
            -> Maybe (Either FilePath [URI])  -- ^ patches
            -> [Text]                   -- ^ additional args to cabal install
            -> Excepts '[ NoDownload
@@ -350,18 +343,15 @@ compileHLS :: ( MonadMask m
                        , BuildFailed
                        , NotInstalled
                        ] m Version
-compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal updateCabal patches cabalArgs = do
+compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal patches cabalArgs = do
   PlatformRequest { .. } <- lift getPlatformReq
   GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
   Dirs { .. } <- lift getDirs
 
-  when updateCabal $ reThrowAll @_ @'[ProcessError] DownloadFailed $ do
-    lift $ logInfo "Updating cabal DB"
-    lEM $ exec "cabal" ["update"] (Just $ fromGHCupPath tmpDir) Nothing
 
-  (workdir, tmpUnpack, tver, git_describe) <- case targetHLS of
+  (workdir, tver, git_describe) <- case targetHLS of
     -- unpack from version tarball
-    SourceDist tver -> do
+    Left tver -> do
       lift $ logDebug $ "Requested to compile: " <> prettyVer tver
 
       -- download source tarball
@@ -379,47 +369,10 @@ compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal upda
                        (liftE . intoSubdir tmpUnpack)
                        (view dlSubdir dlInfo)
 
-      pure (workdir, tmpUnpack, tver, Nothing)
+      pure (workdir, 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
-    GitDist GitBranch{..} -> do
+    Right GitBranch{..} -> do
       tmpUnpack <- lift mkGhcupTmpDir
       let git args = execLogged "git" ("--no-pager":args) (Just $ fromGHCupPath tmpUnpack) "git" Nothing
       reThrowAll @_ @'[ProcessError] DownloadFailed $ do
@@ -456,7 +409,15 @@ compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal upda
                         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")
+        (Just gpd) <- parseGenericPackageDescriptionMaybe
+          <$> liftIO (B.readFile (fromGHCupPath tmpUnpack </> "haskell-language-server.cabal"))
+        let tver = (\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)
         lift $ logInfo $ "Examining git ref " <> T.pack ref <> "\n  " <>
@@ -464,7 +425,7 @@ compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal upda
                                     (if not shallow_clone then "\n  " <> "'git describe' output: " <> fromJust git_describe else mempty) <>
                                     (if isCommitHash ref then mempty else "\n  " <> "commit hash: " <> chash)
 
-        pure (tmpUnpack, tmpUnpack, tver, git_describe)
+        pure (tmpUnpack, tver, git_describe)
 
   -- the version that's installed may differ from the
   -- compiled version, so the user can overwrite it
@@ -480,7 +441,7 @@ compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal upda
                   Right v -> pure v
 
   liftE $ runBuildAction
-    tmpUnpack
+    workdir
     (reThrowAll @_ @'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError, FileAlreadyExistsError, CopyError] @'[BuildFailed] (BuildFailed $ fromGHCupPath workdir) $ do
       let tmpInstallDir = fromGHCupPath workdir </> "out"
       liftIO $ createDirRecursive' tmpInstallDir
@@ -496,22 +457,14 @@ compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal upda
               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
+        Nothing -> pure "cabal.project"
-          | 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)
@@ -705,19 +658,3 @@ rmHLSVer ver = do
     case headMay . reverse . sort $ hlsVers of
       Just latestver -> liftE $ setHLS latestver SetHLSOnly Nothing
       Nothing        -> pure ()
-
-
-getCabalVersion :: (MonadIO m, MonadFail m) => FilePath -> m Version
-getCabalVersion fp = do
-  contents <- liftIO $ B.readFile fp
-  gpd <- case parseGenericPackageDescriptionMaybe contents of
-           Nothing -> fail $ "could not parse cabal file: " <> fp
-           Just r -> pure r
-  let tver = (\c -> Version Nothing c [] Nothing)
-           . NE.fromList . fmap (NE.fromList . (:[]) . digits . fromIntegral)
-           . versionNumbers
-           . pkgVersion
-           . package
-           . packageDescription
-           $ gpd
-  pure tver

lib/GHCup/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,3 +657,10 @@ isSafeDir (IsolateDirResolved _) = False
 isSafeDir (GHCupDir _)           = True
 isSafeDir (GHCupBinDir _)        = False
 
+
+
+
+
+
+
+

lib/GHCup/Utils.hs

@@ -1097,8 +1097,7 @@ runBuildAction bdir action = do
 
 -- | Clean up the given directory if the action fails,
 -- depending on the Settings.
-cleanUpOnError :: forall e m a env .
+cleanUpOnError :: ( MonadReader env m
-                  ( MonadReader env m
                   , HasDirs env
                   , HasSettings env
                   , MonadIO m

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*)
@@ -322,11 +324,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
@@ -353,6 +379,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
 }
 

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
@@ -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)
 }