Fix prefetch for cross bindists

Fixes #923

CHANGELOG.md

@@ -1,8 +1,20 @@
 # Revision history for ghcup
 
-## 0.1.19.5 -- ????-?-??
+## 0.1.20.0 -- 2023-11-10
 
-* support JS cross compilers wrt [#838](https://github.com/haskell/ghcup-hs/issues/838)
+### New features
+
+* support TUI on windows thanks to the work from vty and brick maintainers (Chris Hackett, Timofey Zakrevskiy, Jonathan Daugherty, ...), wrt [#912](https://github.com/haskell/ghcup-hs/pull/912)
+* support JS and wasm cross compilers wrt [#838](https://github.com/haskell/ghcup-hs/issues/838), thanks to Sylvain Henry and IOG
+* Support stacks installation strategy and metadata wrt [#892](https://github.com/haskell/ghcup-hs/issues/892)
+  - you can now enable stacks installation method via `ghcup config set url-source '["GHCupURL", "StackSetupURL"]'`... for more information, check the [documentation](https://www.haskell.org/ghcup/guide/#using-stacks-setup-info-metadata-to-install-ghc)
+
+### Improvements and bug fixes
+
+* fix segfault in TUI when hitting enter early wrt [#887](https://github.com/haskell/ghcup-hs/issues/887)
+* Improve key handling in TUI, fixes [#875](https://github.com/haskell/ghcup-hs/issues/875)
+* add explicit support for Void Linux and Rocky Linux (this requires a metadata version bump to `ghcup-0.0.8.yaml`)
+* optparse cli interface now has a test suite thanks to Lei Zhu, wrt [#862](https://github.com/haskell/ghcup-hs/pull/862)
 
 ## 0.1.19.4 -- 2023-7-02
 

app/ghcup/BrickMain.hs

@@ -5,6 +5,8 @@
 {-# LANGUAGE TypeApplications  #-}
 {-# LANGUAGE RankNTypes        #-}
 {-# LANGUAGE ViewPatterns      #-}
+{-# OPTIONS_GHC -Wno-unused-record-wildcards #-}
+{-# OPTIONS_GHC -Wno-unused-matches #-}
 
 module BrickMain where
 
@@ -16,7 +18,6 @@ import           GHCup.Types         hiding ( LeanAppState(..) )
 import           GHCup.Utils
 import           GHCup.OptParse.Common (logGHCPostRm)
 import           GHCup.Prelude ( decUTF8Safe )
-import           GHCup.Prelude.File
 import           GHCup.Prelude.Logger
 import           GHCup.Prelude.Process
 import           GHCup.Prompts
@@ -49,7 +50,6 @@ import           Data.Vector                    ( Vector
 import           Data.Versions
 import           Haskus.Utils.Variant.Excepts
 import           Prelude                 hiding ( appendFile )
-import           System.FilePath
 import           System.Exit
 import           System.IO.Unsafe
 import           Text.PrettyPrint.HughesPJClass ( prettyShow )
@@ -61,9 +61,34 @@ import qualified Data.Text.Lazy                as L
 import qualified Graphics.Vty                  as Vty
 import qualified Data.Vector                   as V
 import System.Environment (getExecutablePath)
+#if !IS_WINDOWS
+import           GHCup.Prelude.File
+import           System.FilePath
 import qualified System.Posix.Process          as SPP
+#endif
 
 
+installedSign :: String
+#if IS_WINDOWS
+installedSign = "I "
+#else
+installedSign = "✓ "
+#endif
+
+setSign :: String
+#if IS_WINDOWS
+setSign = "IS"
+#else
+setSign = "✔✔"
+#endif
+
+notInstalledSign :: String
+#if IS_WINDOWS
+notInstalledSign = "X "
+#else
+notInstalledSign = "✗ "
+#endif
+
 hiddenTools :: [Tool]
 hiddenTools = []
 
@@ -165,9 +190,9 @@ ui dimAttrs BrickState{ appSettings = as@BrickSettings{}, ..}
     in withDefAttr listAttr . drawListElements (renderItem minTagSize minVerSize) True $ bis
   renderItem minTagSize minVerSize _ b listResult@ListResult{lTag = lTag', ..} =
     let marks = if
-          | lSet       -> (withAttr (attrName "set") $ str "✔✔")
-          | lInstalled -> (withAttr (attrName "installed") $ str "✓ ")
-          | otherwise  -> (withAttr (attrName "not-installed") $ str "✗ ")
+          | lSet       -> (withAttr (attrName "set") $ str setSign)
+          | lInstalled -> (withAttr (attrName "installed") $ str installedSign)
+          | otherwise  -> (withAttr (attrName "not-installed") $ str notInstalledSign)
         ver = case lCross of
           Nothing -> T.unpack . prettyVer $ lVer
           Just c  -> T.unpack (c <> "-" <> prettyVer lVer)
@@ -500,12 +525,15 @@ install' _ (_, ListResult {..}) = do
             forM_ (_viPostInstall =<< vi) $ \msg -> logInfo msg
             case lTool of
               GHCup -> do
+#if !IS_WINDOWS
                 up <- liftIO $ fmap (either (const Nothing) Just)
                   $ try @_ @SomeException $ canonicalizePath (binDir </> "ghcup" <.> exeExt)
                 when ((normalise <$> up) == Just (normalise ce)) $
                   -- TODO: track cli arguments of previous invocation
                   liftIO $ SPP.executeFile ce False ["tui"] Nothing
+#else
                 logInfo "Please restart 'ghcup' for the changes to take effect"
+#endif
               _ -> pure ()
             pure $ Right ()
           VRight (vi, _, _) -> do
@@ -527,7 +555,35 @@ set' bs input@(_, ListResult {..}) = do
 
   let run =
         flip runReaderT settings
-          . runE @'[FileDoesNotExistError , NotInstalled , TagNotFound]
+          . runResourceT
+          . runE
+            @'[ AlreadyInstalled
+              , ArchiveResult
+              , UnknownArchive
+              , FileDoesNotExistError
+              , CopyError
+              , NoDownload
+              , NotInstalled
+              , BuildFailed
+              , TagNotFound
+              , DigestError
+              , ContentLengthError
+              , GPGError
+              , DownloadFailed
+              , DirNotEmpty
+              , NoUpdate
+              , TarDirDoesNotExist
+              , FileAlreadyExistsError
+              , ProcessError
+              , ToolShadowed
+              , UninstallFailed
+              , MergeFileTreeError
+              , NoCompatiblePlatform
+              , GHCup.Errors.ParseError
+              , UnsupportedSetupCombo
+              , DistroNotFound
+              , NoCompatibleArch
+              ]
 
   run (do
       case lTool of
@@ -535,7 +591,12 @@ set' bs input@(_, ListResult {..}) = do
         Cabal -> liftE $ setCabal lVer $> ()
         HLS   -> liftE $ setHLS lVer SetHLSOnly Nothing $> ()
         Stack -> liftE $ setStack lVer $> ()
-        GHCup -> pure ()
+        GHCup -> do
+          promptAnswer <- getUserPromptResponse "Switching GHCup versions is not supported.\nDo you want to install the latest version? [Y/N]: "
+          case promptAnswer of
+                PromptYes -> do
+                  void $ liftE $ upgradeGHCup Nothing False False
+                PromptNo -> pure ()
     )
     >>= \case
           VRight _ -> pure $ Right ()

cabal.project.release

@@ -4,35 +4,26 @@ optional-packages: ./vendored/*/*.cabal
 
 optimization: 2
 
-source-repository-package
-  type: git
-  location: https://github.com/fosskers/versions.git
-  tag: 7bc3355348aac3510771d4622aff09ac38c9924d
+package ghcup
+  flags: +tui
 
 if os(linux)
-  package ghcup
-    flags: +tui
   if arch(x86_64) || arch(i386)
     package *
       ghc-options: -split-sections -optl-static
 elif os(darwin)
   constraints: zlib +bundled-c-zlib,
                lzma +static
-  package ghcup
-    flags: +tui
 elif os(mingw32)
   constraints: zlib +bundled-c-zlib,
                lzma +static,
-               text -simdutf
-  package ghcup
-    flags: -tui
+               text -simdutf,
+			   vty-windows >=0.1.0.3
 elif os(freebsd)
   constraints: zlib +bundled-c-zlib,
                zip +disable-zstd
   package *
     ghc-options: -split-sections -pgmc clang++14
-  package ghcup
-    flags: +tui
 
 constraints: http-io-streams -brotli,
              any.aeson >= 2.0.1.0,

docs/guide.md

@@ -95,7 +95,7 @@ platform-override:
 
 This is the complete list of env variables that change GHCup behavior:
 
-* `GHCUP_USE_XDG_DIRS`: see [XDG support](#xdg-support) above
+* `GHCUP_USE_XDG_DIRS`: see [XDG support](#xdg-support) below
 * `GHCUP_INSTALL_BASE_PREFIX`: the base of ghcup (default: `$HOME`)
 * `GHCUP_CURL_OPTS`: additional options that can be passed to curl
 * `GHCUP_WGET_OPTS`: additional options that can be passed to wget

docs/install.md

@@ -255,7 +255,7 @@ This list may not be exhaustive and specifies support for bindists only.
 
 | Platform | Architecture | ghcup | GHC | cabal | HLS | stack |
 | ------ | ------ | ------ | ------ | ------ | ------ | ------ |
-| Windows 7 | amd64 | ❔ | ✅ | ✅ | ✅ | ✅ |
+| Windows 8.1 | amd64 | ✅ | ✅ | ✅ | ✅ | ✅ |
 | Windows 10 | amd64 | ✅ | ✅ | ✅ | ✅ | ✅ |
 | Windows Server 2016 | amd64 | ✅ | ✅ | ✅ | ✅ | ✅ |
 | Windows Server 2019 | amd64 | ✅ | ✅ | ✅ | ✅ | ✅ |
@@ -271,12 +271,11 @@ This list may not be exhaustive and specifies support for bindists only.
 | Linux generic | aarch64 | ✅ | ⚠️ | ✅ | ⚠️ | ❌ |
 | Linux generic | armv7 | ✅ | ⚠️ | ✅ | ⚠️ | ❌ |
 
-### Windows 7
+### Windows <8.1
 
-May or may not work, several issues:
-
-* [https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/140](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/140)
-* [https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/197](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/197)
+No longer supported for recent GHCs, according to manual testing of GHC 9.8.1 on Windows 7.
+According to [msys2 documentation](https://www.msys2.org/docs/windows_support), the minimum Windows
+version is now 8.1.
 
 ### WSL1
 

ghcup.cabal

@@ -1,6 +1,6 @@
 cabal-version:      2.4
 name:               ghcup
-version:            0.1.19.5
+version:            0.1.20.0
 license:            LGPL-3.0-only
 license-file:       LICENSE
 copyright:          Julian Ospald 2020
@@ -36,7 +36,7 @@ source-repository head
 
 flag tui
   description:
-    Build the brick powered tui (ghcup tui). This is disabled on windows.
+    Build the brick powered tui (ghcup tui).
 
   default:     False
   manual:      True
@@ -86,7 +86,7 @@ common app-common-depends
     , unordered-containers   ^>=0.2
     , uri-bytestring         ^>=0.3.2.2
     , utf8-string            ^>=1.0
-    , vector                 ^>=0.12
+    , vector                 >=0.12     && <0.14
     , versions               >=6.0.3    && <6.1
     , yaml-streamly          ^>=0.12.0
 
@@ -190,7 +190,7 @@ library
     , unliftio-core         ^>=0.2.0.1
     , unordered-containers  ^>=0.2.10.0
     , uri-bytestring        ^>=0.3.2.2
-    , vector                ^>=0.12
+    , vector                 >=0.12     && <0.14
     , versions              >=6.0.3      && <6.1
     , word8                 ^>=0.1.3
     , yaml-streamly         ^>=0.12.0
@@ -236,9 +236,9 @@ library
       , unix             ^>=2.7
       , unix-bytestring  ^>=0.3.7.3
 
-  if (flag(tui) && !os(windows))
+  if flag(tui)
     cpp-options:   -DBRICK
-    build-depends: vty ^>=5.39
+    build-depends: vty ^>=6.0
 
 library ghcup-optparse
   import:             app-common-depends
@@ -284,7 +284,7 @@ library ghcup-optparse
   if flag(internal-downloader)
     cpp-options: -DINTERNAL_DOWNLOADER
 
-  if (flag(tui) && !os(windows))
+  if flag(tui)
     cpp-options:   -DBRICK
 
   if os(windows)
@@ -320,14 +320,13 @@ executable ghcup
   if flag(internal-downloader)
     cpp-options: -DINTERNAL_DOWNLOADER
 
-  if (flag(tui) && !os(windows))
+  if flag(tui)
     cpp-options:   -DBRICK
     other-modules: BrickMain
     build-depends:
-      , brick         ^>=1.5
+      , brick         ^>=2.1
       , transformers  ^>=0.5
-      , unix          ^>=2.7
-      , vty           ^>=5.39
+      , vty           ^>=6.0
 
   if os(windows)
     cpp-options: -DIS_WINDOWS

lib-opt/GHCup/OptParse/Config.hs

@@ -67,7 +67,6 @@ configP = subparser
       <> command "show" showP
       <> command "add-release-channel" addP
       )
-    <|> argsP -- add show for a single option
     <|> pure ShowConfig
  where
   initP = info (pure InitConfig) (progDesc "Write default config to ~/.ghcup/config.yaml")
@@ -193,10 +192,14 @@ config configCommand settings userConf keybindings runLogger = case configComman
           throwE $ ParseError "Empty values are not allowed"
         Nothing -> do
           usersettings <- decodeSettings k
+          when (usersettings == defaultUserSettings)
+            $ throwE $ ParseError ("Failed to parse setting (maybe typo?): " <> k)
           lift $ doConfig usersettings
           pure ()
         Just v -> do
           usersettings <- decodeSettings (k <> ": " <> v <> "\n")
+          when (usersettings == defaultUserSettings)
+            $ throwE $ ParseError ("Failed to parse key '" <> k <> "' with value '" <> v <> "' as user setting. Maybe typo?")
           lift $ doConfig usersettings
           pure ()
     case r of
@@ -204,7 +207,9 @@ config configCommand settings userConf keybindings runLogger = case configComman
       VLeft (V (JSONDecodeError e)) -> do
         runLogger $ logError $ "Error decoding config: " <> T.pack e
         pure $ ExitFailure 65
-      VLeft _ -> pure $ ExitFailure 65
+      VLeft e -> do
+        runLogger (logError $ T.pack $ prettyHFError e)
+        pure $ ExitFailure 65
 
   AddReleaseChannel force new -> do
     r <- runE @'[DuplicateReleaseChannel] $ do

lib-opt/GHCup/OptParse/Prefetch.hs

@@ -199,19 +199,19 @@ prefetch prefetchCommand runAppState runLogger =
           (v, _) <- liftE $ fromVersion mt GHC
           if pfGHCSrc
           then liftE $ fetchGHCSrc v pfCacheDir
-          else liftE $ fetchToolBindist (_tvVersion v) GHC pfCacheDir
+          else liftE $ fetchToolBindist v GHC pfCacheDir
       PrefetchCabal PrefetchOptions {pfCacheDir} mt   -> do
         forM_ pfCacheDir (liftIO . createDirRecursive')
         (v, _) <- liftE $ fromVersion mt Cabal
-        liftE $ fetchToolBindist (_tvVersion v) Cabal pfCacheDir
+        liftE $ fetchToolBindist v Cabal pfCacheDir
       PrefetchHLS PrefetchOptions {pfCacheDir} mt   -> do
         forM_ pfCacheDir (liftIO . createDirRecursive')
         (v, _) <- liftE $ fromVersion mt HLS
-        liftE $ fetchToolBindist (_tvVersion v) HLS pfCacheDir
+        liftE $ fetchToolBindist v HLS pfCacheDir
       PrefetchStack PrefetchOptions {pfCacheDir} mt   -> do
         forM_ pfCacheDir (liftIO . createDirRecursive')
         (v, _) <- liftE $ fromVersion mt Stack
-        liftE $ fetchToolBindist (_tvVersion v) Stack pfCacheDir
+        liftE $ fetchToolBindist v Stack pfCacheDir
       PrefetchMetadata -> do
         pfreq <- lift getPlatformReq
         _ <- liftE $ getDownloadsF pfreq

lib/GHCup.hs

@@ -100,7 +100,7 @@ fetchToolBindist :: ( MonadFail m
                     , MonadIO m
                     , MonadUnliftIO m
                     )
-                 => Version
+                 => GHCTargetVersion
                  -> Tool
                  -> Maybe FilePath
                  -> Excepts
@@ -113,7 +113,7 @@ fetchToolBindist :: ( MonadFail m
                       m
                       FilePath
 fetchToolBindist v t mfp = do
-  dlinfo <- liftE $ getDownloadInfo t v
+  dlinfo <- liftE $ getDownloadInfo' t v
   liftE $ downloadCached' dlinfo Nothing mfp
 
 

lib/GHCup/Download.hs

@@ -149,12 +149,16 @@ getDownloadsF pfreq@(PlatformRequest arch plat _) = do
       -> Excepts
            '[DownloadFailed, GPGError, DigestError, ContentLengthError, JSONError, FileDoesNotExistError]
            m (Either GHCupInfo Stack.SetupInfo)
-  dl' NewGHCupURL       = fmap Left $ liftE $ getBase @GHCupInfo ghcupURL
-  dl' NewStackSetupURL  = fmap Right $ liftE $ getBase @Stack.SetupInfo stackSetupURL
+  dl' NewGHCupURL       = fmap Left $ liftE (getBase ghcupURL) >>= liftE . decodeMetadata @GHCupInfo
+  dl' NewStackSetupURL  = fmap Right $ liftE (getBase stackSetupURL) >>= liftE . decodeMetadata @Stack.SetupInfo
   dl' (NewGHCupInfo gi) = pure (Left gi)
   dl' (NewSetupInfo si) = pure (Right si)
-  dl' (NewURI uri)      = catchE @JSONError (\(JSONDecodeError _) -> Right <$> getBase @Stack.SetupInfo uri)
-                            $ fmap Left $ getBase @GHCupInfo uri
+  dl' (NewURI uri)      = do
+                            base <- liftE $ getBase uri
+                            catchE @JSONError (\(JSONDecodeError _) -> do
+                                logDebug $ "Couldn't decode " <> T.pack base <> " as GHCupInfo, trying as SetupInfo: "
+                                Right <$> decodeMetadata @Stack.SetupInfo base)
+                              $ fmap Left $ decodeMetadata @GHCupInfo base
 
   fromStackSetupInfo :: MonadThrow m
                      => Stack.SetupInfo
@@ -201,7 +205,7 @@ etagsFile :: FilePath -> FilePath
 etagsFile = (<.> "etags")
 
 
-getBase :: forall j m env . ( MonadReader env m
+getBase :: forall m env . ( MonadReader env m
            , HasDirs env
            , HasSettings env
            , MonadFail m
@@ -209,10 +213,9 @@ getBase :: forall j m env . ( MonadReader env m
            , MonadCatch m
            , HasLog env
            , MonadMask m
-           , FromJSON j
            )
         => URI
-        -> Excepts '[DownloadFailed, GPGError, DigestError, ContentLengthError, JSONError, FileDoesNotExistError] m j
+        -> Excepts '[DownloadFailed, GPGError, DigestError, ContentLengthError] m FilePath
 getBase uri = do
   Settings { noNetwork, downloader, metaMode } <- lift getSettings
 
@@ -232,25 +235,8 @@ getBase uri = do
                $ uri
 
   -- if we didn't get a filepath from the download, use the cached yaml
-  actualYaml <- maybe (lift $ yamlFromCache uri) pure mYaml
-  lift $ logDebug $ "Decoding yaml at: " <> T.pack actualYaml
-
-  liftE
-    . onE_ (onError actualYaml)
-    . lEM' @_ @_ @'[JSONError] (\(displayException -> e) -> JSONDecodeError $ unlines [e, "Consider removing " <> actualYaml <> " manually."])
-    . liftIO
-    . Y.decodeFileEither
-    $ actualYaml
+  maybe (lift $ yamlFromCache uri) pure mYaml
  where
-  -- On error, remove the etags file and set access time to 0. This should ensure the next invocation
-  -- may re-download and succeed.
-  onError :: (MonadReader env m, HasLog env, MonadMask m, MonadCatch m, MonadIO m) => FilePath -> m ()
-  onError fp = do
-    let efp = etagsFile fp
-    handleIO (\e -> logWarn $ "Couldn't remove file " <> T.pack efp <> ", error was: " <> T.pack (displayException e))
-      (hideError doesNotExistErrorType $ rmFile efp)
-    liftIO $ hideError doesNotExistErrorType $ setAccessTime fp (posixSecondsToUTCTime (fromIntegral @Int 0))
-
   warnCache :: (MonadReader env m, HasLog env, MonadMask m, MonadCatch m, MonadIO m) => FilePath -> Downloader -> m ()
   warnCache s downloader' = do
     let tryDownloder = case downloader' of
@@ -322,6 +308,39 @@ getBase uri = do
 
       pure f
 
+decodeMetadata :: forall j m env .
+               ( MonadReader env m
+               , HasDirs env
+               , HasSettings env
+               , MonadFail m
+               , MonadIO m
+               , MonadCatch m
+               , HasLog env
+               , MonadMask m
+               , FromJSON j
+               )
+               => FilePath
+               -> Excepts '[JSONError, FileDoesNotExistError] m j
+decodeMetadata actualYaml = do
+  lift $ logDebug $ "Decoding yaml at: " <> T.pack actualYaml
+
+  liftE
+    . onE_ (onError actualYaml)
+    . lEM' @_ @_ @'[JSONError] (\(displayException -> e) -> JSONDecodeError $ unlines [e, "Consider removing " <> actualYaml <> " manually."])
+    . liftIO
+    . Y.decodeFileEither
+    $ actualYaml
+ where
+  -- On error, remove the etags file and set access time to 0. This should ensure the next invocation
+  -- may re-download and succeed.
+  onError :: (MonadReader env m, HasLog env, MonadMask m, MonadCatch m, MonadIO m) => FilePath -> m ()
+  onError fp = do
+    let efp = etagsFile fp
+    handleIO (\e -> logWarn $ "Couldn't remove file " <> T.pack efp <> ", error was: " <> T.pack (displayException e))
+      (hideError doesNotExistErrorType $ rmFile efp)
+    liftIO $ hideError doesNotExistErrorType $ setAccessTime fp (posixSecondsToUTCTime (fromIntegral @Int 0))
+
+
 getDownloadInfo :: ( MonadReader env m
                    , HasPlatformReq env
                    , HasGHCupInfo env

lib/GHCup/Errors.hs

@@ -724,7 +724,7 @@ data InstallSetError = forall xs1 xs2 . (Show (V xs1), Pretty (V xs1), HFErrorPr
 
 instance Pretty InstallSetError where
   pPrint (InstallSetError reason1 reason2) =
-     text "Both installation and setting the tool failed. Install error was:"
+     text "Both installation and setting the tool failed.\nInstall error was:"
       <+> pPrint reason1
       <+> text "\nSet error was:"
       <+> pPrint reason2

lib/GHCup/Stack.hs

@@ -234,7 +234,7 @@ setStack ver = do
 
   liftIO (isShadowed stackbin) >>= \case
     Nothing -> pure ()
-    Just pa -> lift $ logWarn $ T.pack $ prettyHFError (ToolShadowed Cabal pa stackbin ver)
+    Just pa -> lift $ logWarn $ T.pack $ prettyHFError (ToolShadowed Stack pa stackbin ver)
 
   pure ()
 

lib/GHCup/Types.hs

@@ -398,7 +398,7 @@ data UserSettings = UserSettings
   , uPlatformOverride :: Maybe PlatformRequest
   , uMirrors     :: Maybe DownloadMirrors
   }
-  deriving (Show, GHC.Generic)
+  deriving (Show, GHC.Generic, Eq)
 
 defaultUserSettings :: UserSettings
 defaultUserSettings = UserSettings Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
@@ -459,7 +459,7 @@ data UserKeyBindings = UserKeyBindings
   , kShowAll      :: Maybe KeyCombination
   , kShowAllTools :: Maybe KeyCombination
   }
-  deriving (Show, GHC.Generic)
+  deriving (Show, GHC.Generic, Eq)
 
 data KeyBindings = KeyBindings
   { bUp              :: KeyCombination
@@ -475,7 +475,7 @@ data KeyBindings = KeyBindings
   deriving (Show, GHC.Generic)
 
 instance NFData KeyBindings
-#if defined(IS_WINDOWS) || !defined(BRICK)
+#if !defined(BRICK)
 instance NFData Key
 
 instance NFData Modifier

lib/GHCup/Types/Stack.hs

@@ -50,7 +50,7 @@ instance FromJSON SetupInfo where
     siSevenzExe <- o .:? "sevenzexe-info"
     siSevenzDll <- o .:? "sevenzdll-info"
     siMsys2     <- o .:? "msys2"          .!= mempty
-    siGHCs      <- o .:? "ghc"            .!= mempty
+    siGHCs      <- o .: "ghc"
     siStack     <- o .:? "stack"          .!= mempty
     pure SetupInfo {..}
 

scripts/bootstrap/bootstrap-haskell

@@ -28,7 +28,7 @@
 
 plat="$(uname -s)"
 arch=$(uname -m)
-ghver="0.1.19.4"
+ghver="0.1.20.0"
 : "${GHCUP_BASE_URL:=https://downloads.haskell.org/~ghcup}"
 
 export GHCUP_SKIP_UPDATE_CHECK=yes
@@ -172,9 +172,8 @@ _done() {
 				green "Start a new haskell project in the current directory via:"
 				green "  cabal init --interactive"
 				green
-				green "Install other GHC versions and tools via:"
-				green "  ghcup list"
-				green "  ghcup install <tool> <version>"
+				green "To install other GHC versions and tools, run:"
+				green "  ghcup tui"
 				green
 				green "To install system libraries and update msys2/mingw64,"
 				green "open the \"Mingw haskell shell\""

scripts/bootstrap/bootstrap-haskell.ps1

@@ -11,7 +11,7 @@
     * cabal - The Cabal build tool for managing Haskell software"
     * stack - (optional) A cross-platform program for developing Haskell projects"
     * hls   - (optional) A language server for developers to integrate with their editor/IDE"
-    
+
 	By default, the installation is non-interactive, unless you run it with 'Interactive $true'.
 #>
 param (
@@ -42,7 +42,9 @@ param (
     # The Msys2 version to download (e.g. 20221216)
     [string]$Msys2Version,
     # The Msys2 sha256sum hash
-    [string]$Msys2Hash
+    [string]$Msys2Hash,
+    # Whether to disable creation of several desktop shortcuts
+    [switch]$DontWriteDesktopShortcuts
 )
 
 $DefaultMsys2Version = "20221216"
@@ -139,7 +141,7 @@ filter Get-FileSize {
 function Get-FileWCSynchronous{
     param(
         [Parameter(Mandatory=$true)]
-        [string]$url, 
+        [string]$url,
         [string]$destinationFolder="$env:USERPROFILE\Downloads",
         [switch]$includeStats
     )
@@ -229,7 +231,7 @@ if ($GhcupBasePrefixEnv) {
     Print-Msg -color Green -msg ("Picked {0} as default Install prefix!" -f $defaultGhcupBasePrefix)
   } else {
     Print-Msg -color Red -msg "Couldn't find a writable partition with at least 5GB free disk space!"
-    Exit 1    
+    Exit 1
   }
 }
 
@@ -274,7 +276,7 @@ Press enter to accept the default [{0}]:
     if (!($GhcupBasePrefix.EndsWith('\'))) {
       $GhcupBasePrefix = ('{0}\' -f $GhcupBasePrefix)
     }
-  
+
     $GhcupBasePrefix = $GhcupBasePrefix.TrimEnd().TrimStart()
     if (!($GhcupBasePrefix)) {
       Print-Msg -color Red -msg "No directory specified!"
@@ -350,7 +352,7 @@ if ($CabalDir) {
   $CabDirEnv = $CabalDir
   if (!($CabDirEnv)) {
     Print-Msg -color Red -msg "No directory specified!"
-    Exit 1        
+    Exit 1
   } elseif (!(Split-Path -IsAbsolute -Path "$CabDirEnv")) {
     Print-Msg -color Red -msg "Invalid/Non-absolute Path specified"
     Exit 1
@@ -365,7 +367,7 @@ if ($CabalDir) {
 
     $CabDirEnv = $CabDirEnv.TrimEnd().TrimStart()
     if (!($CabDirEnv)) {
-      Print-Msg -color Red -msg "No directory specified!"         
+      Print-Msg -color Red -msg "No directory specified!"
     } elseif (!(Split-Path -IsAbsolute -Path "$CabDirEnv")) {
       Print-Msg -color Red -msg "Invalid/Non-absolute Path specified"
     } else {
@@ -410,6 +412,26 @@ if (!($InstallStack)) {
   }
 }
 
+if ($Interactive) {
+	$DesktopDecision = $Host.UI.PromptForChoice('Create Desktop shortcuts'
+                                        , 'Do you want to create convenience desktop shortcuts (e.g. for uninstallation and msys2 shell)?'
+                                        , [System.Management.Automation.Host.ChoiceDescription[]] @('&Yes'
+                                            '&No'
+                                            '&Abort'), 0)
+	if ($DesktopDecision -eq 0) {
+      $InstallDesktopShortcuts = $true
+    } elseif ($DesktopDecision -eq 2) {
+      Exit 0
+    }
+} else {
+	if ($Minimal) {
+      $InstallDesktopShortcuts = $false
+	} elseif ($DontWriteDesktopShortcuts) {
+      $InstallDesktopShortcuts = $false
+	} else {
+      $InstallDesktopShortcuts = $true
+	}
+}
 
 # mingw foo
 Print-Msg -msg 'First checking for Msys2...'
@@ -485,12 +507,12 @@ if (!(Test-Path -Path ('{0}' -f $MsysDir))) {
         $MsysDirPrompt = Read-Host
         $MsysDir = ($defaultMsys2Dir,$MsysDirPrompt)[[bool]$MsysDirPrompt]
       } else {
-        Print-Msg -color Magenta -msg 'Input existing MSys2 toolchain directory:' 
+        Print-Msg -color Magenta -msg 'Input existing MSys2 toolchain directory:'
         $MsysDir = Read-Host
       }
       $MsysDir = $MsysDir.TrimEnd().TrimStart()
       if (!($MsysDir)) {
-        Print-Msg -color Red -msg "No directory specified!"         
+        Print-Msg -color Red -msg "No directory specified!"
       } elseif (!(Test-Path -LiteralPath ('{0}' -f $MsysDir))) {
         Print-Msg -color Red -msg ('MSys2 installation at ''{0}'' could not be found!' -f $MsysDir)
       } elseif (!(Split-Path -IsAbsolute -Path "$MsysDir")) {
@@ -510,8 +532,11 @@ if (!(Test-Path -Path ('{0}' -f $MsysDir))) {
 	Start-Sleep -s 5
 }
 
-Print-Msg -msg 'Creating shortcuts...'
-$uninstallShortCut = @'
+
+if ($InstallDesktopShortcuts) {
+
+	Print-Msg -msg 'Creating shortcuts...'
+	$uninstallShortCut = @'
 $decision = $Host.UI.PromptForChoice('Uninstall Haskell'
 , 'Do you want to uninstall all of the haskell toolchain, including GHC, Cabal, Stack and GHCup itself?'
 , [System.Management.Automation.Host.ChoiceDescription[]] @('&Uninstall'
@@ -573,12 +598,13 @@ if ($Host.Name -eq "ConsoleHost")
 }
 '@
 
-$GhcInstArgs = '-mingw64 -mintty -c "pacman --noconfirm -S --needed base-devel gettext autoconf make libtool automake python p7zip patch unzip"'
-Create-Shortcut -SourceExe ('{0}\msys2_shell.cmd' -f $MsysDir) -ArgumentsToSourceExe $GhcInstArgs -DestinationPath 'Install GHC dev dependencies.lnk' -TempPath $GhcupDir
-Create-Shortcut -SourceExe ('{0}\msys2_shell.cmd' -f $MsysDir) -ArgumentsToSourceExe '-mingw64' -DestinationPath 'Mingw haskell shell.lnk' -TempPath $GhcupDir
-Create-Shortcut -SourceExe 'https://www.msys2.org/docs/package-management' -ArgumentsToSourceExe '' -DestinationPath 'Mingw package management docs.url' -TempPath $GhcupDir
-$DesktopDir = [Environment]::GetFolderPath("Desktop")
-$null = New-Item -Path $DesktopDir -Name "Uninstall Haskell.ps1" -ItemType "file" -Force -Value $uninstallShortCut
+	$GhcInstArgs = '-mingw64 -mintty -c "pacman --noconfirm -S --needed base-devel gettext autoconf make libtool automake python p7zip patch unzip"'
+	Create-Shortcut -SourceExe ('{0}\msys2_shell.cmd' -f $MsysDir) -ArgumentsToSourceExe $GhcInstArgs -DestinationPath 'Install GHC dev dependencies.lnk' -TempPath $GhcupDir
+	Create-Shortcut -SourceExe ('{0}\msys2_shell.cmd' -f $MsysDir) -ArgumentsToSourceExe '-mingw64' -DestinationPath 'Mingw haskell shell.lnk' -TempPath $GhcupDir
+	Create-Shortcut -SourceExe 'https://www.msys2.org/docs/package-management' -ArgumentsToSourceExe '' -DestinationPath 'Mingw package management docs.url' -TempPath $GhcupDir
+	$DesktopDir = [Environment]::GetFolderPath("Desktop")
+	$null = New-Item -Path $DesktopDir -Name "Uninstall Haskell.ps1" -ItemType "file" -Force -Value $uninstallShortCut
+}
 
 Print-Msg -msg ('Adding {0}\bin to Users Path...' -f $GhcupDir)
 Add-EnvPath -Path ('{0}\bin' -f ([System.IO.Path]::GetFullPath("$GhcupDir"))) -Container 'User'