import System.IO
import System.Posix.Internals
import Foreign.Marshal.Alloc
import Control.Monad(when, liftM)
import Control.Exception(bracket)

import Foreign.C
import GHC.Handle
import GHC.IOBase
import GHC.Base
import Data.Bits

-----------------------------------------------------
-- Variant 1 - Portable
-----------------------------------------------------

copyFile1 :: FilePath -> FilePath -> IO ()
copyFile1 fromFPath toFPath =
	bracket (openBinaryFile fromFPath ReadMode) hClose $ \hFrom ->
	bracket (openBinaryFile toFPath WriteMode) hClose $ \hTo ->
	allocaBytes bufferSize $ \buffer ->
		copyContents hFrom hTo buffer
	where
		bufferSize = 1024
		
		copyContents hFrom hTo buffer = do
			count <- hGetBuf hFrom buffer bufferSize
			when (count > 0) $ do
				hPutBuf hTo buffer count
				copyContents hFrom hTo buffer

-----------------------------------------------------
-- Variant 2 - GHC specific, optimized
-----------------------------------------------------

std_flags    = o_NONBLOCK   .|. o_NOCTTY
output_flags = std_flags    .|. o_CREAT
read_flags   = std_flags    .|. o_RDONLY 
write_flags  = output_flags .|. o_WRONLY

addFilePathToIOError fun fp (IOError h iot _ str _)
  = IOError h iot fun str (Just fp)

copyFile2 :: FilePath -> FilePath -> IO ()
copyFile2 fromFPath toFPath =
	bracket (withFromFPathInIOError (throwErrnoIfMinus1Retry "copyFile"
 	          (withCString fromFPath (\f -> c_open f (fromIntegral (read_flags  .|. o_BINARY)) 0o666)))) c_close $ \fdFrom ->
	bracket (withToFPathInIOError (throwErrnoIfMinus1Retry "copyFile"
 	          (withCString toFPath   (\f -> c_open f (fromIntegral (write_flags .|. o_BINARY)) 0o666)))) c_close $ \fdTo -> do		
		buf <- allocateBuffer bufferSize ReadBuffer
		let copyContents = do
				count <- withFromFPathInIOError (readRawBuffer "copyFile" (fromIntegral fdFrom) False (bufBuf buf) 0 (fromIntegral bufferSize))
				when (count > 0) $ do
					withToFPathInIOError (writeRawBuffer "copyFile" (fromIntegral fdTo) False (bufBuf buf) 0 count)
					copyContents
		withToFPathInIOError (fileTruncate toFPath)
		copyContents
	where
		bufferSize = 1024 :: Int
		
		withFromFPathInIOError f = catch f (\e -> ioError (addFilePathToIOError "copyFile" fromFPath e))
		withToFPathInIOError   f = catch f (\e -> ioError (addFilePathToIOError "copyFile" toFPath   e))