Revision 4b217f68

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