Redo file handling wrt #165 and #187

lib/GHCup/Utils.hs

@@ -53,6 +53,7 @@ import           Control.Monad.Logger
 import           Control.Monad.Reader
 import           Control.Monad.Trans.Resource
                                          hiding ( throwM )
+import           Control.Monad.IO.Unlift        ( MonadUnliftIO( withRunInIO ) )
 #if defined(IS_WINDOWS)
 import           Data.Bits
 #endif
@@ -886,8 +887,17 @@ getChangeLog dls tool (Right tag) =
 --
 --   1. the build directory, depending on the KeepDirs setting
 --   2. the install destination, depending on whether the build failed
-runBuildAction :: (Pretty (V e), Show (V e), MonadReader env m, HasDirs env, HasSettings env, MonadIO m, MonadMask m)
-               => FilePath          -- ^ build directory (cleaned up depending on Settings)
+runBuildAction :: ( Pretty (V e)
+                  , Show (V e)
+                  , MonadReader env m
+                  , HasDirs env
+                  , HasSettings env
+                  , MonadIO m
+                  , MonadMask m
+                  , MonadLogger m
+                  , MonadUnliftIO m
+                  )
+               => FilePath        -- ^ build directory (cleaned up depending on Settings)
                -> Maybe FilePath  -- ^ dir to *always* clean up on exception
                -> Excepts e m a
                -> Excepts '[BuildFailed] m a
@@ -895,11 +905,9 @@ runBuildAction bdir instdir action = do
   Settings {..} <- lift getSettings
   let exAction = do
         forM_ instdir $ \dir ->
-          lift $ hideError doesNotExistErrorType $ rmPathForcibly dir
+          lift $ hideError doesNotExistErrorType $ recyclePathForcibly dir
         when (keepDirs == Never)
-          $ lift
-          $ hideError doesNotExistErrorType
-          $ rmPathForcibly bdir
+          $ lift $ rmBDir bdir
   v <-
     flip onException exAction
     $ catchAllE
@@ -908,10 +916,20 @@ runBuildAction bdir instdir action = do
           throwE (BuildFailed bdir es)
         ) action
 
-  when (keepDirs == Never || keepDirs == Errors) $ lift $ rmPathForcibly bdir
+  when (keepDirs == Never || keepDirs == Errors) $ lift $ rmBDir bdir
   pure v
 
 
+-- | Remove a build directory, ignoring if it doesn't exist and gracefully
+-- printing other errors without crashing.
+rmBDir :: (MonadLogger m, MonadUnliftIO m, MonadIO m) => FilePath -> m ()
+rmBDir dir = withRunInIO (\run -> run $
+           liftIO $ handleIO (\e -> run $ $(logWarn)
+               [i|Couldn't remove build dir #{dir}, error was: #{displayException e}|])
+           $ hideError doesNotExistErrorType
+           $ rmPathForcibly dir)
+
+
 getVersionInfo :: Version
                -> Tool
                -> GHCupDownloads
@@ -1001,10 +1019,10 @@ pathIsLink = pathIsSymbolicLink
 rmLink :: (MonadReader env m, HasDirs env, MonadIO m, MonadMask m) => FilePath -> m ()
 #if defined(IS_WINDOWS)
 rmLink fp = do
-  hideError doesNotExistErrorType . rmFile $ fp
-  hideError doesNotExistErrorType . rmFile $ (dropExtension fp <.> "shim")
+  hideError doesNotExistErrorType . recycleFile $ fp
+  hideError doesNotExistErrorType . recycleFile $ (dropExtension fp <.> "shim")
 #else
-rmLink = hideError doesNotExistErrorType . rmFile
+rmLink = hideError doesNotExistErrorType . recycleFile
 #endif
 
 
@@ -1049,7 +1067,7 @@ createLink link exe = do
   liftIO $ writeFile shim shimContents
 #else
   $(logDebug) [i|rm -f #{exe}|]
-  hideError doesNotExistErrorType $ rmFile exe
+  hideError doesNotExistErrorType $ recycleFile exe
 
   $(logDebug) [i|ln -s #{link} #{exe}|]
   liftIO $ createFileLink link exe
@@ -1078,7 +1096,7 @@ ensureGlobalTools = do
   void $ (\(DigestError _ _) -> do
       lift $ $(logWarn) [i|Digest doesn't match, redownloading gs.exe...|]
       lift $ $(logDebug) [i|rm -f #{shimDownload}|]
-      lift $ hideError doesNotExistErrorType $ rmFile (cacheDir dirs </> "gs.exe")
+      lift $ hideError doesNotExistErrorType $ recycleFile (cacheDir dirs </> "gs.exe")
       liftE @'[DigestError , DownloadFailed] $ dl
     ) `catchE` (liftE @'[DigestError , DownloadFailed] dl)
   pure ()
@@ -1089,14 +1107,14 @@ ensureGlobalTools = do
 
 -- | Ensure ghcup directory structure exists.
 ensureDirectories :: Dirs -> IO ()
-ensureDirectories (Dirs baseDir binDir cacheDir logsDir confDir tmpDir) = do
+ensureDirectories (Dirs baseDir binDir cacheDir logsDir confDir trashDir) = do
   createDirRecursive' baseDir
   createDirRecursive' (baseDir </> "ghc")
   createDirRecursive' binDir
   createDirRecursive' cacheDir
   createDirRecursive' logsDir
   createDirRecursive' confDir
-  createDirRecursive' tmpDir
+  createDirRecursive' trashDir
   pure ()
 
 
@@ -1110,4 +1128,3 @@ ensureDirectories (Dirs baseDir binDir cacheDir logsDir confDir tmpDir) = do
 ghcBinaryName :: GHCTargetVersion -> String
 ghcBinaryName (GHCTargetVersion (Just t) v') = T.unpack (t <> "-ghc-" <> prettyVer v' <> T.pack exeExt)
 ghcBinaryName (GHCTargetVersion Nothing  v') = T.unpack ("ghc-" <> prettyVer v' <> T.pack exeExt)
-