{-# LANGUAGE CPP #-}
module ProjectM36.FileLock where
#if defined(mingw32_HOST_OS)
import System.Win32.Types
import Foreign.Marshal.Alloc
import System.Win32.File
import System.Win32.Mem
import Data.Bits
#if defined(i386_HOST_ARCH)
# define WINDOWS_CCONV stdcall
#elif defined(x86_64_HOST_ARCH)
# define WINDOWS_CCONV ccall
#else
# error Unknown mingw32 arch
#endif
foreign import WINDOWS_CCONV "LockFileEx" c_lockFileEx :: HANDLE -> DWORD -> DWORD -> DWORD -> DWORD -> LPOVERLAPPED -> IO BOOL
foreign import WINDOWS_CCONV "UnlockFileEx" c_unlockFileEx :: HANDLE -> DWORD -> DWORD -> DWORD -> LPOVERLAPPED -> IO BOOL
type LockFile = HANDLE
openLockFile :: FilePath -> IO LockFile
openLockFile path = createFile path
(gENERIC_READ .|. gENERIC_WRITE)
(fILE_SHARE_READ .|. fILE_SHARE_WRITE)
Nothing
oPEN_ALWAYS
fILE_ATTRIBUTE_NORMAL
Nothing
closeLockFile :: LockFile -> IO ()
closeLockFile file = do
closeHandle file
lockFile :: HANDLE -> LockType -> IO ()
lockFile winHandle lock = do
let exFlag = case lock of
WriteLock -> 2
ReadLock -> 0
blockFlag = 0
sizeof_OVERLAPPED = 32
allocaBytes sizeof_OVERLAPPED $ \op -> do
zeroMemory op $ fromIntegral sizeof_OVERLAPPED
failIfFalse_ "LockFileEx" $ c_lockFileEx winHandle (exFlag .|. blockFlag) 0 1 0 op
unlockFile :: HANDLE -> IO ()
unlockFile winHandle = do
let sizeof_OVERLAPPED = 32
allocaBytes sizeof_OVERLAPPED $ \op -> do
zeroMemory op $ fromIntegral sizeof_OVERLAPPED
failIfFalse_ "UnlockFileEx" $ c_unlockFileEx winHandle 0 1 0 op
#else
import qualified System.Posix.IO as P
import System.Posix.Types
import System.Posix.Files
import System.IO
lockStruct :: P.LockRequest -> P.FileLock
lockStruct :: LockRequest -> FileLock
lockStruct LockRequest
req = (LockRequest
req, SeekMode
AbsoluteSeek, FileOffset
0, FileOffset
0)
newtype LockFile = LockFile Fd
openLockFile :: FilePath -> IO LockFile
openLockFile :: FilePath -> IO LockFile
openLockFile FilePath
path =
Fd -> LockFile
LockFile forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> FileMode -> IO Fd
P.createFile FilePath
path FileMode
ownerWriteMode
closeLockFile :: LockFile -> IO ()
closeLockFile :: LockFile -> IO ()
closeLockFile (LockFile Fd
fd) =
Fd -> IO ()
P.closeFd Fd
fd
lockFile :: LockFile -> LockType -> IO ()
lockFile :: LockFile -> LockType -> IO ()
lockFile (LockFile Fd
fd) LockType
lock = do
let lockt :: LockRequest
lockt = case LockType
lock of
LockType
WriteLock -> LockRequest
P.WriteLock
LockType
ReadLock -> LockRequest
P.ReadLock
Fd -> FileLock -> IO ()
P.waitToSetLock Fd
fd (LockRequest -> FileLock
lockStruct LockRequest
lockt)
unlockFile :: LockFile -> IO ()
unlockFile :: LockFile -> IO ()
unlockFile (LockFile Fd
fd) =
Fd -> FileLock -> IO ()
P.waitToSetLock Fd
fd (LockRequest -> FileLock
lockStruct LockRequest
P.Unlock)
#endif
data LockType = ReadLock | WriteLock deriving (Int -> LockType -> ShowS
[LockType] -> ShowS
LockType -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [LockType] -> ShowS
$cshowList :: [LockType] -> ShowS
show :: LockType -> FilePath
$cshow :: LockType -> FilePath
showsPrec :: Int -> LockType -> ShowS
$cshowsPrec :: Int -> LockType -> ShowS
Show)