hsshellscript 3.4.1 → 3.4.2
raw patch · 10 files changed
+938/−185 lines, 10 filesdep ~basedep ~randomdep ~unixPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependency ranges changed: base, random, unix
API changes (from Hackage documentation)
- HsShellScript.Args: [argdesc_argarg_description] :: ArgumentDescription -> Maybe String
- HsShellScript.Args: data ArgumentProperty
- HsShellScript.Args: terminal_width :: Handle -> IO (Maybe Int)
- HsShellScript.Args: terminal_width_ioe :: Handle -> IO Int
+ HsShellScript: terminal_width :: Handle -> IO (Maybe Int)
+ HsShellScript: terminal_width_ioe :: Handle -> IO Int
+ HsShellScript.Args: ArgumentProperty :: (ArgumentDescription -> ArgumentDescription) -> ArgumentProperty
+ HsShellScript.Args: [argdesc_description] :: ArgumentDescription -> Maybe String
+ HsShellScript.Args: [argumentproperty] :: ArgumentProperty -> ArgumentDescription -> ArgumentDescription
+ HsShellScript.Args: argname_long :: ArgumentDescription -> String
+ HsShellScript.Args: argname_short :: ArgumentDescription -> String
+ HsShellScript.Args: newtype ArgumentProperty
- HsShellScript.Args: make_usage_info :: [ArgumentDescription] -> Int -> Int -> Int -> [String]
+ HsShellScript.Args: make_usage_info :: [ArgumentDescription] -> Int -> Int -> Int -> Int -> [String]
Files
- Makefile +1/−1
- hsshellscript.cabal +1/−1
- src/HsShellScript.hs +2/−0
- src/HsShellScript/Args.chs +321/−148
- src/HsShellScript/Args.hs-boot +4/−0
- src/HsShellScript/ProcErr.chs +3/−2
- src/HsShellScript/ProcErr.hs-boot +10/−3
- test/Makefile +2/−2
- test/args.chs +296/−14
- test/args.hs +298/−14
Makefile view
@@ -1,4 +1,4 @@-VERSION = 3.4.1+VERSION = 3.4.2 default :: lib
hsshellscript.cabal view
@@ -1,5 +1,5 @@ Name: hsshellscript-Version: 3.4.1+Version: 3.4.2 Synopsis: Haskell for Unix shell scripting tasks Description: A Haskell-library for tasks which are usually done in shell scripts. This includes parsing command line
src/HsShellScript.hs view
@@ -69,6 +69,8 @@ -- * Output to the standard stream, colorful logging and error reporting outm, outm_, logm, logm_, errm, errm_, isatty,+ terminal_width, terminal_width_ioe,+ -- * Miscellaneous zeros, chomp, lazy_contents, contents, glob, glob_quote,
src/HsShellScript/Args.chs view
@@ -12,25 +12,36 @@ -- of HsShellScript.Args looks something like this: -- -- >import HsShellScript+-- >import Control.Exception+-- >import Control.Monad+-- >import System.Environment+-- >import System.Exit+-- >import System.IO -- >--- >main =--- > do let a_onevalue = argdesc [ desc_at_most_once, ... ]--- > a_values = argdesc [ desc_direct, ... ]--- > a_switch = argdesc [ ... ]--- > ...--- > header = "mclapep - My Command Line Argument Parser Example Program, version 1.0.0"+-- >header = "mclapep - My Command Line Argument Parser Example Program, version 1.0.0\n\n"+-- >descs = [d_onevalue, d_values, d_switch {-...-}] -- >--- > args <- getargs header [a_onevalue, a_values, a_switch, ...]+-- >d_onevalue = argdesc [ desc_short 'o', desc_at_most_once, desc_argname "a", desc_value_required {-...-}]+-- >d_values = argdesc [ desc_direct, desc_any_times {-...-} ]+-- >d_switch = argdesc [ desc_at_most_once, desc_short 's', desc_argname "sw", desc_value_required {-...-} ] +-- >-- ... -- >--- > val <- optarg_req a_onevalue args -- val :: Maybe String--- > vals <- args_req a_values args -- vals :: [String]--- > doit <- arg_switch a_switch args -- doit :: Bool--- > ...--- > `catch`--- > (\argerror -> do--- > hPutStrLn stderr $ (argerror_message argerror) ++ "\n\n" ++ (argerror_usageinfo argerror)--- > exitFailure--- > )+-- >args = unsafe_getargs header descs+-- >val = optarg_req args d_onevalue -- val :: Maybe String+-- >vals = args_req args d_values -- vals :: [String]+-- >doit = arg_switch args d_switch -- doit :: Bool+-- >-- ...+-- >+-- >main = mainwrapper $ do+-- > args0 <- getArgs+-- > when (null args0) $ do+-- > -- No command line arguments - print usage information+-- > print_usage_info stdout header descs+-- > exitWith ExitSuccess+-- > -- trigger argument errors+-- > seq args (return ())+-- >+-- > -- Do something with the arguments -- -- Errors in the argument descriptions are regarded as bugs, and handled -- by aborting the program with a message which is meaningful to the@@ -43,7 +54,7 @@ -- value, or thrown as an exception. module HsShellScript.Args ( -- ** Argument Properties- ArgumentProperty+ ArgumentProperty (..) , ArgumentDescription (..) , ArgumentValueSpec (..) , Argtester@@ -99,15 +110,15 @@ , print_usage_info , argname , argname_a+ , argname_short+ , argname_long , wrap- , terminal_width- , terminal_width_ioe ) where -- We use a fixed copy of GHC's GetOpt implementation. This is to work around a bug. -- import System.Console.GetOpt import HsShellScript.GetOpt-import {-# SOURCE #-} HsShellScript.ProcErr+import {-# SOURCE #-} HsShellScript.ProcErr (terminal_width, terminal_width_ioe) import Foreign.C import System.Environment@@ -123,7 +134,8 @@ import Data.Char import Debug.Trace import Data.Typeable-+import Control.Concurrent.MVar+import GHC.IO.Handle.Internals -- withHandle', do_operation @@ -149,20 +161,20 @@ -- | Description of one command line argument. These are generated by -- @argdesc@ from a list of argument properties, and subsequently used by one of the--- @getargs@... functions. This type is abstract.+-- @getargs@... functions. data ArgumentDescription = ArgumentDescription { argdesc_short_args :: [Char], -- ^ Short option names argdesc_long_args :: [String], -- ^ Long option names argdesc_argarg :: ArgumentValueSpec, -- ^ What about a possible value of the argument? argdesc_times :: Maybe (Int,Int), -- ^ Minimum and maximum of number of occurences allowed argdesc_argargname :: Maybe String, -- ^ Name for argument's value, for message generation- argdesc_argarg_description :: Maybe String, -- ^ Descrition of the argument, for message generation+ argdesc_description :: Maybe String, -- ^ Descrition of the argument, for message generation argdesc_argarg_tester :: Maybe Argtester -- ^ Argument value tester } -- excluding tester ad_tup ad =- (argdesc_short_args ad, argdesc_long_args ad, argdesc_argarg ad, argdesc_times ad, argdesc_argargname ad, argdesc_argarg_description ad)+ (argdesc_short_args ad, argdesc_long_args ad, argdesc_argarg ad, argdesc_times ad, argdesc_argargname ad, argdesc_description ad) instance Eq ArgumentDescription where d == e = ad_tup d == ad_tup e@@ -205,7 +217,7 @@ argdesc_argarg = ArgumentValue_none, argdesc_times = Nothing, -- default = (0,1) argdesc_argargname = Nothing,- argdesc_argarg_description = Nothing,+ argdesc_description = Nothing, argdesc_argarg_tester = Nothing } @@ -240,11 +252,11 @@ -- -- The usage information is generated by the deprecated function usage_info. Better ignore this, and use the newer @make_usage_info@ or @print_usage_info@. ----- See 'usage_info', 'make_usage_info', 'print_usage_info'.+-- See 'make_usage_info', 'print_usage_info', 'usage_info'. data ArgError = ArgError { -- | Error message argerror_message :: String,- -- | Usage information, as generated by the now deprecated function usage_info.+ -- | Deprecated. Usage information, as generated by the now deprecated function 'usage_info'. argerror_usageinfo :: String } deriving (Typeable)@@ -419,16 +431,15 @@ ) -- |--- Specify a short description of what the argument does. Used for the--- generation of the usage message. This is to fit on one line, after the--- short and long argument names. It should be 40 characters long or so.+-- Specify a description of what the argument does. Used for usage message+-- generation. This can be arbitratily long, long lines are wrapped. desc_description :: String -- ^ Short description of the argument.- -> ArgumentProperty -- ^ The corresponding argument property.+ -> ArgumentProperty -- ^ The corresponding argument property. desc_description expl = ArgumentProperty (\desc ->- if argdesc_argarg_description desc == Nothing- then desc { argdesc_argarg_description = Just expl }- else abort "Bug in HsShellScript argument description: Multiple explanations specified" desc+ if argdesc_description desc == Nothing+ then desc { argdesc_description = Just expl }+ else abort "Bug in HsShellScript argument description: Multiple argument descriptions specified" desc ) -- | Specify a tester for this argument. The tester is a function which tests the argument value for format errors. Typically, it tests whether the@@ -521,6 +532,78 @@ else if (argdesc_short_args desc, argdesc_long_args desc) == ([],[]) then "yet unnamed argument" else "argument " ++ concat (intersperse "/" ( map (\s -> "-"++[s]) (argdesc_short_args desc) ++ map ("--" ++) (argdesc_long_args desc) )) +++{- | Create a string, which lists the short forms of one command line argument. If+it has an subargument, it's name is listed as well. For arguments without short+form, the result is the empty string.++For the illegal command line argument, with neither short nor long forms, and+not being the direct argument either, the result is @"yet unnamed argument"@.+Such argument descriptions are incomplete, and will be rejected by @getargs@ and+@unsafe_getargs@.++This is meant for refering to an argument, such as in error messages or usage+information.++Examples:++>argname_short (argdesc [ desc_short 'a'+> , desc_short 'b'+> , desc_value_required+> , desc_argname "Name"+> ])+> == "-a/-b Name"++See 'argdesc', 'desc_direct'. 'argname_long'.+-} +argname_short :: ArgumentDescription -- ^ Argument description, as returned by @argdesc@+ -> String -- ^ Printable name for the argument+argname_short desc =+ if (argdesc_short_args desc, argdesc_long_args desc) == ([],[""]) then ""+ else if (argdesc_short_args desc, argdesc_long_args desc) == ([],[]) then "yet unnamed argument"+ else concat (intersperse "/" (map (\s -> "-" ++ [s]) (argdesc_short_args desc)))+ ++ case argdesc_argargname desc of+ Just name -> " " ++ name+ Nothing -> ""+++{- | Create a string, which lists the long forms of one command line argument. If+it has an subargument, it's name is listed as well. For arguments without long+form, the result is the empty string.++For the illegal command line argument, with neither short nor long forms, and+not being the direct argument either, the result is @"yet unnamed argument"@.+Such argument descriptions are incomplete, and will be rejected by @getargs@ and+@unsafe_getargs@.++This is meant for refering to an argument, such as in error messages or usage+information.++Examples:++>argname_long (argdesc [ desc_long "foo"+> , desc_long "bar"+> , desc_value_required+> , desc_argname "Name"+> ])+> == "--foo/--bar Name"++See 'argdesc', 'desc_direct'. 'argname_long'.+-} ++argname_long :: ArgumentDescription -- ^ Argument description, as returned by @argdesc@+ -> String -- ^ Printable name for the argument+argname_long desc =+ if (argdesc_short_args desc, argdesc_long_args desc) == ([],[""]) then ""+ else if (argdesc_short_args desc, argdesc_long_args desc) == ([],[]) then "yet unnamed argument"+ else concat (intersperse "/" (map (\s -> "--" ++ s) (argdesc_long_args desc)))+ ++ case argdesc_argargname desc of+ Just name -> " " ++ name+ Nothing -> ""+++ up1 "" = "" up1 (x:xs) = toUpper x : xs @@ -536,7 +619,7 @@ else () ) $ desc { argdesc_times = Just (fromMaybe times_default (argdesc_times desc))- , argdesc_argarg_description = Just (fromMaybe "" (argdesc_argarg_description desc))+ , argdesc_description = Just (fromMaybe "" (argdesc_description desc)) } ) @@ -588,7 +671,7 @@ ArgumentValue_optional -> OptArg (\arg -> (desc, arg)) (fromJust (argdesc_argargname desc)) )- (fromJust (argdesc_argarg_description desc))+ (fromJust (argdesc_description desc)) -- Postprocessing after successful call to getOpt getopt_post :: [ArgOcc] -> [String] -> Either ArgError Arguments@@ -1000,11 +1083,11 @@ -- -- Descriptions can be several lines long. Lines get wrapped at column 80. ----- See 'make_usage_info', 'print_usage_info', 'wrap', 'terminal_width', 'terminal_width_ioe'.+-- See 'make_usage_info', 'print_usage_info', 'wrap'. usage_info :: Arguments -> String usage_info (Arguments (l, header)) = unlines (wrap 80 header) ++- concat (intersperse "\n" (make_usage_info (map fst l) 0 20 80))+ concat (intersperse "\n" (make_usage_info (map fst l) 0 10 30 80)) @@ -1063,6 +1146,12 @@ +make_usage_info1 :: [ArgumentDescription] -> String+make_usage_info1 argdescs =+ concat (intersperse "\n" (make_usage_info argdescs 0 10 30 80))+++ -- | -- Generate pretty-printed information about the command line arguments. This -- function gives you much control on how the usage information is generated.@@ -1075,86 +1164,209 @@ -- The direct argument, in case there is one, is omitted. You should detail the -- direct command line arguments separatly, such as in some header. --+-- The specified maximum breadths must fit in the specified width, or an error+-- is raised. This happens, when @colsleft + colsshort + 2 + colslong + 2 + 2 >+-- width@.+-- -- See 'print_usage_info', 'getargs', 'usage_info', 'ArgumentDescription',--- 'desc_description', 'argdesc', 'terminal_width', 'terminal_width_ioe".+-- 'desc_description', 'argdesc', 'terminal_width', 'terminal_width_ioe'. make_usage_info :: [ArgumentDescription] -- ^ List of argument descriptions, as created by a @argdesc@ -> Int -- ^ The output is indented this many columns. Probably zero.- -> Int -- ^ How much columns to reserve for the argument name and name- -- of the value of the argument (if any). Somthing like 10 or 15.+ -> Int -- ^ Maximum width of the column of the short form of each argument. When this many aren't+ -- needed, less are used.+ -> Int -- ^ Maximum width of the column of the long form of each argument. When this many aren't+ -- needed, less are used. -> Int -- ^ Wrap everything at this column. Should probably be the terminal width.- -> [String] -- ^ pretty printed usage information-make_usage_info argdescs colsleft colsarg width =+ -> [String] -- ^ Pretty printed usage information, in paragraphs, which contain one or several lines.+make_usage_info descs colsleft colsshort colslong width = - if width < colsleft + colsarg + 2- then error ("Bug in make_usage_info: geometry doesn't match: "- ++ show width ++ " < " ++ show colsleft ++ " + " ++ show colsarg ++ " + 2")- else+ if colsleft + colsshort + 2 + colslong + 2 + 2 > width+ then error $ "make_usage_info: colsleft, colsshort, and colslong arguments \+ \are too large for the specified width argument.\n\+ \colsleft = " ++ show colsleft ++ " \n\+ \colsshort = " ++ show colsshort ++ " \n\+ \colslong = " ++ show colslong ++ " \n\+ \width = " ++ show width+ else + map unlines (verbinden (zll' (filter (\d -> not (is_direct d)) + descs)+ ))+ + where+ -- Die Argumentbeschreibung, auf die richtige Breite umgebrochen+ beschr :: ArgumentDescription -> [String]+ beschr desc = wrap (width - colsleft - gesamtbr_kurz - 2 - gesamtbr_lang - 2)+ (fromMaybe "" (argdesc_description desc))+ + -- Eine ArgumentDescription rendern. Die fertigen Zeilen sind alle gleich viele (mit "" aufgefüllt).+ auff1 :: ArgumentDescription + -> ([String], [String], [String])+ auff1 desc = auff (kurzname desc)+ (langname desc)+ (beschr desc)+ + -- Wir haben für eine Argumentbeschreibung die Listen von Zeilen, aus denen der kurze, und lange Argumentname besteht, sowie die Zeilen, aus+ -- denen die Argumentbeschreibung besteht.+ zus :: ([String], [String], [String]) -> [(String, String, String)]+ zus (as, bs, cs) = zip3 as bs cs+ + -- Die für die Kurzform einses Arguments benötigte Zahl von Spalten+ kurzbr :: ArgumentDescription -> Int+ kurzbr desc =+ foldr max 0 (map length (kurzname desc))+ + -- Die für die Langform einses Arguments benötigte Zahl von Spalten+ langbr :: ArgumentDescription -> Int+ langbr desc =+ foldr max 0 (map length (langname desc))+ + -- Breite der Kurzform, über alle Argumente hinweg+ gesamtbr_kurz =+ foldr max 0 (map (\desc -> kurzbr desc) descs)+ + -- Breite der Langform, über alle Argumente hinweg+ gesamtbr_lang =+ foldr max 0 (map (\desc -> langbr desc) descs)+ + -- Breite der Beschreibungen+ breite_descr :: Int+ breite_descr = width - colsleft - gesamtbr_kurz - 2 - gesamtbr_lang - 2 - map (\desc -> make_usage_info1 colsleft colsarg width desc)- (filter (\desc -> not (is_direct desc)) argdescs)+ -- Für jedes Kommandozeilenargument die Liste der Zeilen+ zll :: [ArgumentDescription]+ -> [[(String, String, String)]]+ zll descs =+ map (zus . auff1) descs+ + -- Für jedes Kommandozeilenargument die Liste der Zeilen, aufgefüllt auf einheitliche Breite+ zll' :: [ArgumentDescription]+ -> [[(String, String, String)]]+ zll' [] = + []+ zll' descs = + map (\l -> map (\(a,b,c) -> (fuell gesamtbr_kurz a, + fuell gesamtbr_lang b, + c))+ l)+ (zll descs)+ + -- Die Tripel + verbinden :: [[(String, String, String)]]+ -> [[String]]+ verbinden l =+ map (\l' -> map (\(a,b,c) -> take colsleft (repeat ' ') + ++ a ++ " " ++ b ++ " " ++ c) l')+ l+ + -- Die Kurzform des angegebenen Arguments. In Zeilen heruntergebrochen,+ -- wenn die Breite colsshort überschritten wird.+ kurzname :: ArgumentDescription -> [String]+ kurzname desc =+ wrap colsshort (argname_short desc)+ + -- Die Langform des angegebenen Arguments. In Zeilen heruntergebrochen,+ -- wenn die Breite colslong überschritten wird+ langname :: ArgumentDescription -> [String]+ langname desc =+ wrap colslong (argname_long desc)+ + -- Den gegebenen String um so viele Leerzeichen ergänzen, daß daraus ein String der gegebenen Länge wird. Ist er dafür zu lang, denn den+ -- unveränderten String zurückgeben.+ fuell :: Int -> String -> String+ fuell br txt =+ txt ++ take (br - length txt) (repeat ' ')+ - where- -- Make the usage info for one argument description- make_usage_info1 :: Int -> Int -> Int -> ArgumentDescription -> String- make_usage_info1 colsleft colsarg width desc =- unlines $ einruecken1 colsleft $+ -- Complete three lists of Strings. All three strings are made to be made up+ -- of the same number of entries. Missing entries at the end are filled up with+ -- empty strings.+ auff :: [String] -> [String] -> [String] -> ([String], [String], [String])+ auff a b c =+ (reverse x, reverse y, reverse z)+ + where+ (x,y,z) = auff' a b c [] [] []+ + auff' :: [String] -> [String] -> [String]+ -> [String] -> [String] -> [String]+ -> ([String], [String], [String])+ + auff' [] [] [] a1 b1 c1 =+ (a1, b1, c1)+ + auff' a b c a1 b1 c1 =+ auff' (if null a then [] else tail a)+ (if null b then [] else tail b)+ (if null c then [] else tail c)+ ((if null a then "" else head a) : a1)+ ((if null b then "" else head b) : b1)+ ((if null c then "" else head c) : c1)+ - case argdesc_argarg_description desc of - -- Das Argument hat eine Beschreibung- Just txt ->- if length (argname1 desc) >= colsarg- then- -- Der Parameter paßt nicht in die vorgegebene Breite.- -- Füge eine extra Zeile hinzu.- argname1 desc- : einruecken1 colsarg (wrap breite txt) - else- -- Der Parameter paßt in die vorgegebene Breite. Fange- -- in derselben Zeile mit der Beschreibung an.- -- Füge eine extra Zeile hinzu.- let (bzl1:bzlrest) = einruecken colsarg (wrap breite txt)- in- (auff colsarg (argname1 desc) ++ bzl1)- : bzlrest-- -- Das Argument hat keine Beschreibung. Gebe nur den Argumentname aus.- Nothing ->- [ argname1 desc ]-- -- Argumentname zusammen mit Argumentwert-Name- argname1 desc =- argname desc- ++ case argdesc_argargname desc of- Just name -> " " ++ name- Nothing -> ""-- breite = width - colsleft - colsarg-- lz n = take n (repeat ' ')-- auff :: Int -> String -> String- auff n str = if length str <= n then str ++ lz (n - length str)- else str--- -- Einrücken, ab zweiter Zeile. Erste Zeile NICHT einrücken.- einruecken :: Int -> [String] -> [String]- einruecken _ [] = [""]- einruecken spalten (zl:zll) =- zl : map (\z -> lz spalten ++ z) zll+-- |+-- Print the usage information (about the command line arguments), for the+-- specified header and arguments to the specified handle. When the handle is+-- connected to a terminal, the terminal\'s width (in columns) is used to format+-- the output, such that it fits the terminal. Both the header and the argument+-- descriptions are adapted to the width of the terminal (by using @wrap@).+--+-- When the handle does not connected to a terminal, 80 columns are used. This+-- may happen to @stdout@ or @stderr@, for instance, when the program is in a+-- pipe, or the output has been redirected to a file.+--+-- When the terminal is too narrow for useful output, then instead of the usage+-- information, a short message (@"Terminal too narrow"@) is printed. This+-- applies to terminals with a width of less than 12.+--+-- You should specify one long line for each paragraph in the header and the+-- argument descriptions, and let print_usage_info do the wrapping. When you+-- have several paragraphs, separate them by a double @\\n\\n@. This also applies +-- for an empty line, which should be printed after the actual header.+--+-- The arguments are printed in the order, in which they occur in the argument+-- description list.+--+-- This function is a front end to @terminal_width@ and @make_usage_info@.+--+-- See 'argdesc', 'desc_description', 'terminal_width', 'make_usage_info', 'usage_info', 'wrap'.+print_usage_info :: Handle -- ^ To which handle to print the+ -- usage info.+ -> String -- ^ The header to print first.+ -- Can be empty.+ -> [ArgumentDescription] -- ^ The argument description of+ -- the arguments, which should be documented.+ -> IO ()+print_usage_info h header descs = do - -- Alle Zeilen eirücken- einruecken1 :: Int -> [String] -> [String]- einruecken1 _ [] = [""]- einruecken1 spalten zll =- map (\z -> lz spalten ++ z) zll+ -- Determine the width to use+ mw <- terminal_width h+ let w = case mw of+ Just w -> w+ Nothing -> 80 + {-+ if w < 12+ then ioError (mkIOError userErrorType "The terminal width is too small (< 12) for printing \+ \of the usage information. See print_usage_info." (Just h) Nothing)+ else+ -} -make_usage_info1 argdescs =- concat (intersperse "\n" (make_usage_info argdescs 0 10 80))+ if w < 12 + then hPutStr h "Terminal too narrow" + else do -- Wrap and print the header+ hPutStr h (unlines (wrap w header))+ + -- Print the argument descriptions.+ mapM_ (hPutStr h)+ (make_usage_info descs + 0 + (w `div` 5) + (w `div` 3)+ w)+ -- | -- Break down a text to lines, such that each one has the specified@@ -1165,7 +1377,7 @@ -- -- The text is wrapped at space characters. Words remain intact, except when -- they are too long for one line.-wrap :: Int -- ^ Width for the result text, in columns+wrap :: Int -- ^ Maximum width for the lines of the text, which is to be broken down -> String -- ^ Text to break down -> [String] -- ^ The broken down text in columns wrap breite [] = []@@ -1177,6 +1389,10 @@ wrap' :: Int -> String -> [String] wrap' breite [] = [""] wrap' breite txt =+ wrap'' breite (dropWhile isSpace txt)++ wrap'' :: Int -> String -> [String]+ wrap'' breite txt = if length txt <= breite then [txt] else@@ -1205,46 +1421,3 @@ in (zl''', wort') ----- |--- Print the usage information (about the command line arguments), for the--- specified header and arguments to the specified handle. When the handle is--- connected to a terminal, the terminal\'s width (in columns) is used to format--- the output, such that it fits the terminal. Both the header and the argument--- descriptions are adapted to the width of the terminal (by using @wrap@).------ When the handle does not connected to a terminal, 80 columns are used. This--- may happen to @stdout@ or @stderr@, for instance, when the program is in a--- pipe, or the output has been redirected to a file.------ You should specify one long line for each paragraph in the header and the--- argument descriptions, and let print_usage_info do the wrapping. When you--- have several paragraphs, separate them by a double @\\n\\n@.------ The arguments are printed in the order, in which they occur in the argument--- description list.------ This function is a front end to @terminal_width@ and @make_usage_info@.------ See 'argdesc', 'desc_description', 'terminal_width', 'make_usage_info', 'usage_info', 'wrap'.-print_usage_info :: Handle -- ^ To which handle to print the- -- usage info.- -> String -- ^ The header to print first.- -- Can be empty.- -> [ArgumentDescription] -- ^ The argument description of- -- the arguments, which should be documented.- -> IO ()-print_usage_info h header descs = do- -- Determine the width to use- mw <- terminal_width h- let w = case mw of- Just w -> w- Nothing -> 80-- -- Wrap and print the header- hPutStr h (unlines (wrap w header))-- -- Print the argument descriptions- mapM_ (hPutStrLn h)- (make_usage_info descs 0 (w `div` 8 + 1) w)
src/HsShellScript/Args.hs-boot view
@@ -1,5 +1,7 @@ module HsShellScript.Args where +import GHC.IO+ data ArgError = ArgError { argerror_message :: String, argerror_usageinfo :: String@@ -7,3 +9,5 @@ deriving (Typeable) +terminal_width_ioe :: Handle -> IO Int+terminal_width :: Handle -> IO (Maybe Int)
src/HsShellScript/ProcErr.chs view
@@ -54,6 +54,8 @@ ++ {- | Improved version of @System.Posix.Files.setFileMode@, which sets the file name in the @IOError@ which is thrown in case of an error. The implementation in GHC 6.2.2 neglects to do this. @@ -2397,7 +2399,6 @@ instance Exception ProcessStatus - -- | Determine the terminal width in columns. -- -- This value can be used to format output to fit the terminal.@@ -2409,7 +2410,7 @@ -- See 'terminal_width', 'make_usage_info', 'print_usage_info', 'usage_info', 'wrap'. terminal_width_ioe :: Handle -- ^ Handle, which is connected to the terminal -> IO Int -- ^ The number of columns in the constrolling terminal. - -- Nothing, when the handle isn't connected to a terminal.+ -- Throws an IOError when the handle isn't connected to a terminal. terminal_width_ioe h = do fd <- unsafeWithHandleFd h $ \fd -> do
src/HsShellScript/ProcErr.hs-boot view
@@ -1,9 +1,16 @@ module HsShellScript.ProcErr where import Data.Maybe-import System.IO+import System.IO (Handle)+import Control.Concurrent.MVar+import GHC.IO.Handle.Internals -- withHandle', do_operation -terminal_width :: Handle -> IO (Maybe Int)-terminal_width_ioe :: Handle -> IO Int throwErrno' :: String -> Maybe Handle -> Maybe FilePath -> IO a++-- unsafeWithHandleFd :: Handle -> (Fd -> IO a) -> IO a+-- unsafeWithHandleFd' :: Handle -> MVar Handle__ -> (Fd -> IO a) -> IO a+ ++terminal_width_ioe :: Handle -> IO Int+terminal_width :: Handle -> IO (Maybe Int)
test/Makefile view
@@ -8,10 +8,10 @@ % : %.o cteile.o- ghc -o $@ $^ -package unix -package directory -package random -package parsec -package hsshellscript+ ghc -o $@ $^ -package unix -package directory -package random -package parsec -package hsshellscript -XScopedTypeVariables %.o : %.hs- ghc -c $(CFLAGS) $^+ ghc -c $(CFLAGS) $^ -XScopedTypeVariables # %.o : %.c
test/args.chs view
@@ -1,10 +1,9 @@--- Fehler, wenn die Breiten nicht hinkommen in make_usage_info- module Main (main) where -import HsShellScript+import HsShellScript {-hiding (make_usage_info, print_usage_info, wrap)-} import Data.Maybe import Data.List+import Data.Char import Debug.Trace import Control.Monad import Control.Exception@@ -12,7 +11,7 @@ header = "Testprogramm für Kommandozeilenargumente\n\n"-descs = [ d_trenner, d_pfade, d_uml, d_komp, d_inhalt ]+descs = [ d_komp, d_trenner, d_pfade, d_uml, d_inhalt, d_bla ] args = unsafe_getargs header descs trenner_normal = " - " @@ -22,46 +21,329 @@ komp = optarg_req args d_komp -d_komp = +d_komp = argdesc [ desc_short 'k'+ , desc_short 'l'+ , desc_short 'm' , desc_long "komp"+ , desc_long "komp1"+ , desc_long "komp2" , desc_value_required , desc_argname "<Name>" , desc_description "Das ist eine lange Argumentbeschreibung, die umgebrochen werden muß, weil sie zu lang ist. Wirklich. Undhierkommteinganzlangeswortdasgetrenntwerdenmuß" ] -d_trenner = +d_trenner = argdesc [ desc_short 't' , desc_long "langer-param" , desc_at_most_once , desc_value_required , desc_argname "<Txt>"- , desc_description ("Diese Beschreibung\nhat mehrere\n\nZeilen.")+ , desc_description "Diese Beschreibung\nhat mehrere\nZeilen." ] -d_uml = +d_uml = argdesc [ desc_long "äöüß" , desc_at_most_once ] -d_pfade = +d_pfade = argdesc [ desc_direct , desc_any_times , desc_description ("Pfade, denen vorgesetzt werden soll; bzw, bla bla Verzeichnisse, die ihren Inhalten vorgesetzt werden sollen") ] -d_inhalt = +d_inhalt = argdesc [ desc_long "inhalt" , desc_description ("Nicht angegebenen Dateien vorsetzen, sondern dem Inhalt der angegebenen Verzeichnisse. Angegebene Nicht-Verzeichnisse \ \beiseitelassen.") ] +d_bla = + argdesc [ desc_long "foo"+ , desc_short 'h'+ , desc_value_required+ , desc_argname "Name"+ , desc_description "bla bla bla bla bla bla bla bla bla bla bla bla bla bla bla bla bla bla bla bla bla bla bla bla bla bla \+ \bla bla bla bla bla bla bla bla bla bla bla bla bla bla bla bla "+ ] + main = mainwrapper $ do seq args (return ())++ print_usage_info stdout "Header\n\n" descs++++{-+-- |+-- Generate pretty-printed information about the command line arguments. This+-- function gives you much control on how the usage information is generated.+-- @print_usage_info@ might be more like what you need.+--+-- The specified argument descriptions (as taken by the @getargs@... functions)+-- are processed in the given order. Each one is formatted as a paragraph,+-- detailing the argument. This is done according to the specified geometry.+--+-- The direct argument, in case there is one, is omitted. You should detail the+-- direct command line arguments separatly, such as in some header.+--+-- The specified maximum breadths must fit in the specified width, or an error+-- is raised. This happens, when @colsleft + colsshort + 2 + colslong + 2 + 2 >+-- width@.+-- +-- See 'print_usage_info', 'getargs', 'usage_info', 'ArgumentDescription',+-- 'desc_description', 'argdesc', 'terminal_width', 'terminal_width_ioe'.+make_usage_info :: [ArgumentDescription] -- ^ List of argument descriptions, as created by a @argdesc@+ -> Int -- ^ The output is indented this many columns. Probably zero.+ -> Int -- ^ Maximum width of the column of the short form of each argument. When this many aren't+ -- needed, less are used.+ -> Int -- ^ Maximum width of the column of the long form of each argument. When this many aren't+ -- needed, less are used.+ -> Int -- ^ Wrap everything at this column. Should probably be the terminal width.+ -> [String] -- ^ Pretty printed usage information, in paragraphs, which contain one or several lines.+make_usage_info descs colsleft colsshort colslong width =++ if colsleft + colsshort + 2 + colslong + 2 + 2 > width+ then error $ "make_usage_info: colsleft, colsshort, and colslong arguments \+ \are too large for the specified width argument.\n\+ \colsleft = " ++ show colsleft ++ " \n\+ \colsshort = " ++ show colsshort ++ " \n\+ \colslong = " ++ show colslong ++ " \n\+ \width = " ++ show width+ else + map unlines (verbinden (zll' (filter (\d -> not (is_direct d)) + descs)+ ))+ + where+ -- Die Argumentbeschreibung, auf die richtige Breite umgebrochen+ beschr :: ArgumentDescription -> [String]+ beschr desc = wrap (width - colsleft - gesamtbr_kurz - 2 - gesamtbr_lang - 2)+ (fromMaybe "" (argdesc_description desc)) - print_usage_info stdout "Das ist ein langer Header... Das ist ein langer Header... Das ist ein langer Header... Das\- \ist ein langer Header... Das ist ein langer Header... Das ist ein langer Header... Das ist \- \ein langer Header... Das ist ein langer Header... Das ist ein langer Header... \n\n"- descs+ -- Eine ArgumentDescription rendern. Die fertigen Zeilen sind alle gleich viele (mit "" aufgefüllt).+ auff1 :: ArgumentDescription + -> ([String], [String], [String])+ auff1 desc = auff (kurzname desc)+ (langname desc)+ (beschr desc)+ + -- Wir haben für eine Argumentbeschreibung die Listen von Zeilen, aus denen der kurze, und lange Argumentname besteht, sowie die Zeilen, aus+ -- denen die Argumentbeschreibung besteht.+ zus :: ([String], [String], [String]) -> [(String, String, String)]+ zus (as, bs, cs) = zip3 as bs cs+ + -- Die für die Kurzform einses Arguments benötigte Zahl von Spalten+ kurzbr :: ArgumentDescription -> Int+ kurzbr desc =+ foldr max 0 (map length (kurzname desc))+ + -- Die für die Langform einses Arguments benötigte Zahl von Spalten+ langbr :: ArgumentDescription -> Int+ langbr desc =+ foldr max 0 (map length (langname desc))+ + -- Breite der Kurzform, über alle Argumente hinweg+ gesamtbr_kurz =+ foldr max 0 (map (\desc -> kurzbr desc) descs)+ + -- Breite der Langform, über alle Argumente hinweg+ gesamtbr_lang =+ foldr max 0 (map (\desc -> langbr desc) descs)+ + -- Breite der Beschreibungen+ breite_descr :: Int+ breite_descr = width - colsleft - gesamtbr_kurz - 2 - gesamtbr_lang - 2 + -- Für jedes Kommandozeilenargument die Liste der Zeilen+ zll :: [ArgumentDescription]+ -> [[(String, String, String)]]+ zll descs =+ map (zus . auff1) descs+ + -- Für jedes Kommandozeilenargument die Liste der Zeilen, aufgefüllt auf einheitliche Breite+ zll' :: [ArgumentDescription]+ -> [[(String, String, String)]]+ zll' [] = + []+ zll' descs = + map (\l -> map (\(a,b,c) -> (fuell gesamtbr_kurz a, + fuell gesamtbr_lang b, + c))+ l)+ (zll descs)+ + -- Die Tripel + verbinden :: [[(String, String, String)]]+ -> [[String]]+ verbinden l =+ map (\l' -> map (\(a,b,c) -> take colsleft (repeat ' ') + ++ a ++ " " ++ b ++ " " ++ c) l')+ l+ + -- Die Kurzform des angegebenen Arguments. In Zeilen heruntergebrochen,+ -- wenn die Breite colsshort überschritten wird.+ kurzname :: ArgumentDescription -> [String]+ kurzname desc =+ wrap colsshort (argname_short desc)+ + -- Die Langform des angegebenen Arguments. In Zeilen heruntergebrochen,+ -- wenn die Breite colslong überschritten wird+ langname :: ArgumentDescription -> [String]+ langname desc =+ wrap colslong (argname_long desc)+ + -- Den gegebenen String um so viele Leerzeichen ergänzen, daß daraus ein String der gegebenen Länge wird. Ist er dafür zu lang, denn den+ -- unveränderten String zurückgeben.+ fuell :: Int -> String -> String+ fuell br txt =+ txt ++ take (br - length txt) (repeat ' ')+ ++ -- Complete three lists of Strings. All three strings are made to be made up+ -- of the same number of entries. Missing entries at the end are filled up with+ -- empty strings.+ auff :: [String] -> [String] -> [String] -> ([String], [String], [String])+ auff a b c =+ (reverse x, reverse y, reverse z)+ + where+ (x,y,z) = auff' a b c [] [] []+ + auff' :: [String] -> [String] -> [String]+ -> [String] -> [String] -> [String]+ -> ([String], [String], [String])+ + auff' [] [] [] a1 b1 c1 =+ (a1, b1, c1)+ + auff' a b c a1 b1 c1 =+ auff' (if null a then [] else tail a)+ (if null b then [] else tail b)+ (if null c then [] else tail c)+ ((if null a then "" else head a) : a1)+ ((if null b then "" else head b) : b1)+ ((if null c then "" else head c) : c1)+ ++++-- |+-- Print the usage information (about the command line arguments), for the+-- specified header and arguments to the specified handle. When the handle is+-- connected to a terminal, the terminal\'s width (in columns) is used to format+-- the output, such that it fits the terminal. Both the header and the argument+-- descriptions are adapted to the width of the terminal (by using @wrap@).+--+-- When the handle does not connected to a terminal, 80 columns are used. This+-- may happen to @stdout@ or @stderr@, for instance, when the program is in a+-- pipe, or the output has been redirected to a file.+--+-- When the terminal is too narrow for useful output, then instead of the usage+-- information, a short message (@"Terminal too narrow"@) is printed. This+-- applies to terminals with a width of less than 12.+--+-- You should specify one long line for each paragraph in the header and the+-- argument descriptions, and let print_usage_info do the wrapping. When you+-- have several paragraphs, separate them by a double @\\n\\n@. This also applies +-- for an empty line, which should be printed after the actual header.+--+-- The arguments are printed in the order, in which they occur in the argument+-- description list.+--+-- This function is a front end to @terminal_width@ and @make_usage_info@.+--+-- See 'argdesc', 'desc_description', 'terminal_width', 'make_usage_info', 'usage_info', 'wrap'.+print_usage_info :: Handle -- ^ To which handle to print the+ -- usage info.+ -> String -- ^ The header to print first.+ -- Can be empty.+ -> [ArgumentDescription] -- ^ The argument description of+ -- the arguments, which should be documented.+ -> IO ()+print_usage_info h header descs = do++ -- Determine the width to use+ mw <- terminal_width h+ let w = case mw of+ Just w -> w+ Nothing -> 80++ {-+ if w < 12+ then ioError (mkIOError userErrorType "The terminal width is too small (< 12) for printing \+ \of the usage information. See print_usage_info." (Just h) Nothing)+ else+ -}++ if w < 12 + then hPutStr h "Terminal too narrow"++ else do -- Wrap and print the header+ hPutStr h (unlines (wrap w header))+ + -- Print the argument descriptions.+ mapM_ (hPutStr h)+ (make_usage_info descs + 0 + (w `div` 5) + (w `div` 3)+ w)+ ++-- |+-- Break down a text to lines, such that each one has the specified+-- maximum width.+--+-- Newline characters in the input text are respected. They terminate the line,+-- without it being filled up to the width.+--+-- The text is wrapped at space characters. Words remain intact, except when+-- they are too long for one line.+wrap :: Int -- ^ Maximum width for the lines of the text, which is to be broken down+ -> String -- ^ Text to break down+ -> [String] -- ^ The broken down text in columns+wrap breite [] = []+wrap breite txt =+ [ zl | txtzl <- lines txt,+ zl <- wrap' breite txtzl+ ]+ where+ wrap' :: Int -> String -> [String]+ wrap' breite [] = [""]+ wrap' breite txt =+ wrap'' breite (dropWhile isSpace txt)++ wrap'' :: Int -> String -> [String]+ wrap'' breite txt =+ if length txt <= breite+ then [txt]+ else+ if null txt_anf+ then -- Zu breit für eine Zeile+ txt_br : wrap' breite txt_rest+ else txt_anf : wrap' breite rest++ where+ (txt_br, txt_rest) =+ splitAt breite txt++ (txt_anf, txt_anf_rest) =+ letzter_teil txt_br++ rest = txt_anf_rest ++ txt_rest++ -- Letztes Wort von zl abspalten. Liefert+ -- ( Anfang von zl, Letztes Wort )+ letzter_teil zl =+ let zl' = reverse zl+ (wort, zl'') = span (/= ' ') zl'+ zl''1 = dropWhile (== ' ') zl''+ zl''' = reverse zl''1+ wort' = reverse wort+ in (zl''', wort')+++-}
test/args.hs view
@@ -3,15 +3,14 @@ {-# LINE 1 "args.chs" #-}--- Fehler, wenn die Breiten nicht hinkommen in make_usage_info- module Main (main) where -import HsShellScript+import HsShellScript {-hiding (make_usage_info, print_usage_info, wrap)-} import Data.Maybe import Data.List+import Data.Char import Debug.Trace import Control.Monad import Control.Exception@@ -19,7 +18,7 @@ header = "Testprogramm für Kommandozeilenargumente\n\n"-descs = [ d_trenner, d_pfade, d_uml, d_komp, d_inhalt ]+descs = [ d_komp, d_trenner, d_pfade, d_uml, d_inhalt, d_bla ] args = unsafe_getargs header descs trenner_normal = " - " @@ -29,46 +28,331 @@ komp = optarg_req args d_komp -d_komp = +d_komp = argdesc [ desc_short 'k'+ , desc_short 'l'+ , desc_short 'm' , desc_long "komp"+ , desc_long "komp1"+ , desc_long "komp2" , desc_value_required , desc_argname "<Name>" , desc_description "Das ist eine lange Argumentbeschreibung, die umgebrochen werden muß, weil sie zu lang ist. Wirklich. Undhierkommteinganzlangeswortdasgetrenntwerdenmuß" ] -d_trenner = +d_trenner = argdesc [ desc_short 't' , desc_long "langer-param" , desc_at_most_once , desc_value_required , desc_argname "<Txt>"- , desc_description ("Diese Beschreibung\nhat mehrere\n\nZeilen.")+ , desc_description "Diese Beschreibung\nhat mehrere\nZeilen." ] -d_uml = +d_uml = argdesc [ desc_long "äöüß" , desc_at_most_once ] -d_pfade = +d_pfade = argdesc [ desc_direct , desc_any_times , desc_description ("Pfade, denen vorgesetzt werden soll; bzw, bla bla Verzeichnisse, die ihren Inhalten vorgesetzt werden sollen") ] -d_inhalt = +d_inhalt = argdesc [ desc_long "inhalt" , desc_description ("Nicht angegebenen Dateien vorsetzen, sondern dem Inhalt der angegebenen Verzeichnisse. Angegebene Nicht-Verzeichnisse \ \beiseitelassen.") ] +d_bla = + argdesc [ desc_long "foo"+ , desc_short 'h'+ , desc_value_required+ , desc_argname "Name"+ , desc_description "bla bla bla bla bla bla bla bla bla bla bla bla bla bla bla bla bla bla bla bla bla bla bla bla bla bla \+ \bla bla bla bla bla bla bla bla bla bla bla bla bla bla bla bla "+ ] +++ main = mainwrapper $ do seq args (return ())++ print_usage_info stdout "Header\n\n" descs++++{-+-- |+-- Generate pretty-printed information about the command line arguments. This+-- function gives you much control on how the usage information is generated.+-- @print_usage_info@ might be more like what you need.+--+-- The specified argument descriptions (as taken by the @getargs@... functions)+-- are processed in the given order. Each one is formatted as a paragraph,+-- detailing the argument. This is done according to the specified geometry.+--+-- The direct argument, in case there is one, is omitted. You should detail the+-- direct command line arguments separatly, such as in some header.+--+-- The specified maximum breadths must fit in the specified width, or an error+-- is raised. This happens, when @colsleft + colsshort + 2 + colslong + 2 + 2 >+-- width@.+-- +-- See 'print_usage_info', 'getargs', 'usage_info', 'ArgumentDescription',+-- 'desc_description', 'argdesc', 'terminal_width', 'terminal_width_ioe'.+make_usage_info :: [ArgumentDescription] -- ^ List of argument descriptions, as created by a @argdesc@+ -> Int -- ^ The output is indented this many columns. Probably zero.+ -> Int -- ^ Maximum width of the column of the short form of each argument. When this many aren't+ -- needed, less are used.+ -> Int -- ^ Maximum width of the column of the long form of each argument. When this many aren't+ -- needed, less are used.+ -> Int -- ^ Wrap everything at this column. Should probably be the terminal width.+ -> [String] -- ^ Pretty printed usage information, in paragraphs, which contain one or several lines.+make_usage_info descs colsleft colsshort colslong width =++ if colsleft + colsshort + 2 + colslong + 2 + 2 > width+ then error $ "make_usage_info: colsleft, colsshort, and colslong arguments \+ \are too large for the specified width argument.\n\+ \colsleft = " ++ show colsleft ++ " \n\+ \colsshort = " ++ show colsshort ++ " \n\+ \colslong = " ++ show colslong ++ " \n\+ \width = " ++ show width+ else + map unlines (verbinden (zll' (filter (\d -> not (is_direct d)) + descs)+ ))+ + where+ -- Die Argumentbeschreibung, auf die richtige Breite umgebrochen+ beschr :: ArgumentDescription -> [String]+ beschr desc = wrap (width - colsleft - gesamtbr_kurz - 2 - gesamtbr_lang - 2)+ (fromMaybe "" (argdesc_description desc)) - print_usage_info stdout "Das ist ein langer Header... Das ist ein langer Header... Das ist ein langer Header... Das\- \ist ein langer Header... Das ist ein langer Header... Das ist ein langer Header... Das ist \- \ein langer Header... Das ist ein langer Header... Das ist ein langer Header... \n\n"- descs+ -- Eine ArgumentDescription rendern. Die fertigen Zeilen sind alle gleich viele (mit "" aufgefüllt).+ auff1 :: ArgumentDescription + -> ([String], [String], [String])+ auff1 desc = auff (kurzname desc)+ (langname desc)+ (beschr desc)+ + -- Wir haben für eine Argumentbeschreibung die Listen von Zeilen, aus denen der kurze, und lange Argumentname besteht, sowie die Zeilen, aus+ -- denen die Argumentbeschreibung besteht.+ zus :: ([String], [String], [String]) -> [(String, String, String)]+ zus (as, bs, cs) = zip3 as bs cs+ + -- Die für die Kurzform einses Arguments benötigte Zahl von Spalten+ kurzbr :: ArgumentDescription -> Int+ kurzbr desc =+ foldr max 0 (map length (kurzname desc))+ + -- Die für die Langform einses Arguments benötigte Zahl von Spalten+ langbr :: ArgumentDescription -> Int+ langbr desc =+ foldr max 0 (map length (langname desc))+ + -- Breite der Kurzform, über alle Argumente hinweg+ gesamtbr_kurz =+ foldr max 0 (map (\desc -> kurzbr desc) descs)+ + -- Breite der Langform, über alle Argumente hinweg+ gesamtbr_lang =+ foldr max 0 (map (\desc -> langbr desc) descs)+ + -- Breite der Beschreibungen+ breite_descr :: Int+ breite_descr = width - colsleft - gesamtbr_kurz - 2 - gesamtbr_lang - 2 + -- Für jedes Kommandozeilenargument die Liste der Zeilen+ zll :: [ArgumentDescription]+ -> [[(String, String, String)]]+ zll descs =+ map (zus . auff1) descs+ + -- Für jedes Kommandozeilenargument die Liste der Zeilen, aufgefüllt auf einheitliche Breite+ zll' :: [ArgumentDescription]+ -> [[(String, String, String)]]+ zll' [] = + []+ zll' descs = + map (\l -> map (\(a,b,c) -> (fuell gesamtbr_kurz a, + fuell gesamtbr_lang b, + c))+ l)+ (zll descs)+ + -- Die Tripel + verbinden :: [[(String, String, String)]]+ -> [[String]]+ verbinden l =+ map (\l' -> map (\(a,b,c) -> take colsleft (repeat ' ') + ++ a ++ " " ++ b ++ " " ++ c) l')+ l+ + -- Die Kurzform des angegebenen Arguments. In Zeilen heruntergebrochen,+ -- wenn die Breite colsshort überschritten wird.+ kurzname :: ArgumentDescription -> [String]+ kurzname desc =+ wrap colsshort (argname_short desc)+ + -- Die Langform des angegebenen Arguments. In Zeilen heruntergebrochen,+ -- wenn die Breite colslong überschritten wird+ langname :: ArgumentDescription -> [String]+ langname desc =+ wrap colslong (argname_long desc)+ + -- Den gegebenen String um so viele Leerzeichen ergänzen, daß daraus ein String der gegebenen Länge wird. Ist er dafür zu lang, denn den+ -- unveränderten String zurückgeben.+ fuell :: Int -> String -> String+ fuell br txt =+ txt ++ take (br - length txt) (repeat ' ')+ ++ -- Complete three lists of Strings. All three strings are made to be made up+ -- of the same number of entries. Missing entries at the end are filled up with+ -- empty strings.+ auff :: [String] -> [String] -> [String] -> ([String], [String], [String])+ auff a b c =+ (reverse x, reverse y, reverse z)+ + where+ (x,y,z) = auff' a b c [] [] []+ + auff' :: [String] -> [String] -> [String]+ -> [String] -> [String] -> [String]+ -> ([String], [String], [String])+ + auff' [] [] [] a1 b1 c1 =+ (a1, b1, c1)+ + auff' a b c a1 b1 c1 =+ auff' (if null a then [] else tail a)+ (if null b then [] else tail b)+ (if null c then [] else tail c)+ ((if null a then "" else head a) : a1)+ ((if null b then "" else head b) : b1)+ ((if null c then "" else head c) : c1)+ ++++-- |+-- Print the usage information (about the command line arguments), for the+-- specified header and arguments to the specified handle. When the handle is+-- connected to a terminal, the terminal\'s width (in columns) is used to format+-- the output, such that it fits the terminal. Both the header and the argument+-- descriptions are adapted to the width of the terminal (by using @wrap@).+--+-- When the handle does not connected to a terminal, 80 columns are used. This+-- may happen to @stdout@ or @stderr@, for instance, when the program is in a+-- pipe, or the output has been redirected to a file.+--+-- When the terminal is too narrow for useful output, then instead of the usage+-- information, a short message (@"Terminal too narrow"@) is printed. This+-- applies to terminals with a width of less than 12.+--+-- You should specify one long line for each paragraph in the header and the+-- argument descriptions, and let print_usage_info do the wrapping. When you+-- have several paragraphs, separate them by a double @\\n\\n@. This also applies +-- for an empty line, which should be printed after the actual header.+--+-- The arguments are printed in the order, in which they occur in the argument+-- description list.+--+-- This function is a front end to @terminal_width@ and @make_usage_info@.+--+-- See 'argdesc', 'desc_description', 'terminal_width', 'make_usage_info', 'usage_info', 'wrap'.+print_usage_info :: Handle -- ^ To which handle to print the+ -- usage info.+ -> String -- ^ The header to print first.+ -- Can be empty.+ -> [ArgumentDescription] -- ^ The argument description of+ -- the arguments, which should be documented.+ -> IO ()+print_usage_info h header descs = do++ -- Determine the width to use+ mw <- terminal_width h+ let w = case mw of+ Just w -> w+ Nothing -> 80++ {-+ if w < 12+ then ioError (mkIOError userErrorType "The terminal width is too small (< 12) for printing \+ \of the usage information. See print_usage_info." (Just h) Nothing)+ else+ -}++ if w < 12 + then hPutStr h "Terminal too narrow"++ else do -- Wrap and print the header+ hPutStr h (unlines (wrap w header))+ + -- Print the argument descriptions.+ mapM_ (hPutStr h)+ (make_usage_info descs + 0 + (w `div` 5) + (w `div` 3)+ w)+ ++-- |+-- Break down a text to lines, such that each one has the specified+-- maximum width.+--+-- Newline characters in the input text are respected. They terminate the line,+-- without it being filled up to the width.+--+-- The text is wrapped at space characters. Words remain intact, except when+-- they are too long for one line.+wrap :: Int -- ^ Maximum width for the lines of the text, which is to be broken down+ -> String -- ^ Text to break down+ -> [String] -- ^ The broken down text in columns+wrap breite [] = []+wrap breite txt =+ [ zl | txtzl <- lines txt,+ zl <- wrap' breite txtzl+ ]+ where+ wrap' :: Int -> String -> [String]+ wrap' breite [] = [""]+ wrap' breite txt =+ wrap'' breite (dropWhile isSpace txt)++ wrap'' :: Int -> String -> [String]+ wrap'' breite txt =+ if length txt <= breite+ then [txt]+ else+ if null txt_anf+ then -- Zu breit für eine Zeile+ txt_br : wrap' breite txt_rest+ else txt_anf : wrap' breite rest++ where+ (txt_br, txt_rest) =+ splitAt breite txt++ (txt_anf, txt_anf_rest) =+ letzter_teil txt_br++ rest = txt_anf_rest ++ txt_rest++ -- Letztes Wort von zl abspalten. Liefert+ -- ( Anfang von zl, Letztes Wort )+ letzter_teil zl =+ let zl' = reverse zl+ (wort, zl'') = span (/= ' ') zl'+ zl''1 = dropWhile (== ' ') zl''+ zl''' = reverse zl''1+ wort' = reverse wort+ in (zl''', wort')+++-}