diff options
Diffstat (limited to 'Utility/MoveFile.hs')
-rw-r--r-- | Utility/MoveFile.hs | 79 |
1 files changed, 79 insertions, 0 deletions
diff --git a/Utility/MoveFile.hs b/Utility/MoveFile.hs new file mode 100644 index 0000000..6481b29 --- /dev/null +++ b/Utility/MoveFile.hs @@ -0,0 +1,79 @@ +{- moving files + - + - Copyright 2011-2020 Joey Hess <id@joeyh.name> + - + - License: BSD-2-clause + -} + +{-# LANGUAGE CPP #-} +{-# LANGUAGE LambdaCase #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} + +module Utility.MoveFile ( + moveFile, +) where + +import Control.Monad +import System.IO.Error +import Prelude + +#ifndef mingw32_HOST_OS +import System.PosixCompat.Files (isDirectory) +import Control.Monad.IfElse +import Utility.SafeCommand +#endif + +import Utility.SystemDirectory +import Utility.Tmp +import Utility.Exception +import Utility.Monad +import Utility.FileSystemEncoding +import qualified Utility.RawFilePath as R + +{- Moves one filename to another. + - First tries a rename, but falls back to moving across devices if needed. -} +moveFile :: RawFilePath -> RawFilePath -> IO () +moveFile src dest = tryIO (R.rename src dest) >>= onrename + where + onrename (Right _) = noop + onrename (Left e) + | isPermissionError e = rethrow + | isDoesNotExistError e = rethrow + | otherwise = viaTmp mv (fromRawFilePath dest) () + where + rethrow = throwM e + + mv tmp () = do + -- copyFile is likely not as optimised as + -- the mv command, so we'll use the command. + -- + -- But, while Windows has a "mv", it does not + -- seem very reliable, so use copyFile there. +#ifndef mingw32_HOST_OS + -- If dest is a directory, mv would move the file + -- into it, which is not desired. + whenM (isdir dest) rethrow + ok <- boolSystem "mv" + [ Param "-f" + , Param (fromRawFilePath src) + , Param tmp + ] + let e' = e +#else + r <- tryIO $ copyFile (fromRawFilePath src) tmp + let (ok, e') = case r of + Left err -> (False, err) + Right _ -> (True, e) +#endif + unless ok $ do + -- delete any partial + _ <- tryIO $ removeFile tmp + throwM e' + +#ifndef mingw32_HOST_OS + isdir f = do + r <- tryIO $ R.getSymbolicLinkStatus f + case r of + (Left _) -> return False + (Right s) -> return $ isDirectory s +#endif |