X-Git-Url: https://code.grnet.gr/git/ganeti-local/blobdiff_plain/185297fa8ebb033d8d7ebb6fc7895335e58f985b..017a0c3d6c9dbfe65c81612ccc388a40ed3e81fc:/Ganeti/HTools/Utils.hs

diff --git a/Ganeti/HTools/Utils.hs b/Ganeti/HTools/Utils.hs
index 66498db..45b9d5e 100644
--- a/Ganeti/HTools/Utils.hs
+++ b/Ganeti/HTools/Utils.hs
@@ -2,7 +2,7 @@
 
 {-
 
-Copyright (C) 2009 Google Inc.
+Copyright (C) 2009, 2010 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
@@ -24,13 +24,15 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
 module Ganeti.HTools.Utils
     (
       debug
+    , debugFn
+    , debugXy
     , sepSplit
-    , fst3
-    , varianceCoeff
+    , stdDev
     , commaJoin
     , readEitherString
     , loadJSArray
     , fromObj
+    , maybeFromObj
     , tryFromObj
     , fromJVal
     , asJSObject
@@ -39,10 +41,11 @@ module Ganeti.HTools.Utils
     , tryRead
     , formatTable
     , annotateResult
+    , defaultGroupID
     ) where
 
+import Control.Monad (liftM)
 import Data.List
-import Control.Monad
 import qualified Text.JSON as J
 import Text.Printf (printf)
 
@@ -56,47 +59,55 @@ import Ganeti.HTools.Types
 debug :: Show a => a -> a
 debug x = trace (show x) x
 
+-- | Displays a modified form of the second parameter before returning it
+debugFn :: Show b => (a -> b) -> a -> a
+debugFn fn x = debug (fn x) `seq` x
+
+-- | Show the first parameter before returning the second one
+debugXy :: Show a => a -> b -> b
+debugXy a b = debug a `seq` b
+
 -- * Miscelaneous
 
 -- | Comma-join a string list.
 commaJoin :: [String] -> String
 commaJoin = intercalate ","
 
--- | Split a string on a separator and return an array.
-sepSplit :: Char -> String -> [String]
+-- | Split a list on a separator and return an array.
+sepSplit :: Eq a => a -> [a] -> [[a]]
 sepSplit sep s
-    | x == "" && xs == [] = []
-    | xs == []            = [x]
-    | ys == []            = [x,""]
-    | otherwise           = x:sepSplit sep ys
+    | null s    = []
+    | null xs   = [x]
+    | null ys   = [x,[]]
+    | otherwise = x:sepSplit sep ys
     where (x, xs) = break (== sep) s
           ys = drop 1 xs
 
--- | Simple version of 'fst' for a triple
-fst3 :: (a, b, c) -> a
-fst3 (a, _, _) = a
-
 -- * Mathematical functions
 
 -- Simple and slow statistical functions, please replace with better
 -- versions
 
--- | The covariance of the list
-varianceCoeff :: [Double] -> Double
-varianceCoeff lst =
-    let ll = fromIntegral (length lst)::Double -- length of list
-        mv = sum lst / ll   -- mean value
-        av = foldl' (\accu em -> let d = em - mv in accu + d * d) 0.0 lst
-        bv = sqrt (av / ll) -- stddev
-        cv = bv / ll        -- covariance
-    in cv
+-- | Standard deviation function
+stdDev :: [Double] -> Double
+stdDev lst =
+  -- first, calculate the list length and sum lst in a single step,
+  -- for performance reasons
+  let (ll', sx) = foldl' (\(rl, rs) e ->
+                           let rl' = rl + 1
+                               rs' = rs + e
+                           in rl' `seq` rs' `seq` (rl', rs')) (0::Int, 0) lst
+      ll = fromIntegral ll'::Double
+      mv = sx / ll
+      av = foldl' (\accu em -> let d = em - mv in accu + d * d) 0.0 lst
+  in sqrt (av / ll) -- stddev
 
 -- * JSON-related functions
 
 -- | Converts a JSON Result into a monadic value.
-fromJResult :: Monad m => J.Result a -> m a
-fromJResult (J.Error x) = fail x
-fromJResult (J.Ok x) = return x
+fromJResult :: Monad m => String -> J.Result a -> m a
+fromJResult s (J.Error x) = fail (s ++ ": " ++ x)
+fromJResult _ (J.Ok x) = return x
 
 -- | Tries to read a string from a JSON value.
 --
@@ -109,15 +120,34 @@ readEitherString v =
       _ -> fail "Wrong JSON type"
 
 -- | Converts a JSON message into an array of JSON objects.
-loadJSArray :: (Monad m) => String -> m [J.JSObject J.JSValue]
-loadJSArray = fromJResult . J.decodeStrict
+loadJSArray :: (Monad m)
+               => String -- ^ Operation description (for error reporting)
+               -> String -- ^ Input message
+               -> m [J.JSObject J.JSValue]
+loadJSArray s = fromJResult s . J.decodeStrict
 
--- | Reads a the value of a key in a JSON object.
+-- | Reads the value of a key in a JSON object.
 fromObj :: (J.JSON a, Monad m) => String -> [(String, J.JSValue)] -> m a
 fromObj k o =
     case lookup k o of
       Nothing -> fail $ printf "key '%s' not found in %s" k (show o)
-      Just val -> fromJResult $ J.readJSON val
+      Just val -> fromKeyValue k val
+
+-- | Reads the value of an optional key in a JSON object.
+maybeFromObj :: (J.JSON a, Monad m) => String -> [(String, J.JSValue)]
+                -> m (Maybe a)
+maybeFromObj k o =
+    case lookup k o of
+      Nothing -> return Nothing
+      Just val -> liftM Just (fromKeyValue k val)
+
+-- | Reads a JValue, that originated from an object key
+fromKeyValue :: (J.JSON a, Monad m)
+              => String     -- ^ The key name
+              -> J.JSValue  -- ^ The value to read
+              -> m a
+fromKeyValue k val =
+  fromJResult (printf "key '%s', value '%s'" k (show val)) (J.readJSON val)
 
 -- | Annotate a Result with an ownership information
 annotateResult :: String -> Result a -> Result a
@@ -128,7 +158,7 @@ annotateResult _ v = v
 -- than fromObj
 tryFromObj :: (J.JSON a) =>
               String -> [(String, J.JSValue)] -> String -> Result a
-tryFromObj t o k = annotateResult (t ++ " key '" ++ k ++ "'") (fromObj k o)
+tryFromObj t o k = annotateResult t (fromObj k o)
 
 -- | Small wrapper over readJSON.
 fromJVal :: (Monad m, J.JSON a) => J.JSValue -> m a
@@ -178,3 +208,7 @@ formatTable vals numpos =
                              ) flds
                     ) (zip3 vtrans numpos mlens)
    in transpose expnd
+
+-- | Default group UUID (just a string, not a real UUID)
+defaultGroupID :: GroupID
+defaultGroupID = "00000000-0000-0000-0000-000000000000"