{-# LINE 1 "libraries\\base\\GHC\\IO\\Handle\\Lock.hsc" #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE InterruptibleFFI #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NoImplicitPrelude #-}
module GHC.IO.Handle.Lock (
FileLockingNotSupported(..)
, LockMode(..)
, hLock
, hTryLock
, hUnlock
) where
{-# LINE 29 "libraries\\base\\GHC\\IO\\Handle\\Lock.hsc" #-}
{-# LINE 33 "libraries\\base\\GHC\\IO\\Handle\\Lock.hsc" #-}
# define WINDOWS_CCONV ccall
{-# LINE 37 "libraries\\base\\GHC\\IO\\Handle\\Lock.hsc" #-}
import Data.Bits
import Data.Function
import Foreign.C.Error
import Foreign.C.Types
import Foreign.Marshal.Alloc
import Foreign.Marshal.Utils
import GHC.IO.FD
import GHC.IO.Handle.FD
import GHC.Ptr
import GHC.Windows
{-# LINE 56 "libraries\\base\\GHC\\IO\\Handle\\Lock.hsc" #-}
import Data.Functor
import GHC.Base
import GHC.Exception
import GHC.IO.Handle.Types
import GHC.Show
data FileLockingNotSupported = FileLockingNotSupported
deriving Show
instance Exception FileLockingNotSupported
data LockMode = SharedLock | ExclusiveLock
hLock :: Handle -> LockMode -> IO ()
hLock h mode = void $ lockImpl h "hLock" mode True
hTryLock :: Handle -> LockMode -> IO Bool
hTryLock h mode = lockImpl h "hTryLock" mode False
hUnlock :: Handle -> IO ()
hUnlock = unlockImpl
{-# LINE 204 "libraries\\base\\GHC\\IO\\Handle\\Lock.hsc" #-}
lockImpl :: Handle -> String -> LockMode -> Bool -> IO Bool
lockImpl h ctx mode block = do
FD{fdFD = fd} <- handleToFd h
wh <- throwErrnoIf (== iNVALID_HANDLE_VALUE) ctx $ c_get_osfhandle fd
allocaBytes sizeof_OVERLAPPED $ \ovrlpd -> do
fillBytes ovrlpd 0 sizeof_OVERLAPPED
let flags = cmode .|. (if block then 0 else 1)
{-# LINE 212 "libraries\\base\\GHC\\IO\\Handle\\Lock.hsc" #-}
fix $ \retry -> c_LockFileEx wh flags 0 0xffffffff 0xffffffff ovrlpd >>= \case
True -> return True
False -> getLastError >>= \err -> if
| not block && err == 33 -> return False
{-# LINE 221 "libraries\\base\\GHC\\IO\\Handle\\Lock.hsc" #-}
| err == 995 -> retry
{-# LINE 222 "libraries\\base\\GHC\\IO\\Handle\\Lock.hsc" #-}
| otherwise -> failWith ctx err
where
sizeof_OVERLAPPED = (32)
{-# LINE 225 "libraries\\base\\GHC\\IO\\Handle\\Lock.hsc" #-}
cmode = case mode of
SharedLock -> 0
ExclusiveLock -> 2
{-# LINE 229 "libraries\\base\\GHC\\IO\\Handle\\Lock.hsc" #-}
unlockImpl :: Handle -> IO ()
unlockImpl h = do
FD{fdFD = fd} <- handleToFd h
wh <- throwErrnoIf (== iNVALID_HANDLE_VALUE) "hUnlock" $ c_get_osfhandle fd
allocaBytes sizeof_OVERLAPPED $ \ovrlpd -> do
fillBytes ovrlpd 0 sizeof_OVERLAPPED
c_UnlockFileEx wh 0 0xffffffff 0xffffffff ovrlpd >>= \case
True -> return ()
False -> getLastError >>= failWith "hUnlock"
where
sizeof_OVERLAPPED = (32)
{-# LINE 241 "libraries\\base\\GHC\\IO\\Handle\\Lock.hsc" #-}
foreign import ccall unsafe "_get_osfhandle"
c_get_osfhandle :: CInt -> IO HANDLE
foreign import WINDOWS_CCONV interruptible "LockFileEx"
c_LockFileEx :: HANDLE -> DWORD -> DWORD -> DWORD -> DWORD -> Ptr () -> IO BOOL
foreign import WINDOWS_CCONV interruptible "UnlockFileEx"
c_UnlockFileEx :: HANDLE -> DWORD -> DWORD -> DWORD -> Ptr () -> IO BOOL
{-# LINE 265 "libraries\\base\\GHC\\IO\\Handle\\Lock.hsc" #-}