Rename Ganeti/HTools/Utils.hs to Ganeti/Utils.hs

[ganeti-local] / htools / Ganeti / HTools / Program / Hail.hs

diff --git a/htools/Ganeti/HTools/Program/Hail.hs b/htools/Ganeti/HTools/Program/Hail.hs
index 77b6d14..3bc5e2c 100644 (file)
--- a/htools/Ganeti/HTools/Program/Hail.hs
+++ b/htools/Ganeti/HTools/Program/Hail.hs
@@ -4,7 +4,7 @@
 
 {-
 
-Copyright (C) 2009, 2010, 2011 Google Inc.
+Copyright (C) 2009, 2010, 2011, 2012 Google Inc.
 
 This program is free software; you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by
@@ -23,18 +23,19 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
 
 -}
 
-module Ganeti.HTools.Program.Hail (main) where
+module Ganeti.HTools.Program.Hail (main, options) where
 
 import Control.Monad
+import Data.Maybe (fromMaybe, isJust)
 import System.IO
-import qualified System
+import System.Exit
 
 import qualified Ganeti.HTools.Cluster as Cluster
 
 import Ganeti.HTools.CLI
 import Ganeti.HTools.IAlloc
 import Ganeti.HTools.Loader (Request(..), ClusterData(..))
-import Ganeti.HTools.ExtLoader (maybeSaveData)
+import Ganeti.HTools.ExtLoader (maybeSaveData, loadExternalData)
 
 -- | Options list and functions.
 options :: [OptType]
@@ -44,28 +45,38 @@ options =
   , oDataFile
   , oNodeSim
   , oVerbose
-  , oShowVer
-  , oShowHelp
   ]
 
--- | Main function.
-main :: IO ()
-main = do
-  cmd_args <- System.getArgs
-  (opts, args) <- parseOpts cmd_args "hail" options
+wrapReadRequest :: Options -> [String] -> IO Request
+wrapReadRequest opts args = do
+  when (null args) $ do
+    hPutStrLn stderr "Error: this program needs an input file."
+    exitWith $ ExitFailure 1
+
+  r1 <- readRequest (head args)
+  if isJust (optDataFile opts) ||  (not . null . optNodeSim) opts
+    then do
+      cdata <- loadExternalData opts
+      let Request rqt _ = r1
+      return $ Request rqt cdata
+    else return r1
 
+
+-- | Main function.
+main :: Options -> [String] -> IO ()
+main opts args = do
   let shownodes = optShowNodes opts
       verbose = optVerbose opts
       savecluster = optSaveCluster opts
 
-  request <- readRequest opts args
+  request <- wrapReadRequest opts args
 
   let Request rq cdata = request
 
-  when (verbose > 1) $
+  when (verbose > 1) .
        hPutStrLn stderr $ "Received request: " ++ show rq
 
-  when (verbose > 2) $
+  when (verbose > 2) .
        hPutStrLn stderr $ "Received cluster data: " ++ show cdata
 
   maybePrintNodes shownodes "Initial cluster"
@@ -74,7 +85,7 @@ main = do
   maybeSaveData savecluster "pre-ialloc" "before iallocator run" cdata
 
   let (maybe_ni, resp) = runIAllocator request
-      (fin_nl, fin_il) = maybe (cdNodes cdata, cdInstances cdata) id maybe_ni
+      (fin_nl, fin_il) = fromMaybe (cdNodes cdata, cdInstances cdata) maybe_ni
   putStrLn resp
 
   maybePrintNodes shownodes "Final cluster" (Cluster.printNodes fin_nl)