1 {-| Utility functions -}
5 Copyright (C) 2009, 2010, 2011 Google Inc.
7 This program is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2 of the License, or
10 (at your option) any later version.
12 This program is distributed in the hope that it will be useful, but
13 WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
15 General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with this program; if not, write to the Free Software
19 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
24 module Ganeti.HTools.Utils
48 import Control.Monad (liftM)
50 import Data.Maybe (fromMaybe)
51 import qualified Text.JSON as J
52 import Text.Printf (printf)
56 import Ganeti.HTools.Types
60 -- | To be used only for debugging, breaks referential integrity.
61 debug :: Show a => a -> a
62 debug x = trace (show x) x
64 -- | Displays a modified form of the second parameter before returning it
65 debugFn :: Show b => (a -> b) -> a -> a
66 debugFn fn x = debug (fn x) `seq` x
68 -- | Show the first parameter before returning the second one
69 debugXy :: Show a => a -> b -> b
70 debugXy a b = debug a `seq` b
74 -- | Comma-join a string list.
75 commaJoin :: [String] -> String
76 commaJoin = intercalate ","
78 -- | Split a list on a separator and return an array.
79 sepSplit :: Eq a => a -> [a] -> [[a]]
84 | otherwise = x:sepSplit sep ys
85 where (x, xs) = break (== sep) s
88 -- * Mathematical functions
90 -- Simple and slow statistical functions, please replace with better
93 -- | Standard deviation function
94 stdDev :: [Double] -> Double
96 -- first, calculate the list length and sum lst in a single step,
97 -- for performance reasons
98 let (ll', sx) = foldl' (\(rl, rs) e ->
101 in rl' `seq` rs' `seq` (rl', rs')) (0::Int, 0) lst
102 ll = fromIntegral ll'::Double
104 av = foldl' (\accu em -> let d = em - mv in accu + d * d) 0.0 lst
105 in sqrt (av / ll) -- stddev
107 -- * JSON-related functions
109 -- | Converts a JSON Result into a monadic value.
110 fromJResult :: Monad m => String -> J.Result a -> m a
111 fromJResult s (J.Error x) = fail (s ++ ": " ++ x)
112 fromJResult _ (J.Ok x) = return x
114 -- | Tries to read a string from a JSON value.
116 -- In case the value was not a string, we fail the read (in the
117 -- context of the current monad.
118 readEitherString :: (Monad m) => J.JSValue -> m String
121 J.JSString s -> return $ J.fromJSString s
122 _ -> fail "Wrong JSON type"
124 -- | Converts a JSON message into an array of JSON objects.
125 loadJSArray :: (Monad m)
126 => String -- ^ Operation description (for error reporting)
127 -> String -- ^ Input message
128 -> m [J.JSObject J.JSValue]
129 loadJSArray s = fromJResult s . J.decodeStrict
131 -- | Reads the value of a key in a JSON object.
132 fromObj :: (J.JSON a, Monad m) => [(String, J.JSValue)] -> String -> m a
135 Nothing -> fail $ printf "key '%s' not found, object contains only %s"
137 Just val -> fromKeyValue k val
139 -- | Reads the value of an optional key in a JSON object.
140 maybeFromObj :: (J.JSON a, Monad m) =>
141 [(String, J.JSValue)] -> String -> m (Maybe a)
144 Nothing -> return Nothing
145 Just val -> liftM Just (fromKeyValue k val)
147 -- | Reads the value of a key in a JSON object with a default if missing.
148 fromObjWithDefault :: (J.JSON a, Monad m) =>
149 [(String, J.JSValue)] -> String -> a -> m a
150 fromObjWithDefault o k d = liftM (fromMaybe d) $ maybeFromObj o k
152 -- | Reads a JValue, that originated from an object key
153 fromKeyValue :: (J.JSON a, Monad m)
154 => String -- ^ The key name
155 -> J.JSValue -- ^ The value to read
158 fromJResult (printf "key '%s', value '%s'" k (show val)) (J.readJSON val)
160 -- | Annotate a Result with an ownership information
161 annotateResult :: String -> Result a -> Result a
162 annotateResult owner (Bad s) = Bad $ owner ++ ": " ++ s
163 annotateResult _ v = v
165 -- | Try to extract a key from a object with better error reporting
167 tryFromObj :: (J.JSON a) =>
168 String -- ^ Textual "owner" in error messages
169 -> [(String, J.JSValue)] -- ^ The object array
170 -> String -- ^ The desired key from the object
172 tryFromObj t o = annotateResult t . fromObj o
174 -- | Small wrapper over readJSON.
175 fromJVal :: (Monad m, J.JSON a) => J.JSValue -> m a
178 J.Error s -> fail ("Cannot convert value '" ++ show v ++
182 -- | Converts a JSON value into a JSON object.
183 asJSObject :: (Monad m) => J.JSValue -> m (J.JSObject J.JSValue)
184 asJSObject (J.JSObject a) = return a
185 asJSObject _ = fail "not an object"
187 -- | Coneverts a list of JSON values into a list of JSON objects.
188 asObjectList :: (Monad m) => [J.JSValue] -> m [J.JSObject J.JSValue]
189 asObjectList = mapM asJSObject
191 -- * Parsing utility functions
193 -- | Parse results from readsPrec
194 parseChoices :: (Monad m, Read a) => String -> String -> [(a, String)] -> m a
195 parseChoices _ _ ((v, ""):[]) = return v
196 parseChoices name s ((_, e):[]) =
197 fail $ name ++ ": leftover characters when parsing '"
198 ++ s ++ "': '" ++ e ++ "'"
199 parseChoices name s _ = fail $ name ++ ": cannot parse string '" ++ s ++ "'"
201 -- | Safe 'read' function returning data encapsulated in a Result.
202 tryRead :: (Monad m, Read a) => String -> String -> m a
203 tryRead name s = parseChoices name s $ reads s
205 -- | Format a table of strings to maintain consistent length
206 formatTable :: [[String]] -> [Bool] -> [[String]]
207 formatTable vals numpos =
208 let vtrans = transpose vals -- transpose, so that we work on rows
209 -- rather than columns
210 mlens = map (maximum . map length) vtrans
211 expnd = map (\(flds, isnum, ml) ->
213 let delta = ml - length val
214 filler = replicate delta ' '
221 ) (zip3 vtrans numpos mlens)
224 -- | Default group UUID (just a string, not a real UUID)
225 defaultGroupID :: GroupID
226 defaultGroupID = "00000000-0000-0000-0000-000000000000"