{-# LANGUAGE CPP #-}
{-# OPTIONS_HADDOCK hide #-}
module Distribution.Compat.CopyFile (
copyFile,
copyFileChanged,
filesEqual,
copyOrdinaryFile,
copyExecutableFile,
setFileOrdinary,
setFileExecutable,
setDirOrdinary,
) where
import Prelude ()
import Distribution.Compat.Prelude
import Distribution.Compat.Exception
#ifndef mingw32_HOST_OS
import Distribution.Compat.Internal.TempFile
import Control.Exception
( bracketOnError, throwIO )
import qualified Data.ByteString.Lazy as BSL
import System.IO.Error
( ioeSetLocation )
import System.Directory
( doesFileExist, renameFile, removeFile )
import System.FilePath
( takeDirectory )
import System.IO
( IOMode(ReadMode), hClose, hGetBuf, hPutBuf, hFileSize
, withBinaryFile )
import Foreign
( allocaBytes )
import System.Posix.Types
( FileMode )
import System.Posix.Internals
( c_chmod, withFilePath )
import Foreign.C
( throwErrnoPathIfMinus1_ )
#else /* else mingw32_HOST_OS */
import Control.Exception
( throwIO )
import qualified Data.ByteString.Lazy as BSL
import System.IO.Error
( ioeSetLocation )
import System.Directory
( doesFileExist )
import System.FilePath
( isRelative, normalise )
import System.IO
( IOMode(ReadMode), hFileSize
, withBinaryFile )
import qualified System.Win32.File as Win32 ( copyFile )
#endif /* mingw32_HOST_OS */
copyOrdinaryFile, copyExecutableFile :: FilePath -> FilePath -> NoCallStackIO ()
copyOrdinaryFile :: FilePath -> FilePath -> NoCallStackIO ()
copyOrdinaryFile src :: FilePath
src dest :: FilePath
dest = FilePath -> FilePath -> NoCallStackIO ()
copyFile FilePath
src FilePath
dest NoCallStackIO () -> NoCallStackIO () -> NoCallStackIO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FilePath -> NoCallStackIO ()
setFileOrdinary FilePath
dest
copyExecutableFile :: FilePath -> FilePath -> NoCallStackIO ()
copyExecutableFile src :: FilePath
src dest :: FilePath
dest = FilePath -> FilePath -> NoCallStackIO ()
copyFile FilePath
src FilePath
dest NoCallStackIO () -> NoCallStackIO () -> NoCallStackIO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FilePath -> NoCallStackIO ()
setFileExecutable FilePath
dest
setFileOrdinary, setFileExecutable, setDirOrdinary :: FilePath -> NoCallStackIO ()
#ifndef mingw32_HOST_OS
setFileOrdinary :: FilePath -> NoCallStackIO ()
setFileOrdinary path :: FilePath
path = FilePath -> FileMode -> NoCallStackIO ()
setFileMode FilePath
path 0o644
setFileExecutable :: FilePath -> NoCallStackIO ()
setFileExecutable path :: FilePath
path = FilePath -> FileMode -> NoCallStackIO ()
setFileMode FilePath
path 0o755
setFileMode :: FilePath -> FileMode -> NoCallStackIO ()
setFileMode :: FilePath -> FileMode -> NoCallStackIO ()
setFileMode name :: FilePath
name m :: FileMode
m =
FilePath -> (CString -> NoCallStackIO ()) -> NoCallStackIO ()
forall a. FilePath -> (CString -> IO a) -> IO a
withFilePath FilePath
name ((CString -> NoCallStackIO ()) -> NoCallStackIO ())
-> (CString -> NoCallStackIO ()) -> NoCallStackIO ()
forall a b. (a -> b) -> a -> b
$ \s :: CString
s -> do
FilePath -> FilePath -> IO CInt -> NoCallStackIO ()
forall a.
(Eq a, Num a) =>
FilePath -> FilePath -> IO a -> NoCallStackIO ()
throwErrnoPathIfMinus1_ "setFileMode" FilePath
name (CString -> FileMode -> IO CInt
c_chmod CString
s FileMode
m)
#else
setFileOrdinary _ = return ()
setFileExecutable _ = return ()
#endif
setDirOrdinary :: FilePath -> NoCallStackIO ()
setDirOrdinary = FilePath -> NoCallStackIO ()
setFileExecutable
copyFile :: FilePath -> FilePath -> NoCallStackIO ()
copyFile :: FilePath -> FilePath -> NoCallStackIO ()
copyFile fromFPath :: FilePath
fromFPath toFPath :: FilePath
toFPath =
NoCallStackIO ()
copy
NoCallStackIO ()
-> (IOException -> NoCallStackIO ()) -> NoCallStackIO ()
forall a. IO a -> (IOException -> IO a) -> IO a
`catchIO` (\ioe :: IOException
ioe -> IOException -> NoCallStackIO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> FilePath -> IOException
ioeSetLocation IOException
ioe "copyFile"))
where
#ifndef mingw32_HOST_OS
copy :: NoCallStackIO ()
copy = FilePath
-> IOMode -> (Handle -> NoCallStackIO ()) -> NoCallStackIO ()
forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile FilePath
fromFPath IOMode
ReadMode ((Handle -> NoCallStackIO ()) -> NoCallStackIO ())
-> (Handle -> NoCallStackIO ()) -> NoCallStackIO ()
forall a b. (a -> b) -> a -> b
$ \hFrom :: Handle
hFrom ->
IO (FilePath, Handle)
-> ((FilePath, Handle) -> NoCallStackIO ())
-> ((FilePath, Handle) -> NoCallStackIO ())
-> NoCallStackIO ()
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracketOnError IO (FilePath, Handle)
openTmp (FilePath, Handle) -> NoCallStackIO ()
cleanTmp (((FilePath, Handle) -> NoCallStackIO ()) -> NoCallStackIO ())
-> ((FilePath, Handle) -> NoCallStackIO ()) -> NoCallStackIO ()
forall a b. (a -> b) -> a -> b
$ \(tmpFPath :: FilePath
tmpFPath, hTmp :: Handle
hTmp) ->
do Int -> (Ptr Any -> NoCallStackIO ()) -> NoCallStackIO ()
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
bufferSize ((Ptr Any -> NoCallStackIO ()) -> NoCallStackIO ())
-> (Ptr Any -> NoCallStackIO ()) -> NoCallStackIO ()
forall a b. (a -> b) -> a -> b
$ Handle -> Handle -> Ptr Any -> NoCallStackIO ()
forall a. Handle -> Handle -> Ptr a -> NoCallStackIO ()
copyContents Handle
hFrom Handle
hTmp
Handle -> NoCallStackIO ()
hClose Handle
hTmp
FilePath -> FilePath -> NoCallStackIO ()
renameFile FilePath
tmpFPath FilePath
toFPath
openTmp :: IO (FilePath, Handle)
openTmp = FilePath -> FilePath -> IO (FilePath, Handle)
openBinaryTempFile (FilePath -> FilePath
takeDirectory FilePath
toFPath) ".copyFile.tmp"
cleanTmp :: (FilePath, Handle) -> NoCallStackIO ()
cleanTmp (tmpFPath :: FilePath
tmpFPath, hTmp :: Handle
hTmp) = do
Handle -> NoCallStackIO ()
hClose Handle
hTmp NoCallStackIO ()
-> (IOException -> NoCallStackIO ()) -> NoCallStackIO ()
forall a. IO a -> (IOException -> IO a) -> IO a
`catchIO` \_ -> () -> NoCallStackIO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
FilePath -> NoCallStackIO ()
removeFile FilePath
tmpFPath NoCallStackIO ()
-> (IOException -> NoCallStackIO ()) -> NoCallStackIO ()
forall a. IO a -> (IOException -> IO a) -> IO a
`catchIO` \_ -> () -> NoCallStackIO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
bufferSize :: Int
bufferSize = 4096
copyContents :: Handle -> Handle -> Ptr a -> NoCallStackIO ()
copyContents hFrom :: Handle
hFrom hTo :: Handle
hTo buffer :: Ptr a
buffer = do
Int
count <- Handle -> Ptr a -> Int -> IO Int
forall a. Handle -> Ptr a -> Int -> IO Int
hGetBuf Handle
hFrom Ptr a
buffer Int
bufferSize
Bool -> NoCallStackIO () -> NoCallStackIO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
count Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0) (NoCallStackIO () -> NoCallStackIO ())
-> NoCallStackIO () -> NoCallStackIO ()
forall a b. (a -> b) -> a -> b
$ do
Handle -> Ptr a -> Int -> NoCallStackIO ()
forall a. Handle -> Ptr a -> Int -> NoCallStackIO ()
hPutBuf Handle
hTo Ptr a
buffer Int
count
Handle -> Handle -> Ptr a -> NoCallStackIO ()
copyContents Handle
hFrom Handle
hTo Ptr a
buffer
#else
copy = Win32.copyFile (toExtendedLengthPath fromFPath)
(toExtendedLengthPath toFPath)
False
toExtendedLengthPath :: FilePath -> FilePath
toExtendedLengthPath path
| isRelative path = path
| otherwise =
case normalise path of
'\\' : '?' : '?' : '\\' : _ -> path
'\\' : '\\' : '?' : '\\' : _ -> path
'\\' : '\\' : '.' : '\\' : _ -> path
'\\' : subpath@('\\' : _) -> "\\\\?\\UNC" <> subpath
normalisedPath -> "\\\\?\\" <> normalisedPath
#endif /* mingw32_HOST_OS */
copyFileChanged :: FilePath -> FilePath -> NoCallStackIO ()
copyFileChanged :: FilePath -> FilePath -> NoCallStackIO ()
copyFileChanged src :: FilePath
src dest :: FilePath
dest = do
Bool
equal <- FilePath -> FilePath -> NoCallStackIO Bool
filesEqual FilePath
src FilePath
dest
Bool -> NoCallStackIO () -> NoCallStackIO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
equal (NoCallStackIO () -> NoCallStackIO ())
-> NoCallStackIO () -> NoCallStackIO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> NoCallStackIO ()
copyFile FilePath
src FilePath
dest
filesEqual :: FilePath -> FilePath -> NoCallStackIO Bool
filesEqual :: FilePath -> FilePath -> NoCallStackIO Bool
filesEqual f1 :: FilePath
f1 f2 :: FilePath
f2 = do
Bool
ex1 <- FilePath -> NoCallStackIO Bool
doesFileExist FilePath
f1
Bool
ex2 <- FilePath -> NoCallStackIO Bool
doesFileExist FilePath
f2
if Bool -> Bool
not (Bool
ex1 Bool -> Bool -> Bool
&& Bool
ex2) then Bool -> NoCallStackIO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False else
FilePath
-> IOMode -> (Handle -> NoCallStackIO Bool) -> NoCallStackIO Bool
forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile FilePath
f1 IOMode
ReadMode ((Handle -> NoCallStackIO Bool) -> NoCallStackIO Bool)
-> (Handle -> NoCallStackIO Bool) -> NoCallStackIO Bool
forall a b. (a -> b) -> a -> b
$ \h1 :: Handle
h1 ->
FilePath
-> IOMode -> (Handle -> NoCallStackIO Bool) -> NoCallStackIO Bool
forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile FilePath
f2 IOMode
ReadMode ((Handle -> NoCallStackIO Bool) -> NoCallStackIO Bool)
-> (Handle -> NoCallStackIO Bool) -> NoCallStackIO Bool
forall a b. (a -> b) -> a -> b
$ \h2 :: Handle
h2 -> do
Integer
s1 <- Handle -> IO Integer
hFileSize Handle
h1
Integer
s2 <- Handle -> IO Integer
hFileSize Handle
h2
if Integer
s1 Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
s2
then Bool -> NoCallStackIO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
else do
ByteString
c1 <- Handle -> IO ByteString
BSL.hGetContents Handle
h1
ByteString
c2 <- Handle -> IO ByteString
BSL.hGetContents Handle
h2
Bool -> NoCallStackIO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> NoCallStackIO Bool) -> Bool -> NoCallStackIO Bool
forall a b. (a -> b) -> a -> b
$! ByteString
c1 ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
c2