{-# LANGUAGE CPP #-}
{-# OPTIONS_HADDOCK hide #-}

{- HLINT ignore "Use fewer imports" -}

module Distribution.Compat.CopyFile
  ( copyFile
  , copyFileChanged
  , filesEqual
  , copyOrdinaryFile
  , copyExecutableFile
  , setFileOrdinary
  , setFileExecutable
  , setDirOrdinary
  ) where

import Distribution.Compat.Prelude
import Prelude ()

import qualified Data.ByteString.Lazy as BSL
import System.Directory
  ( doesFileExist
  )
import System.IO
  ( IOMode (ReadMode)
  , hFileSize
  , withBinaryFile
  )

#ifndef mingw32_HOST_OS
import Control.Exception
         ( bracketOnError )
import Data.Bits
         ( (.|.) )
import System.IO.Error
         ( ioeSetLocation )
import System.Directory
         ( renameFile, removeFile )
import System.FilePath
         ( takeDirectory )
import System.IO
         ( hClose, hGetBuf, hPutBuf, openBinaryTempFile )
import Foreign
         ( allocaBytes )

import System.Posix.Types
         ( FileMode )
import System.Posix.Files
         ( getFileStatus, fileMode, setFileMode )

#else /* else mingw32_HOST_OS */

import System.Directory
  ( copyFileWithMetadata )

#endif /* mingw32_HOST_OS */

copyOrdinaryFile, copyExecutableFile :: FilePath -> FilePath -> IO ()
copyOrdinaryFile :: FilePath -> FilePath -> IO ()
copyOrdinaryFile FilePath
src FilePath
dest = FilePath -> FilePath -> IO ()
copyFile FilePath
src FilePath
dest IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FilePath -> IO ()
setFileOrdinary FilePath
dest
copyExecutableFile :: FilePath -> FilePath -> IO ()
copyExecutableFile FilePath
src FilePath
dest = FilePath -> FilePath -> IO ()
copyFile FilePath
src FilePath
dest IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FilePath -> IO ()
setFileExecutable FilePath
dest

setFileOrdinary, setFileExecutable, setDirOrdinary :: FilePath -> IO ()
#ifndef mingw32_HOST_OS
-- When running with a restrictive UMASK such as 0077 we still want to
-- install files and directories that are accessible to other users.
setFileOrdinary :: FilePath -> IO ()
setFileOrdinary   FilePath
path = FilePath -> FileMode -> IO ()
addFileMode FilePath
path FileMode
0o644 -- file perms -rw-r--r--
setFileExecutable :: FilePath -> IO ()
setFileExecutable FilePath
path = FilePath -> FileMode -> IO ()
addFileMode FilePath
path FileMode
0o755 -- file perms -rwxr-xr-x

addFileMode :: FilePath -> FileMode -> IO ()
addFileMode :: FilePath -> FileMode -> IO ()
addFileMode FilePath
name FileMode
m = do
  FileMode
o <- FileStatus -> FileMode
fileMode (FileStatus -> FileMode) -> IO FileStatus -> IO FileMode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO FileStatus
getFileStatus FilePath
name
  FilePath -> FileMode -> IO ()
setFileMode FilePath
name (FileMode
m FileMode -> FileMode -> FileMode
forall a. Bits a => a -> a -> a
.|. FileMode
o)
#else
setFileOrdinary   _ = return ()
setFileExecutable _ = return ()
#endif
-- This happens to be true on Unix and currently on Windows too:
setDirOrdinary :: FilePath -> IO ()
setDirOrdinary = FilePath -> IO ()
setFileExecutable

-- | Copies a file to a new destination.
-- Often you should use `copyFileChanged` instead.
copyFile :: FilePath -> FilePath -> IO ()
#ifndef mingw32_HOST_OS
copyFile :: FilePath -> FilePath -> IO ()
copyFile FilePath
fromFPath FilePath
toFPath =
  IO ()
copy
    IO () -> (IOError -> IO ()) -> IO ()
forall a. IO a -> (IOError -> IO a) -> IO a
`catchIO` (\IOError
ioe -> IOError -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOError -> FilePath -> IOError
ioeSetLocation IOError
ioe FilePath
"copyFile"))
  where
      copy :: IO ()
copy = FilePath -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile FilePath
fromFPath IOMode
ReadMode ((Handle -> IO ()) -> IO ()) -> (Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Handle
hFrom ->
             IO (FilePath, Handle)
-> ((FilePath, Handle) -> IO ())
-> ((FilePath, Handle) -> IO ())
-> IO ()
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracketOnError IO (FilePath, Handle)
openTmp (FilePath, Handle) -> IO ()
cleanTmp (((FilePath, Handle) -> IO ()) -> IO ())
-> ((FilePath, Handle) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(FilePath
tmpFPath, Handle
hTmp) ->
             do Int -> (Ptr Any -> IO ()) -> IO ()
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
bufferSize ((Ptr Any -> IO ()) -> IO ()) -> (Ptr Any -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ Handle -> Handle -> Ptr Any -> IO ()
forall {a}. Handle -> Handle -> Ptr a -> IO ()
copyContents Handle
hFrom Handle
hTmp
                Handle -> IO ()
hClose Handle
hTmp
                FilePath -> FilePath -> IO ()
renameFile FilePath
tmpFPath FilePath
toFPath
      openTmp :: IO (FilePath, Handle)
openTmp = FilePath -> FilePath -> IO (FilePath, Handle)
openBinaryTempFile (FilePath -> FilePath
takeDirectory FilePath
toFPath) FilePath
".copyFile.tmp"
      cleanTmp :: (FilePath, Handle) -> IO ()
cleanTmp (FilePath
tmpFPath, Handle
hTmp) = do
        Handle -> IO ()
hClose Handle
hTmp          IO () -> (IOError -> IO ()) -> IO ()
forall a. IO a -> (IOError -> IO a) -> IO a
`catchIO` \IOError
_ -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        FilePath -> IO ()
removeFile FilePath
tmpFPath  IO () -> (IOError -> IO ()) -> IO ()
forall a. IO a -> (IOError -> IO a) -> IO a
`catchIO` \IOError
_ -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      bufferSize :: Int
bufferSize = Int
4096

      copyContents :: Handle -> Handle -> Ptr a -> IO ()
copyContents Handle
hFrom Handle
hTo 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 -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
count Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                      Handle -> Ptr a -> Int -> IO ()
forall a. Handle -> Ptr a -> Int -> IO ()
hPutBuf Handle
hTo Ptr a
buffer Int
count
                      Handle -> Handle -> Ptr a -> IO ()
copyContents Handle
hFrom Handle
hTo Ptr a
buffer
#else
copyFile = copyFileWithMetadata
#endif /* mingw32_HOST_OS */

-- | Like `copyFile`, but does not touch the target if source and destination
-- are already byte-identical. This is recommended as it is useful for
-- time-stamp based recompilation avoidance.
copyFileChanged :: FilePath -> FilePath -> IO ()
copyFileChanged :: FilePath -> FilePath -> IO ()
copyFileChanged FilePath
src FilePath
dest = do
  Bool
equal <- FilePath -> FilePath -> IO Bool
filesEqual FilePath
src FilePath
dest
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
equal (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO ()
copyFile FilePath
src FilePath
dest

-- | Checks if two files are byte-identical.
-- Returns False if either of the files do not exist or if files
-- are of different size.
filesEqual :: FilePath -> FilePath -> IO Bool
filesEqual :: FilePath -> FilePath -> IO Bool
filesEqual FilePath
f1 FilePath
f2 = do
  Bool
ex1 <- FilePath -> IO Bool
doesFileExist FilePath
f1
  Bool
ex2 <- FilePath -> IO Bool
doesFileExist FilePath
f2
  if Bool -> Bool
not (Bool
ex1 Bool -> Bool -> Bool
&& Bool
ex2)
    then Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    else FilePath -> IOMode -> (Handle -> IO Bool) -> IO Bool
forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile FilePath
f1 IOMode
ReadMode ((Handle -> IO Bool) -> IO Bool) -> (Handle -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Handle
h1 ->
      FilePath -> IOMode -> (Handle -> IO Bool) -> IO Bool
forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile FilePath
f2 IOMode
ReadMode ((Handle -> IO Bool) -> IO Bool) -> (Handle -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \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 -> IO Bool
forall a. a -> IO a
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 -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$! ByteString
c1 ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
c2