Commit 2fc5653f authored by Iustin Pop's avatar Iustin Pop
Browse files

Reorganise the lookup functions



Currently, the LookupResult, MatchPriority and related functions are
locate in Loader.hs, since (so far) only hbal needs them in the
selection of instances. However, with the new functionality on confd
side, we need these functions there too, but we don't want to import
Loader.hs (which pulls in lots of balancing-related code). So we move
all these function to BasicTypes.hs, since that module is a leaf one,
with no other dependencies.

Unittests are slightly adjusted (but they are still tested under the
'Loader' group).
Signed-off-by: default avatarIustin Pop <iustin@google.com>
Reviewed-by: default avatarAgata Murawska <agatamurawska@google.com>
parent ab0edd8b
......@@ -26,9 +26,19 @@ module Ganeti.BasicTypes
, eitherToResult
, annotateResult
, annotateIOError
, select
, LookupResult(..)
, MatchPriority(..)
, lookupName
, goodLookupResult
, goodMatchPriority
, prefixMatch
, compareNameComponent
) where
import Control.Monad
import Data.Function
import Data.List
-- | This is similar to the JSON library Result type - /very/ similar,
-- but we want to use it in multiple places, so we abstract it into a
......@@ -78,3 +88,85 @@ annotateResult _ v = v
annotateIOError :: String -> IOError -> IO (Result a)
annotateIOError description exc =
return . Bad $ description ++ ": " ++ show exc
-- * Misc functionality
-- | Return the first result with a True condition, or the default otherwise.
select :: a -- ^ default result
-> [(Bool, a)] -- ^ list of \"condition, result\"
-> a -- ^ first result which has a True condition, or default
select def = maybe def snd . find fst
-- * Lookup of partial names functionality
-- | The priority of a match in a lookup result.
data MatchPriority = ExactMatch
| MultipleMatch
| PartialMatch
| FailMatch
deriving (Show, Read, Enum, Eq, Ord)
-- | The result of a name lookup in a list.
data LookupResult = LookupResult
{ lrMatchPriority :: MatchPriority -- ^ The result type
-- | Matching value (for ExactMatch, PartialMatch), Lookup string otherwise
, lrContent :: String
} deriving (Show, Read)
-- | Lookup results have an absolute preference ordering.
instance Eq LookupResult where
(==) = (==) `on` lrMatchPriority
instance Ord LookupResult where
compare = compare `on` lrMatchPriority
-- | Check for prefix matches in names.
-- Implemented in Ganeti core utils.text.MatchNameComponent
-- as the regexp r"^%s(\..*)?$" % re.escape(key)
prefixMatch :: String -- ^ Lookup
-> String -- ^ Full name
-> Bool -- ^ Whether there is a prefix match
prefixMatch = isPrefixOf . (++ ".")
-- | Is the lookup priority a "good" one?
goodMatchPriority :: MatchPriority -> Bool
goodMatchPriority ExactMatch = True
goodMatchPriority PartialMatch = True
goodMatchPriority _ = False
-- | Is the lookup result an actual match?
goodLookupResult :: LookupResult -> Bool
goodLookupResult = goodMatchPriority . lrMatchPriority
-- | Compares a canonical name and a lookup string.
compareNameComponent :: String -- ^ Canonical (target) name
-> String -- ^ Partial (lookup) name
-> LookupResult -- ^ Result of the lookup
compareNameComponent cnl lkp =
select (LookupResult FailMatch lkp)
[ (cnl == lkp , LookupResult ExactMatch cnl)
, (prefixMatch lkp cnl , LookupResult PartialMatch cnl)
]
-- | Lookup a string and choose the best result.
chooseLookupResult :: String -- ^ Lookup key
-> String -- ^ String to compare to the lookup key
-> LookupResult -- ^ Previous result
-> LookupResult -- ^ New result
chooseLookupResult lkp cstr old =
-- default: use class order to pick the minimum result
select (min new old)
-- special cases:
-- short circuit if the new result is an exact match
[ (lrMatchPriority new == ExactMatch, new)
-- if both are partial matches generate a multiple match
, (partial2, LookupResult MultipleMatch lkp)
] where new = compareNameComponent cstr lkp
partial2 = all ((PartialMatch==) . lrMatchPriority) [old, new]
-- | Find the canonical name for a lookup string in a list of names.
lookupName :: [String] -- ^ List of keys
-> String -- ^ Lookup string
-> LookupResult -- ^ Result of the lookup
lookupName l s = foldr (chooseLookupResult s)
(LookupResult FailMatch s) l
......@@ -100,7 +100,7 @@ import qualified Ganeti.HTools.Node as Node
import qualified Ganeti.Constants as C
import Ganeti.HTools.Types
import Ganeti.HTools.Utils
import Ganeti.HTools.Loader
import Ganeti.BasicTypes
-- * Constants
......
......@@ -30,8 +30,6 @@ module Ganeti.HTools.Loader
( mergeData
, checkData
, assignIndices
, lookupName
, goodLookupResult
, lookupNode
, lookupInstance
, lookupGroup
......@@ -40,14 +38,9 @@ module Ganeti.HTools.Loader
, Request(..)
, ClusterData(..)
, emptyCluster
, compareNameComponent
, prefixMatch
, LookupResult(..)
, MatchPriority(..)
) where
import Data.List
import Data.Function
import qualified Data.Map as M
import Text.Printf (printf)
......@@ -57,6 +50,7 @@ import qualified Ganeti.HTools.Node as Node
import qualified Ganeti.HTools.Group as Group
import qualified Ganeti.HTools.Cluster as Cluster
import Ganeti.BasicTypes
import Ganeti.HTools.Types
import Ganeti.HTools.Utils
......@@ -94,27 +88,6 @@ data ClusterData = ClusterData
, cdIPolicy :: IPolicy -- ^ The cluster instance policy
} deriving (Show, Read, Eq)
-- | The priority of a match in a lookup result.
data MatchPriority = ExactMatch
| MultipleMatch
| PartialMatch
| FailMatch
deriving (Show, Read, Enum, Eq, Ord)
-- | The result of a name lookup in a list.
data LookupResult = LookupResult
{ lrMatchPriority :: MatchPriority -- ^ The result type
-- | Matching value (for ExactMatch, PartialMatch), Lookup string otherwise
, lrContent :: String
} deriving (Show, Read)
-- | Lookup results have an absolute preference ordering.
instance Eq LookupResult where
(==) = (==) `on` lrMatchPriority
instance Ord LookupResult where
compare = compare `on` lrMatchPriority
-- | An empty cluster.
emptyCluster :: ClusterData
emptyCluster = ClusterData Container.empty Container.empty Container.empty []
......@@ -143,57 +116,6 @@ lookupGroup ktg nname gname =
Nothing -> fail $ "Unknown group '" ++ gname ++ "' for node " ++ nname
Just idx -> return idx
-- | Check for prefix matches in names.
-- Implemented in Ganeti core utils.text.MatchNameComponent
-- as the regexp r"^%s(\..*)?$" % re.escape(key)
prefixMatch :: String -- ^ Lookup
-> String -- ^ Full name
-> Bool -- ^ Whether there is a prefix match
prefixMatch = isPrefixOf . (++ ".")
-- | Is the lookup priority a "good" one?
goodMatchPriority :: MatchPriority -> Bool
goodMatchPriority ExactMatch = True
goodMatchPriority PartialMatch = True
goodMatchPriority _ = False
-- | Is the lookup result an actual match?
goodLookupResult :: LookupResult -> Bool
goodLookupResult = goodMatchPriority . lrMatchPriority
-- | Compares a canonical name and a lookup string.
compareNameComponent :: String -- ^ Canonical (target) name
-> String -- ^ Partial (lookup) name
-> LookupResult -- ^ Result of the lookup
compareNameComponent cnl lkp =
select (LookupResult FailMatch lkp)
[ (cnl == lkp , LookupResult ExactMatch cnl)
, (prefixMatch lkp cnl , LookupResult PartialMatch cnl)
]
-- | Lookup a string and choose the best result.
chooseLookupResult :: String -- ^ Lookup key
-> String -- ^ String to compare to the lookup key
-> LookupResult -- ^ Previous result
-> LookupResult -- ^ New result
chooseLookupResult lkp cstr old =
-- default: use class order to pick the minimum result
select (min new old)
-- special cases:
-- short circuit if the new result is an exact match
[ (lrMatchPriority new == ExactMatch, new)
-- if both are partial matches generate a multiple match
, (partial2, LookupResult MultipleMatch lkp)
] where new = compareNameComponent cstr lkp
partial2 = all ((PartialMatch==) . lrMatchPriority) [old, new]
-- | Find the canonical name for a lookup string in a list of names.
lookupName :: [String] -- ^ List of keys
-> String -- ^ Lookup string
-> LookupResult -- ^ Result of the lookup
lookupName l s = foldr (chooseLookupResult s)
(LookupResult FailMatch s) l
-- | Given a list of elements (and their names), assign indices to them.
assignIndices :: (Element a) =>
[(String, a)]
......
......@@ -56,6 +56,7 @@ import qualified Text.JSON as J
import qualified Data.Map
import qualified Data.IntMap as IntMap
import qualified Ganeti.BasicTypes as BasicTypes
import qualified Ganeti.OpCodes as OpCodes
import qualified Ganeti.Jobs as Jobs
import qualified Ganeti.Luxi as Luxi
......@@ -1517,14 +1518,14 @@ prop_Loader_mergeData ns =
-- | Check that compareNameComponent on equal strings works.
prop_Loader_compareNameComponent_equal :: String -> Bool
prop_Loader_compareNameComponent_equal s =
Loader.compareNameComponent s s ==
Loader.LookupResult Loader.ExactMatch s
BasicTypes.compareNameComponent s s ==
BasicTypes.LookupResult BasicTypes.ExactMatch s
-- | Check that compareNameComponent on prefix strings works.
prop_Loader_compareNameComponent_prefix :: NonEmptyList Char -> String -> Bool
prop_Loader_compareNameComponent_prefix (NonEmpty s1) s2 =
Loader.compareNameComponent (s1 ++ "." ++ s2) s1 ==
Loader.LookupResult Loader.PartialMatch s1
BasicTypes.compareNameComponent (s1 ++ "." ++ s2) s1 ==
BasicTypes.LookupResult BasicTypes.PartialMatch s1
testSuite "Loader"
[ 'prop_Loader_lookupNode
......
......@@ -132,13 +132,6 @@ if' :: Bool -- ^ condition
if' True x _ = x
if' _ _ y = y
-- | Return the first result with a True condition, or the default otherwise.
select :: a -- ^ default result
-> [(Bool, a)] -- ^ list of \"condition, result\"
-> a -- ^ first result which has a True condition, or default
select def = maybe def snd . find fst
-- * Parsing utility functions
-- | Parse results from readsPrec.
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment