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

@@ -555,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
@@ -563,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 ()

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

@@ -140,16 +140,18 @@ GHCup supports the following tools, which are also known as the **Haskell Toolch
 <table>
 <thead><tr><th>GHC Version</th><th>Tags</th></tr></thead>
 <tbody>
-<tr><td>9.6.2</td><td><span style="color:blue">latest</span>, base-4.18.0.0</td></tr>
+<tr><td>9.8.1</td><td><span style="color:blue">latest</span>, base-4.19.0.0</td></tr>
+<tr><td>9.6.3</td><td>base-4.18.1.0</td></tr>
+<tr><td>9.6.2</td><td>base-4.18.0.0</td></tr>
 <tr><td>9.6.1</td><td>base-4.18.0.0</td></tr>
-<tr><td>9.4.7</td><td>base-4.17.2.0</td></tr>
+<tr><td>9.4.7</td><td><span style="color:green">recommended</span>, base-4.17.2.0</td></tr>
 <tr><td>9.4.6</td><td>base-4.17.2.0</td></tr>
 <tr><td>9.4.5</td><td>base-4.17.1.0</td></tr>
 <tr><td>9.4.4</td><td>base-4.17.0.0</td></tr>
 <tr><td>9.4.3</td><td>base-4.17.0.0</td></tr>
 <tr><td>9.4.2</td><td>base-4.17.0.0</td></tr>
 <tr><td>9.4.1</td><td>base-4.17.0.0</td></tr>
-<tr><td>9.2.8</td><td><span style="color:green">recommended</span>, base-4.16.4.0</td></tr>
+<tr><td>9.2.8</td><td>base-4.16.4.0</td></tr>
 <tr><td>9.2.7</td><td>base-4.16.4.0</td></tr>
 <tr><td>9.2.6</td><td>base-4.16.4.0</td></tr>
 <tr><td>9.2.5</td><td>base-4.16.4.0</td></tr>
@@ -190,7 +192,8 @@ GHCup supports the following tools, which are also known as the **Haskell Toolch
 <table>
 <thead><tr><th>Cabal Version</th><th>Tags</th></tr></thead>
 <tbody>
-<tr><td>3.10.1.0</td><td><span style="color:blue">latest</span></td></tr>
+<tr><td>3.10.2.0</td><td><span style="color:blue">latest</span></td></tr>
+<tr><td>3.10.1.0</td><td></td></tr>
 <tr><td>3.8.1.0</td><td></td></tr>
 <tr><td>3.6.2.0</td><td><span style="color:green">recommended</span></td></tr>
 <tr><td>3.6.0.0</td><td></td></tr>
@@ -234,8 +237,9 @@ GHCup supports the following tools, which are also known as the **Haskell Toolch
 <table>
 <thead><tr><th>Stack Version</th><th>Tags</th></tr></thead>
 <tbody>
-<tr><td>2.11.1</td><td><span style="color:blue">latest</span></td></tr>
+<tr><td>2.13.1</td><td><span style="color:blue">latest</span></td></tr>
-<tr><td>2.9.3</td><td><span style="color:green">recommended</span></td></tr>
+<tr><td>2.11.1</td><td><span style="color:green">recommended</span></td></tr>
+<tr><td>2.9.3</td><td></td></tr>
 <tr><td>2.9.1</td><td></td></tr>
 <tr><td>2.7.5</td><td></td></tr>
 <tr><td>2.7.3</td><td></td></tr>
@@ -251,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 | ✅ | ✅ | ✅ | ✅ | ✅ |
@@ -267,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:
+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
-* [https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/140](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/140)
+version is now 8.1.
-* [https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/197](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/197)
 
 ### 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

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' NewGHCupURL       = fmap Left $ liftE (getBase ghcupURL) >>= liftE . decodeMetadata @GHCupInfo
-  dl' NewStackSetupURL  = fmap Right $ liftE $ getBase @Stack.SetupInfo stackSetupURL
+  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)
+  dl' (NewURI uri)      = do
-                            $ fmap Left $ getBase @GHCupInfo uri
+                            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
+  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
  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

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

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"'
+	$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 $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 ('{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
+	Create-Shortcut -SourceExe 'https://www.msys2.org/docs/package-management' -ArgumentsToSourceExe '' -DestinationPath 'Mingw package management docs.url' -TempPath $GhcupDir
-$DesktopDir = [Environment]::GetFolderPath("Desktop")
+	$DesktopDir = [Environment]::GetFolderPath("Desktop")
-$null = New-Item -Path $DesktopDir -Name "Uninstall Haskell.ps1" -ItemType "file" -Force -Value $uninstallShortCut
+	$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'

scripts/hooks/stack/ghc-install.sh

@@ -9,8 +9,8 @@ set -eu
 
 case $HOOK_GHC_TYPE in
     bindist)
-        ghcdir=$(ghcup whereis --directory ghc "$HOOK_GHC_VERSION" || ghcup run --ghc "$HOOK_GHC_VERSION" --install) || exit 3
+        ghc_path=$(ghcup whereis ghc "$HOOK_GHC_VERSION" || { ghcup install ghc "$HOOK_GHC_VERSION" >/dev/null && ghcup whereis ghc "$HOOK_GHC_VERSION" ; }) || { >&2 echo "Installing $HOOK_GHC_VERSION via ghcup failed" exit 3 ;}
-        printf "%s/ghc" "${ghcdir}"
+        printf "%s" "${ghc_path}"
         ;;
     git)
         # TODO: should be somewhat possible