Add test for checking Haskell/Python opcode equivalence

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

diff --git a/htools/Ganeti/HTools/Utils.hs b/htools/Ganeti/HTools/Utils.hs
index d43f373..0efe7fe 100644 (file)
--- a/htools/Ganeti/HTools/Utils.hs
+++ b/htools/Ganeti/HTools/Utils.hs
@@ -2,7 +2,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
@@ -31,16 +31,27 @@ module Ganeti.HTools.Utils
   , select
   , applyIf
   , commaJoin
+  , ensureQuoted
   , tryRead
   , formatTable
+  , printTable
   , parseUnit
+  , plural
+  , exitIfBad
+  , exitErr
+  , exitWhen
+  , exitUnless
   ) where
 
-import Data.Char (toUpper)
+import Data.Char (toUpper, isAlphaNum)
 import Data.List
 
 import Debug.Trace
 
+import Ganeti.BasicTypes
+import System.IO
+import System.Exit
+
 -- * Debug functions
 
 -- | To be used only for debugging, breaks referential integrity.
@@ -76,6 +87,17 @@ sepSplit sep s
   where (x, xs) = break (== sep) s
         ys = drop 1 xs
 
+-- | Simple pluralize helper
+plural :: Int -> String -> String -> String
+plural 1 s _ = s
+plural _ _ p = p
+
+-- | Ensure a value is quoted if needed.
+ensureQuoted :: String -> String
+ensureQuoted v = if not (all (\c -> isAlphaNum c || c == '.') v)
+                 then '\'':v ++ "'"
+                 else v
+
 -- * Mathematical functions
 
 -- Simple and slow statistical functions, please replace with better
@@ -110,13 +132,6 @@ if' :: Bool -- ^ condition
 if' True x _ = x
 if' _    _ y = y
 
--- | Return the first result with a True condition, or the default otherwise.
-select :: a            -- ^ default result
-       -> [(Bool, a)]  -- ^ list of \"condition, result\"
-       -> a            -- ^ first result which has a True condition, or default
-select def = maybe def snd . find fst
-
-
 -- * Parsing utility functions
 
 -- | Parse results from readsPrec.
@@ -150,6 +165,31 @@ formatTable vals numpos =
                     ) (zip3 vtrans numpos mlens)
    in transpose expnd
 
+-- | Constructs a printable table from given header and rows
+printTable :: String -> [String] -> [[String]] -> [Bool] -> String
+printTable lp header rows isnum =
+  unlines . map ((++) lp . (:) ' ' . unwords) $
+  formatTable (header:rows) isnum
+
+-- | Converts a unit (e.g. m or GB) into a scaling factor.
+parseUnitValue :: (Monad m) => String -> m Rational
+parseUnitValue unit
+  -- binary conversions first
+  | null unit                     = return 1
+  | unit == "m" || upper == "MIB" = return 1
+  | unit == "g" || upper == "GIB" = return kbBinary
+  | unit == "t" || upper == "TIB" = return $ kbBinary * kbBinary
+  -- SI conversions
+  | unit == "M" || upper == "MB"  = return mbFactor
+  | unit == "G" || upper == "GB"  = return $ mbFactor * kbDecimal
+  | unit == "T" || upper == "TB"  = return $ mbFactor * kbDecimal * kbDecimal
+  | otherwise = fail $ "Unknown unit '" ++ unit ++ "'"
+  where upper = map toUpper unit
+        kbBinary = 1024 :: Rational
+        kbDecimal = 1000 :: Rational
+        decToBin = kbDecimal / kbBinary -- factor for 1K conversion
+        mbFactor = decToBin * decToBin -- twice the factor for just 1K
+
 -- | Tries to extract number and scale from the given string.
 --
 -- Input must be in the format NUMBER+ SPACE* [UNIT]. If no unit is
@@ -159,20 +199,34 @@ parseUnit :: (Monad m, Integral a, Read a) => String -> m a
 parseUnit str =
   -- TODO: enhance this by splitting the unit parsing code out and
   -- accepting floating-point numbers
-  case reads str of
+  case (reads str::[(Int, String)]) of
     [(v, suffix)] ->
       let unit = dropWhile (== ' ') suffix
-          upper = map toUpper unit
-          siConvert x = x * 1000000 `div` 1048576
-      in case () of
-           _ | null unit -> return v
-             | unit == "m" || upper == "MIB" -> return v
-             | unit == "M" || upper == "MB"  -> return $ siConvert v
-             | unit == "g" || upper == "GIB" -> return $ v * 1024
-             | unit == "G" || upper == "GB"  -> return $ siConvert
-                                                (v * 1000)
-             | unit == "t" || upper == "TIB" -> return $ v * 1048576
-             | unit == "T" || upper == "TB"  -> return $
-                                                siConvert (v * 1000000)
-             | otherwise -> fail $ "Unknown unit '" ++ unit ++ "'"
+      in do
+        scaling <- parseUnitValue unit
+        return $ truncate (fromIntegral v * scaling)
     _ -> fail $ "Can't parse string '" ++ str ++ "'"
+
+-- | Unwraps a 'Result', exiting the program if it is a 'Bad' value,
+-- otherwise returning the actual contained value.
+exitIfBad :: String -> Result a -> IO a
+exitIfBad msg (Bad s) = do
+  hPutStrLn stderr $ "Error: " ++ msg ++ ": " ++ s
+  exitWith (ExitFailure 1)
+exitIfBad _ (Ok v) = return v
+
+-- | Exits immediately with an error message.
+exitErr :: String -> IO a
+exitErr errmsg = do
+  hPutStrLn stderr $ "Error: " ++ errmsg ++ "."
+  exitWith (ExitFailure 1)
+
+-- | Exits with an error message if the given boolean condition if true.
+exitWhen :: Bool -> String -> IO ()
+exitWhen True msg = exitErr msg
+exitWhen False _  = return ()
+
+-- | Exits with an error message /unless/ the given boolean condition
+-- if true, the opposite of 'exitWhen'.
+exitUnless :: Bool -> String -> IO ()
+exitUnless cond = exitWhen (not cond)