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
52 import Data.Char (toUpper)
54 import qualified Text.JSON as J
58 import Ganeti.HTools.Types
59 -- we will re-export these for our existing users
60 import Ganeti.HTools.JSON
64 -- | To be used only for debugging, breaks referential integrity.
65 debug :: Show a => a -> a
66 debug x = trace (show x) x
68 -- | Displays a modified form of the second parameter before returning
70 debugFn :: Show b => (a -> b) -> a -> a
71 debugFn fn x = debug (fn x) `seq` x
73 -- | Show the first parameter before returning the second one.
74 debugXy :: Show a => a -> b -> b
79 -- | Comma-join a string list.
80 commaJoin :: [String] -> String
81 commaJoin = intercalate ","
83 -- | Split a list on a separator and return an array.
84 sepSplit :: Eq a => a -> [a] -> [[a]]
89 | otherwise = x:sepSplit sep ys
90 where (x, xs) = break (== sep) s
93 -- * Mathematical functions
95 -- Simple and slow statistical functions, please replace with better
98 -- | Standard deviation function.
99 stdDev :: [Double] -> Double
101 -- first, calculate the list length and sum lst in a single step,
102 -- for performance reasons
103 let (ll', sx) = foldl' (\(rl, rs) e ->
106 in rl' `seq` rs' `seq` (rl', rs')) (0::Int, 0) lst
107 ll = fromIntegral ll'::Double
109 av = foldl' (\accu em -> let d = em - mv in accu + d * d) 0.0 lst
110 in sqrt (av / ll) -- stddev
112 -- * Logical functions
114 -- Avoid syntactic sugar and enhance readability. These functions are proposed
115 -- by some for inclusion in the Prelude, and at the moment they are present
116 -- (with various definitions) in the utility-ht package. Some rationale and
117 -- discussion is available at <http://www.haskell.org/haskellwiki/If-then-else>
119 -- | \"if\" as a function, rather than as syntactic sugar.
120 if' :: Bool -- ^ condition
121 -> a -- ^ \"then\" result
122 -> a -- ^ \"else\" result
123 -> a -- ^ \"then\" or "else" result depending on the condition
127 -- | Return the first result with a True condition, or the default otherwise.
128 select :: a -- ^ default result
129 -> [(Bool, a)] -- ^ list of \"condition, result\"
130 -> a -- ^ first result which has a True condition, or default
131 select def = maybe def snd . find fst
134 -- | Annotate a Result with an ownership information.
135 annotateResult :: String -> Result a -> Result a
136 annotateResult owner (Bad s) = Bad $ owner ++ ": " ++ s
137 annotateResult _ v = v
139 -- | Try to extract a key from a object with better error reporting
141 tryFromObj :: (J.JSON a) =>
142 String -- ^ Textual "owner" in error messages
143 -> JSRecord -- ^ The object array
144 -> String -- ^ The desired key from the object
146 tryFromObj t o = annotateResult t . fromObj o
149 -- * Parsing utility functions
151 -- | Parse results from readsPrec.
152 parseChoices :: (Monad m, Read a) => String -> String -> [(a, String)] -> m a
153 parseChoices _ _ ((v, ""):[]) = return v
154 parseChoices name s ((_, e):[]) =
155 fail $ name ++ ": leftover characters when parsing '"
156 ++ s ++ "': '" ++ e ++ "'"
157 parseChoices name s _ = fail $ name ++ ": cannot parse string '" ++ s ++ "'"
159 -- | Safe 'read' function returning data encapsulated in a Result.
160 tryRead :: (Monad m, Read a) => String -> String -> m a
161 tryRead name s = parseChoices name s $ reads s
163 -- | Format a table of strings to maintain consistent length.
164 formatTable :: [[String]] -> [Bool] -> [[String]]
165 formatTable vals numpos =
166 let vtrans = transpose vals -- transpose, so that we work on rows
167 -- rather than columns
168 mlens = map (maximum . map length) vtrans
169 expnd = map (\(flds, isnum, ml) ->
171 let delta = ml - length val
172 filler = replicate delta ' '
179 ) (zip3 vtrans numpos mlens)
182 -- | Default group UUID (just a string, not a real UUID).
183 defaultGroupID :: GroupID
184 defaultGroupID = "00000000-0000-0000-0000-000000000000"
186 -- | Tries to extract number and scale from the given string.
188 -- Input must be in the format NUMBER+ SPACE* [UNIT]. If no unit is
189 -- specified, it defaults to MiB. Return value is always an integral
191 parseUnit :: (Monad m, Integral a, Read a) => String -> m a
193 -- TODO: enhance this by splitting the unit parsing code out and
194 -- accepting floating-point numbers
197 let unit = dropWhile (== ' ') suffix
198 upper = map toUpper unit
199 siConvert x = x * 1000000 `div` 1048576
201 _ | null unit -> return v
202 | unit == "m" || upper == "MIB" -> return v
203 | unit == "M" || upper == "MB" -> return $ siConvert v
204 | unit == "g" || upper == "GIB" -> return $ v * 1024
205 | unit == "G" || upper == "GB" -> return $ siConvert
207 | unit == "t" || upper == "TIB" -> return $ v * 1048576
208 | unit == "T" || upper == "TB" -> return $
209 siConvert (v * 1000000)
210 | otherwise -> fail $ "Unknown unit '" ++ unit ++ "'"
211 _ -> fail $ "Can't parse string '" ++ str ++ "'"