diff --git a/src/Ganeti/Common.hs b/src/Ganeti/Common.hs
index 75dca4bb46c59236790f8e0cfa50dbc199816eb2..17750b42f8374d2e04f63cceed33127cd5b9d751 100644
--- a/src/Ganeti/Common.hs
+++ b/src/Ganeti/Common.hs
@@ -7,7 +7,7 @@ HTools and any other programs.
{-
-Copyright (C) 2009, 2010, 2011, 2012 Google Inc.
+Copyright (C) 2009, 2010, 2011, 2012, 2013 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
@@ -62,6 +62,7 @@ import Text.Printf (printf)
import Ganeti.BasicTypes
import qualified Ganeti.Constants as C
+import Ganeti.Utils (wrap)
import qualified Ganeti.Version as Version (version)
-- | Parameter type.
@@ -203,10 +204,14 @@ maxCmdLen = 60
-- | Formats the description of various commands.
formatCommands :: (StandardOptions a) => PersonalityList a -> [String]
formatCommands personalities =
- -- FIXME: add wrapping of descriptions
- map (\(cmd, (_, _, _, desc)) -> printf " %-*s - %s" mlen cmd desc::String) $
+ concatMap (\(cmd, (_, _, _, desc)) ->
+ fmtDesc cmd (wrap maxWidth desc) "-" []) $
sortBy (comparing fst) personalities
where mlen = min maxCmdLen . maximum $ map (length . fst) personalities
+ maxWidth = 79 - 3 - mlen
+ fmtDesc _ [] _ acc = reverse acc
+ fmtDesc cmd (d : ds) sep acc =
+ fmtDesc "" ds " " (printf " %-*s %s %s" mlen cmd sep d : acc)
-- | Formats usage for a multi-personality program.
formatCmdUsage :: (StandardOptions a) => String -> PersonalityList a -> String
diff --git a/src/Ganeti/Utils.hs b/src/Ganeti/Utils.hs
index 95f4280a549da951db500a9c4c5ac692bc8aa948..74ad060c764cdeae0c7808a0a3e8efa769657784 100644
--- a/src/Ganeti/Utils.hs
+++ b/src/Ganeti/Utils.hs
@@ -48,6 +48,8 @@ module Ganeti.Utils
, getCurrentTime
, clockTimeToString
, chompPrefix
+ , wrap
+ , trim
) where
import Data.Char (toUpper, isAlphaNum, isDigit, isSpace)
@@ -326,3 +328,34 @@ chompPrefix pfx str =
if pfx `isPrefixOf` str || str == init pfx
then Just $ drop (length pfx) str
else Nothing
+
+-- | Breaks a string in lines with length \<= maxWidth.
+--
+-- NOTE: The split is OK if:
+--
+-- * It doesn't break a word, i.e. the next line begins with space
+-- (@isSpace . head $ rest@) or the current line ends with space
+-- (@null revExtra@);
+--
+-- * It breaks a very big word that doesn't fit anyway (@null revLine@).
+wrap :: Int -- ^ maxWidth
+ -> String -- ^ string that needs wrapping
+ -> [String] -- ^ string \"broken\" in lines
+wrap maxWidth = filter (not . null) . map trim . wrap0
+ where wrap0 :: String -> [String]
+ wrap0 text
+ | length text <= maxWidth = [text]
+ | isSplitOK = line : wrap0 rest
+ | otherwise = line' : wrap0 rest'
+ where (line, rest) = splitAt maxWidth text
+ (revExtra, revLine) = break isSpace . reverse $ line
+ (line', rest') = (reverse revLine, reverse revExtra ++ rest)
+ isSplitOK =
+ null revLine || null revExtra || startsWithSpace rest
+ startsWithSpace (x:_) = isSpace x
+ startsWithSpace _ = False
+
+-- | Removes surrounding whitespace. Should only be used in small
+-- strings.
+trim :: String -> String
+trim = reverse . dropWhile isSpace . reverse . dropWhile isSpace
diff --git a/test/hs/Test/Ganeti/Common.hs b/test/hs/Test/Ganeti/Common.hs
index 4f0f1ae2e272c8f316e66c66871868eef61ebd6d..923ec725261ae1e585c8732e2390ddc1248e5808 100644
--- a/test/hs/Test/Ganeti/Common.hs
+++ b/test/hs/Test/Ganeti/Common.hs
@@ -7,7 +7,7 @@
{-
-Copyright (C) 2009, 2010, 2011, 2012 Google Inc.
+Copyright (C) 2009, 2010, 2011, 2012, 2013 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
@@ -44,6 +44,9 @@ import Test.Ganeti.TestCommon
import Ganeti.BasicTypes
import Ganeti.Common
+import Ganeti.HTools.Program.Main (personalities)
+
+{-# ANN module "HLint: ignore Use camelCase" #-}
-- | Helper to check for correct parsing of an option.
checkOpt :: (StandardOptions b) =>
@@ -122,7 +125,40 @@ prop_parse_yes_no def testval val =
then result ==? Ok (actual_val == "yes")
else property $ isBad result
+-- | Check that formatCmdUsage works similar to Python _FormatUsage.
+case_formatCommands :: Assertion
+case_formatCommands =
+ assertEqual "proper wrap for HTools Main"
+ resCmdTest (formatCommands personalities)
+ where resCmdTest :: [String]
+ resCmdTest =
+ [ " hail - Ganeti IAllocator plugin that implements the instance\
+ \ placement and"
+ , " movement using the same algorithm as hbal(1)"
+ , " hbal - cluster balancer that looks at the current state of\
+ \ the cluster and"
+ , " computes a series of steps designed to bring the\
+ \ cluster into a"
+ , " better state"
+ , " hcheck - cluster checker; prints information about cluster's\
+ \ health and checks"
+ , " whether a rebalance done using hbal would help"
+ , " hinfo - cluster information printer; it prints information\
+ \ about the current"
+ , " cluster state and its residing nodes/instances"
+ , " hroller - cluster rolling maintenance helper; it helps\
+ \ scheduling node reboots"
+ , " in a manner that doesn't conflict with the instances'\
+ \ topology"
+ , " hscan - tool for scanning clusters via RAPI and saving their\
+ \ data in the"
+ , " input format used by hbal(1) and hspace(1)"
+ , " hspace - computes how many additional instances can be fit on a\
+ \ cluster, while"
+ , " maintaining N+1 status."
+ ]
testSuite "Common"
[ 'prop_parse_yes_no
+ , 'case_formatCommands
]
diff --git a/test/hs/Test/Ganeti/Utils.hs b/test/hs/Test/Ganeti/Utils.hs
index 2385e71561ea75f0363dfce2616de6a691860cda..548e4cfa318aaabc27a15e56019d593e576a5dda 100644
--- a/test/hs/Test/Ganeti/Utils.hs
+++ b/test/hs/Test/Ganeti/Utils.hs
@@ -270,6 +270,23 @@ prop_chompPrefix_nothing =
(\s -> not (pfx `isPrefixOf` s) && s /= init pfx)) $ \str ->
chompPrefix pfx str ==? Nothing
+-- | Tests 'trim'.
+prop_trim :: NonEmptyList Char -> Property
+prop_trim (NonEmpty str) =
+ forAll (listOf1 $ elements " \t\n\r\f") $ \whitespace ->
+ forAll (choose (0, length whitespace)) $ \n ->
+ let (preWS, postWS) = splitAt n whitespace in
+ conjoin [ printTestCase "arb. string first and last char are not space" $
+ case trim str of
+ [] -> True
+ xs -> (not . isSpace . head) xs && (not . isSpace . last) xs
+ , printTestCase "whitespace is striped" $
+ trim str ==? trim (preWS ++ str ++ postWS)
+ , printTestCase "whitespace reduced to null" $
+ trim whitespace ==? ""
+ , printTestCase "idempotent on empty strings" $
+ trim "" ==? ""
+ ]
-- | Test list for the Utils module.
testSuite "Utils"
@@ -287,6 +304,7 @@ testSuite "Utils"
, 'prop_niceSort_numbers
, 'prop_niceSortKey_equiv
, 'prop_rStripSpace
+ , 'prop_trim
#ifndef NO_REGEX_PCRE
, 'case_new_uuid
#endif