Commit ebf38064 authored by Iustin Pop's avatar Iustin Pop
Browse files

htools: reindent the rest of the files


Signed-off-by: default avatarIustin Pop <iustin@google.com>
Reviewed-by: default avatarMichael Hanselmann <hansmi@google.com>
parent 00dd69a2
......@@ -2,7 +2,8 @@
{- | Compatibility helper module.
This module holds definitions that help with supporting multiple library versions or transitions between versions.
This module holds definitions that help with supporting multiple
library versions or transitions between versions.
-}
......@@ -28,9 +29,9 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
-}
module Ganeti.HTools.Compat
( rwhnf
, Control.Parallel.Strategies.parMap
) where
( rwhnf
, Control.Parallel.Strategies.parMap
) where
import qualified Control.Parallel.Strategies
......
......@@ -27,33 +27,32 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
-}
module Ganeti.HTools.Container
(
-- * Types
Container
, Key
-- * Creation
, IntMap.empty
, IntMap.singleton
, IntMap.fromList
-- * Query
, IntMap.size
, IntMap.null
, find
, IntMap.findMax
, IntMap.member
-- * Update
, add
, addTwo
, IntMap.map
, IntMap.mapAccum
, IntMap.filter
-- * Conversion
, IntMap.elems
, IntMap.keys
-- * Element functions
, nameOf
, findByName
) where
( -- * Types
Container
, Key
-- * Creation
, IntMap.empty
, IntMap.singleton
, IntMap.fromList
-- * Query
, IntMap.size
, IntMap.null
, find
, IntMap.findMax
, IntMap.member
-- * Update
, add
, addTwo
, IntMap.map
, IntMap.mapAccum
, IntMap.filter
-- * Conversion
, IntMap.elems
, IntMap.keys
-- * Element functions
, nameOf
, findByName
) where
import qualified Data.IntMap as IntMap
......@@ -86,8 +85,8 @@ nameOf c k = T.nameOf $ find k c
findByName :: (T.Element a, Monad m) =>
Container a -> String -> m a
findByName c n =
let all_elems = IntMap.elems c
result = filter ((n `elem`) . T.allNames) all_elems
in case result of
[item] -> return item
_ -> fail $ "Wrong number of elems found with name " ++ n
let all_elems = IntMap.elems c
result = filter ((n `elem`) . T.allNames) all_elems
in case result of
[item] -> return item
_ -> fail $ "Wrong number of elems found with name " ++ n
......@@ -28,10 +28,10 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
-}
module Ganeti.HTools.ExtLoader
( loadExternalData
, commonSuffix
, maybeSaveData
) where
( loadExternalData
, commonSuffix
, maybeSaveData
) where
import Control.Monad
import Data.Maybe (isJust, fromJust)
......@@ -58,17 +58,17 @@ wrapIO = flip catch (return . Bad . show)
-- | Parses a user-supplied utilisation string.
parseUtilisation :: String -> Result (String, DynUtil)
parseUtilisation line =
case sepSplit ' ' line of
[name, cpu, mem, dsk, net] ->
do
rcpu <- tryRead name cpu
rmem <- tryRead name mem
rdsk <- tryRead name dsk
rnet <- tryRead name net
let du = DynUtil { cpuWeight = rcpu, memWeight = rmem
, dskWeight = rdsk, netWeight = rnet }
return (name, du)
_ -> Bad $ "Cannot parse line " ++ line
case sepSplit ' ' line of
[name, cpu, mem, dsk, net] ->
do
rcpu <- tryRead name cpu
rmem <- tryRead name mem
rdsk <- tryRead name dsk
rnet <- tryRead name net
let du = DynUtil { cpuWeight = rcpu, memWeight = rmem
, dskWeight = rdsk, netWeight = rnet }
return (name, du)
_ -> Bad $ "Cannot parse line " ++ line
-- | External tool data loader from a variety of sources.
loadExternalData :: Options
......@@ -100,28 +100,28 @@ loadExternalData opts = do
Nothing -> return "")
let util_data = mapM parseUtilisation $ lines util_contents
util_data' <- (case util_data of
Ok x -> return x
Ok x -> return x
Bad y -> do
hPutStrLn stderr ("Error: can't parse utilisation" ++
" data: " ++ show y)
exitWith $ ExitFailure 1)
input_data <-
case () of
_ | setRapi -> wrapIO $ Rapi.loadData mhost
| setLuxi -> wrapIO $ Luxi.loadData $ fromJust lsock
| setSim -> Simu.loadData simdata
| setFile -> wrapIO $ Text.loadData $ fromJust tfile
| otherwise -> return $ Bad "No backend selected! Exiting."
case () of
_ | setRapi -> wrapIO $ Rapi.loadData mhost
| setLuxi -> wrapIO $ Luxi.loadData $ fromJust lsock
| setSim -> Simu.loadData simdata
| setFile -> wrapIO $ Text.loadData $ fromJust tfile
| otherwise -> return $ Bad "No backend selected! Exiting."
let ldresult = input_data >>= mergeData util_data' exTags selInsts exInsts
cdata <-
(case ldresult of
Ok x -> return x
Bad s -> do
hPrintf stderr
"Error: failed to load data, aborting. Details:\n%s\n" s:: IO ()
exitWith $ ExitFailure 1
)
(case ldresult of
Ok x -> return x
Bad s -> do
hPrintf stderr
"Error: failed to load data, aborting. Details:\n%s\n" s:: IO ()
exitWith $ ExitFailure 1
)
let (fix_msgs, nl) = checkData (cdNodes cdata) (cdInstances cdata)
unless (optVerbose opts == 0) $ maybeShowWarnings fix_msgs
......
......@@ -24,14 +24,14 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
-}
module Ganeti.HTools.Group
( Group(..)
, List
, AssocList
-- * Constructor
, create
, setIdx
, isAllocable
) where
( Group(..)
, List
, AssocList
-- * Constructor
, create
, setIdx
, isAllocable
) where
import qualified Ganeti.HTools.Container as Container
......@@ -41,20 +41,20 @@ import qualified Ganeti.HTools.Types as T
-- | The node group type.
data Group = Group
{ name :: String -- ^ The node name
, uuid :: T.GroupID -- ^ The UUID of the group
, idx :: T.Gdx -- ^ Internal index for book-keeping
, allocPolicy :: T.AllocPolicy -- ^ The allocation policy for this group
} deriving (Show, Read, Eq)
{ name :: String -- ^ The node name
, uuid :: T.GroupID -- ^ The UUID of the group
, idx :: T.Gdx -- ^ Internal index for book-keeping
, allocPolicy :: T.AllocPolicy -- ^ The allocation policy for this group
} deriving (Show, Read, Eq)
-- Note: we use the name as the alias, and the UUID as the official
-- name
instance T.Element Group where
nameOf = uuid
idxOf = idx
setAlias = setName
setIdx = setIdx
allNames n = [name n, uuid n]
nameOf = uuid
idxOf = idx
setAlias = setName
setIdx = setIdx
allNames n = [name n, uuid n]
-- | A simple name for the int, node association list.
type AssocList = [(T.Gdx, Group)]
......@@ -67,11 +67,11 @@ type List = Container.Container Group
-- | Create a new group.
create :: String -> T.GroupID -> T.AllocPolicy -> Group
create name_init id_init apol_init =
Group { name = name_init
, uuid = id_init
, allocPolicy = apol_init
, idx = -1
}
Group { name = name_init
, uuid = id_init
, allocPolicy = apol_init
, idx = -1
}
-- | Sets the group index.
--
......
......@@ -27,29 +27,29 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
-}
module Ganeti.HTools.Instance
( Instance(..)
, AssocList
, List
, create
, instanceRunning
, instanceOffline
, instanceDown
, applyIfOnline
, setIdx
, setName
, setAlias
, setPri
, setSec
, setBoth
, setMovable
, specOf
, shrinkByType
, localStorageTemplates
, hasSecondary
, requiredNodes
, allNodes
, usesLocalStorage
) where
( Instance(..)
, AssocList
, List
, create
, instanceRunning
, instanceOffline
, instanceDown
, applyIfOnline
, setIdx
, setName
, setAlias
, setPri
, setSec
, setBoth
, setMovable
, specOf
, shrinkByType
, localStorageTemplates
, hasSecondary
, requiredNodes
, allNodes
, usesLocalStorage
) where
import qualified Ganeti.HTools.Types as T
import qualified Ganeti.HTools.Container as Container
......@@ -61,39 +61,39 @@ import Ganeti.HTools.Utils
-- | The instance type.
data Instance = Instance
{ name :: String -- ^ The instance name
, alias :: String -- ^ The shortened name
, mem :: Int -- ^ Memory of the instance
, dsk :: Int -- ^ Disk size of instance
, vcpus :: Int -- ^ Number of VCPUs
, runSt :: T.InstanceStatus -- ^ Original run status
, pNode :: T.Ndx -- ^ Original primary node
, sNode :: T.Ndx -- ^ Original secondary node
, idx :: T.Idx -- ^ Internal index
, util :: T.DynUtil -- ^ Dynamic resource usage
, movable :: Bool -- ^ Can and should the instance be moved?
, autoBalance :: Bool -- ^ Is the instance auto-balanced?
, tags :: [String] -- ^ List of instance tags
, diskTemplate :: T.DiskTemplate -- ^ The disk template of the instance
} deriving (Show, Read)
{ name :: String -- ^ The instance name
, alias :: String -- ^ The shortened name
, mem :: Int -- ^ Memory of the instance
, dsk :: Int -- ^ Disk size of instance
, vcpus :: Int -- ^ Number of VCPUs
, runSt :: T.InstanceStatus -- ^ Original run status
, pNode :: T.Ndx -- ^ Original primary node
, sNode :: T.Ndx -- ^ Original secondary node
, idx :: T.Idx -- ^ Internal index
, util :: T.DynUtil -- ^ Dynamic resource usage
, movable :: Bool -- ^ Can and should the instance be moved?
, autoBalance :: Bool -- ^ Is the instance auto-balanced?
, tags :: [String] -- ^ List of instance tags
, diskTemplate :: T.DiskTemplate -- ^ The disk template of the instance
} deriving (Show, Read)
instance T.Element Instance where
nameOf = name
idxOf = idx
setAlias = setAlias
setIdx = setIdx
allNames n = [name n, alias n]
nameOf = name
idxOf = idx
setAlias = setAlias
setIdx = setIdx
allNames n = [name n, alias n]
-- | Check if instance is running.
instanceRunning :: Instance -> Bool
instanceRunning (Instance {runSt = T.Running}) = True
instanceRunning (Instance {runSt = T.ErrorUp}) = True
instanceRunning _ = False
instanceRunning _ = False
-- | Check if instance is offline.
instanceOffline :: Instance -> Bool
instanceOffline (Instance {runSt = T.AdminOffline}) = True
instanceOffline _ = False
instanceOffline _ = False
-- | Check if instance is down.
instanceDown :: Instance -> Bool
......@@ -141,21 +141,21 @@ create :: String -> Int -> Int -> Int -> T.InstanceStatus
-> [String] -> Bool -> T.Ndx -> T.Ndx -> T.DiskTemplate -> Instance
create name_init mem_init dsk_init vcpus_init run_init tags_init
auto_balance_init pn sn dt =
Instance { name = name_init
, alias = name_init
, mem = mem_init
, dsk = dsk_init
, vcpus = vcpus_init
, runSt = run_init
, pNode = pn
, sNode = sn
, idx = -1
, util = T.baseUtil
, tags = tags_init
, movable = supportsMoves dt
, autoBalance = auto_balance_init
, diskTemplate = dt
}
Instance { name = name_init
, alias = name_init
, mem = mem_init
, dsk = dsk_init
, vcpus = vcpus_init
, runSt = run_init
, pNode = pn
, sNode = sn
, idx = -1
, util = T.baseUtil
, tags = tags_init
, movable = supportsMoves dt
, autoBalance = auto_balance_init
, diskTemplate = dt
}
-- | Changes the index.
--
......@@ -228,7 +228,7 @@ shrinkByType _ f = T.Bad $ "Unhandled failure mode " ++ show f
-- | Return the spec of an instance.
specOf :: Instance -> T.RSpec
specOf Instance { mem = m, dsk = d, vcpus = c } =
T.RSpec { T.rspecCpu = c, T.rspecMem = m, T.rspecDsk = d }
T.RSpec { T.rspecCpu = c, T.rspecMem = m, T.rspecDsk = d }
-- | Checks whether the instance uses a secondary node.
--
......
......@@ -22,18 +22,18 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
-}
module Ganeti.HTools.JSON
( fromJResult
, readEitherString
, JSRecord
, loadJSArray
, fromObj
, maybeFromObj
, fromObjWithDefault
, fromJVal
, asJSObject
, asObjectList
)
where
( fromJResult
, readEitherString
, JSRecord
, loadJSArray
, fromObj
, maybeFromObj
, fromObjWithDefault
, fromJVal
, asJSObject
, asObjectList
)
where
import Control.Monad (liftM)
import Data.Maybe (fromMaybe)
......@@ -57,9 +57,9 @@ fromJResult _ (J.Ok x) = return x
-- context of the current monad.
readEitherString :: (Monad m) => J.JSValue -> m String
readEitherString v =
case v of
J.JSString s -> return $ J.fromJSString s
_ -> fail "Wrong JSON type"
case v of
J.JSString s -> return $ J.fromJSString s
_ -> fail "Wrong JSON type"
-- | Converts a JSON message into an array of JSON objects.
loadJSArray :: (Monad m)
......@@ -71,18 +71,18 @@ loadJSArray s = fromJResult s . J.decodeStrict
-- | Reads the value of a key in a JSON object.
fromObj :: (J.JSON a, Monad m) => JSRecord -> String -> m a
fromObj o k =
case lookup k o of
Nothing -> fail $ printf "key '%s' not found, object contains only %s"
k (show (map fst o))
Just val -> fromKeyValue k val
case lookup k o of
Nothing -> fail $ printf "key '%s' not found, object contains only %s"
k (show (map fst o))
Just val -> fromKeyValue k val
-- | Reads the value of an optional key in a JSON object.
maybeFromObj :: (J.JSON a, Monad m) =>
JSRecord -> String -> m (Maybe a)
maybeFromObj o k =
case lookup k o of
Nothing -> return Nothing
Just val -> liftM Just (fromKeyValue k val)
case lookup k o of
Nothing -> return Nothing
Just val -> liftM Just (fromKeyValue k val)
-- | Reads the value of a key in a JSON object with a default if missing.
fromObjWithDefault :: (J.JSON a, Monad m) =>
......@@ -100,10 +100,10 @@ fromKeyValue k val =
-- | Small wrapper over readJSON.
fromJVal :: (Monad m, J.JSON a) => J.JSValue -> m a
fromJVal v =
case J.readJSON v of
J.Error s -> fail ("Cannot convert value '" ++ show v ++
"', error: " ++ s)
J.Ok x -> return x
case J.readJSON v of
J.Error s -> fail ("Cannot convert value '" ++ show v ++
"', error: " ++ s)
J.Ok x -> return x
-- | Converts a JSON value into a JSON object.
asJSObject :: (Monad m) => J.JSValue -> m (J.JSObject J.JSValue)
......
......@@ -27,24 +27,24 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
-}
module Ganeti.HTools.Loader
( mergeData
, checkData
, assignIndices
, lookupName
, goodLookupResult
, lookupNode
, lookupInstance
, lookupGroup
, commonSuffix
, RqType(..)
, Request(..)
, ClusterData(..)
, emptyCluster
, compareNameComponent
, prefixMatch
, LookupResult(..)
, MatchPriority(..)
) where
( mergeData
, checkData
, assignIndices
, lookupName
, goodLookupResult
, lookupNode
, lookupInstance
, lookupGroup
, commonSuffix
, RqType(..)
, Request(..)
, ClusterData(..)
, emptyCluster
, compareNameComponent
, prefixMatch
, LookupResult(..)
, MatchPriority(..)
) where
import Data.List
import Data.Function
......@@ -74,23 +74,23 @@ request-specific fields.
-}
data RqType
= Allocate Instance.Instance Int -- ^ A new instance allocation
| Relocate Idx Int [Ndx] -- ^ Choose a new secondary node
| NodeEvacuate [Idx] EvacMode -- ^ node-evacuate mode
| ChangeGroup [Gdx] [Idx] -- ^ Multi-relocate mode
= Allocate Instance.Instance Int -- ^ A new instance allocation
| Relocate Idx Int [Ndx] -- ^ Choose a new secondary node
| NodeEvacuate [Idx] EvacMode -- ^ node-evacuate mode
| ChangeGroup [Gdx] [Idx] -- ^ Multi-relocate mode
deriving (Show, Read)
-- | A complete request, as received from Ganeti.
data Request = Request RqType ClusterData
deriving (Show, Read)
deriving (Show, Read)
-- | The cluster state.
data ClusterData = ClusterData
{ cdGroups :: Group.List -- ^ The node group list
, cdNodes :: Node.List -- ^ The node list
, cdInstances :: Instance.List -- ^ The instance list
, cdTags :: [String] -- ^ The cluster tags
} deriving (Show, Read)
{ cdGroups :: Group.List -- ^ The node group list
, cdNodes :: Node.List -- ^ The node list
, cdInstances :: Instance.List -- ^ The instance list
, cdTags :: [String] -- ^ The cluster tags
} deriving (Show, Read)
-- | The priority of a match in a lookup result.
data MatchPriority = ExactMatch
......@@ -101,10 +101,10 @@ data MatchPriority = ExactMatch
-- | The result of a name lookup in a list.
data LookupResult = LookupResult
{ lrMatchPriority :: MatchPriority -- ^ The result type
-- | Matching value (for ExactMatch, PartialMatch), Lookup string otherwise
, lrContent :: String
} deriving (Show, Read)
{ lrMatchPriority :: MatchPriority -- ^ The result type
-- | Matching value (for ExactMatch, PartialMatch), Lookup string otherwise
, lrContent :: String
} deriving (Show, Read)
-- | Lookup results have an absolute preference ordering.
instance Eq LookupResult where
......@@ -122,23 +122,23 @@ emptyCluster = ClusterData Container.empty Container.empty Container.empty []
-- | Lookups a node into an assoc list.
lookupNode :: (Monad m) => NameAssoc -> String -> String -> m Ndx
lookupNode ktn inst node =
case M.lookup node ktn of
Nothing -> fail $ "Unknown node '" ++ node ++ "' for instance " ++ inst
Just idx -> return idx
case M.lookup node ktn of
Nothing -> fail $ "Unknown node '" ++ node ++ "' for instance " ++ inst
Just idx -> return idx
-- | Lookups an instance into an assoc list.
lookupInstance :: (Monad m) => NameAssoc -> String -> m Idx
lookupInstance kti inst =
case M.lookup inst kti of
Nothing -> fail $ "Unknown instance '" ++ inst ++ "'"
Just idx -> return idx
case M.lookup inst kti of
Nothing -> fail $ "Unknown instance '" ++ inst ++ "'"
Just idx -> return idx
-- | Lookups a group into an assoc list.
lookupGroup :: (Monad m) => NameAssoc -> String -> String