    {-# LANGUAGE CPP #-}
    {-# OPTIONS_HADDOCK hide #-}
    module Distribution.Compat.CopyFile (
      copyFile,
      copyFileChanged,
      filesEqual,
      copyOrdinaryFile,
      copyExecutableFile,
      setFileOrdinary,
      setFileExecutable,
      setDirOrdinary,
      ) where

    import Prelude ()
    import Distribution.Compat.Prelude

    #ifndef mingw32_HOST_OS
    import Distribution.Compat.Internal.TempFile

    import Control.Exception
             ( bracketOnError )
    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 qualified Data.ByteString.Lazy as BSL
    import System.IO.Error
      ( ioeSetLocation )
    import System.Directory
      ( doesFileExist )
    import System.FilePath
      ( addTrailingPathSeparator
      , hasTrailingPathSeparator
      , isPathSeparator
      , isRelative
      , joinDrive
      , joinPath
      , pathSeparator
      , pathSeparators
      , splitDirectories
      , splitDrive
      )
    import System.IO
      ( IOMode(ReadMode), hFileSize
      , withBinaryFile )

    import qualified System.Win32.File as Win32 ( copyFile )
    #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 (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 (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
    setFileOrdinary :: FilePath -> IO ()
    setFileOrdinary   FilePath
    path = FilePath -> FileMode -> IO ()
    setFileMode FilePath
    path FileMode
    0o644 -- file perms -rw-r--r--
    setFileExecutable :: FilePath -> IO ()
    setFileExecutable FilePath
    path = FilePath -> FileMode -> IO ()
    setFileMode FilePath
    path FileMode
    0o755 -- file perms -rwxr-xr-x

    setFileMode :: FilePath -> FileMode -> IO ()
    setFileMode :: FilePath -> FileMode -> IO ()
    setFileMode FilePath
    name FileMode
    m =
      FilePath -> (CString -> IO ()) -> IO ()
    forall a. FilePath -> (CString -> IO a) -> IO a
    withFilePath FilePath
    name ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \CString
    s -> do
        FilePath -> FilePath -> IO CInt -> IO ()
    forall a. (Eq a, Num a) => FilePath -> FilePath -> IO a -> IO ()
    throwErrnoPathIfMinus1_ FilePath
    "setFileMode" FilePath
    name (CString -> FileMode -> IO CInt
    c_chmod CString
    s FileMode
    m)
    #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 ()
    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
    #ifndef mingw32_HOST_OS
          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 (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 (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
          copy = Win32.copyFile (toExtendedLengthPath fromFPath)
                                (toExtendedLengthPath toFPath)
                                False

    -- NOTE: Shamelessly lifted from System.Directory.Internal.Windows

    -- | Add the @"\\\\?\\"@ prefix if necessary or possible.  The path remains
    -- unchanged if the prefix is not added.  This function can sometimes be used
    -- to bypass the @MAX_PATH@ length restriction in Windows API calls.
    --
    -- See Note [Path normalization].
    toExtendedLengthPath :: FilePath -> FilePath
    toExtendedLengthPath path
      | isRelative path = path
      | otherwise =
          case normalisedPath of
            '\\' : '?'  : '?' : '\\' : _ -> normalisedPath
            '\\' : '\\' : '?' : '\\' : _ -> normalisedPath
            '\\' : '\\' : '.' : '\\' : _ -> normalisedPath
            '\\' : subpath@('\\' : _)    -> "\\\\?\\UNC" <> subpath
            _                            -> "\\\\?\\" <> normalisedPath
        where normalisedPath = simplifyWindows path

    -- | Similar to 'normalise' but:
    --
    -- * empty paths stay empty,
    -- * parent dirs (@..@) are expanded, and
    -- * paths starting with @\\\\?\\@ are preserved.
    --
    -- The goal is to preserve the meaning of paths better than 'normalise'.
    --
    -- Note [Path normalization]
    -- 'normalise' doesn't simplify path names but will convert / into \\
    -- this would normally not be a problem as once the path hits the RTS we would
    -- have simplified the path then.  However since we're calling the WIn32 API
    -- directly we have to do the simplification before the call.  Without this the
    -- path Z:// would become Z:\\\\ and when converted to a device path the path
    -- becomes \\?\Z:\\\\ which is an invalid path.
    --
    -- This is not a bug in normalise as it explicitly states that it won't simplify
    -- a FilePath.
    simplifyWindows :: FilePath -> FilePath
    simplifyWindows "" = ""
    simplifyWindows path =
      case drive' of
        "\\\\?\\" -> drive' <> subpath
        _ -> simplifiedPath
      where
        simplifiedPath = joinDrive drive' subpath'
        (drive, subpath) = splitDrive path
        drive' = upperDrive (normaliseTrailingSep (normalisePathSeps drive))
        subpath' = appendSep . avoidEmpty . prependSep . joinPath .
                   stripPardirs . expandDots . skipSeps .
                   splitDirectories $ subpath

        upperDrive d = case d of
          c : ':' : s | isAlpha c && all isPathSeparator s -> toUpper c : ':' : s
          _ -> d
        skipSeps = filter (not . (`elem` (pure <$> pathSeparators)))
        stripPardirs | pathIsAbsolute || subpathIsAbsolute = dropWhile (== "..")
                     | otherwise = id
        prependSep | subpathIsAbsolute = (pathSeparator :)
                   | otherwise = id
        avoidEmpty | not pathIsAbsolute
                     && (null drive || hasTrailingPathSep) -- prefer "C:" over "C:."
                     = emptyToCurDir
                   | otherwise = id
        appendSep p | hasTrailingPathSep
                      && not (pathIsAbsolute && null p)
                      = addTrailingPathSeparator p
                    | otherwise = p
        pathIsAbsolute = not (isRelative path)
        subpathIsAbsolute = any isPathSeparator (take 1 subpath)
        hasTrailingPathSep = hasTrailingPathSeparator subpath

    -- | Given a list of path segments, expand @.@ and @..@.  The path segments
    -- must not contain path separators.
    expandDots :: [FilePath] -> [FilePath]
    expandDots = reverse . go []
      where
        go ys' xs' =
          case xs' of
            [] -> ys'
            x : xs ->
              case x of
                "." -> go ys' xs
                ".." ->
                  case ys' of
                    [] -> go (x : ys') xs
                    ".." : _ -> go (x : ys') xs
                    _ : ys -> go ys xs
                _ -> go (x : ys') xs

    -- | Convert to the right kind of slashes.
    normalisePathSeps :: FilePath -> FilePath
    normalisePathSeps p = (\ c -> if isPathSeparator c then pathSeparator else c) <$> p

    -- | Remove redundant trailing slashes and pick the right kind of slash.
    normaliseTrailingSep :: FilePath -> FilePath
    normaliseTrailingSep path = do
      let path' = reverse path
      let (sep, path'') = span isPathSeparator path'
      let addSep = if null sep then id else (pathSeparator :)
      reverse (addSep path'')

    -- | Convert empty paths to the current directory, otherwise leave it
    -- unchanged.
    emptyToCurDir :: FilePath -> FilePath
    emptyToCurDir ""   = "."
    emptyToCurDir path = path
    #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 (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 (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 (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