From abbe51614d92ccca765b2bffb17b8135790f06cd Mon Sep 17 00:00:00 2001
From: Julian Ospald <hasufell@posteo.de>
Date: Wed, 7 Jul 2021 23:14:26 +0200
Subject: [PATCH] Improve uninstallation on windows wrt #150

---
 bootstrap-haskell.ps1 | 54 +++++++++++++++++++++++++++++++++++++++++++
 lib/GHCup.hs          |  8 ++++---
 2 files changed, 59 insertions(+), 3 deletions(-)

diff --git a/bootstrap-haskell.ps1 b/bootstrap-haskell.ps1
index 7a7cbce..d9e3dc8 100644
--- a/bootstrap-haskell.ps1
+++ b/bootstrap-haskell.ps1
@@ -333,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'
diff --git a/lib/GHCup.hs b/lib/GHCup.hs
index 1b5f777..60215be 100644
--- a/lib/GHCup.hs
+++ b/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 =