Update README for hail
[ganeti-local] / hail.hs
diff --git a/hail.hs b/hail.hs
index 23dca5d..217c799 100644 (file)
--- a/hail.hs
+++ b/hail.hs
@@ -6,7 +6,7 @@ module Main (main) where
 
 import Data.List
 import Data.Function
-import Data.Maybe (isJust, fromJust, fromMaybe)
+import Data.Maybe (isJust, fromJust)
 import Monad
 import System
 import System.IO
@@ -21,91 +21,29 @@ import qualified Ganeti.HTools.Node as Node
 import qualified Ganeti.HTools.Instance as Instance
 import qualified Ganeti.HTools.CLI as CLI
 import Ganeti.HTools.IAlloc
-import Ganeti.HTools.Utils
 import Ganeti.HTools.Types
 
 -- | Command line options structure.
 data Options = Options
-    { optShowNodes :: Bool           -- ^ Whether to show node status
-    , optShowCmds  :: Maybe FilePath -- ^ Whether to show the command list
-    , optOneline   :: Bool           -- ^ Switch output to a single line
-    , optNodef     :: FilePath       -- ^ Path to the nodes file
-    , optNodeSet   :: Bool           -- ^ The nodes have been set by options
-    , optInstf     :: FilePath       -- ^ Path to the instances file
-    , optInstSet   :: Bool           -- ^ The insts have been set by options
-    , optMaxLength :: Int            -- ^ Stop after this many steps
-    , optMaster    :: String         -- ^ Collect data from RAPI
-    , optVerbose   :: Int            -- ^ Verbosity level
-    , optOffline   :: [String]       -- ^ Names of offline nodes
-    , optMinScore  :: Cluster.Score  -- ^ The minimum score we aim for
-    , optShowVer   :: Bool           -- ^ Just show the program version
+    { optShowVer   :: Bool           -- ^ Just show the program version
     , optShowHelp  :: Bool           -- ^ Just show the help
     } deriving Show
 
-instance CLI.CLIOptions Options where
-    showVersion = optShowVer
-    showHelp    = optShowHelp
-
 -- | Default values for the command line options.
 defaultOptions :: Options
 defaultOptions  = Options
- { optShowNodes = False
- , optShowCmds  = Nothing
- , optOneline   = False
- , optNodef     = "nodes"
- , optNodeSet   = False
- , optInstf     = "instances"
- , optInstSet   = False
- , optMaxLength = -1
- , optMaster    = ""
- , optVerbose   = 1
- , optOffline   = []
- , optMinScore  = 1e-9
- , optShowVer   = False
+ { optShowVer   = False
  , optShowHelp  = False
  }
 
+instance CLI.CLIOptions Options where
+    showVersion = optShowVer
+    showHelp    = optShowHelp
+
 -- | Options list and functions
 options :: [OptDescr (Options -> Options)]
 options =
-    [ Option ['p']     ["print-nodes"]
-      (NoArg (\ opts -> opts { optShowNodes = True }))
-      "print the final node list"
-    , Option ['C']     ["print-commands"]
-      (OptArg ((\ f opts -> opts { optShowCmds = Just f }) . fromMaybe "-")
-                  "FILE")
-      "print the ganeti command list for reaching the solution,\
-      \if an argument is passed then write the commands to a file named\
-      \ as such"
-    , Option ['o']     ["oneline"]
-      (NoArg (\ opts -> opts { optOneline = True }))
-      "print the ganeti command list for reaching the solution"
-    , Option ['n']     ["nodes"]
-      (ReqArg (\ f opts -> opts { optNodef = f, optNodeSet = True }) "FILE")
-      "the node list FILE"
-    , Option ['i']     ["instances"]
-      (ReqArg (\ f opts -> opts { optInstf =  f, optInstSet = True }) "FILE")
-      "the instance list FILE"
-    , Option ['m']     ["master"]
-      (ReqArg (\ m opts -> opts { optMaster = m }) "ADDRESS")
-      "collect data via RAPI at the given ADDRESS"
-    , Option ['l']     ["max-length"]
-      (ReqArg (\ i opts -> opts { optMaxLength =  (read i)::Int }) "N")
-      "cap the solution at this many moves (useful for very unbalanced \
-      \clusters)"
-    , Option ['v']     ["verbose"]
-      (NoArg (\ opts -> opts { optVerbose = (optVerbose opts) + 1 }))
-      "increase the verbosity level"
-    , Option ['q']     ["quiet"]
-      (NoArg (\ opts -> opts { optVerbose = (optVerbose opts) - 1 }))
-      "decrease the verbosity level"
-    , Option ['O']     ["offline"]
-      (ReqArg (\ n opts -> opts { optOffline = n:optOffline opts }) "NODE")
-      " set node as offline"
-    , Option ['e']     ["min-score"]
-      (ReqArg (\ e opts -> opts { optMinScore = read e }) "EPSILON")
-      " mininum score to aim for"
-    , Option ['V']     ["version"]
+    [ Option ['V']     ["version"]
       (NoArg (\ opts -> opts { optShowVer = True}))
       "show the version of the program"
     , Option ['h']     ["help"]
@@ -113,6 +51,10 @@ options =
       "show help"
     ]
 
+-- | Compute online nodes from a NodeList
+getOnline :: NodeList -> [Node.Node]
+getOnline = filter (not . Node.offline) . Container.elems
+
 -- | Try to allocate an instance on the cluster
 tryAlloc :: (Monad m) =>
             NodeList
@@ -120,17 +62,20 @@ tryAlloc :: (Monad m) =>
          -> Instance.Instance
          -> Int
          -> m [(Maybe NodeList, [Node.Node])]
-tryAlloc nl il inst 2 =
-    let all_nodes = Container.elems nl
+tryAlloc nl _ inst 2 =
+    let all_nodes = getOnline nl
         all_pairs = liftM2 (,) all_nodes all_nodes
         ok_pairs = filter (\(x, y) -> Node.idx x /= Node.idx y) all_pairs
-        sols1 = map (\(p, s) -> let pdx = Node.idx p
-                                    sdx = Node.idx s
-                                    (mnl, _) = Cluster.allocateOn nl
-                                               inst pdx sdx
-                                in (mnl, [p, s])
-                     ) ok_pairs
-    in return sols1
+        sols = map (\(p, s) ->
+                        (fst $ Cluster.allocateOnPair nl inst p s, [p, s]))
+               ok_pairs
+    in return sols
+
+tryAlloc nl _ inst 1 =
+    let all_nodes = getOnline nl
+        sols = map (\p -> (fst $ Cluster.allocateOnSingle nl inst p, [p]))
+               all_nodes
+    in return sols
 
 tryAlloc _ _ _ reqn = fail $ "Unsupported number of alllocation \
                              \destinations required (" ++ (show reqn) ++
@@ -145,7 +90,7 @@ tryReloc :: (Monad m) =>
          -> [Int]
          -> m [(Maybe NodeList, [Node.Node])]
 tryReloc nl il xid 1 ex_idx =
-    let all_nodes = Container.elems nl
+    let all_nodes = getOnline nl
         inst = Container.find xid il
         valid_nodes = filter (not . flip elem ex_idx . idx) all_nodes
         valid_idxes = map Node.idx valid_nodes
@@ -180,8 +125,8 @@ processResults sols =
         sols'' = sortBy (compare `on` fst) sols'
         (best, w) = head sols''
         (worst, l) = last sols''
-        info = printf "Valid results: %d, best score: %.8f (nodes %s), \
-                      \worst score: %.8f (nodes %s)" (length sols'')
+        info = printf "Valid results: %d, best score: %.8f for node(s) %s, \
+                      \worst score: %.8f for node(s) %s" (length sols'')
                       best (intercalate "/" . map Node.name $ w)
                       worst (intercalate "/" . map Node.name $ l)
     in return (info, w)
@@ -190,8 +135,7 @@ processResults sols =
 main :: IO ()
 main = do
   cmd_args <- System.getArgs
-  (opts, args) <- CLI.parseOpts cmd_args "hail" options
-                  defaultOptions
+  (_, args) <- CLI.parseOpts cmd_args "hail" options defaultOptions
 
   when (null args) $ do
          hPutStrLn stderr "Error: this program needs an input file."