hsshellscript 3.3.4 → 3.4.0

raw patch · 19 files changed

+1587/−1042 lines, 19 filesdep ~basedep ~directoryPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base, directory

API changes (from Hackage documentation)

Files

• Makefile +1/−1
• hsshellscript.cabal +5/−6
• src/HsShellScript.hs +1/−7
• src/HsShellScript/Args.chs +1250/−0
• src/HsShellScript/Args.hs +0/−981
• src/HsShellScript/Args.hs-boot +9/−0
• src/HsShellScript/Commands.chs +5/−7
• src/HsShellScript/GetOpt.hs +14/−14
• src/HsShellScript/Misc.chs +22/−0
• src/HsShellScript/ProcErr.chs +61/−16
• src/HsShellScript/ProcErr.hs-boot +9/−0
• src/cbits/hsshellscript.c +18/−0
• test/Makefile +12/−10
• test/_exit.hs +0/−0
• test/args.chs +67/−0
• test/args.hs +74/−0
• test/cteile.c +21/−0
• test/fdupes.hs +6/−0
• test/glob_quote.hs +12/−0

@@ -1,5 +1,5 @@ # nächste Version:-VERSION = 3.3.4+VERSION = 3.4.0  default :: lib 

@@ -1,5 +1,5 @@ Name:                hsshellscript-Version:             3.3.4+Version:             3.4.0 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@@ -21,14 +21,14 @@   Library-  Exposed-Modules:   HsShellScript,+  Exposed-Modules:   HsShellScript                      HsShellScript.Args-                     HsShellScript.Commands+                     HsShellScript.Paths+                     HsShellScript.Shell+  Other-Modules:     HsShellScript.Commands                      HsShellScript.GetOpt                      HsShellScript.Misc-                     HsShellScript.Paths                      HsShellScript.ProcErr-                     HsShellScript.Shell   Extensions:        DeriveDataTypeable,                      ForeignFunctionInterface,                      RecordWildCards,@@ -37,7 +37,6 @@                      StandaloneDeriving   Build-depends:     base >= 3 && < 6,                      unix >= 2.3.2,-                     -- unix-compat,                      directory,                      parsec >= 2.1.0.1,                      random

@@ -71,7 +71,7 @@               isatty,                -- * Miscellaneous-              zeros, chomp, lazy_contents, contents, glob,+              zeros, chomp, lazy_contents, contents, glob, glob_quote,                -- * Error Handling               mainwrapper, errno,@@ -87,12 +87,6 @@          ) where --- import IO--- import List--- import Maybe--- import Monad--- import Random--- import System import Control.Exception import GHC.IO import HsShellScript.Args

@@ -0,0 +1,1250 @@+-- |+-- This module provides a more convient way of parsing command line+-- arguments than the GHC GetOpt package. It uses GetOpt, but hides+-- it from the user. It is reexported from module HsShellScript.+--+-- For each command line argument, a description is to be created with+-- @argdesc@. Then the command line arguments are evaluated with+-- one of the @getargs@... functions. In case of an error, this will cause a+-- exception, which provides an expressive error message to be+-- printed. Then the @arg@... functions are used to extract the+-- values contained in the arguments, with the right type. The typical use+-- of HsShellScript.Args looks something like this:+--+-- >import HsShellScript+-- >+-- >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"+-- >+-- >      args <- getargs header [a_onevalue, a_values, a_switch, ...]+-- >+-- >      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+-- >      )+--+-- Errors in the argument descriptions are regarded as bugs, and handled+-- by aborting the program with a message which is meaningful to the+-- programmer. It is assumed that the argument description is a constant for+-- a given program.+--+-- Errors in the arguments are reported using HsShellScript's error handling+-- scheme. An error description+-- value is generated, and either returned via an @Either@+-- value, or thrown as an exception.++module HsShellScript.Args ( -- ** Argument Properties+                    ArgumentProperty+                  , ArgumentDescription (..)+                  , ArgumentValueSpec (..)+                  , Argtester+                  , argdesc+                  , desc_short+                  , desc_long+                  , desc_direct+                  , desc_value_required+                  , desc_value_optional+                  , desc_times+                  , desc_once+                  , desc_at_least_once+                  , desc_at_most_once+                  , desc_any_times+                  , desc_at_least+                  , desc_at_most+                  , desc_argname+                  , desc_description+                  , desc_tester+                  , desc_integer+                  , desc_nonneg_integer+                  , readtester+                  , is_direct+                    -- ** Evaluating the Command Line+                  , Arguments+                  , getargs+                  , getargs_ordered+                  , getargs'+                  , getargs_ordered'+                  , unsafe_getargs+                  , unsafe_getargs_ordered+                    -- ** Extracting the Argument Values+                  , arg_switch+                  , arg_times+                  , args_opt+                  , args_req+                  , reqarg_opt+                  , reqarg_req+                  , optarg_opt+                  , optarg_req+                  , arg_occurs+                    -- ** Placing additional Constraints on the Arguments+                  , args_none+                  , args_all+                  , args_one+                  , args_at_most_one+                  , args_at_least_one+                  , arg_conflicts+                    -- ** Argument Error Reporting+                  , ArgError (..)+                  , usage_info+                  , make_usage_info+                  , print_usage_info+                  , argname+                  , argname_a+                  , 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 Foreign.C+import System.Environment+import Control.Monad+import Control.Exception+import Prelude hiding (catch)+import Data.Maybe+import System.Environment+import Data.List+import GHC.IO+import System.IO+import HsShellScript.Shell+import Data.Char+import Debug.Trace+import Data.Typeable+++++-- | Does the command line argument take an value?+data ArgumentValueSpec  = ArgumentValue_none     -- ^ No value+                        | ArgumentValue_required -- ^ Value required+                        | ArgumentValue_optional -- ^ Value optional+   deriving (Eq, Show, Ord)+++-- | Argument value tester function. This tests the format of an argument's value for errors. The tester function is specified by+-- 'desc_tester' or such, as part of the argument description.+--+-- The tester is passed the argument value. If the format is correct, then it returns @Nothing@. If there is an error, then it returns @Just msgf@,+-- with @msgf@ being an error message generation function. This function gets passed the argument description, and produces the error+-- message. The argument description typically is used to extract a descriptive name of the argument (using 'argname' or 'argname_a') to be included+-- in the error message.+type Argtester = String                           -- Argument value to be tested+                 -> Maybe (ArgumentDescription    -- Argument description for message generation+                           -> String              -- Error message+                          )+++-- | 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.+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_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)++instance Eq ArgumentDescription where+   d == e = ad_tup d == ad_tup e++instance Ord ArgumentDescription where+   compare d e = compare (ad_tup d) (ad_tup e)++-- value for maximum number of times+unlimited = -1++-- Whether two argument descriptions describe the same argument.+-- Every short or long argument name occurs in only one argument+-- descriptor (this is checked). Every argument has a short or a long+-- name (short = [], long = [""] for direct arguments).+same_arg :: ArgumentDescription -> ArgumentDescription -> Bool+same_arg arg1 arg2 =+   case (argdesc_short_args arg1, argdesc_short_args arg2) of+      (a:_, b:_) -> a == b+      ([], [])   -> case (argdesc_long_args arg1, argdesc_long_args arg2) of+                       ([],_)  -> unnamed+                       (_,[])  -> unnamed+                       (l1,l2) -> head l1 == head l2+      _          -> False+   where unnamed = error "Bug in argument description: nameless, non-direct argument. desc_short or desc_long must be specified."++-- | A property of a command line argument. These are generated by the+-- @desc_@... functions, and condensed to argument+-- descriptions of type @ArgumentDescription@ by @argdesc@. This type is abstract.+newtype ArgumentProperty =+   ArgumentProperty { argumentproperty :: ArgumentDescription -> ArgumentDescription }+-- An argument property is a function which fills in part of an argument descriptor.+++-- starting value for argument descriptor+nulldesc :: ArgumentDescription+nulldesc =+   ArgumentDescription {+      argdesc_short_args = [],+      argdesc_long_args = [],+      argdesc_argarg = ArgumentValue_none,+      argdesc_times = Nothing,          -- default = (0,1)+      argdesc_argargname = Nothing,+      argdesc_argarg_description = Nothing,+      argdesc_argarg_tester = Nothing+   }++-- default number of times an argument may occur+times_default = (0,1)+++-- | This represents the parsed contents of the command line. It is returned+-- by the @getargs@... functions, and passed on to the+-- value extraction functions by the user.+--+-- See 'getargs', 'getargs_ordered', 'getargs\'', 'getargs_ordered\''.+newtype Arguments =+    Arguments ([ ( ArgumentDescription             -- argument descriptor+                 , [Maybe String]                  -- arguments matching this descriptor+                 )],+               String)                             -- header+++argvalues :: Arguments -> ArgumentDescription -> [Maybe String]+argvalues (Arguments (l, header)) desc =+   argvalues' l+   where+      argvalues' ((d,v):r) = if same_arg desc d then v else argvalues' r+      argvalues' []        = abort "Bug using HsShellScript: Value of unknown argument queried (add it to getarg's list)" desc++-- used internally to represent one occurence of a specific argument+type ArgOcc = (ArgumentDescription, Maybe String)+++-- | Error thrown when there is an error in the command line arguments.+--+-- 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'.+data ArgError = ArgError {+      -- | Error message+      argerror_message :: String,+      -- | Usage information, as generated by the now deprecated function usage_info.+      argerror_usageinfo :: String+   }+   deriving (Typeable)+++argerror_ui :: String+            -> [ArgumentDescription]+            -> a+argerror_ui mess descl =+   throw (ArgError mess (make_usage_info1 descl))+++-- |+-- Make @ArgError@ an instance of @Exception@, so we can throw and catch it, using GHC-6.10\'s new exception library.+instance Exception ArgError+++---+-- Printing an @ArgError@ will produce the error message. The usage+-- information must be printed separately, using @usage_info@.+instance Show ArgError where+   show argerror = argerror_message argerror+++-- |+-- Whether the specified argument is the direct argument. Direct arguments are+-- the ones which are specified without introducing "-" or "--", in the command+-- line, or which occur after the special argument "--".+--+-- See 'argdesc', 'desc_direct'.+is_direct :: ArgumentDescription        -- ^ Argument description, as returned by @argdesc@.+          -> Bool+is_direct desc =+   argdesc_short_args desc == [] && argdesc_long_args desc == [""]+++-- |+-- Short name of the argument. This specifies a character for a+-- one letter style argument, like @-x@. There can be specified+-- several for the same argument. Each argument needs at least+-- either a short or a long name.+desc_short :: Char                -- ^ The character to name the argument.+           -> ArgumentProperty    -- ^ The corresponding argument property.+desc_short c = ArgumentProperty+   (\desc ->+      if (c `elem` (argdesc_short_args desc))+         then abort ("Bug in HsShellScript argument description: Duplicate short argument " ++ show c ++ " specified") desc+         else if ("" `elem` argdesc_long_args desc)+                 then abort_conflict "" desc+                 else desc { argdesc_short_args = c : argdesc_short_args desc }+   )++-- |+-- Long name of the argument. This specifies a GNU style long name for the argument, which is+-- introduced by two dashes, like @--arg@ or @--arg=...@. There can be specified several names for+-- the same argument. Each argument needs at least either a short or a long name. Except for direct+-- arguments, which don't have a name.+--+-- See 'desc_direct'+desc_long :: String                     -- ^ The long name of the argument.+          -> ArgumentProperty     -- ^ The corresponding argument property.+desc_long str = ArgumentProperty+   (\desc ->+      if (str `elem` (argdesc_long_args desc))+         then abort ("Bug in HsShellScript argument description: Duplicate long argument " ++ show str ++ " specified") desc+         else if ("" `elem` argdesc_long_args desc)+                 then abort_conflict "" desc+                 else desc { argdesc_long_args = str : argdesc_long_args desc }+   )++-- |+-- Signal that this is the description of direct arguments. Direct arguments are the ones not+-- introduced by any short or long argument names (like @-x@ or @--arg@). After the special argument+-- @--@, also everything is a direct argument, even when starting with @-@ or @--@. The presence of+-- @desc_direct@ in the argument properties list signals @argdesc@ that this is the description of+-- the direct arguments. There may be at most one such description.+--+-- The @is_direct@ function can be used in order to determine if a specific+-- argument is the direct argument.+--+-- See 'is_direct'.+desc_direct :: ArgumentProperty+desc_direct = ArgumentProperty+   (\desc ->+      if argdesc_long_args desc == [] && argdesc_short_args desc == [] && argdesc_argarg desc == ArgumentValue_none+         then desc { argdesc_long_args = [""]+                   , argdesc_argarg = ArgumentValue_required+                   , argdesc_argargname = Just ""+                   }+         else abort_conflict "desc_direct conflicts with desc_long, desc_short, desc_value_required and desc_value_optional." desc+   )++-- |+-- Signal that the argument requires a value.+desc_value_required :: ArgumentProperty+desc_value_required = ArgumentProperty+   (\desc ->+      if argdesc_argarg desc == ArgumentValue_none+         then desc { argdesc_argarg = ArgumentValue_required }+         else abort_conflict "desc_value_required repeated or conflicting desc_value_optional" desc+   )++-- |+-- Signal that the argument optionally has a value. The user may or may+-- not specify a value to this argument.+desc_value_optional :: ArgumentProperty+desc_value_optional = ArgumentProperty+   (\desc ->+      if argdesc_argarg desc == ArgumentValue_none+         then desc { argdesc_argarg = ArgumentValue_optional }+         else abort_conflict "desc_value_optional repeated or conflicting desc_value_required" desc+   )++-- |+-- Specify lower and upper bound on the number of times an argument may+-- occur.+desc_times :: Int                       -- ^ Lower bound of the allowed number of argdesc_times.+           -> Int                       -- ^ Upper bound of the allowed number of argdesc_times.+           -> ArgumentProperty          -- ^ The corresponding argument property.+desc_times n m = ArgumentProperty+   (\desc ->+       if argdesc_times desc == Nothing+          then desc { argdesc_times = Just (n,m) }+          else abort_conflict "desc_times conflicting previous number of occurences specification" desc+   )++-- |+-- Signal that the argument must be present exactly once. This is+-- meaningful only for arguments which can take a value.+desc_once :: ArgumentProperty     -- ^ The corresponding argument property.+desc_once = desc_times 1 1++-- |+-- Signal that the argument must occur at least one time.+desc_at_least_once :: ArgumentProperty -- ^ The corresponding argument property.+desc_at_least_once = desc_times 1 unlimited++-- |+-- Signal that the argument must occur at most one time.+desc_at_most_once :: ArgumentProperty -- ^ The corresponding argument property.+desc_at_most_once  = desc_times 0 1++-- |+-- Signal that the argument must have at least the specified number of+-- occurences, and has no upper limit of occurences.+desc_at_least :: Int                        -- ^ Number of times.+              -> ArgumentProperty           -- ^ The corresponding argument property.+desc_at_least n = desc_times n unlimited++-- |+-- Signal that the argument may occur any number of times.+desc_any_times :: ArgumentProperty -- ^ The corresponding argument property.+desc_any_times  = desc_times 0 unlimited++-- |+-- Signal that the argument does not need to be present, and may occur at most+-- the specified number of times.+desc_at_most :: Int                     -- ^ Number of times.+             -> ArgumentProperty  -- ^ The corresponding argument property.+desc_at_most n = desc_times 0 n++-- |+-- Specify the descriptive name for command line argument's value. Used for the+-- generation of the usage message. The name should be very short.+desc_argname :: String                          -- ^ Name of the argument's value.+             -> ArgumentProperty          -- ^ The corresponding argument property.+desc_argname name = ArgumentProperty+   (\desc ->+      if argdesc_argargname desc == Nothing+         then desc { argdesc_argargname = Just name }+         else abort "Bug in HsShellScript argument description: Multiple names specified" desc+   )++-- |+-- 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.+desc_description :: String                      -- ^ Short description of the argument.+                 -> 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+   )++-- | Specify a tester for this argument. The tester is a function which tests the argument value for format errors. Typically, it tests whether the+-- value can be parsed to some target type. If the test fails, the tester produces an error message. When parsing the command line arguments (which+-- @getargs@ or related), all the testers are applied to the respective argument values, and an 'ArgError' is thrown in case of failure. By using a+-- tester, it can be ensured that the argument values abide a specific format when extracting them, such that they can be parsed without errors, e.g.+-- @myarg = read (reqarg_req args d_myarg)@.+--+-- An argument tester is a function of type 'Argtester'.+--+-- See 'readtester', 'desc_integer', 'desc_nonneg_integer', 'Argtester'.+desc_tester :: Argtester                        -- ^ Argument tester to apply to this argument+            -> ArgumentProperty                 -- ^ The corresponding argument property.+desc_tester t = ArgumentProperty+   (\desc ->+      case argdesc_argarg_tester desc of+         Nothing -> desc { argdesc_argarg_tester = Just t }+         Just _  -> abort "Bug in HsShellScript argument description: Multiple argument value testers specified" desc+   )+++-- |+-- Build an argument tester from a @reads@ like function. Typically, a specialisation of the standard prelude function @read@ is used.+-- Example: @readtester \"Integer expected.\" (reads :: ReadS Int)@+readtester :: ReadS a                           -- Reader function, like the standard prelude function @reads@+           -> String                            -- Additional message+           -> Argtester                         -- Argument tester to be passed to 'desc_tester'+readtester reader msg val =+   case filter ((== "") . snd) $ reader val of+      [(_,"")] -> Nothing+      []       -> Just (\arg -> "Format error in the value of the " ++ argname_a arg ++ ". " ++ msg ++ "\nValue: " ++ quote val)+      _        -> Just (\arg -> "Ambigious value of the " ++ argname_a arg ++ ". " ++ msg ++ "\nValue: " ++ quote val)+++{- | Specify that the value of this argument, if present, is a positive integer. This will cause an error when the command line is parsed, and the+   argument's value doesn't specify an integer.++>desc_integer = desc_tester (readtester (reads :: ReadS Int) "Integer expected.")++   See 'desc_tester'.+-}+desc_integer :: ArgumentProperty+desc_integer = desc_tester (readtester (reads :: ReadS Int) "Integer expected.")+++{- | Specify that the value of this argument, if present, is a non-negative integer. This will cause an error when the command line is parsed, and the+   value doesn't specify a non-negative integer.++>desc_nonneg_integer = desc_tester (readtester ((filter (\(a,_) -> a >= 0) . reads) :: ReadS Int) "Non-negative integer expected." )++   See 'desc_tester'.+-}+desc_nonneg_integer :: ArgumentProperty+desc_nonneg_integer = desc_tester (readtester ((filter (\(a,_) -> a >= 0) . reads) :: ReadS Int) "Non-negative integer expected." )+++abort_conflict msg = abort ("Conflicting properties in argument description. " ++ msg)+abort msg desc = error (msg ++ "\nargument (so far): " ++ argname desc)++-- |+-- Generate a descriptive argument name from an argument description, suitable+-- for use in error messages and usage information. This uses the long and short+-- argument names (as specified by 'desc_short' and 'desc_long') and generates+-- descriptive names of the argument like \"-f\", \"--myflag\",+-- \"-f\/--myflag\", etc. All the argument names are included. In case of direct+-- arguments (see 'desc_direct'), the descriptive name is \"@(direct+-- argument)@\".+--+-- See 'argdesc'.+argname :: ArgumentDescription  -- ^ Argument description, as returned by @argdesc@+        -> String               -- ^ Printable name for the argument+argname desc =+   if (argdesc_short_args desc, argdesc_long_args desc) == ([],[""]) then "(direct argument)"+      else if (argdesc_short_args desc, argdesc_long_args desc) == ([],[]) then "yet unnamed argument"+         else concat (intersperse "/" ( map (\s -> "-"++[s]) (argdesc_short_args desc) ++ map ("--" ++) (argdesc_long_args desc) ))++-- |+-- Generate a descriptive argument name from an argument description, beginning+-- with \"argument\". This uses the long and short argument names (as specified+-- by 'desc_short' and 'desc_long') and generates descriptive names of the+-- argument like \"argument -f\", \"argument --myflag\", \"argument+-- -f\/--myflag\", etc. All the argument names are included. In case of direct+-- arguments (see 'desc_direct'), the descriptive name is \"direct argument\".+--+-- See 'argdesc'.+argname_a :: ArgumentDescription        -- ^ Argument description, as returned by @argdesc@+          -> String                     -- ^ Printable name for the argument+argname_a desc =+   if (argdesc_short_args desc, argdesc_long_args desc) == ([],[""]) then "direct argument"+      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) ))++up1 "" = ""+up1 (x:xs) = toUpper x : xs++-- complete generation of argument description+prop_final :: ArgumentProperty+prop_final = ArgumentProperty+   (\desc ->+      seq (if argdesc_argarg desc /= ArgumentValue_none && argdesc_argargname desc == Nothing+              then error $ "Bug in description of " ++ argname_a desc ++ ": Argument's value must be given a name using desc_argname."+              else if argdesc_argarg desc == ArgumentValue_none && argdesc_argargname desc /= Nothing+                      then error $ "Bug in description of " ++ argname_a desc+                           ++ ": Argument doesn't take a sub argument, but a name for it is specified."+                      else ()+          ) $+          desc { argdesc_times = Just (fromMaybe times_default (argdesc_times desc))+               , argdesc_argarg_description = Just (fromMaybe "" (argdesc_argarg_description desc))+               }+   )++-- |+-- Make an argument description from a list of argument properties. This+-- condenses the list to an argument description,+-- which can be used by the @getargs@... functions and the+-- argument value extraction functions.+argdesc :: [ArgumentProperty]     -- ^ List of properties, which describe the command line argument.+        -> ArgumentDescription    -- ^ The corresponding argument description.+argdesc propl =+   foldr (.) id (map argumentproperty (prop_final:propl)) nulldesc+++-- Parse command line arguments.+getargs0 :: String                      -- Header for usage info+         -> ArgOrder ArgOcc             -- HsShellScript.GetOpt.Permute or HsShellScript.GetOpt.RequireOrder+                                        --   Permute:      Named arguments (like -x or --arg) and direct arguments may occur in any order.+                                        --   RequireOrder: All arguments after the first direct argument are regarded as direct arguments.+         -> [String]                    -- The command line arguments as returned by System.Environment.getArgs+         -> [ArgumentDescription]       -- The arguments descriptions+         -> Either ArgError             -- Error+                   Arguments            -- Parsed command line arguments+getargs0 header ordering cmdlargs descs =+   let (  descs_direct     -- direct arguments (without argument name)+        , descs_regular    -- regular arguments (with long or short argument name)+        ) = partition is_direct descs++       nonunique :: Eq a => [a] -> Maybe a+       nonunique (a:b:r) = if (a == b) then (Just a) else nonunique (b:r)+       nonunique _       = Nothing++       test_unique :: (Show a, Ord a) => (ArgumentDescription -> [a]) -> String -> b -> b+       test_unique extr what x =+           case nonunique (sort (concat (map extr descs))) of+              Just y -> error ("Bug: Several occurences of " ++ what ++ " " ++ show y ++ " in command line argument specifications")+              Nothing -> x++       optdescr = map make_optdescr descs_regular++       make_optdescr :: ArgumentDescription -> OptDescr ArgOcc+       make_optdescr desc =+          Option (argdesc_short_args desc)+                 (argdesc_long_args desc)+                 (case argdesc_argarg desc of+                     ArgumentValue_none      -> NoArg  (desc, Nothing)+                     ArgumentValue_required     -> ReqArg (\arg -> (desc, Just arg))+                                              (fromJust (argdesc_argargname desc))+                     ArgumentValue_optional     -> OptArg (\arg -> (desc, arg))+                                              (fromJust (argdesc_argargname desc))+                 )+                 (fromJust (argdesc_argarg_description desc))++       -- Postprocessing after successful call to getOpt+       getopt_post :: [ArgOcc] -> [String] -> Either ArgError Arguments+       getopt_post pars{-getOpt recognized arguments-} rest{-direct arguments-} =+          case (rest, descs_direct) of+             ([],[])  ->+                -- no direct arguments allowed and none provided+                getopt_post' pars+             (r, [d]) ->+                -- direct arguments allowed and expected+                getopt_post' (pars ++ zip (repeat d) (map Just r))+             ((x:xs), []) ->+                -- direct arguments provided, but not allowed+                Left (ArgError "Surplus arguments."+                               (make_usage_info1 descs)+                     )+             _ ->+                -- several descriptions for direct arguments+                error "Bug in argument descriptions: Several descriptions for direct arguments (desc_direct) specified."++       add :: (ArgumentDescription, Maybe String) -> [(ArgumentDescription, [Maybe String])] -> [(ArgumentDescription, [Maybe String])]+       add (a,str) []        = [(a,[str])]+       add (b,str) ((a,l):r) =+          if same_arg a b then (a,str:l) : r+                          else (a,l) : add (b,str) r++       getopt_post' :: [ArgOcc] -> Either ArgError Arguments+       getopt_post' pars{-all arguments-} =+          let pars' = foldr add (map (\d -> (d,[])) descs) pars++              -- Check the number of argument occurences+              check_num :: [(ArgumentDescription, [Maybe String])] -> Maybe ArgError+              check_num [] = Nothing+              check_num ((desc,args):rest) =+                 let (min,max) = fromJust (argdesc_times desc)+                     number    = length args+                     wrong_number_msg =+                        (if is_direct desc then fst else snd) $+                        if number == 0 && min == 1 then+                           ( "Missing argument."+                           , "Missing " ++ argname_a desc ++ "."+                           )+                        else if number < min then+                           ( "Too few arguments. " ++ show min ++ " required."+                           , "Too few instances of " ++ argname_a desc ++ ". "++ show min ++ " required."+                           )+                        else if number > max && max == 1 then+                           ( "Only one argument may be specified."+                           , "Repeated " ++ argname_a desc ++ "."+                           )+                        else if number > max && max /= unlimited then+                           ( "Too many arguments."+                           , "Too many instances of " ++ argname_a desc ++ "."+                           )+                        else error "bug in HsShellScript.Args.hs"+                 in  if number >= min && (number <= max || max == unlimited)+                        then check_num rest+                        else Just (ArgError wrong_number_msg (make_usage_info1 descs))++              -- Apply any argument testers+              check_testers :: [(ArgumentDescription, [Maybe String])] -> Maybe ArgError+              check_testers [] = Nothing+              check_testers ((desc,args):rest) =+                 case argdesc_argarg_tester desc of+                    Just argdesc_argarg_tester ->+                       if argdesc_argarg desc == ArgumentValue_none+                          then abort "Bug in HsShellScript argument descriptions: Argument value tester specified,\n\+                                     \but no argument value has been allowed. Add desc_value_optional or\n\+                                     \desc_value_required."+                                     desc+                          else case filter isJust (map (argdesc_argarg_tester . fromJust) (filter isJust args)) of+                                  []              -> check_testers rest+                                  (Just msgf : _) -> Just (ArgError (msgf desc) (make_usage_info1 descs))+                    Nothing -> check_testers rest++          in  case check_testers pars' of+                 Nothing  -> case check_num pars' of+                                Nothing  -> Right (Arguments (pars', header))+                                Just err -> Left err+                 Just err -> Left err++       args =+          test_unique argdesc_short_args "short argument" $+             test_unique argdesc_long_args "long argument" $+                case getOpt ordering optdescr cmdlargs of+                   (pars, rest, []) ->+                      getopt_post pars rest+                   (_,_,f) ->+                      throw (ArgError (unlines (map chomp f)) (usageInfo header optdescr))++    in args++   where+      -- duplicated here in order to break cyclic module dependency+      chomp "" = ""+      chomp "\n" = ""+      chomp [x] = [x]+      chomp (x:xs) = let xs' = chomp xs+                     in  if xs' == "" && x == '\n' then "" else x:xs'+++++-- |+-- Parse command line arguments. The arguments are taken from a call to+-- @getArgs@ and parsed. Any error is thrown as a+-- @ArgError@ exception. The result is a value from which the+-- information in the command line can be extracted by the @arg@...,+-- @reqarg@... and @optarg@... functions.+--+-- The header is used only by the deprecated @usage_info@ function. If you don't+-- use it, you don't need to specify a header. Just pass an empty string.+--+-- Named arguments (like @-x@ or @--arg@) and direct+-- arguments may occur in any order.+--+-- See 'usage_info', 'make_usage_info', 'print_usage_info'.+getargs :: String                         -- ^ Header to be used by the deprecated @usage_info@ function.+        -> [ArgumentDescription]          -- ^ The argument descriptions.+        -> IO Arguments                   -- ^ The contents of the command line.+getargs header descs = do+   args <- getArgs+   let res = getargs0 header Permute args descs+   either throw+          return+          res++-- |+-- Parse command line arguments. The arguments are taken from a call to+-- @getArgs@ and parsed. Any error is thrown as a+-- @ArgError@ exception. The result is a value from which the+-- information in the command line can be extracted by the @arg@...,+-- @reqarg@... and @optarg@... functions.+--+-- The header is used only by the deprecated @usage_info@ function. If you don't+-- use it, you don't need to specify a header. Just pass an empty string.+--+-- All arguments after the first direct argument are regarded as direct+-- arguments. This means that argument names introduced by @-@+-- or @--@ no longer take effect.+--+-- See 'usage_info', 'make_usage_info', 'print_usage_info'.+getargs_ordered :: String                 -- ^ Header to be used by the deprecated @usage_info@ function.+                -> [ArgumentDescription]  -- ^ Descriptions of the arguments.+                -> IO Arguments           -- ^ The contents of the command line.+getargs_ordered header descs = do+   args <- getArgs+   either throw+          return+          (getargs0 header RequireOrder args descs)++-- |+-- Parse the specified command line. Any error is returned as @Left+-- argerror@. In case of success, the result is returned as+-- @Right res@. From the result, the information in the command+-- line can be extracted by the @arg@..., @reqarg@...+-- and @optarg@... functions.+--+-- The header is used only by the deprecated @usage_info@ function. If you don't+-- use it, you don't need to specify a header. Just pass an empty string.+--+-- Named arguments (like @-x@ or @--arg@) and direct+-- arguments may occur in any order.+--+-- See 'usage_info', 'make_usage_info', 'print_usage_info'.+getargs' :: String                              -- ^ Header to be used by the deprecated @usage_info@ function.+         -> [String]                            -- ^ Command line to be parsed.+         -> [ArgumentDescription]         -- ^ The argument descriptions.+         -> Either ArgError Arguments     -- ^ The contents of the command line.+getargs' header args descs = getargs0 header Permute args descs++-- |+-- Parse the specified command line. Any error is returned as @Left+-- argerror@. In case of success, the result is returned as+-- @Right res@. From the result, the information in the command+-- line can be extracted by the @arg@..., @reqarg@...+-- and @optarg@... functions.+--+-- The header is used only by the deprecated @usage_info@ function. If you don't+-- use it, you don't need to specify a header. Just pass an empty string.+--+-- All arguments after the first direct argument are regarded as direct+-- arguments. This means that argument names introduced by @-@+-- or @--@ no longer take effect.+--+-- See 'usage_info', 'make_usage_info', 'print_usage_info'.+getargs_ordered' :: String                              -- ^ Header to be used by the deprecated @usage_info@ function.+                 -> [String]                            -- ^ Command line to be parsed.+                 -> [ArgumentDescription]         -- ^ The argument descriptions.+                 -> Either ArgError Arguments     -- ^ The contents of the command line.+getargs_ordered' header args descs = getargs0 header RequireOrder args descs+++test_desc :: ArgumentDescription -> Bool -> String -> b -> b+test_desc desc ok msg x =+   if ok then x+         else abort msg desc++maybe_head :: [a] -> Maybe a+maybe_head [] = Nothing+maybe_head [a] = Just a++-- |+-- Query whether a certain switch is specified on the command line. A switch is an+-- argument which is allowed zero or one time, and has no value.+arg_switch :: Arguments                   -- ^ Command line parse result.+           -> ArgumentDescription         -- ^ Argument description of the switch.+           -> Bool                              -- ^ Whether the switch is present in the command line.+arg_switch args desc =+   test_desc desc (argdesc_argarg desc == ArgumentValue_none && argdesc_times desc == Just (0,1))+             "bug: querying argument with is not a switch with arg_switch" $+   case argvalues args desc of+      []         -> False+      [Nothing]  -> True++-- |+-- Query the number of occurences of an argument.+arg_times :: Arguments                    -- ^ Command line parse result.+          -> ArgumentDescription          -- ^ Description of the argument.+          -> Int                          -- ^ Number of times the argument occurs.+arg_times args desc =+   length (argvalues args desc)++-- |+-- Query the values of an argument with optional value. This is for+-- arguments which take an optional value, and may occur several times. The+-- occurences with value are represented as @Just value@, the occurences+-- without are represented as @Nothing@.+args_opt :: Arguments                     -- ^ Command line parse result.+         -> ArgumentDescription           -- ^ Description of the argument.+         -> [Maybe String]                      -- ^ The occurences of the argument.+args_opt args desc =+   test_desc desc (argdesc_argarg desc == ArgumentValue_optional && snd (fromJust (argdesc_times desc)) /= 1)+             "Bug: Querying argument which doesn't take an optional value, or may not occur several times, with args_opt."+   $ argvalues args desc++-- |+-- Query the values of an argument with required value. This is for+-- arguments which require a value, and may occur several times.+args_req :: Arguments                     -- ^ Command line parse result.+         -> ArgumentDescription           -- ^ Description of the argument.+         -> [String]                            -- ^ The values of the argument.+args_req args desc =+   test_desc desc (argdesc_argarg desc == ArgumentValue_required && snd (fromJust (argdesc_times desc)) /= 1)+             "Bug: Querying argument which doesn't require a value, or may not occur several times, with args_req." $+   map fromJust (argvalues args desc)++-- |+-- Query the optional value of a required argument. This is for arguments+-- which must occur once, and may have a value. If the argument is+-- specified, its value is returned as @Just value@. If it isn't, the result+-- is @Nothing@.+reqarg_opt :: Arguments                   -- ^ Command line parse result.+           -> ArgumentDescription         -- ^ Description of the argument.+           -> Maybe String                      -- ^ The value of the argument, if it occurs.+reqarg_opt args desc =+   test_desc desc (argdesc_argarg desc == ArgumentValue_optional && argdesc_times desc == Just (1,1))+             "Bug: Querying argument which doesn't take an optional value, or which must not occur exactly once, with reqarg_opt." $+   head (argvalues args desc)++-- |+-- Query the value of a required argument. This is for arguments which must+-- occur exactly once, and require a value.+reqarg_req :: Arguments                   -- ^ Command line parse result.+           -> ArgumentDescription         -- ^ Description of the argument.+           -> String                            -- ^ The value of the argument.+reqarg_req args desc =+   test_desc desc (argdesc_argarg desc == ArgumentValue_required && argdesc_times desc == Just (1,1))+             "Bug: Querying argument with non-required value, or which doesn't occur exactly once, with reqarg_req." $+   fromJust (head (argvalues args desc))++-- |+-- Query the optional value of an optional argument. This is for arguments+-- which may occur zero or one time, and which may or may not have a value.+-- If the argument doesn't occur, the result is @Nothing@. If it does occur,+-- but has no value, then the result is @Just Nothing@. If it does occur with+-- value, the result is @Just (Just value)@.+optarg_opt :: Arguments                   -- ^ Command line parse result.+           -> ArgumentDescription         -- ^ Description of the argument.+           -> Maybe (Maybe String)              -- ^ The occurence of the argument and its value (see above).+optarg_opt args desc =+   test_desc desc (argdesc_argarg desc == ArgumentValue_optional)  "Bug: Querying argument with non-optional value with optarg_opt." $+   test_desc desc (fst (fromJust (argdesc_times desc)) == 0)       "Bug: Querying argument which isn't optional with optarg_opt." $+   test_desc desc (snd (fromJust (argdesc_times desc)) == 1)       "Bug: Querying argument which may occur several times optarg_opt." $+   maybe_head (argvalues args desc)++-- |+-- Query the value of an optional argument. This is for optional arguments+-- which require a value, and may occur at most once. The result is+-- @Just value@ if the argument occurs, and @Nothing@+-- if it doesn't occur.+optarg_req :: Arguments                   -- ^ Command line parse result.+           -> ArgumentDescription         -- ^ Description of the argument.+           -> Maybe String                      -- ^ The value of the argument, if it occurs.+optarg_req args desc =+   test_desc desc (argdesc_argarg desc == ArgumentValue_required)        "Bug: Querying argument with non-required value with optarg_req."+   $ test_desc desc (fst (fromJust (argdesc_times desc)) == 0)          "Bug: Querying argument which isn't optional with optarg_req."+   $ test_desc desc (snd (fromJust (argdesc_times desc)) == 1)          "Bug: Querying argument which may occur several times optarg_req."+   $ fmap fromJust (maybe_head (argvalues args desc))+++-- |+-- None of the specifed arguments may be present.+--+-- Throws an ArgError if any of the arguments are present.+args_none :: [ArgumentDescription]        -- ^ List of the arguments which must not be present.+          -> Arguments                    -- ^ Command line parse result.+          -> IO ()+args_none descs args@(Arguments argl) =+   mapM_ (\desc ->+             when (arg_times args desc /= 0) $+                argerror_ui (up1 (argname_a desc) ++ " is not allowed.\n")+                            descs+         )+         descs++-- |+-- All of the specified arguments must be present.+--+-- Throws an ArgError if any is missing.+args_all :: [ArgumentDescription]         -- ^ List of the arguments which must be present.+         -> Arguments                     -- ^ Command line parse result.+         -> IO ()+args_all descs args@(Arguments argl) =+   mapM_ (\desc ->+             when (arg_times args desc == 0) $+                argerror_ui ("Missing " ++ argname_a desc ++ "\n") descs+         )+         descs++-- |+-- Exactly one of the specified arguments must be present.+--+-- Otherwise throw an ArgError.+args_one :: [ArgumentDescription]         -- ^ List of the arguments, of which exactly one must be present.+         -> Arguments                     -- ^ Command line parse result.+         -> IO ()+args_one descs args@(Arguments argl) =+   when (occuring descs args /= 1) $+      argerror_ui ("Exactly one of the following arguments must be present.\n"+                ++ concat (intersperse ", " (map argname descs)) ++ "\n")+               descs+++-- |+-- At most one of the specified arguments may be present.+--+-- Otherwise throw an ArgError.+args_at_most_one :: [ArgumentDescription] -- ^ List of the arguments, of which at most one may be present.+                 -> Arguments             -- ^ Command line parse result.+                 -> IO ()+args_at_most_one descs args@(Arguments argl) =+   when (occuring descs args > 1) $+      argerror_ui ("Only one of the following arguments may be present.\n"+                   ++ concat (intersperse ", " (map argname descs)) ++ "\n")+                   descs+++-- |+-- At least one of the specified arguments must be present.+--+-- Otherwise throw an ArgError.+args_at_least_one :: [ArgumentDescription]        -- ^ List of the arguments, of which at least one must be present.+                  -> Arguments                    -- ^ Command line parse result.+                  -> IO ()+args_at_least_one descs args@(Arguments argl) =+   when (occuring descs args == 0) $+      argerror_ui ("One of the following arguments must be present.\n"+                   ++ concat (intersperse ", " (map argname descs)) ++ "\n")+                   descs+++-- |+-- When the specified argument is present, then none of the other arguments may be present.+--+-- Otherwise throw an ArgError.+arg_conflicts :: ArgumentDescription   -- ^ Argument which doesn't tolerate the other arguments+              -> [ArgumentDescription] -- ^ Arguments which aren't tolerated by the specified argument+              -> Arguments             -- ^ Command line parse result.+              -> IO ()+arg_conflicts desc descs args@(Arguments argl) =+   when (arg_occurs args desc && occuring descs args > 1) $+      argerror_ui ("When " ++ argname desc ++ " is present, none of the following arguments may be present.\n"+                   ++ concat (intersperse ", " (map argname descs)) ++ "\n")+                   descs+++-- How many of the specified arguments do occur? Multiple occurences of the same argument count as one.+occuring :: [ArgumentDescription] -> Arguments -> Int+occuring descs args =+   sum (map (\desc -> if arg_times args desc == 0 then 0 else 1) descs)+++{- | Whether the specified argument occurs in the command line.+-}+arg_occurs :: Arguments                   -- ^ Command line parse result.+           -> ArgumentDescription         -- ^ Description of the respective argument.+           -> Bool                              -- ^ Whether the specified argument occurs in the command line.+arg_occurs args desc =+   occuring [desc] args == 1+++-- |+-- /Deprecated/. This is left here for backwards compatibility. New programs should use @make_usage_info@ and/or @print_usage_info@.+--+-- Get the usage information from the parsed arguments. The usage info+-- contains the header specified to the corresponding @getargs...@+-- function, and descriptions of the command line arguments.+--+-- 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'.+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))++++{- | @getargs@ as a pure function, instead of an IO action. This allows to make evaluated command line arguments global values. This calls @getargs@+   to parse the command line arguments. @GHC.IO.unsafePerformIO@ is used to take the result out of the IO monad.++   >unsafe_getargs header descs = GHC.IO.unsafePerformIO $ getargs "" descs++   The @getargs@ action is performed on demand, when the parse result is evaluated. It may result in an 'ArgError' being thrown. In order to avoid+   this happening at unexpected times, the @main@ function should, start with the line @seq args (return ())@, where @args@ is the result of+   @unsafe_getargs@,. This will trigger any command line argument errors at the beginning of the program. (See section 6.2 of the Hakell Report for the+   definition of @seq@).++   The header is used only by the deprecated @usage_info@ function. If you don't+   use it, you don't need to specify a header. Just pass an empty string.++   A typical use of @unsafe_getargs@ looks like this:++>descs = [ d_myflag, ... ]+>+>d_myflag = argdesc [ ... ]+>+>args = unsafe_getargs "" descs+>myflag = arg_switch args d_myflag+>+>main = mainwrapper $ do+>   seq args (return ())+>   ...++  See 'getargs', 'unsafe_getargs_ordered'.+-}+unsafe_getargs :: String                        -- ^ Header to be used by the deprecated @usage_info@ function.+               -> [ArgumentDescription]   -- ^ The argument descriptions+               -> Arguments               -- ^ The parsed command line arguments+unsafe_getargs header descs =+   GHC.IO.unsafePerformIO $ getargs header descs+++{- | @getargs_ordered@ as a pure function, instead of an IO action. This is exactly like @unsafe_getargs@, but using @getargs_ordered@ instead of+   @getargs@.++   The header is used only by the deprecated @usage_info@ function. If you don't+   use it, you don't need to specify a header. Just pass an empty string.++   The definition is:++   >unsafe_getargs_ordered = GHC.IO.unsafePerformIO $ getargs_ordered "" descs++   See 'unsafe_getargs', 'usage_info', 'make_usage_info', 'print_usage_info'.+-}+unsafe_getargs_ordered :: String                        -- ^ Header to be used by the deprecated @usage_info@ function.+                       -> [ArgumentDescription]   -- ^ The argument descriptions+                       -> Arguments               -- ^ The parsed command line arguments+unsafe_getargs_ordered header descs =+   GHC.IO.unsafePerformIO $ getargs_ordered header 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.+--+-- 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                                  -- ^ 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                                  -- ^ Wrap everything at this column. Should probably be the terminal width.+                -> [String]                             -- ^ pretty printed usage information+make_usage_info argdescs colsleft colsarg 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++         map (\desc -> make_usage_info1 colsleft colsarg width desc)+             (filter (\desc -> not (is_direct desc)) argdescs)++   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 $++            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++      -- Alle Zeilen eirücken+      einruecken1 :: Int -> [String] -> [String]+      einruecken1 _ [] = [""]+      einruecken1 spalten zll =+         map (\z -> lz spalten ++ z) zll+++make_usage_info1 argdescs =+   concat (intersperse "\n" (make_usage_info argdescs 0 10 80))+++-- |+-- 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             -- ^ Width for the result text, in columns+     -> 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 =+         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')+++++-- |+-- 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)

@@ -1,981 +0,0 @@--- |--- This module provides a more convient way of parsing command line--- arguments than the GHC GetOpt package. It uses GetOpt, but hides--- it from the user. It is reexported from module HsShellScript.------ For each command line argument, a description is to be created with--- @argdesc@. Then the command line arguments are evaluated with--- one of the @getargs@... functions. In case of an error, this will cause a--- exception, which provides an expressive error message to be--- printed. Then the @arg@... functions are used to extract the--- values contained in the arguments, with the right type. The typical use--- of HsShellScript.Args looks something like this:------ >import HsShellScript--- >--- >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"--- >--- >      args <- getargs header [a_onevalue, a_values, a_switch, ...]--- >--- >      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--- >      )------ Errors in the argument descriptions are regarded as bugs, and handled--- by aborting the program with a message which is meaningful to the--- programmer. It is assumed that the argument description is a constant for--- a given program.------ Errors in the arguments are reported using HsShellScript's error handling--- scheme. An error description--- value is generated, and either returned via an @Either@--- value, or thrown as an exception.--module HsShellScript.Args ( -- ** Argument Properties-                    ArgumentProperty-                  , ArgumentDescription (..)-                  , ArgumentValueSpec (..)-                  , Argtester-                  , argdesc-                  , desc_short-                  , desc_long-                  , desc_direct-                  , desc_value_required-                  , desc_value_optional-                  , desc_times-                  , desc_once-                  , desc_at_least_once-                  , desc_at_most_once-                  , desc_any_times-                  , desc_at_least-                  , desc_at_most-                  , desc_argname-                  , desc_description-                  , desc_tester-                  , desc_integer-                  , desc_nonneg_integer-                  , readtester-                    -- ** Evaluating the Command Line-                  , Arguments-                  , getargs-                  , getargs_ordered-                  , getargs'-                  , getargs_ordered'-                  , unsafe_getargs-                  , unsafe_getargs_ordered-                    -- ** Extracting the Argument Values-                  , arg_switch-                  , arg_times-                  , args_opt-                  , args_req-                  , reqarg_opt-                  , reqarg_req-                  , optarg_opt-                  , optarg_req-                  , arg_occurs-                    -- ** Placing additional Constraints on the Arguments-                  , args_none-                  , args_all-                  , args_one-                  , args_at_most_one-                  , args_at_least_one-                  , arg_conflicts-                    -- ** Argument Error Reporting-                  , ArgError (..)-                  , usage_info-                  , argname-                  , argname_a-                  ) 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 Control.Monad-import Control.Exception-import Prelude hiding (catch)-import Data.Maybe-import System.Environment-import Data.List-import GHC.IO-import System.IO-import HsShellScript.Shell-import Data.Char-import Debug.Trace-import Data.Typeable------- | Does the command line argument take an value?-data ArgumentValueSpec  = ArgumentValue_none 		-- ^ No value-                        | ArgumentValue_required 	-- ^ Value required-                        | ArgumentValue_optional	-- ^ Value optional-   deriving (Eq, Show, Ord)----- | Argument value tester function. This tests the format of an argument's value for errors. The tester function is specified by--- 'desc_tester' or such, as part of the argument description. --- --- The tester is passed the argument value. If the format is correct, then it returns @Nothing@. If there is an error, then it returns @Just msgf@,--- with @msgf@ being an error message generation function. This function gets passed the argument description, and produces the error--- message. The argument description typically is used to extract a descriptive name of the argument (using 'argname' or 'argname_a') to be included--- in the error message.-type Argtester = String                           -- Argument value to be tested-                 -> Maybe (ArgumentDescription    -- Argument description for message generation-                           -> String              -- Error message-                          )----- | 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.-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_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)--instance Eq ArgumentDescription where-   d == e = ad_tup d == ad_tup e--instance Ord ArgumentDescription where-   compare d e = compare (ad_tup d) (ad_tup e)---- value for maximum number of times-unlimited = -1---- Whether two argument descriptions describe the same argument.--- Every short or long argument name occurs in only one argument--- descriptor (this is checked). Every argument has a short or a long--- name (short = [], long = [""] for direct arguments).-same_arg :: ArgumentDescription -> ArgumentDescription -> Bool-same_arg arg1 arg2 =-   case (argdesc_short_args arg1, argdesc_short_args arg2) of-      (a:_, b:_) -> a == b-      ([], [])   -> case (argdesc_long_args arg1, argdesc_long_args arg2) of-                       ([],_)  -> unnamed-                       (_,[])  -> unnamed-                       (l1,l2) -> head l1 == head l2-      _          -> False-   where unnamed = error "Bug in argument description: nameless, non-direct argument. desc_short or desc_long must be specified."---- | A property of a command line argument. These are generated by the--- @desc_@... functions, and condensed to argument--- descriptions of type @ArgumentDescription@ by @argdesc@. This type is abstract.-newtype ArgumentProperty =-   ArgumentProperty { argumentproperty :: ArgumentDescription -> ArgumentDescription }--- An argument property is a function which fills in part of an argument descriptor.----- starting value for argument descriptor-nulldesc :: ArgumentDescription-nulldesc =-   ArgumentDescription {-      argdesc_short_args = [],-      argdesc_long_args = [],-      argdesc_argarg = ArgumentValue_none,-      argdesc_times = Nothing,          -- default = (0,1)-      argdesc_argargname = Nothing,-      argdesc_argarg_description = Nothing,-      argdesc_argarg_tester = Nothing-   }---- default number of times an argument may occur-times_default = (0,1)----- | This represents the parsed contents of the command line. It is returned--- by the @getargs@... functions, and passed on to the--- value extraction functions by the user.------ See 'getargs', 'getargs_ordered', 'getargs\'', 'getargs_ordered\''.-newtype Arguments =-    Arguments ( [ ( ArgumentDescription             -- argument descriptor-                  , [Maybe String]                  -- arguments matching this descriptor-                  )-                ]-              , String                              -- usage information-              )--argvalues :: Arguments -> ArgumentDescription -> [Maybe String]-argvalues (Arguments (l,_)) desc =-   argvalues' l-   where-      argvalues' ((d,v):r) = if same_arg desc d then v else argvalues' r-      argvalues' []        = abort "Bug using HsShellScript: Value of unknown argument queried (add it to getarg's list)" desc---- used internally to represent one occurence of a specific argument-type ArgOcc = (ArgumentDescription, Maybe String)----- | Error thrown when there is an error in the--- command line arguments.-data ArgError = ArgError {-      -- | Error message generated by HsShellScript.Args.-      argerror_message :: String,-      -- | Usage information derived from the argument descriptions.-      argerror_usageinfo :: String-   }-   deriving (Typeable)----- |--- Make @ArgError@ an instance of @Exception@, so we can throw and catch it, using GHC-6.10\'s new exception library.-instance Exception ArgError--------- Printing an @ArgError@ will produce the error message. The usage--- information must be printed separately, using @usage_info@.-instance Show ArgError where-   show argerror = argerror_message argerror----- Whether it is the description for direct arguments. Direct arguments are--- the ones without introducing "-" or "--".-is_direct :: ArgumentDescription -> Bool-is_direct desc =-   argdesc_short_args desc == [] && argdesc_long_args desc == [""]----- |--- Short name of the argument. This specifies a character for a--- one letter style argument, like @-x@. There can be specified--- several for the same argument. Each argument needs at least--- either a short or a long name.-desc_short :: Char                      -- ^ The character to name the argument.-           -> ArgumentProperty    -- ^ The corresponding argument property.-desc_short c = ArgumentProperty-   (\desc ->-      if (c `elem` (argdesc_short_args desc))-         then abort ("Bug in HsShellScript argument description: Duplicate short argument " ++ show c ++ " specified") desc-         else if ("" `elem` argdesc_long_args desc)-                 then abort_conflict "" desc-                 else desc { argdesc_short_args = c : argdesc_short_args desc }-   )---- |---- Long name of the argument. This specifies a GNU style long name for the argument, which is--- introduced by two dashes, like @--arg@ or @--arg=...@. There can be specified several names for--- the same argument. Each argument needs at least either a short or a long name. Except for direct --- arguments, which don't have a name.------ See 'desc_direct'--desc_long :: String                     -- ^ The long name of the argument.-          -> ArgumentProperty     -- ^ The corresponding argument property.-desc_long str = ArgumentProperty-   (\desc ->-      if (str `elem` (argdesc_long_args desc))-         then abort ("Bug in HsShellScript argument description: Duplicate long argument " ++ show str ++ " specified") desc-         else if ("" `elem` argdesc_long_args desc)-                 then abort_conflict "" desc-                 else desc { argdesc_long_args = str : argdesc_long_args desc }-   )---- |--- Signal that this is the description of direct arguments. Direct arguments are the ones not--- introduced by any short or long argument names (like @-x@ or @--arg@). After the special argument--- @--@, also everything is a direct argument, even when starting with @-@ or @--@. The presence of--- @desc_direct@ in the argument properties list signals @argdesc@ that this is the description of--- the direct arguments. There may be at most one such description.-desc_direct :: ArgumentProperty-desc_direct = ArgumentProperty-   (\desc ->-      if argdesc_long_args desc == [] && argdesc_short_args desc == [] && argdesc_argarg desc == ArgumentValue_none-         then desc { argdesc_long_args = [""], argdesc_argarg = ArgumentValue_required, argdesc_argargname = Just "" }-         else abort_conflict "desc_direct conflicts desc_long, desc_short, desc_value_required and desc_value_optional." desc-   )---- |--- Signal that the argument requires a value.-desc_value_required :: ArgumentProperty-desc_value_required = ArgumentProperty-   (\desc ->-      if argdesc_argarg desc == ArgumentValue_none-         then desc { argdesc_argarg = ArgumentValue_required }-         else abort_conflict "desc_value_required repeated or conflicting desc_value_optional" desc-   )---- |--- Signal that the argument optionally has a value. The user may or may--- not specify a value to this argument.-desc_value_optional :: ArgumentProperty-desc_value_optional = ArgumentProperty-   (\desc ->-      if argdesc_argarg desc == ArgumentValue_none-         then desc { argdesc_argarg = ArgumentValue_optional }-         else abort_conflict "desc_value_optional repeated or conflicting desc_value_required" desc-   )---- |--- Specify lower and upper bound on the number of times an argument may--- occur.-desc_times :: Int                       -- ^ Lower bound of the allowed number of argdesc_times.-           -> Int                       -- ^ Upper bound of the allowed number of argdesc_times.-           -> ArgumentProperty          -- ^ The corresponding argument property.-desc_times n m = ArgumentProperty-   (\desc ->-       if argdesc_times desc == Nothing-          then desc { argdesc_times = Just (n,m) }-          else abort_conflict "desc_times conflicting previous number of occurences specification" desc-   )---- |--- Signal that the argument must be present exactly once. This is--- meaningful only for arguments which can take a value.-desc_once :: ArgumentProperty     -- ^ The corresponding argument property.-desc_once = desc_times 1 1---- |--- Signal that the argument must occur at least one time.-desc_at_least_once :: ArgumentProperty -- ^ The corresponding argument property.-desc_at_least_once = desc_times 1 unlimited---- |--- Signal that the argument must occur at most one time.-desc_at_most_once :: ArgumentProperty -- ^ The corresponding argument property.-desc_at_most_once  = desc_times 0 1---- |--- Signal that the argument must have at least the specified number of--- occurences, and has no upper limit of occurences.-desc_at_least :: Int                        -- ^ Number of times.-              -> ArgumentProperty           -- ^ The corresponding argument property.-desc_at_least n = desc_times n unlimited---- |--- Signal that the argument may occur any number of times.-desc_any_times :: ArgumentProperty -- ^ The corresponding argument property.-desc_any_times  = desc_times 0 unlimited---- |--- Signal that the argument does not need to be present, and may occur at most--- the specified number of times.-desc_at_most :: Int                     -- ^ Number of times.-             -> ArgumentProperty  -- ^ The corresponding argument property.-desc_at_most n = desc_times 0 n---- |--- Specify the descriptive name for command line argument's value. Used for the--- generation of the usage message. The name should be very short.-desc_argname :: String                          -- ^ Name of the argument's value.-             -> ArgumentProperty          -- ^ The corresponding argument property.-desc_argname name = ArgumentProperty-   (\desc ->-      if argdesc_argargname desc == Nothing-         then desc { argdesc_argargname = Just name }-         else abort "Bug in HsShellScript argument description: Multiple names specified" desc-   )---- |--- 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.-desc_description :: String                      -- ^ Short description of the argument.-                 -> 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-   )---- | Specify a tester for this argument. The tester is a function which tests the argument value for format errors. Typically, it tests whether the--- value can be parsed to some target type. If the test fails, the tester produces an error message. When parsing the command line arguments (which--- @getargs@ or related), all the testers are applied to the respective argument values, and an 'ArgError' is thrown in case of failure. By using a--- tester, it can be ensured that the argument values abide a specific format when extracting them, such that they can be parsed without errors, e.g.--- @myarg = read (reqarg_req args d_myarg)@.------ An argument tester is a function of type 'Argtester'. ------ See 'readtester', 'desc_integer', 'desc_nonneg_integer', 'Argtester'.-desc_tester :: Argtester                        -- ^ Argument tester to apply to this argument-            -> ArgumentProperty                 -- ^ The corresponding argument property.-desc_tester t = ArgumentProperty-   (\desc ->-      case argdesc_argarg_tester desc of-         Nothing -> desc { argdesc_argarg_tester = Just t }-         Just _  -> abort "Bug in HsShellScript argument description: Multiple argument value testers specified" desc-   )----- |--- Build an argument tester from a @reads@ like function. Typically, a specialisation of the standard prelude function @read@ is used. --- Example: @readtester \"Integer expected.\" (reads :: ReadS Int)@-readtester :: ReadS a                           -- Reader function, like the standard prelude function @reads@-           -> String                            -- Additional message-           -> Argtester                         -- Argument tester to be passed to 'desc_tester'-readtester reader msg val = -   case filter ((== "") . snd) $ reader val of-      [(_,"")] -> Nothing-      []       -> Just (\arg -> "Format error in the value of the " ++ argname_a arg ++ ". " ++ msg ++ "\nValue: " ++ quote val)-      _        -> Just (\arg -> "Ambigious value of the " ++ argname_a arg ++ ". " ++ msg ++ "\nValue: " ++ quote val)---{- | Specify that the value of this argument, if present, is a positive integer. This will cause an error when the command line is parsed, and the-   argument's value doesn't specify an integer.-->desc_integer = desc_tester (readtester (reads :: ReadS Int) "Integer expected.")--   See 'desc_tester'.--}-desc_integer :: ArgumentProperty-desc_integer = desc_tester (readtester (reads :: ReadS Int) "Integer expected.")---{- | Specify that the value of this argument, if present, is a non-negative integer. This will cause an error when the command line is parsed, and the-   value doesn't specify a non-negative integer.-->desc_nonneg_integer = desc_tester (readtester ((filter (\(a,_) -> a >= 0) . reads) :: ReadS Int) "Non-negative integer expected." )--   See 'desc_tester'.--}-desc_nonneg_integer :: ArgumentProperty-desc_nonneg_integer = desc_tester (readtester ((filter (\(a,_) -> a >= 0) . reads) :: ReadS Int) "Non-negative integer expected." )---abort_conflict msg = abort ("Conflicting properties in argument description. " ++ msg)-abort msg desc = error (msg ++ "\nargument (so far): " ++ argname desc)---- | Generate a descriptive argument name from an argument description, suitable for use in error messages. This uses the long and short argument names--- (as specified by 'desc_short' and 'desc_long') and generates descriptive names of the argument like \"-f\", \"--myflag\", \"-f\/--myflag\", etc. All the--- argument names are included. In case of direct arguments (see 'desc_direct'), the descriptive name is \"@(direct argument)@\".-argname :: ArgumentDescription -> String-argname desc =-   if (argdesc_short_args desc, argdesc_long_args desc) == ([],[""]) then "(direct argument)"-      else if (argdesc_short_args desc, argdesc_long_args desc) == ([],[]) then "yet unnamed argument"-         else concat (intersperse "/" ( map (\s -> "-"++[s]) (argdesc_short_args desc) ++ map ("--" ++) (argdesc_long_args desc) ))---- | Generate a descriptive argument name from an argument description, beginning with \"argument\". This uses the long and short argument names (as--- specified by 'desc_short' and 'desc_long') and generates descriptive names of the argument like \"argument -f\", \"argument --myflag\", \"argument--- -f\/--myflag\", etc. All the argument names are included. In case of direct arguments (see 'desc_direct'), the descriptive name is \"direct argument\".-argname_a :: ArgumentDescription -> String-argname_a desc =-   if (argdesc_short_args desc, argdesc_long_args desc) == ([],[""]) then "direct argument"-      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) ))--up1 "" = ""-up1 (x:xs) = toUpper x : xs---- complete generation of argument description-prop_final :: ArgumentProperty-prop_final = ArgumentProperty-   (\desc ->-      seq (if argdesc_argarg desc /= ArgumentValue_none && argdesc_argargname desc == Nothing-              then error $ "Bug in description of " ++ argname_a desc ++ ": Argument's value must be given a name using desc_argname."-              else if argdesc_argarg desc == ArgumentValue_none && argdesc_argargname desc /= Nothing-                      then error $ "Bug in description of " ++ argname_a desc-                           ++ ": Argument doesn't take a sub argument, but a name for it is specified."-                      else ()-          ) $-          desc { argdesc_times = Just (fromMaybe times_default (argdesc_times desc))-               , argdesc_argarg_description = Just (fromMaybe "" (argdesc_argarg_description desc))-               }-   )---- |--- Make an argument description from a list of argument properties. This--- condenses the list to an argument description,--- which can be used by the @getargs@... functions and the--- argument value extraction functions.-argdesc :: [ArgumentProperty]     -- ^ List of properties, which describe the command line argument.-        -> ArgumentDescription    -- ^ The corresponding argument description.-argdesc propl =-   foldr (.) id (map argumentproperty (prop_final:propl)) nulldesc----- Parse command line arguments.-getargs0 :: String -> ArgOrder ArgOcc -> [String] -> [ArgumentDescription] -> Either ArgError Arguments-getargs0 header ordering cmdlargs descs =-   let (  descs_direct     -- direct arguments (without argument name)-        , descs_regular    -- regular arguments (with long or short argument name)-        ) = partition is_direct descs--       nonunique :: Eq a => [a] -> Maybe a-       nonunique (a:b:r) = if (a == b) then (Just a) else nonunique (b:r)-       nonunique _       = Nothing--       test_unique :: (Show a, Ord a) => (ArgumentDescription -> [a]) -> String -> b -> b-       test_unique extr what x =-           case nonunique (sort (concat (map extr descs))) of-              Just y -> error ("Bug: Several occurences of " ++ what ++ " " ++ show y ++ " in command line argument specifications")-              Nothing -> x--       optdescr = map make_optdescr descs_regular--       make_optdescr :: ArgumentDescription -> OptDescr ArgOcc-       make_optdescr desc =-          Option (argdesc_short_args desc)-                 (argdesc_long_args desc)-                 (case argdesc_argarg desc of-                     ArgumentValue_none      -> NoArg  (desc, Nothing)-                     ArgumentValue_required     -> ReqArg (\arg -> (desc, Just arg))-                                              (fromJust (argdesc_argargname desc))-                     ArgumentValue_optional     -> OptArg (\arg -> (desc, arg))-                                              (fromJust (argdesc_argargname desc))-                 )-                 (fromJust (argdesc_argarg_description desc))--       -- Postprocessing after successful call to getOpt-       getopt_post :: [ArgOcc] -> [String] -> Either ArgError Arguments-       getopt_post pars{-getOpt recognized arguments-} rest{-direct arguments-} =-          case (rest, descs_direct) of-             ([],[])  ->-                -- no direct arguments allowed and none provided-                getopt_post' pars-             (r, [d]) ->-                -- direct arguments allowed and expected-                getopt_post' (pars ++ zip (repeat d) (map Just r))-             ((x:xs), []) ->-                -- direct arguments provided, but not allowed-                Left (ArgError "Surplus arguments." usageinfo)-             _ ->-                -- several descriptions for direct arguments-                error "Bug in argument descriptions: Several descriptions for direct arguments (desc_direct) specified."--       add :: (ArgumentDescription, Maybe String) -> [(ArgumentDescription, [Maybe String])] -> [(ArgumentDescription, [Maybe String])]-       add (a,str) []        = [(a,[str])]-       add (b,str) ((a,l):r) =-          if same_arg a b then (a,str:l) : r-                          else (a,l) : add (b,str) r--       getopt_post' :: [ArgOcc] -> Either ArgError Arguments-       getopt_post' pars{-all arguments-} =-          let pars' = foldr add (map (\d -> (d,[])) descs) pars--              -- Check the number of argument occurences-              check_num :: [(ArgumentDescription, [Maybe String])] -> Maybe ArgError-              check_num [] = Nothing-              check_num ((desc,args):rest) =-                 let (min,max) = fromJust (argdesc_times desc)-                     number    = length args-                     wrong_number_msg =-                        (if is_direct desc then fst else snd) $-                        if number == 0 && min == 1 then-                           ( "Missing argument."-                           , "Missing " ++ argname_a desc ++ "."-                           )-                        else if number < min then-                           ( "Too few arguments. " ++ show min ++ " required."-                           , "Too few instances of " ++ argname_a desc ++ ". "++ show min ++ " required."-                           )-                        else if number > max && max == 1 then-                           ( "Only one argument may be specified."-                           , "Repeated " ++ argname_a desc ++ "."-                           )-                        else if number > max && max /= unlimited then-                           ( "Too many arguments."-                           , "Too many instances of " ++ argname_a desc ++ "."-                           )-                        else error "bug in HsShellScript.Args.hs"-                 in  if number >= min && (number <= max || max == unlimited)-                        then check_num rest-                        else Just (ArgError wrong_number_msg usageinfo)--              -- Apply any argument testers-              check_testers :: [(ArgumentDescription, [Maybe String])] -> Maybe ArgError-              check_testers [] = Nothing-              check_testers ((desc,args):rest) =-                 case argdesc_argarg_tester desc of-                    Just argdesc_argarg_tester -> -                       if argdesc_argarg desc == ArgumentValue_none -                          then abort "Bug in HsShellScript argument descriptions: Argument value tester specified,\n\-                                     \but no argument value has been allowed. Add desc_value_optional or\n\-                                     \desc_value_required." -                                     desc-                          else case filter isJust (map (argdesc_argarg_tester . fromJust) (filter isJust args)) of-                                  []              -> check_testers rest-                                  (Just msgf : _) -> Just (ArgError (msgf desc) usageinfo)-                    Nothing -> check_testers rest--          in  case check_testers pars' of -                 Nothing  -> case check_num pars' of-                                Nothing  -> Right (Arguments (pars',usageinfo))-                                Just err -> Left err-                 Just err -> Left err--       -- usage information generated by GetOpt-       usageinfo = usageInfo header optdescr--   in test_unique argdesc_short_args "short argument" $-         test_unique argdesc_long_args "long argument" $-            case getOpt ordering optdescr cmdlargs of-               (pars, rest, []) ->-                  getopt_post pars rest-               (_,_,f) ->-                  throw (ArgError (unlines (map chomp f)) (usageInfo header optdescr))-   where-      -- duplicated here in order to break cyclic module dependency-      chomp "" = ""-      chomp "\n" = ""-      chomp [x] = [x]-      chomp (x:xs) = let xs' = chomp xs-                     in  if xs' == "" && x == '\n' then "" else x:xs'----- |--- Parse command line arguments. The arguments are taken from a call to--- @getArgs@ and parsed. Any error is thrown as a --- @ArgError@ exception. The result is a value from which the--- information in the command line can be extracted by the @arg@...,--- @reqarg@... and @optarg@... functions.------ Named arguments (like @-x@ or @--arg@) and direct--- arguments may occur in any order.-getargs :: String                               -- ^ Header to be used in the usage info.-        -> [ArgumentDescription]          -- ^ The argument descriptions.-        -> IO Arguments                   -- ^ The contents of the command line.-getargs header descs = do-   args <- getArgs-   let res = getargs0 header Permute args descs-   either throw-          return-          res---- |--- Parse command line arguments. The arguments are taken from a call to--- @getArgs@ and parsed. Any error is thrown as a --- @ArgError@ exception. The result is a value from which the--- information in the command line can be extracted by the @arg@...,--- @reqarg@... and @optarg@... functions.------ All arguments after the first direct argument are regarded as direct--- arguments. This means that argument names introduced by @-@--- or @--@ no longer take effect.-getargs_ordered :: String                       -- ^ Header to be used in the usage info.-                -> [ArgumentDescription]  -- ^ Descriptions of the arguments.-                -> IO Arguments           -- ^ The contents of the command line.-getargs_ordered header descs = do-   args <- getArgs-   either throw-          return-          (getargs0 header RequireOrder args descs)---- |--- Parse the specified command line. Any error is returned as @Left--- argerror@. In case of success, the result is returned as--- @Right res@. From the result, the information in the command--- line can be extracted by the @arg@..., @reqarg@...--- and @optarg@... functions.------ Named arguments (like @-x@ or @--arg@) and direct--- arguments may occur in any order.-getargs' :: String                              -- ^ Header to be used in the usage info.-         -> [String]                            -- ^ Command line to be parsed.-         -> [ArgumentDescription]         -- ^ The argument descriptions.-         -> Either ArgError Arguments     -- ^ The contents of the command line.-getargs' header args descs = getargs0 header Permute args descs---- |--- Parse the specified command line. Any error is returned as @Left--- argerror@. In case of success, the result is returned as--- @Right res@. From the result, the information in the command--- line can be extracted by the @arg@..., @reqarg@...--- and @optarg@... functions.------ All arguments after the first direct argument are regarded as direct--- arguments. This means that argument names introduced by @-@--- or @--@ no longer take effect.-getargs_ordered' :: String                              -- ^ Header to be used in the usage info.-                 -> [String]                            -- ^ Command line to be parsed.-                 -> [ArgumentDescription]         -- ^ The argument descriptions.-                 -> Either ArgError Arguments     -- ^ The contents of the command line.-getargs_ordered' header args descs = getargs0 header RequireOrder args descs---test_desc :: ArgumentDescription -> Bool -> String -> b -> b-test_desc desc ok msg x =-   if ok then x-         else abort msg desc--maybe_head :: [a] -> Maybe a-maybe_head [] = Nothing-maybe_head [a] = Just a---- |--- Query whether a certain switch is specified on the command line. A switch is an--- argument which is allowed zero or one time, and has no value.-arg_switch :: Arguments                   -- ^ Command line parse result.-           -> ArgumentDescription         -- ^ Argument description of the switch.-           -> Bool                              -- ^ Whether the switch is present in the command line.-arg_switch args desc =-   test_desc desc (argdesc_argarg desc == ArgumentValue_none && argdesc_times desc == Just (0,1))-             "bug: querying argument with is not a switch with arg_switch" $-   case argvalues args desc of-      []         -> False-      [Nothing]  -> True---- |--- Query the number of occurences of an argument.-arg_times :: Arguments                    -- ^ Command line parse result.-          -> ArgumentDescription          -- ^ Description of the argument.-          -> Int                          -- ^ Number of times the argument occurs.-arg_times args desc =-   length (argvalues args desc)---- |--- Query the values of an argument with optional value. This is for--- arguments which take an optional value, and may occur several times. The--- occurences with value are represented as @Just value@, the occurences--- without are represented as @Nothing@.-args_opt :: Arguments                     -- ^ Command line parse result.-         -> ArgumentDescription           -- ^ Description of the argument.-         -> [Maybe String]                      -- ^ The occurences of the argument.-args_opt args desc =-   test_desc desc (argdesc_argarg desc == ArgumentValue_optional && snd (fromJust (argdesc_times desc)) /= 1)-             "Bug: Querying argument which doesn't take an optional value, or may not occur several times, with args_opt."-   $ argvalues args desc---- |--- Query the values of an argument with required value. This is for--- arguments which require a value, and may occur several times.-args_req :: Arguments                     -- ^ Command line parse result.-         -> ArgumentDescription           -- ^ Description of the argument.-         -> [String]                            -- ^ The values of the argument.-args_req args desc =-   test_desc desc (argdesc_argarg desc == ArgumentValue_required && snd (fromJust (argdesc_times desc)) /= 1)-             "Bug: Querying argument which doesn't require a value, or may not occur several times, with args_req." $-   map fromJust (argvalues args desc)---- |--- Query the optional value of a required argument. This is for arguments--- which must occur once, and may have a value. If the argument is--- specified, its value is returned as @Just value@. If it isn't, the result--- is @Nothing@.-reqarg_opt :: Arguments                   -- ^ Command line parse result.-           -> ArgumentDescription         -- ^ Description of the argument.-           -> Maybe String                      -- ^ The value of the argument, if it occurs.-reqarg_opt args desc =-   test_desc desc (argdesc_argarg desc == ArgumentValue_optional && argdesc_times desc == Just (1,1))-             "Bug: Querying argument which doesn't take an optional value, or which must not occur exactly once, with reqarg_opt." $-   head (argvalues args desc)---- |--- Query the value of a required argument. This is for arguments which must--- occur exactly once, and require a value.-reqarg_req :: Arguments                   -- ^ Command line parse result.-           -> ArgumentDescription         -- ^ Description of the argument.-           -> String                            -- ^ The value of the argument.-reqarg_req args desc =-   test_desc desc (argdesc_argarg desc == ArgumentValue_required && argdesc_times desc == Just (1,1))-             "Bug: Querying argument with non-required value, or which doesn't occur exactly once, with reqarg_req." $-   fromJust (head (argvalues args desc))---- |--- Query the optional value of an optional argument. This is for arguments--- which may occur zero or one time, and which may or may not have a value.--- If the argument doesn't occur, the result is @Nothing@. If it does occur,--- but has no value, then the result is @Just Nothing@. If it does occur with--- value, the result is @Just (Just value)@.-optarg_opt :: Arguments                   -- ^ Command line parse result.-           -> ArgumentDescription         -- ^ Description of the argument.-           -> Maybe (Maybe String)              -- ^ The occurence of the argument and its value (see above).-optarg_opt args desc =-   test_desc desc (argdesc_argarg desc == ArgumentValue_optional)  "Bug: Querying argument with non-optional value with optarg_opt." $-   test_desc desc (fst (fromJust (argdesc_times desc)) == 0)       "Bug: Querying argument which isn't optional with optarg_opt." $-   test_desc desc (snd (fromJust (argdesc_times desc)) == 1)       "Bug: Querying argument which may occur several times optarg_opt." $-   maybe_head (argvalues args desc)---- |--- Query the value of an optional argument. This is for optional arguments--- which require a value, and may occur at most once. The result is--- @Just value@ if the argument occurs, and @Nothing@--- if it doesn't occur.-optarg_req :: Arguments                   -- ^ Command line parse result.-           -> ArgumentDescription         -- ^ Description of the argument.-           -> Maybe String                      -- ^ The value of the argument, if it occurs.-optarg_req args desc =-   test_desc desc (argdesc_argarg desc == ArgumentValue_required)        "Bug: Querying argument with non-required value with optarg_req."-   $ test_desc desc (fst (fromJust (argdesc_times desc)) == 0)          "Bug: Querying argument which isn't optional with optarg_req."-   $ test_desc desc (snd (fromJust (argdesc_times desc)) == 1)          "Bug: Querying argument which may occur several times optarg_req."-   $ fmap fromJust (maybe_head (argvalues args desc))----- |--- None of the specifed arguments may be present.------ Throws an ArgError if any of the arguments are present.-args_none :: [ArgumentDescription]        -- ^ List of the arguments which must not be present.-          -> Arguments                    -- ^ Command line parse result.-          -> IO ()-args_none descs args@(Arguments (argl,usageinfo)) =-   mapM_ (\desc ->-             when (arg_times args desc /= 0) $-                throw (ArgError (up1 (argname_a desc) ++ " is not allowed.\n") usageinfo)-         )-         descs---- |--- All of the specified arguments must be present.------ Throws an ArgError if any is missing.-args_all :: [ArgumentDescription]         -- ^ List of the arguments which must be present.-         -> Arguments                     -- ^ Command line parse result.-         -> IO ()-args_all descs args@(Arguments (argl,usageinfo)) =-   mapM_ (\desc ->-             when (arg_times args desc == 0) $-                throw (ArgError ("Missing " ++ argname_a desc ++ "\n") usageinfo)-         )-         descs---- |--- Exactly one of the specified arguments must be present.------ Otherwise throw an ArgError.-args_one :: [ArgumentDescription]         -- ^ List of the arguments, of which exactly one must be present.-         -> Arguments                     -- ^ Command line parse result.-         -> IO ()-args_one descs args@(Arguments (argl,usageinfo)) =-   when (occuring descs args /= 1) $-      throw (ArgError ("Exactly one of the following arguments must be present.\n"-                       ++ concat (intersperse ", " (map argname descs)) ++ "\n")-                       usageinfo)----- |--- At most one of the specified arguments may be present.------ Otherwise throw an ArgError.-args_at_most_one :: [ArgumentDescription] -- ^ List of the arguments, of which at most one may be present.-                 -> Arguments             -- ^ Command line parse result.-                 -> IO ()-args_at_most_one descs args@(Arguments (argl,usageinfo)) =-   when (occuring descs args > 1) $-      throw (ArgError ("Only one of the following arguments may be present.\n"-                       ++ concat (intersperse ", " (map argname descs)) ++ "\n")-                      usageinfo)----- |--- At least one of the specified arguments must be present.------ Otherwise throw an ArgError.-args_at_least_one :: [ArgumentDescription]        -- ^ List of the arguments, of which at least one must be present.-                  -> Arguments                    -- ^ Command line parse result.-                  -> IO ()-args_at_least_one descs args@(Arguments (argl,usageinfo)) =-   when (occuring descs args == 0) $-      throw (ArgError ("One of the following arguments must be present.\n"-                       ++ concat (intersperse ", " (map argname descs)) ++ "\n")-                      usageinfo)----- |--- When the specified argument is present, then none of the other arguments may be present.------ Otherwise throw an ArgError.-arg_conflicts :: ArgumentDescription   -- ^ Argument which doesn't tolerate the other arguments-              -> [ArgumentDescription] -- ^ Arguments which aren't tolerated by the specified argument-              -> Arguments             -- ^ Command line parse result.-              -> IO ()-arg_conflicts desc descs args@(Arguments (argl,usageinfo)) =-   when (arg_occurs args desc && occuring descs args > 1) $-      throw (ArgError ("When " ++ argname desc ++ " is present, none of the following arguments may be present.\n"-                       ++ concat (intersperse ", " (map argname descs)) ++ "\n")-                       usageinfo)----- How many of the specified arguments do occur? Multiple occurences of the same argument count as one.-occuring :: [ArgumentDescription] -> Arguments -> Int-occuring descs args =-   sum (map (\desc -> if arg_times args desc == 0 then 0 else 1) descs)---{- | Whether the specified argument occurs in the command line. --}-arg_occurs :: Arguments                   -- ^ Command line parse result.-           -> ArgumentDescription         -- ^ Description of the respective argument.-           -> Bool                              -- ^ Whether the specified argument occurs in the command line.-arg_occurs args desc =-   occuring [desc] args == 1----- |--- Get the usage information from the parsed arguments. The usage info--- contains the header specified to the corresponding @getargs...@--- function, and descriptions of the command line arguments.-usage_info :: Arguments -> String-usage_info (Arguments (_,ui)) = ui---{--instance Show (OptDescr a) where-   show (Option short long argdescr expl) =-       "Option short:" ++ showList short " long:" ++ show long ++ " argdescr:" ++ show argdescr ++ " expl:" ++ showList expl ""--instance Show (ArgDescr a) where-   show (NoArg _) = "NoArg"-   show (ReqArg _ _) = "ReqArg ..."-   show (OptArg _ _) = "OptArg ..."--}---{- | @getargs@ as a pure function, instead of an IO action. This allows to make evaluated command line arguments global values. This calls @getargs@-   to parse the command line arguments. @GHC.IO.unsafePerformIO@ is used to take the result out of the IO monad.--   >unsafe_getargs header descs = GHC.IO.unsafePerformIO $ getargs header descs--   The @getargs@ action is performed on demand, when the parse result is evaluated. It may result in an 'ArgError' being thrown. In order to avoid-   this happening at unexpected times, the @main@ function should, start with the line @seq args (return ())@, where @args@ is the result of-   @unsafe_getargs@,. This will trigger any command line argument errors at the beginning of the program. (See section 6.2 of the Hakell Report for the-   definition of @seq@).--   A typical use of @unsafe_getargs@ looks like this:-->header = "..."->descs = [ d_myflag, ... ]->->d_myflag = argdesc [ ... ]->->args = unsafe_getargs header descs->myflag = arg_switch args d_myflag->->main = mainwrapper $ do->   seq args (return ())->   ...--  See 'getargs', 'unsafe_getargs_ordered'.--}-unsafe_getargs :: String                        -- ^ The header used in the usage information-               -> [ArgumentDescription]   -- ^ The argument descriptions-               -> Arguments               -- ^ The parsed command line arguments-unsafe_getargs header descs = -   GHC.IO.unsafePerformIO $ getargs header descs---{- | @getargs_ordered@ as a pure function, instead of an IO action. This is exactly like @unsafe_getargs@, but using @getargs_ordered@ instead of-   @getargs@.--   >unsafe_getargs_ordered = GHC.IO.unsafePerformIO $ getargs_ordered header descs--   See 'unsafe_getargs'.--}-unsafe_getargs_ordered :: String                        -- ^ The header used in the usage information-                       -> [ArgumentDescription]   -- ^ The argument descriptions-                       -> Arguments               -- ^ The parsed command line arguments-unsafe_getargs_ordered header descs = -   GHC.IO.unsafePerformIO $ getargs_ordered header descs

@@ -0,0 +1,9 @@+module HsShellScript.Args where++data ArgError = ArgError {+      argerror_message :: String,+      argerror_usageinfo :: String+   }+   deriving (Typeable)++

@@ -5,7 +5,6 @@ import Prelude hiding (catch) import Control.Exception import Data.Bits--- import Directory import Foreign.C import Foreign.C.Error import Foreign.Ptr@@ -23,15 +22,14 @@ import Control.Exception import Text.ParserCombinators.Parsec as Parsec import System.Posix hiding (rename, createDirectory, removeDirectory)---import System.Env import System.Random import System.Directory  -- | -- Do a call to the @realpath(3)@ system library function. This makes the path absolute, normalizes it and expands all symbolic links. In case of an -- error, an @IOError@ is thrown.-realpath :: String      -- ^ path-         -> IO String	-- ^ noramlized, absolute path, with symbolic links expanded+realpath :: String    -- ^ path+         -> IO String -- ^ noramlized, absolute path, with symbolic links expanded realpath path =    withCString path $ \cpath -> do       res <- {#call hsshellscript_get_realpath#} cpath@@ -43,8 +41,8 @@ -- the directory which the symlink is in. In case of an error, an @IOError@ is thrown. The path is included and can be accessed with -- @IO.ioeGetFileName@. Note that, if the path to the symlink ends with a slash, this path denotes the directory pointed to, /not/ the symlink. In -- this case the call to will fail because of \"Invalid argument\".-readlink :: String      -- ^ Path of the symbolic link-         -> IO String	-- ^ The link target - where the symbolic link points to+readlink :: String    -- ^ Path of the symbolic link+         -> IO String -- ^ The link target - where the symbolic link points to readlink path =    withCString path $ \cpath -> do       res <- {#call hsshellscript_get_readlink#} cpath@@ -57,7 +55,7 @@ -- to, /not/ the symlink. In this case the call to @readlink@ will fail with an @IOError@ because of \"Invalid argument\". In case of any error, a -- proper @IOError@ is thrown. readlink' :: String     -- ^ path of the symbolic link-          -> IO String	-- ^ target; where the symbolic link points to+          -> IO String  -- ^ target; where the symbolic link points to readlink' symlink = do    target <- readlink symlink    return (absolute_path' target (fst (split_path symlink)))

@@ -5,20 +5,20 @@ -}  module HsShellScript.GetOpt (-	-- * GetOpt-	getOpt,-	usageInfo,-	ArgOrder(..),-	OptDescr(..),-	ArgDescr(..),+        -- * GetOpt+ getOpt,+ usageInfo,+ ArgOrder(..),+ OptDescr(..),+ ArgDescr(..), -	-- * Example-		-	-- $example+ -- * Example+  + -- $example   ) where  import Prelude-import Data.List 	( isPrefixOf )+import Data.List  ( isPrefixOf )  -- |What to do with options following non-options data ArgOrder a@@ -241,7 +241,7 @@ >    data Flag  >     = Verbose  | Version  >     | Input String | Output String | LibDir String->    	deriving Show+>     deriving Show >     >    options :: [OptDescr Flag] >    options =@@ -258,9 +258,9 @@ >     >    compilerOpts :: [String] -> IO ([Flag], [String]) >    compilerOpts argv = ->    	case (getOpt Permute options argv) of->    	   (o,n,[]  ) -> return (o,n)->    	   (_,_,errs) -> ioError (userError (concat errs ++ usageInfo header options))+>     case (getOpt Permute options argv) of+>        (o,n,[]  ) -> return (o,n)+>        (_,_,errs) -> ioError (userError (concat errs ++ usageInfo header options)) >      where header = "Usage: ic [OPTION...] files..."  -}

@@ -472,6 +472,28 @@             )  +-- |+-- Quote special characters for use with the @glob@ function.+--+-- The characters @*@, @?@, @[@ and @\\@ must be quoted by preceding+-- backslashs, when they souldn't have their special meaning. The @glob_quote@+-- function does this.+-- +-- You can't use @quote@ or @shell_quote@.+--+-- See 'glob', 'quote', 'shell_quote'+glob_quote :: String+           -> String+glob_quote path = +   case path of+      []          -> []+      ('*':rest)  -> ('\\':'*':glob_quote rest)+      ('?':rest)  -> ('\\':'?':glob_quote rest)+      ('[':rest)  -> ('\\':'[':glob_quote rest)+      ('\\':rest) -> ('\\':'\\':glob_quote rest)+      (ch:rest)   -> ch : glob_quote rest++  #c /*

@@ -24,8 +24,6 @@ import GHC.IO.Handle import GHC.IO.Handle.Internals             -- withHandle', do_operation import GHC.IO.Handle.Types hiding (close)-import HsShellScript.Args-import HsShellScript.Shell import Prelude hiding (catch) import System.Directory import System.Environment@@ -39,6 +37,9 @@ import qualified GHC.IO.FD as FD import qualified System.IO.Error                -- mkIOError +import HsShellScript.Args+import HsShellScript.Shell+ infixr 2 -|-    -- left handed, stdout infixr 2 =|-    -- left handed, stderr infixl 2 -|=    -- right handed, stdout@@ -70,21 +71,19 @@ -- Execute an IO action as a separate process, and wait for it to finish. -- Report errors as exceptions. ----- This forks a child process, which performs the specified IO action.--- In--- case the child process has been stopped by a signal, the parent blocks.+-- This forks a child process, which performs the specified IO action. In case+-- the child process has been stopped by a signal, the parent blocks. -- -- If the action throws an @IOError@, it is transmitted to the parent. -- It is then raised there, as if it happened locally. The child then aborts -- quietly with an exit code of 0. ----- Exceptions in--- the child process, other than @IOError@s, result in an error message on @stderr@, and a--- @ProcessStatus@ exception in the parent, with the value of @Exited--- (ExitFailure 1)@. The following exceptions are understood by @subproc@, and--- result in corresponding messages: @ArgError@, @ProcessStatus@, @RunError@,--- @IOError@ and @ExitCode@. Other exceptions result in the generic message, as--- produced by @show@.+-- Exceptions in the child process, other than @IOError@s, result in an error+-- message on @stderr@, and a @ProcessStatus@ exception in the parent, with the+-- value of @Exited (ExitFailure 1)@. The following exceptions are understood by+-- @subproc@, and result in corresponding messages: @ArgError@, @ProcessStatus@,+-- @RunError@, @IOError@ and @ExitCode@. Other exceptions result in the generic+-- message, as produced by @show@. -- -- If the child process exits with an exit code other than zero, or it is -- terminated by a signal, the corresponding @ProcessStatus@ is raised as an@@ -2159,10 +2158,6 @@          )     where-      handleToFd_noclose :: Handle -> IO Fd-      handleToFd_noclose h =-         unsafeWithHandleFd h (\fd -> return fd)-       restore h@(FileHandle _ mvar) fd = do          -- The fd used by the handle. This is in GHC.IO.Handle.FD          --                              handleToFd_noclose: Fehlerhaft, aus hssh-2.9@@ -2229,6 +2224,12 @@   +handleToFd_noclose :: Handle -> IO Fd+handleToFd_noclose h =+    unsafeWithHandleFd h (\fd -> return fd)+++ {- About Bas van Dijk's unsafeWithHandleFd:     This function is broken. It blocks when called like this:@@ -2396,6 +2397,47 @@ instance Exception ProcessStatus  ++-- | Determine the terminal width in columns. +--+-- This value can be used to format output to fit the terminal.+--+-- This queries the terminal which is connected to stdout. It may happen, that+-- stdout isn't connected to a terminal. For instance when the program is part of+-- a pipe. In this case, an IOError is thrown.+--+-- 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.+terminal_width_ioe h = do++   fd <- unsafeWithHandleFd h $ \fd -> do +      res <- {#call c_terminal_width#} (fromIntegral fd)+      when (res == -1) $ throwErrno' "terminal_width" Nothing Nothing+      return res+   return (fromIntegral fd)+++-- | Determine the terminal width in columns. +--+-- This value can be used to format output to fit the terminal.+--+-- This queries the terminal which is connected to stdout. It may happen, that+-- stdout isn't connected to a terminal, for instance when the program is part of+-- a pipe. In this case, @Nothing@ is returned. No exception is thrown.+--+-- See 'terminal_width_ioe', 'make_usage_info', 'print_usage_info', 'usage_info', 'wrap'.+terminal_width :: Handle                -- ^ Handle, which is connected to the terminal    +               -> IO (Maybe Int)        -- ^ The number of columns in the constrolling terminal. +                                    --   Nothing, when the handle isn't connected to a terminal.+terminal_width h = do+   w <- terminal_width_ioe h+   return (Just w)+   `catch` (\(ioe :: IOError) -> return Nothing)+++ #c /* c2hs-0.14.5 chokes on the following includes.@@ -2432,4 +2474,7 @@  /* Set the flags of a file descriptor. Returns the old flags. */ int c_set_flags(int fd, int new_flags);++/* Determine the with of the controlling terminal */+int c_terminal_width(int fd); #endc

@@ -0,0 +1,9 @@+module HsShellScript.ProcErr where++import Data.Maybe+import System.IO++terminal_width :: Handle -> IO (Maybe Int)+terminal_width_ioe :: Handle -> IO Int++throwErrno' :: String -> Maybe Handle -> Maybe FilePath -> IO a

@@ -8,6 +8,7 @@ #include <stdio.h> #include <stdlib.h> #include <string.h>+#include <sys/ioctl.h> #include <sys/stat.h> #include <sys/types.h> #include <unistd.h>@@ -132,3 +133,20 @@   return old_flags; } +int c_terminal_width_stdout(void)+{+  struct winsize size;+  if (ioctl (STDOUT_FILENO, TIOCGWINSZ, &size) == -1)+    return -1;+  else +    return size.ws_col;+}++int c_terminal_width_stderr(void)+{+  struct winsize size;+  if (ioctl (STDERR_FILENO, TIOCGWINSZ, &size) == -1)+    return -1;+  else +    return size.ws_col;+}

@@ -1,6 +1,5 @@-VERSION=3.3.4-CFLAGS=-XDeriveDataTypeable -i../dist/build -package-name hsshellscript-3.3.4-# Kleines i bei "-i" oben+VERSION=3.4.0+CFLAGS=-XDeriveDataTypeable   PROG_HS  = $(notdir $(basename $(wildcard [_abcdefghijklmnopqrstuvwxyzäöü]*.hs))) PROG_CHS = $(notdir $(basename $(wildcard [_abcdefghijklmnopqrstuvwxyzäöü]*.chs)))@@ -9,13 +8,16 @@ PROGS    = $(sort $(PROG_HS) $(PROG_CHS))  -% : %.o cteile.o ../dist/build/libHShsshellscript-$(VERSION).a-	ghc -o $@ $^ -package haskell2010 -package unix -package directory -package random+% : %.o cteile.o+	ghc -o $@ $^ -package unix -package directory -package random -package parsec -package hsshellscript  %.o : %.hs 	ghc -c $(CFLAGS) $^ -%.o : %.c+# %.o : %.c++cteile.o : cteile.c+	echo CTEILE 	gcc -c -o $@ $<  %.hs : %.chs@@ -24,15 +26,15 @@ 	chmod u-w $@  clean :: depend-	rm -f *.hi *.o *~ *.bak $(PROGS) *.chi *.chs.h \+	rm -f -- *.hi *.o *~ *.bak $(PROGS) *.chi *.chs.h \ 	      $(foreach m, $(PROG_CHS), "$(m).hs")  depend :: $(foreach m, $(PROGS), $(m).hs) 	ghc -M $(CFLAGS) -dep-makefile -optdepdepend -dep-suffix "p_" \ 	       $(foreach m, $(PROGS), "$(m).hs")-	make cteile.o+#	make cteile.o -z : z.c-	gcc -o $@ $<+#z : z.c+#	gcc -o $@ $<  -include depend

@@ -0,0 +1,67 @@+-- Fehler, wenn die Breiten nicht hinkommen in make_usage_info++module Main (main) where++import HsShellScript+import Data.Maybe+import Data.List+import Debug.Trace+import Control.Monad+import Control.Exception+import System.IO+++header                                  = "Testprogramm für Kommandozeilenargumente\n\n"+descs                                   = [ d_trenner, d_pfade, d_uml, d_komp, d_inhalt ]+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_long "komp"+           , 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\n\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.")+           ]+++main = mainwrapper $ do+   seq args (return ())+   +   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+

@@ -0,0 +1,74 @@+-- 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" #-}+-- Fehler, wenn die Breiten nicht hinkommen in make_usage_info++module Main (main) where++++import HsShellScript+import Data.Maybe+import Data.List+import Debug.Trace+import Control.Monad+import Control.Exception+import System.IO+++header                                  = "Testprogramm für Kommandozeilenargumente\n\n"+descs                                   = [ d_trenner, d_pfade, d_uml, d_komp, d_inhalt ]+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_long "komp"+           , 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\n\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.")+           ]+++main = mainwrapper $ do+   seq args (return ())+   +   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+

@@ -1,6 +1,11 @@ #include <stdio.h> #include <string.h> +#include <stdio.h>+#include <unistd.h>+#include <sys/ioctl.h>++ void c_aufruf(const char* ptr) {   printf("ptr = >%s<\nlength = %d\n", ptr, (int) strlen(ptr));@@ -31,3 +36,19 @@   printf("\", Länge = %d\n",len); } ++++//----------------------------------------------------------------------------------------------------++// Thanks to Jan-Benedict Glaw for this+int c_terminal_width(int fd)+{+  int res;+  struct winsize size;++  res = ioctl (fd, TIOCGWINSZ, &size);++  if (res == -1) return -1;+  else return size.ws_col;+}

@@ -0,0 +1,6 @@+import HsShellScript++main = do+   erg <- fdupes ["-r", "-s", "-H"] ["."]+   print erg+

@@ -0,0 +1,12 @@+import HsShellScript++silly = "[[silly \\ filename]]"++main = do+   runprog "touch" ["/tmp/"++silly]+   +   q <- glob ("/tmp/"++glob_quote silly)+   outm ("Quoted: " ++ show q)++   nq <- glob ("/tmp/"++ silly)+   outm ("Non-quoted: " ++ show nq)