Add a complex allocation/serialisation/load test
[ganeti-local] / htools / Ganeti / HTools / ExtLoader.hs
index 0db8956..f5db7f5 100644 (file)
@@ -1,4 +1,4 @@
-{-| External data loader
+{-| External data loader.
 
 This module holds the external data loading, and thus is the only one
 depending (via the specialized Text\/Rapi\/Luxi modules) on the actual
@@ -28,17 +28,17 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
 -}
 
 module Ganeti.HTools.ExtLoader
-    ( loadExternalData
-    , commonSuffix
-    , maybeSaveData
-    ) where
+  ( loadExternalData
+  , commonSuffix
+  , maybeSaveData
+  ) where
 
+import Control.Monad
 import Data.Maybe (isJust, fromJust)
-import Monad
 import System.FilePath
 import System.IO
-import System
-import Text.Printf (printf, hPrintf)
+import System.Exit
+import Text.Printf (hPrintf)
 
 import qualified Ganeti.HTools.Luxi as Luxi
 import qualified Ganeti.HTools.Rapi as Rapi
@@ -51,23 +51,24 @@ import Ganeti.HTools.Types
 import Ganeti.HTools.CLI
 import Ganeti.HTools.Utils (sepSplit, tryRead)
 
--- | Error beautifier
+-- | Error beautifier.
 wrapIO :: IO (Result a) -> IO (Result a)
 wrapIO = flip catch (return . Bad . show)
 
+-- | Parses a user-supplied utilisation string.
 parseUtilisation :: String -> Result (String, DynUtil)
 parseUtilisation line =
-    let columns = sepSplit ' ' line
-    in case columns of
-         [name, cpu, mem, dsk, net] -> do
-                      rcpu <- tryRead name cpu
-                      rmem <- tryRead name mem
-                      rdsk <- tryRead name dsk
-                      rnet <- tryRead name net
-                      let du = DynUtil { cpuWeight = rcpu, memWeight = rmem
-                                       , dskWeight = rdsk, netWeight = rnet }
-                      return (name, du)
-         _ -> Bad $ "Cannot parse line " ++ line
+  case sepSplit ' ' line of
+    [name, cpu, mem, dsk, net] ->
+      do
+        rcpu <- tryRead name cpu
+        rmem <- tryRead name mem
+        rdsk <- tryRead name dsk
+        rnet <- tryRead name net
+        let du = DynUtil { cpuWeight = rcpu, memWeight = rmem
+                         , dskWeight = rdsk, netWeight = rnet }
+        return (name, du)
+    _ -> Bad $ "Cannot parse line " ++ line
 
 -- | External tool data loader from a variety of sources.
 loadExternalData :: Options
@@ -94,38 +95,33 @@ loadExternalData opts = do
                            " files options should be given.")
          exitWith $ ExitFailure 1
 
-  util_contents <- (case optDynuFile opts of
-                      Just path -> readFile path
-                      Nothing -> return "")
+  util_contents <- maybe (return "") readFile (optDynuFile opts)
   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)
+  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
   input_data <-
-      case () of
-        _ | setRapi -> wrapIO $ Rapi.loadData mhost
-          | setLuxi -> wrapIO $ Luxi.loadData $ fromJust lsock
-          | setSim -> Simu.loadData simdata
-          | setFile -> wrapIO $ Text.loadData $ fromJust tfile
-          | otherwise -> return $ Bad "No backend selected! Exiting."
+    case () of
+      _ | setRapi -> wrapIO $ Rapi.loadData mhost
+        | setLuxi -> wrapIO $ Luxi.loadData $ fromJust lsock
+        | setSim -> Simu.loadData simdata
+        | setFile -> wrapIO $ Text.loadData $ fromJust tfile
+        | 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
-      )
+    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 (fix_msgs, nl) = checkData (cdNodes cdata) (cdInstances cdata)
 
-  unless (null fix_msgs || optVerbose opts == 0) $ do
-         hPutStrLn stderr "Warning: cluster has inconsistent data:"
-         hPutStrLn stderr . unlines . map (printf "  - %s") $ fix_msgs
+  unless (optVerbose opts == 0) $ maybeShowWarnings fix_msgs
 
   return cdata {cdNodes = nl}