On Fri, Apr 11, 2014 at 12:43 PM, Klaus Aehlig <[email protected]> wrote:

> Again, this just wraps around updateLocks, sequentially trying
> to obtain all the locks mentioned.
>
> Signed-off-by: Klaus Aehlig <[email protected]>
> ---
>  src/Ganeti/Locking/Waiting.hs | 25 ++++++++++++++++++++++++-
>  1 file changed, 24 insertions(+), 1 deletion(-)
>
> diff --git a/src/Ganeti/Locking/Waiting.hs b/src/Ganeti/Locking/Waiting.hs
> index 2d95c6a..d0eba92 100644
> --- a/src/Ganeti/Locking/Waiting.hs
> +++ b/src/Ganeti/Locking/Waiting.hs
> @@ -39,10 +39,12 @@ module Ganeti.Locking.Waiting
>   , freeLocksPredicate
>   , downGradeLocksPredicate
>   , intersectLocks
> + , opportunisticLockUnion
>   ) where
>
> -import Control.Arrow ((&&&), second)
> +import Control.Arrow ((&&&), (***), second)
>  import Control.Monad (liftM)
> +import Data.List (sort)
>  import qualified Data.Map as M
>  import Data.Maybe (fromMaybe)
>  import qualified Data.Set as S
> @@ -317,3 +319,24 @@ intersectLocks :: (Lock a, Ord b, Ord c)
>                 -> b
>                 -> LockWaiting a b c -> (LockWaiting a b c, S.Set b)
>  intersectLocks locks = freeLocksPredicate (not . flip elem locks)
> +
> +-- | Opprotunistically allocate locks for a given user; return the set
>

I'd suggest s/user/owner/


> +-- of actually acquired locks.
> +opportunisticLockUnion :: (Lock a, Ord b, Ord c)
> +                       => b
> +                       -> [(a, L.OwnerState)]
> +                       -> LockWaiting a b c
> +                       -> (LockWaiting a b c, ([a], S.Set b))
> +opportunisticLockUnion owner reqs state =
> +  let locks = L.listLocks owner $ getAllocation state
> +      reqs' = sort $ filter (uncurry (<) . (flip M.lookup locks ***
> Just)) reqs
> +      maybeAllocate (s, (success, notify)) (lock, ownstate) =
> +        let (s',  (result, notify')) =
> +              updateLocks owner
> +                          [(if ownstate == L.OwnShared
> +                              then L.requestShared
> +                              else L.requestExclusive) lock]
> +                          s
> +        in (s', ( if result == Ok S.empty then lock:success else success
> +                , notify `S.union` notify'))
> +  in foldl maybeAllocate (state, ([], S.empty)) reqs'
> --
> 1.9.1.423.g4596e3a
>
>
LGTM

Reply via email to