Merge branch 'stable-2.8' into stable-2.9

[ganeti-local] / src / Ganeti / Common.hs

diff --git a/src/Ganeti/Common.hs b/src/Ganeti/Common.hs
index 75dca4b..b907ead 100644 (file)
--- 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
@@ -45,6 +45,9 @@ module Ganeti.Common
   , parseOptsInner
   , parseOptsCmds
   , genericMainCmds
+  , fillUpList
+  , fillPairFromMaybe
+  , pickPairUnique
   ) where
 
 import Control.Monad (foldM)
@@ -62,6 +65,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.
@@ -122,7 +126,7 @@ argComplToText :: ArgCompletion -> String
 argComplToText (ArgCompletion optc min_cnt max_cnt) =
   complToText optc ++ " " ++ show min_cnt ++ " " ++ maybe "none" show max_cnt
 
--- | Abrreviation for the option type.
+-- | Abbreviation for the option type.
 type GenericOptType a = (OptDescr (a -> Result a), OptCompletion)
 
 -- | Type class for options which support help and version.
@@ -203,10 +207,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
@@ -336,3 +344,28 @@ genericMainCmds defaults personalities genopts = do
   (opts, args, fn) <-
     parseOptsCmds defaults cmd_args prog personalities genopts
   fn opts args
+
+-- | Order a list of pairs in the order of the given list and fill up
+-- the list for elements that don't have a matching pair
+fillUpList :: ([(a, b)] -> a -> (a, b)) -> [a] -> [(a, b)] -> [(a, b)]
+fillUpList fill_fn inputs pairs =
+  map (fill_fn pairs) inputs
+
+-- | Fill up a pair with fillup element if no matching pair is present
+fillPairFromMaybe :: (a -> (a, b)) -> (a -> [(a, b)] -> Maybe (a, b))
+                  -> [(a, b)] -> a -> (a, b)
+fillPairFromMaybe fill_fn pick_fn pairs element = fromMaybe (fill_fn element)
+    (pick_fn element pairs)
+
+-- | Check if the given element matches the given pair
+isMatchingPair :: (Eq a) => a -> (a, b) -> Bool
+isMatchingPair element (pair_element, _) = element == pair_element
+
+-- | Pick a specific element's pair from the list
+pickPairUnique :: (Eq a) => a -> [(a, b)] -> Maybe (a, b)
+pickPairUnique element pairs =
+  let res = filter (isMatchingPair element) pairs
+  in case res of
+    [x] -> Just x
+    -- if we have more than one result, we should get suspcious
+    _ -> Nothing