Statistics
| Branch: | Tag: | Revision:

root / htools / Ganeti / HTools / Utils.hs @ 084565ac

History | View | Annotate | Download (6.2 kB)

1 525bfb36 Iustin Pop
{-| Utility functions. -}
2 e4f08c46 Iustin Pop
3 e2fa2baf Iustin Pop
{-
4 e2fa2baf Iustin Pop
5 e8230242 Iustin Pop
Copyright (C) 2009, 2010, 2011 Google Inc.
6 e2fa2baf Iustin Pop
7 e2fa2baf Iustin Pop
This program is free software; you can redistribute it and/or modify
8 e2fa2baf Iustin Pop
it under the terms of the GNU General Public License as published by
9 e2fa2baf Iustin Pop
the Free Software Foundation; either version 2 of the License, or
10 e2fa2baf Iustin Pop
(at your option) any later version.
11 e2fa2baf Iustin Pop
12 e2fa2baf Iustin Pop
This program is distributed in the hope that it will be useful, but
13 e2fa2baf Iustin Pop
WITHOUT ANY WARRANTY; without even the implied warranty of
14 e2fa2baf Iustin Pop
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
15 e2fa2baf Iustin Pop
General Public License for more details.
16 e2fa2baf Iustin Pop
17 e2fa2baf Iustin Pop
You should have received a copy of the GNU General Public License
18 e2fa2baf Iustin Pop
along with this program; if not, write to the Free Software
19 e2fa2baf Iustin Pop
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
20 e2fa2baf Iustin Pop
02110-1301, USA.
21 e2fa2baf Iustin Pop
22 e2fa2baf Iustin Pop
-}
23 e2fa2baf Iustin Pop
24 209b3711 Iustin Pop
module Ganeti.HTools.Utils
25 ebf38064 Iustin Pop
  ( debug
26 ebf38064 Iustin Pop
  , debugFn
27 ebf38064 Iustin Pop
  , debugXy
28 ebf38064 Iustin Pop
  , sepSplit
29 ebf38064 Iustin Pop
  , stdDev
30 ebf38064 Iustin Pop
  , if'
31 ebf38064 Iustin Pop
  , select
32 ebf38064 Iustin Pop
  , applyIf
33 ebf38064 Iustin Pop
  , commaJoin
34 ebf38064 Iustin Pop
  , tryRead
35 ebf38064 Iustin Pop
  , formatTable
36 ebf38064 Iustin Pop
  , parseUnit
37 19e310cc René Nussbaumer
  , plural
38 ebf38064 Iustin Pop
  ) where
39 e4f08c46 Iustin Pop
40 1cb92fac Iustin Pop
import Data.Char (toUpper)
41 29ac5975 Iustin Pop
import Data.List
42 e4f08c46 Iustin Pop
43 e4f08c46 Iustin Pop
import Debug.Trace
44 e4f08c46 Iustin Pop
45 9188aeef Iustin Pop
-- * Debug functions
46 9188aeef Iustin Pop
47 e4f08c46 Iustin Pop
-- | To be used only for debugging, breaks referential integrity.
48 e4f08c46 Iustin Pop
debug :: Show a => a -> a
49 e4f08c46 Iustin Pop
debug x = trace (show x) x
50 e4f08c46 Iustin Pop
51 525bfb36 Iustin Pop
-- | Displays a modified form of the second parameter before returning
52 525bfb36 Iustin Pop
-- it.
53 adc5c176 Iustin Pop
debugFn :: Show b => (a -> b) -> a -> a
54 adc5c176 Iustin Pop
debugFn fn x = debug (fn x) `seq` x
55 adc5c176 Iustin Pop
56 525bfb36 Iustin Pop
-- | Show the first parameter before returning the second one.
57 adc5c176 Iustin Pop
debugXy :: Show a => a -> b -> b
58 05ff7a00 Agata Murawska
debugXy = seq . debug
59 adc5c176 Iustin Pop
60 525bfb36 Iustin Pop
-- * Miscellaneous
61 1b7cf8ca Iustin Pop
62 61bbbed7 Agata Murawska
-- | Apply the function if condition holds, otherwise use default value.
63 61bbbed7 Agata Murawska
applyIf :: Bool -> (a -> a) -> a -> a
64 61bbbed7 Agata Murawska
applyIf b f x = if b then f x else x
65 61bbbed7 Agata Murawska
66 e4f08c46 Iustin Pop
-- | Comma-join a string list.
67 e4f08c46 Iustin Pop
commaJoin :: [String] -> String
68 e4f08c46 Iustin Pop
commaJoin = intercalate ","
69 e4f08c46 Iustin Pop
70 748d5d50 Iustin Pop
-- | Split a list on a separator and return an array.
71 748d5d50 Iustin Pop
sepSplit :: Eq a => a -> [a] -> [[a]]
72 e4f08c46 Iustin Pop
sepSplit sep s
73 ebf38064 Iustin Pop
  | null s    = []
74 ebf38064 Iustin Pop
  | null xs   = [x]
75 ebf38064 Iustin Pop
  | null ys   = [x,[]]
76 ebf38064 Iustin Pop
  | otherwise = x:sepSplit sep ys
77 ebf38064 Iustin Pop
  where (x, xs) = break (== sep) s
78 ebf38064 Iustin Pop
        ys = drop 1 xs
79 e4f08c46 Iustin Pop
80 19e310cc René Nussbaumer
-- | Simple pluralize helper
81 19e310cc René Nussbaumer
plural :: Int -> String -> String -> String
82 19e310cc René Nussbaumer
plural 1 s _ = s
83 19e310cc René Nussbaumer
plural _ _ p = p
84 19e310cc René Nussbaumer
85 9188aeef Iustin Pop
-- * Mathematical functions
86 9188aeef Iustin Pop
87 185297fa Iustin Pop
-- Simple and slow statistical functions, please replace with better
88 185297fa Iustin Pop
-- versions
89 e4f08c46 Iustin Pop
90 525bfb36 Iustin Pop
-- | Standard deviation function.
91 4715711d Iustin Pop
stdDev :: [Double] -> Double
92 4715711d Iustin Pop
stdDev lst =
93 7570569e Iustin Pop
  -- first, calculate the list length and sum lst in a single step,
94 7570569e Iustin Pop
  -- for performance reasons
95 7570569e Iustin Pop
  let (ll', sx) = foldl' (\(rl, rs) e ->
96 7570569e Iustin Pop
                           let rl' = rl + 1
97 7570569e Iustin Pop
                               rs' = rs + e
98 7570569e Iustin Pop
                           in rl' `seq` rs' `seq` (rl', rs')) (0::Int, 0) lst
99 7570569e Iustin Pop
      ll = fromIntegral ll'::Double
100 7570569e Iustin Pop
      mv = sx / ll
101 7570569e Iustin Pop
      av = foldl' (\accu em -> let d = em - mv in accu + d * d) 0.0 lst
102 4715711d Iustin Pop
  in sqrt (av / ll) -- stddev
103 dd4c56ed Iustin Pop
104 bfe6c954 Guido Trotter
-- *  Logical functions
105 bfe6c954 Guido Trotter
106 bfe6c954 Guido Trotter
-- Avoid syntactic sugar and enhance readability. These functions are proposed
107 bfe6c954 Guido Trotter
-- by some for inclusion in the Prelude, and at the moment they are present
108 bfe6c954 Guido Trotter
-- (with various definitions) in the utility-ht package. Some rationale and
109 bfe6c954 Guido Trotter
-- discussion is available at <http://www.haskell.org/haskellwiki/If-then-else>
110 bfe6c954 Guido Trotter
111 bfe6c954 Guido Trotter
-- | \"if\" as a function, rather than as syntactic sugar.
112 bfe6c954 Guido Trotter
if' :: Bool -- ^ condition
113 bfe6c954 Guido Trotter
    -> a    -- ^ \"then\" result
114 bfe6c954 Guido Trotter
    -> a    -- ^ \"else\" result
115 bfe6c954 Guido Trotter
    -> a    -- ^ \"then\" or "else" result depending on the condition
116 bfe6c954 Guido Trotter
if' True x _ = x
117 bfe6c954 Guido Trotter
if' _    _ y = y
118 bfe6c954 Guido Trotter
119 bfe6c954 Guido Trotter
-- | Return the first result with a True condition, or the default otherwise.
120 bfe6c954 Guido Trotter
select :: a            -- ^ default result
121 bfe6c954 Guido Trotter
       -> [(Bool, a)]  -- ^ list of \"condition, result\"
122 bfe6c954 Guido Trotter
       -> a            -- ^ first result which has a True condition, or default
123 bfe6c954 Guido Trotter
select def = maybe def snd . find fst
124 bfe6c954 Guido Trotter
125 5b763470 Iustin Pop
126 5b763470 Iustin Pop
-- * Parsing utility functions
127 5b763470 Iustin Pop
128 525bfb36 Iustin Pop
-- | Parse results from readsPrec.
129 5b763470 Iustin Pop
parseChoices :: (Monad m, Read a) => String -> String -> [(a, String)] -> m a
130 5b763470 Iustin Pop
parseChoices _ _ ((v, ""):[]) = return v
131 5b763470 Iustin Pop
parseChoices name s ((_, e):[]) =
132 5b763470 Iustin Pop
    fail $ name ++ ": leftover characters when parsing '"
133 5b763470 Iustin Pop
           ++ s ++ "': '" ++ e ++ "'"
134 5b763470 Iustin Pop
parseChoices name s _ = fail $ name ++ ": cannot parse string '" ++ s ++ "'"
135 5b763470 Iustin Pop
136 5b763470 Iustin Pop
-- | Safe 'read' function returning data encapsulated in a Result.
137 5b763470 Iustin Pop
tryRead :: (Monad m, Read a) => String -> String -> m a
138 5b763470 Iustin Pop
tryRead name s = parseChoices name s $ reads s
139 c5f7412e Iustin Pop
140 525bfb36 Iustin Pop
-- | Format a table of strings to maintain consistent length.
141 c5f7412e Iustin Pop
formatTable :: [[String]] -> [Bool] -> [[String]]
142 c5f7412e Iustin Pop
formatTable vals numpos =
143 c5f7412e Iustin Pop
    let vtrans = transpose vals  -- transpose, so that we work on rows
144 c5f7412e Iustin Pop
                                 -- rather than columns
145 c5f7412e Iustin Pop
        mlens = map (maximum . map length) vtrans
146 c5f7412e Iustin Pop
        expnd = map (\(flds, isnum, ml) ->
147 c5f7412e Iustin Pop
                         map (\val ->
148 c5f7412e Iustin Pop
                                  let delta = ml - length val
149 c5f7412e Iustin Pop
                                      filler = replicate delta ' '
150 c5f7412e Iustin Pop
                                  in if delta > 0
151 c5f7412e Iustin Pop
                                     then if isnum
152 c5f7412e Iustin Pop
                                          then filler ++ val
153 c5f7412e Iustin Pop
                                          else val ++ filler
154 c5f7412e Iustin Pop
                                     else val
155 c5f7412e Iustin Pop
                             ) flds
156 c5f7412e Iustin Pop
                    ) (zip3 vtrans numpos mlens)
157 c5f7412e Iustin Pop
   in transpose expnd
158 9b9da389 Iustin Pop
159 1cb92fac Iustin Pop
-- | Tries to extract number and scale from the given string.
160 1cb92fac Iustin Pop
--
161 1cb92fac Iustin Pop
-- Input must be in the format NUMBER+ SPACE* [UNIT]. If no unit is
162 1cb92fac Iustin Pop
-- specified, it defaults to MiB. Return value is always an integral
163 1cb92fac Iustin Pop
-- value in MiB.
164 1cb92fac Iustin Pop
parseUnit :: (Monad m, Integral a, Read a) => String -> m a
165 1cb92fac Iustin Pop
parseUnit str =
166 ebf38064 Iustin Pop
  -- TODO: enhance this by splitting the unit parsing code out and
167 ebf38064 Iustin Pop
  -- accepting floating-point numbers
168 ebf38064 Iustin Pop
  case reads str of
169 ebf38064 Iustin Pop
    [(v, suffix)] ->
170 ebf38064 Iustin Pop
      let unit = dropWhile (== ' ') suffix
171 ebf38064 Iustin Pop
          upper = map toUpper unit
172 ebf38064 Iustin Pop
          siConvert x = x * 1000000 `div` 1048576
173 ebf38064 Iustin Pop
      in case () of
174 ebf38064 Iustin Pop
           _ | null unit -> return v
175 ebf38064 Iustin Pop
             | unit == "m" || upper == "MIB" -> return v
176 ebf38064 Iustin Pop
             | unit == "M" || upper == "MB"  -> return $ siConvert v
177 ebf38064 Iustin Pop
             | unit == "g" || upper == "GIB" -> return $ v * 1024
178 ebf38064 Iustin Pop
             | unit == "G" || upper == "GB"  -> return $ siConvert
179 ebf38064 Iustin Pop
                                                (v * 1000)
180 ebf38064 Iustin Pop
             | unit == "t" || upper == "TIB" -> return $ v * 1048576
181 ebf38064 Iustin Pop
             | unit == "T" || upper == "TB"  -> return $
182 ebf38064 Iustin Pop
                                                siConvert (v * 1000000)
183 ebf38064 Iustin Pop
             | otherwise -> fail $ "Unknown unit '" ++ unit ++ "'"
184 ebf38064 Iustin Pop
    _ -> fail $ "Can't parse string '" ++ str ++ "'"