Commit 179c0828 authored by Iustin Pop's avatar Iustin Pop
Browse files

htools: further docstring fixes



This adds parameter documentation for Cluster.iMoveToJob (I think it
was not clear if the new or old node list is needed) and fixes other
docstring style issues.

After this patch, all modules except for CLI.hs (which has many
obvious declarations for command-line options) and QC.hs (unittests)
have 100% doc-strings.
Signed-off-by: default avatarIustin Pop <iustin@google.com>
Reviewed-by: default avatarMichael Hanselmann <hansmi@google.com>
parent 9f8b97ce
......@@ -139,6 +139,7 @@ emptyEvacSolution = EvacSolution { esMoved = []
data Table = Table Node.List Instance.List Score [Placement]
deriving (Show, Read)
-- | Cluster statistics data type.
data CStats = CStats { csFmem :: Integer -- ^ Cluster free mem
, csFdsk :: Integer -- ^ Cluster free disk
, csAmem :: Integer -- ^ Cluster allocatable mem
......@@ -278,6 +279,7 @@ detailedCVInfo = [ (1, "free_mem_cv")
, (2, "pri_tags_score")
]
-- | Holds the weights used by 'compCVNodes' for each metric.
detailedCVWeights :: [Double]
detailedCVWeights = map fst detailedCVInfo
......@@ -333,7 +335,6 @@ compCVNodes = sum . zipWith (*) detailedCVWeights . compDetailedCV
compCV :: Node.List -> Double
compCV = compCVNodes . Container.elems
-- | Compute online nodes from a 'Node.List'.
getOnline :: Node.List -> [Node.Node]
getOnline = filter (not . Node.offline) . Container.elems
......@@ -1314,8 +1315,16 @@ printStats nl =
in intercalate ", " formatted
-- | Convert a placement into a list of OpCodes (basically a job).
iMoveToJob :: Node.List -> Instance.List
-> Idx -> IMove -> [OpCodes.OpCode]
iMoveToJob :: Node.List -- ^ The node list; only used for node
-- names, so any version is good
-- (before or after the operation)
-> Instance.List -- ^ The instance list; also used for
-- names only
-> Idx -- ^ The index of the instance being
-- moved
-> IMove -- ^ The actual move to be described
-> [OpCodes.OpCode] -- ^ The list of opcodes equivalent to
-- the given move
iMoveToJob nl il idx move =
let inst = Container.find idx il
iname = Instance.name inst
......
......@@ -34,6 +34,11 @@ module Ganeti.HTools.Compat
import qualified Control.Parallel.Strategies
-- | Wrapper over the function exported from
-- "Control.Parallel.Strategies".
--
-- This wraps either the old or the new name of the function,
-- depending on the detected library version.
rwhnf :: Control.Parallel.Strategies.Strategy a
#ifdef PARALLEL3
rwhnf = Control.Parallel.Strategies.rseq
......
......@@ -59,7 +59,11 @@ import qualified Data.IntMap as IntMap
import qualified Ganeti.HTools.Types as T
-- | Our key type.
type Key = IntMap.Key
-- | Our container type.
type Container = IntMap.IntMap
-- | Locate a key in the map (must exist).
......
......@@ -55,6 +55,7 @@ import Ganeti.HTools.Utils (sepSplit, tryRead)
wrapIO :: IO (Result a) -> IO (Result a)
wrapIO = flip catch (return . Bad . show)
-- | Parses a user-supplied utilisation string.
parseUtilisation :: String -> Result (String, DynUtil)
parseUtilisation line =
case sepSplit ' ' line of
......
......@@ -73,6 +73,8 @@ create name_init id_init apol_init =
, idx = -1
}
-- | Sets the group index.
--
-- This is used only during the building of the data structures.
setIdx :: Group -> T.Gdx -> Group
setIdx t i = t {idx = i}
......
......@@ -237,7 +237,7 @@ formatNodeEvac gl nl il (fin_nl, fin_il, es) =
" were moved successfully"
in Ok (info, showJSON (mes, fes, Cluster.esOpCodes es), fin_nl, fin_il)
-- | Process a request and return new node lists
-- | Process a request and return new node lists.
processRequest :: Request -> Result IAllocResult
processRequest request =
let Request rqtype (ClusterData gl nl il _) = request
......@@ -251,7 +251,7 @@ processRequest request =
Cluster.tryNodeEvac gl nl il mode xi >>=
formatNodeEvac gl nl il
-- | Reads the request from the data file(s)
-- | Reads the request from the data file(s).
readRequest :: Options -> [String] -> IO Request
readRequest opts args = do
when (null args) $ do
......
......@@ -159,6 +159,7 @@ setBoth :: Instance -- ^ the original instance
-> Instance -- ^ the modified instance
setBoth t p s = t { pNode = p, sNode = s }
-- | Sets the movable flag on an instance.
setMovable :: Instance -- ^ The original instance
-> Bool -- ^ New movable flag
-> Instance -- ^ The modified instance
......@@ -186,7 +187,7 @@ specOf :: Instance -> T.RSpec
specOf Instance { mem = m, dsk = d, vcpus = c } =
T.RSpec { T.rspecCpu = c, T.rspecMem = m, T.rspecDsk = d }
-- | Computed the number of nodes for a given disk template
-- | Computed the number of nodes for a given disk template.
requiredNodes :: T.DiskTemplate -> Int
requiredNodes T.DTDrbd8 = 2
requiredNodes _ = 1
......
......@@ -88,14 +88,15 @@ queryGroupsMsg :: L.LuxiOp
queryGroupsMsg =
L.QueryGroups [] ["uuid", "name", "alloc_policy"] False
-- | Wraper over callMethod doing node query.
-- | Wraper over 'callMethod' doing node query.
queryNodes :: L.Client -> IO (Result JSValue)
queryNodes = L.callMethod queryNodesMsg
-- | Wraper over callMethod doing instance query.
-- | Wraper over 'callMethod' doing instance query.
queryInstances :: L.Client -> IO (Result JSValue)
queryInstances = L.callMethod queryInstancesMsg
-- | Wrapper over 'callMethod' doing cluster information query.
queryClusterInfo :: L.Client -> IO (Result JSValue)
queryClusterInfo = L.callMethod queryClusterInfoMsg
......@@ -167,15 +168,18 @@ parseNode ktg (JSArray [ name, mtotal, mnode, mfree, dtotal, dfree
parseNode _ v = fail ("Invalid node query result: " ++ show v)
-- | Parses the cluster tags.
getClusterTags :: JSValue -> Result [String]
getClusterTags v = do
let errmsg = "Parsing cluster info"
obj <- annotateResult errmsg $ asJSObject v
tryFromObj errmsg (fromJSObject obj) "tags"
-- | Parses the cluster groups.
getGroups :: JSValue -> Result [(String, Group.Group)]
getGroups arr = toArray arr >>= mapM parseGroup
-- | Parses a given group information.
parseGroup :: JSValue -> Result (String, Group.Group)
parseGroup (JSArray [ uuid, name, apol ]) = do
xname <- annotateResult "Parsing new group" (fromJVal name)
......
......@@ -36,7 +36,7 @@ import Ganeti.HTools.IAlloc
import Ganeti.HTools.Loader (Request(..), ClusterData(..))
import Ganeti.HTools.ExtLoader (maybeSaveData)
-- | Options list and functions
-- | Options list and functions.
options :: [OptType]
options =
[ oPrintNodes
......
......@@ -54,7 +54,7 @@ import Ganeti.HTools.Loader
import qualified Ganeti.Luxi as L
import Ganeti.Jobs
-- | Options list and functions
-- | Options list and functions.
options :: [OptType]
options =
[ oPrintNodes
......@@ -133,14 +133,14 @@ iterateDepth ini_tbl max_rounds disk_moves inst_moves nmlen imlen
mg_limit min_gain evac_mode
Nothing -> return (ini_tbl, cmd_strs)
-- | Formats the solution for the oneline display
-- | Formats the solution for the oneline display.
formatOneline :: Double -> Int -> Double -> String
formatOneline ini_cv plc_len fin_cv =
printf "%.8f %d %.8f %8.3f" ini_cv plc_len fin_cv
(if fin_cv == 0 then 1 else ini_cv / fin_cv)
-- | Polls a set of jobs at a fixed interval until all are finished
-- one way or another
-- one way or another.
waitForJobs :: L.Client -> [String] -> IO (Result [JobStatus])
waitForJobs client jids = do
sts <- L.queryJobsStatus client jids
......@@ -153,11 +153,11 @@ waitForJobs client jids = do
waitForJobs client jids
else return $ Ok s
-- | Check that a set of job statuses is all success
-- | Check that a set of job statuses is all success.
checkJobsStatus :: [JobStatus] -> Bool
checkJobsStatus = all (== JOB_STATUS_SUCCESS)
-- | Wrapper over execJobSet checking for early termination
-- | Wrapper over execJobSet checking for early termination.
execWrapper :: String -> Node.List
-> Instance.List -> IORef Int -> [JobSet] -> IO Bool
execWrapper _ _ _ _ [] = return True
......@@ -170,7 +170,7 @@ execWrapper master nl il cref alljss = do
return False
else execJobSet master nl il cref alljss)
-- | Execute an entire jobset
-- | Execute an entire jobset.
execJobSet :: String -> Node.List
-> Instance.List -> IORef Int -> [JobSet] -> IO Bool
execJobSet _ _ _ _ [] = return True
......@@ -201,14 +201,14 @@ execJobSet master nl il cref (js:jss) = do
hPutStrLn stderr "Aborting."
return False)
-- | Signal handler for graceful termination
-- | Signal handler for graceful termination.
hangleSigInt :: IORef Int -> IO ()
hangleSigInt cref = do
writeIORef cref 1
putStrLn ("Cancel request registered, will exit at" ++
" the end of the current job set...")
-- | Signal handler for immediate termination
-- | Signal handler for immediate termination.
hangleSigTerm :: IORef Int -> IO ()
hangleSigTerm cref = do
-- update the cref to 2, just for consistency
......@@ -216,6 +216,7 @@ hangleSigTerm cref = do
putStrLn "Double cancel request, exiting now..."
exitImmediately $ ExitFailure 2
-- | Runs a job set with handling of signals.
runJobSet :: String -> Node.List -> Instance.List -> [JobSet] -> IO Bool
runJobSet master fin_nl il cmd_jobs = do
cref <- newIORef 0
......
......@@ -46,7 +46,7 @@ import Ganeti.HTools.Text (serializeCluster)
import Ganeti.HTools.CLI
import Ganeti.HTools.Types
-- | Options list and functions
-- | Options list and functions.
options :: [OptType]
options =
[ oPrintNodes
......@@ -58,7 +58,7 @@ options =
, oShowHelp
]
-- | Return a one-line summary of cluster state
-- | Return a one-line summary of cluster state.
printCluster :: Node.List -> Instance.List
-> String
printCluster nl il =
......@@ -79,7 +79,7 @@ printCluster nl il =
ccv
-- | Replace slashes with underscore for saving to filesystem
-- | Replace slashes with underscore for saving to filesystem.
fixSlash :: String -> String
fixSlash = map (\x -> if x == '/' then '_' else x)
......@@ -91,7 +91,7 @@ processData input_data = do
let (_, fix_nl) = checkData nl il
return cdata { cdNodes = fix_nl }
-- | Writes cluster data out
-- | Writes cluster data out.
writeData :: Int
-> String
-> Options
......@@ -108,6 +108,7 @@ writeData nlen name opts (Ok cdata) = do
name err >> return False
Ok processed -> writeDataInner nlen name opts cdata processed
-- | Inner function for writing cluster data to disk.
writeDataInner :: Int
-> String
-> Options
......
......@@ -48,7 +48,7 @@ import Ganeti.HTools.CLI
import Ganeti.HTools.ExtLoader
import Ganeti.HTools.Loader
-- | Options list and functions
-- | Options list and functions.
options :: [OptType]
options =
[ oPrintNodes
......@@ -110,6 +110,8 @@ dskEff = effFn Cluster.csIdsk Cluster.csTdsk
cpuEff :: Cluster.CStats -> Double
cpuEff = effFn Cluster.csIcpu (fromIntegral . Cluster.csVcpu)
-- | Holds data for converting a 'Cluster.CStats' structure into
-- detailed statictics.
statsData :: [(String, Cluster.CStats -> String)]
statsData = [ ("SCORE", printf "%.8f" . Cluster.csScore)
, ("INST_CNT", printf "%d" . Cluster.csNinst)
......@@ -133,12 +135,14 @@ statsData = [ ("SCORE", printf "%.8f" . Cluster.csScore)
, ("MNODE_DSK_AVAIL", printf "%d" . Cluster.csMdsk)
]
-- | List holding 'RSpec' formatting information.
specData :: [(String, RSpec -> String)]
specData = [ ("MEM", printf "%d" . rspecMem)
, ("DSK", printf "%d" . rspecDsk)
, ("CPU", printf "%d" . rspecCpu)
]
-- | List holding 'Cluster.CStats' formatting information.
clusterData :: [(String, Cluster.CStats -> String)]
clusterData = [ ("MEM", printf "%.0f" . Cluster.csTmem)
, ("DSK", printf "%.0f" . Cluster.csTdsk)
......@@ -146,7 +150,7 @@ clusterData = [ ("MEM", printf "%.0f" . Cluster.csTmem)
, ("VCPU", printf "%d" . Cluster.csVcpu)
]
-- | Function to print stats for a given phase
-- | Function to print stats for a given phase.
printStats :: Phase -> Cluster.CStats -> [(String, String)]
printStats ph cs =
map (\(s, fn) -> (printf "%s_%s" kind s, fn cs)) statsData
......@@ -211,6 +215,7 @@ formatSpecMap =
map (\(spec, cnt) -> printf "%d,%d,%d=%d" (rspecMem spec)
(rspecDsk spec) (rspecCpu spec) cnt)
-- | Formats \"key-metrics\" values.
formatRSpec :: Double -> String -> RSpec -> [(String, String)]
formatRSpec m_cpu s r =
[ ("KM_" ++ s ++ "_CPU", show $ rspecCpu r)
......@@ -219,6 +224,7 @@ formatRSpec m_cpu s r =
, ("KM_" ++ s ++ "_DSK", show $ rspecDsk r)
]
-- | Shows allocations stats.
printAllocationStats :: Double -> Node.List -> Node.List -> IO ()
printAllocationStats m_cpu ini_nl fin_nl = do
let ini_stats = Cluster.totalResources ini_nl
......@@ -228,17 +234,18 @@ printAllocationStats m_cpu ini_nl fin_nl = do
printKeys $ formatRSpec m_cpu "POOL"ralo
printKeys $ formatRSpec m_cpu "UNAV" runa
-- | Ensure a value is quoted if needed
-- | Ensure a value is quoted if needed.
ensureQuoted :: String -> String
ensureQuoted v = if not (all (\c -> isAlphaNum c || c == '.') v)
then '\'':v ++ "'"
else v
-- | Format a list of key\/values as a shell fragment
-- | Format a list of key\/values as a shell fragment.
printKeys :: [(String, String)] -> IO ()
printKeys = mapM_ (\(k, v) ->
printf "HTS_%s=%s\n" (map toUpper k) (ensureQuoted v))
-- | Converts instance data to a list of strings.
printInstance :: Node.List -> Instance.Instance -> [String]
printInstance nl i = [ Instance.name i
, Container.nameOf nl $ Instance.pNode i
......@@ -250,7 +257,7 @@ printInstance nl i = [ Instance.name i
, show (Instance.vcpus i)
]
-- | Optionally print the allocation map
-- | Optionally print the allocation map.
printAllocationMap :: Int -> String
-> Node.List -> [Instance.Instance] -> IO ()
printAllocationMap verbose msg nl ixes =
......@@ -314,11 +321,13 @@ printTiered False spec_map _ ini_nl fin_nl sreason = do
printClusterScores ini_nl fin_nl
printClusterEff (Cluster.totalResources fin_nl)
-- | Displays the initial/final cluster scores.
printClusterScores :: Node.List -> Node.List -> IO ()
printClusterScores ini_nl fin_nl = do
printf " - initial cluster score: %.8f\n" $ Cluster.compCV ini_nl::IO ()
printf " - final cluster score: %.8f\n" $ Cluster.compCV fin_nl
-- | Displays the cluster efficiency.
printClusterEff :: Cluster.CStats -> IO ()
printClusterEff cs =
mapM_ (\(s, fn) ->
......
......@@ -180,7 +180,7 @@ data IMove = Failover -- ^ Failover the instance (f)
| FailoverAndReplace Ndx -- ^ Failover, replace secondary (f, r:ns)
deriving (Show, Read)
-- | Instance disk template type
-- | Instance disk template type.
data DiskTemplate = DTDiskless
| DTFile
| DTSharedFile
......@@ -189,7 +189,7 @@ data DiskTemplate = DTDiskless
| DTDrbd8
deriving (Show, Read, Eq, Enum, Bounded)
-- | Converts a DiskTemplate to String
-- | Converts a DiskTemplate to String.
dtToString :: DiskTemplate -> String
dtToString DTDiskless = C.dtDiskless
dtToString DTFile = C.dtFile
......@@ -198,7 +198,7 @@ dtToString DTPlain = C.dtPlain
dtToString DTBlock = C.dtBlock
dtToString DTDrbd8 = C.dtDrbd8
-- | Converts a DiskTemplate from String
-- | Converts a DiskTemplate from String.
dtFromString :: (Monad m) => String -> m DiskTemplate
dtFromString s =
case () of
......@@ -281,7 +281,7 @@ isOk _ = False
isBad :: Result a -> Bool
isBad = not . isOk
-- | Converter from Either String to 'Result'
-- | Converter from Either String to 'Result'.
eitherToResult :: Either String a -> Result a
eitherToResult (Left s) = Bad s
eitherToResult (Right v) = Ok v
......
-- Hey Emacs, this is a -*- haskell -*- file
{- | Auto-generated module holding version information.
-}
module Ganeti.HTools.Version
(
......
......@@ -37,7 +37,7 @@ import Ganeti.HTools.QC
import Ganeti.HTools.CLI
import Ganeti.HTools.Utils (sepSplit)
-- | Options list and functions
-- | Options list and functions.
options :: [OptType]
options =
[ oReplay
......@@ -61,7 +61,7 @@ slow = stdArgs
incIORef :: IORef Int -> IO ()
incIORef ir = atomicModifyIORef ir (\x -> (x + 1, ()))
-- | Wrapper over a test runner with error counting
-- | Wrapper over a test runner with error counting.
wrapTest :: IORef Int
-> (Args -> IO Result)
-> Args
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment