-- GENERATED by C->Haskell Compiler, version 0.28.8 Switcheroo, 25 November 2017 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "src/HsShellScript/Args.chs" #-}
-- |
-- This module provides a more convient way of parsing command line
-- arguments than the GHC GetOpt package. It builds on top of 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
-- >import Control.Exception
-- >import Control.Monad
-- >import System.Environment
-- >import System.Exit
-- >import System.IO
-- >
-- >header = "mclapep - My Command Line Argument Parser Example Program, version 1.0.0\n\n"
-- >descs  = [d_onevalue, d_values, d_switch {-...-}]
-- >
-- >d_onevalue = argdesc [ desc_short 'o', desc_at_most_once, desc_argname "a", desc_value_required {-...-}]
-- >d_values   = argdesc [ desc_direct, desc_any_times {-...-} ]
-- >d_switch   = argdesc [ desc_long "doit", desc_at_most_once {-...-} ]
-- >-- ...
-- >
-- >args = unsafe_getargs header descs
-- >val  = optarg_req args d_onevalue        -- val  :: Maybe String
-- >vals = args_req   args d_values          -- vals :: [String]
-- >doit = arg_switch args d_switch          -- doit :: Bool
-- >-- ...
-- >
-- >main = mainwrapper $ do
-- >   args0 <- getArgs
-- >   when (null args0) $ do
-- >      -- No command line arguments - print usage information
-- >      print_usage_info stdout header descs
-- >      exitWith ExitSuccess
-- >   -- trigger argument errors
-- >   seq args (return ())
-- >
-- >   -- Do something with the arguments
--
-- Errors in the argument descriptions are regarded as bugs, and handled
-- by aborting the program with a message which is meaningful to the
-- 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
                  , argname_short
                  , argname_long
                  , wrap
                  ) 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 (terminal_width, terminal_width_ioe)

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
import Control.Concurrent.MVar
import GHC.IO.Handle.Internals             -- withHandle', do_operation



-- | Does the command line argument take an value?
data ArgumentValueSpec  = ArgumentValue_none     -- ^ No value
                        | ArgumentValue_required -- ^ Value required
                        | ArgumentValue_optional -- ^ Value optional
   deriving (ArgumentValueSpec -> ArgumentValueSpec -> Bool
(ArgumentValueSpec -> ArgumentValueSpec -> Bool)
-> (ArgumentValueSpec -> ArgumentValueSpec -> Bool)
-> Eq ArgumentValueSpec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ArgumentValueSpec -> ArgumentValueSpec -> Bool
$c/= :: ArgumentValueSpec -> ArgumentValueSpec -> Bool
== :: ArgumentValueSpec -> ArgumentValueSpec -> Bool
$c== :: ArgumentValueSpec -> ArgumentValueSpec -> Bool
Eq, Int -> ArgumentValueSpec -> ShowS
[ArgumentValueSpec] -> ShowS
ArgumentValueSpec -> String
(Int -> ArgumentValueSpec -> ShowS)
-> (ArgumentValueSpec -> String)
-> ([ArgumentValueSpec] -> ShowS)
-> Show ArgumentValueSpec
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ArgumentValueSpec] -> ShowS
$cshowList :: [ArgumentValueSpec] -> ShowS
show :: ArgumentValueSpec -> String
$cshow :: ArgumentValueSpec -> String
showsPrec :: Int -> ArgumentValueSpec -> ShowS
$cshowsPrec :: Int -> ArgumentValueSpec -> ShowS
Show, Eq ArgumentValueSpec
Eq ArgumentValueSpec =>
(ArgumentValueSpec -> ArgumentValueSpec -> Ordering)
-> (ArgumentValueSpec -> ArgumentValueSpec -> Bool)
-> (ArgumentValueSpec -> ArgumentValueSpec -> Bool)
-> (ArgumentValueSpec -> ArgumentValueSpec -> Bool)
-> (ArgumentValueSpec -> ArgumentValueSpec -> Bool)
-> (ArgumentValueSpec -> ArgumentValueSpec -> ArgumentValueSpec)
-> (ArgumentValueSpec -> ArgumentValueSpec -> ArgumentValueSpec)
-> Ord ArgumentValueSpec
ArgumentValueSpec -> ArgumentValueSpec -> Bool
ArgumentValueSpec -> ArgumentValueSpec -> Ordering
ArgumentValueSpec -> ArgumentValueSpec -> ArgumentValueSpec
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ArgumentValueSpec -> ArgumentValueSpec -> ArgumentValueSpec
$cmin :: ArgumentValueSpec -> ArgumentValueSpec -> ArgumentValueSpec
max :: ArgumentValueSpec -> ArgumentValueSpec -> ArgumentValueSpec
$cmax :: ArgumentValueSpec -> ArgumentValueSpec -> ArgumentValueSpec
>= :: ArgumentValueSpec -> ArgumentValueSpec -> Bool
$c>= :: ArgumentValueSpec -> ArgumentValueSpec -> Bool
> :: ArgumentValueSpec -> ArgumentValueSpec -> Bool
$c> :: ArgumentValueSpec -> ArgumentValueSpec -> Bool
<= :: ArgumentValueSpec -> ArgumentValueSpec -> Bool
$c<= :: ArgumentValueSpec -> ArgumentValueSpec -> Bool
< :: ArgumentValueSpec -> ArgumentValueSpec -> Bool
$c< :: ArgumentValueSpec -> ArgumentValueSpec -> Bool
compare :: ArgumentValueSpec -> ArgumentValueSpec -> Ordering
$ccompare :: ArgumentValueSpec -> ArgumentValueSpec -> Ordering
$cp1Ord :: Eq ArgumentValueSpec
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.

data ArgumentDescription = ArgumentDescription {
        ArgumentDescription -> String
argdesc_short_args :: [Char],             -- ^ Short option names
        ArgumentDescription -> [String]
argdesc_long_args :: [String],            -- ^ Long option names
        ArgumentDescription -> ArgumentValueSpec
argdesc_argarg :: ArgumentValueSpec,      -- ^ What about a possible value of the argument?
        ArgumentDescription -> Maybe (Int, Int)
argdesc_times :: Maybe (Int,Int),         -- ^ Minimum and maximum of number of occurences allowed
        ArgumentDescription -> Maybe String
argdesc_argargname :: Maybe String,       -- ^ Name for argument's value, for message generation
        ArgumentDescription -> Maybe String
argdesc_description :: Maybe String,      -- ^ Descrition of the argument, for message generation
        ArgumentDescription -> Maybe Argtester
argdesc_argarg_tester :: Maybe Argtester  -- ^ Argument value tester
      }

-- excluding tester
ad_tup :: ArgumentDescription
-> (String, [String], ArgumentValueSpec, Maybe (Int, Int),
    Maybe String, Maybe String)
ad_tup ad :: ArgumentDescription
ad =
   (ArgumentDescription -> String
argdesc_short_args ArgumentDescription
ad, ArgumentDescription -> [String]
argdesc_long_args ArgumentDescription
ad, ArgumentDescription -> ArgumentValueSpec
argdesc_argarg ArgumentDescription
ad, ArgumentDescription -> Maybe (Int, Int)
argdesc_times ArgumentDescription
ad,
    ArgumentDescription -> Maybe String
argdesc_argargname ArgumentDescription
ad, ArgumentDescription -> Maybe String
argdesc_description ArgumentDescription
ad)

instance Eq ArgumentDescription where
   d :: ArgumentDescription
d == :: ArgumentDescription -> ArgumentDescription -> Bool
== e :: ArgumentDescription
e = ArgumentDescription
-> (String, [String], ArgumentValueSpec, Maybe (Int, Int),
    Maybe String, Maybe String)
ad_tup ArgumentDescription
d (String, [String], ArgumentValueSpec, Maybe (Int, Int),
 Maybe String, Maybe String)
-> (String, [String], ArgumentValueSpec, Maybe (Int, Int),
    Maybe String, Maybe String)
-> Bool
forall a. Eq a => a -> a -> Bool
== ArgumentDescription
-> (String, [String], ArgumentValueSpec, Maybe (Int, Int),
    Maybe String, Maybe String)
ad_tup ArgumentDescription
e

instance Ord ArgumentDescription where
   compare :: ArgumentDescription -> ArgumentDescription -> Ordering
compare d :: ArgumentDescription
d e :: ArgumentDescription
e = (String, [String], ArgumentValueSpec, Maybe (Int, Int),
 Maybe String, Maybe String)
-> (String, [String], ArgumentValueSpec, Maybe (Int, Int),
    Maybe String, Maybe String)
-> Ordering
forall a. Ord a => a -> a -> Ordering
compare (ArgumentDescription
-> (String, [String], ArgumentValueSpec, Maybe (Int, Int),
    Maybe String, Maybe String)
ad_tup ArgumentDescription
d) (ArgumentDescription
-> (String, [String], ArgumentValueSpec, Maybe (Int, Int),
    Maybe String, Maybe String)
ad_tup ArgumentDescription
e)

-- value for maximum number of times
unlimited :: Int
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 :: ArgumentDescription -> ArgumentDescription -> Bool
same_arg arg1 :: ArgumentDescription
arg1 arg2 :: ArgumentDescription
arg2 =
   case (ArgumentDescription -> String
argdesc_short_args ArgumentDescription
arg1, ArgumentDescription -> String
argdesc_short_args ArgumentDescription
arg2) of
      (a :: Char
a:_, b :: Char
b:_) -> Char
a Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
b
      ([], [])   -> case (ArgumentDescription -> [String]
argdesc_long_args ArgumentDescription
arg1, ArgumentDescription -> [String]
argdesc_long_args ArgumentDescription
arg2) of
                       ([],_)  -> Bool
forall a. a
unnamed
                       (_,[])  -> Bool
forall a. a
unnamed
                       (l1 :: [String]
l1,l2 :: [String]
l2) -> [String] -> String
forall a. [a] -> a
head [String]
l1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== [String] -> String
forall a. [a] -> a
head [String]
l2
      _          -> Bool
False
   where unnamed :: a
unnamed = String -> a
forall a. HasCallStack => String -> a
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
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
nulldesc =
   ArgumentDescription :: String
-> [String]
-> ArgumentValueSpec
-> Maybe (Int, Int)
-> Maybe String
-> Maybe String
-> Maybe Argtester
-> ArgumentDescription
ArgumentDescription {
      argdesc_short_args :: String
argdesc_short_args = [],
      argdesc_long_args :: [String]
argdesc_long_args = [],
      argdesc_argarg :: ArgumentValueSpec
argdesc_argarg = ArgumentValueSpec
ArgumentValue_none,
      argdesc_times :: Maybe (Int, Int)
argdesc_times = Maybe (Int, Int)
forall a. Maybe a
Nothing,          -- default = (0,1)
      argdesc_argargname :: Maybe String
argdesc_argargname = Maybe String
forall a. Maybe a
Nothing,
      argdesc_description :: Maybe String
argdesc_description = Maybe String
forall a. Maybe a
Nothing,
      argdesc_argarg_tester :: Maybe Argtester
argdesc_argarg_tester = Maybe Argtester
forall a. Maybe a
Nothing
   }

-- default number of times an argument may occur
times_default :: (Int, Int)
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 -> ArgumentDescription -> [Maybe String]
argvalues (Arguments (l :: [(ArgumentDescription, [Maybe String])]
l, header :: String
header)) desc :: ArgumentDescription
desc =
   [(ArgumentDescription, [Maybe String])] -> [Maybe String]
forall p. [(ArgumentDescription, p)] -> p
argvalues' [(ArgumentDescription, [Maybe String])]
l
   where
      argvalues' :: [(ArgumentDescription, p)] -> p
argvalues' ((d :: ArgumentDescription
d,v :: p
v):r :: [(ArgumentDescription, p)]
r) = if ArgumentDescription -> ArgumentDescription -> Bool
same_arg ArgumentDescription
desc ArgumentDescription
d then p
v else [(ArgumentDescription, p)] -> p
argvalues' [(ArgumentDescription, p)]
r
      argvalues' []        = String -> ArgumentDescription -> p
forall a. String -> ArgumentDescription -> a
abort "Bug using HsShellScript: Value of unknown argument queried \
                                   \(add it to getarg's list)" ArgumentDescription
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 'make_usage_info', 'print_usage_info', 'usage_info'.
data ArgError = ArgError {
      -- | Error message
      ArgError -> String
argerror_message :: String,
      -- | Deprecated. Usage information, as generated by the now deprecated function 'usage_info'.
      ArgError -> String
argerror_usageinfo :: String
   }
   deriving (Typeable)


argerror_ui :: String
            -> [ArgumentDescription]
            -> a
argerror_ui :: String -> [ArgumentDescription] -> a
argerror_ui mess :: String
mess descl :: [ArgumentDescription]
descl =
   ArgError -> a
forall a e. Exception e => e -> a
throw (String -> String -> ArgError
ArgError String
mess ([ArgumentDescription] -> String
make_usage_info1 [ArgumentDescription]
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 -> String
show argerror :: ArgError
argerror = ArgError -> String
argerror_message ArgError
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 :: ArgumentDescription -> Bool
is_direct desc :: ArgumentDescription
desc =
   ArgumentDescription -> String
argdesc_short_args ArgumentDescription
desc String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== [] Bool -> Bool -> Bool
&& ArgumentDescription -> [String]
argdesc_long_args ArgumentDescription
desc [String] -> [String] -> Bool
forall a. Eq a => a -> a -> Bool
== [""]


-- |
-- 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 :: Char -> ArgumentProperty
desc_short c :: Char
c = (ArgumentDescription -> ArgumentDescription) -> ArgumentProperty
ArgumentProperty
   (\desc :: ArgumentDescription
desc ->
      if (Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (ArgumentDescription -> String
argdesc_short_args ArgumentDescription
desc))
         then String -> ArgumentDescription -> ArgumentDescription
forall a. String -> ArgumentDescription -> a
abort ("Bug in HsShellScript argument description: Duplicate short argument " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char -> String
forall a. Show a => a -> String
show Char
c String -> ShowS
forall a. [a] -> [a] -> [a]
++ " specified") ArgumentDescription
desc
         else if ("" String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ArgumentDescription -> [String]
argdesc_long_args ArgumentDescription
desc)
                 then String -> ArgumentDescription -> ArgumentDescription
forall a. String -> ArgumentDescription -> a
abort_conflict "" ArgumentDescription
desc
                 else ArgumentDescription
desc { argdesc_short_args :: String
argdesc_short_args = Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: ArgumentDescription -> String
argdesc_short_args ArgumentDescription
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 :: String -> ArgumentProperty
desc_long str :: String
str = (ArgumentDescription -> ArgumentDescription) -> ArgumentProperty
ArgumentProperty
   (\desc :: ArgumentDescription
desc ->
      if (String
str String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (ArgumentDescription -> [String]
argdesc_long_args ArgumentDescription
desc))
         then String -> ArgumentDescription -> ArgumentDescription
forall a. String -> ArgumentDescription -> a
abort ("Bug in HsShellScript argument description: Duplicate long argument " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
str String -> ShowS
forall a. [a] -> [a] -> [a]
++ " specified") ArgumentDescription
desc
         else if ("" String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ArgumentDescription -> [String]
argdesc_long_args ArgumentDescription
desc)
                 then String -> ArgumentDescription -> ArgumentDescription
forall a. String -> ArgumentDescription -> a
abort_conflict "" ArgumentDescription
desc
                 else ArgumentDescription
desc { argdesc_long_args :: [String]
argdesc_long_args = String
str String -> [String] -> [String]
forall a. a -> [a] -> [a]
: ArgumentDescription -> [String]
argdesc_long_args ArgumentDescription
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_direct = (ArgumentDescription -> ArgumentDescription) -> ArgumentProperty
ArgumentProperty
   (\desc :: ArgumentDescription
desc ->
      if ArgumentDescription -> [String]
argdesc_long_args ArgumentDescription
desc [String] -> [String] -> Bool
forall a. Eq a => a -> a -> Bool
== [] Bool -> Bool -> Bool
&& ArgumentDescription -> String
argdesc_short_args ArgumentDescription
desc String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== [] Bool -> Bool -> Bool
&& ArgumentDescription -> ArgumentValueSpec
argdesc_argarg ArgumentDescription
desc ArgumentValueSpec -> ArgumentValueSpec -> Bool
forall a. Eq a => a -> a -> Bool
== ArgumentValueSpec
ArgumentValue_none
         then ArgumentDescription
desc { argdesc_long_args :: [String]
argdesc_long_args = [""]
                   , argdesc_argarg :: ArgumentValueSpec
argdesc_argarg = ArgumentValueSpec
ArgumentValue_required
                   , argdesc_argargname :: Maybe String
argdesc_argargname = String -> Maybe String
forall a. a -> Maybe a
Just ""
                   }
         else String -> ArgumentDescription -> ArgumentDescription
forall a. String -> ArgumentDescription -> a
abort_conflict "desc_direct conflicts with desc_long, desc_short, desc_value_required \
                             \and desc_value_optional." ArgumentDescription
desc
   )

-- |
-- Signal that the argument requires a value.
desc_value_required :: ArgumentProperty
desc_value_required :: ArgumentProperty
desc_value_required = (ArgumentDescription -> ArgumentDescription) -> ArgumentProperty
ArgumentProperty
   (\desc :: ArgumentDescription
desc ->
      if ArgumentDescription -> ArgumentValueSpec
argdesc_argarg ArgumentDescription
desc ArgumentValueSpec -> ArgumentValueSpec -> Bool
forall a. Eq a => a -> a -> Bool
== ArgumentValueSpec
ArgumentValue_none
         then ArgumentDescription
desc { argdesc_argarg :: ArgumentValueSpec
argdesc_argarg = ArgumentValueSpec
ArgumentValue_required }
         else String -> ArgumentDescription -> ArgumentDescription
forall a. String -> ArgumentDescription -> a
abort_conflict "desc_value_required repeated or conflicting desc_value_optional" ArgumentDescription
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_value_optional = (ArgumentDescription -> ArgumentDescription) -> ArgumentProperty
ArgumentProperty
   (\desc :: ArgumentDescription
desc ->
      if ArgumentDescription -> ArgumentValueSpec
argdesc_argarg ArgumentDescription
desc ArgumentValueSpec -> ArgumentValueSpec -> Bool
forall a. Eq a => a -> a -> Bool
== ArgumentValueSpec
ArgumentValue_none
         then ArgumentDescription
desc { argdesc_argarg :: ArgumentValueSpec
argdesc_argarg = ArgumentValueSpec
ArgumentValue_optional }
         else String -> ArgumentDescription -> ArgumentDescription
forall a. String -> ArgumentDescription -> a
abort_conflict "desc_value_optional repeated or conflicting desc_value_required" ArgumentDescription
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 :: Int -> Int -> ArgumentProperty
desc_times n :: Int
n m :: Int
m = (ArgumentDescription -> ArgumentDescription) -> ArgumentProperty
ArgumentProperty
   (\desc :: ArgumentDescription
desc ->
       if ArgumentDescription -> Maybe (Int, Int)
argdesc_times ArgumentDescription
desc Maybe (Int, Int) -> Maybe (Int, Int) -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe (Int, Int)
forall a. Maybe a
Nothing
          then ArgumentDescription
desc { argdesc_times :: Maybe (Int, Int)
argdesc_times = (Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just (Int
n,Int
m) }
          else String -> ArgumentDescription -> ArgumentDescription
forall a. String -> ArgumentDescription -> a
abort_conflict "desc_times conflicting previous number of occurences specification" ArgumentDescription
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 :: ArgumentProperty
desc_once = Int -> Int -> ArgumentProperty
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 :: ArgumentProperty
desc_at_least_once = Int -> Int -> ArgumentProperty
desc_times 1 Int
unlimited

-- |
-- Signal that the argument must occur at most one time.
desc_at_most_once :: ArgumentProperty -- ^ The corresponding argument property.
desc_at_most_once :: ArgumentProperty
desc_at_most_once  = Int -> Int -> ArgumentProperty
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 :: Int -> ArgumentProperty
desc_at_least n :: Int
n = Int -> Int -> ArgumentProperty
desc_times Int
n Int
unlimited

-- |
-- Signal that the argument may occur any number of times.
desc_any_times :: ArgumentProperty -- ^ The corresponding argument property.
desc_any_times :: ArgumentProperty
desc_any_times  = Int -> Int -> ArgumentProperty
desc_times 0 Int
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 :: Int -> ArgumentProperty
desc_at_most n :: Int
n = Int -> Int -> ArgumentProperty
desc_times 0 Int
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 :: String -> ArgumentProperty
desc_argname name :: String
name = (ArgumentDescription -> ArgumentDescription) -> ArgumentProperty
ArgumentProperty
   (\desc :: ArgumentDescription
desc ->
      if ArgumentDescription -> Maybe String
argdesc_argargname ArgumentDescription
desc Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe String
forall a. Maybe a
Nothing
         then ArgumentDescription
desc { argdesc_argargname :: Maybe String
argdesc_argargname = String -> Maybe String
forall a. a -> Maybe a
Just String
name }
         else String -> ArgumentDescription -> ArgumentDescription
forall a. String -> ArgumentDescription -> a
abort "Bug in HsShellScript argument description: Multiple names specified" ArgumentDescription
desc
   )

-- |
-- Specify a description of what the argument does. Used for usage message
-- generation. This can be arbitratily long, long lines are wrapped.
desc_description :: String                      -- ^ Short description of the argument.
                 -> ArgumentProperty            -- ^ The corresponding argument property.
desc_description :: String -> ArgumentProperty
desc_description expl :: String
expl = (ArgumentDescription -> ArgumentDescription) -> ArgumentProperty
ArgumentProperty
   (\desc :: ArgumentDescription
desc ->
      if ArgumentDescription -> Maybe String
argdesc_description ArgumentDescription
desc Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe String
forall a. Maybe a
Nothing
         then ArgumentDescription
desc { argdesc_description :: Maybe String
argdesc_description = String -> Maybe String
forall a. a -> Maybe a
Just String
expl }
         else String -> ArgumentDescription -> ArgumentDescription
forall a. String -> ArgumentDescription -> a
abort "Bug in HsShellScript argument description: Multiple argument descriptions specified" ArgumentDescription
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 :: Argtester -> ArgumentProperty
desc_tester t :: Argtester
t = (ArgumentDescription -> ArgumentDescription) -> ArgumentProperty
ArgumentProperty
   (\desc :: ArgumentDescription
desc ->
      case ArgumentDescription -> Maybe Argtester
argdesc_argarg_tester ArgumentDescription
desc of
         Nothing -> ArgumentDescription
desc { argdesc_argarg_tester :: Maybe Argtester
argdesc_argarg_tester = Argtester -> Maybe Argtester
forall a. a -> Maybe a
Just Argtester
t }
         Just _  -> String -> ArgumentDescription -> ArgumentDescription
forall a. String -> ArgumentDescription -> a
abort "Bug in HsShellScript argument description: Multiple argument value testers specified"
                          ArgumentDescription
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 :: ReadS a -> String -> Argtester
readtester reader :: ReadS a
reader msg :: String
msg val :: String
val =
   case ((a, String) -> Bool) -> [(a, String)] -> [(a, String)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "") (String -> Bool) -> ((a, String) -> String) -> (a, String) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, String) -> String
forall a b. (a, b) -> b
snd) ([(a, String)] -> [(a, String)]) -> [(a, String)] -> [(a, String)]
forall a b. (a -> b) -> a -> b
$ ReadS a
reader String
val of
      [(_,"")] -> Maybe (ArgumentDescription -> String)
forall a. Maybe a
Nothing
      []       -> (ArgumentDescription -> String)
-> Maybe (ArgumentDescription -> String)
forall a. a -> Maybe a
Just (\arg :: ArgumentDescription
arg -> "Format error in the value of the " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ArgumentDescription -> String
argname_a ArgumentDescription
arg String -> ShowS
forall a. [a] -> [a] -> [a]
++ ". " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg String -> ShowS
forall a. [a] -> [a] -> [a]
++
                                "\nValue: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
quote String
val)
      _        -> (ArgumentDescription -> String)
-> Maybe (ArgumentDescription -> String)
forall a. a -> Maybe a
Just (\arg :: ArgumentDescription
arg -> "Ambigious value of the " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ArgumentDescription -> String
argname_a ArgumentDescription
arg String -> ShowS
forall a. [a] -> [a] -> [a]
++ ". " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg String -> ShowS
forall a. [a] -> [a] -> [a]
++ "\nValue: " String -> ShowS
forall a. [a] -> [a] -> [a]
++
                                ShowS
quote String
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 :: ArgumentProperty
desc_integer = Argtester -> ArgumentProperty
desc_tester (ReadS Int -> String -> Argtester
forall a. ReadS a -> String -> Argtester
readtester (ReadS Int
forall a. Read a => ReadS a
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 :: ArgumentProperty
desc_nonneg_integer = Argtester -> ArgumentProperty
desc_tester (ReadS Int -> String -> Argtester
forall a. ReadS a -> String -> Argtester
readtester ((((Int, String) -> Bool) -> [(Int, String)] -> [(Int, String)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(a :: Int
a,_) -> Int
a Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 0) ([(Int, String)] -> [(Int, String)]) -> ReadS Int -> ReadS Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReadS Int
forall a. Read a => ReadS a
reads) :: ReadS Int)
                                   "Non-negative integer expected." )


abort_conflict :: String -> ArgumentDescription -> a
abort_conflict msg :: String
msg = String -> ArgumentDescription -> a
forall a. String -> ArgumentDescription -> a
abort ("Conflicting properties in argument description. " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg)
abort :: String -> ArgumentDescription -> a
abort msg :: String
msg desc :: ArgumentDescription
desc = String -> a
forall a. HasCallStack => String -> a
error (String
msg String -> ShowS
forall a. [a] -> [a] -> [a]
++ "\nargument (so far): " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ArgumentDescription -> String
argname ArgumentDescription
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 :: ArgumentDescription -> String
argname desc :: ArgumentDescription
desc =
   if (ArgumentDescription -> String
argdesc_short_args ArgumentDescription
desc, ArgumentDescription -> [String]
argdesc_long_args ArgumentDescription
desc) (String, [String]) -> (String, [String]) -> Bool
forall a. Eq a => a -> a -> Bool
== ([],[""]) then "(direct argument)"
      else if (ArgumentDescription -> String
argdesc_short_args ArgumentDescription
desc, ArgumentDescription -> [String]
argdesc_long_args ArgumentDescription
desc) (String, [String]) -> (String, [String]) -> Bool
forall a. Eq a => a -> a -> Bool
== ([],[]) then "yet unnamed argument"
         else [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse "/" ( (Char -> String) -> String -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\s :: Char
s -> "-"String -> ShowS
forall a. [a] -> [a] -> [a]
++[Char
s]) (ArgumentDescription -> String
argdesc_short_args ArgumentDescription
desc) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
                                        ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ("--" String -> ShowS
forall a. [a] -> [a] -> [a]
++) (ArgumentDescription -> [String]
argdesc_long_args ArgumentDescription
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 :: ArgumentDescription -> String
argname_a desc :: ArgumentDescription
desc =
   if (ArgumentDescription -> String
argdesc_short_args ArgumentDescription
desc, ArgumentDescription -> [String]
argdesc_long_args ArgumentDescription
desc) (String, [String]) -> (String, [String]) -> Bool
forall a. Eq a => a -> a -> Bool
== ([],[""]) then "direct argument"
      else if (ArgumentDescription -> String
argdesc_short_args ArgumentDescription
desc, ArgumentDescription -> [String]
argdesc_long_args ArgumentDescription
desc) (String, [String]) -> (String, [String]) -> Bool
forall a. Eq a => a -> a -> Bool
== ([],[]) then "yet unnamed argument"
         else "argument " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse "/" ( (Char -> String) -> String -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\s :: Char
s -> "-"String -> ShowS
forall a. [a] -> [a] -> [a]
++[Char
s]) (ArgumentDescription -> String
argdesc_short_args ArgumentDescription
desc) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ("--" String -> ShowS
forall a. [a] -> [a] -> [a]
++) (ArgumentDescription -> [String]
argdesc_long_args ArgumentDescription
desc) ))



{- | Create a string, which lists the short forms of one command line argument. If
it has an subargument, it's name is listed as well. For arguments without short
form, the result is the empty string.

For the illegal command line argument, with neither short nor long forms, and
not being the direct argument either, the result is @"yet unnamed argument"@.
Such argument descriptions are incomplete, and will be rejected by @getargs@ and
@unsafe_getargs@.

This is meant for refering to an argument, such as in error messages or usage
information.

Examples:

>argname_short (argdesc [ desc_short 'a'
>                       , desc_short 'b'
>                       , desc_value_required
>                       , desc_argname "Name"
>                       ])
>  == "-a/-b Name"

See 'argdesc', 'desc_direct'. 'argname_long'.
-}
argname_short :: ArgumentDescription  -- ^ Argument description, as returned by @argdesc@
              -> String               -- ^ Printable name for the argument
argname_short :: ArgumentDescription -> String
argname_short desc :: ArgumentDescription
desc =
   if (ArgumentDescription -> String
argdesc_short_args ArgumentDescription
desc, ArgumentDescription -> [String]
argdesc_long_args ArgumentDescription
desc) (String, [String]) -> (String, [String]) -> Bool
forall a. Eq a => a -> a -> Bool
== ([],[""])
   then ""
   else if (ArgumentDescription -> String
argdesc_short_args ArgumentDescription
desc, ArgumentDescription -> [String]
argdesc_long_args ArgumentDescription
desc) (String, [String]) -> (String, [String]) -> Bool
forall a. Eq a => a -> a -> Bool
== ([],[])
        then "yet unnamed argument"
        else
           case (ArgumentDescription -> String
argdesc_short_args ArgumentDescription
desc, ArgumentDescription -> Maybe String
argdesc_argargname ArgumentDescription
desc) of
              ([], _)         -> ""
              (sl :: String
sl, Just name :: String
name) -> [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse "/" ((Char -> String) -> String -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\s :: Char
s -> "-" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
s]) String
sl)) String -> ShowS
forall a. [a] -> [a] -> [a]
++ " " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name
              (sl :: String
sl, Nothing)   -> [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse "/" ((Char -> String) -> String -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\s :: Char
s -> "-" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
s]) String
sl))



{- | Create a string, which lists the long forms of one command line argument. If
it has an subargument, it's name is listed as well. For arguments without long
form, the result is the empty string.

For the illegal command line argument, with neither short nor long forms, and
not being the direct argument either, the result is @"yet unnamed argument"@.
Such argument descriptions are incomplete, and will be rejected by @getargs@ and
@unsafe_getargs@.

This is meant for refering to an argument, such as in error messages or usage
information.

Examples:

>argname_long (argdesc [ desc_long "foo"
>                      , desc_long "bar"
>                      , desc_value_required
>                      , desc_argname "Name"
>                      ])
>  == "--foo/--bar Name"

See 'argdesc', 'desc_direct'. 'argname_long'.
-}
argname_long :: ArgumentDescription  -- ^ Argument description, as returned by @argdesc@
             -> String               -- ^ Printable name for the argument
argname_long :: ArgumentDescription -> String
argname_long desc :: ArgumentDescription
desc =
   if (ArgumentDescription -> String
argdesc_short_args ArgumentDescription
desc, ArgumentDescription -> [String]
argdesc_long_args ArgumentDescription
desc) (String, [String]) -> (String, [String]) -> Bool
forall a. Eq a => a -> a -> Bool
== ([],[""])
   then ""
   else if (ArgumentDescription -> String
argdesc_short_args ArgumentDescription
desc, ArgumentDescription -> [String]
argdesc_long_args ArgumentDescription
desc) (String, [String]) -> (String, [String]) -> Bool
forall a. Eq a => a -> a -> Bool
== ([],[])
        then "yet unnamed argument"
        else
           case (ArgumentDescription -> [String]
argdesc_long_args ArgumentDescription
desc, ArgumentDescription -> Maybe String
argdesc_argargname ArgumentDescription
desc) of
              ([], _)         -> ""
              (sl :: [String]
sl, Just name :: String
name) -> [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse "/" (ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\s :: String
s -> "--" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s) [String]
sl)) String -> ShowS
forall a. [a] -> [a] -> [a]
++ " " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name
              (sl :: [String]
sl, Nothing)   -> [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse "/" (ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\s :: String
s -> "--" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s) [String]
sl))



up1 :: ShowS
up1 "" = ""
up1 (x :: Char
x:xs :: String
xs) = Char -> Char
toUpper Char
x Char -> ShowS
forall a. a -> [a] -> [a]
: String
xs

-- complete generation of argument description
prop_final :: ArgumentProperty
prop_final :: ArgumentProperty
prop_final = (ArgumentDescription -> ArgumentDescription) -> ArgumentProperty
ArgumentProperty
   (\desc :: ArgumentDescription
desc ->
      () -> ArgumentDescription -> ArgumentDescription
forall a b. a -> b -> b
seq (if ArgumentDescription -> ArgumentValueSpec
argdesc_argarg ArgumentDescription
desc ArgumentValueSpec -> ArgumentValueSpec -> Bool
forall a. Eq a => a -> a -> Bool
/= ArgumentValueSpec
ArgumentValue_none Bool -> Bool -> Bool
&& ArgumentDescription -> Maybe String
argdesc_argargname ArgumentDescription
desc Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe String
forall a. Maybe a
Nothing
              then String -> ()
forall a. HasCallStack => String -> a
error (String -> ()) -> String -> ()
forall a b. (a -> b) -> a -> b
$ "Bug in description of " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ArgumentDescription -> String
argname_a ArgumentDescription
desc String -> ShowS
forall a. [a] -> [a] -> [a]
++ ": Argument's value must be given a name using desc_argname."
              else if ArgumentDescription -> ArgumentValueSpec
argdesc_argarg ArgumentDescription
desc ArgumentValueSpec -> ArgumentValueSpec -> Bool
forall a. Eq a => a -> a -> Bool
== ArgumentValueSpec
ArgumentValue_none Bool -> Bool -> Bool
&& ArgumentDescription -> Maybe String
argdesc_argargname ArgumentDescription
desc Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe String
forall a. Maybe a
Nothing
                      then String -> ()
forall a. HasCallStack => String -> a
error (String -> ()) -> String -> ()
forall a b. (a -> b) -> a -> b
$ "Bug in description of " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ArgumentDescription -> String
argname_a ArgumentDescription
desc
                           String -> ShowS
forall a. [a] -> [a] -> [a]
++ ": Argument doesn't take a sub argument, but a name for it is specified."
                      else ()
          ) (ArgumentDescription -> ArgumentDescription)
-> ArgumentDescription -> ArgumentDescription
forall a b. (a -> b) -> a -> b
$
          ArgumentDescription
desc { argdesc_times :: Maybe (Int, Int)
argdesc_times = (Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just ((Int, Int) -> Maybe (Int, Int) -> (Int, Int)
forall a. a -> Maybe a -> a
fromMaybe (Int, Int)
times_default (ArgumentDescription -> Maybe (Int, Int)
argdesc_times ArgumentDescription
desc))
               , argdesc_description :: Maybe String
argdesc_description = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe "" (ArgumentDescription -> Maybe String
argdesc_description ArgumentDescription
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 :: [ArgumentProperty] -> ArgumentDescription
argdesc propl :: [ArgumentProperty]
propl =
   ((ArgumentDescription -> ArgumentDescription)
 -> (ArgumentDescription -> ArgumentDescription)
 -> ArgumentDescription
 -> ArgumentDescription)
-> (ArgumentDescription -> ArgumentDescription)
-> [ArgumentDescription -> ArgumentDescription]
-> ArgumentDescription
-> ArgumentDescription
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (ArgumentDescription -> ArgumentDescription)
-> (ArgumentDescription -> ArgumentDescription)
-> ArgumentDescription
-> ArgumentDescription
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) ArgumentDescription -> ArgumentDescription
forall a. a -> a
id ((ArgumentProperty -> ArgumentDescription -> ArgumentDescription)
-> [ArgumentProperty]
-> [ArgumentDescription -> ArgumentDescription]
forall a b. (a -> b) -> [a] -> [b]
map ArgumentProperty -> ArgumentDescription -> ArgumentDescription
argumentproperty (ArgumentProperty
prop_finalArgumentProperty -> [ArgumentProperty] -> [ArgumentProperty]
forall a. a -> [a] -> [a]
:[ArgumentProperty]
propl)) ArgumentDescription
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 :: String
-> ArgOrder ArgOcc
-> [String]
-> [ArgumentDescription]
-> Either ArgError Arguments
getargs0 header :: String
header ordering :: ArgOrder ArgOcc
ordering cmdlargs :: [String]
cmdlargs descs :: [ArgumentDescription]
descs =
   let (  descs_direct :: [ArgumentDescription]
descs_direct     -- direct arguments (without argument name)
        , descs_regular :: [ArgumentDescription]
descs_regular    -- regular arguments (with long or short argument name)
        ) = (ArgumentDescription -> Bool)
-> [ArgumentDescription]
-> ([ArgumentDescription], [ArgumentDescription])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ArgumentDescription -> Bool
is_direct [ArgumentDescription]
descs

       nonunique :: Eq a => [a] -> Maybe a
       nonunique :: [a] -> Maybe a
nonunique (a :: a
a:b :: a
b:r :: [a]
r) = if (a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b) then (a -> Maybe a
forall a. a -> Maybe a
Just a
a) else [a] -> Maybe a
forall a. Eq a => [a] -> Maybe a
nonunique (a
ba -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
r)
       nonunique _       = Maybe a
forall a. Maybe a
Nothing

       test_unique :: (Show a, Ord a) => (ArgumentDescription -> [a]) -> String -> b -> b
       test_unique :: (ArgumentDescription -> [a]) -> String -> b -> b
test_unique extr :: ArgumentDescription -> [a]
extr what :: String
what x :: b
x =
           case [a] -> Maybe a
forall a. Eq a => [a] -> Maybe a
nonunique ([a] -> [a]
forall a. Ord a => [a] -> [a]
sort ([[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ((ArgumentDescription -> [a]) -> [ArgumentDescription] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map ArgumentDescription -> [a]
extr [ArgumentDescription]
descs))) of
              Just y :: a
y -> String -> b
forall a. HasCallStack => String -> a
error ("Bug: Several occurences of " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
what String -> ShowS
forall a. [a] -> [a] -> [a]
++ " " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
y String -> ShowS
forall a. [a] -> [a] -> [a]
++
                               " in command line argument specifications")
              Nothing -> b
x

       optdescr :: [OptDescr ArgOcc]
optdescr = (ArgumentDescription -> OptDescr ArgOcc)
-> [ArgumentDescription] -> [OptDescr ArgOcc]
forall a b. (a -> b) -> [a] -> [b]
map ArgumentDescription -> OptDescr ArgOcc
make_optdescr [ArgumentDescription]
descs_regular

       make_optdescr :: ArgumentDescription -> OptDescr ArgOcc
       make_optdescr :: ArgumentDescription -> OptDescr ArgOcc
make_optdescr desc :: ArgumentDescription
desc =
          String -> [String] -> ArgDescr ArgOcc -> String -> OptDescr ArgOcc
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option (ArgumentDescription -> String
argdesc_short_args ArgumentDescription
desc)
                 (ArgumentDescription -> [String]
argdesc_long_args ArgumentDescription
desc)
                 (case ArgumentDescription -> ArgumentValueSpec
argdesc_argarg ArgumentDescription
desc of
                     ArgumentValue_none      -> ArgOcc -> ArgDescr ArgOcc
forall a. a -> ArgDescr a
NoArg  (ArgumentDescription
desc, Maybe String
forall a. Maybe a
Nothing)
                     ArgumentValue_required     -> (String -> ArgOcc) -> String -> ArgDescr ArgOcc
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\arg :: String
arg -> (ArgumentDescription
desc, String -> Maybe String
forall a. a -> Maybe a
Just String
arg))
                                              (Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (ArgumentDescription -> Maybe String
argdesc_argargname ArgumentDescription
desc))
                     ArgumentValue_optional     -> (Maybe String -> ArgOcc) -> String -> ArgDescr ArgOcc
forall a. (Maybe String -> a) -> String -> ArgDescr a
OptArg (\arg :: Maybe String
arg -> (ArgumentDescription
desc, Maybe String
arg))
                                              (Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (ArgumentDescription -> Maybe String
argdesc_argargname ArgumentDescription
desc))
                 )
                 (Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (ArgumentDescription -> Maybe String
argdesc_description ArgumentDescription
desc))

       -- Postprocessing after successful call to getOpt
       getopt_post :: [ArgOcc] -> [String] -> Either ArgError Arguments
       getopt_post :: [ArgOcc] -> [String] -> Either ArgError Arguments
getopt_post pars :: [ArgOcc]
pars{-getOpt recognized arguments-} rest :: [String]
rest{-direct arguments-} =
          case ([String]
rest, [ArgumentDescription]
descs_direct) of
             ([],[])  ->
                -- no direct arguments allowed and none provided
                [ArgOcc] -> Either ArgError Arguments
getopt_post' [ArgOcc]
pars
             (r :: [String]
r, [d :: ArgumentDescription
d]) ->
                -- direct arguments allowed and expected
                [ArgOcc] -> Either ArgError Arguments
getopt_post' ([ArgOcc]
pars [ArgOcc] -> [ArgOcc] -> [ArgOcc]
forall a. [a] -> [a] -> [a]
++ [ArgumentDescription] -> [Maybe String] -> [ArgOcc]
forall a b. [a] -> [b] -> [(a, b)]
zip (ArgumentDescription -> [ArgumentDescription]
forall a. a -> [a]
repeat ArgumentDescription
d) ((String -> Maybe String) -> [String] -> [Maybe String]
forall a b. (a -> b) -> [a] -> [b]
map String -> Maybe String
forall a. a -> Maybe a
Just [String]
r))
             ((x :: String
x:xs :: [String]
xs), []) ->
                -- direct arguments provided, but not allowed
                ArgError -> Either ArgError Arguments
forall a b. a -> Either a b
Left (String -> String -> ArgError
ArgError "Surplus arguments."
                               ([ArgumentDescription] -> String
make_usage_info1 [ArgumentDescription]
descs)
                     )
             _ ->
                -- several descriptions for direct arguments
                String -> Either ArgError Arguments
forall a. HasCallStack => String -> a
error "Bug in argument descriptions: Several descriptions for direct arguments \
                      \(desc_direct) specified."

       add :: (ArgumentDescription, Maybe String)
           -> [(ArgumentDescription, [Maybe String])]
           -> [(ArgumentDescription, [Maybe String])]
       add :: ArgOcc
-> [(ArgumentDescription, [Maybe String])]
-> [(ArgumentDescription, [Maybe String])]
add (a :: ArgumentDescription
a,str :: Maybe String
str) []        = [(ArgumentDescription
a,[Maybe String
str])]
       add (b :: ArgumentDescription
b,str :: Maybe String
str) ((a :: ArgumentDescription
a,l :: [Maybe String]
l):r :: [(ArgumentDescription, [Maybe String])]
r) =
          if ArgumentDescription -> ArgumentDescription -> Bool
same_arg ArgumentDescription
a ArgumentDescription
b then (ArgumentDescription
a,Maybe String
strMaybe String -> [Maybe String] -> [Maybe String]
forall a. a -> [a] -> [a]
:[Maybe String]
l) (ArgumentDescription, [Maybe String])
-> [(ArgumentDescription, [Maybe String])]
-> [(ArgumentDescription, [Maybe String])]
forall a. a -> [a] -> [a]
: [(ArgumentDescription, [Maybe String])]
r
                          else (ArgumentDescription
a,[Maybe String]
l) (ArgumentDescription, [Maybe String])
-> [(ArgumentDescription, [Maybe String])]
-> [(ArgumentDescription, [Maybe String])]
forall a. a -> [a] -> [a]
: ArgOcc
-> [(ArgumentDescription, [Maybe String])]
-> [(ArgumentDescription, [Maybe String])]
add (ArgumentDescription
b,Maybe String
str) [(ArgumentDescription, [Maybe String])]
r

       getopt_post' :: [ArgOcc] -> Either ArgError Arguments
       getopt_post' :: [ArgOcc] -> Either ArgError Arguments
getopt_post' pars :: [ArgOcc]
pars{-all arguments-} =
          let pars' :: [(ArgumentDescription, [Maybe String])]
pars' = (ArgOcc
 -> [(ArgumentDescription, [Maybe String])]
 -> [(ArgumentDescription, [Maybe String])])
-> [(ArgumentDescription, [Maybe String])]
-> [ArgOcc]
-> [(ArgumentDescription, [Maybe String])]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ArgOcc
-> [(ArgumentDescription, [Maybe String])]
-> [(ArgumentDescription, [Maybe String])]
add ((ArgumentDescription -> (ArgumentDescription, [Maybe String]))
-> [ArgumentDescription] -> [(ArgumentDescription, [Maybe String])]
forall a b. (a -> b) -> [a] -> [b]
map (\d :: ArgumentDescription
d -> (ArgumentDescription
d,[])) [ArgumentDescription]
descs) [ArgOcc]
pars

              -- Check the number of argument occurences
              check_num :: [(ArgumentDescription, [Maybe String])] -> Maybe ArgError
              check_num :: [(ArgumentDescription, [Maybe String])] -> Maybe ArgError
check_num [] = Maybe ArgError
forall a. Maybe a
Nothing
              check_num ((desc :: ArgumentDescription
desc,args :: [Maybe String]
args):rest :: [(ArgumentDescription, [Maybe String])]
rest) =
                 let (min :: Int
min,max :: Int
max) = Maybe (Int, Int) -> (Int, Int)
forall a. HasCallStack => Maybe a -> a
fromJust (ArgumentDescription -> Maybe (Int, Int)
argdesc_times ArgumentDescription
desc)
                     number :: Int
number    = [Maybe String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Maybe String]
args
                     wrong_number_msg :: String
wrong_number_msg =
                        (if ArgumentDescription -> Bool
is_direct ArgumentDescription
desc then (String, String) -> String
forall a b. (a, b) -> a
fst else (String, String) -> String
forall a b. (a, b) -> b
snd) ((String, String) -> String) -> (String, String) -> String
forall a b. (a -> b) -> a -> b
$
                        if Int
number Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 Bool -> Bool -> Bool
&& Int
min Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 then
                           ( "Missing argument."
                           , "Missing " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ArgumentDescription -> String
argname_a ArgumentDescription
desc String -> ShowS
forall a. [a] -> [a] -> [a]
++ "."
                           )
                        else if Int
number Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
min then
                           ( "Too few arguments. " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
min String -> ShowS
forall a. [a] -> [a] -> [a]
++ " required."
                           , "Too few instances of " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ArgumentDescription -> String
argname_a ArgumentDescription
desc String -> ShowS
forall a. [a] -> [a] -> [a]
++ ". "String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
min String -> ShowS
forall a. [a] -> [a] -> [a]
++ " required."
                           )
                        else if Int
number Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
max Bool -> Bool -> Bool
&& Int
max Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 then
                           ( "Only one argument may be specified."
                           , "Repeated " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ArgumentDescription -> String
argname_a ArgumentDescription
desc String -> ShowS
forall a. [a] -> [a] -> [a]
++ "."
                           )
                        else if Int
number Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
max Bool -> Bool -> Bool
&& Int
max Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
unlimited then
                           ( "Too many arguments."
                           , "Too many instances of " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ArgumentDescription -> String
argname_a ArgumentDescription
desc String -> ShowS
forall a. [a] -> [a] -> [a]
++ "."
                           )
                        else String -> (String, String)
forall a. HasCallStack => String -> a
error "bug in HsShellScript.Args.hs"
                 in  if Int
number Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
min Bool -> Bool -> Bool
&& (Int
number Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
max Bool -> Bool -> Bool
|| Int
max Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
unlimited)
                        then [(ArgumentDescription, [Maybe String])] -> Maybe ArgError
check_num [(ArgumentDescription, [Maybe String])]
rest
                        else ArgError -> Maybe ArgError
forall a. a -> Maybe a
Just (String -> String -> ArgError
ArgError String
wrong_number_msg ([ArgumentDescription] -> String
make_usage_info1 [ArgumentDescription]
descs))

              -- Apply any argument testers
              check_testers :: [(ArgumentDescription, [Maybe String])] -> Maybe ArgError
              check_testers :: [(ArgumentDescription, [Maybe String])] -> Maybe ArgError
check_testers [] = Maybe ArgError
forall a. Maybe a
Nothing
              check_testers ((desc :: ArgumentDescription
desc,args :: [Maybe String]
args):rest :: [(ArgumentDescription, [Maybe String])]
rest) =
                 case ArgumentDescription -> Maybe Argtester
argdesc_argarg_tester ArgumentDescription
desc of
                    Just argdesc_argarg_tester :: Argtester
argdesc_argarg_tester ->
                       if ArgumentDescription -> ArgumentValueSpec
argdesc_argarg ArgumentDescription
desc ArgumentValueSpec -> ArgumentValueSpec -> Bool
forall a. Eq a => a -> a -> Bool
== ArgumentValueSpec
ArgumentValue_none
                          then String -> ArgumentDescription -> Maybe ArgError
forall a. String -> ArgumentDescription -> a
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."
                                     ArgumentDescription
desc
                          else case (Maybe (ArgumentDescription -> String) -> Bool)
-> [Maybe (ArgumentDescription -> String)]
-> [Maybe (ArgumentDescription -> String)]
forall a. (a -> Bool) -> [a] -> [a]
filter Maybe (ArgumentDescription -> String) -> Bool
forall a. Maybe a -> Bool
isJust ((Maybe String -> Maybe (ArgumentDescription -> String))
-> [Maybe String] -> [Maybe (ArgumentDescription -> String)]
forall a b. (a -> b) -> [a] -> [b]
map (Argtester
argdesc_argarg_tester Argtester
-> (Maybe String -> String)
-> Maybe String
-> Maybe (ArgumentDescription -> String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust) ((Maybe String -> Bool) -> [Maybe String] -> [Maybe String]
forall a. (a -> Bool) -> [a] -> [a]
filter Maybe String -> Bool
forall a. Maybe a -> Bool
isJust [Maybe String]
args)) of
                                  []              -> [(ArgumentDescription, [Maybe String])] -> Maybe ArgError
check_testers [(ArgumentDescription, [Maybe String])]
rest
                                  (Just msgf :: ArgumentDescription -> String
msgf : _) -> ArgError -> Maybe ArgError
forall a. a -> Maybe a
Just (String -> String -> ArgError
ArgError (ArgumentDescription -> String
msgf ArgumentDescription
desc) ([ArgumentDescription] -> String
make_usage_info1 [ArgumentDescription]
descs))
                    Nothing -> [(ArgumentDescription, [Maybe String])] -> Maybe ArgError
check_testers [(ArgumentDescription, [Maybe String])]
rest

          in  case [(ArgumentDescription, [Maybe String])] -> Maybe ArgError
check_testers [(ArgumentDescription, [Maybe String])]
pars' of
                 Nothing  -> case [(ArgumentDescription, [Maybe String])] -> Maybe ArgError
check_num [(ArgumentDescription, [Maybe String])]
pars' of
                                Nothing  -> Arguments -> Either ArgError Arguments
forall a b. b -> Either a b
Right (([(ArgumentDescription, [Maybe String])], String) -> Arguments
Arguments ([(ArgumentDescription, [Maybe String])]
pars', String
header))
                                Just err :: ArgError
err -> ArgError -> Either ArgError Arguments
forall a b. a -> Either a b
Left ArgError
err
                 Just err :: ArgError
err -> ArgError -> Either ArgError Arguments
forall a b. a -> Either a b
Left ArgError
err

       args :: Either ArgError Arguments
args =
          (ArgumentDescription -> String)
-> String -> Either ArgError Arguments -> Either ArgError Arguments
forall a b.
(Show a, Ord a) =>
(ArgumentDescription -> [a]) -> String -> b -> b
test_unique ArgumentDescription -> String
argdesc_short_args "short argument" (Either ArgError Arguments -> Either ArgError Arguments)
-> Either ArgError Arguments -> Either ArgError Arguments
forall a b. (a -> b) -> a -> b
$
             (ArgumentDescription -> [String])
-> String -> Either ArgError Arguments -> Either ArgError Arguments
forall a b.
(Show a, Ord a) =>
(ArgumentDescription -> [a]) -> String -> b -> b
test_unique ArgumentDescription -> [String]
argdesc_long_args "long argument" (Either ArgError Arguments -> Either ArgError Arguments)
-> Either ArgError Arguments -> Either ArgError Arguments
forall a b. (a -> b) -> a -> b
$
                case ArgOrder ArgOcc
-> [OptDescr ArgOcc] -> [String] -> ([ArgOcc], [String], [String])
forall a.
ArgOrder a -> [OptDescr a] -> [String] -> ([a], [String], [String])
getOpt ArgOrder ArgOcc
ordering [OptDescr ArgOcc]
optdescr [String]
cmdlargs of
                   (pars :: [ArgOcc]
pars, rest :: [String]
rest, []) ->
                      [ArgOcc] -> [String] -> Either ArgError Arguments
getopt_post [ArgOcc]
pars [String]
rest
                   (_,_,f :: [String]
f) ->
                      ArgError -> Either ArgError Arguments
forall a e. Exception e => e -> a
throw (String -> String -> ArgError
ArgError ([String] -> String
unlines (ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
chomp [String]
f)) (String -> [OptDescr ArgOcc] -> String
forall a. String -> [OptDescr a] -> String
usageInfo String
header [OptDescr ArgOcc]
optdescr))

    in Either ArgError Arguments
args

   where
      -- duplicated here in order to break cyclic module dependency
      chomp :: ShowS
chomp "" = ""
      chomp "\n" = ""
      chomp [x :: Char
x] = [Char
x]
      chomp (x :: Char
x:xs :: String
xs) = let xs' :: String
xs' = ShowS
chomp String
xs
                     in  if String
xs' String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "" Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\n' then "" else Char
xChar -> ShowS
forall a. a -> [a] -> [a]
:String
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 :: String -> [ArgumentDescription] -> IO Arguments
getargs header :: String
header descs :: [ArgumentDescription]
descs = do
   [String]
args <- IO [String]
getArgs
   let res :: Either ArgError Arguments
res = String
-> ArgOrder ArgOcc
-> [String]
-> [ArgumentDescription]
-> Either ArgError Arguments
getargs0 String
header ArgOrder ArgOcc
forall a. ArgOrder a
Permute [String]
args [ArgumentDescription]
descs
   (ArgError -> IO Arguments)
-> (Arguments -> IO Arguments)
-> Either ArgError Arguments
-> IO Arguments
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ArgError -> IO Arguments
forall a e. Exception e => e -> a
throw
          Arguments -> IO Arguments
forall (m :: * -> *) a. Monad m => a -> m a
return
          Either ArgError Arguments
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 :: String -> [ArgumentDescription] -> IO Arguments
getargs_ordered header :: String
header descs :: [ArgumentDescription]
descs = do
   [String]
args <- IO [String]
getArgs
   (ArgError -> IO Arguments)
-> (Arguments -> IO Arguments)
-> Either ArgError Arguments
-> IO Arguments
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ArgError -> IO Arguments
forall a e. Exception e => e -> a
throw
          Arguments -> IO Arguments
forall (m :: * -> *) a. Monad m => a -> m a
return
          (String
-> ArgOrder ArgOcc
-> [String]
-> [ArgumentDescription]
-> Either ArgError Arguments
getargs0 String
header ArgOrder ArgOcc
forall a. ArgOrder a
RequireOrder [String]
args [ArgumentDescription]
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' :: String
-> [String] -> [ArgumentDescription] -> Either ArgError Arguments
getargs' header :: String
header args :: [String]
args descs :: [ArgumentDescription]
descs = String
-> ArgOrder ArgOcc
-> [String]
-> [ArgumentDescription]
-> Either ArgError Arguments
getargs0 String
header ArgOrder ArgOcc
forall a. ArgOrder a
Permute [String]
args [ArgumentDescription]
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' :: String
-> [String] -> [ArgumentDescription] -> Either ArgError Arguments
getargs_ordered' header :: String
header args :: [String]
args descs :: [ArgumentDescription]
descs = String
-> ArgOrder ArgOcc
-> [String]
-> [ArgumentDescription]
-> Either ArgError Arguments
getargs0 String
header ArgOrder ArgOcc
forall a. ArgOrder a
RequireOrder [String]
args [ArgumentDescription]
descs


test_desc :: ArgumentDescription -> Bool -> String -> b -> b
test_desc :: ArgumentDescription -> Bool -> String -> b -> b
test_desc desc :: ArgumentDescription
desc ok :: Bool
ok msg :: String
msg x :: b
x =
   if Bool
ok then b
x
         else String -> ArgumentDescription -> b
forall a. String -> ArgumentDescription -> a
abort String
msg ArgumentDescription
desc

maybe_head :: [a] -> Maybe a
maybe_head :: [a] -> Maybe a
maybe_head [] = Maybe a
forall a. Maybe a
Nothing
maybe_head [a :: a
a] = a -> Maybe a
forall a. a -> Maybe a
Just a
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 :: Arguments -> ArgumentDescription -> Bool
arg_switch args :: Arguments
args desc :: ArgumentDescription
desc =
   ArgumentDescription -> Bool -> String -> Bool -> Bool
forall b. ArgumentDescription -> Bool -> String -> b -> b
test_desc ArgumentDescription
desc (ArgumentDescription -> ArgumentValueSpec
argdesc_argarg ArgumentDescription
desc ArgumentValueSpec -> ArgumentValueSpec -> Bool
forall a. Eq a => a -> a -> Bool
== ArgumentValueSpec
ArgumentValue_none Bool -> Bool -> Bool
&& ArgumentDescription -> Maybe (Int, Int)
argdesc_times ArgumentDescription
desc Maybe (Int, Int) -> Maybe (Int, Int) -> Bool
forall a. Eq a => a -> a -> Bool
== (Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just (0,1))
             "bug: querying argument with is not a switch with arg_switch" (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
   case Arguments -> ArgumentDescription -> [Maybe String]
argvalues Arguments
args ArgumentDescription
desc of
      []         -> Bool
False
      [Nothing]  -> Bool
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 :: Arguments -> ArgumentDescription -> Int
arg_times args :: Arguments
args desc :: ArgumentDescription
desc =
   [Maybe String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Arguments -> ArgumentDescription -> [Maybe String]
argvalues Arguments
args ArgumentDescription
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 :: Arguments -> ArgumentDescription -> [Maybe String]
args_opt args :: Arguments
args desc :: ArgumentDescription
desc =
   ArgumentDescription
-> Bool -> String -> [Maybe String] -> [Maybe String]
forall b. ArgumentDescription -> Bool -> String -> b -> b
test_desc ArgumentDescription
desc (ArgumentDescription -> ArgumentValueSpec
argdesc_argarg ArgumentDescription
desc ArgumentValueSpec -> ArgumentValueSpec -> Bool
forall a. Eq a => a -> a -> Bool
== ArgumentValueSpec
ArgumentValue_optional Bool -> Bool -> Bool
&& (Int, Int) -> Int
forall a b. (a, b) -> b
snd (Maybe (Int, Int) -> (Int, Int)
forall a. HasCallStack => Maybe a -> a
fromJust (ArgumentDescription -> Maybe (Int, Int)
argdesc_times ArgumentDescription
desc)) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= 1)
             "Bug: Querying argument which doesn't take an optional value, or may not occur several times, \
             \with args_opt."
   ([Maybe String] -> [Maybe String])
-> [Maybe String] -> [Maybe String]
forall a b. (a -> b) -> a -> b
$ Arguments -> ArgumentDescription -> [Maybe String]
argvalues Arguments
args ArgumentDescription
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 :: Arguments -> ArgumentDescription -> [String]
args_req args :: Arguments
args desc :: ArgumentDescription
desc =
   ArgumentDescription -> Bool -> String -> [String] -> [String]
forall b. ArgumentDescription -> Bool -> String -> b -> b
test_desc ArgumentDescription
desc (ArgumentDescription -> ArgumentValueSpec
argdesc_argarg ArgumentDescription
desc ArgumentValueSpec -> ArgumentValueSpec -> Bool
forall a. Eq a => a -> a -> Bool
== ArgumentValueSpec
ArgumentValue_required Bool -> Bool -> Bool
&& (Int, Int) -> Int
forall a b. (a, b) -> b
snd (Maybe (Int, Int) -> (Int, Int)
forall a. HasCallStack => Maybe a -> a
fromJust (ArgumentDescription -> Maybe (Int, Int)
argdesc_times ArgumentDescription
desc)) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= 1)
             "Bug: Querying argument which doesn't require a value, or may not occur several times, with \
             \args_req." ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$
   (Maybe String -> String) -> [Maybe String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (Arguments -> ArgumentDescription -> [Maybe String]
argvalues Arguments
args ArgumentDescription
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 :: Arguments -> ArgumentDescription -> Maybe String
reqarg_opt args :: Arguments
args desc :: ArgumentDescription
desc =
   ArgumentDescription
-> Bool -> String -> Maybe String -> Maybe String
forall b. ArgumentDescription -> Bool -> String -> b -> b
test_desc ArgumentDescription
desc (ArgumentDescription -> ArgumentValueSpec
argdesc_argarg ArgumentDescription
desc ArgumentValueSpec -> ArgumentValueSpec -> Bool
forall a. Eq a => a -> a -> Bool
== ArgumentValueSpec
ArgumentValue_optional Bool -> Bool -> Bool
&& ArgumentDescription -> Maybe (Int, Int)
argdesc_times ArgumentDescription
desc Maybe (Int, Int) -> Maybe (Int, Int) -> Bool
forall a. Eq a => a -> a -> Bool
== (Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just (1,1))
             "Bug: Querying argument which doesn't take an optional value, or which must not occur exactly \
             \once, with reqarg_opt." (Maybe String -> Maybe String) -> Maybe String -> Maybe String
forall a b. (a -> b) -> a -> b
$
   [Maybe String] -> Maybe String
forall a. [a] -> a
head (Arguments -> ArgumentDescription -> [Maybe String]
argvalues Arguments
args ArgumentDescription
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 :: Arguments -> ArgumentDescription -> String
reqarg_req args :: Arguments
args desc :: ArgumentDescription
desc =
   ArgumentDescription -> Bool -> String -> ShowS
forall b. ArgumentDescription -> Bool -> String -> b -> b
test_desc ArgumentDescription
desc (ArgumentDescription -> ArgumentValueSpec
argdesc_argarg ArgumentDescription
desc ArgumentValueSpec -> ArgumentValueSpec -> Bool
forall a. Eq a => a -> a -> Bool
== ArgumentValueSpec
ArgumentValue_required Bool -> Bool -> Bool
&& ArgumentDescription -> Maybe (Int, Int)
argdesc_times ArgumentDescription
desc Maybe (Int, Int) -> Maybe (Int, Int) -> Bool
forall a. Eq a => a -> a -> Bool
== (Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just (1,1))
             "Bug: Querying argument with non-required value, or which doesn't occur exactly once, with reqarg_req." ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
   Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust ([Maybe String] -> Maybe String
forall a. [a] -> a
head (Arguments -> ArgumentDescription -> [Maybe String]
argvalues Arguments
args ArgumentDescription
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 :: Arguments -> ArgumentDescription -> Maybe (Maybe String)
optarg_opt args :: Arguments
args desc :: ArgumentDescription
desc =
   ArgumentDescription
-> Bool -> String -> Maybe (Maybe String) -> Maybe (Maybe String)
forall b. ArgumentDescription -> Bool -> String -> b -> b
test_desc ArgumentDescription
desc (ArgumentDescription -> ArgumentValueSpec
argdesc_argarg ArgumentDescription
desc ArgumentValueSpec -> ArgumentValueSpec -> Bool
forall a. Eq a => a -> a -> Bool
== ArgumentValueSpec
ArgumentValue_optional)
             "Bug: Querying argument with non-optional value with optarg_opt." (Maybe (Maybe String) -> Maybe (Maybe String))
-> Maybe (Maybe String) -> Maybe (Maybe String)
forall a b. (a -> b) -> a -> b
$
   ArgumentDescription
-> Bool -> String -> Maybe (Maybe String) -> Maybe (Maybe String)
forall b. ArgumentDescription -> Bool -> String -> b -> b
test_desc ArgumentDescription
desc ((Int, Int) -> Int
forall a b. (a, b) -> a
fst (Maybe (Int, Int) -> (Int, Int)
forall a. HasCallStack => Maybe a -> a
fromJust (ArgumentDescription -> Maybe (Int, Int)
argdesc_times ArgumentDescription
desc)) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0)
             "Bug: Querying argument which isn't optional with optarg_opt." (Maybe (Maybe String) -> Maybe (Maybe String))
-> Maybe (Maybe String) -> Maybe (Maybe String)
forall a b. (a -> b) -> a -> b
$
   ArgumentDescription
-> Bool -> String -> Maybe (Maybe String) -> Maybe (Maybe String)
forall b. ArgumentDescription -> Bool -> String -> b -> b
test_desc ArgumentDescription
desc ((Int, Int) -> Int
forall a b. (a, b) -> b
snd (Maybe (Int, Int) -> (Int, Int)
forall a. HasCallStack => Maybe a -> a
fromJust (ArgumentDescription -> Maybe (Int, Int)
argdesc_times ArgumentDescription
desc)) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1)
             "Bug: Querying argument which may occur several times optarg_opt." (Maybe (Maybe String) -> Maybe (Maybe String))
-> Maybe (Maybe String) -> Maybe (Maybe String)
forall a b. (a -> b) -> a -> b
$
   [Maybe String] -> Maybe (Maybe String)
forall a. [a] -> Maybe a
maybe_head (Arguments -> ArgumentDescription -> [Maybe String]
argvalues Arguments
args ArgumentDescription
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 :: Arguments -> ArgumentDescription -> Maybe String
optarg_req args :: Arguments
args desc :: ArgumentDescription
desc =
   ArgumentDescription
-> Bool -> String -> Maybe String -> Maybe String
forall b. ArgumentDescription -> Bool -> String -> b -> b
test_desc ArgumentDescription
desc (ArgumentDescription -> ArgumentValueSpec
argdesc_argarg ArgumentDescription
desc ArgumentValueSpec -> ArgumentValueSpec -> Bool
forall a. Eq a => a -> a -> Bool
== ArgumentValueSpec
ArgumentValue_required)
             "Bug: Querying argument with non-required value with optarg_req."
   (Maybe String -> Maybe String) -> Maybe String -> Maybe String
forall a b. (a -> b) -> a -> b
$ ArgumentDescription
-> Bool -> String -> Maybe String -> Maybe String
forall b. ArgumentDescription -> Bool -> String -> b -> b
test_desc ArgumentDescription
desc ((Int, Int) -> Int
forall a b. (a, b) -> a
fst (Maybe (Int, Int) -> (Int, Int)
forall a. HasCallStack => Maybe a -> a
fromJust (ArgumentDescription -> Maybe (Int, Int)
argdesc_times ArgumentDescription
desc)) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0)
               "Bug: Querying argument which isn't optional with optarg_req."
   (Maybe String -> Maybe String) -> Maybe String -> Maybe String
forall a b. (a -> b) -> a -> b
$ ArgumentDescription
-> Bool -> String -> Maybe String -> Maybe String
forall b. ArgumentDescription -> Bool -> String -> b -> b
test_desc ArgumentDescription
desc ((Int, Int) -> Int
forall a b. (a, b) -> b
snd (Maybe (Int, Int) -> (Int, Int)
forall a. HasCallStack => Maybe a -> a
fromJust (ArgumentDescription -> Maybe (Int, Int)
argdesc_times ArgumentDescription
desc)) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1)
               "Bug: Querying argument which may occur several times optarg_req."
   (Maybe String -> Maybe String) -> Maybe String -> Maybe String
forall a b. (a -> b) -> a -> b
$ (Maybe String -> String) -> Maybe (Maybe String) -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust ([Maybe String] -> Maybe (Maybe String)
forall a. [a] -> Maybe a
maybe_head (Arguments -> ArgumentDescription -> [Maybe String]
argvalues Arguments
args ArgumentDescription
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 :: [ArgumentDescription] -> Arguments -> IO ()
args_none descs :: [ArgumentDescription]
descs args :: Arguments
args@(Arguments argl :: ([(ArgumentDescription, [Maybe String])], String)
argl) =
   (ArgumentDescription -> IO ()) -> [ArgumentDescription] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\desc :: ArgumentDescription
desc ->
             Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Arguments -> ArgumentDescription -> Int
arg_times Arguments
args ArgumentDescription
desc Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                String -> [ArgumentDescription] -> IO ()
forall a. String -> [ArgumentDescription] -> a
argerror_ui (ShowS
up1 (ArgumentDescription -> String
argname_a ArgumentDescription
desc) String -> ShowS
forall a. [a] -> [a] -> [a]
++ " is not allowed.\n")
                            [ArgumentDescription]
descs
         )
         [ArgumentDescription]
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 :: [ArgumentDescription] -> Arguments -> IO ()
args_all descs :: [ArgumentDescription]
descs args :: Arguments
args@(Arguments argl :: ([(ArgumentDescription, [Maybe String])], String)
argl) =
   (ArgumentDescription -> IO ()) -> [ArgumentDescription] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\desc :: ArgumentDescription
desc ->
             Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Arguments -> ArgumentDescription -> Int
arg_times Arguments
args ArgumentDescription
desc Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                String -> [ArgumentDescription] -> IO ()
forall a. String -> [ArgumentDescription] -> a
argerror_ui ("Missing " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ArgumentDescription -> String
argname_a ArgumentDescription
desc String -> ShowS
forall a. [a] -> [a] -> [a]
++ "\n") [ArgumentDescription]
descs
         )
         [ArgumentDescription]
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 :: [ArgumentDescription] -> Arguments -> IO ()
args_one descs :: [ArgumentDescription]
descs args :: Arguments
args@(Arguments argl :: ([(ArgumentDescription, [Maybe String])], String)
argl) =
   Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([ArgumentDescription] -> Arguments -> Int
occuring [ArgumentDescription]
descs Arguments
args Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= 1) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      String -> [ArgumentDescription] -> IO ()
forall a. String -> [ArgumentDescription] -> a
argerror_ui ("Exactly one of the following arguments must be present.\n"
                String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse ", " ((ArgumentDescription -> String)
-> [ArgumentDescription] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ArgumentDescription -> String
argname [ArgumentDescription]
descs)) String -> ShowS
forall a. [a] -> [a] -> [a]
++ "\n")
               [ArgumentDescription]
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 :: [ArgumentDescription] -> Arguments -> IO ()
args_at_most_one descs :: [ArgumentDescription]
descs args :: Arguments
args@(Arguments argl :: ([(ArgumentDescription, [Maybe String])], String)
argl) =
   Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([ArgumentDescription] -> Arguments -> Int
occuring [ArgumentDescription]
descs Arguments
args Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      String -> [ArgumentDescription] -> IO ()
forall a. String -> [ArgumentDescription] -> a
argerror_ui ("Only one of the following arguments may be present.\n"
                   String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse ", " ((ArgumentDescription -> String)
-> [ArgumentDescription] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ArgumentDescription -> String
argname [ArgumentDescription]
descs)) String -> ShowS
forall a. [a] -> [a] -> [a]
++ "\n")
                   [ArgumentDescription]
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 :: [ArgumentDescription] -> Arguments -> IO ()
args_at_least_one descs :: [ArgumentDescription]
descs args :: Arguments
args@(Arguments argl :: ([(ArgumentDescription, [Maybe String])], String)
argl) =
   Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([ArgumentDescription] -> Arguments -> Int
occuring [ArgumentDescription]
descs Arguments
args Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      String -> [ArgumentDescription] -> IO ()
forall a. String -> [ArgumentDescription] -> a
argerror_ui ("One of the following arguments must be present.\n"
                   String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse ", " ((ArgumentDescription -> String)
-> [ArgumentDescription] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ArgumentDescription -> String
argname [ArgumentDescription]
descs)) String -> ShowS
forall a. [a] -> [a] -> [a]
++ "\n")
                   [ArgumentDescription]
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 :: ArgumentDescription -> [ArgumentDescription] -> Arguments -> IO ()
arg_conflicts desc :: ArgumentDescription
desc descs :: [ArgumentDescription]
descs args :: Arguments
args@(Arguments argl :: ([(ArgumentDescription, [Maybe String])], String)
argl) =
   Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Arguments -> ArgumentDescription -> Bool
arg_occurs Arguments
args ArgumentDescription
desc Bool -> Bool -> Bool
&& [ArgumentDescription] -> Arguments -> Int
occuring [ArgumentDescription]
descs Arguments
args Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      String -> [ArgumentDescription] -> IO ()
forall a. String -> [ArgumentDescription] -> a
argerror_ui ("When " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ArgumentDescription -> String
argname ArgumentDescription
desc String -> ShowS
forall a. [a] -> [a] -> [a]
++ " is present, none of the following arguments may be present.\n"
                   String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse ", " ((ArgumentDescription -> String)
-> [ArgumentDescription] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ArgumentDescription -> String
argname [ArgumentDescription]
descs)) String -> ShowS
forall a. [a] -> [a] -> [a]
++ "\n")
                   [ArgumentDescription]
descs


-- How many of the specified arguments do occur? Multiple occurences of the same argument count as one.
occuring :: [ArgumentDescription] -> Arguments -> Int
occuring :: [ArgumentDescription] -> Arguments -> Int
occuring descs :: [ArgumentDescription]
descs args :: Arguments
args =
   [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((ArgumentDescription -> Int) -> [ArgumentDescription] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\desc :: ArgumentDescription
desc -> if Arguments -> ArgumentDescription -> Int
arg_times Arguments
args ArgumentDescription
desc Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 then 0 else 1) [ArgumentDescription]
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 :: Arguments -> ArgumentDescription -> Bool
arg_occurs args :: Arguments
args desc :: ArgumentDescription
desc =
   [ArgumentDescription] -> Arguments -> Int
occuring [ArgumentDescription
desc] Arguments
args Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 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'.
usage_info :: Arguments -> String
usage_info :: Arguments -> String
usage_info (Arguments (l :: [(ArgumentDescription, [Maybe String])]
l, header :: String
header)) =
   [String] -> String
unlines (Int -> String -> [String]
wrap 80 String
header) String -> ShowS
forall a. [a] -> [a] -> [a]
++
   [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse "\n" ([ArgumentDescription] -> Int -> Int -> Int -> Int -> [String]
make_usage_info (((ArgumentDescription, [Maybe String]) -> ArgumentDescription)
-> [(ArgumentDescription, [Maybe String])] -> [ArgumentDescription]
forall a b. (a -> b) -> [a] -> [b]
map (ArgumentDescription, [Maybe String]) -> ArgumentDescription
forall a b. (a, b) -> a
fst [(ArgumentDescription, [Maybe String])]
l) 0 10 30 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 :: String -> [ArgumentDescription] -> Arguments
unsafe_getargs header :: String
header descs :: [ArgumentDescription]
descs =
   IO Arguments -> Arguments
forall a. IO a -> a
GHC.IO.unsafePerformIO (IO Arguments -> Arguments) -> IO Arguments -> Arguments
forall a b. (a -> b) -> a -> b
$ String -> [ArgumentDescription] -> IO Arguments
getargs String
header [ArgumentDescription]
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 :: String -> [ArgumentDescription] -> Arguments
unsafe_getargs_ordered header :: String
header descs :: [ArgumentDescription]
descs =
   IO Arguments -> Arguments
forall a. IO a -> a
GHC.IO.unsafePerformIO (IO Arguments -> Arguments) -> IO Arguments -> Arguments
forall a b. (a -> b) -> a -> b
$ String -> [ArgumentDescription] -> IO Arguments
getargs_ordered String
header [ArgumentDescription]
descs



make_usage_info1 :: [ArgumentDescription] -> String
make_usage_info1 :: [ArgumentDescription] -> String
make_usage_info1 argdescs :: [ArgumentDescription]
argdescs =
   [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse "\n" ([ArgumentDescription] -> Int -> Int -> Int -> Int -> [String]
make_usage_info [ArgumentDescription]
argdescs 0 10 30 80))



-- |
-- Generate pretty-printed information about the command line arguments. This
-- function gives you much control on how the usage information is generated.
-- @print_usage_info@ might be more like what you need.
--
-- The specified argument descriptions (as taken by the @getargs@... functions)
-- are processed in the given order. Each one is formatted as a paragraph,
-- detailing the argument. This is done according to the specified geometry.
--
-- The direct argument, in case there is one, is omitted. You should detail the
-- direct command line arguments separatly, such as in some header.
--
-- The specified maximum breadths must fit in the specified width, or an error
-- is raised. This happens, when @colsleft + colsshort + 2 + colslong + 2 + 2 >
-- width@.
--
-- See 'print_usage_info', 'getargs', 'usage_info', 'ArgumentDescription',
-- 'desc_description', 'argdesc', 'terminal_width', 'terminal_width_ioe'.

make_usage_info :: [ArgumentDescription]      -- ^ List of argument descriptions, as created by a @argdesc@
                -> Int                        -- ^ The output is indented this many columns. Probably zero.
                -> Int                        -- ^ Maximum width of the column of the short form of each argument.
                                              --   When this many aren'tneeded, less are used.
                -> Int                        -- ^ Maximum width of the column of the long form of each argument.
                                              --   When this many aren't needed, less are used.
                -> Int                        -- ^ Wrap everything at this column. Should probably be the
                                              --   terminal width.
                -> [String]                   -- ^ Pretty printed usage information, in paragraphs, which contain
                                              --   one or several lines, which are separated by newlines.

make_usage_info :: [ArgumentDescription] -> Int -> Int -> Int -> Int -> [String]
make_usage_info descs :: [ArgumentDescription]
descs colsleft :: Int
colsleft colsshort :: Int
colsshort colslong :: Int
colslong width :: Int
width =

    if Int
colsleft Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
colsshort Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
colslong Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
width
       then String -> [String]
forall a. HasCallStack => String -> a
error (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ "make_usage_info: colsleft, colsshort, and colslong arguments \
                    \are too large for the specified width argument.\n\
                    \colsleft  = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
colsleft String -> ShowS
forall a. [a] -> [a] -> [a]
++ "  \n\
                    \colsshort = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
colsshort String -> ShowS
forall a. [a] -> [a] -> [a]
++ "  \n\
                    \colslong  = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
colslong String -> ShowS
forall a. [a] -> [a] -> [a]
++ "  \n\
                    \width     = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
width
       else
          ([String] -> String) -> [[String]] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map [String] -> String
unlines ([[(String, String, String)]] -> [[String]]
verbinden ([ArgumentDescription] -> [[(String, String, String)]]
zll' ((ArgumentDescription -> Bool)
-> [ArgumentDescription] -> [ArgumentDescription]
forall a. (a -> Bool) -> [a] -> [a]
filter (\d :: ArgumentDescription
d -> Bool -> Bool
not (ArgumentDescription -> Bool
is_direct ArgumentDescription
d))
                                               [ArgumentDescription]
descs)
                                 ))

    where
          -- The argument description, wrapped to the right width.
          beschr :: ArgumentDescription -> [String]
          beschr :: ArgumentDescription -> [String]
beschr desc :: ArgumentDescription
desc = Int -> String -> [String]
wrap (Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
colsleft Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
gesamtbr_kurz Int -> Int -> Int
forall a. Num a => a -> a -> a
- 2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
gesamtbr_lang Int -> Int -> Int
forall a. Num a => a -> a -> a
- 2)
                             (String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe "" (ArgumentDescription -> Maybe String
argdesc_description ArgumentDescription
desc))

          -- Render an argument description.
          auff1 :: ArgumentDescription 
                -> ([String], [String], [String])
          auff1 :: ArgumentDescription -> ([String], [String], [String])
auff1 desc :: ArgumentDescription
desc = [String] -> [String] -> [String] -> ([String], [String], [String])
auff (ArgumentDescription -> [String]
kurzname ArgumentDescription
desc)
                            (ArgumentDescription -> [String]
langname ArgumentDescription
desc)
                            (ArgumentDescription -> [String]
beschr ArgumentDescription
desc)

          -- Wir haben für eine Argumentbeschreibung die Listen von Zeilen, aus denen der kurze, und lange
          -- Argumentname besteht, sowie die Zeilen, aus denen die Argumentbeschreibung besteht.
          zus :: ([String], [String], [String]) -> [(String, String, String)]
          zus :: ([String], [String], [String]) -> [(String, String, String)]
zus (as :: [String]
as, bs :: [String]
bs, cs :: [String]
cs) = [String] -> [String] -> [String] -> [(String, String, String)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [String]
as [String]
bs [String]
cs

          -- Die für die Kurzform einses Arguments benötigte Zahl von Spalten
          kurzbr :: ArgumentDescription -> Int
          kurzbr :: ArgumentDescription -> Int
kurzbr desc :: ArgumentDescription
desc =
             (Int -> Int -> Int) -> Int -> [Int] -> Int
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Int -> Int -> Int
forall a. Ord a => a -> a -> a
max 0 ((String -> Int) -> [String] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (ArgumentDescription -> [String]
kurzname ArgumentDescription
desc))

          -- Die für die Langform einses Arguments benötigte Zahl von Spalten
          langbr :: ArgumentDescription -> Int
          langbr :: ArgumentDescription -> Int
langbr desc :: ArgumentDescription
desc =
             (Int -> Int -> Int) -> Int -> [Int] -> Int
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Int -> Int -> Int
forall a. Ord a => a -> a -> a
max 0 ((String -> Int) -> [String] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (ArgumentDescription -> [String]
langname ArgumentDescription
desc))

          -- Breite der Kurzform, über alle Argumente hinweg
          gesamtbr_kurz :: Int
gesamtbr_kurz =
             (Int -> Int -> Int) -> Int -> [Int] -> Int
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Int -> Int -> Int
forall a. Ord a => a -> a -> a
max 0 ((ArgumentDescription -> Int) -> [ArgumentDescription] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\desc :: ArgumentDescription
desc -> ArgumentDescription -> Int
kurzbr ArgumentDescription
desc) [ArgumentDescription]
descs)

          -- Breite der Langform, über alle Argumente hinweg
          gesamtbr_lang :: Int
gesamtbr_lang =
             (Int -> Int -> Int) -> Int -> [Int] -> Int
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Int -> Int -> Int
forall a. Ord a => a -> a -> a
max 0 ((ArgumentDescription -> Int) -> [ArgumentDescription] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\desc :: ArgumentDescription
desc -> ArgumentDescription -> Int
langbr ArgumentDescription
desc) [ArgumentDescription]
descs)

          -- Breite der Beschreibungen
          breite_descr :: Int
          breite_descr :: Int
breite_descr = Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
colsleft Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
gesamtbr_kurz Int -> Int -> Int
forall a. Num a => a -> a -> a
- 2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
gesamtbr_lang Int -> Int -> Int
forall a. Num a => a -> a -> a
- 2

          -- Für jedes Kommandozeilenargument die Liste der Zeilen
          zll :: [ArgumentDescription]
              -> [[(String, String, String)]]
          zll :: [ArgumentDescription] -> [[(String, String, String)]]
zll descs :: [ArgumentDescription]
descs =
             (ArgumentDescription -> [(String, String, String)])
-> [ArgumentDescription] -> [[(String, String, String)]]
forall a b. (a -> b) -> [a] -> [b]
map (([String], [String], [String]) -> [(String, String, String)]
zus (([String], [String], [String]) -> [(String, String, String)])
-> (ArgumentDescription -> ([String], [String], [String]))
-> ArgumentDescription
-> [(String, String, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ArgumentDescription -> ([String], [String], [String])
auff1) [ArgumentDescription]
descs

          -- Für jedes Kommandozeilenargument die Liste der Zeilen, aufgefüllt auf einheitliche Breite
          zll' :: [ArgumentDescription]
               -> [[(String, String, String)]]
          zll' :: [ArgumentDescription] -> [[(String, String, String)]]
zll' [] =
             []
          zll' descs :: [ArgumentDescription]
descs =
             ([(String, String, String)] -> [(String, String, String)])
-> [[(String, String, String)]] -> [[(String, String, String)]]
forall a b. (a -> b) -> [a] -> [b]
map (\l :: [(String, String, String)]
l -> ((String, String, String) -> (String, String, String))
-> [(String, String, String)] -> [(String, String, String)]
forall a b. (a -> b) -> [a] -> [b]
map (\(a :: String
a,b :: String
b,c :: String
c) -> (Int -> ShowS
fuell Int
gesamtbr_kurz String
a,
                                          Int -> ShowS
fuell Int
gesamtbr_lang String
b,
                                          String
c))
                            [(String, String, String)]
l)
                 ([ArgumentDescription] -> [[(String, String, String)]]
zll [ArgumentDescription]
descs)

          -- Die Tripel
          verbinden :: [[(String, String, String)]]
                    -> [[String]]
          verbinden :: [[(String, String, String)]] -> [[String]]
verbinden l :: [[(String, String, String)]]
l =
             ([(String, String, String)] -> [String])
-> [[(String, String, String)]] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map (\l' :: [(String, String, String)]
l' -> ((String, String, String) -> String)
-> [(String, String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\(a :: String
a,b :: String
b,c :: String
c) -> Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
colsleft (Char -> String
forall a. a -> [a]
repeat ' ')
                                          String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ "  " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
b String -> ShowS
forall a. [a] -> [a] -> [a]
++ "  " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
c) [(String, String, String)]
l')
                 [[(String, String, String)]]
l

          -- Die Kurzform des angegebenen Arguments. In Zeilen heruntergebrochen,
          -- wenn die Breite colsshort überschritten wird.
          kurzname :: ArgumentDescription -> [String]
          kurzname :: ArgumentDescription -> [String]
kurzname desc :: ArgumentDescription
desc =
             Int -> String -> [String]
wrap Int
colsshort (ArgumentDescription -> String
argname_short ArgumentDescription
desc)

          -- Die Langform des angegebenen Arguments. In Zeilen heruntergebrochen,
          -- wenn die Breite colslong überschritten wird
          langname :: ArgumentDescription -> [String]
          langname :: ArgumentDescription -> [String]
langname desc :: ArgumentDescription
desc =
             Int -> String -> [String]
wrap Int
colslong (ArgumentDescription -> String
argname_long ArgumentDescription
desc)

          -- Den gegebenen String um so viele Leerzeichen ergänzen, daß daraus ein String der gegebenen Länge
          -- wird. Ist er dafür zu lang, denn den unveränderten String zurückgeben.
          fuell :: Int -> String -> String
          fuell :: Int -> ShowS
fuell br :: Int
br txt :: String
txt =
             String
txt String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> ShowS
forall a. Int -> [a] -> [a]
take (Int
br Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
txt) (Char -> String
forall a. a -> [a]
repeat ' ')


          -- Complete three lists of Strings. All three strings are made to be made up
          -- of the same number of entries. Missing entries at the end are filled up with
          -- empty strings.
          auff :: [String] -> [String] -> [String] -> ([String], [String], [String])
          auff :: [String] -> [String] -> [String] -> ([String], [String], [String])
auff a :: [String]
a b :: [String]
b c :: [String]
c =
             ([String] -> [String]
forall a. [a] -> [a]
reverse [String]
x, [String] -> [String]
forall a. [a] -> [a]
reverse [String]
y, [String] -> [String]
forall a. [a] -> [a]
reverse [String]
z)

             where
                (x :: [String]
x,y :: [String]
y,z :: [String]
z) = [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> ([String], [String], [String])
auff' [String]
a [String]
b [String]
c [] [] []

                auff' :: [String] -> [String] -> [String]
                      -> [String] -> [String] -> [String]
                      -> ([String], [String], [String])

                auff' :: [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> ([String], [String], [String])
auff' [] [] [] a1 :: [String]
a1 b1 :: [String]
b1 c1 :: [String]
c1 =
                   ([String]
a1, [String]
b1, [String]
c1)

                auff' a :: [String]
a b :: [String]
b c :: [String]
c a1 :: [String]
a1 b1 :: [String]
b1 c1 :: [String]
c1 =
                   [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> ([String], [String], [String])
auff' (if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
a then [] else [String] -> [String]
forall a. [a] -> [a]
tail [String]
a)
                         (if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
b then [] else [String] -> [String]
forall a. [a] -> [a]
tail [String]
b)
                         (if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
c then [] else [String] -> [String]
forall a. [a] -> [a]
tail [String]
c)
                         ((if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
a then "" else [String] -> String
forall a. [a] -> a
head [String]
a) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
a1)
                         ((if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
b then "" else [String] -> String
forall a. [a] -> a
head [String]
b) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
b1)
                         ((if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
c then "" else [String] -> String
forall a. [a] -> a
head [String]
c) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
c1)




-- |
-- Print the usage information (about the command line arguments), for the
-- specified header and arguments to the specified handle. When the handle is
-- connected to a terminal, the terminal\'s width (in columns) is used to format
-- the output, such that it fits the terminal. Both the header and the argument
-- descriptions are adapted to the width of the terminal (by using @wrap@).
--
-- When the handle does not connected to a terminal, 80 columns are used. This
-- may happen to @stdout@ or @stderr@, for instance, when the program is in a
-- pipe, or the output has been redirected to a file.
--
-- When the terminal is too narrow for useful output, then instead of the usage
-- information, a short message (@"Terminal too narrow"@) is printed. This
-- applies to terminals with a width of less than 12.
--
-- You should specify one long line for each paragraph in the header and the
-- argument descriptions, and let print_usage_info do the wrapping. When you
-- have several paragraphs, separate them by a double @\\n\\n@. This also applies
-- for an empty line, which should be printed after the actual header.
--
-- The arguments are printed in the order, in which they occur in the argument
-- description list.
--
-- This function is a front end to @terminal_width@ and @make_usage_info@.
--
-- See 'argdesc', 'desc_description', 'terminal_width', 'make_usage_info', 'usage_info', 'wrap'.
print_usage_info :: Handle                      -- ^ To which handle to print the
                                                --   usage info.
                 -> String                      -- ^ The header to print first.
                                                --   Can be empty.
                 -> [ArgumentDescription]       -- ^ The argument description of
                                                --   the arguments, which should be documented.
                 -> IO ()
print_usage_info :: Handle -> String -> [ArgumentDescription] -> IO ()
print_usage_info h :: Handle
h header :: String
header descs :: [ArgumentDescription]
descs = do

   -- Determine the width to use
   Maybe Int
mw <- Handle -> IO (Maybe Int)
terminal_width Handle
h
   let w :: Int
w = case Maybe Int
mw of
              Just w :: Int
w  -> Int
w
              Nothing -> 80

   {-
   if w < 12
      then ioError (mkIOError userErrorType "The terminal width is too small (< 12) for printing \
                                            \of the usage information. See print_usage_info." (Just h) Nothing)
      else
   -}

   if Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 12
      then Handle -> String -> IO ()
hPutStr Handle
h "Terminal too narrow"

      else do -- Wrap and print the header
              Handle -> String -> IO ()
hPutStr Handle
h ([String] -> String
unlines (Int -> String -> [String]
wrap Int
w String
header))

              -- Print the argument descriptions.
              (String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Handle -> String -> IO ()
hPutStr Handle
h)
                    ([ArgumentDescription] -> Int -> Int -> Int -> Int -> [String]
make_usage_info [ArgumentDescription]
descs
                                     0
                                     (Int
w Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 5)
                                     (Int
w Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 3)
                                     Int
w)


-- |
-- Break down a text to lines, such that each one has the specified
-- maximum width.
--
-- Newline characters in the input text are respected. They terminate the line,
-- without it being filled up to the width.
--
-- The text is wrapped at space characters. Words remain intact, except when
-- they are too long for one line.
wrap :: Int             -- ^ Maximum width for the lines of the text, which is to be broken down
     -> String          -- ^ Text to break down
     -> [String]        -- ^ The broken down text in columns
wrap :: Int -> String -> [String]
wrap breite :: Int
breite [] = []
wrap breite :: Int
breite txt :: String
txt =
   [ String
zl | String
txtzl <- String -> [String]
lines String
txt,
          String
zl <- Int -> String -> [String]
wrap' Int
breite String
txtzl
   ]
   where
      wrap' :: Int -> String -> [String]
      wrap' :: Int -> String -> [String]
wrap' breite :: Int
breite [] = [""]
      wrap' breite :: Int
breite txt :: String
txt =
         Int -> String -> [String]
wrap'' Int
breite ((Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace String
txt)

      wrap'' :: Int -> String -> [String]
      wrap'' :: Int -> String -> [String]
wrap'' breite :: Int
breite txt :: String
txt =
         if String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
txt Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
breite
            then [String
txt]
            else
                 if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
txt_anf
                    then -- Zu breit für eine Zeile
                         String
txt_br String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Int -> String -> [String]
wrap' Int
breite String
txt_rest
                    else String
txt_anf String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Int -> String -> [String]
wrap' Int
breite String
rest

         where
            (txt_br :: String
txt_br, txt_rest :: String
txt_rest) =
               Int -> String -> (String, String)
forall a. Int -> [a] -> ([a], [a])
splitAt Int
breite String
txt

            (txt_anf :: String
txt_anf, txt_anf_rest :: String
txt_anf_rest) =
               String -> (String, String)
letzter_teil String
txt_br

            rest :: String
rest = String
txt_anf_rest String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
txt_rest

            -- Letztes Wort von zl abspalten. Liefert
            -- ( Anfang von zl, Letztes Wort )
            letzter_teil :: String -> (String, String)
letzter_teil zl :: String
zl =
               let zl' :: String
zl'              = ShowS
forall a. [a] -> [a]
reverse String
zl
                   (wort :: String
wort, zl'' :: String
zl'')     = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= ' ') String
zl'
                   zl''1 :: String
zl''1            = (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ' ') String
zl''
                   zl''' :: String
zl'''            = ShowS
forall a. [a] -> [a]
reverse String
zl''1
                   wort' :: String
wort'            = ShowS
forall a. [a] -> [a]
reverse String
wort
               in (String
zl''', String
wort')