From 2fc5653fa1cb858e3d58d26d1aa58912bec9513c Mon Sep 17 00:00:00 2001
From: Iustin Pop <iustin@google.com>
Date: Wed, 18 Jul 2012 11:03:31 +0200
Subject: [PATCH] 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: Iustin Pop <iustin@google.com>
Reviewed-by: Agata Murawska <agatamurawska@google.com>
---
htools/Ganeti/BasicTypes.hs | 92 ++++++++++++++++++++++++++++++++++
htools/Ganeti/HTools/CLI.hs | 2 +-
htools/Ganeti/HTools/Loader.hs | 80 +----------------------------
htools/Ganeti/HTools/QC.hs | 9 ++--
htools/Ganeti/HTools/Utils.hs | 7 ---
5 files changed, 99 insertions(+), 91 deletions(-)
diff --git a/htools/Ganeti/BasicTypes.hs b/htools/Ganeti/BasicTypes.hs
index ec3e138af..55bab2858 100644
--- a/htools/Ganeti/BasicTypes.hs
+++ b/htools/Ganeti/BasicTypes.hs
@@ -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
diff --git a/htools/Ganeti/HTools/CLI.hs b/htools/Ganeti/HTools/CLI.hs
index 4636fd7a0..29f17288f 100644
--- a/htools/Ganeti/HTools/CLI.hs
+++ b/htools/Ganeti/HTools/CLI.hs
@@ -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
diff --git a/htools/Ganeti/HTools/Loader.hs b/htools/Ganeti/HTools/Loader.hs
index 5a5da6542..851c84bb9 100644
--- a/htools/Ganeti/HTools/Loader.hs
+++ b/htools/Ganeti/HTools/Loader.hs
@@ -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)]
diff --git a/htools/Ganeti/HTools/QC.hs b/htools/Ganeti/HTools/QC.hs
index d056a9c95..c00e22d15 100644
--- a/htools/Ganeti/HTools/QC.hs
+++ b/htools/Ganeti/HTools/QC.hs
@@ -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
diff --git a/htools/Ganeti/HTools/Utils.hs b/htools/Ganeti/HTools/Utils.hs
index aaf4fb093..2b21518c4 100644
--- a/htools/Ganeti/HTools/Utils.hs
+++ b/htools/Ganeti/HTools/Utils.hs
@@ -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.
--
GitLab