Use predictable /tmp names for ghcup run, fixes #329

CHANGELOG.md

@@ -1,5 +1,11 @@
 # Revision history for ghcup
 
+## 0.1.17.6 -- ????-??-??
+
+* Vastly improve shell completions wrt [#242](https://gitlab.haskell.org/haskell/ghcup-hs/-/merge_requests/242)
+* Fix 'ghcup install cabal/hls/stack --set' wrt [#324](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/324)
+* Fix bad error message wrt [#323](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/323)
+
 ## 0.1.17.5 -- 2022-02-26
 
 * Implement `ghcup run` subcommand wrt [#137](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/137)

app/ghcup/GHCup/OptParse.hs

@@ -124,6 +124,7 @@ opts =
             <> metavar "URL"
             <> help "Alternative ghcup download info url"
             <> internal
+            <> completer fileUri
             )
           )
     <*> (fmap . fmap) not (invertableSwitch "verify" 'n' True (help "Disable tarball checksum verification (default: enabled)"))
@@ -134,6 +135,7 @@ opts =
           <> help
                "Keep build directories? (default: errors)"
           <> hidden
+          <> completer (listCompleter ["always", "errors", "never"])
           ))
     <*> optional (option
           (eitherReader downloaderParser)
@@ -142,10 +144,12 @@ opts =
           <> metavar "<internal|curl|wget>"
           <> help
           "Downloader to use (default: internal)"
+          <> completer (listCompleter ["internal", "curl", "wget"])
 #else
           <> metavar "<curl|wget>"
           <> help
           "Downloader to use (default: curl)"
+          <> completer (listCompleter ["curl", "wget"])
 #endif
           <> hidden
           ))
@@ -156,6 +160,7 @@ opts =
           <> metavar "<strict|lax|none>"
           <> help
           "GPG verification (default: none)"
+          <> completer (listCompleter ["strict", "lax", "none"])
           ))
     <*> com
  where

app/ghcup/GHCup/OptParse/Common.hs

@@ -52,6 +52,7 @@ import           Haskus.Utils.Variant.Excepts
 import           Options.Applicative     hiding ( style )
 import           Prelude                 hiding ( appendFile )
 import           Safe
+import           System.Directory
 import           System.Process                  ( readProcess )
 import           System.FilePath
 import           Text.HTML.TagSoup       hiding ( Tag )
@@ -301,20 +302,37 @@ gpgParser s' | t == T.pack "strict" = Right GPGStrict
 toolCompleter :: Completer
 toolCompleter = listCompleter ["ghc", "cabal", "hls", "stack"]
 
+gitFileUri :: [String] -> Completer
+gitFileUri add = mkCompleter $ fileUri' (["git://"] <> add)
 
 fileUri :: Completer
-fileUri = mkCompleter $ \case
+fileUri = mkCompleter $ fileUri' []
-  "" -> pure ["https://", "http://", "file:///"]
+
+fileUri' :: [String] -> String -> IO [String]
+fileUri' add = \case
+  "" -> do
+    pwd <- getCurrentDirectory
+    pure $ ["https://", "http://", "file:///", "file://" <> pwd <> "/"] <> add
   xs
-   | "file://" `isPrefixOf` xs -> fmap ("file://" <>) <$>
+   | "file:///" `isPrefixOf` xs -> fmap ("file://" <>) <$>
       case stripPrefix "file://" xs of
         Nothing -> pure []
         Just r ->  do
-          let cmd = unwords ["compgen", "-A", "file", "--", requote r]
+          pwd <- getCurrentDirectory
-          result <- tryIO $ readProcess "bash" ["-c", cmd] ""
+          dirs  <- compgen "directory" r ["-S", "/"]
-          return . lines . either (const []) id $ result
+          files <- filter (\f -> (f <> "/") `notElem` dirs) <$> compgen "file" r []
+          pure (dirs <> files <> if r `isPrefixOf` pwd then [pwd <> "/"] else [])
+   | xs `isPrefixOf` "file:///" -> pure ["file:///"]
+   | xs `isPrefixOf` "https://" -> pure ["https://"]
+   | xs `isPrefixOf` "http://"  -> pure ["http://"]
    | otherwise -> pure []
  where
+  compgen :: String -> String -> [String] -> IO [String]
+  compgen action' r opts = do
+    let cmd = unwords $ ["compgen", "-A", action'] <> opts <> ["--", requote r]
+    result <- tryIO $ readProcess "bash" ["-c", cmd] ""
+    return . lines . either (const []) id $ result
+
   -- | Strongly quote the string we pass to compgen.
   --
   -- We need to do this so bash doesn't expand out any ~ or other
@@ -459,8 +477,9 @@ versionCompleter criteria tool = listIOCompleter $ do
 
 toolDlCompleter :: Tool -> Completer
 toolDlCompleter tool = mkCompleter $ \case
-  "" -> pure $ initUrl tool
+  "" -> pure (initUrl tool <> ["https://", "http://", "file:///"])
   word
+    | "file://" `isPrefixOf` word -> fileUri' [] word
     -- downloads.haskell.org
     | "https://downloads.haskell.org/" `isPrefixOf` word ->
         fmap (completePrefix word) . prefixMatch (FP.takeFileName word) <$> fromHRef word
@@ -501,6 +520,10 @@ toolDlCompleter tool = mkCompleter $ \case
 
     | "h" `isPrefixOf` word -> pure $ initUrl tool
 
+    | word `isPrefixOf` "file:///" -> pure ["file:///"]
+    | word `isPrefixOf` "https://" -> pure ["https://"]
+    | word `isPrefixOf` "http://"  -> pure ["http://"]
+
     | otherwise -> pure []
  where
   initUrl :: Tool -> [String]

app/ghcup/GHCup/OptParse/Compile.hs

@@ -173,7 +173,10 @@ ghcCompileOpts =
           (short 'g' <> long "git-ref" <> metavar "GIT_REFERENCE" <> help
             "The git commit/branch/ref to build from"
           ) <*>
-          optional (option str (short 'r' <> long "repository" <> metavar "GIT_REPOSITORY" <> help "The git repository to build from (defaults to GHC upstream)"))
+          optional (option str (
+            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"])
+            ))
           )))
     <*> option
           (eitherReader
@@ -285,7 +288,9 @@ hlsCompileOpts =
           (short 'g' <> long "git-ref" <> metavar "GIT_REFERENCE" <> help
             "The git commit/branch/ref to build from"
           ) <*>
-          optional (option str (short 'r' <> long "repository" <> metavar "GIT_REPOSITORY" <> help "The git repository to build from (defaults to GHC upstream)"))
+          optional (option str (short 'r' <> long "repository" <> metavar "GIT_REPOSITORY" <> help "The git repository to build from (defaults to GHC upstream)"
+            <> completer (gitFileUri ["https://github.com/haskell/haskell-language-server.git"])
+          ))
           )))
     <*> optional
           (option

app/ghcup/GHCup/OptParse/Install.hs

@@ -6,6 +6,7 @@
 {-# LANGUAGE QuasiQuotes       #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE ViewPatterns      #-}
 
 module GHCup.OptParse.Install where
 
@@ -255,6 +256,48 @@ type InstallEffects = '[ AlreadyInstalled
                        , NoToolVersionSet
                        , FileAlreadyExistsError
                        , ProcessError
+
+                       , (AlreadyInstalled, ())
+                       , (UnknownArchive, ())
+                       , (ArchiveResult, ())
+                       , (FileDoesNotExistError, ())
+                       , (CopyError, ())
+                       , (NotInstalled, ())
+                       , (DirNotEmpty, ())
+                       , (NoDownload, ())
+                       , (NotInstalled, ())
+                       , (BuildFailed, ())
+                       , (TagNotFound, ())
+                       , (DigestError, ())
+                       , (GPGError, ())
+                       , (DownloadFailed, ())
+                       , (TarDirDoesNotExist, ())
+                       , (NextVerNotFound, ())
+                       , (NoToolVersionSet, ())
+                       , (FileAlreadyExistsError, ())
+                       , (ProcessError, ())
+
+                       , (AlreadyInstalled, NotInstalled)
+                       , (UnknownArchive, NotInstalled)
+                       , (ArchiveResult, NotInstalled)
+                       , (FileDoesNotExistError, NotInstalled)
+                       , (CopyError, NotInstalled)
+                       , (NotInstalled, NotInstalled)
+                       , (DirNotEmpty, NotInstalled)
+                       , (NoDownload, NotInstalled)
+                       , (NotInstalled, NotInstalled)
+                       , (BuildFailed, NotInstalled)
+                       , (TagNotFound, NotInstalled)
+                       , (DigestError, NotInstalled)
+                       , (GPGError, NotInstalled)
+                       , (DownloadFailed, NotInstalled)
+                       , (TarDirDoesNotExist, NotInstalled)
+                       , (NextVerNotFound, NotInstalled)
+                       , (NoToolVersionSet, NotInstalled)
+                       , (FileAlreadyExistsError, NotInstalled)
+                       , (ProcessError, NotInstalled)
+
+                       , ((), NotInstalled)
                        ]
 
 
@@ -420,20 +463,22 @@ install installCommand settings getAppState' runLogger = case installCommand of
     s'@AppState{ dirs = Dirs{ .. } } <- liftIO getAppState'
     (case instBindist of
        Nothing -> runInstTool s' instPlatform $ do
-         (v, vi) <- liftE $ fromVersion instVer Cabal
+         (_tvVersion -> v, vi) <- liftE $ fromVersion instVer Cabal
-         liftE $ installCabalBin
+         void $ liftE $ sequenceE (installCabalBin
-                   (_tvVersion v)
+                                    v
-                   isolateDir
+                                    isolateDir
-                   forceInstall
+                                    forceInstall
+                                  ) $ when instSet $ void $ setCabal v
          pure vi
        Just uri -> do
          runInstTool s'{ settings = settings { noVerify = True}} instPlatform $ do
-           (v, vi) <- liftE $ fromVersion instVer Cabal
+           (_tvVersion -> v, vi) <- liftE $ fromVersion instVer Cabal
-           liftE $ installCabalBindist 
+           void $ liftE $ sequenceE (installCabalBindist
-                     (DownloadInfo uri Nothing "")
+                                      (DownloadInfo uri Nothing "")
-                     (_tvVersion v)
+                                      v
-                     isolateDir
+                                      isolateDir
-                     forceInstall
+                                      forceInstall
+                                    ) $ when instSet $ void $ setCabal v
            pure vi
       )
       >>= \case
@@ -450,6 +495,14 @@ install installCommand settings getAppState' runLogger = case installCommand of
               runLogger $ logWarn $
                 "File " <> T.pack fp <> " already exists. Use 'ghcup install cabal --isolate " <> T.pack fp <> " --force ..." <> "' if you want to overwrite."
               pure $ ExitFailure 3
+            VLeft (V (AlreadyInstalled _ v, ())) -> do
+              runLogger $ logWarn $
+                "Cabal ver " <> prettyVer v <> " already installed; if you really want to reinstall it, you may want to run 'ghcup install cabal --force " <> prettyVer v <> "'"
+              pure ExitSuccess
+            VLeft (V (FileAlreadyExistsError fp, ())) -> do
+              runLogger $ logWarn $
+                "File " <> T.pack fp <> " already exists. Use 'ghcup install cabal --isolate " <> T.pack fp <> " --force ..." <> "' if you want to overwrite."
+              pure $ ExitFailure 3
             VLeft e -> do
               runLogger $ do
                 logError $ T.pack $ prettyShow e
@@ -461,21 +514,23 @@ install installCommand settings getAppState' runLogger = case installCommand of
      s'@AppState{ dirs = Dirs{ .. } } <- liftIO getAppState'
      (case instBindist of
        Nothing -> runInstTool s' instPlatform $ do
-         (v, vi) <- liftE $ fromVersion instVer HLS
+         (_tvVersion -> v, vi) <- liftE $ fromVersion instVer HLS
-         liftE $ installHLSBin
+         void $ liftE $ sequenceE (installHLSBin
-                   (_tvVersion v)
+                                    v
-                   isolateDir
+                                    isolateDir
-                   forceInstall
+                                    forceInstall
+                                  ) $ when instSet $ void $ setHLS v SetHLSOnly Nothing
          pure vi
        Just uri -> do
          runInstTool s'{ settings = settings { noVerify = True}} instPlatform $ do
-           (v, vi) <- liftE $ fromVersion instVer HLS
+           (_tvVersion -> v, vi) <- liftE $ fromVersion instVer HLS
            -- TODO: support legacy
-           liftE $ installHLSBindist
+           void $ liftE $ sequenceE (installHLSBindist
-                     (DownloadInfo uri (Just $ RegexDir "haskell-language-server-*") "")
+                                      (DownloadInfo uri (Just $ RegexDir "haskell-language-server-*") "")
-                     (_tvVersion v)
+                                      v
-                     isolateDir
+                                      isolateDir
-                     forceInstall
+                                      forceInstall
+                                    ) $ when instSet $ void $ setHLS v SetHLSOnly Nothing
            pure vi
       )
       >>= \case
@@ -496,6 +551,18 @@ install installCommand settings getAppState' runLogger = case installCommand of
               runLogger $ logWarn $
                 "File " <> T.pack fp <> " already exists. Use 'ghcup install hls --isolate " <> T.pack fp <> " --force ..." <> "' if you want to overwrite."
               pure $ ExitFailure 3
+            VLeft (V (AlreadyInstalled _ v, ())) -> do
+              runLogger $ logWarn $
+                  "HLS ver "
+                <> prettyVer v
+                <> " already installed; if you really want to reinstall it, you may want to run 'ghcup install hls --force "
+                <> prettyVer v
+                <> "'"
+              pure ExitSuccess
+            VLeft (V (FileAlreadyExistsError fp, ())) -> do
+              runLogger $ logWarn $
+                "File " <> T.pack fp <> " already exists. Use 'ghcup install hls --isolate " <> T.pack fp <> " --force ..." <> "' if you want to overwrite."
+              pure $ ExitFailure 3
             VLeft e -> do
               runLogger $ do
                 logError $ T.pack $ prettyShow e
@@ -507,20 +574,22 @@ install installCommand settings getAppState' runLogger = case installCommand of
      s'@AppState{ dirs = Dirs{ .. } } <- liftIO getAppState'
      (case instBindist of
         Nothing -> runInstTool s' instPlatform $ do
-          (v, vi) <- liftE $ fromVersion instVer Stack
+          (_tvVersion -> v, vi) <- liftE $ fromVersion instVer Stack
-          liftE $ installStackBin
+          void $ liftE $ sequenceE (installStackBin
-                    (_tvVersion v)
+                                     v
-                    isolateDir
+                                     isolateDir
-                    forceInstall
+                                     forceInstall
+                                   ) $ when instSet $ void $ setStack v
           pure vi
         Just uri -> do
           runInstTool s'{ settings = settings { noVerify = True}} instPlatform $ do
-            (v, vi) <- liftE $ fromVersion instVer Stack
+            (_tvVersion -> v, vi) <- liftE $ fromVersion instVer Stack
-            liftE $ installStackBindist
+            void $ liftE $ sequenceE (installStackBindist
-                      (DownloadInfo uri Nothing "")
+                                       (DownloadInfo uri Nothing "")
-                      (_tvVersion v)
+                                       v
-                      isolateDir
+                                       isolateDir
-                      forceInstall
+                                       forceInstall
+                                     ) $ when instSet $ void $ setStack v
             pure vi
       )
       >>= \case
@@ -537,6 +606,14 @@ install installCommand settings getAppState' runLogger = case installCommand of
               runLogger $ logWarn $
                 "File " <> T.pack fp <> " already exists. Use 'ghcup install stack --isolate " <> T.pack fp <> " --force ..." <> "' if you want to overwrite."
               pure $ ExitFailure 3
+            VLeft (V (AlreadyInstalled _ v, ())) -> do
+              runLogger $ logWarn $
+                "Stack ver " <> prettyVer v <> " already installed; if you really want to reinstall it, you may want to run 'ghcup install stack --force " <> prettyVer v <> "'"
+              pure ExitSuccess
+            VLeft (V (FileAlreadyExistsError fp, ())) -> do
+              runLogger $ logWarn $
+                "File " <> T.pack fp <> " already exists. Use 'ghcup install stack --isolate " <> T.pack fp <> " --force ..." <> "' if you want to overwrite."
+              pure $ ExitFailure 3
             VLeft e -> do
               runLogger $ do
                 logError $ T.pack $ prettyShow e

app/ghcup/GHCup/OptParse/Run.hs

@@ -35,7 +35,6 @@ import           Prelude                 hiding ( appendFile )
 import           System.Directory
 import           System.FilePath
 import           System.Environment
-import           System.IO.Temp
 import           System.Exit
 import           Text.PrettyPrint.HughesPJClass ( prettyShow )
 
@@ -217,16 +216,20 @@ run :: forall m.
    -> LeanAppState
    -> (ReaderT LeanAppState m () -> m ())
    -> m ExitCode
-run RunOptions{..} runAppState leanAppstate runLogger = do
+run RunOptions{..} runAppState leanAppstate runLogger = runE @RunEffects ( do
+   toolchain <- Excepts resolveToolchain
    tmp <- case runBinDir of
-     Just bdir -> do
+     Just bindir -> do
-       liftIO $ createDirRecursive' bdir
+       liftIO $ createDirRecursive' bindir
-       liftIO $ canonicalizePath bdir
+       liftIO $ canonicalizePath bindir
-     Nothing -> liftIO (getTemporaryDirectory >>= \tmp -> createTempDirectory tmp "ghcup")
+     Nothing -> do
-   r <- do
+       d <- liftIO $ predictableTmpDir toolchain
-     addToolsToDir tmp
+       liftIO $ createDirRecursive' d
-   case r of
+       liftIO $ canonicalizePath d
-     VRight _ -> do
+   Excepts $ installToolChain toolchain tmp
+   pure tmp
+   ) >>= \case
+     VRight tmp -> do
        case runCOMMAND of
          [] -> do
            liftIO $ putStr tmp
@@ -253,70 +256,78 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
    isToolTag _           = False
 
    -- TODO: doesn't work for cross
-   addToolsToDir tmp
+   resolveToolchain
      | or (fmap (maybe False isToolTag) [runGHCVer, runCabalVer, runHLSVer, runStackVer]) || runInstTool' = runRUN runAppState $ do
-         forM_ runGHCVer $ \ver -> do
+         ghcVer <- forM runGHCVer $ \ver -> do
            (v, _) <- liftE $ fromVersion (Just ver) GHC
-           installTool GHC v
+           pure v
-           setTool GHC v tmp
+         cabalVer <- forM runCabalVer $ \ver -> do
-         forM_ runCabalVer $ \ver -> do
            (v, _) <- liftE $ fromVersion (Just ver) Cabal
-           installTool Cabal v
+           pure v
-           setTool Cabal v tmp
+         hlsVer <- forM runHLSVer $ \ver -> do
-         forM_ runHLSVer $ \ver -> do
            (v, _) <- liftE $ fromVersion (Just ver) HLS
-           installTool HLS v
+           pure v
-           setTool HLS v tmp
+         stackVer <- forM runStackVer $ \ver -> do
-         forM_ runStackVer $ \ver -> do
            (v, _) <- liftE $ fromVersion (Just ver) Stack
-           installTool Stack v
+           pure v
-           setTool Stack v tmp
+         pure Toolchain{..}
      | otherwise = runLeanRUN leanAppstate $ do
-         case runGHCVer of
+         ghcVer <- case runGHCVer of
-            Just (ToolVersion v) ->
+            Just (ToolVersion v) -> pure $ Just v
-              setTool GHC v tmp
+            Nothing -> pure Nothing
-            Nothing -> pure ()
             _ -> fail "Internal error"
-         case runCabalVer of
+         cabalVer <- case runCabalVer of
-            Just (ToolVersion v) ->
+            Just (ToolVersion v) -> pure $ Just v
-              setTool Cabal v tmp
+            Nothing -> pure Nothing
-            Nothing -> pure ()
             _ -> fail "Internal error"
-         case runHLSVer of
+         hlsVer <- case runHLSVer of
-            Just (ToolVersion v) ->
+            Just (ToolVersion v) -> pure $ Just v
-              setTool HLS v tmp
+            Nothing -> pure Nothing
-            Nothing -> pure ()
             _ -> fail "Internal error"
-         case runStackVer of
+         stackVer <- case runStackVer of
-            Just (ToolVersion v) ->
+            Just (ToolVersion v) -> pure $ Just v
-              setTool Stack v tmp
+            Nothing -> pure Nothing
-            Nothing -> pure ()
             _ -> fail "Internal error"
+         pure Toolchain{..}
 
-   installTool tool v = do
+   installToolChain Toolchain{..} tmp
-      isInstalled <- checkIfToolInstalled' tool v
+     | or (fmap (maybe False isToolTag) [runGHCVer, runCabalVer, runHLSVer, runStackVer]) || runInstTool' = runRUN runAppState $ do
-      case tool of
+         forM_ [(GHC,) <$> ghcVer, (Cabal,) <$> cabalVer, (HLS,) <$> hlsVer, (Stack,) <$> stackVer] $ \mt -> do
-        GHC -> do
+           isInstalled <- maybe (pure False) (\(tool, v) -> lift $ checkIfToolInstalled' tool v) mt
-          unless isInstalled $ when (runInstTool' && isNothing (_tvTarget v)) $ void $ liftE $ installGHCBin
+           case mt of
-            (_tvVersion v)
+             Just (GHC, v) -> do
-            Nothing
+               unless isInstalled $ when (runInstTool' && isNothing (_tvTarget v)) $ void $ liftE $ installGHCBin
-            False
+                 (_tvVersion v)
-        Cabal -> do
+                 Nothing
-          unless isInstalled $ when runInstTool' $ void $ liftE $ installCabalBin
+                 False
-            (_tvVersion v)
+               setTool GHC v tmp
-            Nothing
+             Just (Cabal, v) -> do
-            False
+               unless isInstalled $ when runInstTool' $ void $ liftE $ installCabalBin
-        Stack -> do
+                 (_tvVersion v)
-          unless isInstalled $ when runInstTool' $ void $ liftE $ installStackBin
+                 Nothing
-            (_tvVersion v)
+                 False
-            Nothing
+               setTool Cabal v tmp
-            False
+             Just (Stack, v) -> do
-        HLS -> do
+               unless isInstalled $ when runInstTool' $ void $ liftE $ installStackBin
-          unless isInstalled $ when runInstTool' $ void $ liftE $ installHLSBin
+                 (_tvVersion v)
-            (_tvVersion v)
+                 Nothing
-            Nothing
+                 False
-            False
+               setTool Stack v tmp
-        GHCup -> pure ()
+             Just (HLS, v) -> do
+               unless isInstalled $ when runInstTool' $ void $ liftE $ installHLSBin
+                 (_tvVersion v)
+                 Nothing
+                 False
+               setTool HLS v tmp
+             _ -> pure ()
+     | otherwise = runLeanRUN leanAppstate $ do
+         forM_ [(GHC,) <$> ghcVer, (Cabal,) <$> cabalVer, (HLS,) <$> hlsVer, (Stack,) <$> stackVer] $ \mt -> do
+           case mt of
+             Just (GHC, v)   -> setTool GHC v tmp
+             Just (Cabal, v) -> setTool Cabal v tmp
+             Just (Stack, v) -> setTool Stack v tmp
+             Just (HLS, v)   -> setTool HLS v tmp
+             _ -> pure ()
 
    setTool tool v tmp =
       case tool of
@@ -338,7 +349,7 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
           if legacy
           then do
             -- TODO: factor this out
-            (Just hlsWrapper) <- hlsWrapperBinary 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 </>))
@@ -360,3 +371,30 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
         envWithNewPath = Map.toList $ Map.insert pathVar newPath envWithoutPath
     liftIO $ setEnv pathVar newPath
     return envWithNewPath
+
+   predictableTmpDir (Toolchain Nothing Nothing Nothing Nothing) =
+     liftIO (getTemporaryDirectory >>= \tmp -> pure (tmp </> "ghcup-none"))
+   predictableTmpDir Toolchain{..} = do
+      tmp <- getTemporaryDirectory
+      pure $ tmp
+        </> ("ghcup"
+              <> maybe "" (("_ghc-"   <>) . T.unpack . tVerToText) ghcVer
+              <> maybe "" (("_cabal-" <>) . T.unpack . tVerToText) cabalVer
+              <> maybe "" (("_hls-"   <>) . T.unpack . tVerToText) hlsVer
+              <> maybe "" (("_stack-" <>) . T.unpack . tVerToText) stackVer
+            )
+
+
+
+    -------------------------
+    --[ Other local types ]--
+    -------------------------
+
+
+
+data Toolchain = Toolchain
+  { ghcVer     :: Maybe GHCTargetVersion
+  , cabalVer   :: Maybe GHCTargetVersion
+  , hlsVer     :: Maybe GHCTargetVersion
+  , stackVer   :: Maybe GHCTargetVersion
+  }

docs/css/extra.css

@@ -1,5 +1,8 @@
 :root {
   --theme-purple: #5E5184;
+  --theme-purple-dark: rgba(69, 59, 97, 0.5);
+  --ukraine-top: #0057B8;
+  --ukraine-bottom: #FFD700;
   --link-pink: #9E358F;
 }
 
@@ -108,12 +111,12 @@ body.homepage>div.container div.col-md-9 {
 
 .bg-primary {
   background-image: none;
-  background-color: var(--theme-purple) !important;
+  background-color: var(--ukraine-top) !important;
 }
 
 body .bg-primary {
   background-image: none;
-  background-color: var(--theme-purple);
+  background-color: var(--ukraine-top);
   border: 0px;
 }
 
@@ -125,8 +128,8 @@ body .btn-primary {
 
 .navbar.fixed-top {
   background-image: none;
-  background-color: var(--theme-purple);
+  background-color: var(--ukraine-top);
-  border-bottom: 5px solid rgba(69, 59, 97, 0.5);
+  border-bottom: 40px solid var(--ukraine-bottom);
   padding: 0px;
 }
 

docs/install.md

@@ -50,10 +50,90 @@ On windows, double-click on the `Uninstall Haskell.ps1` PowerShell script on you
 
 GHCup supports the following tools, which are also known as the **Haskell Toolchain**:
 
-1. [GHC](https://www.haskell.org/ghc/)
+<details>
-2. [cabal-install](https://cabal.readthedocs.io/en/stable/)
+  <summary>Show all supported <a href='https://www.haskell.org/ghc/'>GHC</a> versions</summary>
-3. [haskell-language-server](https://haskell-language-server.readthedocs.io/en/stable/)
+  
-4. [stack](https://docs.haskellstack.org/en/stable/README/)
+<table>
+<thead><tr><th>GHC Version</th><th>Tags</th></tr></thead>
+<tbody>
+<tr><td>7.10.3</td><td>base-4.8.2.0</td></tr>
+<tr><td>8.0.2</td><td>base-4.9.1.0</td></tr>
+<tr><td>8.2.2</td><td>base-4.10.1.0</td></tr>
+<tr><td>8.4.1</td><td>base-4.11.0.0</td></tr>
+<tr><td>8.4.2</td><td>base-4.11.1.0</td></tr>
+<tr><td>8.4.3</td><td>base-4.11.1.0</td></tr>
+<tr><td>8.4.4</td><td>base-4.11.1.0</td></tr>
+<tr><td>8.6.1</td><td>base-4.12.0.0</td></tr>
+<tr><td>8.6.2</td><td>base-4.12.0.0</td></tr>
+<tr><td>8.6.3</td><td>base-4.12.0.0</td></tr>
+<tr><td>8.6.4</td><td>base-4.12.0.0</td></tr>
+<tr><td>8.6.5</td><td>base-4.12.0.0</td></tr>
+<tr><td>8.8.1</td><td>base-4.13.0.0</td></tr>
+<tr><td>8.8.2</td><td>base-4.13.0.0</td></tr>
+<tr><td>8.8.3</td><td>base-4.13.0.0</td></tr>
+<tr><td>8.8.4</td><td>base-4.13.0.0</td></tr>
+<tr><td>8.10.1</td><td>base-4.14.0.0</td></tr>
+<tr><td>8.10.2</td><td>base-4.14.1.0</td></tr>
+<tr><td>8.10.3</td><td>base-4.14.1.0</td></tr>
+<tr><td>8.10.4</td><td>base-4.14.1.0</td></tr>
+<tr><td>8.10.5</td><td>base-4.14.2.0</td></tr>
+<tr><td>8.10.6</td><td>base-4.14.3.0</td></tr>
+<tr><td>8.10.7</td><td><span style="color:green">recommended</span>, base-4.14.3.0</td></tr>
+<tr><td>9.0.1</td><td>base-4.15.0.0</td></tr>
+<tr><td>9.0.2</td><td>base-4.15.1.0</td></tr>
+<tr><td>9.2.1</td><td>base-4.16.0.0</td></tr>
+<tr><td>9.2.2</td><td><span style="color:blue">latest</span>, base-4.16.1.0</td></tr>
+</tbody>
+</table>
+
+</details>
+
+<details>
+  <summary>Show all supported <a href='https://cabal.readthedocs.io/en/stable/'>cabal-install</a> versions</summary>
+  <table>
+<thead><tr><th>Cabal Version</th><th>Tags</th></tr></thead>
+<tbody>
+<tr><td>2.4.1.0</td><td></td></tr>
+<tr><td>3.0.0.0</td><td></td></tr>
+<tr><td>3.2.0.0</td><td></td></tr>
+<tr><td>3.4.0.0</td><td></td></tr>
+<tr><td>3.4.1.0</td><td></td></tr>
+<tr><td>3.6.0.0</td><td></td></tr>
+<tr><td>3.6.2.0</td><td><span style="color:blue">latest</span>, <span style="color:green">recommended</span></td></tr>
+</tbody>
+</table>
+
+</details>
+
+<details>
+  <summary>Show all supported <a href='https://haskell-language-server.readthedocs.io/en/stable/'>HLS</a> versions</summary>
+<table>
+<thead><tr><th>HLS Version</th><th>Tags</th></tr></thead>
+<tbody>
+<tr><td>1.1.0</td><td></td></tr>
+<tr><td>1.2.0</td><td></td></tr>
+<tr><td>1.3.0</td><td></td></tr>
+<tr><td>1.4.0</td><td></td></tr>
+<tr><td>1.5.0</td><td></td></tr>
+<tr><td>1.5.1</td><td></td></tr>
+<tr><td>1.6.0.0</td><td></td></tr>
+<tr><td>1.6.1.0</td><td><span style="color:blue">latest</span>, <span style="color:green">recommended</span></td></tr>
+</tbody>
+</table>
+</details>
+
+<details>
+  <summary>Show all supported <a href='https://docs.haskellstack.org/en/stable/README/'>Stack</a> versions</summary>
+<table>
+<thead><tr><th>Stack Version</th><th>Tags</th></tr></thead>
+<tbody>
+<tr><td>2.5.1</td><td></td></tr>
+<tr><td>2.7.1</td><td></td></tr>
+<tr><td>2.7.3</td><td></td></tr>
+<tr><td>2.7.5</td><td><span style="color:blue">latest</span>, <span style="color:green">recommended</span></td></tr>
+</tbody>
+</table>
+</details>
 
 ## Supported platforms
 

ghcup.cabal

@@ -121,7 +121,7 @@ library
     , haskus-utils-variant  ^>=3.2.1
     , libarchive            ^>=3.0.3.0
     , lzma-static           ^>=5.2.5.3
-    , megaparsec            >=8.0.0      && <9.1
+    , megaparsec            >=8.0.0      && <9.3
     , mtl                   ^>=2.2
     , optics                ^>=0.4
     , os-release            ^>=1.0.0
@@ -236,9 +236,9 @@ executable ghcup
     , ghcup
     , haskus-utils-variant  ^>=3.2.1
     , libarchive            ^>=3.0.3.0
-    , megaparsec            >=8.0.0    && <9.1
+    , megaparsec            >=8.0.0    && <9.3
     , mtl                   ^>=2.2
-    , optparse-applicative  >=0.15.1.0 && <0.17
+    , optparse-applicative  >=0.15.1.0 && <0.18
     , pretty                ^>=1.1.3.1
     , pretty-terminal       ^>=0.1.0.0
     , process               ^>=1.6.11.0
@@ -246,8 +246,8 @@ executable ghcup
     , safe                  ^>=0.3.18
     , safe-exceptions       ^>=0.1
     , tagsoup               ^>=0.14
-    , temporary             ^>=1.3
     , template-haskell      >=2.7      && <2.18
+    , temporary             ^>=1.3
     , text                  ^>=1.2.4.0
     , unordered-containers  ^>=0.2
     , uri-bytestring        ^>=0.3.2.2
@@ -270,18 +270,18 @@ executable ghcup
 
   if os(windows)
     cpp-options: -DIS_WINDOWS
+
   else
-    build-depends:
+    build-depends: unix ^>=2.7
-      , unix             ^>=2.7
 
   if flag(no-exe)
     buildable: False
 
-  if (flag(disable-upgrade))
+  if flag(disable-upgrade)
-    cpp-options:   -DDISABLE_UPGRADE
+    cpp-options: -DDISABLE_UPGRADE
+
   else
-    other-modules:
+    other-modules: GHCup.OptParse.Upgrade
-        GHCup.OptParse.Upgrade
 
 test-suite ghcup-test
   type:               exitcode-stdio-1.0
@@ -310,9 +310,9 @@ test-suite ghcup-test
     , base                      >=4.12    && <5
     , bytestring                ^>=0.10
     , containers                ^>=0.6
-    , generic-arbitrary         ^>=0.1.0
+    , generic-arbitrary         >=0.1.0   && <0.3
     , ghcup
-    , hspec                     ^>=2.7.10
+    , hspec                     >=2.7.10  && <2.10
     , hspec-golden-aeson        ^>=0.9
     , QuickCheck                ^>=2.14.1
     , quickcheck-arbitrary-adt  ^>=0.3.1.0

stack.yaml

@@ -16,6 +16,7 @@ extra-deps:
   - composition-prelude-3.0.0.2@sha256:1ffed216bd28d810fce0b5be83a661e2a892696d73b3f8de5c0f5edb9b5f0090,1216
   - haskus-utils-data-1.4@sha256:bfa94363b94b14779edd6834fbd59dbb847c3d7b8f48e3844f456ffdc077da4a,1466
   - haskus-utils-types-1.5.1@sha256:991c472f4e751e2f0d7aab6ad4220ef151d6160876dcf0511bbf876bbd432020,1298
+  - haskus-utils-variant-3.2.1@sha256:791f4cf1e786eb578f4d37aef60986641f84c36e130164321f7d01542584066a,2200
   - heaps-0.3.6.1@sha256:7928b759ca5180d35722c45948c0bde264229f3c99c1888188a3d9285f13d3d2,1340
   - hpath-filepath-0.10.4@sha256:e9e44fb5fdbade7f30b5b5451257dbee15b6ef1aae4060034d73008bb3b5d878,1269
   - hpath-posix-0.13.3@sha256:abe472cf16bccd3a8b8814865ed3551a728fde0f3a2baea2acc03023bec6c565,1615
@@ -39,11 +40,6 @@ extra-deps:
   - xor-0.0.1.0@sha256:f8362b4a68562b9afbcd727ff64c1a303970df3a032e0033d2f4c094c3501df3,2243
   - yaml-streamly-0.12.0
 
-  - git: https://github.com/hasufell/packages.git
-    commit: cc0b4688f8bb374fa92f17c856949de795b56291
-    subdirs:
-      - haskus-utils-variant
-
 flags:
   http-io-streams:
     brotli: false