blob: ec36e6156c943bccc245bdc8a477a17e86e95450 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
|
{- Handles for lock pools.
-
- Copyright 2015 Joey Hess <id@joeyh.name>
-
- License: BSD-2-clause
-}
{-# LANGUAGE CPP #-}
module Utility.LockPool.LockHandle where
import qualified Utility.LockPool.STM as P
import Utility.LockPool.STM (LockFile)
import Control.Concurrent.STM
import Control.Exception
data LockHandle = LockHandle
{ poolHandle :: P.LockHandle
, fileLockOps :: FileLockOps
}
data FileLockOps = FileLockOps
{ fDropLock :: IO ()
#ifndef mingw32_HOST_OS
, fCheckSaneLock :: LockFile -> IO Bool
#endif
}
dropLock :: LockHandle -> IO ()
dropLock h = P.releaseLock (poolHandle h) (fDropLock (fileLockOps h))
#ifndef mingw32_HOST_OS
checkSaneLock :: LockFile -> LockHandle -> IO Bool
checkSaneLock lockfile (LockHandle _ flo) = fCheckSaneLock flo lockfile
#endif
-- 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 FileLockOps -> IO LockHandle
makeLockHandle pa fa = bracketOnError setup cleanup go
where
setup = atomically pa
cleanup ph = P.releaseLock ph (return ())
go ph = do
fo <- fa
return $ LockHandle ph fo
tryMakeLockHandle :: STM (Maybe P.LockHandle) -> IO (Maybe FileLockOps) -> IO (Maybe LockHandle)
tryMakeLockHandle pa fa = bracketOnError setup cleanup go
where
setup = atomically pa
cleanup Nothing = return ()
cleanup (Just ph) = P.releaseLock ph (return ())
go Nothing = return Nothing
go (Just ph) = do
mfo <- fa
case mfo of
Nothing -> do
cleanup (Just ph)
return Nothing
Just fo -> return $ Just $ LockHandle ph fo
|
