-- GENERATED by C->Haskell Compiler, version 0.27.1 Eternal Sunshine, 29 November 2015 (Haskell)
-- Edit the ORIGNAL .chs file instead!
{-# LINE 1 "args.chs" #-}
module Main (main) where
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
import System.IO
header = "Testprogramm für Kommandozeilenargumente\n\n"
descs = [ d_komp, d_trenner, d_pfade, d_uml, d_inhalt, d_bla ]
args = unsafe_getargs header descs
trenner_normal = " - "
pfade = args_req args d_pfade
trenner = fromMaybe trenner_normal $ optarg_req args d_trenner
inhalt = arg_switch args d_inhalt
komp = optarg_req args 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 =
argdesc [ desc_short 't'
, desc_long "langer-param"
, desc_at_most_once
, desc_value_required
, desc_argname "<Txt>"
, desc_description "Diese Beschreibung\nhat mehrere\nZeilen."
]
d_uml =
argdesc [ desc_long "äöüß"
, desc_at_most_once
]
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 =
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))
-- 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')
-}