Add test for checking Haskell/Python opcode equivalence

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

diff --git a/htools/Ganeti/HTools/ExtLoader.hs b/htools/Ganeti/HTools/ExtLoader.hs
index 210c888..797a66f 100644 (file)
--- a/htools/Ganeti/HTools/ExtLoader.hs
+++ b/htools/Ganeti/HTools/ExtLoader.hs
@@ -8,7 +8,7 @@ libraries implementing the low-level protocols.
 
 {-
 
-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
@@ -34,26 +34,28 @@ module Ganeti.HTools.ExtLoader
   ) where
 
 import Control.Monad
+import Control.Exception
 import Data.Maybe (isJust, fromJust)
+import Prelude hiding (catch)
 import System.FilePath
 import System.IO
-import System.Exit
 import Text.Printf (hPrintf)
 
 import qualified Ganeti.HTools.Luxi as Luxi
 import qualified Ganeti.HTools.Rapi as Rapi
 import qualified Ganeti.HTools.Simu as Simu
 import qualified Ganeti.HTools.Text as Text
+import qualified Ganeti.HTools.IAlloc as IAlloc
 import Ganeti.HTools.Loader (mergeData, checkData, ClusterData(..)
                             , commonSuffix)
 
 import Ganeti.HTools.Types
 import Ganeti.HTools.CLI
-import Ganeti.HTools.Utils (sepSplit, tryRead)
+import Ganeti.HTools.Utils (sepSplit, tryRead, exitIfBad, exitWhen)
 
 -- | Error beautifier.
 wrapIO :: IO (Result a) -> IO (Result a)
-wrapIO = flip catch (return . Bad . show)
+wrapIO = handle (\e -> return . Bad . show $ (e::IOException))
 
 -- | Parses a user-supplied utilisation string.
 parseUtilisation :: String -> Result (String, DynUtil)
@@ -78,10 +80,12 @@ loadExternalData opts = do
       lsock = optLuxi opts
       tfile = optDataFile opts
       simdata = optNodeSim opts
+      iallocsrc = optIAllocSrc opts
       setRapi = mhost /= ""
       setLuxi = isJust lsock
       setSim = (not . null) simdata
       setFile = isJust tfile
+      setIAllocSrc = isJust iallocsrc
       allSet = filter id [setRapi, setLuxi, setFile]
       exTags = case optExTags opts of
                  Nothing -> []
@@ -89,39 +93,23 @@ loadExternalData opts = do
       selInsts = optSelInst opts
       exInsts = optExInst opts
 
-  when (length allSet > 1) $
-       do
-         hPutStrLn stderr ("Error: Only one of the rapi, luxi, and data" ++
-                           " files options should be given.")
-         exitWith $ ExitFailure 1
-
-  util_contents <- (case optDynuFile opts of
-                      Just path -> readFile path
-                      Nothing -> return "")
-  let util_data = mapM parseUtilisation $ lines util_contents
-  util_data' <- (case util_data of
-                   Ok x  -> return x
-                   Bad y -> do
-                     hPutStrLn stderr ("Error: can't parse utilisation" ++
-                                       " data: " ++ show y)
-                     exitWith $ ExitFailure 1)
+  exitWhen (length allSet > 1) "Only one of the rapi, luxi, and data\
+                               \ files options should be given"
+
+  util_contents <- maybe (return "") readFile (optDynuFile opts)
+  util_data <- exitIfBad "can't parse utilisation data" .
+               mapM parseUtilisation $ lines util_contents
   input_data <-
     case () of
       _ | setRapi -> wrapIO $ Rapi.loadData mhost
-        | setLuxi -> wrapIO $ Luxi.loadData $ fromJust lsock
+        | setLuxi -> wrapIO . Luxi.loadData $ fromJust lsock
         | setSim -> Simu.loadData simdata
-        | setFile -> wrapIO $ Text.loadData $ fromJust tfile
+        | setFile -> wrapIO . Text.loadData $ fromJust tfile
+        | setIAllocSrc -> wrapIO . IAlloc.loadData $ fromJust iallocsrc
         | otherwise -> return $ Bad "No backend selected! Exiting."
 
-  let ldresult = input_data >>= mergeData util_data' exTags selInsts exInsts
-  cdata <-
-    (case ldresult of
-       Ok x -> return x
-       Bad s -> do
-         hPrintf stderr
-           "Error: failed to load data, aborting. Details:\n%s\n" s:: IO ()
-         exitWith $ ExitFailure 1
-    )
+  let ldresult = input_data >>= mergeData util_data exTags selInsts exInsts
+  cdata <- exitIfBad "failed to load data, aborting" ldresult
   let (fix_msgs, nl) = checkData (cdNodes cdata) (cdInstances cdata)
 
   unless (optVerbose opts == 0) $ maybeShowWarnings fix_msgs