Improve uninstallation on windows wrt #150

HACKING.md

@@ -69,7 +69,3 @@ yaml files: `ghcup-<yaml-ver>.yaml`.
    Most of the `Version` parameters to functions had to be replaced with
    that and ensured the logic is consistent for cross and non-cross
    installs.
-2. This refactor added windows support wrt [#130](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/130).
-   The major changes here were switching `hpath` library out for `filepath`/`directory` (sadly) and
-   introducing a non-unix way of handling processes via the `process` library. It also introduced considerable
-   amounts of CPP wrt file handling, installation etc.

bootstrap-haskell.ps1

@@ -150,15 +150,6 @@ function Exec
 
 $ErrorActionPreference = 'Stop'
 
-$elevated = ([Security.Principal.WindowsPrincipal] `
- [Security.Principal.WindowsIdentity]::GetCurrent()
-).IsInRole([Security.Principal.WindowsBuiltInRole]::Administrator)
-
-if ($elevated) {
-  Print-Msg -color Yellow -msg ('This script should not be run as administrator/elevated. Waiting 10s before continuing anyway...')
-  Start-Sleep -s 10
-}
-
 $GhcupBasePrefixEnv = [System.Environment]::GetEnvironmentVariable('GHCUP_INSTALL_BASE_PREFIX', 'user')
 
 if ($GhcupBasePrefixEnv) {
@@ -342,11 +333,65 @@ if (!(Test-Path -Path ('{0}' -f $MsysDir))) {
 }
 
 Print-Msg -msg 'Creating shortcuts...'
+$uninstallShortCut = @'
+Write-Host 'Removing ghcup toolchain' -ForegroundColor Green
+ghcup nuke
+
+Write-Host 'Unsetting GHCUP_INSTALL_BASE_PREFIX' -ForegroundColor Green
+[Environment]::SetEnvironmentVariable('GHCUP_INSTALL_BASE_PREFIX', $null, [System.EnvironmentVariableTarget]::User)
+
+$ghcupMsys2 = [System.Environment]::GetEnvironmentVariable('GHCUP_MSYS2', 'user')
+$GhcupBasePrefixEnv = [System.Environment]::GetEnvironmentVariable('GHCUP_INSTALL_BASE_PREFIX', 'user')
+
+if ($ghcupMsys2) {
+  $msys2Dir = [IO.Path]::GetFullPath($ghcupMsys2)
+  $baseDir = [IO.Path]::GetFullPath('{0}\ghcup' -f $GhcupBasePrefixEnv)
+
+  if ($msys2Dir.StartsWith($baseDir)) {
+    Write-Host 'Unsetting GHCUP_MSYS2' -ForegroundColor Green
+    [Environment]::SetEnvironmentVariable('GHCUP_MSYS2', $null, [System.EnvironmentVariableTarget]::User)
+  } else {
+    Write-Host ('GHCUP_MSYS2 env variable is set to a non-standard location {0}. Environment variable not unset. Uninstall manually.' -f $msys2Dir) -ForegroundColor Magenta
+  }
+} else {
+  Write-Host 'Unsetting GHCUP_MSYS2' -ForegroundColor Green
+  [Environment]::SetEnvironmentVariable('GHCUP_MSYS2', $null, [System.EnvironmentVariableTarget]::User)
+}
+
+Write-Host 'Removing ghcup from PATH env var' -ForegroundColor Green
+$path = [System.Environment]::GetEnvironmentVariable(
+    'PATH',
+    'user'
+)
+$path = ($path.Split(';') | Where-Object { $_ -ne ('{0}\bin' -f $baseDir) }) -join ';'
+[System.Environment]::SetEnvironmentVariable(
+    'PATH',
+    $path,
+    'user'
+)
+
+Write-Host 'Removing desktop files' -ForegroundColor Green
+$DesktopDir = [Environment]::GetFolderPath("Desktop")
+Remove-Item -LiteralPath ('{0}\Install GHC dev dependencies.lnk' -f $DesktopDir) -Force
+Remove-Item -LiteralPath ('{0}\Mingw haskell shell.lnk' -f $DesktopDir) -Force
+Remove-Item -LiteralPath ('{0}\Mingw package management docs.url' -f $DesktopDir) -Force
+
+Write-Host ('CABAL_DIR env variable is still set to {0} and will be used by cabal regardless of ghcup. You may want to uninstall this manually.' -f [System.Environment]::GetEnvironmentVariable('CABAL_DIR', 'user')) -ForegroundColor Magenta
+Write-Host 'You may remove this script now.' -ForegroundColor Magenta
+
+if ($Host.Name -eq "ConsoleHost")
+{
+    Write-Host "Press any key to continue..."
+    $Host.UI.RawUI.ReadKey("NoEcho,IncludeKeyUp") > $null
+}
+'@
+
 $DesktopDir = [Environment]::GetFolderPath("Desktop")
 $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 ('{0}\Install GHC dev dependencies.lnk' -f $DesktopDir)
 Create-Shortcut -SourceExe ('{0}\msys2_shell.cmd' -f $MsysDir) -ArgumentsToSourceExe '-mingw64' -DestinationPath ('{0}\Mingw haskell shell.lnk' -f $DesktopDir)
 Create-Shortcut -SourceExe 'https://www.msys2.org/docs/package-management' -ArgumentsToSourceExe '' -DestinationPath ('{0}\Mingw package management docs.url' -f $DesktopDir)
+$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'

ghcup-0.0.5.yaml

@@ -2060,8 +2060,8 @@ ghcupDownloads:
         A_ARM64:
           Linux_UnknownLinux:
             unknown_versioning:
-              dlUri: https://downloads.haskell.org/~ghcup/0.1.15.2/aarch64-linux-ghcup-0.1.15.2-r2
-              dlHash: d67702f7c9e3586e85ed7c1bd09b7544da55bd1d3b4a961a07018348f78cf76b
+              dlUri: https://downloads.haskell.org/~ghcup/0.1.15.2/aarch64-linux-ghcup-0.1.15.2
+              dlHash: d91b7a5416f292f2cf813824eb419f76ad9976d258cee3581123cb6eb01db9a7
           Darwin:
             unknown_versioning:
               dlUri: https://downloads.haskell.org/~ghcup/0.1.15.2/aarch64-apple-darwin-ghcup-0.1.15.2
@@ -2120,17 +2120,8 @@ ghcupDownloads:
         - old
       viChangeLog: https://github.com/commercialhaskell/stack/blob/master/ChangeLog.md#v251
       viPostInstall: &stack-post |
-        Stack manages GHC versions internally by default. In order to make it use ghcup installed
-        GHC versions you can run the following commands:
-          stack config set install-ghc false --global
-          stack config set system-ghc  true  --global
-        
-        On windows, you may find the following config options useful too:
-          skip-msys, extra-path, extra-include-dirs, extra-lib-dirs
-
-        Also check out: https://docs.haskellstack.org/en/stable/yaml_configuration
-
-        !!! Additionally, you should upgrade stack only through ghcup and not use 'stack upgrade' !!!
+        Stack manages GHC versions internally by default. In order to make it use ghcup installed GHC versions have a look at the options 'system-ghc', 'compiler-check' and 'compiler': https://docs.haskellstack.org/en/stable/yaml_configuration/#system-ghc
+        Additionally, you should upgrade stack only through ghcup.
       viArch:
         A_64:
           Linux_UnknownLinux:

lib/GHCup.hs

@@ -1393,12 +1393,14 @@ rmGhcupDirs = do
     rmEnvFile :: (MonadCatch m, MonadLogger m, MonadIO m) => FilePath -> m ()
     rmEnvFile enFilePath = do
       $logInfo "Removing Ghcup Environment File"
-      hideError doesNotExistErrorType $ liftIO $ deleteFile enFilePath
+      hideErrorDef [doesNotExistErrorType, permissionErrorType] ()
+        $ liftIO $ deleteFile enFilePath
 
     rmConfFile :: (MonadCatch m, MonadLogger m, MonadIO m) => FilePath -> m ()
     rmConfFile confFilePath = do
       $logInfo "removing Ghcup Config File"
-      hideError doesNotExistErrorType $ liftIO $ deleteFile confFilePath
+      hideErrorDef [doesNotExistErrorType, permissionErrorType] ()
+        $ liftIO $ deleteFile confFilePath
 
     rmDir :: (MonadLogger m, MonadIO m, MonadCatch m) => FilePath -> m ()
     rmDir dir = do
@@ -1448,7 +1450,7 @@ rmGhcupDirs = do
 
     deleteFile :: FilePath -> IO ()
     deleteFile filepath = do
-      hideError InappropriateType $ rmFile filepath
+      hideErrorDef [InappropriateType, permissionErrorType] () $ rmFile filepath
 
     removeDirIfEmptyOrIsSymlink :: (MonadCatch m, MonadIO m) => FilePath -> m ()
     removeDirIfEmptyOrIsSymlink filepath =

lib/GHCup/Utils/Logger.hs

@@ -20,7 +20,6 @@ import           GHCup.Utils.String.QQ
 import           Control.Monad
 import           Control.Monad.IO.Class
 import           Control.Monad.Logger
-import           Data.Char               ( ord )
 import           Prelude                 hiding ( appendFile )
 import           System.Console.Pretty
 import           System.FilePath
@@ -44,33 +43,20 @@ myLoggerT LoggerConfig {..} loggingt = runLoggingT loggingt mylogger
   mylogger :: Loc -> LogSource -> LogLevel -> LogStr -> IO ()
   mylogger _ _ level str' = do
     -- color output
-    let style' = case level of
-          LevelDebug   -> style Bold . color Blue
-          LevelInfo    -> style Bold . color Green
-          LevelWarn    -> style Bold . color Yellow
-          LevelError   -> style Bold . color Red
-          LevelOther _ -> id
     let l = case level of
-          LevelDebug   -> toLogStr (style' "[ Debug ]")
-          LevelInfo    -> toLogStr (style' "[ Info  ]")
-          LevelWarn    -> toLogStr (style' "[ Warn  ]")
-          LevelError   -> toLogStr (style' "[ Error ]")
+          LevelDebug   -> toLogStr (style Bold $ color Blue "[ Debug ]")
+          LevelInfo    -> toLogStr (style Bold $ color Green "[ Info  ]")
+          LevelWarn    -> toLogStr (style Bold $ color Yellow "[ Warn  ]")
+          LevelError   -> toLogStr (style Bold $ color Red "[ Error ]")
           LevelOther t -> toLogStr "[ " <> toLogStr t <> toLogStr " ]"
-    let strs = fmap toLogStr . B.split (fromIntegral $ ord '\n') . fromLogStr $ str'
-    let out = case strs of
-                [] -> B.empty
-                (x:xs) -> fromLogStr
-                  . foldr (\a b -> a <> toLogStr "\n" <> b) mempty
-                  . ((l <> toLogStr " " <> x) :)
-                  . fmap (\line' -> toLogStr (style' "[ ...   ] ") <> line' )
-                  $ xs
+    let out = fromLogStr (l <> toLogStr " " <> str' <> toLogStr "\n")
 
     when (lcPrintDebug || (not lcPrintDebug && (level /= LevelDebug)))
       $ colorOutter out
 
     -- raw output
     let lr = case level of
-          LevelDebug   -> toLogStr "Debug:"
+          LevelDebug   -> toLogStr "Debug: "
           LevelInfo    -> toLogStr "Info:"
           LevelWarn    -> toLogStr "Warn:"
           LevelError   -> toLogStr "Error:"