diff options
-rw-r--r-- | Utility/LockPool/LockHandle.hs | 33 | ||||
-rw-r--r-- | Utility/LockPool/Posix.hs | 16 | ||||
-rw-r--r-- | Utility/LockPool/Windows.hs | 9 |
3 files changed, 37 insertions, 21 deletions
diff --git a/Utility/LockPool/LockHandle.hs b/Utility/LockPool/LockHandle.hs index 5582d7682..1fa8e7ca7 100644 --- a/Utility/LockPool/LockHandle.hs +++ b/Utility/LockPool/LockHandle.hs @@ -10,33 +10,38 @@ module Utility.LockPool.LockHandle where import qualified Utility.LockPool.STM as P -#ifndef mingw32_HOST_OS -import qualified Utility.LockFile.Posix as F -#else -import qualified Utility.LockFile.Windows as F -#endif import Control.Concurrent.STM import Control.Exception -data LockHandle = LockHandle P.LockHandle F.LockHandle +data LockHandle = LockHandle + { poolHandle :: P.LockHandle + , fileLockOps :: FileLockOps + } + +data FileLockOps = FileLockOps + { fDropLock :: IO () +#ifndef mingw32_HOST_OS + , fCheckSaneLock :: FilePath -> IO Bool +#endif + } dropLock :: LockHandle -> IO () -dropLock (LockHandle ph fh) = P.releaseLock ph (F.dropLock fh) +dropLock h = P.releaseLock (poolHandle h) (fDropLock (fileLockOps h)) -- Take a lock, by first updating the lock pool, and then taking the file -- lock. If taking the file lock fails for any reason, take care to -- release the lock in the lock pool. -makeLockHandle :: STM P.LockHandle -> IO F.LockHandle -> IO LockHandle +makeLockHandle :: STM P.LockHandle -> IO FileLockOps -> IO LockHandle makeLockHandle pa fa = bracketOnError setup cleanup go where setup = atomically pa cleanup ph = P.releaseLock ph (return ()) go ph = do - fh <- fa - return $ LockHandle ph fh + fo <- fa + return $ LockHandle ph fo -tryMakeLockHandle :: STM (Maybe P.LockHandle) -> IO (Maybe F.LockHandle) -> IO (Maybe LockHandle) +tryMakeLockHandle :: STM (Maybe P.LockHandle) -> IO (Maybe FileLockOps) -> IO (Maybe LockHandle) tryMakeLockHandle pa fa = bracketOnError setup cleanup go where setup = atomically pa @@ -44,9 +49,9 @@ tryMakeLockHandle pa fa = bracketOnError setup cleanup go cleanup (Just ph) = P.releaseLock ph (return ()) go Nothing = return Nothing go (Just ph) = do - mfh <- fa - case mfh of + mfo <- fa + case mfo of Nothing -> do cleanup (Just ph) return Nothing - Just fh -> return $ Just $ LockHandle ph fh + Just fo -> return $ Just $ LockHandle ph fo diff --git a/Utility/LockPool/Posix.hs b/Utility/LockPool/Posix.hs index 3e445e1a1..eb679b7e8 100644 --- a/Utility/LockPool/Posix.hs +++ b/Utility/LockPool/Posix.hs @@ -35,25 +35,25 @@ import Prelude lockShared :: Maybe FileMode -> LockFile -> IO LockHandle lockShared mode file = makeLockHandle (P.waitTakeLock P.lockPool file LockShared) - (F.lockShared mode file) + (mk <$> F.lockShared mode file) -- Takes an exclusive lock, blocking until the lock is available. lockExclusive :: Maybe FileMode -> LockFile -> IO LockHandle lockExclusive mode file = makeLockHandle (P.waitTakeLock P.lockPool file LockExclusive) - (F.lockExclusive mode file) + (mk <$> F.lockExclusive mode file) -- Tries to take a shared lock, but does not block. tryLockShared :: Maybe FileMode -> LockFile -> IO (Maybe LockHandle) tryLockShared mode file = tryMakeLockHandle (P.tryTakeLock P.lockPool file LockShared) - (F.tryLockShared mode file) + (fmap mk <$> F.tryLockShared mode file) -- Tries to take an exclusive lock, but does not block. tryLockExclusive :: Maybe FileMode -> LockFile -> IO (Maybe LockHandle) tryLockExclusive mode file = tryMakeLockHandle (P.tryTakeLock P.lockPool file LockExclusive) - (F.tryLockExclusive mode file) + (fmap mk <$> F.tryLockExclusive mode file) -- Returns Nothing when the file doesn't exist, for cases where -- that is different from it not being locked. @@ -68,4 +68,10 @@ getLockStatus file = P.getLockStatus P.lockPool file (F.getLockStatus file) checkSaneLock :: LockFile -> LockHandle -> IO Bool -checkSaneLock lockfile (LockHandle _ fh) = F.checkSaneLock lockfile fh +checkSaneLock lockfile (LockHandle _ flo) = fCheckSaneLock flo lockfile + +mk :: F.LockHandle -> FileLockOps +mk h = FileLockOps + { fDropLock = F.dropLock h + , fCheckSaneLock = \f -> F.checkSaneLock f h + } diff --git a/Utility/LockPool/Windows.hs b/Utility/LockPool/Windows.hs index a88525a9b..2641ac37d 100644 --- a/Utility/LockPool/Windows.hs +++ b/Utility/LockPool/Windows.hs @@ -24,7 +24,7 @@ import Utility.LockPool.STM (LockFile, LockMode(..)) lockShared :: LockFile -> IO (Maybe LockHandle) lockShared file = tryMakeLockHandle (P.tryTakeLock P.lockPool file LockShared) - (F.lockShared file) + (fmap mk <$> F.lockShared file) {- Tries to take an exclusive lock on a file. Fails if another process has - a shared or exclusive lock. @@ -35,9 +35,14 @@ lockShared file = tryMakeLockHandle lockExclusive :: LockFile -> IO (Maybe LockHandle) lockExclusive file = tryMakeLockHandle (P.tryTakeLock P.lockPool file LockExclusive) - (F.lockExclusive file) + (fmap mk <$> F.lockExclusive file) {- If the initial lock fails, this is a BUSY wait, and does not - guarentee FIFO order of waiters. In other news, Windows is a POS. -} waitToLock :: IO (Maybe lockhandle) -> IO lockhandle waitToLock = F.waitToLock + +mk :: F.LockHandle -> FileLockOps +mk h = FileLockOps + { fDropLock = F.dropLock h + } |