htools: add parseUnit function

This is similar, but not identical, to Utils.ParseUnit. The biggest
difference is that we don't round up/down; as we only use integral
types, the result will always be rounded down.

Moreover, since (real-world) disk sizes come in SI units, the function
differentiates between SI and binary prefixes, using lower-case for
binary and upper-case for SI (similar to lvm usage). This distinction
should be ported to the Python code.

Signed-off-by: Iustin Pop <iustin@google.com>
Reviewed-by: Guido Trotter <ultrotter@google.com>

htools/Ganeti/HTools/QC.hs

@@ -334,6 +334,19 @@ prop_Utils_select_undefv lst1 (NonEmpty lst2) =
         tlist = map (\e -> (True, e)) lst2
         cndlist = flist ++ tlist ++ [undefined]
 
+prop_Utils_parseUnit (NonNegative n) =
+    Utils.parseUnit (show n) == Types.Ok n &&
+    Utils.parseUnit (show n ++ "m") == Types.Ok n &&
+    (case Utils.parseUnit (show n ++ "M") of
+      Types.Ok m -> if n > 0
+                    then m < n  -- for positive values, X MB is less than X MiB
+                    else m == 0 -- but for 0, 0 MB == 0 MiB
+      Types.Bad _ -> False) &&
+    Utils.parseUnit (show n ++ "g") == Types.Ok (n*1024) &&
+    Utils.parseUnit (show n ++ "t") == Types.Ok (n*1048576) &&
+    Types.isBad (Utils.parseUnit (show n ++ "x")::Types.Result Int)
+    where _types = (n::Int)
+
 -- | Test list for the Utils module.
 testUtils =
   [ run prop_Utils_commaJoinSplit
@@ -343,6 +356,7 @@ testUtils =
   , run prop_Utils_select
   , run prop_Utils_select_undefd
   , run prop_Utils_select_undefv
+  , run prop_Utils_parseUnit
   ]
 
 -- ** PeerMap tests

htools/Ganeti/HTools/Types.hs

@@ -264,7 +264,7 @@ mini-library here
 data Result a
     = Bad String
     | Ok a
-    deriving (Show, Read)
+    deriving (Show, Read, Eq)
 
 instance Monad Result where
     (>>=) (Bad x) _ = Bad x

htools/Ganeti/HTools/Utils.hs

@@ -46,9 +46,11 @@ module Ganeti.HTools.Utils
     , formatTable
     , annotateResult
     , defaultGroupID
+    , parseUnit
     ) where
 
 import Control.Monad (liftM)
+import Data.Char (toUpper)
 import Data.List
 import Data.Maybe (fromMaybe)
 import qualified Text.JSON as J
@@ -252,3 +254,30 @@ formatTable vals numpos =
 -- | Default group UUID (just a string, not a real UUID).
 defaultGroupID :: GroupID
 defaultGroupID = "00000000-0000-0000-0000-000000000000"
+
+-- | Tries to extract number and scale from the given string.
+--
+-- Input must be in the format NUMBER+ SPACE* [UNIT]. If no unit is
+-- specified, it defaults to MiB. Return value is always an integral
+-- value in MiB.
+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
+      [(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 ++ "'"
+      _ -> fail $ "Can't parse string '" ++ str ++ "'"