Revision 26d62e4c
b/Makefile.am | ||
---|---|---|
421 | 421 |
htools/Ganeti/HTools/Simu.hs \ |
422 | 422 |
htools/Ganeti/HTools/Text.hs \ |
423 | 423 |
htools/Ganeti/HTools/Types.hs \ |
424 |
htools/Ganeti/HTools/Utils.hs \ |
|
425 | 424 |
htools/Ganeti/HTools/Program.hs \ |
426 | 425 |
htools/Ganeti/HTools/Program/Hail.hs \ |
427 | 426 |
htools/Ganeti/HTools/Program/Hbal.hs \ |
... | ... | |
456 | 455 |
htools/Ganeti/Rpc.hs \ |
457 | 456 |
htools/Ganeti/Runtime.hs \ |
458 | 457 |
htools/Ganeti/Ssconf.hs \ |
459 |
htools/Ganeti/THH.hs |
|
458 |
htools/Ganeti/THH.hs \ |
|
459 |
htools/Ganeti/Utils.hs |
|
460 | 460 |
|
461 | 461 |
HS_TEST_SRCS = \ |
462 | 462 |
htest/Test/Ganeti/BasicTypes.hs \ |
... | ... | |
473 | 473 |
htest/Test/Ganeti/HTools/Simu.hs \ |
474 | 474 |
htest/Test/Ganeti/HTools/Text.hs \ |
475 | 475 |
htest/Test/Ganeti/HTools/Types.hs \ |
476 |
htest/Test/Ganeti/HTools/Utils.hs \ |
|
477 | 476 |
htest/Test/Ganeti/JSON.hs \ |
478 | 477 |
htest/Test/Ganeti/Jobs.hs \ |
479 | 478 |
htest/Test/Ganeti/Luxi.hs \ |
... | ... | |
486 | 485 |
htest/Test/Ganeti/Ssconf.hs \ |
487 | 486 |
htest/Test/Ganeti/TestCommon.hs \ |
488 | 487 |
htest/Test/Ganeti/TestHTools.hs \ |
489 |
htest/Test/Ganeti/TestHelper.hs |
|
488 |
htest/Test/Ganeti/TestHelper.hs \ |
|
489 |
htest/Test/Ganeti/Utils.hs |
|
490 | 490 |
|
491 | 491 |
HS_LIBTEST_SRCS = $(HS_LIB_SRCS) $(HS_TEST_SRCS) |
492 | 492 |
|
b/htest/Test/Ganeti/HTools/Text.hs | ||
---|---|---|
48 | 48 |
import qualified Ganeti.HTools.Node as Node |
49 | 49 |
import qualified Ganeti.HTools.Text as Text |
50 | 50 |
import qualified Ganeti.HTools.Types as Types |
51 |
import qualified Ganeti.HTools.Utils as Utils
|
|
51 |
import qualified Ganeti.Utils as Utils |
|
52 | 52 |
|
53 | 53 |
-- * Instance text loader tests |
54 | 54 |
|
/dev/null | ||
---|---|---|
1 |
{-# LANGUAGE TemplateHaskell #-} |
|
2 |
{-# OPTIONS_GHC -fno-warn-orphans #-} |
|
3 |
|
|
4 |
{-| Unittests for ganeti-htools. |
|
5 |
|
|
6 |
-} |
|
7 |
|
|
8 |
{- |
|
9 |
|
|
10 |
Copyright (C) 2009, 2010, 2011, 2012 Google Inc. |
|
11 |
|
|
12 |
This program is free software; you can redistribute it and/or modify |
|
13 |
it under the terms of the GNU General Public License as published by |
|
14 |
the Free Software Foundation; either version 2 of the License, or |
|
15 |
(at your option) any later version. |
|
16 |
|
|
17 |
This program is distributed in the hope that it will be useful, but |
|
18 |
WITHOUT ANY WARRANTY; without even the implied warranty of |
|
19 |
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
|
20 |
General Public License for more details. |
|
21 |
|
|
22 |
You should have received a copy of the GNU General Public License |
|
23 |
along with this program; if not, write to the Free Software |
|
24 |
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA |
|
25 |
02110-1301, USA. |
|
26 |
|
|
27 |
-} |
|
28 |
|
|
29 |
module Test.Ganeti.HTools.Utils (testHTools_Utils) where |
|
30 |
|
|
31 |
import Test.QuickCheck |
|
32 |
|
|
33 |
import qualified Text.JSON as J |
|
34 |
|
|
35 |
import Test.Ganeti.TestHelper |
|
36 |
import Test.Ganeti.TestCommon |
|
37 |
|
|
38 |
import qualified Ganeti.JSON as JSON |
|
39 |
import qualified Ganeti.HTools.Types as Types |
|
40 |
import qualified Ganeti.HTools.Utils as Utils |
|
41 |
|
|
42 |
-- | Helper to generate a small string that doesn't contain commas. |
|
43 |
genNonCommaString :: Gen String |
|
44 |
genNonCommaString = do |
|
45 |
size <- choose (0, 20) -- arbitrary max size |
|
46 |
vectorOf size (arbitrary `suchThat` (/=) ',') |
|
47 |
|
|
48 |
-- | If the list is not just an empty element, and if the elements do |
|
49 |
-- not contain commas, then join+split should be idempotent. |
|
50 |
prop_commaJoinSplit :: Property |
|
51 |
prop_commaJoinSplit = |
|
52 |
forAll (choose (0, 20)) $ \llen -> |
|
53 |
forAll (vectorOf llen genNonCommaString `suchThat` (/=) [""]) $ \lst -> |
|
54 |
Utils.sepSplit ',' (Utils.commaJoin lst) ==? lst |
|
55 |
|
|
56 |
-- | Split and join should always be idempotent. |
|
57 |
prop_commaSplitJoin :: String -> Property |
|
58 |
prop_commaSplitJoin s = |
|
59 |
Utils.commaJoin (Utils.sepSplit ',' s) ==? s |
|
60 |
|
|
61 |
-- | fromObjWithDefault, we test using the Maybe monad and an integer |
|
62 |
-- value. |
|
63 |
prop_fromObjWithDefault :: Integer -> String -> Bool |
|
64 |
prop_fromObjWithDefault def_value random_key = |
|
65 |
-- a missing key will be returned with the default |
|
66 |
JSON.fromObjWithDefault [] random_key def_value == Just def_value && |
|
67 |
-- a found key will be returned as is, not with default |
|
68 |
JSON.fromObjWithDefault [(random_key, J.showJSON def_value)] |
|
69 |
random_key (def_value+1) == Just def_value |
|
70 |
|
|
71 |
-- | Test that functional if' behaves like the syntactic sugar if. |
|
72 |
prop_if'if :: Bool -> Int -> Int -> Gen Prop |
|
73 |
prop_if'if cnd a b = |
|
74 |
Utils.if' cnd a b ==? if cnd then a else b |
|
75 |
|
|
76 |
-- | Test basic select functionality |
|
77 |
prop_select :: Int -- ^ Default result |
|
78 |
-> [Int] -- ^ List of False values |
|
79 |
-> [Int] -- ^ List of True values |
|
80 |
-> Gen Prop -- ^ Test result |
|
81 |
prop_select def lst1 lst2 = |
|
82 |
Utils.select def (flist ++ tlist) ==? expectedresult |
|
83 |
where expectedresult = Utils.if' (null lst2) def (head lst2) |
|
84 |
flist = zip (repeat False) lst1 |
|
85 |
tlist = zip (repeat True) lst2 |
|
86 |
|
|
87 |
-- | Test basic select functionality with undefined default |
|
88 |
prop_select_undefd :: [Int] -- ^ List of False values |
|
89 |
-> NonEmptyList Int -- ^ List of True values |
|
90 |
-> Gen Prop -- ^ Test result |
|
91 |
prop_select_undefd lst1 (NonEmpty lst2) = |
|
92 |
Utils.select undefined (flist ++ tlist) ==? head lst2 |
|
93 |
where flist = zip (repeat False) lst1 |
|
94 |
tlist = zip (repeat True) lst2 |
|
95 |
|
|
96 |
-- | Test basic select functionality with undefined list values |
|
97 |
prop_select_undefv :: [Int] -- ^ List of False values |
|
98 |
-> NonEmptyList Int -- ^ List of True values |
|
99 |
-> Gen Prop -- ^ Test result |
|
100 |
prop_select_undefv lst1 (NonEmpty lst2) = |
|
101 |
Utils.select undefined cndlist ==? head lst2 |
|
102 |
where flist = zip (repeat False) lst1 |
|
103 |
tlist = zip (repeat True) lst2 |
|
104 |
cndlist = flist ++ tlist ++ [undefined] |
|
105 |
|
|
106 |
prop_parseUnit :: NonNegative Int -> Property |
|
107 |
prop_parseUnit (NonNegative n) = |
|
108 |
Utils.parseUnit (show n) ==? Types.Ok n .&&. |
|
109 |
Utils.parseUnit (show n ++ "m") ==? Types.Ok n .&&. |
|
110 |
Utils.parseUnit (show n ++ "M") ==? Types.Ok (truncate n_mb::Int) .&&. |
|
111 |
Utils.parseUnit (show n ++ "g") ==? Types.Ok (n*1024) .&&. |
|
112 |
Utils.parseUnit (show n ++ "G") ==? Types.Ok (truncate n_gb::Int) .&&. |
|
113 |
Utils.parseUnit (show n ++ "t") ==? Types.Ok (n*1048576) .&&. |
|
114 |
Utils.parseUnit (show n ++ "T") ==? Types.Ok (truncate n_tb::Int) .&&. |
|
115 |
printTestCase "Internal error/overflow?" |
|
116 |
(n_mb >=0 && n_gb >= 0 && n_tb >= 0) .&&. |
|
117 |
property (Types.isBad (Utils.parseUnit (show n ++ "x")::Types.Result Int)) |
|
118 |
where n_mb = (fromIntegral n::Rational) * 1000 * 1000 / 1024 / 1024 |
|
119 |
n_gb = n_mb * 1000 |
|
120 |
n_tb = n_gb * 1000 |
|
121 |
|
|
122 |
-- | Test list for the Utils module. |
|
123 |
testSuite "HTools/Utils" |
|
124 |
[ 'prop_commaJoinSplit |
|
125 |
, 'prop_commaSplitJoin |
|
126 |
, 'prop_fromObjWithDefault |
|
127 |
, 'prop_if'if |
|
128 |
, 'prop_select |
|
129 |
, 'prop_select_undefd |
|
130 |
, 'prop_select_undefv |
|
131 |
, 'prop_parseUnit |
|
132 |
] |
b/htest/Test/Ganeti/Utils.hs | ||
---|---|---|
1 |
{-# LANGUAGE TemplateHaskell #-} |
|
2 |
{-# OPTIONS_GHC -fno-warn-orphans #-} |
|
3 |
|
|
4 |
{-| Unittests for ganeti-htools. |
|
5 |
|
|
6 |
-} |
|
7 |
|
|
8 |
{- |
|
9 |
|
|
10 |
Copyright (C) 2009, 2010, 2011, 2012 Google Inc. |
|
11 |
|
|
12 |
This program is free software; you can redistribute it and/or modify |
|
13 |
it under the terms of the GNU General Public License as published by |
|
14 |
the Free Software Foundation; either version 2 of the License, or |
|
15 |
(at your option) any later version. |
|
16 |
|
|
17 |
This program is distributed in the hope that it will be useful, but |
|
18 |
WITHOUT ANY WARRANTY; without even the implied warranty of |
|
19 |
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
|
20 |
General Public License for more details. |
|
21 |
|
|
22 |
You should have received a copy of the GNU General Public License |
|
23 |
along with this program; if not, write to the Free Software |
|
24 |
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA |
|
25 |
02110-1301, USA. |
|
26 |
|
|
27 |
-} |
|
28 |
|
|
29 |
module Test.Ganeti.Utils (testUtils) where |
|
30 |
|
|
31 |
import Test.QuickCheck |
|
32 |
|
|
33 |
import qualified Text.JSON as J |
|
34 |
|
|
35 |
import Test.Ganeti.TestHelper |
|
36 |
import Test.Ganeti.TestCommon |
|
37 |
|
|
38 |
import qualified Ganeti.JSON as JSON |
|
39 |
import qualified Ganeti.HTools.Types as Types |
|
40 |
import qualified Ganeti.Utils as Utils |
|
41 |
|
|
42 |
-- | Helper to generate a small string that doesn't contain commas. |
|
43 |
genNonCommaString :: Gen String |
|
44 |
genNonCommaString = do |
|
45 |
size <- choose (0, 20) -- arbitrary max size |
|
46 |
vectorOf size (arbitrary `suchThat` (/=) ',') |
|
47 |
|
|
48 |
-- | If the list is not just an empty element, and if the elements do |
|
49 |
-- not contain commas, then join+split should be idempotent. |
|
50 |
prop_commaJoinSplit :: Property |
|
51 |
prop_commaJoinSplit = |
|
52 |
forAll (choose (0, 20)) $ \llen -> |
|
53 |
forAll (vectorOf llen genNonCommaString `suchThat` (/=) [""]) $ \lst -> |
|
54 |
Utils.sepSplit ',' (Utils.commaJoin lst) ==? lst |
|
55 |
|
|
56 |
-- | Split and join should always be idempotent. |
|
57 |
prop_commaSplitJoin :: String -> Property |
|
58 |
prop_commaSplitJoin s = |
|
59 |
Utils.commaJoin (Utils.sepSplit ',' s) ==? s |
|
60 |
|
|
61 |
-- | fromObjWithDefault, we test using the Maybe monad and an integer |
|
62 |
-- value. |
|
63 |
prop_fromObjWithDefault :: Integer -> String -> Bool |
|
64 |
prop_fromObjWithDefault def_value random_key = |
|
65 |
-- a missing key will be returned with the default |
|
66 |
JSON.fromObjWithDefault [] random_key def_value == Just def_value && |
|
67 |
-- a found key will be returned as is, not with default |
|
68 |
JSON.fromObjWithDefault [(random_key, J.showJSON def_value)] |
|
69 |
random_key (def_value+1) == Just def_value |
|
70 |
|
|
71 |
-- | Test that functional if' behaves like the syntactic sugar if. |
|
72 |
prop_if'if :: Bool -> Int -> Int -> Gen Prop |
|
73 |
prop_if'if cnd a b = |
|
74 |
Utils.if' cnd a b ==? if cnd then a else b |
|
75 |
|
|
76 |
-- | Test basic select functionality |
|
77 |
prop_select :: Int -- ^ Default result |
|
78 |
-> [Int] -- ^ List of False values |
|
79 |
-> [Int] -- ^ List of True values |
|
80 |
-> Gen Prop -- ^ Test result |
|
81 |
prop_select def lst1 lst2 = |
|
82 |
Utils.select def (flist ++ tlist) ==? expectedresult |
|
83 |
where expectedresult = Utils.if' (null lst2) def (head lst2) |
|
84 |
flist = zip (repeat False) lst1 |
|
85 |
tlist = zip (repeat True) lst2 |
|
86 |
|
|
87 |
-- | Test basic select functionality with undefined default |
|
88 |
prop_select_undefd :: [Int] -- ^ List of False values |
|
89 |
-> NonEmptyList Int -- ^ List of True values |
|
90 |
-> Gen Prop -- ^ Test result |
|
91 |
prop_select_undefd lst1 (NonEmpty lst2) = |
|
92 |
Utils.select undefined (flist ++ tlist) ==? head lst2 |
|
93 |
where flist = zip (repeat False) lst1 |
|
94 |
tlist = zip (repeat True) lst2 |
|
95 |
|
|
96 |
-- | Test basic select functionality with undefined list values |
|
97 |
prop_select_undefv :: [Int] -- ^ List of False values |
|
98 |
-> NonEmptyList Int -- ^ List of True values |
|
99 |
-> Gen Prop -- ^ Test result |
|
100 |
prop_select_undefv lst1 (NonEmpty lst2) = |
|
101 |
Utils.select undefined cndlist ==? head lst2 |
|
102 |
where flist = zip (repeat False) lst1 |
|
103 |
tlist = zip (repeat True) lst2 |
|
104 |
cndlist = flist ++ tlist ++ [undefined] |
|
105 |
|
|
106 |
prop_parseUnit :: NonNegative Int -> Property |
|
107 |
prop_parseUnit (NonNegative n) = |
|
108 |
Utils.parseUnit (show n) ==? Types.Ok n .&&. |
|
109 |
Utils.parseUnit (show n ++ "m") ==? Types.Ok n .&&. |
|
110 |
Utils.parseUnit (show n ++ "M") ==? Types.Ok (truncate n_mb::Int) .&&. |
|
111 |
Utils.parseUnit (show n ++ "g") ==? Types.Ok (n*1024) .&&. |
|
112 |
Utils.parseUnit (show n ++ "G") ==? Types.Ok (truncate n_gb::Int) .&&. |
|
113 |
Utils.parseUnit (show n ++ "t") ==? Types.Ok (n*1048576) .&&. |
|
114 |
Utils.parseUnit (show n ++ "T") ==? Types.Ok (truncate n_tb::Int) .&&. |
|
115 |
printTestCase "Internal error/overflow?" |
|
116 |
(n_mb >=0 && n_gb >= 0 && n_tb >= 0) .&&. |
|
117 |
property (Types.isBad (Utils.parseUnit (show n ++ "x")::Types.Result Int)) |
|
118 |
where n_mb = (fromIntegral n::Rational) * 1000 * 1000 / 1024 / 1024 |
|
119 |
n_gb = n_mb * 1000 |
|
120 |
n_tb = n_gb * 1000 |
|
121 |
|
|
122 |
-- | Test list for the Utils module. |
|
123 |
testSuite "Utils" |
|
124 |
[ 'prop_commaJoinSplit |
|
125 |
, 'prop_commaSplitJoin |
|
126 |
, 'prop_fromObjWithDefault |
|
127 |
, 'prop_if'if |
|
128 |
, 'prop_select |
|
129 |
, 'prop_select_undefd |
|
130 |
, 'prop_select_undefv |
|
131 |
, 'prop_parseUnit |
|
132 |
] |
b/htest/test.hs | ||
---|---|---|
44 | 44 |
import Test.Ganeti.HTools.Simu |
45 | 45 |
import Test.Ganeti.HTools.Text |
46 | 46 |
import Test.Ganeti.HTools.Types |
47 |
import Test.Ganeti.HTools.Utils |
|
48 | 47 |
import Test.Ganeti.Jobs |
49 | 48 |
import Test.Ganeti.JSON |
50 | 49 |
import Test.Ganeti.Luxi |
... | ... | |
55 | 54 |
import Test.Ganeti.Query.Query |
56 | 55 |
import Test.Ganeti.Rpc |
57 | 56 |
import Test.Ganeti.Ssconf |
57 |
import Test.Ganeti.Utils |
|
58 | 58 |
|
59 | 59 |
-- | Our default test options, overring the built-in test-framework |
60 | 60 |
-- ones (but not the supplied command line parameters). |
... | ... | |
85 | 85 |
, testHTools_Simu |
86 | 86 |
, testHTools_Text |
87 | 87 |
, testHTools_Types |
88 |
, testHTools_Utils |
|
89 | 88 |
, testJSON |
90 | 89 |
, testJobs |
91 | 90 |
, testLuxi |
... | ... | |
96 | 95 |
, testQuery_Query |
97 | 96 |
, testRpc |
98 | 97 |
, testSsconf |
98 |
, testUtils |
|
99 | 99 |
] |
100 | 100 |
|
101 | 101 |
-- | Main function. Note we don't use defaultMain since we want to |
b/htools/Ganeti/Confd/Server.hs | ||
---|---|---|
47 | 47 |
import Ganeti.Daemon |
48 | 48 |
import Ganeti.JSON |
49 | 49 |
import Ganeti.HTools.Types |
50 |
import Ganeti.HTools.Utils |
|
51 | 50 |
import Ganeti.Objects |
52 | 51 |
import Ganeti.Confd |
53 | 52 |
import Ganeti.Confd.Utils |
54 | 53 |
import Ganeti.Config |
55 | 54 |
import Ganeti.Hash |
56 | 55 |
import Ganeti.Logging |
56 |
import Ganeti.Utils |
|
57 | 57 |
import qualified Ganeti.Constants as C |
58 | 58 |
import qualified Ganeti.Path as Path |
59 | 59 |
import Ganeti.Query.Server (runQueryD) |
b/htools/Ganeti/Confd/Utils.hs | ||
---|---|---|
42 | 42 |
import qualified Ganeti.Constants as C |
43 | 43 |
import qualified Ganeti.Path as Path |
44 | 44 |
import Ganeti.JSON |
45 |
import Ganeti.HTools.Utils
|
|
45 |
import Ganeti.Utils |
|
46 | 46 |
|
47 | 47 |
-- | Returns the HMAC key. |
48 | 48 |
getClusterHmac :: IO HashKey |
b/htools/Ganeti/Daemon.hs | ||
---|---|---|
65 | 65 |
import Ganeti.Logging |
66 | 66 |
import Ganeti.Runtime |
67 | 67 |
import Ganeti.BasicTypes |
68 |
import Ganeti.HTools.Utils
|
|
68 |
import Ganeti.Utils |
|
69 | 69 |
import qualified Ganeti.Constants as C |
70 | 70 |
import qualified Ganeti.Ssconf as Ssconf |
71 | 71 |
|
b/htools/Ganeti/HTools/CLI.hs | ||
---|---|---|
1 | 1 |
{-| Implementation of command-line functions. |
2 | 2 |
|
3 | 3 |
This module holds the common command-line related functions for the |
4 |
binaries, separated into this module since "Ganeti.HTools.Utils" is
|
|
4 |
binaries, separated into this module since "Ganeti.Utils" is |
|
5 | 5 |
used in many other places and this is more IO oriented. |
6 | 6 |
|
7 | 7 |
-} |
... | ... | |
95 | 95 |
import qualified Ganeti.HTools.Node as Node |
96 | 96 |
import qualified Ganeti.Path as Path |
97 | 97 |
import Ganeti.HTools.Types |
98 |
import Ganeti.HTools.Utils |
|
99 | 98 |
import Ganeti.BasicTypes |
100 | 99 |
import Ganeti.Common as Common |
100 |
import Ganeti.Utils |
|
101 | 101 |
|
102 | 102 |
-- * Data types |
103 | 103 |
|
b/htools/Ganeti/HTools/Cluster.hs | ||
---|---|---|
86 | 86 |
import qualified Ganeti.HTools.Node as Node |
87 | 87 |
import qualified Ganeti.HTools.Group as Group |
88 | 88 |
import Ganeti.HTools.Types |
89 |
import Ganeti.HTools.Utils |
|
90 | 89 |
import Ganeti.Compat |
91 | 90 |
import qualified Ganeti.OpCodes as OpCodes |
91 |
import Ganeti.Utils |
|
92 | 92 |
|
93 | 93 |
-- * Types |
94 | 94 |
|
b/htools/Ganeti/HTools/ExtLoader.hs | ||
---|---|---|
51 | 51 |
|
52 | 52 |
import Ganeti.HTools.Types |
53 | 53 |
import Ganeti.HTools.CLI |
54 |
import Ganeti.HTools.Utils (sepSplit, tryRead, exitIfBad, exitWhen)
|
|
54 |
import Ganeti.Utils (sepSplit, tryRead, exitIfBad, exitWhen) |
|
55 | 55 |
|
56 | 56 |
-- | Error beautifier. |
57 | 57 |
wrapIO :: IO (Result a) -> IO (Result a) |
b/htools/Ganeti/HTools/Instance.hs | ||
---|---|---|
60 | 60 |
import qualified Ganeti.HTools.Types as T |
61 | 61 |
import qualified Ganeti.HTools.Container as Container |
62 | 62 |
|
63 |
import Ganeti.HTools.Utils
|
|
63 |
import Ganeti.Utils |
|
64 | 64 |
|
65 | 65 |
-- * Type declarations |
66 | 66 |
|
b/htools/Ganeti/HTools/Loader.hs | ||
---|---|---|
52 | 52 |
|
53 | 53 |
import Ganeti.BasicTypes |
54 | 54 |
import Ganeti.HTools.Types |
55 |
import Ganeti.HTools.Utils
|
|
55 |
import Ganeti.Utils |
|
56 | 56 |
|
57 | 57 |
-- * Constants |
58 | 58 |
|
b/htools/Ganeti/HTools/Program/Hbal.hs | ||
---|---|---|
50 | 50 |
|
51 | 51 |
import Ganeti.HTools.CLI |
52 | 52 |
import Ganeti.HTools.ExtLoader |
53 |
import Ganeti.HTools.Utils |
|
54 | 53 |
import Ganeti.HTools.Types |
55 | 54 |
import Ganeti.HTools.Loader |
55 |
import Ganeti.Utils |
|
56 | 56 |
|
57 | 57 |
import qualified Ganeti.Luxi as L |
58 | 58 |
import Ganeti.Jobs |
b/htools/Ganeti/HTools/Program/Hinfo.hs | ||
---|---|---|
38 | 38 |
import qualified Ganeti.HTools.Group as Group |
39 | 39 |
import qualified Ganeti.HTools.Instance as Instance |
40 | 40 |
|
41 |
import Ganeti.HTools.Utils |
|
42 | 41 |
import Ganeti.HTools.CLI |
43 | 42 |
import Ganeti.HTools.ExtLoader |
44 | 43 |
import Ganeti.HTools.Loader |
44 |
import Ganeti.Utils |
|
45 | 45 |
|
46 | 46 |
-- | Options list and functions. |
47 | 47 |
options :: [OptType] |
b/htools/Ganeti/HTools/Program/Hspace.hs | ||
---|---|---|
40 | 40 |
import qualified Ganeti.HTools.Node as Node |
41 | 41 |
import qualified Ganeti.HTools.Instance as Instance |
42 | 42 |
|
43 |
import Ganeti.HTools.Utils |
|
44 | 43 |
import Ganeti.HTools.Types |
45 | 44 |
import Ganeti.HTools.CLI |
46 | 45 |
import Ganeti.HTools.ExtLoader |
47 | 46 |
import Ganeti.HTools.Loader |
47 |
import Ganeti.Utils |
|
48 | 48 |
|
49 | 49 |
-- | Options list and functions. |
50 | 50 |
options :: [OptType] |
b/htools/Ganeti/HTools/Simu.hs | ||
---|---|---|
33 | 33 |
import Control.Monad (mplus, zipWithM) |
34 | 34 |
import Text.Printf (printf) |
35 | 35 |
|
36 |
import Ganeti.HTools.Utils
|
|
36 |
import Ganeti.Utils |
|
37 | 37 |
import Ganeti.HTools.Types |
38 | 38 |
import Ganeti.HTools.Loader |
39 | 39 |
import qualified Ganeti.HTools.Container as Container |
b/htools/Ganeti/HTools/Text.hs | ||
---|---|---|
47 | 47 |
|
48 | 48 |
import Text.Printf (printf) |
49 | 49 |
|
50 |
import Ganeti.HTools.Utils
|
|
50 |
import Ganeti.Utils |
|
51 | 51 |
import Ganeti.HTools.Loader |
52 | 52 |
import Ganeti.HTools.Types |
53 | 53 |
import qualified Ganeti.HTools.Container as Container |
/dev/null | ||
---|---|---|
1 |
{-| Utility functions. -} |
|
2 |
|
|
3 |
{- |
|
4 |
|
|
5 |
Copyright (C) 2009, 2010, 2011, 2012 Google Inc. |
|
6 |
|
|
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. |
|
11 |
|
|
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. |
|
16 |
|
|
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 |
|
20 |
02110-1301, USA. |
|
21 |
|
|
22 |
-} |
|
23 |
|
|
24 |
module Ganeti.HTools.Utils |
|
25 |
( debug |
|
26 |
, debugFn |
|
27 |
, debugXy |
|
28 |
, sepSplit |
|
29 |
, stdDev |
|
30 |
, if' |
|
31 |
, select |
|
32 |
, applyIf |
|
33 |
, commaJoin |
|
34 |
, ensureQuoted |
|
35 |
, tryRead |
|
36 |
, formatTable |
|
37 |
, printTable |
|
38 |
, parseUnit |
|
39 |
, plural |
|
40 |
, exitIfBad |
|
41 |
, exitErr |
|
42 |
, exitWhen |
|
43 |
, exitUnless |
|
44 |
) where |
|
45 |
|
|
46 |
import Data.Char (toUpper, isAlphaNum) |
|
47 |
import Data.List |
|
48 |
|
|
49 |
import Debug.Trace |
|
50 |
|
|
51 |
import Ganeti.BasicTypes |
|
52 |
import System.IO |
|
53 |
import System.Exit |
|
54 |
|
|
55 |
-- * Debug functions |
|
56 |
|
|
57 |
-- | To be used only for debugging, breaks referential integrity. |
|
58 |
debug :: Show a => a -> a |
|
59 |
debug x = trace (show x) x |
|
60 |
|
|
61 |
-- | Displays a modified form of the second parameter before returning |
|
62 |
-- it. |
|
63 |
debugFn :: Show b => (a -> b) -> a -> a |
|
64 |
debugFn fn x = debug (fn x) `seq` x |
|
65 |
|
|
66 |
-- | Show the first parameter before returning the second one. |
|
67 |
debugXy :: Show a => a -> b -> b |
|
68 |
debugXy = seq . debug |
|
69 |
|
|
70 |
-- * Miscellaneous |
|
71 |
|
|
72 |
-- | Apply the function if condition holds, otherwise use default value. |
|
73 |
applyIf :: Bool -> (a -> a) -> a -> a |
|
74 |
applyIf b f x = if b then f x else x |
|
75 |
|
|
76 |
-- | Comma-join a string list. |
|
77 |
commaJoin :: [String] -> String |
|
78 |
commaJoin = intercalate "," |
|
79 |
|
|
80 |
-- | Split a list on a separator and return an array. |
|
81 |
sepSplit :: Eq a => a -> [a] -> [[a]] |
|
82 |
sepSplit sep s |
|
83 |
| null s = [] |
|
84 |
| null xs = [x] |
|
85 |
| null ys = [x,[]] |
|
86 |
| otherwise = x:sepSplit sep ys |
|
87 |
where (x, xs) = break (== sep) s |
|
88 |
ys = drop 1 xs |
|
89 |
|
|
90 |
-- | Simple pluralize helper |
|
91 |
plural :: Int -> String -> String -> String |
|
92 |
plural 1 s _ = s |
|
93 |
plural _ _ p = p |
|
94 |
|
|
95 |
-- | Ensure a value is quoted if needed. |
|
96 |
ensureQuoted :: String -> String |
|
97 |
ensureQuoted v = if not (all (\c -> isAlphaNum c || c == '.') v) |
|
98 |
then '\'':v ++ "'" |
|
99 |
else v |
|
100 |
|
|
101 |
-- * Mathematical functions |
|
102 |
|
|
103 |
-- Simple and slow statistical functions, please replace with better |
|
104 |
-- versions |
|
105 |
|
|
106 |
-- | Standard deviation function. |
|
107 |
stdDev :: [Double] -> Double |
|
108 |
stdDev lst = |
|
109 |
-- first, calculate the list length and sum lst in a single step, |
|
110 |
-- for performance reasons |
|
111 |
let (ll', sx) = foldl' (\(rl, rs) e -> |
|
112 |
let rl' = rl + 1 |
|
113 |
rs' = rs + e |
|
114 |
in rl' `seq` rs' `seq` (rl', rs')) (0::Int, 0) lst |
|
115 |
ll = fromIntegral ll'::Double |
|
116 |
mv = sx / ll |
|
117 |
av = foldl' (\accu em -> let d = em - mv in accu + d * d) 0.0 lst |
|
118 |
in sqrt (av / ll) -- stddev |
|
119 |
|
|
120 |
-- * Logical functions |
|
121 |
|
|
122 |
-- Avoid syntactic sugar and enhance readability. These functions are proposed |
|
123 |
-- by some for inclusion in the Prelude, and at the moment they are present |
|
124 |
-- (with various definitions) in the utility-ht package. Some rationale and |
|
125 |
-- discussion is available at <http://www.haskell.org/haskellwiki/If-then-else> |
|
126 |
|
|
127 |
-- | \"if\" as a function, rather than as syntactic sugar. |
|
128 |
if' :: Bool -- ^ condition |
|
129 |
-> a -- ^ \"then\" result |
|
130 |
-> a -- ^ \"else\" result |
|
131 |
-> a -- ^ \"then\" or "else" result depending on the condition |
|
132 |
if' True x _ = x |
|
133 |
if' _ _ y = y |
|
134 |
|
|
135 |
-- * Parsing utility functions |
|
136 |
|
|
137 |
-- | Parse results from readsPrec. |
|
138 |
parseChoices :: (Monad m, Read a) => String -> String -> [(a, String)] -> m a |
|
139 |
parseChoices _ _ ((v, ""):[]) = return v |
|
140 |
parseChoices name s ((_, e):[]) = |
|
141 |
fail $ name ++ ": leftover characters when parsing '" |
|
142 |
++ s ++ "': '" ++ e ++ "'" |
|
143 |
parseChoices name s _ = fail $ name ++ ": cannot parse string '" ++ s ++ "'" |
|
144 |
|
|
145 |
-- | Safe 'read' function returning data encapsulated in a Result. |
|
146 |
tryRead :: (Monad m, Read a) => String -> String -> m a |
|
147 |
tryRead name s = parseChoices name s $ reads s |
|
148 |
|
|
149 |
-- | Format a table of strings to maintain consistent length. |
|
150 |
formatTable :: [[String]] -> [Bool] -> [[String]] |
|
151 |
formatTable vals numpos = |
|
152 |
let vtrans = transpose vals -- transpose, so that we work on rows |
|
153 |
-- rather than columns |
|
154 |
mlens = map (maximum . map length) vtrans |
|
155 |
expnd = map (\(flds, isnum, ml) -> |
|
156 |
map (\val -> |
|
157 |
let delta = ml - length val |
|
158 |
filler = replicate delta ' ' |
|
159 |
in if delta > 0 |
|
160 |
then if isnum |
|
161 |
then filler ++ val |
|
162 |
else val ++ filler |
|
163 |
else val |
|
164 |
) flds |
|
165 |
) (zip3 vtrans numpos mlens) |
|
166 |
in transpose expnd |
|
167 |
|
|
168 |
-- | Constructs a printable table from given header and rows |
|
169 |
printTable :: String -> [String] -> [[String]] -> [Bool] -> String |
|
170 |
printTable lp header rows isnum = |
|
171 |
unlines . map ((++) lp . (:) ' ' . unwords) $ |
|
172 |
formatTable (header:rows) isnum |
|
173 |
|
|
174 |
-- | Converts a unit (e.g. m or GB) into a scaling factor. |
|
175 |
parseUnitValue :: (Monad m) => String -> m Rational |
|
176 |
parseUnitValue unit |
|
177 |
-- binary conversions first |
|
178 |
| null unit = return 1 |
|
179 |
| unit == "m" || upper == "MIB" = return 1 |
|
180 |
| unit == "g" || upper == "GIB" = return kbBinary |
|
181 |
| unit == "t" || upper == "TIB" = return $ kbBinary * kbBinary |
|
182 |
-- SI conversions |
|
183 |
| unit == "M" || upper == "MB" = return mbFactor |
|
184 |
| unit == "G" || upper == "GB" = return $ mbFactor * kbDecimal |
|
185 |
| unit == "T" || upper == "TB" = return $ mbFactor * kbDecimal * kbDecimal |
|
186 |
| otherwise = fail $ "Unknown unit '" ++ unit ++ "'" |
|
187 |
where upper = map toUpper unit |
|
188 |
kbBinary = 1024 :: Rational |
|
189 |
kbDecimal = 1000 :: Rational |
|
190 |
decToBin = kbDecimal / kbBinary -- factor for 1K conversion |
|
191 |
mbFactor = decToBin * decToBin -- twice the factor for just 1K |
|
192 |
|
|
193 |
-- | Tries to extract number and scale from the given string. |
|
194 |
-- |
|
195 |
-- Input must be in the format NUMBER+ SPACE* [UNIT]. If no unit is |
|
196 |
-- specified, it defaults to MiB. Return value is always an integral |
|
197 |
-- value in MiB. |
|
198 |
parseUnit :: (Monad m, Integral a, Read a) => String -> m a |
|
199 |
parseUnit str = |
|
200 |
-- TODO: enhance this by splitting the unit parsing code out and |
|
201 |
-- accepting floating-point numbers |
|
202 |
case (reads str::[(Int, String)]) of |
|
203 |
[(v, suffix)] -> |
|
204 |
let unit = dropWhile (== ' ') suffix |
|
205 |
in do |
|
206 |
scaling <- parseUnitValue unit |
|
207 |
return $ truncate (fromIntegral v * scaling) |
|
208 |
_ -> fail $ "Can't parse string '" ++ str ++ "'" |
|
209 |
|
|
210 |
-- | Unwraps a 'Result', exiting the program if it is a 'Bad' value, |
|
211 |
-- otherwise returning the actual contained value. |
|
212 |
exitIfBad :: String -> Result a -> IO a |
|
213 |
exitIfBad msg (Bad s) = do |
|
214 |
hPutStrLn stderr $ "Error: " ++ msg ++ ": " ++ s |
|
215 |
exitWith (ExitFailure 1) |
|
216 |
exitIfBad _ (Ok v) = return v |
|
217 |
|
|
218 |
-- | Exits immediately with an error message. |
|
219 |
exitErr :: String -> IO a |
|
220 |
exitErr errmsg = do |
|
221 |
hPutStrLn stderr $ "Error: " ++ errmsg ++ "." |
|
222 |
exitWith (ExitFailure 1) |
|
223 |
|
|
224 |
-- | Exits with an error message if the given boolean condition if true. |
|
225 |
exitWhen :: Bool -> String -> IO () |
|
226 |
exitWhen True msg = exitErr msg |
|
227 |
exitWhen False _ = return () |
|
228 |
|
|
229 |
-- | Exits with an error message /unless/ the given boolean condition |
|
230 |
-- if true, the opposite of 'exitWhen'. |
|
231 |
exitUnless :: Bool -> String -> IO () |
|
232 |
exitUnless cond = exitWhen (not cond) |
b/htools/Ganeti/Luxi.hs | ||
---|---|---|
69 | 69 |
|
70 | 70 |
import Ganeti.JSON |
71 | 71 |
import Ganeti.HTools.Types |
72 |
import Ganeti.HTools.Utils
|
|
72 |
import Ganeti.Utils |
|
73 | 73 |
|
74 | 74 |
import Ganeti.Constants |
75 | 75 |
import Ganeti.Jobs (JobStatus) |
b/htools/Ganeti/Ssconf.hs | ||
---|---|---|
48 | 48 |
import qualified Ganeti.Constants as C |
49 | 49 |
import qualified Ganeti.Path as Path |
50 | 50 |
import Ganeti.BasicTypes |
51 |
import Ganeti.HTools.Utils
|
|
51 |
import Ganeti.Utils |
|
52 | 52 |
|
53 | 53 |
-- | Maximum ssconf file size we support. |
54 | 54 |
maxFileSize :: Int |
b/htools/Ganeti/Utils.hs | ||
---|---|---|
1 |
{-| Utility functions. -} |
|
2 |
|
|
3 |
{- |
|
4 |
|
|
5 |
Copyright (C) 2009, 2010, 2011, 2012 Google Inc. |
|
6 |
|
|
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. |
|
11 |
|
|
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. |
|
16 |
|
|
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 |
|
20 |
02110-1301, USA. |
|
21 |
|
|
22 |
-} |
|
23 |
|
|
24 |
module Ganeti.Utils |
|
25 |
( debug |
|
26 |
, debugFn |
|
27 |
, debugXy |
|
28 |
, sepSplit |
|
29 |
, stdDev |
|
30 |
, if' |
|
31 |
, select |
|
32 |
, applyIf |
|
33 |
, commaJoin |
|
34 |
, ensureQuoted |
|
35 |
, tryRead |
|
36 |
, formatTable |
|
37 |
, printTable |
|
38 |
, parseUnit |
|
39 |
, plural |
|
40 |
, exitIfBad |
|
41 |
, exitErr |
|
42 |
, exitWhen |
|
43 |
, exitUnless |
|
44 |
) where |
|
45 |
|
|
46 |
import Data.Char (toUpper, isAlphaNum) |
|
47 |
import Data.List |
|
48 |
|
|
49 |
import Debug.Trace |
|
50 |
|
|
51 |
import Ganeti.BasicTypes |
|
52 |
import System.IO |
|
53 |
import System.Exit |
|
54 |
|
|
55 |
-- * Debug functions |
|
56 |
|
|
57 |
-- | To be used only for debugging, breaks referential integrity. |
|
58 |
debug :: Show a => a -> a |
|
59 |
debug x = trace (show x) x |
|
60 |
|
|
61 |
-- | Displays a modified form of the second parameter before returning |
|
62 |
-- it. |
|
63 |
debugFn :: Show b => (a -> b) -> a -> a |
|
64 |
debugFn fn x = debug (fn x) `seq` x |
|
65 |
|
|
66 |
-- | Show the first parameter before returning the second one. |
|
67 |
debugXy :: Show a => a -> b -> b |
|
68 |
debugXy = seq . debug |
|
69 |
|
|
70 |
-- * Miscellaneous |
|
71 |
|
|
72 |
-- | Apply the function if condition holds, otherwise use default value. |
|
73 |
applyIf :: Bool -> (a -> a) -> a -> a |
|
74 |
applyIf b f x = if b then f x else x |
|
75 |
|
|
76 |
-- | Comma-join a string list. |
|
77 |
commaJoin :: [String] -> String |
|
78 |
commaJoin = intercalate "," |
|
79 |
|
|
80 |
-- | Split a list on a separator and return an array. |
|
81 |
sepSplit :: Eq a => a -> [a] -> [[a]] |
|
82 |
sepSplit sep s |
|
83 |
| null s = [] |
|
84 |
| null xs = [x] |
|
85 |
| null ys = [x,[]] |
|
86 |
| otherwise = x:sepSplit sep ys |
|
87 |
where (x, xs) = break (== sep) s |
|
88 |
ys = drop 1 xs |
|
89 |
|
|
90 |
-- | Simple pluralize helper |
|
91 |
plural :: Int -> String -> String -> String |
|
92 |
plural 1 s _ = s |
|
93 |
plural _ _ p = p |
|
94 |
|
|
95 |
-- | Ensure a value is quoted if needed. |
|
96 |
ensureQuoted :: String -> String |
|
97 |
ensureQuoted v = if not (all (\c -> isAlphaNum c || c == '.') v) |
|
98 |
then '\'':v ++ "'" |
|
99 |
else v |
|
100 |
|
|
101 |
-- * Mathematical functions |
|
102 |
|
|
103 |
-- Simple and slow statistical functions, please replace with better |
|
104 |
-- versions |
|
105 |
|
|
106 |
-- | Standard deviation function. |
|
107 |
stdDev :: [Double] -> Double |
|
108 |
stdDev lst = |
|
109 |
-- first, calculate the list length and sum lst in a single step, |
|
110 |
-- for performance reasons |
|
111 |
let (ll', sx) = foldl' (\(rl, rs) e -> |
|
112 |
let rl' = rl + 1 |
|
113 |
rs' = rs + e |
|
114 |
in rl' `seq` rs' `seq` (rl', rs')) (0::Int, 0) lst |
|
115 |
ll = fromIntegral ll'::Double |
|
116 |
mv = sx / ll |
|
117 |
av = foldl' (\accu em -> let d = em - mv in accu + d * d) 0.0 lst |
|
118 |
in sqrt (av / ll) -- stddev |
|
119 |
|
|
120 |
-- * Logical functions |
|
121 |
|
|
122 |
-- Avoid syntactic sugar and enhance readability. These functions are proposed |
|
123 |
-- by some for inclusion in the Prelude, and at the moment they are present |
|
124 |
-- (with various definitions) in the utility-ht package. Some rationale and |
|
125 |
-- discussion is available at <http://www.haskell.org/haskellwiki/If-then-else> |
|
126 |
|
|
127 |
-- | \"if\" as a function, rather than as syntactic sugar. |
|
128 |
if' :: Bool -- ^ condition |
|
129 |
-> a -- ^ \"then\" result |
|
130 |
-> a -- ^ \"else\" result |
|
131 |
-> a -- ^ \"then\" or "else" result depending on the condition |
|
132 |
if' True x _ = x |
|
133 |
if' _ _ y = y |
|
134 |
|
|
135 |
-- * Parsing utility functions |
|
136 |
|
|
137 |
-- | Parse results from readsPrec. |
|
138 |
parseChoices :: (Monad m, Read a) => String -> String -> [(a, String)] -> m a |
|
139 |
parseChoices _ _ ((v, ""):[]) = return v |
|
140 |
parseChoices name s ((_, e):[]) = |
|
141 |
fail $ name ++ ": leftover characters when parsing '" |
|
142 |
++ s ++ "': '" ++ e ++ "'" |
|
143 |
parseChoices name s _ = fail $ name ++ ": cannot parse string '" ++ s ++ "'" |
|
144 |
|
|
145 |
-- | Safe 'read' function returning data encapsulated in a Result. |
|
146 |
tryRead :: (Monad m, Read a) => String -> String -> m a |
|
147 |
tryRead name s = parseChoices name s $ reads s |
|
148 |
|
|
149 |
-- | Format a table of strings to maintain consistent length. |
|
150 |
formatTable :: [[String]] -> [Bool] -> [[String]] |
|
151 |
formatTable vals numpos = |
|
152 |
let vtrans = transpose vals -- transpose, so that we work on rows |
|
153 |
-- rather than columns |
|
154 |
mlens = map (maximum . map length) vtrans |
|
155 |
expnd = map (\(flds, isnum, ml) -> |
|
156 |
map (\val -> |
|
157 |
let delta = ml - length val |
|
158 |
filler = replicate delta ' ' |
|
159 |
in if delta > 0 |
|
160 |
then if isnum |
|
161 |
then filler ++ val |
|
162 |
else val ++ filler |
|
163 |
else val |
|
164 |
) flds |
|
165 |
) (zip3 vtrans numpos mlens) |
|
166 |
in transpose expnd |
|
167 |
|
|
168 |
-- | Constructs a printable table from given header and rows |
|
169 |
printTable :: String -> [String] -> [[String]] -> [Bool] -> String |
|
170 |
printTable lp header rows isnum = |
|
171 |
unlines . map ((++) lp . (:) ' ' . unwords) $ |
|
172 |
formatTable (header:rows) isnum |
|
173 |
|
|
174 |
-- | Converts a unit (e.g. m or GB) into a scaling factor. |
|
175 |
parseUnitValue :: (Monad m) => String -> m Rational |
|
176 |
parseUnitValue unit |
|
177 |
-- binary conversions first |
|
178 |
| null unit = return 1 |
|
179 |
| unit == "m" || upper == "MIB" = return 1 |
|
180 |
| unit == "g" || upper == "GIB" = return kbBinary |
|
181 |
| unit == "t" || upper == "TIB" = return $ kbBinary * kbBinary |
|
182 |
-- SI conversions |
|
183 |
| unit == "M" || upper == "MB" = return mbFactor |
|
184 |
| unit == "G" || upper == "GB" = return $ mbFactor * kbDecimal |
|
185 |
| unit == "T" || upper == "TB" = return $ mbFactor * kbDecimal * kbDecimal |
|
186 |
| otherwise = fail $ "Unknown unit '" ++ unit ++ "'" |
|
187 |
where upper = map toUpper unit |
|
188 |
kbBinary = 1024 :: Rational |
|
189 |
kbDecimal = 1000 :: Rational |
|
190 |
decToBin = kbDecimal / kbBinary -- factor for 1K conversion |
|
191 |
mbFactor = decToBin * decToBin -- twice the factor for just 1K |
|
192 |
|
|
193 |
-- | Tries to extract number and scale from the given string. |
|
194 |
-- |
|
195 |
-- Input must be in the format NUMBER+ SPACE* [UNIT]. If no unit is |
|
196 |
-- specified, it defaults to MiB. Return value is always an integral |
|
197 |
-- value in MiB. |
|
198 |
parseUnit :: (Monad m, Integral a, Read a) => String -> m a |
|
199 |
parseUnit str = |
|
200 |
-- TODO: enhance this by splitting the unit parsing code out and |
|
201 |
-- accepting floating-point numbers |
|
202 |
case (reads str::[(Int, String)]) of |
|
203 |
[(v, suffix)] -> |
|
204 |
let unit = dropWhile (== ' ') suffix |
|
205 |
in do |
|
206 |
scaling <- parseUnitValue unit |
|
207 |
return $ truncate (fromIntegral v * scaling) |
|
208 |
_ -> fail $ "Can't parse string '" ++ str ++ "'" |
|
209 |
|
|
210 |
-- | Unwraps a 'Result', exiting the program if it is a 'Bad' value, |
|
211 |
-- otherwise returning the actual contained value. |
|
212 |
exitIfBad :: String -> Result a -> IO a |
|
213 |
exitIfBad msg (Bad s) = do |
|
214 |
hPutStrLn stderr $ "Error: " ++ msg ++ ": " ++ s |
|
215 |
exitWith (ExitFailure 1) |
|
216 |
exitIfBad _ (Ok v) = return v |
|
217 |
|
|
218 |
-- | Exits immediately with an error message. |
|
219 |
exitErr :: String -> IO a |
|
220 |
exitErr errmsg = do |
|
221 |
hPutStrLn stderr $ "Error: " ++ errmsg ++ "." |
|
222 |
exitWith (ExitFailure 1) |
|
223 |
|
|
224 |
-- | Exits with an error message if the given boolean condition if true. |
|
225 |
exitWhen :: Bool -> String -> IO () |
|
226 |
exitWhen True msg = exitErr msg |
|
227 |
exitWhen False _ = return () |
|
228 |
|
|
229 |
-- | Exits with an error message /unless/ the given boolean condition |
|
230 |
-- if true, the opposite of 'exitWhen'. |
|
231 |
exitUnless :: Bool -> String -> IO () |
|
232 |
exitUnless cond = exitWhen (not cond) |
b/htools/htools.hs | ||
---|---|---|
34 | 34 |
import System.IO |
35 | 35 |
import System.IO.Error (isDoesNotExistError) |
36 | 36 |
|
37 |
import Ganeti.HTools.Utils
|
|
37 |
import Ganeti.Utils |
|
38 | 38 |
import Ganeti.HTools.CLI (parseOpts, genericOpts) |
39 | 39 |
import Ganeti.HTools.Program (personalities) |
40 | 40 |
|
Also available in: Unified diff