Rework the types used during data loading

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

diff --git a/Ganeti/HTools/Utils.hs b/Ganeti/HTools/Utils.hs
index 7771f0e..7ae2367 100644 (file)
--- 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
     , commaJoin
     , readEitherString
     , loadJSArray
     , fromObj
+    , maybeFromObj
     , tryFromObj
     , fromJVal
     , asJSObject
@@ -39,8 +41,10 @@ module Ganeti.HTools.Utils
     , tryRead
     , formatTable
     , annotateResult
+    , defaultGroupID
     ) where
 
+import Control.Monad (liftM)
 import Data.List
 import qualified Text.JSON as J
 import Text.Printf (printf)
@@ -55,6 +59,14 @@ 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.
@@ -71,24 +83,26 @@ sepSplit sep s
     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
+-- | Our modified standard deviation function (not, it's not the variance)
 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
+  -- 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
+      bv = sqrt (av / ll) -- stddev
+      cv = bv / ll        -- standard deviation divided by list length
+  in cv
 
 -- * JSON-related functions
 
@@ -114,13 +128,28 @@ loadJSArray :: (Monad m)
                -> 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 (printf "key '%s', value '%s'" k (show val))
-                  (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
@@ -181,3 +210,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"