Update CHANGELOG

leftover reporting.

.gitlab-ci.yml

@@ -151,7 +151,7 @@ variables:
     function runInNixShell() {
       time nix-shell .gitlab/shell.nix \
         -I nixpkgs=https://github.com/angerman/nixpkgs/archive/75f7281738b.tar.gz \
-        --argstr system "x86_64-darwin" \
+        --argstr system "aarch64-darwin" \
         --pure \
         --keep GHC_VERSION --keep CABAL_INSTALL_VERSION --keep BUILD_FLAVOUR \
         --keep BIN_DIST_PREP_TAR_COMP --keep CPUS --keep PROJECT_DIR \
@@ -398,8 +398,24 @@ release:darwin:aarch64:
     - .darwin:aarch64
     - .release_ghcup
     - .root_cleanup
-  before_script:
-    - ./.gitlab/before_script/darwin/install_deps.sh
+  script: |
+    set -Eeuo pipefail
+    function runInNixShell() {
+      time nix-shell .gitlab/shell.nix \
+        -I nixpkgs=https://github.com/angerman/nixpkgs/archive/75f7281738b.tar.gz \
+        --argstr system "aarch64-darwin" \
+        --pure \
+        --keep GHC_VERSION --keep CABAL_INSTALL_VERSION --keep BUILD_FLAVOUR \
+        --keep BIN_DIST_PREP_TAR_COMP --keep CPUS --keep PROJECT_DIR \
+        --keep CI_PROJECT_DIR --keep MAKE_ARGS --keep HADRIAN_ARGS --keep CABAL_CACHE \
+        --keep LANG --keep CONFIGURE_ARGS --keep TEST_ENV --keep BIN_DIST_NAME \
+        --keep MACOSX_DEPLOYMENT_TARGET --keep ac_cv_func_clock_gettime --keep HACKAGE_INDEX_STATE \
+        --keep CABAL_DIR --keep ARCH --keep OS --keep CABAL_VERSION --keep GHC_VERSION \ 
+        --keep JSON_VERSION --ARTIFACT \
+        --run "$1" 2>&1
+    }
+    runInNixShell ./.gitlab/before_script/darwin/install_deps.sh 2>&1
+    runInNixShell ./.gitlab/script/ghcup_release.sh 2>&1
   variables:
     ARTIFACT: "aarch64-apple-darwin-ghcup"
     GHC_VERSION: "8.10.5"
@@ -417,24 +433,8 @@ release:freebsd:
     - .freebsd
     - .release_ghcup
     - .root_cleanup
-  script: |
-    set -Eeuo pipefail
-    function runInNixShell() {
-      time nix-shell .gitlab/shell.nix \
-        -I nixpkgs=https://github.com/angerman/nixpkgs/archive/75f7281738b.tar.gz \
-        --argstr system "x86_64-darwin" \
-        --pure \
-        --keep GHC_VERSION --keep CABAL_INSTALL_VERSION --keep BUILD_FLAVOUR \
-        --keep BIN_DIST_PREP_TAR_COMP --keep CPUS --keep PROJECT_DIR \
-        --keep CI_PROJECT_DIR --keep MAKE_ARGS --keep HADRIAN_ARGS --keep CABAL_CACHE \
-        --keep LANG --keep CONFIGURE_ARGS --keep TEST_ENV --keep BIN_DIST_NAME \
-        --keep MACOSX_DEPLOYMENT_TARGET --keep ac_cv_func_clock_gettime --keep HACKAGE_INDEX_STATE \
-        --keep CABAL_DIR --keep ARCH --keep OS --keep CABAL_VERSION --keep GHC_VERSION \ 
-        --keep JSON_VERSION --ARTIFACT \
-        --run "$1" 2>&1
-    }
-    runInNixShell ./.gitlab/before_script/freebsd/install_deps.sh 2>&1
-    runInNixShell ./.gitlab/script/ghcup_release.sh 2>&1
+  before_script:
+    - ./.gitlab/before_script/freebsd/install_deps.sh
   variables:
     ARTIFACT: "x86_64-portbld-freebsd-ghcup"
     GHC_VERSION: "8.10.5"

CHANGELOG.md

@@ -1,5 +1,9 @@
 # Revision history for ghcup
 
+## 0.1.16 -- ????-??-??
+
+* Add 'nuke' subcommand wrt [#135](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/135), implemented by Arjun Kathuria
+
 ## 0.1.15.2 -- 2021-06-13
 
 * Remove legacy handling of cabal binary and be more graceful about binaries not installed by ghcup (e.g. stack)

app/ghcup/Main.hs

@@ -103,6 +103,7 @@ data Command
   | Upgrade UpgradeOpts Bool
   | ToolRequirements
   | ChangeLog ChangeLogOptions
+  | Nuke
 #if defined(BRICK)
   | Interactive
 #endif
@@ -219,7 +220,7 @@ invertableSwitch'
     -> Mod FlagFields Bool -- ^ option modifier for --no-foo
     -> Parser (Maybe Bool)
 invertableSwitch' longopt shortopt defv enmod dismod = optional
-    ( flag' True (enmod <> long longopt <> if defv then mempty else short shortopt)
+    ( flag' True ( enmod <> long longopt <> if defv then mempty else short shortopt)
     <|> flag' False (dismod <> long nolongopt <> if defv then short shortopt else mempty)
     )
   where
@@ -368,6 +369,14 @@ com =
               )
           <> internal
           )
+     <|> subparser
+          (command
+              "nuke"
+               (info (pure Nuke <**> helper)
+                     (progDesc "Completely remove ghcup from your system"))
+           <> commandGroup "Nuclear Commands:"
+          )
+
  where
   installToolFooter :: String
   installToolFooter = [s|Discussion:
@@ -393,7 +402,6 @@ com =
   By default returns the URI of the ChangeLog of the latest GHC release.
   Pass '-o' to automatically open via xdg-open.|]
 
-
 installCabalFooter :: String
 installCabalFooter = [s|Discussion:
   Installs the specified cabal-install version (or a recommended default one)
@@ -1105,7 +1113,10 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
           let loggerConfig = LoggerConfig
                 { lcPrintDebug = verbose settings
                 , colorOutter  = B.hPut stderr
-                , rawOutter    = B.appendFile logfile
+                , rawOutter    =
+                    case optCommand of
+                      Nuke -> \_ -> pure ()
+                      _ -> B.appendFile logfile
                 }
           let runLogger = myLoggerT loggerConfig
           let siletRunLogger = myLoggerT loggerConfig { colorOutter = \_ -> pure () }
@@ -1693,9 +1704,41 @@ Make sure to clean up #{tmpdir} afterwards.|])
                                 >> pure (ExitFailure 13)
                     else putStrLn uri' >> pure ExitSuccess
 
+            Nuke ->
+              runRm (do
+                   lift $ $logWarn "WARNING: This will remove GHCup and all installed components from your system."
+                   lift $ $logWarn "Waiting 10 seconds before commencing, if you want to cancel it, now would be the time."
+                   liftIO $ threadDelay 10000000  -- wait 10s
+
+                   lift $ $logInfo "Initiating Nuclear Sequence 🚀🚀🚀"
+                   lift $ $logInfo "Nuking in 3...2...1"
+              
+                   lInstalled <- lift $ listVersions Nothing (Just ListInstalled)
+
+                   forM_ lInstalled (liftE . rmTool)
+
+                   lift rmGhcupDirs
+
+                   ) >>= \case
+                            VRight leftOverFiles
+                              | null leftOverFiles -> do
+                                  runLogger $ $logInfo "Nuclear Annihilation complete!"
+                                  pure ExitSuccess
+                              | otherwise -> do
+                                  runLogger $ $logWarn "These Files have survived Nuclear Annihilation, you may remove them manually."
+                                  forM_ leftOverFiles putStrLn
+                                  pure ExitSuccess
+
+                            VLeft e -> do
+                              runLogger $ $(logError) $ T.pack $ prettyShow e
+                              pure $ ExitFailure 15
+
+
           case res of
             ExitSuccess        -> pure ()
             ef@(ExitFailure _) -> exitWith ef
+
+
   pure ()
 
 fromVersion :: (MonadLogger m, MonadFail m, MonadReader AppState m, MonadThrow m, MonadIO m, MonadCatch m)

bootstrap-haskell

@@ -16,7 +16,7 @@
 
 plat="$(uname -s)"
 arch=$(uname -m)
-ghver="0.1.15.1"
+ghver="0.1.15.2"
 base_url="https://downloads.haskell.org/~ghcup"
 
 case "${plat}" in

ghcup-0.0.4.yaml

@@ -1868,7 +1868,7 @@ ghcupDownloads:
               dlUri: https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal/3.4.0.0/cabal-install-3.4.0.0-armv7-linux-bootstrapped.tar.xz
               dlHash: 16c0d1eaba24bed14f3e152970179a45d9f9bb5cc839b2c210ad06eb7d4826ed
   GHCup:
-    0.1.15.1:
+    0.1.15.2:
       viTags:
       - Recommended
       - Latest
@@ -1878,39 +1878,39 @@ ghcupDownloads:
         A_64:
           Linux_UnknownLinux:
             unknown_versioning: &ghcup-64
-              dlUri: https://downloads.haskell.org/~ghcup/0.1.15.1/x86_64-linux-ghcup-0.1.15.1
-              dlHash: 871c9dc1bfbf7df6fe3b9b7250c20a3dae8a7aee171712a3e63689ab75bc9439
+              dlUri: https://downloads.haskell.org/~ghcup/0.1.15.2/x86_64-linux-ghcup-0.1.15.2
+              dlHash: 1eb1bb318a327754f42eaa2245bc81fe53be7c791160d28a186893ded3004ed7
           Darwin:
             unknown_versioning:
-              dlUri: https://downloads.haskell.org/~ghcup/0.1.15.1/x86_64-apple-darwin-ghcup-0.1.15.1
-              dlHash: 7cd67b554fc58c4ffb224b73e369c5dd27c5276c01f102f6423230b34cc635bc
+              dlUri: https://downloads.haskell.org/~ghcup/0.1.15.2/x86_64-apple-darwin-ghcup-0.1.15.2
+              dlHash: c2a6436a49f19f108493954d4a3efcb27503e343dd6288c2641784d32320b1ea
           FreeBSD:
             unknown_versioning:
-              dlUri: https://downloads.haskell.org/~ghcup/0.1.15.1/x86_64-portbld-freebsd-ghcup-0.1.15.1
-              dlHash: b4ad9c9f1a878560e8f770d985d53b8fb70582baf99e40e53ec9ee97dc47ae64
+              dlUri: https://downloads.haskell.org/~ghcup/0.1.15.2/x86_64-portbld-freebsd-ghcup-0.1.15.2
+              dlHash: 7e0c17dd78ebd9fd03e6ecea278c192bac31ca333721bde5b0ef99438b847a20
           Linux_Alpine:
             unknown_versioning: *ghcup-64
         A_32:
           Linux_UnknownLinux:
             unknown_versioning: &ghcup-32
-              dlUri: https://downloads.haskell.org/~ghcup/0.1.15.1/i386-linux-ghcup-0.1.15.1
-              dlHash: 0c1dcbdd7cfa8accdfbe14c623924f3ca29a35d32a2ac3e61f0eb322855e2cb1
+              dlUri: https://downloads.haskell.org/~ghcup/0.1.15.2/i386-linux-ghcup-0.1.15.2
+              dlHash: 3b1fe710cded0398e920ec9716089ba65226abf181741897f387e7c539a619c2
           Linux_Alpine:
             unknown_versioning: *ghcup-32
         A_ARM64:
           Linux_UnknownLinux:
             unknown_versioning:
-              dlUri: https://downloads.haskell.org/~ghcup/0.1.15.1/aarch64-linux-ghcup-0.1.15.1
-              dlHash: 7fa29d8e9a9fe3d1e3a63a1d16fc3550128edbdb9b5b5dff7974358c4dab192c
+              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.1/aarch64-apple-darwin-ghcup-0.1.15.1
-              dlHash: 6a743cd50e8124ac2de8be77013d49dcf3b99ce7cc463ec86ed99a904a51dfd9
+              dlUri: https://downloads.haskell.org/~ghcup/0.1.15.2/aarch64-apple-darwin-ghcup-0.1.15.2
+              dlHash: 20625ba5e7488f2a6155331750ecead3815ea16b2695c20521633c1412f012cc
         A_ARM:
           Linux_UnknownLinux:
             unknown_versioning:
-              dlUri: https://downloads.haskell.org/~ghcup/0.1.15.1/armv7-linux-ghcup-0.1.15.1
-              dlHash: 77ee5d9828c2ba771127274e301e81412b9f29af2d65dd85dada4786d9438c2c
+              dlUri: https://downloads.haskell.org/~ghcup/0.1.15.2/armv7-linux-ghcup-0.1.15.2
+              dlHash: 03a4af5ed895ada1dd21f4cc3f64dc9078a5bf4268313021d004c04bea7f9c2e
   HLS:
     1.1.0:
       viTags:

ghcup-0.0.5.yaml

@@ -2024,7 +2024,7 @@ ghcupDownloads:
               dlUri: https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal/3.4.0.0/cabal-install-3.4.0.0-armv7-linux-bootstrapped.tar.xz
               dlHash: 16c0d1eaba24bed14f3e152970179a45d9f9bb5cc839b2c210ad06eb7d4826ed
   GHCup:
-    0.1.15.1:
+    0.1.15.2:
       viTags:
       - Recommended
       - Latest
@@ -2034,48 +2034,46 @@ ghcupDownloads:
         A_64:
           Linux_UnknownLinux:
             unknown_versioning: &ghcup-64
-              dlUri: https://downloads.haskell.org/~ghcup/0.1.15.1/x86_64-linux-ghcup-0.1.15.1
-              dlHash: 871c9dc1bfbf7df6fe3b9b7250c20a3dae8a7aee171712a3e63689ab75bc9439
+              dlUri: https://downloads.haskell.org/~ghcup/0.1.15.2/x86_64-linux-ghcup-0.1.15.2
+              dlHash: 1eb1bb318a327754f42eaa2245bc81fe53be7c791160d28a186893ded3004ed7
           Darwin:
             unknown_versioning:
-              dlUri: https://downloads.haskell.org/~ghcup/0.1.15.1/x86_64-apple-darwin-ghcup-0.1.15.1
-              dlHash: 7cd67b554fc58c4ffb224b73e369c5dd27c5276c01f102f6423230b34cc635bc
+              dlUri: https://downloads.haskell.org/~ghcup/0.1.15.2/x86_64-apple-darwin-ghcup-0.1.15.2
+              dlHash: c2a6436a49f19f108493954d4a3efcb27503e343dd6288c2641784d32320b1ea
           FreeBSD:
             unknown_versioning:
-              dlUri: https://downloads.haskell.org/~ghcup/0.1.15.1/x86_64-portbld-freebsd-ghcup-0.1.15.1
-              dlHash: b4ad9c9f1a878560e8f770d985d53b8fb70582baf99e40e53ec9ee97dc47ae64
+              dlUri: https://downloads.haskell.org/~ghcup/0.1.15.2/x86_64-portbld-freebsd-ghcup-0.1.15.2
+              dlHash: 7e0c17dd78ebd9fd03e6ecea278c192bac31ca333721bde5b0ef99438b847a20
           Windows:
             unknown_versioning:
-              dlUri: https://downloads.haskell.org/~ghcup/0.1.15.1/x86_64-mingw64-ghcup-0.1.15.1.exe
-              dlHash: 045bac4620fc9d1119ed4961aeba46b616ed572dd11b7d35b48caf58eea08d0f
+              dlUri: https://downloads.haskell.org/~ghcup/0.1.15.2/x86_64-mingw64-ghcup-0.1.15.2.exe
+              dlHash: 4d832052754379531ac472aeef35666e433acfee79d4079826b8ede8ca5de520
           Linux_Alpine:
             unknown_versioning: *ghcup-64
         A_32:
           Linux_UnknownLinux:
             unknown_versioning: &ghcup-32
-              dlUri: https://downloads.haskell.org/~ghcup/0.1.15.1/i386-linux-ghcup-0.1.15.1
-              dlHash: 0c1dcbdd7cfa8accdfbe14c623924f3ca29a35d32a2ac3e61f0eb322855e2cb1
+              dlUri: https://downloads.haskell.org/~ghcup/0.1.15.2/i386-linux-ghcup-0.1.15.2
+              dlHash: 3b1fe710cded0398e920ec9716089ba65226abf181741897f387e7c539a619c2
           Linux_Alpine:
             unknown_versioning: *ghcup-32
         A_ARM64:
           Linux_UnknownLinux:
             unknown_versioning:
-              dlUri: https://downloads.haskell.org/~ghcup/0.1.15.1/aarch64-linux-ghcup-0.1.15.1
-              dlHash: 7fa29d8e9a9fe3d1e3a63a1d16fc3550128edbdb9b5b5dff7974358c4dab192c
+              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.1/aarch64-apple-darwin-ghcup-0.1.15.1
-              dlHash: 6a743cd50e8124ac2de8be77013d49dcf3b99ce7cc463ec86ed99a904a51dfd9
+              dlUri: https://downloads.haskell.org/~ghcup/0.1.15.2/aarch64-apple-darwin-ghcup-0.1.15.2
+              dlHash: 20625ba5e7488f2a6155331750ecead3815ea16b2695c20521633c1412f012cc
         A_ARM:
           Linux_UnknownLinux:
             unknown_versioning:
-              dlUri: https://downloads.haskell.org/~ghcup/0.1.15.1/armv7-linux-ghcup-0.1.15.1
-              dlHash: 77ee5d9828c2ba771127274e301e81412b9f29af2d65dd85dada4786d9438c2c
+              dlUri: https://downloads.haskell.org/~ghcup/0.1.15.2/armv7-linux-ghcup-0.1.15.2
+              dlHash: 03a4af5ed895ada1dd21f4cc3f64dc9078a5bf4268313021d004c04bea7f9c2e
   HLS:
     1.1.0:
-      viTags:
-        - Recommended
-        - Latest
+      viTags: []
       viChangeLog: https://github.com/haskell/haskell-language-server/blob/master/ChangeLog.md#110
       viPostInstall: "This is just the server part of your LSP configuration. Consult the README on how to configure HLS, your project and your LSP client in your editor: https://github.com/haskell/haskell-language-server/blob/master/README.md"
       viArch:
@@ -2094,6 +2092,28 @@ ghcupDownloads:
               dlHash: a1d3f451e64a041aa527a25da29e4716a2de6ae347cef4ef9312fc7611e168cc
           Linux_Alpine:
             unknown_versioning: *hls-64
+    1.2.0:
+      viTags:
+        - Recommended
+        - Latest
+      viChangeLog: https://github.com/haskell/haskell-language-server/blob/master/ChangeLog.md#120
+      viPostInstall: "This is just the server part of your LSP configuration. Consult the README on how to configure HLS, your project and your LSP client in your editor: https://github.com/haskell/haskell-language-server/blob/master/README.md"
+      viArch:
+        A_64:
+          Linux_UnknownLinux:
+            unknown_versioning: &hls-64
+              dlUri: https://github.com/haskell/haskell-language-server/releases/download/1.2.0/haskell-language-server-Linux-1.2.0.tar.gz
+              dlHash: d29ee22f7bd706da2e2a1bd7640e25bb9736adeafb34eef47d29ea143b0fa927
+          Darwin:
+            unknown_versioning:
+              dlUri: https://github.com/haskell/haskell-language-server/releases/download/1.2.0/haskell-language-server-macOS-1.2.0.tar.gz
+              dlHash: 43d2ef356fb8cbd8e27acf70f94c079157258916bb1220751547584513584aaa
+          Windows:
+            unknown_versioning:
+              dlUri: https://github.com/haskell/haskell-language-server/releases/download/1.2.0/haskell-language-server-Windows-1.2.0.tar.gz
+              dlHash: 961c6ff12c9a9c7a4609f239c5ac70d7d16753cdb8c10348a6a51feeaa0b6aea
+          Linux_Alpine:
+            unknown_versioning: *hls-64
   Stack:
     2.5.1:
       viTags:

lib/GHCup.hs

@@ -1282,6 +1282,192 @@ rmStackVer ver = do
       Nothing        -> liftIO $ rmLink (binDir </> "stack" <> exeExt)
 
 
+-- assuming the current scheme of having just 1 ghcup bin, no version info is required.
+rmGhcup :: ( MonadReader AppState m
+           , MonadIO m
+           , MonadCatch m
+           , MonadLogger m
+           )
+        => m ()
+
+rmGhcup = do
+  AppState {dirs = Dirs {binDir}} <- ask
+  let ghcupFilename = "ghcup" <> exeExt
+  let ghcupFilepath = binDir </> ghcupFilename
+
+  currentRunningExecPath <- liftIO $ getExecutablePath
+
+  -- if paths do no exist, warn user, and continue to compare them, as is,
+  -- which should eventually fail and result in a non-standard install warning
+
+  p1 <- handleIO' doesNotExistErrorType
+                  (handlePathNotPresent currentRunningExecPath)
+                  (liftIO $ canonicalizePath currentRunningExecPath)
+
+  p2 <- handleIO' doesNotExistErrorType
+                  (handlePathNotPresent ghcupFilepath)
+                  (liftIO $ canonicalizePath ghcupFilepath)
+
+  let areEqualPaths = equalFilePath p1 p2
+
+  when (not areEqualPaths) $ do
+    $logWarn $ nonStandardInstallLocationMsg currentRunningExecPath
+
+#if defined(IS_WINDOWS)
+  -- since it doesn't seem possible to delete a running exec in windows
+  -- we move it to temp dir, to be deleted at next reboot
+  tempDir <- liftIO $ getTemporaryDirectory
+  let tempFilepath = tempDir </> ghcupFilename
+  hideError UnsupportedOperation $
+            liftIO $ hideError NoSuchThing $
+            Win32.moveFileEx ghcupFilepath (Just tempFilepath) Win32.mOVEFILE_REPLACE_EXISTING
+#else
+  -- delete it.
+  hideError doesNotExistErrorType $ liftIO $ rmFile ghcupFilepath
+#endif
+
+  where
+    handlePathNotPresent fp _err = do
+      $logDebug $ "Error: The path does not exist, " <> T.pack fp
+      pure fp
+
+    nonStandardInstallLocationMsg path = T.pack $
+      "current ghcup is invoked from a non-standard location: \n"
+      <> path <>
+      "\n you may have to uninstall it manually."
+
+rmTool :: ( MonadReader AppState m
+           , MonadLogger m
+           , MonadFail m
+           , MonadMask m
+           , MonadUnliftIO m)
+           => ListResult
+           -> Excepts '[NotInstalled ] m ()
+
+rmTool ListResult {lVer, lTool, lCross} = do
+  case lTool of
+    GHC ->
+      let ghcTargetVersion = GHCTargetVersion lCross lVer
+      in rmGHCVer ghcTargetVersion
+    HLS -> rmHLSVer lVer
+    Cabal -> rmCabalVer lVer
+    Stack -> rmStackVer lVer
+    GHCup -> lift rmGhcup
+
+
+rmGhcupDirs :: ( MonadReader AppState m
+               , MonadIO m
+               , MonadLogger m
+               , MonadCatch m
+               , MonadMask m )
+            => m [FilePath]
+rmGhcupDirs = do
+  Dirs
+    { baseDir
+    , binDir
+    , logsDir
+    , cacheDir
+    } <- asks dirs
+
+  let envFilePath = baseDir </> "env"
+
+  confFilePath <- getConfigFilePath
+
+  rmEnvFile  envFilePath
+  rmConfFile confFilePath
+  rmCacheDir cacheDir
+  rmLogsDir  logsDir
+  rmBinDir   binDir
+#if defined(IS_WINDOWS)
+  rmPath (baseDir </> "msys64")
+#endif
+
+  liftIO $ removeEmptyDirsRecursive baseDir
+
+  -- report files in baseDir that are left-over after
+  -- the standard location deletions above
+  hideErrorDef [doesNotExistErrorType] [] $ reportRemainingFiles baseDir
+
+  where
+
+    rmEnvFile :: (MonadCatch m, MonadLogger m, MonadIO m) => FilePath -> m ()
+    rmEnvFile enFilePath = do
+      $logInfo "Removing Ghcup Environment File"
+      hideError doesNotExistErrorType $ 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
+
+    rmCacheDir :: (MonadLogger m, MonadIO m) => FilePath -> m ()
+    rmCacheDir cacheDir = do
+      $logInfo "removing ghcup cache Dir"
+      contents <- liftIO $ getDirectoryContentsRecursive cacheDir
+      forM_ contents (liftIO . deleteFile . (cacheDir </>))
+
+    rmLogsDir :: (MonadLogger m, MonadIO m) => FilePath -> m ()
+    rmLogsDir logsDir = do
+      $logInfo "removing ghcup logs Dir"
+      contents <- liftIO $ getDirectoryContentsRecursive logsDir
+      forM_ contents (liftIO . deleteFile . (logsDir </>))
+
+    rmBinDir :: (MonadCatch m, MonadIO m) => FilePath -> m ()
+    rmBinDir binDir = do
+#if !defined(IS_WINDOWS)
+      isXDGStyle <- liftIO $ useXDG
+      if not isXDGStyle
+        then removeDirIfEmptyOrIsSymlink binDir
+        else pure ()
+#else
+      removeDirIfEmptyOrIsSymlink binDir
+#endif
+
+    reportRemainingFiles :: MonadIO m => FilePath -> m [FilePath]
+    reportRemainingFiles dir = do
+      remainingFiles <- liftIO $ getDirectoryContentsRecursive dir
+      let normalizedFilePaths = fmap normalise remainingFiles
+      let sortedByDepthRemainingFiles = reverse $ sortBy compareFn normalizedFilePaths
+      let remainingFilesAbsolute = fmap (dir </>) sortedByDepthRemainingFiles
+
+      pure remainingFilesAbsolute
+
+      where
+        calcDepth :: FilePath -> Int
+        calcDepth = length . filter isPathSeparator
+
+        compareFn :: FilePath -> FilePath -> Ordering
+        compareFn fp1 fp2 = compare (calcDepth fp1) (calcDepth fp2)
+
+    removeEmptyDirsRecursive :: FilePath -> IO ()
+    removeEmptyDirsRecursive fp = do
+      cs <- listDirectory fp >>= filterM doesDirectoryExist . fmap (fp </>)
+      forM_ cs removeEmptyDirsRecursive
+      hideError InappropriateType $ removeDirIfEmptyOrIsSymlink fp
+        
+
+    -- we expect only files inside cache/log dir
+    -- we report remaining files/dirs later,
+    -- hence the force/quiet mode in these delete functions below.
+
+    deleteFile :: FilePath -> IO ()
+    deleteFile filepath = do
+      hideError InappropriateType $ rmFile filepath
+
+    removeDirIfEmptyOrIsSymlink :: (MonadCatch m, MonadIO m) => FilePath -> m ()
+    removeDirIfEmptyOrIsSymlink filepath =
+      hideError UnsatisfiedConstraints $
+      handleIO' InappropriateType
+            (handleIfSym filepath)
+            (liftIO $ removeDirectory filepath)
+      where
+        handleIfSym fp e = do
+          isSym <- liftIO $ pathIsSymbolicLink fp
+          if isSym
+          then liftIO $ deleteFile fp
+          else liftIO $ ioError e
+
+
 
     ------------------
     --[ Debug info ]--

lib/GHCup/Utils/Dirs.hs

@@ -26,6 +26,10 @@ module GHCup.Utils.Dirs
   , parseGHCupGHCDir
   , relativeSymlink
   , withGHCupTmpDir
+  , getConfigFilePath
+#if !defined(IS_WINDOWS)
+  , useXDG
+#endif
   )
 where
 
@@ -201,13 +205,16 @@ getDirs = do
     --[ GHCup files ]--
     -------------------
 
+getConfigFilePath :: (MonadIO m) => m FilePath
+getConfigFilePath = do
+  confDir <- liftIO ghcupConfigDir
+  pure $ confDir </> "config.yaml"
 
 ghcupConfigFile :: (MonadIO m)
                 => Excepts '[JSONError] m UserSettings
 ghcupConfigFile = do
-  confDir <- liftIO ghcupConfigDir
-  let file = confDir </> "config.yaml"
-  contents <- liftIO $ handleIO' NoSuchThing (\_ -> pure Nothing) $ Just <$> BS.readFile file
+  filepath <- getConfigFilePath
+  contents <- liftIO $ handleIO' NoSuchThing (\_ -> pure Nothing) $ Just <$> BS.readFile filepath
   case contents of
       Nothing -> pure defaultUserSettings
       Just contents' -> lE' JSONDecodeError . first show . Y.decodeEither' $ contents'

lib/GHCup/Utils/Prelude.hs

@@ -190,14 +190,14 @@ hideError :: (MonadIO m, MonadCatch m) => IOErrorType -> m () -> m ()
 hideError err = handleIO (\e -> if err == ioeGetErrorType e then pure () else liftIO . ioError $ e)
 
 
-hideErrorDef :: [IOErrorType] -> a -> IO a -> IO a
+hideErrorDef :: (MonadIO m, MonadCatch m) => [IOErrorType] -> a -> m a -> m a
 hideErrorDef errs def =
-  handleIO (\e -> if ioeGetErrorType e `elem` errs then pure def else ioError e)
+  handleIO (\e -> if ioeGetErrorType e `elem` errs then pure def else liftIO $ ioError e)
 
 
-hideErrorDefM :: [IOErrorType] -> IO a -> IO a -> IO a
+hideErrorDefM :: (MonadIO m, MonadCatch m) => [IOErrorType] -> m a -> m a -> m a
 hideErrorDefM errs def =
-  handleIO (\e -> if ioeGetErrorType e `elem` errs then def else ioError e)
+  handleIO (\e -> if ioeGetErrorType e `elem` errs then def else liftIO $ ioError e)
 
 
 -- TODO: does this work?
@@ -334,37 +334,38 @@ copyDirectoryRecursive srcDir destDir = do
                    in doCopy src dest
                 | (srcBase, srcFile) <- srcFiles ]
 
-    -- | List all the files in a directory and all subdirectories.
-    --
-    -- The order places files in sub-directories after all the files in their
-    -- parent directories. The list is generated lazily so is not well defined if
-    -- the source directory structure changes before the list is used.
-    --
-    getDirectoryContentsRecursive :: FilePath -> IO [FilePath]
-    getDirectoryContentsRecursive topdir = recurseDirectories [""]
+
+-- | List all the files in a directory and all subdirectories.
+--
+-- The order places files in sub-directories after all the files in their
+-- parent directories. The list is generated lazily so is not well defined if
+-- the source directory structure changes before the list is used.
+--
+getDirectoryContentsRecursive :: FilePath -> IO [FilePath]
+getDirectoryContentsRecursive topdir = recurseDirectories [""]
+  where
+    recurseDirectories :: [FilePath] -> IO [FilePath]
+    recurseDirectories []         = return []
+    recurseDirectories (dir:dirs) = unsafeInterleaveIO $ do
+      (files, dirs') <- collect [] [] =<< getDirectoryContents (topdir </> dir)
+      files' <- recurseDirectories (dirs' ++ dirs)
+      return (files ++ files')
+
       where
-        recurseDirectories :: [FilePath] -> IO [FilePath]
-        recurseDirectories []         = return []
-        recurseDirectories (dir:dirs) = unsafeInterleaveIO $ do
-          (files, dirs') <- collect [] [] =<< getDirectoryContents (topdir </> dir)
-          files' <- recurseDirectories (dirs' ++ dirs)
-          return (files ++ files')
+        collect files dirs' []              = return (reverse files
+                                                     ,reverse dirs')
+        collect files dirs' (entry:entries) | ignore entry
+                                            = collect files dirs' entries
+        collect files dirs' (entry:entries) = do
+          let dirEntry = dir </> entry
+          isDirectory <- doesDirectoryExist (topdir </> dirEntry)
+          if isDirectory
+            then collect files (dirEntry:dirs') entries
+            else collect (dirEntry:files) dirs' entries
 
-          where
-            collect files dirs' []              = return (reverse files
-                                                         ,reverse dirs')
-            collect files dirs' (entry:entries) | ignore entry
-                                                = collect files dirs' entries
-            collect files dirs' (entry:entries) = do
-              let dirEntry = dir </> entry
-              isDirectory <- doesDirectoryExist (topdir </> dirEntry)
-              if isDirectory
-                then collect files (dirEntry:dirs') entries
-                else collect (dirEntry:files) dirs' entries
-
-            ignore ['.']      = True
-            ignore ['.', '.'] = True
-            ignore _          = False
+        ignore ['.']      = True
+        ignore ['.', '.'] = True
+        ignore _          = False
 
 -- https://github.com/haskell/directory/issues/110
 -- https://github.com/haskell/directory/issues/96