Revision 4b217f68 src/Ganeti/Locking/Allocation.hs
b/src/Ganeti/Locking/Allocation.hs | ||
---|---|---|
35 | 35 |
, updateLocks |
36 | 36 |
, freeLocks |
37 | 37 |
, intersectLocks |
38 |
, opportunisticLockUnion |
|
38 | 39 |
) where |
39 | 40 |
|
40 | 41 |
import Control.Arrow (second, (***)) |
41 | 42 |
import Control.Monad |
42 | 43 |
import Data.Foldable (for_, find) |
44 |
import Data.List (sort) |
|
43 | 45 |
import qualified Data.Map as M |
44 | 46 |
import Data.Maybe (fromMaybe) |
45 | 47 |
import qualified Data.Set as S |
... | ... | |
295 | 297 |
toFree = filter (not . flip S.member lockset) |
296 | 298 |
. M.keys $ listLocks owner state |
297 | 299 |
in fst $ updateLocks owner (map requestRelease toFree) state |
300 |
|
|
301 |
-- | Opportunistically allocate locks for a given user; return the set |
|
302 |
-- of actually acquired. The signature is chosen to be suitable for |
|
303 |
-- atomicModifyIORef. |
|
304 |
opportunisticLockUnion :: (Lock a, Ord b) |
|
305 |
=> b -> [(a, OwnerState)] |
|
306 |
-> LockAllocation a b -> (LockAllocation a b, S.Set a) |
|
307 |
opportunisticLockUnion owner reqs state = |
|
308 |
let locks = listLocks owner state |
|
309 |
reqs' = sort $ filter (uncurry (<) . (flip M.lookup locks *** Just)) reqs |
|
310 |
maybeAllocate (s, success) (lock, ownstate) = |
|
311 |
let (s', result) = updateLocks owner |
|
312 |
[(if ownstate == OwnShared |
|
313 |
then requestShared |
|
314 |
else requestExclusive) lock] |
|
315 |
s |
|
316 |
in (s', if result == Ok S.empty then lock:success else success) |
|
317 |
in second S.fromList $ foldl maybeAllocate (state, []) reqs' |
Also available in: Unified diff