{-# OPTIONS -cpp #-}
-- OPTIONS required for ghc-6.4.x compat, and must appear first
{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -cpp #-}
{-# OPTIONS_NHC98 -cpp #-}
{-# OPTIONS_JHC -fcpp #-}
-- #hide
module Distribution.Compat.CopyFile (
  copyFile,
  copyOrdinaryFile,
  copyExecutableFile,
  setFileOrdinary,
  setFileExecutable,
  setDirOrdinary,
  ) where

#ifdef __GLASGOW_HASKELL__

import Control.Monad
         ( when )
import Control.Exception
         ( bracket, bracketOnError )
import Distribution.Compat.Exception
         ( catchIO )
#if __GLASGOW_HASKELL__ >= 608
import Distribution.Compat.Exception
         ( throwIOIO )
import System.IO.Error
         ( ioeSetLocation )
#endif
import System.Directory
         ( renameFile, removeFile )
import Distribution.Compat.TempFile
         ( openBinaryTempFile )
import System.FilePath
         ( takeDirectory )
import System.IO
         ( openBinaryFile, IOMode(ReadMode), hClose, hGetBuf, hPutBuf )
import Foreign
         ( allocaBytes )
#endif /* __GLASGOW_HASKELL__ */

#ifndef mingw32_HOST_OS
#if __GLASGOW_HASKELL__ >= 611
import System.Posix.Internals (withFilePath)
#else
import Foreign.C              (withCString)
#endif
import System.Posix.Types
         ( FileMode )
import System.Posix.Internals
         ( c_chmod )
#if __GLASGOW_HASKELL__ >= 608
import Foreign.C
         ( throwErrnoPathIfMinus1_ )
#else
import Foreign.C
         ( throwErrnoIfMinus1_ )
#endif
#endif /* mingw32_HOST_OS */

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

setFileOrdinary,  setFileExecutable, setDirOrdinary  :: FilePath -> IO ()
#ifndef mingw32_HOST_OS
setFileOrdinary   path = setFileMode :: FilePath -> FileMode -> IO ()setFileMode path :: FilePathpath 0o644 -- file perms -rw-r--r--
setFileExecutable path = setFileMode :: FilePath -> FileMode -> IO ()setFileMode path :: FilePathpath 0o755 -- file perms -rwxr-xr-x

setFileMode :: FilePath -> FileMode -> IO ()
setFileMode name m =
#if __GLASGOW_HASKELL__ >= 611
  withFilePath :: FilePath -> (CString -> IO a) -> IO awithFilePath name :: FilePathname ($) :: (a -> b) -> a -> b$ \s -> do
#else
  withCString name $ \s -> do
#endif
#if __GLASGOW_HASKELL__ >= 608
    throwErrnoPathIfMinus1_ ::
  Num a => String -> FilePath -> IO a -> IO ()throwErrnoPathIfMinus1_ "setFileMode" name :: FilePathname (c_chmod :: CString -> CMode -> IO CIntc_chmod s :: CStrings m :: FileModem)
#else
    throwErrnoIfMinus1_                   name (c_chmod s m)
#endif
#else
setFileOrdinary   _ = return ()
setFileExecutable _ = return ()
#endif
-- This happens to be true on Unix and currently on Windows too:
setDirOrdinary = setFileExecutable :: FilePath -> IO ()setFileExecutable

copyFile :: FilePath -> FilePath -> IO ()
#ifdef __GLASGOW_HASKELL__
copyFile fromFPath toFPath =
  copy :: IO ()copy
#if __GLASGOW_HASKELL__ >= 608
    catchIO :: IO a -> (IOException -> IO a) -> IO a`catchIO` (\ioe -> throwIOIO :: IOException -> IO athrowIOIO (ioeSetLocation :: IOError -> String -> IOErrorioeSetLocation ioe :: IOExceptionioe "copyFile"))
#endif
    where copy = bracket :: IO a -> (a -> IO b) -> (a -> IO c) -> IO cbracket (openBinaryFile :: FilePath -> IOMode -> IO HandleopenBinaryFile fromFPath :: FilePathfromFPath ReadMode :: IOModeReadMode) hClose :: Handle -> IO ()hClose ($) :: (a -> b) -> a -> b$ \hFrom ->
                 bracketOnError :: IO a -> (a -> IO b) -> (a -> IO c) -> IO cbracketOnError openTmp :: IO (FilePath, Handle)openTmp cleanTmp :: (FilePath, Handle) -> IO ()cleanTmp ($) :: (a -> b) -> a -> b$ \(tmpFPath, hTmp) ->
                 do allocaBytes :: Int -> (Ptr a -> IO b) -> IO ballocaBytes bufferSize :: IntbufferSize ($) :: (a -> b) -> a -> b$ copyContents :: Handle -> Handle -> Ptr a -> IO ()copyContents hFrom :: HandlehFrom hTmp :: HandlehTmp
                    hClose :: Handle -> IO ()hClose hTmp :: HandlehTmp
                    renameFile :: FilePath -> FilePath -> IO ()renameFile tmpFPath :: FilePathtmpFPath toFPath :: FilePathtoFPath
          openTmp = openBinaryTempFile :: FilePath -> String -> IO (FilePath, Handle)openBinaryTempFile (takeDirectory :: FilePath -> FilePathtakeDirectory toFPath :: FilePathtoFPath) ".copyFile.tmp"
          cleanTmp (tmpFPath, hTmp) = do
            hClose :: Handle -> IO ()hClose hTmp :: HandlehTmp          catchIO :: IO a -> (IOException -> IO a) -> IO a`catchIO` \_ -> return :: Monad m => forall a. a -> m areturn ()
            removeFile :: FilePath -> IO ()removeFile tmpFPath :: FilePathtmpFPath  catchIO :: IO a -> (IOException -> IO a) -> IO a`catchIO` \_ -> return :: Monad m => forall a. a -> m areturn ()
          bufferSize = 4096

          copyContents hFrom hTo buffer = do
                  count <- hGetBuf :: Handle -> Ptr a -> Int -> IO InthGetBuf hFrom :: HandlehFrom buffer :: Ptr abuffer bufferSize :: IntbufferSize
                  when :: Monad m => Bool -> m () -> m ()when (count :: Intcount (>) :: Ord a => a -> a -> Bool> 0) ($) :: (a -> b) -> a -> b$ do
                          hPutBuf :: Handle -> Ptr a -> Int -> IO ()hPutBuf hTo :: HandlehTo buffer :: Ptr abuffer count :: Intcount
                          copyContents :: Handle -> Handle -> Ptr a -> IO ()copyContents hFrom :: HandlehFrom hTo :: HandlehTo buffer :: Ptr abuffer
#else
copyFile fromFPath toFPath = readFile fromFPath >>= writeFile toFPath
#endif