793ddecd4b
And follow-on changes. Note that relatedTemplate was changed to operate on a RawFilePath, and so when it counts the length, it is now the number of bytes, not the number of code points. This will just make it truncate shorter strings in some cases, the truncation is still unicode aware. When not building with the OsPath flag, toOsPath . fromRawFilePath and fromRawFilePath . fromOsPath do extra conversions back and forth between String and ByteString. That overhead could be avoided, but that's the non-optimised build mode, so didn't bother. Sponsored-by: unqueued
85 lines
2 KiB
Haskell
85 lines
2 KiB
Haskell
{- 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 Utility.OsPath
|
|
import qualified Utility.RawFilePath as R
|
|
import Author
|
|
|
|
{- 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 (toOsPath dest) ()
|
|
where
|
|
rethrow = throwM e
|
|
|
|
mv tmp () = do
|
|
let tmp' = fromRawFilePath (fromOsPath tmp)
|
|
-- 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 <- copyright =<< 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
|
|
|
|
copyright :: Copyright
|
|
copyright = author JoeyHess (2022-11)
|
|
#endif
|