{-# LANGUAGE CPP #-}
module Darcs.Util.Workaround
(
renameFile
, setExecutable
, getCurrentDirectory
, installHandler
, raiseSignal
, Handler(..)
, Signal
, sigINT
, sigHUP
, sigABRT
, sigALRM
, sigTERM
, sigPIPE
) where
import Prelude ()
import Darcs.Prelude
#ifdef WIN32
import Control.Monad ( unless )
import qualified System.Directory ( renameFile, getCurrentDirectory, removeFile )
import Control.Exception ( catch, IOException )
import qualified Control.Exception ( mask )
import qualified System.IO.Error ( isDoesNotExistError, ioError )
#else
import System.Posix.Signals(installHandler, raiseSignal, Handler(..), Signal,
sigINT, sigHUP, sigABRT, sigALRM, sigTERM, sigPIPE)
import System.Directory ( renameFile, getCurrentDirectory )
import System.Posix.Files (fileMode,getFileStatus, setFileMode,
setFileCreationMask,
ownerReadMode, ownerWriteMode, ownerExecuteMode,
groupReadMode, groupWriteMode, groupExecuteMode,
otherReadMode, otherWriteMode, otherExecuteMode)
import Data.Bits ( (.&.), (.|.), complement )
#endif
#ifdef WIN32
data Handler = Default
| Ignore
| Catch (IO ())
type Signal = Int
installHandler :: Signal
-> Handler
-> Maybe ()
-> IO ()
installHandler _ _ _ = return ()
raiseSignal :: Signal -> IO ()
raiseSignal _ = return ()
sigINT :: Signal
sigINT = 0
sigHUP :: Signal
sigHUP = 0
sigABRT :: Signal
sigABRT = 0
sigTERM :: Signal
sigTERM = 0
sigPIPE :: Signal
sigPIPE = 0
sigALRM :: Signal
sigALRM = 0
renameFile :: FilePath
-> FilePath
-> IO ()
renameFile old new = Control.Exception.mask $ \_ ->
System.Directory.renameFile old new
`catch` \(_ :: IOException) ->
do System.Directory.removeFile new
`catch`
(\e -> unless (System.IO.Error.isDoesNotExistError e) $
System.IO.Error.ioError e)
System.Directory.renameFile old new
setExecutable :: FilePath
-> Bool
-> IO ()
setExecutable _ _ = return ()
getCurrentDirectory :: IO FilePath
getCurrentDirectory = do
d <- System.Directory.getCurrentDirectory
return $ map rb d
where
rb '\\' = '/'
rb c = c
#else
setExecutable :: FilePath
-> Bool
-> IO ()
setExecutable :: FilePath -> Bool -> IO ()
setExecutable f :: FilePath
f ex :: Bool
ex = do
FileStatus
st <- FilePath -> IO FileStatus
getFileStatus FilePath
f
FileMode
umask <- FileMode -> IO FileMode
setFileCreationMask 0
FileMode
_ <- FileMode -> IO FileMode
setFileCreationMask FileMode
umask
let rw :: FileMode
rw = FileStatus -> FileMode
fileMode FileStatus
st FileMode -> FileMode -> FileMode
forall a. Bits a => a -> a -> a
.&.
(FileMode
ownerReadMode FileMode -> FileMode -> FileMode
forall a. Bits a => a -> a -> a
.|. FileMode
ownerWriteMode FileMode -> FileMode -> FileMode
forall a. Bits a => a -> a -> a
.|.
FileMode
groupReadMode FileMode -> FileMode -> FileMode
forall a. Bits a => a -> a -> a
.|. FileMode
groupWriteMode FileMode -> FileMode -> FileMode
forall a. Bits a => a -> a -> a
.|.
FileMode
otherReadMode FileMode -> FileMode -> FileMode
forall a. Bits a => a -> a -> a
.|. FileMode
otherWriteMode)
total :: FileMode
total = if Bool
ex then FileMode
rw FileMode -> FileMode -> FileMode
forall a. Bits a => a -> a -> a
.|.
((FileMode
ownerExecuteMode FileMode -> FileMode -> FileMode
forall a. Bits a => a -> a -> a
.|. FileMode
groupExecuteMode FileMode -> FileMode -> FileMode
forall a. Bits a => a -> a -> a
.|. FileMode
otherExecuteMode)
FileMode -> FileMode -> FileMode
forall a. Bits a => a -> a -> a
.&. FileMode -> FileMode
forall a. Bits a => a -> a
complement FileMode
umask)
else FileMode
rw
FilePath -> FileMode -> IO ()
setFileMode FilePath
f FileMode
total
#endif