diff --git a/htools/Ganeti/BasicTypes.hs b/htools/Ganeti/BasicTypes.hs index 031e3c29885739537c271a916962cf852ea473fd..b7b437fa906165728a5b3d6a161aa1546afb3463 100644 --- a/htools/Ganeti/BasicTypes.hs +++ b/htools/Ganeti/BasicTypes.hs @@ -24,6 +24,7 @@ module Ganeti.BasicTypes , isOk , isBad , eitherToResult + , annotateResult ) where import Control.Monad @@ -65,3 +66,8 @@ isBad = not . isOk eitherToResult :: Either String a -> Result a eitherToResult (Left s) = Bad s eitherToResult (Right v) = Ok v + +-- | Annotate a Result with an ownership information. +annotateResult :: String -> Result a -> Result a +annotateResult owner (Bad s) = Bad $ owner ++ ": " ++ s +annotateResult _ v = v diff --git a/htools/Ganeti/HTools/JSON.hs b/htools/Ganeti/HTools/JSON.hs index 185201fa5bd065cc690b669e3b35564b39f25152..31a6d1947f28d2f70f9505ed193ec7c081d7a1b8 100644 --- a/htools/Ganeti/HTools/JSON.hs +++ b/htools/Ganeti/HTools/JSON.hs @@ -33,6 +33,7 @@ module Ganeti.HTools.JSON , fromJVal , asJSObject , asObjectList + , tryFromObj ) where @@ -42,6 +43,8 @@ import Text.Printf (printf) import qualified Text.JSON as J +import Ganeti.BasicTypes + -- * JSON-related functions -- | A type alias for the list-based representation of J.JSObject. @@ -114,3 +117,12 @@ asJSObject _ = fail "not an object" -- | Coneverts a list of JSON values into a list of JSON objects. asObjectList :: (Monad m) => [J.JSValue] -> m [J.JSObject J.JSValue] asObjectList = mapM asJSObject + +-- | Try to extract a key from a object with better error reporting +-- than fromObj. +tryFromObj :: (J.JSON a) => + String -- ^ Textual "owner" in error messages + -> JSRecord -- ^ The object array + -> String -- ^ The desired key from the object + -> Result a +tryFromObj t o = annotateResult t . fromObj o diff --git a/htools/Ganeti/HTools/Luxi.hs b/htools/Ganeti/HTools/Luxi.hs index f7c6dee1dd873919eaf39381d60ad35a483b8cd4..38bb266fc879cb98427422a5438122b1fdeb1030 100644 --- a/htools/Ganeti/HTools/Luxi.hs +++ b/htools/Ganeti/HTools/Luxi.hs @@ -38,7 +38,7 @@ import Ganeti.HTools.Types import qualified Ganeti.HTools.Group as Group import qualified Ganeti.HTools.Node as Node import qualified Ganeti.HTools.Instance as Instance -import Ganeti.HTools.Utils (fromJVal, annotateResult, tryFromObj, asJSObject, +import Ganeti.HTools.Utils (fromJVal, tryFromObj, asJSObject, fromObj) {-# ANN module "HLint: ignore Eta reduce" #-} diff --git a/htools/Ganeti/HTools/QC.hs b/htools/Ganeti/HTools/QC.hs index df1da6b98a9253ee60e840db404f7ea673369dc1..435d37823ea40a10e7b1a4210168d97a5d36ac1d 100644 --- a/htools/Ganeti/HTools/QC.hs +++ b/htools/Ganeti/HTools/QC.hs @@ -91,7 +91,7 @@ maxCpu = 1024 defGroup :: Group.Group defGroup = flip Group.setIdx 0 $ - Group.create "default" Utils.defaultGroupID Types.AllocPreferred + Group.create "default" Types.defaultGroupID Types.AllocPreferred defGroupList :: Group.List defGroupList = Container.fromList [(Group.idx defGroup, defGroup)] diff --git a/htools/Ganeti/HTools/Types.hs b/htools/Ganeti/HTools/Types.hs index 644d4d979c3f57a2ad1090008d2a89e9198f049b..3209ce7a71e9a8b29cad3010a36b1dabeb22ffae 100644 --- a/htools/Ganeti/HTools/Types.hs +++ b/htools/Ganeti/HTools/Types.hs @@ -33,6 +33,7 @@ module Ganeti.HTools.Types , Score , Weight , GroupID + , defaultGroupID , AllocPolicy(..) , allocPolicyFromRaw , allocPolicyToRaw @@ -62,6 +63,7 @@ module Ganeti.HTools.Types , isOk , isBad , eitherToResult + , annotateResult , Element(..) , FailMode(..) , FailStats @@ -100,6 +102,10 @@ type Weight = Double -- | The Group UUID type. type GroupID = String +-- | Default group UUID (just a string, not a real UUID). +defaultGroupID :: GroupID +defaultGroupID = "00000000-0000-0000-0000-000000000000" + -- | The Group allocation policy type. -- -- Note that the order of constructors is important as the automatic diff --git a/htools/Ganeti/HTools/Utils.hs b/htools/Ganeti/HTools/Utils.hs index c3b3caad9e45c04641a7b7dae59c9ec06e1c09aa..b1898ebe780af088f235e59084371d6f84f3341d 100644 --- a/htools/Ganeti/HTools/Utils.hs +++ b/htools/Ganeti/HTools/Utils.hs @@ -44,18 +44,14 @@ module Ganeti.HTools.Utils , fromJResult , tryRead , formatTable - , annotateResult - , defaultGroupID , parseUnit ) where import Data.Char (toUpper) import Data.List -import qualified Text.JSON as J import Debug.Trace -import Ganeti.HTools.Types -- we will re-export these for our existing users import Ganeti.HTools.JSON @@ -134,20 +130,6 @@ select :: a -- ^ default result -> a -- ^ first result which has a True condition, or default select def = maybe def snd . find fst --- | Annotate a Result with an ownership information. -annotateResult :: String -> Result a -> Result a -annotateResult owner (Bad s) = Bad $ owner ++ ": " ++ s -annotateResult _ v = v - --- | Try to extract a key from a object with better error reporting --- than fromObj. -tryFromObj :: (J.JSON a) => - String -- ^ Textual "owner" in error messages - -> JSRecord -- ^ The object array - -> String -- ^ The desired key from the object - -> Result a -tryFromObj t o = annotateResult t . fromObj o - -- * Parsing utility functions @@ -182,10 +164,6 @@ formatTable vals numpos = ) (zip3 vtrans numpos mlens) in transpose expnd --- | Default group UUID (just a string, not a real UUID). -defaultGroupID :: GroupID -defaultGroupID = "00000000-0000-0000-0000-000000000000" - -- | Tries to extract number and scale from the given string. -- -- Input must be in the format NUMBER+ SPACE* [UNIT]. If no unit is