Rework CLI modules and tests

[ganeti-local] / htools / Ganeti / HTools / Loader.hs

diff --git a/htools/Ganeti/HTools/Loader.hs b/htools/Ganeti/HTools/Loader.hs
index 027aedd..71893e3 100644 (file)
--- a/htools/Ganeti/HTools/Loader.hs
+++ b/htools/Ganeti/HTools/Loader.hs
@@ -30,8 +30,6 @@ module Ganeti.HTools.Loader
   ( mergeData
   , checkData
   , assignIndices
   ( mergeData
   , checkData
   , assignIndices

-  , lookupName
-  , goodLookupResult

   , lookupNode
   , lookupInstance
   , lookupGroup
   , lookupNode
   , lookupInstance
   , lookupGroup

@@ -40,14 +38,9 @@ module Ganeti.HTools.Loader
   , Request(..)
   , ClusterData(..)
   , emptyCluster
   , Request(..)
   , ClusterData(..)
   , emptyCluster

-  , compareNameComponent
-  , prefixMatch
-  , LookupResult(..)
-  , MatchPriority(..)

   ) where
 
 import Data.List
   ) where
 
 import Data.List

-import Data.Function

 import qualified Data.Map as M
 import Text.Printf (printf)
 
 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 qualified Ganeti.HTools.Group as Group
 import qualified Ganeti.HTools.Cluster as Cluster
 

+import Ganeti.BasicTypes

 import Ganeti.HTools.Types
 import Ganeti.HTools.Utils
 
 import Ganeti.HTools.Types
 import Ganeti.HTools.Utils
 

@@ -75,10 +69,11 @@ request-specific fields.
 
 -}
 data RqType
 
 -}
 data RqType

-  = Allocate Instance.Instance Int -- ^ A new instance allocation
-  | Relocate Idx Int [Ndx]         -- ^ Choose a new secondary node
-  | NodeEvacuate [Idx] EvacMode    -- ^ node-evacuate mode
-  | ChangeGroup [Gdx] [Idx]        -- ^ Multi-relocate mode
+  = Allocate Instance.Instance Int           -- ^ A new instance allocation
+  | Relocate Idx Int [Ndx]                   -- ^ Choose a new secondary node
+  | NodeEvacuate [Idx] EvacMode              -- ^ node-evacuate mode
+  | ChangeGroup [Gdx] [Idx]                  -- ^ Multi-relocate mode
+  | MultiAllocate [(Instance.Instance, Int)] -- ^ Multi-allocate mode

     deriving (Show, Read)
 
 -- | A complete request, as received from Ganeti.
     deriving (Show, Read)
 
 -- | A complete request, as received from Ganeti.

@@ -94,27 +89,6 @@ data ClusterData = ClusterData
   , cdIPolicy   :: IPolicy       -- ^ The cluster instance policy
   } deriving (Show, Read, Eq)
 
   , 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 []
 -- | An empty cluster.
 emptyCluster :: ClusterData
 emptyCluster = ClusterData Container.empty Container.empty Container.empty []

@@ -139,57 +113,6 @@ lookupGroup ktg nname gname =
   maybe (fail $ "Unknown group '" ++ gname ++ "' for node " ++ nname) return $
     M.lookup gname ktg
 
   maybe (fail $ "Unknown group '" ++ gname ++ "' for node " ++ nname) return $
     M.lookup gname ktg
 

--- | 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)]
 -- | Given a list of elements (and their names), assign indices to them.
 assignIndices :: (Element a) =>
                  [(String, a)]