This is, I believe, the last non-htools specific file that still lived in the htools directory; it's already widely used in non-htools code, so let's move it before we add more functionality to this module.
All changes are related to the name change, imports fixup, etc.; there are no other changes in this patch. Signed-off-by: Iustin Pop <[email protected]> --- Makefile.am | 8 +- htest/Test/Ganeti/HTools/Text.hs | 2 +- htest/Test/Ganeti/HTools/Utils.hs | 132 ------------------ htest/Test/Ganeti/Utils.hs | 132 ++++++++++++++++++ htest/test.hs | 4 +- htools/Ganeti/Confd/Server.hs | 2 +- htools/Ganeti/Confd/Utils.hs | 2 +- htools/Ganeti/Daemon.hs | 2 +- htools/Ganeti/HTools/CLI.hs | 4 +- htools/Ganeti/HTools/Cluster.hs | 2 +- htools/Ganeti/HTools/ExtLoader.hs | 2 +- htools/Ganeti/HTools/Instance.hs | 2 +- htools/Ganeti/HTools/Loader.hs | 2 +- htools/Ganeti/HTools/Program/Hbal.hs | 2 +- htools/Ganeti/HTools/Program/Hinfo.hs | 2 +- htools/Ganeti/HTools/Program/Hspace.hs | 2 +- htools/Ganeti/HTools/Simu.hs | 2 +- htools/Ganeti/HTools/Text.hs | 2 +- htools/Ganeti/HTools/Utils.hs | 232 -------------------------------- htools/Ganeti/Luxi.hs | 2 +- htools/Ganeti/Ssconf.hs | 2 +- htools/Ganeti/Utils.hs | 232 ++++++++++++++++++++++++++++++++ htools/htools.hs | 2 +- 23 files changed, 388 insertions(+), 388 deletions(-) delete mode 100644 htest/Test/Ganeti/HTools/Utils.hs create mode 100644 htest/Test/Ganeti/Utils.hs delete mode 100644 htools/Ganeti/HTools/Utils.hs create mode 100644 htools/Ganeti/Utils.hs diff --git a/Makefile.am b/Makefile.am index ee74e2c..b861318 100644 --- a/Makefile.am +++ b/Makefile.am @@ -420,7 +420,6 @@ HS_LIB_SRCS = \ htools/Ganeti/HTools/Simu.hs \ htools/Ganeti/HTools/Text.hs \ htools/Ganeti/HTools/Types.hs \ - htools/Ganeti/HTools/Utils.hs \ htools/Ganeti/HTools/Program.hs \ htools/Ganeti/HTools/Program/Hail.hs \ htools/Ganeti/HTools/Program/Hbal.hs \ @@ -455,7 +454,8 @@ HS_LIB_SRCS = \ htools/Ganeti/Rpc.hs \ htools/Ganeti/Runtime.hs \ htools/Ganeti/Ssconf.hs \ - htools/Ganeti/THH.hs + htools/Ganeti/THH.hs \ + htools/Ganeti/Utils.hs HS_TEST_SRCS = \ htest/Test/Ganeti/BasicTypes.hs \ @@ -472,7 +472,6 @@ HS_TEST_SRCS = \ htest/Test/Ganeti/HTools/Simu.hs \ htest/Test/Ganeti/HTools/Text.hs \ htest/Test/Ganeti/HTools/Types.hs \ - htest/Test/Ganeti/HTools/Utils.hs \ htest/Test/Ganeti/JSON.hs \ htest/Test/Ganeti/Jobs.hs \ htest/Test/Ganeti/Luxi.hs \ @@ -485,7 +484,8 @@ HS_TEST_SRCS = \ htest/Test/Ganeti/Ssconf.hs \ htest/Test/Ganeti/TestCommon.hs \ htest/Test/Ganeti/TestHTools.hs \ - htest/Test/Ganeti/TestHelper.hs + htest/Test/Ganeti/TestHelper.hs \ + htest/Test/Ganeti/Utils.hs HS_LIBTEST_SRCS = $(HS_LIB_SRCS) $(HS_TEST_SRCS) diff --git a/htest/Test/Ganeti/HTools/Text.hs b/htest/Test/Ganeti/HTools/Text.hs index c1c23c5..d64cb17 100644 --- a/htest/Test/Ganeti/HTools/Text.hs +++ b/htest/Test/Ganeti/HTools/Text.hs @@ -48,7 +48,7 @@ import qualified Ganeti.HTools.Loader as Loader import qualified Ganeti.HTools.Node as Node import qualified Ganeti.HTools.Text as Text import qualified Ganeti.HTools.Types as Types -import qualified Ganeti.HTools.Utils as Utils +import qualified Ganeti.Utils as Utils -- * Instance text loader tests diff --git a/htest/Test/Ganeti/HTools/Utils.hs b/htest/Test/Ganeti/HTools/Utils.hs deleted file mode 100644 index abb3e32..0000000 --- a/htest/Test/Ganeti/HTools/Utils.hs +++ /dev/null @@ -1,132 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} - -{-| Unittests for ganeti-htools. - --} - -{- - -Copyright (C) 2009, 2010, 2011, 2012 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 -the Free Software Foundation; either version 2 of the License, or -(at your option) any later version. - -This program is distributed in the hope that it will be useful, but -WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -General Public License for more details. - -You should have received a copy of the GNU General Public License -along with this program; if not, write to the Free Software -Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA -02110-1301, USA. - --} - -module Test.Ganeti.HTools.Utils (testHTools_Utils) where - -import Test.QuickCheck - -import qualified Text.JSON as J - -import Test.Ganeti.TestHelper -import Test.Ganeti.TestCommon - -import qualified Ganeti.JSON as JSON -import qualified Ganeti.HTools.Types as Types -import qualified Ganeti.HTools.Utils as Utils - --- | Helper to generate a small string that doesn't contain commas. -genNonCommaString :: Gen String -genNonCommaString = do - size <- choose (0, 20) -- arbitrary max size - vectorOf size (arbitrary `suchThat` (/=) ',') - --- | If the list is not just an empty element, and if the elements do --- not contain commas, then join+split should be idempotent. -prop_commaJoinSplit :: Property -prop_commaJoinSplit = - forAll (choose (0, 20)) $ \llen -> - forAll (vectorOf llen genNonCommaString `suchThat` (/=) [""]) $ \lst -> - Utils.sepSplit ',' (Utils.commaJoin lst) ==? lst - --- | Split and join should always be idempotent. -prop_commaSplitJoin :: String -> Property -prop_commaSplitJoin s = - Utils.commaJoin (Utils.sepSplit ',' s) ==? s - --- | fromObjWithDefault, we test using the Maybe monad and an integer --- value. -prop_fromObjWithDefault :: Integer -> String -> Bool -prop_fromObjWithDefault def_value random_key = - -- a missing key will be returned with the default - JSON.fromObjWithDefault [] random_key def_value == Just def_value && - -- a found key will be returned as is, not with default - JSON.fromObjWithDefault [(random_key, J.showJSON def_value)] - random_key (def_value+1) == Just def_value - --- | Test that functional if' behaves like the syntactic sugar if. -prop_if'if :: Bool -> Int -> Int -> Gen Prop -prop_if'if cnd a b = - Utils.if' cnd a b ==? if cnd then a else b - --- | Test basic select functionality -prop_select :: Int -- ^ Default result - -> [Int] -- ^ List of False values - -> [Int] -- ^ List of True values - -> Gen Prop -- ^ Test result -prop_select def lst1 lst2 = - Utils.select def (flist ++ tlist) ==? expectedresult - where expectedresult = Utils.if' (null lst2) def (head lst2) - flist = zip (repeat False) lst1 - tlist = zip (repeat True) lst2 - --- | Test basic select functionality with undefined default -prop_select_undefd :: [Int] -- ^ List of False values - -> NonEmptyList Int -- ^ List of True values - -> Gen Prop -- ^ Test result -prop_select_undefd lst1 (NonEmpty lst2) = - Utils.select undefined (flist ++ tlist) ==? head lst2 - where flist = zip (repeat False) lst1 - tlist = zip (repeat True) lst2 - --- | Test basic select functionality with undefined list values -prop_select_undefv :: [Int] -- ^ List of False values - -> NonEmptyList Int -- ^ List of True values - -> Gen Prop -- ^ Test result -prop_select_undefv lst1 (NonEmpty lst2) = - Utils.select undefined cndlist ==? head lst2 - where flist = zip (repeat False) lst1 - tlist = zip (repeat True) lst2 - cndlist = flist ++ tlist ++ [undefined] - -prop_parseUnit :: NonNegative Int -> Property -prop_parseUnit (NonNegative n) = - Utils.parseUnit (show n) ==? Types.Ok n .&&. - Utils.parseUnit (show n ++ "m") ==? Types.Ok n .&&. - Utils.parseUnit (show n ++ "M") ==? Types.Ok (truncate n_mb::Int) .&&. - Utils.parseUnit (show n ++ "g") ==? Types.Ok (n*1024) .&&. - Utils.parseUnit (show n ++ "G") ==? Types.Ok (truncate n_gb::Int) .&&. - Utils.parseUnit (show n ++ "t") ==? Types.Ok (n*1048576) .&&. - Utils.parseUnit (show n ++ "T") ==? Types.Ok (truncate n_tb::Int) .&&. - printTestCase "Internal error/overflow?" - (n_mb >=0 && n_gb >= 0 && n_tb >= 0) .&&. - property (Types.isBad (Utils.parseUnit (show n ++ "x")::Types.Result Int)) - where n_mb = (fromIntegral n::Rational) * 1000 * 1000 / 1024 / 1024 - n_gb = n_mb * 1000 - n_tb = n_gb * 1000 - --- | Test list for the Utils module. -testSuite "HTools/Utils" - [ 'prop_commaJoinSplit - , 'prop_commaSplitJoin - , 'prop_fromObjWithDefault - , 'prop_if'if - , 'prop_select - , 'prop_select_undefd - , 'prop_select_undefv - , 'prop_parseUnit - ] diff --git a/htest/Test/Ganeti/Utils.hs b/htest/Test/Ganeti/Utils.hs new file mode 100644 index 0000000..e2ce7d7 --- /dev/null +++ b/htest/Test/Ganeti/Utils.hs @@ -0,0 +1,132 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + +{-| Unittests for ganeti-htools. + +-} + +{- + +Copyright (C) 2009, 2010, 2011, 2012 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 +the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +This program is distributed in the hope that it will be useful, but +WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +General Public License for more details. + +You should have received a copy of the GNU General Public License +along with this program; if not, write to the Free Software +Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA +02110-1301, USA. + +-} + +module Test.Ganeti.Utils (testUtils) where + +import Test.QuickCheck + +import qualified Text.JSON as J + +import Test.Ganeti.TestHelper +import Test.Ganeti.TestCommon + +import qualified Ganeti.JSON as JSON +import qualified Ganeti.HTools.Types as Types +import qualified Ganeti.Utils as Utils + +-- | Helper to generate a small string that doesn't contain commas. +genNonCommaString :: Gen String +genNonCommaString = do + size <- choose (0, 20) -- arbitrary max size + vectorOf size (arbitrary `suchThat` (/=) ',') + +-- | If the list is not just an empty element, and if the elements do +-- not contain commas, then join+split should be idempotent. +prop_commaJoinSplit :: Property +prop_commaJoinSplit = + forAll (choose (0, 20)) $ \llen -> + forAll (vectorOf llen genNonCommaString `suchThat` (/=) [""]) $ \lst -> + Utils.sepSplit ',' (Utils.commaJoin lst) ==? lst + +-- | Split and join should always be idempotent. +prop_commaSplitJoin :: String -> Property +prop_commaSplitJoin s = + Utils.commaJoin (Utils.sepSplit ',' s) ==? s + +-- | fromObjWithDefault, we test using the Maybe monad and an integer +-- value. +prop_fromObjWithDefault :: Integer -> String -> Bool +prop_fromObjWithDefault def_value random_key = + -- a missing key will be returned with the default + JSON.fromObjWithDefault [] random_key def_value == Just def_value && + -- a found key will be returned as is, not with default + JSON.fromObjWithDefault [(random_key, J.showJSON def_value)] + random_key (def_value+1) == Just def_value + +-- | Test that functional if' behaves like the syntactic sugar if. +prop_if'if :: Bool -> Int -> Int -> Gen Prop +prop_if'if cnd a b = + Utils.if' cnd a b ==? if cnd then a else b + +-- | Test basic select functionality +prop_select :: Int -- ^ Default result + -> [Int] -- ^ List of False values + -> [Int] -- ^ List of True values + -> Gen Prop -- ^ Test result +prop_select def lst1 lst2 = + Utils.select def (flist ++ tlist) ==? expectedresult + where expectedresult = Utils.if' (null lst2) def (head lst2) + flist = zip (repeat False) lst1 + tlist = zip (repeat True) lst2 + +-- | Test basic select functionality with undefined default +prop_select_undefd :: [Int] -- ^ List of False values + -> NonEmptyList Int -- ^ List of True values + -> Gen Prop -- ^ Test result +prop_select_undefd lst1 (NonEmpty lst2) = + Utils.select undefined (flist ++ tlist) ==? head lst2 + where flist = zip (repeat False) lst1 + tlist = zip (repeat True) lst2 + +-- | Test basic select functionality with undefined list values +prop_select_undefv :: [Int] -- ^ List of False values + -> NonEmptyList Int -- ^ List of True values + -> Gen Prop -- ^ Test result +prop_select_undefv lst1 (NonEmpty lst2) = + Utils.select undefined cndlist ==? head lst2 + where flist = zip (repeat False) lst1 + tlist = zip (repeat True) lst2 + cndlist = flist ++ tlist ++ [undefined] + +prop_parseUnit :: NonNegative Int -> Property +prop_parseUnit (NonNegative n) = + Utils.parseUnit (show n) ==? Types.Ok n .&&. + Utils.parseUnit (show n ++ "m") ==? Types.Ok n .&&. + Utils.parseUnit (show n ++ "M") ==? Types.Ok (truncate n_mb::Int) .&&. + Utils.parseUnit (show n ++ "g") ==? Types.Ok (n*1024) .&&. + Utils.parseUnit (show n ++ "G") ==? Types.Ok (truncate n_gb::Int) .&&. + Utils.parseUnit (show n ++ "t") ==? Types.Ok (n*1048576) .&&. + Utils.parseUnit (show n ++ "T") ==? Types.Ok (truncate n_tb::Int) .&&. + printTestCase "Internal error/overflow?" + (n_mb >=0 && n_gb >= 0 && n_tb >= 0) .&&. + property (Types.isBad (Utils.parseUnit (show n ++ "x")::Types.Result Int)) + where n_mb = (fromIntegral n::Rational) * 1000 * 1000 / 1024 / 1024 + n_gb = n_mb * 1000 + n_tb = n_gb * 1000 + +-- | Test list for the Utils module. +testSuite "Utils" + [ 'prop_commaJoinSplit + , 'prop_commaSplitJoin + , 'prop_fromObjWithDefault + , 'prop_if'if + , 'prop_select + , 'prop_select_undefd + , 'prop_select_undefv + , 'prop_parseUnit + ] diff --git a/htest/test.hs b/htest/test.hs index 9e00d36..9100095 100644 --- a/htest/test.hs +++ b/htest/test.hs @@ -44,7 +44,6 @@ import Test.Ganeti.HTools.PeerMap import Test.Ganeti.HTools.Simu import Test.Ganeti.HTools.Text import Test.Ganeti.HTools.Types -import Test.Ganeti.HTools.Utils import Test.Ganeti.Jobs import Test.Ganeti.JSON import Test.Ganeti.Luxi @@ -55,6 +54,7 @@ import Test.Ganeti.Query.Language import Test.Ganeti.Query.Query import Test.Ganeti.Rpc import Test.Ganeti.Ssconf +import Test.Ganeti.Utils -- | Our default test options, overring the built-in test-framework -- ones (but not the supplied command line parameters). @@ -85,7 +85,6 @@ allTests = , testHTools_Simu , testHTools_Text , testHTools_Types - , testHTools_Utils , testJSON , testJobs , testLuxi @@ -96,6 +95,7 @@ allTests = , testQuery_Query , testRpc , testSsconf + , testUtils ] -- | Main function. Note we don't use defaultMain since we want to diff --git a/htools/Ganeti/Confd/Server.hs b/htools/Ganeti/Confd/Server.hs index b14eb43..5644f11 100644 --- a/htools/Ganeti/Confd/Server.hs +++ b/htools/Ganeti/Confd/Server.hs @@ -47,13 +47,13 @@ import System.INotify import Ganeti.Daemon import Ganeti.JSON import Ganeti.HTools.Types -import Ganeti.HTools.Utils import Ganeti.Objects import Ganeti.Confd import Ganeti.Confd.Utils import Ganeti.Config import Ganeti.Hash import Ganeti.Logging +import Ganeti.Utils import qualified Ganeti.Constants as C import qualified Ganeti.Path as Path import Ganeti.Query.Server (runQueryD) diff --git a/htools/Ganeti/Confd/Utils.hs b/htools/Ganeti/Confd/Utils.hs index 043ded0..01c7ee7 100644 --- a/htools/Ganeti/Confd/Utils.hs +++ b/htools/Ganeti/Confd/Utils.hs @@ -42,7 +42,7 @@ import Ganeti.Hash import qualified Ganeti.Constants as C import qualified Ganeti.Path as Path import Ganeti.JSON -import Ganeti.HTools.Utils +import Ganeti.Utils -- | Returns the HMAC key. getClusterHmac :: IO HashKey diff --git a/htools/Ganeti/Daemon.hs b/htools/Ganeti/Daemon.hs index 2b715b5..1a53086 100644 --- a/htools/Ganeti/Daemon.hs +++ b/htools/Ganeti/Daemon.hs @@ -65,7 +65,7 @@ import Ganeti.Common as Common import Ganeti.Logging import Ganeti.Runtime import Ganeti.BasicTypes -import Ganeti.HTools.Utils +import Ganeti.Utils import qualified Ganeti.Constants as C import qualified Ganeti.Ssconf as Ssconf diff --git a/htools/Ganeti/HTools/CLI.hs b/htools/Ganeti/HTools/CLI.hs index fee8df8..67b51a1 100644 --- a/htools/Ganeti/HTools/CLI.hs +++ b/htools/Ganeti/HTools/CLI.hs @@ -1,7 +1,7 @@ {-| Implementation of command-line functions. This module holds the common command-line related functions for the -binaries, separated into this module since "Ganeti.HTools.Utils" is +binaries, separated into this module since "Ganeti.Utils" is used in many other places and this is more IO oriented. -} @@ -95,9 +95,9 @@ import qualified Ganeti.HTools.Container as Container import qualified Ganeti.HTools.Node as Node import qualified Ganeti.Path as Path import Ganeti.HTools.Types -import Ganeti.HTools.Utils import Ganeti.BasicTypes import Ganeti.Common as Common +import Ganeti.Utils -- * Data types diff --git a/htools/Ganeti/HTools/Cluster.hs b/htools/Ganeti/HTools/Cluster.hs index deb56dd..b36b5de 100644 --- a/htools/Ganeti/HTools/Cluster.hs +++ b/htools/Ganeti/HTools/Cluster.hs @@ -86,9 +86,9 @@ import qualified Ganeti.HTools.Instance as Instance import qualified Ganeti.HTools.Node as Node import qualified Ganeti.HTools.Group as Group import Ganeti.HTools.Types -import Ganeti.HTools.Utils import Ganeti.Compat import qualified Ganeti.OpCodes as OpCodes +import Ganeti.Utils -- * Types diff --git a/htools/Ganeti/HTools/ExtLoader.hs b/htools/Ganeti/HTools/ExtLoader.hs index 797a66f..2ecd100 100644 --- a/htools/Ganeti/HTools/ExtLoader.hs +++ b/htools/Ganeti/HTools/ExtLoader.hs @@ -51,7 +51,7 @@ import Ganeti.HTools.Loader (mergeData, checkData, ClusterData(..) import Ganeti.HTools.Types import Ganeti.HTools.CLI -import Ganeti.HTools.Utils (sepSplit, tryRead, exitIfBad, exitWhen) +import Ganeti.Utils (sepSplit, tryRead, exitIfBad, exitWhen) -- | Error beautifier. wrapIO :: IO (Result a) -> IO (Result a) diff --git a/htools/Ganeti/HTools/Instance.hs b/htools/Ganeti/HTools/Instance.hs index 9d13556..62803ff 100644 --- a/htools/Ganeti/HTools/Instance.hs +++ b/htools/Ganeti/HTools/Instance.hs @@ -60,7 +60,7 @@ module Ganeti.HTools.Instance import qualified Ganeti.HTools.Types as T import qualified Ganeti.HTools.Container as Container -import Ganeti.HTools.Utils +import Ganeti.Utils -- * Type declarations diff --git a/htools/Ganeti/HTools/Loader.hs b/htools/Ganeti/HTools/Loader.hs index 71893e3..9acf96d 100644 --- a/htools/Ganeti/HTools/Loader.hs +++ b/htools/Ganeti/HTools/Loader.hs @@ -52,7 +52,7 @@ import qualified Ganeti.HTools.Cluster as Cluster import Ganeti.BasicTypes import Ganeti.HTools.Types -import Ganeti.HTools.Utils +import Ganeti.Utils -- * Constants diff --git a/htools/Ganeti/HTools/Program/Hbal.hs b/htools/Ganeti/HTools/Program/Hbal.hs index dc103d3..90a056e 100644 --- a/htools/Ganeti/HTools/Program/Hbal.hs +++ b/htools/Ganeti/HTools/Program/Hbal.hs @@ -50,9 +50,9 @@ import qualified Ganeti.HTools.Instance as Instance import Ganeti.HTools.CLI import Ganeti.HTools.ExtLoader -import Ganeti.HTools.Utils import Ganeti.HTools.Types import Ganeti.HTools.Loader +import Ganeti.Utils import qualified Ganeti.Luxi as L import Ganeti.Jobs diff --git a/htools/Ganeti/HTools/Program/Hinfo.hs b/htools/Ganeti/HTools/Program/Hinfo.hs index 37f5bba..2c5200e 100644 --- a/htools/Ganeti/HTools/Program/Hinfo.hs +++ b/htools/Ganeti/HTools/Program/Hinfo.hs @@ -38,10 +38,10 @@ import qualified Ganeti.HTools.Node as Node import qualified Ganeti.HTools.Group as Group import qualified Ganeti.HTools.Instance as Instance -import Ganeti.HTools.Utils import Ganeti.HTools.CLI import Ganeti.HTools.ExtLoader import Ganeti.HTools.Loader +import Ganeti.Utils -- | Options list and functions. options :: [OptType] diff --git a/htools/Ganeti/HTools/Program/Hspace.hs b/htools/Ganeti/HTools/Program/Hspace.hs index 960d4fd..605b4ff 100644 --- a/htools/Ganeti/HTools/Program/Hspace.hs +++ b/htools/Ganeti/HTools/Program/Hspace.hs @@ -40,11 +40,11 @@ import qualified Ganeti.HTools.Cluster as Cluster import qualified Ganeti.HTools.Node as Node import qualified Ganeti.HTools.Instance as Instance -import Ganeti.HTools.Utils import Ganeti.HTools.Types import Ganeti.HTools.CLI import Ganeti.HTools.ExtLoader import Ganeti.HTools.Loader +import Ganeti.Utils -- | Options list and functions. options :: [OptType] diff --git a/htools/Ganeti/HTools/Simu.hs b/htools/Ganeti/HTools/Simu.hs index ec8b8b6..2e61ed7 100644 --- a/htools/Ganeti/HTools/Simu.hs +++ b/htools/Ganeti/HTools/Simu.hs @@ -33,7 +33,7 @@ module Ganeti.HTools.Simu import Control.Monad (mplus, zipWithM) import Text.Printf (printf) -import Ganeti.HTools.Utils +import Ganeti.Utils import Ganeti.HTools.Types import Ganeti.HTools.Loader import qualified Ganeti.HTools.Container as Container diff --git a/htools/Ganeti/HTools/Text.hs b/htools/Ganeti/HTools/Text.hs index 39a568c..3731bcc 100644 --- a/htools/Ganeti/HTools/Text.hs +++ b/htools/Ganeti/HTools/Text.hs @@ -47,7 +47,7 @@ import Data.List import Text.Printf (printf) -import Ganeti.HTools.Utils +import Ganeti.Utils import Ganeti.HTools.Loader import Ganeti.HTools.Types import qualified Ganeti.HTools.Container as Container diff --git a/htools/Ganeti/HTools/Utils.hs b/htools/Ganeti/HTools/Utils.hs deleted file mode 100644 index 0efe7fe..0000000 --- a/htools/Ganeti/HTools/Utils.hs +++ /dev/null @@ -1,232 +0,0 @@ -{-| Utility functions. -} - -{- - -Copyright (C) 2009, 2010, 2011, 2012 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 -the Free Software Foundation; either version 2 of the License, or -(at your option) any later version. - -This program is distributed in the hope that it will be useful, but -WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -General Public License for more details. - -You should have received a copy of the GNU General Public License -along with this program; if not, write to the Free Software -Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA -02110-1301, USA. - --} - -module Ganeti.HTools.Utils - ( debug - , debugFn - , debugXy - , sepSplit - , stdDev - , if' - , select - , applyIf - , commaJoin - , ensureQuoted - , tryRead - , formatTable - , printTable - , parseUnit - , plural - , exitIfBad - , exitErr - , exitWhen - , exitUnless - ) where - -import Data.Char (toUpper, isAlphaNum) -import Data.List - -import Debug.Trace - -import Ganeti.BasicTypes -import System.IO -import System.Exit - --- * Debug functions - --- | To be used only for debugging, breaks referential integrity. -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 = seq . debug - --- * Miscellaneous - --- | Apply the function if condition holds, otherwise use default value. -applyIf :: Bool -> (a -> a) -> a -> a -applyIf b f x = if b then f x else x - --- | Comma-join a string list. -commaJoin :: [String] -> String -commaJoin = intercalate "," - --- | Split a list on a separator and return an array. -sepSplit :: Eq a => a -> [a] -> [[a]] -sepSplit sep s - | null s = [] - | null xs = [x] - | null ys = [x,[]] - | otherwise = x:sepSplit sep ys - where (x, xs) = break (== sep) s - ys = drop 1 xs - --- | Simple pluralize helper -plural :: Int -> String -> String -> String -plural 1 s _ = s -plural _ _ p = p - --- | Ensure a value is quoted if needed. -ensureQuoted :: String -> String -ensureQuoted v = if not (all (\c -> isAlphaNum c || c == '.') v) - then '\'':v ++ "'" - else v - --- * Mathematical functions - --- Simple and slow statistical functions, please replace with better --- versions - --- | Standard deviation function. -stdDev :: [Double] -> Double -stdDev lst = - -- 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 - in sqrt (av / ll) -- stddev - --- * Logical functions - --- Avoid syntactic sugar and enhance readability. These functions are proposed --- by some for inclusion in the Prelude, and at the moment they are present --- (with various definitions) in the utility-ht package. Some rationale and --- discussion is available at <http://www.haskell.org/haskellwiki/If-then-else> - --- | \"if\" as a function, rather than as syntactic sugar. -if' :: Bool -- ^ condition - -> a -- ^ \"then\" result - -> a -- ^ \"else\" result - -> a -- ^ \"then\" or "else" result depending on the condition -if' True x _ = x -if' _ _ y = y - --- * Parsing utility functions - --- | Parse results from readsPrec. -parseChoices :: (Monad m, Read a) => String -> String -> [(a, String)] -> m a -parseChoices _ _ ((v, ""):[]) = return v -parseChoices name s ((_, e):[]) = - fail $ name ++ ": leftover characters when parsing '" - ++ s ++ "': '" ++ e ++ "'" -parseChoices name s _ = fail $ name ++ ": cannot parse string '" ++ s ++ "'" - --- | Safe 'read' function returning data encapsulated in a Result. -tryRead :: (Monad m, Read a) => String -> String -> m a -tryRead name s = parseChoices name s $ reads s - --- | Format a table of strings to maintain consistent length. -formatTable :: [[String]] -> [Bool] -> [[String]] -formatTable vals numpos = - let vtrans = transpose vals -- transpose, so that we work on rows - -- rather than columns - mlens = map (maximum . map length) vtrans - expnd = map (\(flds, isnum, ml) -> - map (\val -> - let delta = ml - length val - filler = replicate delta ' ' - in if delta > 0 - then if isnum - then filler ++ val - else val ++ filler - else val - ) flds - ) (zip3 vtrans numpos mlens) - in transpose expnd - --- | Constructs a printable table from given header and rows -printTable :: String -> [String] -> [[String]] -> [Bool] -> String -printTable lp header rows isnum = - unlines . map ((++) lp . (:) ' ' . unwords) $ - formatTable (header:rows) isnum - --- | Converts a unit (e.g. m or GB) into a scaling factor. -parseUnitValue :: (Monad m) => String -> m Rational -parseUnitValue unit - -- binary conversions first - | null unit = return 1 - | unit == "m" || upper == "MIB" = return 1 - | unit == "g" || upper == "GIB" = return kbBinary - | unit == "t" || upper == "TIB" = return $ kbBinary * kbBinary - -- SI conversions - | unit == "M" || upper == "MB" = return mbFactor - | unit == "G" || upper == "GB" = return $ mbFactor * kbDecimal - | unit == "T" || upper == "TB" = return $ mbFactor * kbDecimal * kbDecimal - | otherwise = fail $ "Unknown unit '" ++ unit ++ "'" - where upper = map toUpper unit - kbBinary = 1024 :: Rational - kbDecimal = 1000 :: Rational - decToBin = kbDecimal / kbBinary -- factor for 1K conversion - mbFactor = decToBin * decToBin -- twice the factor for just 1K - --- | Tries to extract number and scale from the given string. --- --- Input must be in the format NUMBER+ SPACE* [UNIT]. If no unit is --- specified, it defaults to MiB. Return value is always an integral --- value in MiB. -parseUnit :: (Monad m, Integral a, Read a) => String -> m a -parseUnit str = - -- TODO: enhance this by splitting the unit parsing code out and - -- accepting floating-point numbers - case (reads str::[(Int, String)]) of - [(v, suffix)] -> - let unit = dropWhile (== ' ') suffix - in do - scaling <- parseUnitValue unit - return $ truncate (fromIntegral v * scaling) - _ -> fail $ "Can't parse string '" ++ str ++ "'" - --- | Unwraps a 'Result', exiting the program if it is a 'Bad' value, --- otherwise returning the actual contained value. -exitIfBad :: String -> Result a -> IO a -exitIfBad msg (Bad s) = do - hPutStrLn stderr $ "Error: " ++ msg ++ ": " ++ s - exitWith (ExitFailure 1) -exitIfBad _ (Ok v) = return v - --- | Exits immediately with an error message. -exitErr :: String -> IO a -exitErr errmsg = do - hPutStrLn stderr $ "Error: " ++ errmsg ++ "." - exitWith (ExitFailure 1) - --- | Exits with an error message if the given boolean condition if true. -exitWhen :: Bool -> String -> IO () -exitWhen True msg = exitErr msg -exitWhen False _ = return () - --- | Exits with an error message /unless/ the given boolean condition --- if true, the opposite of 'exitWhen'. -exitUnless :: Bool -> String -> IO () -exitUnless cond = exitWhen (not cond) diff --git a/htools/Ganeti/Luxi.hs b/htools/Ganeti/Luxi.hs index 16fb27d..12dc6ed 100644 --- a/htools/Ganeti/Luxi.hs +++ b/htools/Ganeti/Luxi.hs @@ -69,7 +69,7 @@ import qualified Network.Socket as S import Ganeti.JSON import Ganeti.HTools.Types -import Ganeti.HTools.Utils +import Ganeti.Utils import Ganeti.Constants import Ganeti.Jobs (JobStatus) diff --git a/htools/Ganeti/Ssconf.hs b/htools/Ganeti/Ssconf.hs index 47a2e04..bf3713b 100644 --- a/htools/Ganeti/Ssconf.hs +++ b/htools/Ganeti/Ssconf.hs @@ -48,7 +48,7 @@ import System.IO.Error (isDoesNotExistError) import qualified Ganeti.Constants as C import qualified Ganeti.Path as Path import Ganeti.BasicTypes -import Ganeti.HTools.Utils +import Ganeti.Utils -- | Maximum ssconf file size we support. maxFileSize :: Int diff --git a/htools/Ganeti/Utils.hs b/htools/Ganeti/Utils.hs new file mode 100644 index 0000000..708755e --- /dev/null +++ b/htools/Ganeti/Utils.hs @@ -0,0 +1,232 @@ +{-| Utility functions. -} + +{- + +Copyright (C) 2009, 2010, 2011, 2012 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 +the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +This program is distributed in the hope that it will be useful, but +WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +General Public License for more details. + +You should have received a copy of the GNU General Public License +along with this program; if not, write to the Free Software +Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA +02110-1301, USA. + +-} + +module Ganeti.Utils + ( debug + , debugFn + , debugXy + , sepSplit + , stdDev + , if' + , select + , applyIf + , commaJoin + , ensureQuoted + , tryRead + , formatTable + , printTable + , parseUnit + , plural + , exitIfBad + , exitErr + , exitWhen + , exitUnless + ) where + +import Data.Char (toUpper, isAlphaNum) +import Data.List + +import Debug.Trace + +import Ganeti.BasicTypes +import System.IO +import System.Exit + +-- * Debug functions + +-- | To be used only for debugging, breaks referential integrity. +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 = seq . debug + +-- * Miscellaneous + +-- | Apply the function if condition holds, otherwise use default value. +applyIf :: Bool -> (a -> a) -> a -> a +applyIf b f x = if b then f x else x + +-- | Comma-join a string list. +commaJoin :: [String] -> String +commaJoin = intercalate "," + +-- | Split a list on a separator and return an array. +sepSplit :: Eq a => a -> [a] -> [[a]] +sepSplit sep s + | null s = [] + | null xs = [x] + | null ys = [x,[]] + | otherwise = x:sepSplit sep ys + where (x, xs) = break (== sep) s + ys = drop 1 xs + +-- | Simple pluralize helper +plural :: Int -> String -> String -> String +plural 1 s _ = s +plural _ _ p = p + +-- | Ensure a value is quoted if needed. +ensureQuoted :: String -> String +ensureQuoted v = if not (all (\c -> isAlphaNum c || c == '.') v) + then '\'':v ++ "'" + else v + +-- * Mathematical functions + +-- Simple and slow statistical functions, please replace with better +-- versions + +-- | Standard deviation function. +stdDev :: [Double] -> Double +stdDev lst = + -- 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 + in sqrt (av / ll) -- stddev + +-- * Logical functions + +-- Avoid syntactic sugar and enhance readability. These functions are proposed +-- by some for inclusion in the Prelude, and at the moment they are present +-- (with various definitions) in the utility-ht package. Some rationale and +-- discussion is available at <http://www.haskell.org/haskellwiki/If-then-else> + +-- | \"if\" as a function, rather than as syntactic sugar. +if' :: Bool -- ^ condition + -> a -- ^ \"then\" result + -> a -- ^ \"else\" result + -> a -- ^ \"then\" or "else" result depending on the condition +if' True x _ = x +if' _ _ y = y + +-- * Parsing utility functions + +-- | Parse results from readsPrec. +parseChoices :: (Monad m, Read a) => String -> String -> [(a, String)] -> m a +parseChoices _ _ ((v, ""):[]) = return v +parseChoices name s ((_, e):[]) = + fail $ name ++ ": leftover characters when parsing '" + ++ s ++ "': '" ++ e ++ "'" +parseChoices name s _ = fail $ name ++ ": cannot parse string '" ++ s ++ "'" + +-- | Safe 'read' function returning data encapsulated in a Result. +tryRead :: (Monad m, Read a) => String -> String -> m a +tryRead name s = parseChoices name s $ reads s + +-- | Format a table of strings to maintain consistent length. +formatTable :: [[String]] -> [Bool] -> [[String]] +formatTable vals numpos = + let vtrans = transpose vals -- transpose, so that we work on rows + -- rather than columns + mlens = map (maximum . map length) vtrans + expnd = map (\(flds, isnum, ml) -> + map (\val -> + let delta = ml - length val + filler = replicate delta ' ' + in if delta > 0 + then if isnum + then filler ++ val + else val ++ filler + else val + ) flds + ) (zip3 vtrans numpos mlens) + in transpose expnd + +-- | Constructs a printable table from given header and rows +printTable :: String -> [String] -> [[String]] -> [Bool] -> String +printTable lp header rows isnum = + unlines . map ((++) lp . (:) ' ' . unwords) $ + formatTable (header:rows) isnum + +-- | Converts a unit (e.g. m or GB) into a scaling factor. +parseUnitValue :: (Monad m) => String -> m Rational +parseUnitValue unit + -- binary conversions first + | null unit = return 1 + | unit == "m" || upper == "MIB" = return 1 + | unit == "g" || upper == "GIB" = return kbBinary + | unit == "t" || upper == "TIB" = return $ kbBinary * kbBinary + -- SI conversions + | unit == "M" || upper == "MB" = return mbFactor + | unit == "G" || upper == "GB" = return $ mbFactor * kbDecimal + | unit == "T" || upper == "TB" = return $ mbFactor * kbDecimal * kbDecimal + | otherwise = fail $ "Unknown unit '" ++ unit ++ "'" + where upper = map toUpper unit + kbBinary = 1024 :: Rational + kbDecimal = 1000 :: Rational + decToBin = kbDecimal / kbBinary -- factor for 1K conversion + mbFactor = decToBin * decToBin -- twice the factor for just 1K + +-- | Tries to extract number and scale from the given string. +-- +-- Input must be in the format NUMBER+ SPACE* [UNIT]. If no unit is +-- specified, it defaults to MiB. Return value is always an integral +-- value in MiB. +parseUnit :: (Monad m, Integral a, Read a) => String -> m a +parseUnit str = + -- TODO: enhance this by splitting the unit parsing code out and + -- accepting floating-point numbers + case (reads str::[(Int, String)]) of + [(v, suffix)] -> + let unit = dropWhile (== ' ') suffix + in do + scaling <- parseUnitValue unit + return $ truncate (fromIntegral v * scaling) + _ -> fail $ "Can't parse string '" ++ str ++ "'" + +-- | Unwraps a 'Result', exiting the program if it is a 'Bad' value, +-- otherwise returning the actual contained value. +exitIfBad :: String -> Result a -> IO a +exitIfBad msg (Bad s) = do + hPutStrLn stderr $ "Error: " ++ msg ++ ": " ++ s + exitWith (ExitFailure 1) +exitIfBad _ (Ok v) = return v + +-- | Exits immediately with an error message. +exitErr :: String -> IO a +exitErr errmsg = do + hPutStrLn stderr $ "Error: " ++ errmsg ++ "." + exitWith (ExitFailure 1) + +-- | Exits with an error message if the given boolean condition if true. +exitWhen :: Bool -> String -> IO () +exitWhen True msg = exitErr msg +exitWhen False _ = return () + +-- | Exits with an error message /unless/ the given boolean condition +-- if true, the opposite of 'exitWhen'. +exitUnless :: Bool -> String -> IO () +exitUnless cond = exitWhen (not cond) diff --git a/htools/htools.hs b/htools/htools.hs index 08a5a14..216fe3f 100644 --- a/htools/htools.hs +++ b/htools/htools.hs @@ -34,7 +34,7 @@ import System.Exit import System.IO import System.IO.Error (isDoesNotExistError) -import Ganeti.HTools.Utils +import Ganeti.Utils import Ganeti.HTools.CLI (parseOpts, genericOpts) import Ganeti.HTools.Program (personalities) -- 1.7.10.4
