-- 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
$c== :: ArgumentValueSpec -> ArgumentValueSpec -> Bool
== :: ArgumentValueSpec -> ArgumentValueSpec -> Bool
$c/= :: ArgumentValueSpec -> ArgumentValueSpec -> Bool
/= :: ArgumentValueSpec -> ArgumentValueSpec -> Bool
Eq, Int -> ArgumentValueSpec -> ShowS
[ArgumentValueSpec] -> ShowS
ArgumentValueSpec -> [Char]
(Int -> ArgumentValueSpec -> ShowS)
-> (ArgumentValueSpec -> [Char])
-> ([ArgumentValueSpec] -> ShowS)
-> Show ArgumentValueSpec
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ArgumentValueSpec -> ShowS
showsPrec :: Int -> ArgumentValueSpec -> ShowS
$cshow :: ArgumentValueSpec -> [Char]
show :: ArgumentValueSpec -> [Char]
$cshowList :: [ArgumentValueSpec] -> ShowS
showList :: [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
$ccompare :: ArgumentValueSpec -> ArgumentValueSpec -> Ordering
compare :: ArgumentValueSpec -> ArgumentValueSpec -> Ordering
$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
>= :: ArgumentValueSpec -> ArgumentValueSpec -> Bool
$cmax :: ArgumentValueSpec -> ArgumentValueSpec -> ArgumentValueSpec
max :: ArgumentValueSpec -> ArgumentValueSpec -> ArgumentValueSpec
$cmin :: ArgumentValueSpec -> ArgumentValueSpec -> ArgumentValueSpec
min :: ArgumentValueSpec -> ArgumentValueSpec -> 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 -> [Char]
argdesc_short_args :: [Char],             -- ^ Short option names
        ArgumentDescription -> [[Char]]
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 [Char]
argdesc_argargname :: Maybe String,       -- ^ Name for argument's value, for message generation
        ArgumentDescription -> Maybe [Char]
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
-> ([Char], [[Char]], ArgumentValueSpec, Maybe (Int, Int),
    Maybe [Char], Maybe [Char])
ad_tup ArgumentDescription
ad =
   (ArgumentDescription -> [Char]
argdesc_short_args ArgumentDescription
ad, ArgumentDescription -> [[Char]]
argdesc_long_args ArgumentDescription
ad, ArgumentDescription -> ArgumentValueSpec
argdesc_argarg ArgumentDescription
ad, ArgumentDescription -> Maybe (Int, Int)
argdesc_times ArgumentDescription
ad,
    ArgumentDescription -> Maybe [Char]
argdesc_argargname ArgumentDescription
ad, ArgumentDescription -> Maybe [Char]
argdesc_description ArgumentDescription
ad)

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

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

-- value for maximum number of times
unlimited :: Int
unlimited = -Int
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 ArgumentDescription
arg1 ArgumentDescription
arg2 =
   case (ArgumentDescription -> [Char]
argdesc_short_args ArgumentDescription
arg1, ArgumentDescription -> [Char]
argdesc_short_args ArgumentDescription
arg2) of
      (Char
a:[Char]
_, Char
b:[Char]
_) -> Char
a Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
b
      ([], [])   -> case (ArgumentDescription -> [[Char]]
argdesc_long_args ArgumentDescription
arg1, ArgumentDescription -> [[Char]]
argdesc_long_args ArgumentDescription
arg2) of
                       ([],[[Char]]
_)  -> Bool
forall {a}. a
unnamed
                       ([[Char]]
_,[])  -> Bool
forall {a}. a
unnamed
                       ([[Char]]
l1,[[Char]]
l2) -> [[Char]] -> [Char]
forall a. HasCallStack => [a] -> a
head [[Char]]
l1 [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [[Char]] -> [Char]
forall a. HasCallStack => [a] -> a
head [[Char]]
l2
      ([Char], [Char])
_          -> Bool
False
   where unnamed :: a
unnamed = [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"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 {
      argdesc_short_args :: [Char]
argdesc_short_args = [],
      argdesc_long_args :: [[Char]]
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 [Char]
argdesc_argargname = Maybe [Char]
forall a. Maybe a
Nothing,
      argdesc_description :: Maybe [Char]
argdesc_description = Maybe [Char]
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 = (Int
0,Int
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 [Char]]
argvalues (Arguments ([(ArgumentDescription, [Maybe [Char]])]
l, [Char]
header)) ArgumentDescription
desc =
   [(ArgumentDescription, [Maybe [Char]])] -> [Maybe [Char]]
forall {b}. [(ArgumentDescription, b)] -> b
argvalues' [(ArgumentDescription, [Maybe [Char]])]
l
   where
      argvalues' :: [(ArgumentDescription, b)] -> b
argvalues' ((ArgumentDescription
d,b
v):[(ArgumentDescription, b)]
r) = if ArgumentDescription -> ArgumentDescription -> Bool
same_arg ArgumentDescription
desc ArgumentDescription
d then b
v else [(ArgumentDescription, b)] -> b
argvalues' [(ArgumentDescription, b)]
r
      argvalues' []        = [Char] -> ArgumentDescription -> b
forall {a}. [Char] -> ArgumentDescription -> a
abort [Char]
"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 -> [Char]
argerror_message :: String,
      -- | Deprecated. Usage information, as generated by the now deprecated function 'usage_info'.
      ArgError -> [Char]
argerror_usageinfo :: String
   }
   deriving (Typeable)


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


-- |
-- 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 Char
c = (ArgumentDescription -> ArgumentDescription) -> ArgumentProperty
ArgumentProperty
   (\ArgumentDescription
desc ->
      if (Char
c Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (ArgumentDescription -> [Char]
argdesc_short_args ArgumentDescription
desc))
         then [Char] -> ArgumentDescription -> ArgumentDescription
forall {a}. [Char] -> ArgumentDescription -> a
abort ([Char]
"Bug in HsShellScript argument description: Duplicate short argument " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Char -> [Char]
forall a. Show a => a -> [Char]
show Char
c [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" specified") ArgumentDescription
desc
         else if ([Char]
"" [Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ArgumentDescription -> [[Char]]
argdesc_long_args ArgumentDescription
desc)
                 then [Char] -> ArgumentDescription -> ArgumentDescription
forall {a}. [Char] -> ArgumentDescription -> a
abort_conflict [Char]
"" ArgumentDescription
desc
                 else ArgumentDescription
desc { argdesc_short_args :: [Char]
argdesc_short_args = Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: ArgumentDescription -> [Char]
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 :: [Char] -> ArgumentProperty
desc_long [Char]
str = (ArgumentDescription -> ArgumentDescription) -> ArgumentProperty
ArgumentProperty
   (\ArgumentDescription
desc ->
      if ([Char]
str [Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (ArgumentDescription -> [[Char]]
argdesc_long_args ArgumentDescription
desc))
         then [Char] -> ArgumentDescription -> ArgumentDescription
forall {a}. [Char] -> ArgumentDescription -> a
abort ([Char]
"Bug in HsShellScript argument description: Duplicate long argument " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> [Char]
show [Char]
str [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" specified") ArgumentDescription
desc
         else if ([Char]
"" [Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ArgumentDescription -> [[Char]]
argdesc_long_args ArgumentDescription
desc)
                 then [Char] -> ArgumentDescription -> ArgumentDescription
forall {a}. [Char] -> ArgumentDescription -> a
abort_conflict [Char]
"" ArgumentDescription
desc
                 else ArgumentDescription
desc { argdesc_long_args :: [[Char]]
argdesc_long_args = [Char]
str [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: ArgumentDescription -> [[Char]]
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
   (\ArgumentDescription
desc ->
      if ArgumentDescription -> [[Char]]
argdesc_long_args ArgumentDescription
desc [[Char]] -> [[Char]] -> Bool
forall a. Eq a => a -> a -> Bool
== [] Bool -> Bool -> Bool
&& ArgumentDescription -> [Char]
argdesc_short_args ArgumentDescription
desc [Char] -> [Char] -> 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 :: [[Char]]
argdesc_long_args = [[Char]
""]
                   , argdesc_argarg :: ArgumentValueSpec
argdesc_argarg = ArgumentValueSpec
ArgumentValue_required
                   , argdesc_argargname :: Maybe [Char]
argdesc_argargname = [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
""
                   }
         else [Char] -> ArgumentDescription -> ArgumentDescription
forall {a}. [Char] -> ArgumentDescription -> a
abort_conflict [Char]
"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
   (\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 [Char] -> ArgumentDescription -> ArgumentDescription
forall {a}. [Char] -> ArgumentDescription -> a
abort_conflict [Char]
"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
   (\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 [Char] -> ArgumentDescription -> ArgumentDescription
forall {a}. [Char] -> ArgumentDescription -> a
abort_conflict [Char]
"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 Int
n Int
m = (ArgumentDescription -> ArgumentDescription) -> ArgumentProperty
ArgumentProperty
   (\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 [Char] -> ArgumentDescription -> ArgumentDescription
forall {a}. [Char] -> ArgumentDescription -> a
abort_conflict [Char]
"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 Int
1 Int
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 Int
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 Int
0 Int
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 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 Int
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 Int
n = Int -> Int -> ArgumentProperty
desc_times Int
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 :: [Char] -> ArgumentProperty
desc_argname [Char]
name = (ArgumentDescription -> ArgumentDescription) -> ArgumentProperty
ArgumentProperty
   (\ArgumentDescription
desc ->
      if ArgumentDescription -> Maybe [Char]
argdesc_argargname ArgumentDescription
desc Maybe [Char] -> Maybe [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe [Char]
forall a. Maybe a
Nothing
         then ArgumentDescription
desc { argdesc_argargname :: Maybe [Char]
argdesc_argargname = [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
name }
         else [Char] -> ArgumentDescription -> ArgumentDescription
forall {a}. [Char] -> ArgumentDescription -> a
abort [Char]
"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 :: [Char] -> ArgumentProperty
desc_description [Char]
expl = (ArgumentDescription -> ArgumentDescription) -> ArgumentProperty
ArgumentProperty
   (\ArgumentDescription
desc ->
      if ArgumentDescription -> Maybe [Char]
argdesc_description ArgumentDescription
desc Maybe [Char] -> Maybe [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe [Char]
forall a. Maybe a
Nothing
         then ArgumentDescription
desc { argdesc_description :: Maybe [Char]
argdesc_description = [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
expl }
         else [Char] -> ArgumentDescription -> ArgumentDescription
forall {a}. [Char] -> ArgumentDescription -> a
abort [Char]
"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 Argtester
t = (ArgumentDescription -> ArgumentDescription) -> ArgumentProperty
ArgumentProperty
   (\ArgumentDescription
desc ->
      case ArgumentDescription -> Maybe Argtester
argdesc_argarg_tester ArgumentDescription
desc of
         Maybe Argtester
Nothing -> ArgumentDescription
desc { argdesc_argarg_tester :: Maybe Argtester
argdesc_argarg_tester = Argtester -> Maybe Argtester
forall a. a -> Maybe a
Just Argtester
t }
         Just Argtester
_  -> [Char] -> ArgumentDescription -> ArgumentDescription
forall {a}. [Char] -> ArgumentDescription -> a
abort [Char]
"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 :: forall a. ReadS a -> [Char] -> Argtester
readtester ReadS a
reader [Char]
msg [Char]
val =
   case ((a, [Char]) -> Bool) -> [(a, [Char])] -> [(a, [Char])]
forall a. (a -> Bool) -> [a] -> [a]
filter (([Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"") ([Char] -> Bool) -> ((a, [Char]) -> [Char]) -> (a, [Char]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, [Char]) -> [Char]
forall a b. (a, b) -> b
snd) ([(a, [Char])] -> [(a, [Char])]) -> [(a, [Char])] -> [(a, [Char])]
forall a b. (a -> b) -> a -> b
$ ReadS a
reader [Char]
val of
      [(a
_,[Char]
"")] -> Maybe (ArgumentDescription -> [Char])
forall a. Maybe a
Nothing
      []       -> (ArgumentDescription -> [Char])
-> Maybe (ArgumentDescription -> [Char])
forall a. a -> Maybe a
Just (\ArgumentDescription
arg -> [Char]
"Format error in the value of the " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ArgumentDescription -> [Char]
argname_a ArgumentDescription
arg [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
". " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
msg [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++
                                [Char]
"\nValue: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
quote [Char]
val)
      [(a, [Char])]
_        -> (ArgumentDescription -> [Char])
-> Maybe (ArgumentDescription -> [Char])
forall a. a -> Maybe a
Just (\ArgumentDescription
arg -> [Char]
"Ambigious value of the " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ArgumentDescription -> [Char]
argname_a ArgumentDescription
arg [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
". " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
msg [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"\nValue: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++
                                ShowS
quote [Char]
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 -> [Char] -> Argtester
forall a. ReadS a -> [Char] -> Argtester
readtester (ReadS Int
forall a. Read a => ReadS a
reads :: ReadS Int) [Char]
"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 -> [Char] -> Argtester
forall a. ReadS a -> [Char] -> Argtester
readtester ((((Int, [Char]) -> Bool) -> [(Int, [Char])] -> [(Int, [Char])]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Int
a,[Char]
_) -> Int
a Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0) ([(Int, [Char])] -> [(Int, [Char])]) -> 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)
                                   [Char]
"Non-negative integer expected." )


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



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

-- complete generation of argument description
prop_final :: ArgumentProperty
prop_final :: ArgumentProperty
prop_final = (ArgumentDescription -> ArgumentDescription) -> ArgumentProperty
ArgumentProperty
   (\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 [Char]
argdesc_argargname ArgumentDescription
desc Maybe [Char] -> Maybe [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe [Char]
forall a. Maybe a
Nothing
              then [Char] -> ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> ()) -> [Char] -> ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Bug in description of " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ArgumentDescription -> [Char]
argname_a ArgumentDescription
desc [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
": 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 [Char]
argdesc_argargname ArgumentDescription
desc Maybe [Char] -> Maybe [Char] -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe [Char]
forall a. Maybe a
Nothing
                      then [Char] -> ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> ()) -> [Char] -> ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Bug in description of " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ArgumentDescription -> [Char]
argname_a ArgumentDescription
desc
                           [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
": 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 [Char]
argdesc_description = [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char] -> Maybe [Char] -> [Char]
forall a. a -> Maybe a -> a
fromMaybe [Char]
"" (ArgumentDescription -> Maybe [Char]
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 [ArgumentProperty]
propl =
   ((ArgumentDescription -> ArgumentDescription)
 -> (ArgumentDescription -> ArgumentDescription)
 -> ArgumentDescription
 -> ArgumentDescription)
-> (ArgumentDescription -> ArgumentDescription)
-> [ArgumentDescription -> ArgumentDescription]
-> ArgumentDescription
-> ArgumentDescription
forall a b. (a -> b -> b) -> b -> [a] -> b
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 :: [Char]
-> ArgOrder ArgOcc
-> [[Char]]
-> [ArgumentDescription]
-> Either ArgError Arguments
getargs0 [Char]
header ArgOrder ArgOcc
ordering [[Char]]
cmdlargs [ArgumentDescription]
descs =
   let (  [ArgumentDescription]
descs_direct     -- direct arguments (without argument name)
        , [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 :: forall a. Eq a => [a] -> Maybe a
nonunique (a
a:a
b:[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 [a]
_       = Maybe a
forall a. Maybe a
Nothing

       test_unique :: (Show a, Ord a) => (ArgumentDescription -> [a]) -> String -> b -> b
       test_unique :: forall a b.
(Show a, Ord a) =>
(ArgumentDescription -> [a]) -> [Char] -> b -> b
test_unique ArgumentDescription -> [a]
extr [Char]
what 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 a
y -> [Char] -> b
forall a. HasCallStack => [Char] -> a
error ([Char]
"Bug: Several occurences of " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
what [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall a. Show a => a -> [Char]
show a
y [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++
                               [Char]
" in command line argument specifications")
              Maybe a
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 ArgumentDescription
desc =
          [Char] -> [[Char]] -> ArgDescr ArgOcc -> [Char] -> OptDescr ArgOcc
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option (ArgumentDescription -> [Char]
argdesc_short_args ArgumentDescription
desc)
                 (ArgumentDescription -> [[Char]]
argdesc_long_args ArgumentDescription
desc)
                 (case ArgumentDescription -> ArgumentValueSpec
argdesc_argarg ArgumentDescription
desc of
                     ArgumentValueSpec
ArgumentValue_none      -> ArgOcc -> ArgDescr ArgOcc
forall a. a -> ArgDescr a
NoArg  (ArgumentDescription
desc, Maybe [Char]
forall a. Maybe a
Nothing)
                     ArgumentValueSpec
ArgumentValue_required     -> ([Char] -> ArgOcc) -> [Char] -> ArgDescr ArgOcc
forall a. ([Char] -> a) -> [Char] -> ArgDescr a
ReqArg (\[Char]
arg -> (ArgumentDescription
desc, [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
arg))
                                              (Maybe [Char] -> [Char]
forall a. HasCallStack => Maybe a -> a
fromJust (ArgumentDescription -> Maybe [Char]
argdesc_argargname ArgumentDescription
desc))
                     ArgumentValueSpec
ArgumentValue_optional     -> (Maybe [Char] -> ArgOcc) -> [Char] -> ArgDescr ArgOcc
forall a. (Maybe [Char] -> a) -> [Char] -> ArgDescr a
OptArg (\Maybe [Char]
arg -> (ArgumentDescription
desc, Maybe [Char]
arg))
                                              (Maybe [Char] -> [Char]
forall a. HasCallStack => Maybe a -> a
fromJust (ArgumentDescription -> Maybe [Char]
argdesc_argargname ArgumentDescription
desc))
                 )
                 (Maybe [Char] -> [Char]
forall a. HasCallStack => Maybe a -> a
fromJust (ArgumentDescription -> Maybe [Char]
argdesc_description ArgumentDescription
desc))

       -- Postprocessing after successful call to getOpt
       getopt_post :: [ArgOcc] -> [String] -> Either ArgError Arguments
       getopt_post :: [ArgOcc] -> [[Char]] -> Either ArgError Arguments
getopt_post [ArgOcc]
pars{-getOpt recognized arguments-} [[Char]]
rest{-direct arguments-} =
          case ([[Char]]
rest, [ArgumentDescription]
descs_direct) of
             ([],[])  ->
                -- no direct arguments allowed and none provided
                [ArgOcc] -> Either ArgError Arguments
getopt_post' [ArgOcc]
pars
             ([[Char]]
r, [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 [Char]] -> [ArgOcc]
forall a b. [a] -> [b] -> [(a, b)]
zip (ArgumentDescription -> [ArgumentDescription]
forall a. a -> [a]
repeat ArgumentDescription
d) (([Char] -> Maybe [Char]) -> [[Char]] -> [Maybe [Char]]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [[Char]]
r))
             (([Char]
x:[[Char]]
xs), []) ->
                -- direct arguments provided, but not allowed
                ArgError -> Either ArgError Arguments
forall a b. a -> Either a b
Left ([Char] -> [Char] -> ArgError
ArgError [Char]
"Surplus arguments."
                               ([ArgumentDescription] -> [Char]
make_usage_info1 [ArgumentDescription]
descs)
                     )
             ([[Char]], [ArgumentDescription])
_ ->
                -- several descriptions for direct arguments
                [Char] -> Either ArgError Arguments
forall a. HasCallStack => [Char] -> a
error [Char]
"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 [Char]])]
-> [(ArgumentDescription, [Maybe [Char]])]
add (ArgumentDescription
a,Maybe [Char]
str) []        = [(ArgumentDescription
a,[Maybe [Char]
str])]
       add (ArgumentDescription
b,Maybe [Char]
str) ((ArgumentDescription
a,[Maybe [Char]]
l):[(ArgumentDescription, [Maybe [Char]])]
r) =
          if ArgumentDescription -> ArgumentDescription -> Bool
same_arg ArgumentDescription
a ArgumentDescription
b then (ArgumentDescription
a,Maybe [Char]
strMaybe [Char] -> [Maybe [Char]] -> [Maybe [Char]]
forall a. a -> [a] -> [a]
:[Maybe [Char]]
l) (ArgumentDescription, [Maybe [Char]])
-> [(ArgumentDescription, [Maybe [Char]])]
-> [(ArgumentDescription, [Maybe [Char]])]
forall a. a -> [a] -> [a]
: [(ArgumentDescription, [Maybe [Char]])]
r
                          else (ArgumentDescription
a,[Maybe [Char]]
l) (ArgumentDescription, [Maybe [Char]])
-> [(ArgumentDescription, [Maybe [Char]])]
-> [(ArgumentDescription, [Maybe [Char]])]
forall a. a -> [a] -> [a]
: ArgOcc
-> [(ArgumentDescription, [Maybe [Char]])]
-> [(ArgumentDescription, [Maybe [Char]])]
add (ArgumentDescription
b,Maybe [Char]
str) [(ArgumentDescription, [Maybe [Char]])]
r

       getopt_post' :: [ArgOcc] -> Either ArgError Arguments
       getopt_post' :: [ArgOcc] -> Either ArgError Arguments
getopt_post' [ArgOcc]
pars{-all arguments-} =
          let pars' :: [(ArgumentDescription, [Maybe [Char]])]
pars' = (ArgOcc
 -> [(ArgumentDescription, [Maybe [Char]])]
 -> [(ArgumentDescription, [Maybe [Char]])])
-> [(ArgumentDescription, [Maybe [Char]])]
-> [ArgOcc]
-> [(ArgumentDescription, [Maybe [Char]])]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ArgOcc
-> [(ArgumentDescription, [Maybe [Char]])]
-> [(ArgumentDescription, [Maybe [Char]])]
add ((ArgumentDescription -> (ArgumentDescription, [Maybe [Char]]))
-> [ArgumentDescription] -> [(ArgumentDescription, [Maybe [Char]])]
forall a b. (a -> b) -> [a] -> [b]
map (\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 [Char]])] -> Maybe ArgError
check_num [] = Maybe ArgError
forall a. Maybe a
Nothing
              check_num ((ArgumentDescription
desc,[Maybe [Char]]
args):[(ArgumentDescription, [Maybe [Char]])]
rest) =
                 let (Int
min,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 [Char]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Maybe [Char]]
args
                     wrong_number_msg :: [Char]
wrong_number_msg =
                        (if ArgumentDescription -> Bool
is_direct ArgumentDescription
desc then ([Char], [Char]) -> [Char]
forall a b. (a, b) -> a
fst else ([Char], [Char]) -> [Char]
forall a b. (a, b) -> b
snd) (([Char], [Char]) -> [Char]) -> ([Char], [Char]) -> [Char]
forall a b. (a -> b) -> a -> b
$
                        if Int
number Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& Int
min Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then
                           ( [Char]
"Missing argument."
                           , [Char]
"Missing " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ArgumentDescription -> [Char]
argname_a ArgumentDescription
desc [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"."
                           )
                        else if Int
number Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
min then
                           ( [Char]
"Too few arguments. " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
min [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" required."
                           , [Char]
"Too few instances of " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ArgumentDescription -> [Char]
argname_a ArgumentDescription
desc [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
". "[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
min [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" 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
== Int
1 then
                           ( [Char]
"Only one argument may be specified."
                           , [Char]
"Repeated " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ArgumentDescription -> [Char]
argname_a ArgumentDescription
desc [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"."
                           )
                        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
                           ( [Char]
"Too many arguments."
                           , [Char]
"Too many instances of " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ArgumentDescription -> [Char]
argname_a ArgumentDescription
desc [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"."
                           )
                        else [Char] -> ([Char], [Char])
forall a. HasCallStack => [Char] -> a
error [Char]
"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 [Char]])] -> Maybe ArgError
check_num [(ArgumentDescription, [Maybe [Char]])]
rest
                        else ArgError -> Maybe ArgError
forall a. a -> Maybe a
Just ([Char] -> [Char] -> ArgError
ArgError [Char]
wrong_number_msg ([ArgumentDescription] -> [Char]
make_usage_info1 [ArgumentDescription]
descs))

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

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

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

    in Either ArgError Arguments
args

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


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

maybe_head :: [a] -> Maybe a
maybe_head :: forall a. [a] -> Maybe a
maybe_head [] = Maybe a
forall a. Maybe a
Nothing
maybe_head [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 Arguments
args ArgumentDescription
desc =
   ArgumentDescription -> Bool -> [Char] -> Bool -> Bool
forall b. ArgumentDescription -> Bool -> [Char] -> 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 (Int
0,Int
1))
             [Char]
"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 [Char]]
argvalues Arguments
args ArgumentDescription
desc of
      []         -> Bool
False
      [Maybe [Char]
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 Arguments
args ArgumentDescription
desc =
   [Maybe [Char]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Arguments -> ArgumentDescription -> [Maybe [Char]]
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 [Char]]
args_opt Arguments
args ArgumentDescription
desc =
   ArgumentDescription
-> Bool -> [Char] -> [Maybe [Char]] -> [Maybe [Char]]
forall b. ArgumentDescription -> Bool -> [Char] -> 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
/= Int
1)
             [Char]
"Bug: Querying argument which doesn't take an optional value, or may not occur several times, \
             \with args_opt."
   ([Maybe [Char]] -> [Maybe [Char]])
-> [Maybe [Char]] -> [Maybe [Char]]
forall a b. (a -> b) -> a -> b
$ Arguments -> ArgumentDescription -> [Maybe [Char]]
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 -> [[Char]]
args_req Arguments
args ArgumentDescription
desc =
   ArgumentDescription -> Bool -> [Char] -> [[Char]] -> [[Char]]
forall b. ArgumentDescription -> Bool -> [Char] -> 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
/= Int
1)
             [Char]
"Bug: Querying argument which doesn't require a value, or may not occur several times, with \
             \args_req." ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$
   (Maybe [Char] -> [Char]) -> [Maybe [Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Maybe [Char] -> [Char]
forall a. HasCallStack => Maybe a -> a
fromJust (Arguments -> ArgumentDescription -> [Maybe [Char]]
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 [Char]
reqarg_opt Arguments
args ArgumentDescription
desc =
   ArgumentDescription
-> Bool -> [Char] -> Maybe [Char] -> Maybe [Char]
forall b. ArgumentDescription -> Bool -> [Char] -> 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 (Int
1,Int
1))
             [Char]
"Bug: Querying argument which doesn't take an optional value, or which must not occur exactly \
             \once, with reqarg_opt." (Maybe [Char] -> Maybe [Char]) -> Maybe [Char] -> Maybe [Char]
forall a b. (a -> b) -> a -> b
$
   [Maybe [Char]] -> Maybe [Char]
forall a. HasCallStack => [a] -> a
head (Arguments -> ArgumentDescription -> [Maybe [Char]]
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 -> [Char]
reqarg_req Arguments
args ArgumentDescription
desc =
   ArgumentDescription -> Bool -> [Char] -> ShowS
forall b. ArgumentDescription -> Bool -> [Char] -> 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 (Int
1,Int
1))
             [Char]
"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 [Char] -> [Char]
forall a. HasCallStack => Maybe a -> a
fromJust ([Maybe [Char]] -> Maybe [Char]
forall a. HasCallStack => [a] -> a
head (Arguments -> ArgumentDescription -> [Maybe [Char]]
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 [Char])
optarg_opt Arguments
args ArgumentDescription
desc =
   ArgumentDescription
-> Bool -> [Char] -> Maybe (Maybe [Char]) -> Maybe (Maybe [Char])
forall b. ArgumentDescription -> Bool -> [Char] -> 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)
             [Char]
"Bug: Querying argument with non-optional value with optarg_opt." (Maybe (Maybe [Char]) -> Maybe (Maybe [Char]))
-> Maybe (Maybe [Char]) -> Maybe (Maybe [Char])
forall a b. (a -> b) -> a -> b
$
   ArgumentDescription
-> Bool -> [Char] -> Maybe (Maybe [Char]) -> Maybe (Maybe [Char])
forall b. ArgumentDescription -> Bool -> [Char] -> 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
== Int
0)
             [Char]
"Bug: Querying argument which isn't optional with optarg_opt." (Maybe (Maybe [Char]) -> Maybe (Maybe [Char]))
-> Maybe (Maybe [Char]) -> Maybe (Maybe [Char])
forall a b. (a -> b) -> a -> b
$
   ArgumentDescription
-> Bool -> [Char] -> Maybe (Maybe [Char]) -> Maybe (Maybe [Char])
forall b. ArgumentDescription -> Bool -> [Char] -> 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
== Int
1)
             [Char]
"Bug: Querying argument which may occur several times optarg_opt." (Maybe (Maybe [Char]) -> Maybe (Maybe [Char]))
-> Maybe (Maybe [Char]) -> Maybe (Maybe [Char])
forall a b. (a -> b) -> a -> b
$
   [Maybe [Char]] -> Maybe (Maybe [Char])
forall a. [a] -> Maybe a
maybe_head (Arguments -> ArgumentDescription -> [Maybe [Char]]
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 [Char]
optarg_req Arguments
args ArgumentDescription
desc =
   ArgumentDescription
-> Bool -> [Char] -> Maybe [Char] -> Maybe [Char]
forall b. ArgumentDescription -> Bool -> [Char] -> 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)
             [Char]
"Bug: Querying argument with non-required value with optarg_req."
   (Maybe [Char] -> Maybe [Char]) -> Maybe [Char] -> Maybe [Char]
forall a b. (a -> b) -> a -> b
$ ArgumentDescription
-> Bool -> [Char] -> Maybe [Char] -> Maybe [Char]
forall b. ArgumentDescription -> Bool -> [Char] -> 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
== Int
0)
               [Char]
"Bug: Querying argument which isn't optional with optarg_req."
   (Maybe [Char] -> Maybe [Char]) -> Maybe [Char] -> Maybe [Char]
forall a b. (a -> b) -> a -> b
$ ArgumentDescription
-> Bool -> [Char] -> Maybe [Char] -> Maybe [Char]
forall b. ArgumentDescription -> Bool -> [Char] -> 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
== Int
1)
               [Char]
"Bug: Querying argument which may occur several times optarg_req."
   (Maybe [Char] -> Maybe [Char]) -> Maybe [Char] -> Maybe [Char]
forall a b. (a -> b) -> a -> b
$ (Maybe [Char] -> [Char]) -> Maybe (Maybe [Char]) -> Maybe [Char]
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe [Char] -> [Char]
forall a. HasCallStack => Maybe a -> a
fromJust ([Maybe [Char]] -> Maybe (Maybe [Char])
forall a. [a] -> Maybe a
maybe_head (Arguments -> ArgumentDescription -> [Maybe [Char]]
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 [ArgumentDescription]
descs args :: Arguments
args@(Arguments ([(ArgumentDescription, [Maybe [Char]])], [Char])
argl) =
   (ArgumentDescription -> IO ()) -> [ArgumentDescription] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\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
/= Int
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                [Char] -> [ArgumentDescription] -> IO ()
forall a. [Char] -> [ArgumentDescription] -> a
argerror_ui (ShowS
up1 (ArgumentDescription -> [Char]
argname_a ArgumentDescription
desc) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" 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 [ArgumentDescription]
descs args :: Arguments
args@(Arguments ([(ArgumentDescription, [Maybe [Char]])], [Char])
argl) =
   (ArgumentDescription -> IO ()) -> [ArgumentDescription] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\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
== Int
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                [Char] -> [ArgumentDescription] -> IO ()
forall a. [Char] -> [ArgumentDescription] -> a
argerror_ui ([Char]
"Missing " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ArgumentDescription -> [Char]
argname_a ArgumentDescription
desc [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"\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 [ArgumentDescription]
descs args :: Arguments
args@(Arguments ([(ArgumentDescription, [Maybe [Char]])], [Char])
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
/= Int
1) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      [Char] -> [ArgumentDescription] -> IO ()
forall a. [Char] -> [ArgumentDescription] -> a
argerror_ui ([Char]
"Exactly one of the following arguments must be present.\n"
                [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
intersperse [Char]
", " ((ArgumentDescription -> [Char])
-> [ArgumentDescription] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ArgumentDescription -> [Char]
argname [ArgumentDescription]
descs)) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"\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 [ArgumentDescription]
descs args :: Arguments
args@(Arguments ([(ArgumentDescription, [Maybe [Char]])], [Char])
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
> Int
1) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      [Char] -> [ArgumentDescription] -> IO ()
forall a. [Char] -> [ArgumentDescription] -> a
argerror_ui ([Char]
"Only one of the following arguments may be present.\n"
                   [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
intersperse [Char]
", " ((ArgumentDescription -> [Char])
-> [ArgumentDescription] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ArgumentDescription -> [Char]
argname [ArgumentDescription]
descs)) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"\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 [ArgumentDescription]
descs args :: Arguments
args@(Arguments ([(ArgumentDescription, [Maybe [Char]])], [Char])
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
== Int
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      [Char] -> [ArgumentDescription] -> IO ()
forall a. [Char] -> [ArgumentDescription] -> a
argerror_ui ([Char]
"One of the following arguments must be present.\n"
                   [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
intersperse [Char]
", " ((ArgumentDescription -> [Char])
-> [ArgumentDescription] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ArgumentDescription -> [Char]
argname [ArgumentDescription]
descs)) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"\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 ArgumentDescription
desc [ArgumentDescription]
descs args :: Arguments
args@(Arguments ([(ArgumentDescription, [Maybe [Char]])], [Char])
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
> Int
1) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      [Char] -> [ArgumentDescription] -> IO ()
forall a. [Char] -> [ArgumentDescription] -> a
argerror_ui ([Char]
"When " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ArgumentDescription -> [Char]
argname ArgumentDescription
desc [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" is present, none of the following arguments may be present.\n"
                   [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
intersperse [Char]
", " ((ArgumentDescription -> [Char])
-> [ArgumentDescription] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ArgumentDescription -> [Char]
argname [ArgumentDescription]
descs)) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"\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 [ArgumentDescription]
descs Arguments
args =
   [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((ArgumentDescription -> Int) -> [ArgumentDescription] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\ArgumentDescription
desc -> if Arguments -> ArgumentDescription -> Int
arg_times Arguments
args ArgumentDescription
desc Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Int
0 else Int
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 Arguments
args ArgumentDescription
desc =
   [ArgumentDescription] -> Arguments -> Int
occuring [ArgumentDescription
desc] Arguments
args Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
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 -> [Char]
usage_info (Arguments ([(ArgumentDescription, [Maybe [Char]])]
l, [Char]
header)) =
   [[Char]] -> [Char]
unlines (Int -> [Char] -> [[Char]]
wrap Int
80 [Char]
header) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++
   [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
intersperse [Char]
"\n" ([ArgumentDescription] -> Int -> Int -> Int -> Int -> [[Char]]
make_usage_info (((ArgumentDescription, [Maybe [Char]]) -> ArgumentDescription)
-> [(ArgumentDescription, [Maybe [Char]])] -> [ArgumentDescription]
forall a b. (a -> b) -> [a] -> [b]
map (ArgumentDescription, [Maybe [Char]]) -> ArgumentDescription
forall a b. (a, b) -> a
fst [(ArgumentDescription, [Maybe [Char]])]
l) Int
0 Int
10 Int
30 Int
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 :: [Char] -> [ArgumentDescription] -> Arguments
unsafe_getargs [Char]
header [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
$ [Char] -> [ArgumentDescription] -> IO Arguments
getargs [Char]
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 :: [Char] -> [ArgumentDescription] -> Arguments
unsafe_getargs_ordered [Char]
header [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
$ [Char] -> [ArgumentDescription] -> IO Arguments
getargs_ordered [Char]
header [ArgumentDescription]
descs



make_usage_info1 :: [ArgumentDescription] -> String
make_usage_info1 :: [ArgumentDescription] -> [Char]
make_usage_info1 [ArgumentDescription]
argdescs =
   [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
intersperse [Char]
"\n" ([ArgumentDescription] -> Int -> Int -> Int -> Int -> [[Char]]
make_usage_info [ArgumentDescription]
argdescs Int
0 Int
10 Int
30 Int
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 -> [[Char]]
make_usage_info [ArgumentDescription]
descs Int
colsleft Int
colsshort Int
colslong 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
+ Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
colslong Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
width
       then [Char] -> [[Char]]
forall a. HasCallStack => [Char] -> a
error ([Char] -> [[Char]]) -> [Char] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ [Char]
"make_usage_info: colsleft, colsshort, and colslong arguments \
                    \are too large for the specified width argument.\n\
                    \colsleft  = " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
colsleft [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"  \n\
                    \colsshort = " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
colsshort [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"  \n\
                    \colslong  = " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
colslong [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"  \n\
                    \width     = " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
width
       else
          ([[Char]] -> [Char]) -> [[[Char]]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map [[Char]] -> [Char]
unlines ([[([Char], [Char], [Char])]] -> [[[Char]]]
verbinden ([ArgumentDescription] -> [[([Char], [Char], [Char])]]
zll' ((ArgumentDescription -> Bool)
-> [ArgumentDescription] -> [ArgumentDescription]
forall a. (a -> Bool) -> [a] -> [a]
filter (\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 -> [[Char]]
beschr ArgumentDescription
desc = Int -> [Char] -> [[Char]]
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
- Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
gesamtbr_lang Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2)
                             ([Char] -> Maybe [Char] -> [Char]
forall a. a -> Maybe a -> a
fromMaybe [Char]
"" (ArgumentDescription -> Maybe [Char]
argdesc_description ArgumentDescription
desc))

          -- Render an argument description.
          auff1 :: ArgumentDescription 
                -> ([String], [String], [String])
          auff1 :: ArgumentDescription -> ([[Char]], [[Char]], [[Char]])
auff1 ArgumentDescription
desc = [[Char]] -> [[Char]] -> [[Char]] -> ([[Char]], [[Char]], [[Char]])
auff (ArgumentDescription -> [[Char]]
kurzname ArgumentDescription
desc)
                            (ArgumentDescription -> [[Char]]
langname ArgumentDescription
desc)
                            (ArgumentDescription -> [[Char]]
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 :: ([[Char]], [[Char]], [[Char]]) -> [([Char], [Char], [Char])]
zus ([[Char]]
as, [[Char]]
bs, [[Char]]
cs) = [[Char]] -> [[Char]] -> [[Char]] -> [([Char], [Char], [Char])]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [[Char]]
as [[Char]]
bs [[Char]]
cs

          -- Die für die Kurzform einses Arguments benötigte Zahl von Spalten
          kurzbr :: ArgumentDescription -> Int
          kurzbr :: ArgumentDescription -> Int
kurzbr ArgumentDescription
desc =
             (Int -> Int -> Int) -> Int -> [Int] -> Int
forall a b. (a -> b -> b) -> b -> [a] -> b
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 Int
0 (([Char] -> Int) -> [[Char]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (ArgumentDescription -> [[Char]]
kurzname ArgumentDescription
desc))

          -- Die für die Langform einses Arguments benötigte Zahl von Spalten
          langbr :: ArgumentDescription -> Int
          langbr :: ArgumentDescription -> Int
langbr ArgumentDescription
desc =
             (Int -> Int -> Int) -> Int -> [Int] -> Int
forall a b. (a -> b -> b) -> b -> [a] -> b
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 Int
0 (([Char] -> Int) -> [[Char]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (ArgumentDescription -> [[Char]]
langname ArgumentDescription
desc))

          -- Breite der Kurzform, über alle Argumente hinweg
          gesamtbr_kurz :: Int
gesamtbr_kurz =
             (Int -> Int -> Int) -> Int -> [Int] -> Int
forall a b. (a -> b -> b) -> b -> [a] -> b
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 Int
0 ((ArgumentDescription -> Int) -> [ArgumentDescription] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\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 a b. (a -> b -> b) -> b -> [a] -> b
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 Int
0 ((ArgumentDescription -> Int) -> [ArgumentDescription] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\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
- Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
gesamtbr_lang Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2

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

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

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

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

          -- Die Langform des angegebenen Arguments. In Zeilen heruntergebrochen,
          -- wenn die Breite colslong überschritten wird
          langname :: ArgumentDescription -> [String]
          langname :: ArgumentDescription -> [[Char]]
langname ArgumentDescription
desc =
             Int -> [Char] -> [[Char]]
wrap Int
colslong (ArgumentDescription -> [Char]
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 Int
br [Char]
txt =
             [Char]
txt [Char] -> 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
- [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
txt) (Char -> [Char]
forall a. a -> [a]
repeat Char
' ')


          -- 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 :: [[Char]] -> [[Char]] -> [[Char]] -> ([[Char]], [[Char]], [[Char]])
auff [[Char]]
a [[Char]]
b [[Char]]
c =
             ([[Char]] -> [[Char]]
forall a. [a] -> [a]
reverse [[Char]]
x, [[Char]] -> [[Char]]
forall a. [a] -> [a]
reverse [[Char]]
y, [[Char]] -> [[Char]]
forall a. [a] -> [a]
reverse [[Char]]
z)

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

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

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

                auff' [[Char]]
a [[Char]]
b [[Char]]
c [[Char]]
a1 [[Char]]
b1 [[Char]]
c1 =
                   [[Char]]
-> [[Char]]
-> [[Char]]
-> [[Char]]
-> [[Char]]
-> [[Char]]
-> ([[Char]], [[Char]], [[Char]])
auff' (if [[Char]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Char]]
a then [] else [[Char]] -> [[Char]]
forall a. HasCallStack => [a] -> [a]
tail [[Char]]
a)
                         (if [[Char]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Char]]
b then [] else [[Char]] -> [[Char]]
forall a. HasCallStack => [a] -> [a]
tail [[Char]]
b)
                         (if [[Char]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Char]]
c then [] else [[Char]] -> [[Char]]
forall a. HasCallStack => [a] -> [a]
tail [[Char]]
c)
                         ((if [[Char]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Char]]
a then [Char]
"" else [[Char]] -> [Char]
forall a. HasCallStack => [a] -> a
head [[Char]]
a) [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [[Char]]
a1)
                         ((if [[Char]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Char]]
b then [Char]
"" else [[Char]] -> [Char]
forall a. HasCallStack => [a] -> a
head [[Char]]
b) [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [[Char]]
b1)
                         ((if [[Char]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Char]]
c then [Char]
"" else [[Char]] -> [Char]
forall a. HasCallStack => [a] -> a
head [[Char]]
c) [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [[Char]]
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 -> [Char] -> [ArgumentDescription] -> IO ()
print_usage_info Handle
h [Char]
header [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 Int
w  -> Int
w
              Maybe Int
Nothing -> Int
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
< Int
12
      then Handle -> [Char] -> IO ()
hPutStr Handle
h [Char]
"Terminal too narrow"

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

              -- Print the argument descriptions.
              ([Char] -> IO ()) -> [[Char]] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Handle -> [Char] -> IO ()
hPutStr Handle
h)
                    ([ArgumentDescription] -> Int -> Int -> Int -> Int -> [[Char]]
make_usage_info [ArgumentDescription]
descs
                                     Int
0
                                     (Int
w Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
5)
                                     (Int
w Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
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 -> [Char] -> [[Char]]
wrap Int
breite [] = []
wrap Int
breite [Char]
txt =
   [ [Char]
zl | [Char]
txtzl <- [Char] -> [[Char]]
lines [Char]
txt,
          [Char]
zl <- Int -> [Char] -> [[Char]]
wrap' Int
breite [Char]
txtzl
   ]
   where
      wrap' :: Int -> String -> [String]
      wrap' :: Int -> [Char] -> [[Char]]
wrap' Int
breite [] = [[Char]
""]
      wrap' Int
breite [Char]
txt =
         Int -> [Char] -> [[Char]]
wrap'' Int
breite ((Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace [Char]
txt)

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

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

            ([Char]
txt_anf, [Char]
txt_anf_rest) =
               [Char] -> ([Char], [Char])
letzter_teil [Char]
txt_br

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

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