From df89ddcdf59dbbdbcc91ebb02d955c00e7bff97c Mon Sep 17 00:00:00 2001 From: Julian Ospald Date: Fri, 20 May 2022 23:19:33 +0200 Subject: [PATCH] Use internal tmpdir --- app/ghcup/GHCup/OptParse/GC.hs | 14 ++-- app/ghcup/GHCup/OptParse/Prefetch.hs | 2 +- app/ghcup/Main.hs | 1 - docs/guide.md | 1 - lib/GHCup.hs | 2 + lib/GHCup/Types.hs | 13 ++-- lib/GHCup/Utils.hs | 4 +- lib/GHCup/Utils/Dirs.hs | 62 +++++++++------- lib/GHCup/Utils/File.hs | 105 ++++++++++++++++++++++++++- lib/GHCup/Utils/File.hs-boot | 14 ++++ lib/GHCup/Utils/File/Posix.hs | 25 ++++++- lib/GHCup/Utils/File/Windows.hs | 12 ++- lib/GHCup/Utils/Logger.hs | 1 + lib/GHCup/Utils/Prelude.hs | 103 -------------------------- lib/GHCup/Utils/Prelude/Posix.hs | 16 ---- lib/GHCup/Utils/Prelude/Windows.hs | 11 --- 16 files changed, 210 insertions(+), 176 deletions(-) create mode 100644 lib/GHCup/Utils/File.hs-boot diff --git a/app/ghcup/GHCup/OptParse/GC.hs b/app/ghcup/GHCup/OptParse/GC.hs index b3a28f7..e51edbc 100644 --- a/app/ghcup/GHCup/OptParse/GC.hs +++ b/app/ghcup/GHCup/OptParse/GC.hs @@ -56,26 +56,26 @@ data GCOptions = GCOptions --[ Parsers ]-- --------------- - + gcP :: Parser GCOptions gcP = GCOptions - <$> + <$> switch (short 'o' <> long "ghc-old" <> help "Remove GHC versions marked as 'old'") - <*> + <*> switch (short 'p' <> long "profiling-libs" <> help "Remove profiling libs of GHC versions") - <*> + <*> switch (short 's' <> long "share-dir" <> help "Remove GHC share directories (documentation)") - <*> + <*> switch (short 'h' <> long "hls-no-ghc" <> help "Remove HLS versions that don't have a corresponding installed GHC version") - <*> + <*> switch (short 'c' <> long "cache" <> help "GC the GHCup cache") - <*> + <*> switch (short 't' <> long "tmpdirs" <> help "Remove tmpdir leftovers") diff --git a/app/ghcup/GHCup/OptParse/Prefetch.hs b/app/ghcup/GHCup/OptParse/Prefetch.hs index 87f6bdb..7d43c10 100644 --- a/app/ghcup/GHCup/OptParse/Prefetch.hs +++ b/app/ghcup/GHCup/OptParse/Prefetch.hs @@ -14,6 +14,7 @@ module GHCup.OptParse.Prefetch where import GHCup import GHCup.Errors import GHCup.Types +import GHCup.Utils.File import GHCup.Utils.Logger import GHCup.OptParse.Common import GHCup.Utils.String.QQ @@ -33,7 +34,6 @@ import Text.PrettyPrint.HughesPJClass ( prettyShow ) import qualified Data.Text as T import Control.Exception.Safe (MonadMask) -import GHCup.Utils.Prelude import GHCup.Download (getDownloadsF) diff --git a/app/ghcup/Main.hs b/app/ghcup/Main.hs index 96eabe8..df636d7 100644 --- a/app/ghcup/Main.hs +++ b/app/ghcup/Main.hs @@ -155,7 +155,6 @@ main = do versions. It maintains a self-contained ~/.ghcup directory. ENV variables: - * TMPDIR: where ghcup does the work (unpacking, building, ...) * GHCUP_INSTALL_BASE_PREFIX: the base of ghcup (default: $HOME) * GHCUP_USE_XDG_DIRS: set to anything to use XDG style directories diff --git a/docs/guide.md b/docs/guide.md index d90a5f9..a273c07 100644 --- a/docs/guide.md +++ b/docs/guide.md @@ -76,7 +76,6 @@ Partial configuration is fine. Command line options always override the config f This is the complete list of env variables that change GHCup behavior: * `GHCUP_USE_XDG_DIRS`: see [XDG support](#xdg-support) above -* `TMPDIR`: where ghcup does the work (unpacking, building, ...) * `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 diff --git a/lib/GHCup.hs b/lib/GHCup.hs index 505ea2b..3e4e0c3 100644 --- a/lib/GHCup.hs +++ b/lib/GHCup.hs @@ -2029,6 +2029,7 @@ rmGhcupDirs = do , cacheDir , recycleDir , dbDir + , tmpDir } <- getDirs let envFilePath = fromGHCupPath baseDir "env" @@ -2040,6 +2041,7 @@ rmGhcupDirs = do -- for xdg dirs, the order matters here handleRm $ rmPathForcibly logsDir + handleRm $ rmPathForcibly tmpDir handleRm $ rmPathForcibly cacheDir handleRm $ rmBinDir binDir diff --git a/lib/GHCup/Types.hs b/lib/GHCup/Types.hs index 7b22698..3918de7 100644 --- a/lib/GHCup/Types.hs +++ b/lib/GHCup/Types.hs @@ -441,13 +441,14 @@ defaultSettings = Settings False defaultMetaCache False Never Curl False GHCupUR instance NFData Settings data Dirs = Dirs - { baseDir :: GHCupPath - , binDir :: FilePath - , cacheDir :: GHCupPath - , logsDir :: GHCupPath - , confDir :: GHCupPath - , dbDir :: GHCupPath + { baseDir :: GHCupPath + , binDir :: FilePath + , cacheDir :: GHCupPath + , logsDir :: GHCupPath + , confDir :: GHCupPath + , dbDir :: GHCupPath , recycleDir :: GHCupPath -- mainly used on windows + , tmpDir :: GHCupPath } deriving (Show, GHC.Generic) diff --git a/lib/GHCup/Utils.hs b/lib/GHCup/Utils.hs index e227885..6a161a2 100644 --- a/lib/GHCup/Utils.hs +++ b/lib/GHCup/Utils.hs @@ -1255,15 +1255,17 @@ ensureGlobalTools -- | Ensure ghcup directory structure exists. ensureDirectories :: Dirs -> IO () -ensureDirectories (Dirs baseDir binDir cacheDir logsDir confDir trashDir dbDir) = do +ensureDirectories (Dirs baseDir binDir cacheDir logsDir confDir trashDir dbDir tmpDir) = do createDirRecursive' (fromGHCupPath baseDir) createDirRecursive' (fromGHCupPath baseDir "ghc") + createDirRecursive' (fromGHCupPath baseDir "hls") createDirRecursive' binDir createDirRecursive' (fromGHCupPath cacheDir) createDirRecursive' (fromGHCupPath logsDir) createDirRecursive' (fromGHCupPath confDir) createDirRecursive' (fromGHCupPath trashDir) createDirRecursive' (fromGHCupPath dbDir) + createDirRecursive' (fromGHCupPath tmpDir) pure () diff --git a/lib/GHCup/Utils/Dirs.hs b/lib/GHCup/Utils/Dirs.hs index acf8b37..817d2ac 100644 --- a/lib/GHCup/Utils/Dirs.hs +++ b/lib/GHCup/Utils/Dirs.hs @@ -99,6 +99,9 @@ module GHCup.Utils.Dirs , setAccessTime , setModificationTime , isSymbolicLink + + -- uhm + , rmPathForcibly ) where @@ -135,7 +138,6 @@ import System.Directory hiding ( removeDirectory ) import qualified System.Directory as SD -import System.DiskSpace import System.Environment import System.FilePath import System.IO.Temp @@ -145,7 +147,6 @@ import qualified Data.ByteString as BS import qualified Data.Text as T import qualified Data.Yaml.Aeson as Y import qualified Text.Megaparsec as MP -import Control.Concurrent (threadDelay) @@ -174,7 +175,7 @@ createTempGHCupDirectory (GHCupPath gp) d = GHCupPath <$> createTempDirectory gp getGHCupTmpDirs :: IO [GHCupPath] getGHCupTmpDirs = do - tmpdir <- getCanonicalTemporaryDirectory + tmpdir <- fromGHCupPath <$> ghcupTMPDir ghcup_dirs <- handleIO (\_ -> pure []) $ findFiles tmpdir (makeRegexOpts compExtended @@ -323,6 +324,25 @@ ghcupRecycleDir :: IO GHCupPath ghcupRecycleDir = ghcupBaseDir <&> (\(GHCupPath gp) -> GHCupPath (gp "trash")) +-- | Defaults to '~/.ghcup/tmp. +-- +-- If 'GHCUP_USE_XDG_DIRS' is set (to anything), +-- then uses 'XDG_CACHE_HOME/ghcup/tmp as per xdg spec. +ghcupTMPDir :: IO GHCupPath +ghcupTMPDir + | isWindows = ghcupBaseDir <&> (\(GHCupPath gp) -> GHCupPath (gp "tmp")) + | otherwise = do + xdg <- useXDG + if xdg + then do + bdir <- lookupEnv "XDG_CACHE_HOME" >>= \case + Just r -> pure r + Nothing -> do + home <- liftIO getHomeDirectory + pure (home ".cache") + pure (GHCupPath (bdir "ghcup" "tmp")) + else ghcupBaseDir <&> (\(GHCupPath gp) -> GHCupPath (gp "tmp")) + getAllDirs :: IO Dirs getAllDirs = do @@ -332,6 +352,7 @@ getAllDirs = do logsDir <- ghcupLogsDir confDir <- ghcupConfigDir recycleDir <- ghcupRecycleDir + tmpDir <- ghcupTMPDir dbDir <- ghcupDbDir pure Dirs { .. } @@ -405,6 +426,7 @@ ghcupHLSDir ver = do let verdir = T.unpack $ prettyVer ver pure (basedir `appendGHCupPath` verdir) + mkGhcupTmpDir :: ( MonadReader env m , HasDirs env , MonadUnliftIO m @@ -415,29 +437,8 @@ mkGhcupTmpDir :: ( MonadReader env m , MonadIO m) => m GHCupPath mkGhcupTmpDir = GHCupPath <$> do - tmpdir <- liftIO getCanonicalTemporaryDirectory - - let minSpace = 5000 -- a rough guess, aight? - space <- handleIO (\_ -> pure Nothing) $ fmap Just $ liftIO $ getAvailSpace tmpdir - when (maybe False (toBytes minSpace >) space) $ do - logWarn ("Possibly insufficient disk space on " - <> T.pack tmpdir - <> ". At least " - <> T.pack (show minSpace) - <> " MB are recommended, but only " - <> toMB (fromJust space) - <> " are free. Consider freeing up disk space or setting TMPDIR env variable.") - logWarn - "...waiting for 10 seconds before continuing anyway, you can still abort..." - liftIO $ threadDelay 10000000 -- give the user a sec to intervene - - liftIO $ createTempDirectory tmpdir "ghcup" - where - toBytes mb = mb * 1024 * 1024 - toMB b = T.pack $ show (truncate' (fromIntegral b / (1024 * 1024) :: Double) 2) - truncate' :: Double -> Int -> Double - truncate' x n = fromIntegral (floor (x * t) :: Integer) / t - where t = 10^n + Dirs { tmpDir } <- getDirs + liftIO $ createTempDirectory (fromGHCupPath tmpDir) "ghcup" withGHCupTmpDir :: ( MonadReader env m @@ -521,4 +522,13 @@ removePathForcibly :: GHCupPath -> IO () removePathForcibly (GHCupPath fp) = SD.removePathForcibly fp +rmPathForcibly :: ( MonadIO m + , MonadMask m + ) + => GHCupPath + -> m () +rmPathForcibly fp + | isWindows = recover (liftIO $ removePathForcibly fp) + | otherwise = liftIO $ removePathForcibly fp + diff --git a/lib/GHCup/Utils/File.hs b/lib/GHCup/Utils/File.hs index 2bc8a04..493c531 100644 --- a/lib/GHCup/Utils/File.hs +++ b/lib/GHCup/Utils/File.hs @@ -33,7 +33,15 @@ module GHCup.Utils.File ( removeEmptyDirectory, removeDirIfEmptyOrIsSymlink, removeEmptyDirsRecursive, - rmFileForce + rmFileForce, + createDirRecursive', + recyclePathForcibly, + rmDirectory, + recycleFile, + rmFile, + rmDirectoryLink, + moveFilePortable, + moveFile ) where import GHCup.Utils.Dirs @@ -235,3 +243,98 @@ rmFileForce :: (MonadMask m, MonadIO m) => FilePath -> m () rmFileForce filepath = do hideError doesNotExistErrorType $ hideError InappropriateType $ rmFile filepath + +-- | More permissive version of 'createDirRecursive'. This doesn't +-- error when the destination is a symlink to a directory. +createDirRecursive' :: FilePath -> IO () +createDirRecursive' p = + handleIO (\e -> if isAlreadyExistsError e then isSymlinkDir e else throwIO e) + . createDirectoryIfMissing True + $ p + + where + isSymlinkDir e = do + ft <- pathIsSymbolicLink p + case ft of + True -> do + rp <- canonicalizePath p + rft <- doesDirectoryExist rp + case rft of + True -> pure () + _ -> throwIO e + _ -> throwIO e + + +-- https://github.com/haskell/directory/issues/110 +-- https://github.com/haskell/directory/issues/96 +-- https://www.sqlite.org/src/info/89f1848d7f +recyclePathForcibly :: ( MonadIO m + , MonadReader env m + , HasDirs env + , MonadMask m + ) + => GHCupPath + -> m () +recyclePathForcibly fp + | isWindows = do + Dirs { recycleDir } <- getDirs + tmp <- liftIO $ createTempGHCupDirectory recycleDir "recyclePathForcibly" + let dest = tmp `appendGHCupPath` takeFileName (fromGHCupPath fp) + liftIO (moveFile (fromGHCupPath fp) (fromGHCupPath dest)) + `catch` + (\e -> if | isDoesNotExistError e -> pure () + | isPermissionError e || ioeGetErrorType e == UnsupportedOperation {- EXDEV on windows -} -> recover (liftIO $ removePathForcibly fp) + | otherwise -> throwIO e) + `finally` + liftIO (handleIO (\_ -> pure ()) $ removePathForcibly tmp) + | otherwise = liftIO $ removePathForcibly fp + + + +rmDirectory :: (MonadIO m, MonadMask m) + => GHCupPath + -> m () +rmDirectory fp + | isWindows = recover (liftIO $ removeDirectory fp) + | otherwise = liftIO $ removeDirectory fp + + +-- https://www.sqlite.org/src/info/89f1848d7f +-- https://github.com/haskell/directory/issues/96 +recycleFile :: ( MonadIO m + , MonadMask m + , MonadReader env m + , HasDirs env + ) + => FilePath + -> m () +recycleFile fp + | isWindows = do + Dirs { recycleDir } <- getDirs + liftIO $ whenM (doesDirectoryExist fp) $ ioError (IOError Nothing InappropriateType "recycleFile" "" Nothing (Just fp)) + tmp <- liftIO $ createTempGHCupDirectory recycleDir "recycleFile" + let dest = fromGHCupPath tmp takeFileName fp + liftIO (moveFile fp dest) + `catch` + (\e -> if isPermissionError e || ioeGetErrorType e == UnsupportedOperation {- EXDEV on windows -} then recover (liftIO $ rmFile fp) else throwIO e) + `finally` + liftIO (handleIO (\_ -> pure ()) $ removePathForcibly tmp) + | otherwise = liftIO $ removeFile fp + + +rmFile :: ( MonadIO m + , MonadMask m + ) + => FilePath + -> m () +rmFile fp + | isWindows = recover (liftIO $ removeFile fp) + | otherwise = liftIO $ removeFile fp + + +rmDirectoryLink :: (MonadIO m, MonadMask m, MonadReader env m, HasDirs env) + => FilePath + -> m () +rmDirectoryLink fp + | isWindows = recover (liftIO $ removeDirectoryLink fp) + | otherwise = liftIO $ removeDirectoryLink fp diff --git a/lib/GHCup/Utils/File.hs-boot b/lib/GHCup/Utils/File.hs-boot new file mode 100644 index 0000000..2da9c00 --- /dev/null +++ b/lib/GHCup/Utils/File.hs-boot @@ -0,0 +1,14 @@ +{-# LANGUAGE FlexibleContexts #-} + +module GHCup.Utils.File ( + recycleFile +) where + +import Control.Monad.IO.Class (MonadIO) +import Control.Monad.Catch (MonadMask) +import Control.Monad.Reader (MonadReader) +import GHCup.Types.Optics (HasDirs) + + +recycleFile :: (MonadIO m, MonadMask m, MonadReader env m, HasDirs env) => FilePath -> m () + diff --git a/lib/GHCup/Utils/File/Posix.hs b/lib/GHCup/Utils/File/Posix.hs index 51b1cb1..1ff0f2f 100644 --- a/lib/GHCup/Utils/File/Posix.hs +++ b/lib/GHCup/Utils/File/Posix.hs @@ -40,10 +40,11 @@ import Data.Sequence ( Seq, (|>) ) import Data.List import Data.Word8 import Foreign.C.String +import Foreign.C.Error import Foreign.C.Types import GHC.IO.Exception import System.IO ( stderr, hClose, hSetBinaryMode ) -import System.IO.Error +import System.IO.Error hiding ( catchIOError ) import System.FilePath import System.Posix.Directory import System.Posix.Error ( throwErrnoPathIfMinus1Retry ) @@ -559,6 +560,28 @@ install from to fail' = do | PF.isSymbolicLink fs = recreateSymlink from to fail' | otherwise = ioError $ mkIOError illegalOperationErrorType "install: not a regular file or symlink" Nothing (Just from) +moveFile :: FilePath -> FilePath -> IO () +moveFile = rename + + +moveFilePortable :: FilePath -> FilePath -> IO () +moveFilePortable from to = do + catchErrno [eXDEV] (moveFile from to) $ do + copyFile from to True + removeFile from + + +catchErrno :: [Errno] -- ^ errno to catch + -> IO a -- ^ action to try, which can raise an IOException + -> IO a -- ^ action to carry out in case of an IOException and + -- if errno matches + -> IO a +catchErrno en a1 a2 = + catchIOError a1 $ \e -> do + errno <- getErrno + if errno `elem` en + then a2 + else ioError e removeEmptyDirectory :: FilePath -> IO () removeEmptyDirectory = PD.removeDirectory diff --git a/lib/GHCup/Utils/File/Windows.hs b/lib/GHCup/Utils/File/Windows.hs index fea543a..5d168cf 100644 --- a/lib/GHCup/Utils/File/Windows.hs +++ b/lib/GHCup/Utils/File/Windows.hs @@ -293,8 +293,18 @@ copyFile = WS.copyFile deleteFile :: FilePath -> IO () deleteFile = WS.deleteFile + install :: FilePath -> FilePath -> Bool -> IO () -install = copyFile +install = moveFile + + +moveFile :: FilePath -> FilePath -> IO () +moveFile from to = Win32.moveFileEx from (Just to) 0 + + +moveFilePortable :: FilePath -> FilePath -> IO () +moveFilePortable = Win32.moveFile + removeEmptyDirectory :: FilePath -> IO () removeEmptyDirectory = WS.removeDirectory diff --git a/lib/GHCup/Utils/Logger.hs b/lib/GHCup/Utils/Logger.hs index 3763e07..2d003b5 100644 --- a/lib/GHCup/Utils/Logger.hs +++ b/lib/GHCup/Utils/Logger.hs @@ -19,6 +19,7 @@ import GHCup.Types import GHCup.Types.Optics import {-# SOURCE #-} GHCup.Utils.Dirs (fromGHCupPath) import {-# SOURCE #-} GHCup.Utils.File.Common (findFiles) +import {-# SOURCE #-} GHCup.Utils.File (recycleFile) import GHCup.Utils.String.QQ import Control.Exception.Safe diff --git a/lib/GHCup/Utils/Prelude.hs b/lib/GHCup/Utils/Prelude.hs index c2486a6..d39d5d0 100644 --- a/lib/GHCup/Utils/Prelude.hs +++ b/lib/GHCup/Utils/Prelude.hs @@ -379,109 +379,6 @@ escapeVerRex = B.pack . go . B.unpack . verToBS go (x : xs) | x == _period = [_backslash, _period] ++ go xs | otherwise = x : go xs --- | More permissive version of 'createDirRecursive'. This doesn't --- error when the destination is a symlink to a directory. -createDirRecursive' :: FilePath -> IO () -createDirRecursive' p = - handleIO (\e -> if isAlreadyExistsError e then isSymlinkDir e else throwIO e) - . createDirectoryIfMissing True - $ p - - where - isSymlinkDir e = do - ft <- pathIsSymbolicLink p - case ft of - True -> do - rp <- canonicalizePath p - rft <- doesDirectoryExist rp - case rft of - True -> pure () - _ -> throwIO e - _ -> throwIO e - - --- https://github.com/haskell/directory/issues/110 --- https://github.com/haskell/directory/issues/96 --- https://www.sqlite.org/src/info/89f1848d7f -recyclePathForcibly :: ( MonadIO m - , MonadReader env m - , HasDirs env - , MonadMask m - ) - => GHCupPath - -> m () -recyclePathForcibly fp - | isWindows = do - Dirs { recycleDir } <- getDirs - tmp <- liftIO $ createTempGHCupDirectory recycleDir "recyclePathForcibly" - let dest = tmp `appendGHCupPath` takeFileName (fromGHCupPath fp) - liftIO (moveFile (fromGHCupPath fp) (fromGHCupPath dest)) - `catch` - (\e -> if | isDoesNotExistError e -> pure () - | isPermissionError e || ioeGetErrorType e == UnsupportedOperation {- EXDEV on windows -} -> recover (liftIO $ removePathForcibly fp) - | otherwise -> throwIO e) - `finally` - liftIO (handleIO (\_ -> pure ()) $ removePathForcibly tmp) - | otherwise = liftIO $ removePathForcibly fp - - -rmPathForcibly :: ( MonadIO m - , MonadMask m - ) - => GHCupPath - -> m () -rmPathForcibly fp - | isWindows = recover (liftIO $ removePathForcibly fp) - | otherwise = liftIO $ removePathForcibly fp - - -rmDirectory :: (MonadIO m, MonadMask m) - => GHCupPath - -> m () -rmDirectory fp - | isWindows = recover (liftIO $ removeDirectory fp) - | otherwise = liftIO $ removeDirectory fp - - --- https://www.sqlite.org/src/info/89f1848d7f --- https://github.com/haskell/directory/issues/96 -recycleFile :: ( MonadIO m - , MonadMask m - , MonadReader env m - , HasDirs env - ) - => FilePath - -> m () -recycleFile fp - | isWindows = do - Dirs { recycleDir } <- getDirs - liftIO $ whenM (doesDirectoryExist fp) $ ioError (IOError Nothing InappropriateType "recycleFile" "" Nothing (Just fp)) - tmp <- liftIO $ createTempGHCupDirectory recycleDir "recycleFile" - let dest = fromGHCupPath tmp takeFileName fp - liftIO (moveFile fp dest) - `catch` - (\e -> if isPermissionError e || ioeGetErrorType e == UnsupportedOperation {- EXDEV on windows -} then recover (liftIO $ rmFile fp) else throwIO e) - `finally` - liftIO (handleIO (\_ -> pure ()) $ removePathForcibly tmp) - | otherwise = liftIO $ removeFile fp - - -rmFile :: ( MonadIO m - , MonadMask m - ) - => FilePath - -> m () -rmFile fp - | isWindows = recover (liftIO $ removeFile fp) - | otherwise = liftIO $ removeFile fp - - -rmDirectoryLink :: (MonadIO m, MonadMask m, MonadReader env m, HasDirs env) - => FilePath - -> m () -rmDirectoryLink fp - | isWindows = recover (liftIO $ removeDirectoryLink fp) - | otherwise = liftIO $ removeDirectoryLink fp recover :: (MonadIO m, MonadMask m) => m a -> m a diff --git a/lib/GHCup/Utils/Prelude/Posix.hs b/lib/GHCup/Utils/Prelude/Posix.hs index e092320..3945423 100644 --- a/lib/GHCup/Utils/Prelude/Posix.hs +++ b/lib/GHCup/Utils/Prelude/Posix.hs @@ -1,24 +1,8 @@ module GHCup.Utils.Prelude.Posix where -import System.Directory hiding ( removeDirectory - , removeDirectoryRecursive - , removePathForcibly - , findFiles - ) -import System.Posix.Files - isWindows, isNotWindows :: Bool isWindows = False isNotWindows = not isWindows -moveFile :: FilePath -> FilePath -> IO () -moveFile = rename - - -moveFilePortable :: FilePath -> FilePath -> IO () -moveFilePortable from to = do - copyFile from to - removeFile from - diff --git a/lib/GHCup/Utils/Prelude/Windows.hs b/lib/GHCup/Utils/Prelude/Windows.hs index 914b374..bcdeb41 100644 --- a/lib/GHCup/Utils/Prelude/Windows.hs +++ b/lib/GHCup/Utils/Prelude/Windows.hs @@ -1,17 +1,6 @@ module GHCup.Utils.Prelude.Windows where -import qualified System.Win32.File as Win32 - - isWindows, isNotWindows :: Bool isWindows = True isNotWindows = not isWindows - -moveFile :: FilePath -> FilePath -> IO () -moveFile from to = Win32.moveFileEx from (Just to) 0 - - -moveFilePortable :: FilePath -> FilePath -> IO () -moveFilePortable = Win32.moveFile -