, 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
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
import qualified Ganeti.Constants as C
import Ganeti.HTools.Types
import Ganeti.HTools.Utils
-import Ganeti.HTools.Loader
+import Ganeti.BasicTypes
-- * Constants
( mergeData
, checkData
, assignIndices
- , lookupName
- , goodLookupResult
, lookupNode
, lookupInstance
, lookupGroup
, Request(..)
, ClusterData(..)
, emptyCluster
- , compareNameComponent
- , prefixMatch
- , LookupResult(..)
- , MatchPriority(..)
) where
import Data.List
-import Data.Function
import qualified Data.Map as M
import Text.Printf (printf)
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
, 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 []
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)]
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
-- | 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
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.
projects / ganeti-local / commitdiff