{-# LINE 1 "src/HsShellScript/Args.chs" #-}
module HsShellScript.Args (
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
, Arguments
, getargs
, getargs_ordered
, getargs'
, getargs_ordered'
, unsafe_getargs
, unsafe_getargs_ordered
, arg_switch
, arg_times
, args_opt
, args_req
, reqarg_opt
, reqarg_req
, optarg_opt
, optarg_req
, arg_occurs
, args_none
, args_all
, args_one
, args_at_most_one
, args_at_least_one
, arg_conflicts
, ArgError (..)
, usage_info
, make_usage_info
, print_usage_info
, argname
, argname_a
, argname_short
, argname_long
, wrap
) where
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
data ArgumentValueSpec = ArgumentValue_none
| ArgumentValue_required
| ArgumentValue_optional
deriving (ArgumentValueSpec -> ArgumentValueSpec -> Bool
(ArgumentValueSpec -> ArgumentValueSpec -> Bool)
-> (ArgumentValueSpec -> ArgumentValueSpec -> Bool)
-> Eq ArgumentValueSpec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ArgumentValueSpec -> ArgumentValueSpec -> Bool
$c/= :: ArgumentValueSpec -> ArgumentValueSpec -> Bool
== :: ArgumentValueSpec -> ArgumentValueSpec -> Bool
$c== :: ArgumentValueSpec -> ArgumentValueSpec -> Bool
Eq, Int -> ArgumentValueSpec -> ShowS
[ArgumentValueSpec] -> ShowS
ArgumentValueSpec -> String
(Int -> ArgumentValueSpec -> ShowS)
-> (ArgumentValueSpec -> String)
-> ([ArgumentValueSpec] -> ShowS)
-> Show ArgumentValueSpec
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ArgumentValueSpec] -> ShowS
$cshowList :: [ArgumentValueSpec] -> ShowS
show :: ArgumentValueSpec -> String
$cshow :: ArgumentValueSpec -> String
showsPrec :: Int -> ArgumentValueSpec -> ShowS
$cshowsPrec :: Int -> ArgumentValueSpec -> ShowS
Show, Eq ArgumentValueSpec
Eq ArgumentValueSpec =>
(ArgumentValueSpec -> ArgumentValueSpec -> Ordering)
-> (ArgumentValueSpec -> ArgumentValueSpec -> Bool)
-> (ArgumentValueSpec -> ArgumentValueSpec -> Bool)
-> (ArgumentValueSpec -> ArgumentValueSpec -> Bool)
-> (ArgumentValueSpec -> ArgumentValueSpec -> Bool)
-> (ArgumentValueSpec -> ArgumentValueSpec -> ArgumentValueSpec)
-> (ArgumentValueSpec -> ArgumentValueSpec -> ArgumentValueSpec)
-> Ord ArgumentValueSpec
ArgumentValueSpec -> ArgumentValueSpec -> Bool
ArgumentValueSpec -> ArgumentValueSpec -> Ordering
ArgumentValueSpec -> ArgumentValueSpec -> ArgumentValueSpec
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ArgumentValueSpec -> ArgumentValueSpec -> ArgumentValueSpec
$cmin :: ArgumentValueSpec -> ArgumentValueSpec -> ArgumentValueSpec
max :: ArgumentValueSpec -> ArgumentValueSpec -> ArgumentValueSpec
$cmax :: ArgumentValueSpec -> ArgumentValueSpec -> ArgumentValueSpec
>= :: ArgumentValueSpec -> ArgumentValueSpec -> Bool
$c>= :: ArgumentValueSpec -> ArgumentValueSpec -> Bool
> :: ArgumentValueSpec -> ArgumentValueSpec -> Bool
$c> :: ArgumentValueSpec -> ArgumentValueSpec -> Bool
<= :: ArgumentValueSpec -> ArgumentValueSpec -> Bool
$c<= :: ArgumentValueSpec -> ArgumentValueSpec -> Bool
< :: ArgumentValueSpec -> ArgumentValueSpec -> Bool
$c< :: ArgumentValueSpec -> ArgumentValueSpec -> Bool
compare :: ArgumentValueSpec -> ArgumentValueSpec -> Ordering
$ccompare :: ArgumentValueSpec -> ArgumentValueSpec -> Ordering
$cp1Ord :: Eq ArgumentValueSpec
Ord)
type Argtester = String
-> Maybe (ArgumentDescription
-> String
)
data ArgumentDescription = ArgumentDescription {
ArgumentDescription -> String
argdesc_short_args :: [Char],
ArgumentDescription -> [String]
argdesc_long_args :: [String],
ArgumentDescription -> ArgumentValueSpec
argdesc_argarg :: ArgumentValueSpec,
ArgumentDescription -> Maybe (Int, Int)
argdesc_times :: Maybe (Int,Int),
ArgumentDescription -> Maybe String
argdesc_argargname :: Maybe String,
ArgumentDescription -> Maybe String
argdesc_description :: Maybe String,
ArgumentDescription -> Maybe Argtester
argdesc_argarg_tester :: Maybe Argtester
}
ad_tup :: ArgumentDescription
-> (String, [String], ArgumentValueSpec, Maybe (Int, Int),
Maybe String, Maybe String)
ad_tup ad :: ArgumentDescription
ad =
(ArgumentDescription -> String
argdesc_short_args ArgumentDescription
ad, ArgumentDescription -> [String]
argdesc_long_args ArgumentDescription
ad, ArgumentDescription -> ArgumentValueSpec
argdesc_argarg ArgumentDescription
ad, ArgumentDescription -> Maybe (Int, Int)
argdesc_times ArgumentDescription
ad,
ArgumentDescription -> Maybe String
argdesc_argargname ArgumentDescription
ad, ArgumentDescription -> Maybe String
argdesc_description ArgumentDescription
ad)
instance Eq ArgumentDescription where
d :: ArgumentDescription
d == :: ArgumentDescription -> ArgumentDescription -> Bool
== e :: ArgumentDescription
e = ArgumentDescription
-> (String, [String], ArgumentValueSpec, Maybe (Int, Int),
Maybe String, Maybe String)
ad_tup ArgumentDescription
d (String, [String], ArgumentValueSpec, Maybe (Int, Int),
Maybe String, Maybe String)
-> (String, [String], ArgumentValueSpec, Maybe (Int, Int),
Maybe String, Maybe String)
-> Bool
forall a. Eq a => a -> a -> Bool
== ArgumentDescription
-> (String, [String], ArgumentValueSpec, Maybe (Int, Int),
Maybe String, Maybe String)
ad_tup ArgumentDescription
e
instance Ord ArgumentDescription where
compare :: ArgumentDescription -> ArgumentDescription -> Ordering
compare d :: ArgumentDescription
d e :: ArgumentDescription
e = (String, [String], ArgumentValueSpec, Maybe (Int, Int),
Maybe String, Maybe String)
-> (String, [String], ArgumentValueSpec, Maybe (Int, Int),
Maybe String, Maybe String)
-> Ordering
forall a. Ord a => a -> a -> Ordering
compare (ArgumentDescription
-> (String, [String], ArgumentValueSpec, Maybe (Int, Int),
Maybe String, Maybe String)
ad_tup ArgumentDescription
d) (ArgumentDescription
-> (String, [String], ArgumentValueSpec, Maybe (Int, Int),
Maybe String, Maybe String)
ad_tup ArgumentDescription
e)
unlimited :: Int
unlimited = -1
same_arg :: ArgumentDescription -> ArgumentDescription -> Bool
same_arg :: ArgumentDescription -> ArgumentDescription -> Bool
same_arg arg1 :: ArgumentDescription
arg1 arg2 :: ArgumentDescription
arg2 =
case (ArgumentDescription -> String
argdesc_short_args ArgumentDescription
arg1, ArgumentDescription -> String
argdesc_short_args ArgumentDescription
arg2) of
(a :: Char
a:_, b :: Char
b:_) -> Char
a Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
b
([], []) -> case (ArgumentDescription -> [String]
argdesc_long_args ArgumentDescription
arg1, ArgumentDescription -> [String]
argdesc_long_args ArgumentDescription
arg2) of
([],_) -> Bool
forall a. a
unnamed
(_,[]) -> Bool
forall a. a
unnamed
(l1 :: [String]
l1,l2 :: [String]
l2) -> [String] -> String
forall a. [a] -> a
head [String]
l1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== [String] -> String
forall a. [a] -> a
head [String]
l2
_ -> Bool
False
where unnamed :: a
unnamed = String -> a
forall a. HasCallStack => String -> a
error "Bug in argument description: nameless, non-direct argument. \
\desc_short or desc_long must be specified."
newtype ArgumentProperty =
ArgumentProperty { ArgumentProperty -> ArgumentDescription -> ArgumentDescription
argumentproperty :: ArgumentDescription -> ArgumentDescription }
nulldesc :: ArgumentDescription
nulldesc :: ArgumentDescription
nulldesc =
ArgumentDescription :: String
-> [String]
-> ArgumentValueSpec
-> Maybe (Int, Int)
-> Maybe String
-> Maybe String
-> Maybe Argtester
-> ArgumentDescription
ArgumentDescription {
argdesc_short_args :: String
argdesc_short_args = [],
argdesc_long_args :: [String]
argdesc_long_args = [],
argdesc_argarg :: ArgumentValueSpec
argdesc_argarg = ArgumentValueSpec
ArgumentValue_none,
argdesc_times :: Maybe (Int, Int)
argdesc_times = Maybe (Int, Int)
forall a. Maybe a
Nothing,
argdesc_argargname :: Maybe String
argdesc_argargname = Maybe String
forall a. Maybe a
Nothing,
argdesc_description :: Maybe String
argdesc_description = Maybe String
forall a. Maybe a
Nothing,
argdesc_argarg_tester :: Maybe Argtester
argdesc_argarg_tester = Maybe Argtester
forall a. Maybe a
Nothing
}
times_default :: (Int, Int)
times_default = (0,1)
newtype Arguments =
Arguments ([ ( ArgumentDescription
, [Maybe String]
)],
String)
argvalues :: Arguments -> ArgumentDescription -> [Maybe String]
argvalues :: Arguments -> ArgumentDescription -> [Maybe String]
argvalues (Arguments (l :: [(ArgumentDescription, [Maybe String])]
l, header :: String
header)) desc :: ArgumentDescription
desc =
[(ArgumentDescription, [Maybe String])] -> [Maybe String]
forall p. [(ArgumentDescription, p)] -> p
argvalues' [(ArgumentDescription, [Maybe String])]
l
where
argvalues' :: [(ArgumentDescription, p)] -> p
argvalues' ((d :: ArgumentDescription
d,v :: p
v):r :: [(ArgumentDescription, p)]
r) = if ArgumentDescription -> ArgumentDescription -> Bool
same_arg ArgumentDescription
desc ArgumentDescription
d then p
v else [(ArgumentDescription, p)] -> p
argvalues' [(ArgumentDescription, p)]
r
argvalues' [] = String -> ArgumentDescription -> p
forall a. String -> ArgumentDescription -> a
abort "Bug using HsShellScript: Value of unknown argument queried \
\(add it to getarg's list)" ArgumentDescription
desc
type ArgOcc = (ArgumentDescription, Maybe String)
data ArgError = ArgError {
ArgError -> String
argerror_message :: String,
ArgError -> String
argerror_usageinfo :: String
}
deriving (Typeable)
argerror_ui :: String
-> [ArgumentDescription]
-> a
argerror_ui :: String -> [ArgumentDescription] -> a
argerror_ui mess :: String
mess descl :: [ArgumentDescription]
descl =
ArgError -> a
forall a e. Exception e => e -> a
throw (String -> String -> ArgError
ArgError String
mess ([ArgumentDescription] -> String
make_usage_info1 [ArgumentDescription]
descl))
instance Exception ArgError
instance Show ArgError where
show :: ArgError -> String
show argerror :: ArgError
argerror = ArgError -> String
argerror_message ArgError
argerror
is_direct :: ArgumentDescription
-> Bool
is_direct :: ArgumentDescription -> Bool
is_direct desc :: ArgumentDescription
desc =
ArgumentDescription -> String
argdesc_short_args ArgumentDescription
desc String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== [] Bool -> Bool -> Bool
&& ArgumentDescription -> [String]
argdesc_long_args ArgumentDescription
desc [String] -> [String] -> Bool
forall a. Eq a => a -> a -> Bool
== [""]
desc_short :: Char
-> ArgumentProperty
desc_short :: Char -> ArgumentProperty
desc_short c :: Char
c = (ArgumentDescription -> ArgumentDescription) -> ArgumentProperty
ArgumentProperty
(\desc :: ArgumentDescription
desc ->
if (Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (ArgumentDescription -> String
argdesc_short_args ArgumentDescription
desc))
then String -> ArgumentDescription -> ArgumentDescription
forall a. String -> ArgumentDescription -> a
abort ("Bug in HsShellScript argument description: Duplicate short argument " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char -> String
forall a. Show a => a -> String
show Char
c String -> ShowS
forall a. [a] -> [a] -> [a]
++ " specified") ArgumentDescription
desc
else if ("" String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ArgumentDescription -> [String]
argdesc_long_args ArgumentDescription
desc)
then String -> ArgumentDescription -> ArgumentDescription
forall a. String -> ArgumentDescription -> a
abort_conflict "" ArgumentDescription
desc
else ArgumentDescription
desc { argdesc_short_args :: String
argdesc_short_args = Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: ArgumentDescription -> String
argdesc_short_args ArgumentDescription
desc }
)
desc_long :: String
-> ArgumentProperty
desc_long :: String -> ArgumentProperty
desc_long str :: String
str = (ArgumentDescription -> ArgumentDescription) -> ArgumentProperty
ArgumentProperty
(\desc :: ArgumentDescription
desc ->
if (String
str String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (ArgumentDescription -> [String]
argdesc_long_args ArgumentDescription
desc))
then String -> ArgumentDescription -> ArgumentDescription
forall a. String -> ArgumentDescription -> a
abort ("Bug in HsShellScript argument description: Duplicate long argument " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
str String -> ShowS
forall a. [a] -> [a] -> [a]
++ " specified") ArgumentDescription
desc
else if ("" String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ArgumentDescription -> [String]
argdesc_long_args ArgumentDescription
desc)
then String -> ArgumentDescription -> ArgumentDescription
forall a. String -> ArgumentDescription -> a
abort_conflict "" ArgumentDescription
desc
else ArgumentDescription
desc { argdesc_long_args :: [String]
argdesc_long_args = String
str String -> [String] -> [String]
forall a. a -> [a] -> [a]
: ArgumentDescription -> [String]
argdesc_long_args ArgumentDescription
desc }
)
desc_direct :: ArgumentProperty
desc_direct :: ArgumentProperty
desc_direct = (ArgumentDescription -> ArgumentDescription) -> ArgumentProperty
ArgumentProperty
(\desc :: ArgumentDescription
desc ->
if ArgumentDescription -> [String]
argdesc_long_args ArgumentDescription
desc [String] -> [String] -> Bool
forall a. Eq a => a -> a -> Bool
== [] Bool -> Bool -> Bool
&& ArgumentDescription -> String
argdesc_short_args ArgumentDescription
desc String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== [] Bool -> Bool -> Bool
&& ArgumentDescription -> ArgumentValueSpec
argdesc_argarg ArgumentDescription
desc ArgumentValueSpec -> ArgumentValueSpec -> Bool
forall a. Eq a => a -> a -> Bool
== ArgumentValueSpec
ArgumentValue_none
then ArgumentDescription
desc { argdesc_long_args :: [String]
argdesc_long_args = [""]
, argdesc_argarg :: ArgumentValueSpec
argdesc_argarg = ArgumentValueSpec
ArgumentValue_required
, argdesc_argargname :: Maybe String
argdesc_argargname = String -> Maybe String
forall a. a -> Maybe a
Just ""
}
else String -> ArgumentDescription -> ArgumentDescription
forall a. String -> ArgumentDescription -> a
abort_conflict "desc_direct conflicts with desc_long, desc_short, desc_value_required \
\and desc_value_optional." ArgumentDescription
desc
)
desc_value_required :: ArgumentProperty
desc_value_required :: ArgumentProperty
desc_value_required = (ArgumentDescription -> ArgumentDescription) -> ArgumentProperty
ArgumentProperty
(\desc :: ArgumentDescription
desc ->
if ArgumentDescription -> ArgumentValueSpec
argdesc_argarg ArgumentDescription
desc ArgumentValueSpec -> ArgumentValueSpec -> Bool
forall a. Eq a => a -> a -> Bool
== ArgumentValueSpec
ArgumentValue_none
then ArgumentDescription
desc { argdesc_argarg :: ArgumentValueSpec
argdesc_argarg = ArgumentValueSpec
ArgumentValue_required }
else String -> ArgumentDescription -> ArgumentDescription
forall a. String -> ArgumentDescription -> a
abort_conflict "desc_value_required repeated or conflicting desc_value_optional" ArgumentDescription
desc
)
desc_value_optional :: ArgumentProperty
desc_value_optional :: ArgumentProperty
desc_value_optional = (ArgumentDescription -> ArgumentDescription) -> ArgumentProperty
ArgumentProperty
(\desc :: ArgumentDescription
desc ->
if ArgumentDescription -> ArgumentValueSpec
argdesc_argarg ArgumentDescription
desc ArgumentValueSpec -> ArgumentValueSpec -> Bool
forall a. Eq a => a -> a -> Bool
== ArgumentValueSpec
ArgumentValue_none
then ArgumentDescription
desc { argdesc_argarg :: ArgumentValueSpec
argdesc_argarg = ArgumentValueSpec
ArgumentValue_optional }
else String -> ArgumentDescription -> ArgumentDescription
forall a. String -> ArgumentDescription -> a
abort_conflict "desc_value_optional repeated or conflicting desc_value_required" ArgumentDescription
desc
)
desc_times :: Int
-> Int
-> ArgumentProperty
desc_times :: Int -> Int -> ArgumentProperty
desc_times n :: Int
n m :: Int
m = (ArgumentDescription -> ArgumentDescription) -> ArgumentProperty
ArgumentProperty
(\desc :: ArgumentDescription
desc ->
if ArgumentDescription -> Maybe (Int, Int)
argdesc_times ArgumentDescription
desc Maybe (Int, Int) -> Maybe (Int, Int) -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe (Int, Int)
forall a. Maybe a
Nothing
then ArgumentDescription
desc { argdesc_times :: Maybe (Int, Int)
argdesc_times = (Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just (Int
n,Int
m) }
else String -> ArgumentDescription -> ArgumentDescription
forall a. String -> ArgumentDescription -> a
abort_conflict "desc_times conflicting previous number of occurences specification" ArgumentDescription
desc
)
desc_once :: ArgumentProperty
desc_once :: ArgumentProperty
desc_once = Int -> Int -> ArgumentProperty
desc_times 1 1
desc_at_least_once :: ArgumentProperty
desc_at_least_once :: ArgumentProperty
desc_at_least_once = Int -> Int -> ArgumentProperty
desc_times 1 Int
unlimited
desc_at_most_once :: ArgumentProperty
desc_at_most_once :: ArgumentProperty
desc_at_most_once = Int -> Int -> ArgumentProperty
desc_times 0 1
desc_at_least :: Int
-> ArgumentProperty
desc_at_least :: Int -> ArgumentProperty
desc_at_least n :: Int
n = Int -> Int -> ArgumentProperty
desc_times Int
n Int
unlimited
desc_any_times :: ArgumentProperty
desc_any_times :: ArgumentProperty
desc_any_times = Int -> Int -> ArgumentProperty
desc_times 0 Int
unlimited
desc_at_most :: Int
-> ArgumentProperty
desc_at_most :: Int -> ArgumentProperty
desc_at_most n :: Int
n = Int -> Int -> ArgumentProperty
desc_times 0 Int
n
desc_argname :: String
-> ArgumentProperty
desc_argname :: String -> ArgumentProperty
desc_argname name :: String
name = (ArgumentDescription -> ArgumentDescription) -> ArgumentProperty
ArgumentProperty
(\desc :: ArgumentDescription
desc ->
if ArgumentDescription -> Maybe String
argdesc_argargname ArgumentDescription
desc Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe String
forall a. Maybe a
Nothing
then ArgumentDescription
desc { argdesc_argargname :: Maybe String
argdesc_argargname = String -> Maybe String
forall a. a -> Maybe a
Just String
name }
else String -> ArgumentDescription -> ArgumentDescription
forall a. String -> ArgumentDescription -> a
abort "Bug in HsShellScript argument description: Multiple names specified" ArgumentDescription
desc
)
desc_description :: String
-> ArgumentProperty
desc_description :: String -> ArgumentProperty
desc_description expl :: String
expl = (ArgumentDescription -> ArgumentDescription) -> ArgumentProperty
ArgumentProperty
(\desc :: ArgumentDescription
desc ->
if ArgumentDescription -> Maybe String
argdesc_description ArgumentDescription
desc Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe String
forall a. Maybe a
Nothing
then ArgumentDescription
desc { argdesc_description :: Maybe String
argdesc_description = String -> Maybe String
forall a. a -> Maybe a
Just String
expl }
else String -> ArgumentDescription -> ArgumentDescription
forall a. String -> ArgumentDescription -> a
abort "Bug in HsShellScript argument description: Multiple argument descriptions specified" ArgumentDescription
desc
)
desc_tester :: Argtester
-> ArgumentProperty
desc_tester :: Argtester -> ArgumentProperty
desc_tester t :: Argtester
t = (ArgumentDescription -> ArgumentDescription) -> ArgumentProperty
ArgumentProperty
(\desc :: ArgumentDescription
desc ->
case ArgumentDescription -> Maybe Argtester
argdesc_argarg_tester ArgumentDescription
desc of
Nothing -> ArgumentDescription
desc { argdesc_argarg_tester :: Maybe Argtester
argdesc_argarg_tester = Argtester -> Maybe Argtester
forall a. a -> Maybe a
Just Argtester
t }
Just _ -> String -> ArgumentDescription -> ArgumentDescription
forall a. String -> ArgumentDescription -> a
abort "Bug in HsShellScript argument description: Multiple argument value testers specified"
ArgumentDescription
desc
)
readtester :: ReadS a
-> String
-> Argtester
readtester :: ReadS a -> String -> Argtester
readtester reader :: ReadS a
reader msg :: String
msg val :: String
val =
case ((a, String) -> Bool) -> [(a, String)] -> [(a, String)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "") (String -> Bool) -> ((a, String) -> String) -> (a, String) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, String) -> String
forall a b. (a, b) -> b
snd) ([(a, String)] -> [(a, String)]) -> [(a, String)] -> [(a, String)]
forall a b. (a -> b) -> a -> b
$ ReadS a
reader String
val of
[(_,"")] -> Maybe (ArgumentDescription -> String)
forall a. Maybe a
Nothing
[] -> (ArgumentDescription -> String)
-> Maybe (ArgumentDescription -> String)
forall a. a -> Maybe a
Just (\arg :: ArgumentDescription
arg -> "Format error in the value of the " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ArgumentDescription -> String
argname_a ArgumentDescription
arg String -> ShowS
forall a. [a] -> [a] -> [a]
++ ". " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg String -> ShowS
forall a. [a] -> [a] -> [a]
++
"\nValue: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
quote String
val)
_ -> (ArgumentDescription -> String)
-> Maybe (ArgumentDescription -> String)
forall a. a -> Maybe a
Just (\arg :: ArgumentDescription
arg -> "Ambigious value of the " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ArgumentDescription -> String
argname_a ArgumentDescription
arg String -> ShowS
forall a. [a] -> [a] -> [a]
++ ". " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg String -> ShowS
forall a. [a] -> [a] -> [a]
++ "\nValue: " String -> ShowS
forall a. [a] -> [a] -> [a]
++
ShowS
quote String
val)
desc_integer :: ArgumentProperty
desc_integer :: ArgumentProperty
desc_integer = Argtester -> ArgumentProperty
desc_tester (ReadS Int -> String -> Argtester
forall a. ReadS a -> String -> Argtester
readtester (ReadS Int
forall a. Read a => ReadS a
reads :: ReadS Int) "Integer expected.")
desc_nonneg_integer :: ArgumentProperty
desc_nonneg_integer :: ArgumentProperty
desc_nonneg_integer = Argtester -> ArgumentProperty
desc_tester (ReadS Int -> String -> Argtester
forall a. ReadS a -> String -> Argtester
readtester ((((Int, String) -> Bool) -> [(Int, String)] -> [(Int, String)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(a :: Int
a,_) -> Int
a Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 0) ([(Int, String)] -> [(Int, String)]) -> ReadS Int -> ReadS Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReadS Int
forall a. Read a => ReadS a
reads) :: ReadS Int)
"Non-negative integer expected." )
abort_conflict :: String -> ArgumentDescription -> a
abort_conflict msg :: String
msg = String -> ArgumentDescription -> a
forall a. String -> ArgumentDescription -> a
abort ("Conflicting properties in argument description. " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg)
abort :: String -> ArgumentDescription -> a
abort msg :: String
msg desc :: ArgumentDescription
desc = String -> a
forall a. HasCallStack => String -> a
error (String
msg String -> ShowS
forall a. [a] -> [a] -> [a]
++ "\nargument (so far): " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ArgumentDescription -> String
argname ArgumentDescription
desc)
argname :: ArgumentDescription
-> String
argname :: ArgumentDescription -> String
argname desc :: ArgumentDescription
desc =
if (ArgumentDescription -> String
argdesc_short_args ArgumentDescription
desc, ArgumentDescription -> [String]
argdesc_long_args ArgumentDescription
desc) (String, [String]) -> (String, [String]) -> Bool
forall a. Eq a => a -> a -> Bool
== ([],[""]) then "(direct argument)"
else if (ArgumentDescription -> String
argdesc_short_args ArgumentDescription
desc, ArgumentDescription -> [String]
argdesc_long_args ArgumentDescription
desc) (String, [String]) -> (String, [String]) -> Bool
forall a. Eq a => a -> a -> Bool
== ([],[]) then "yet unnamed argument"
else [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse "/" ( (Char -> String) -> String -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\s :: Char
s -> "-"String -> ShowS
forall a. [a] -> [a] -> [a]
++[Char
s]) (ArgumentDescription -> String
argdesc_short_args ArgumentDescription
desc) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ("--" String -> ShowS
forall a. [a] -> [a] -> [a]
++) (ArgumentDescription -> [String]
argdesc_long_args ArgumentDescription
desc) ))
argname_a :: ArgumentDescription
-> String
argname_a :: ArgumentDescription -> String
argname_a desc :: ArgumentDescription
desc =
if (ArgumentDescription -> String
argdesc_short_args ArgumentDescription
desc, ArgumentDescription -> [String]
argdesc_long_args ArgumentDescription
desc) (String, [String]) -> (String, [String]) -> Bool
forall a. Eq a => a -> a -> Bool
== ([],[""]) then "direct argument"
else if (ArgumentDescription -> String
argdesc_short_args ArgumentDescription
desc, ArgumentDescription -> [String]
argdesc_long_args ArgumentDescription
desc) (String, [String]) -> (String, [String]) -> Bool
forall a. Eq a => a -> a -> Bool
== ([],[]) then "yet unnamed argument"
else "argument " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse "/" ( (Char -> String) -> String -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\s :: Char
s -> "-"String -> ShowS
forall a. [a] -> [a] -> [a]
++[Char
s]) (ArgumentDescription -> String
argdesc_short_args ArgumentDescription
desc) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ("--" String -> ShowS
forall a. [a] -> [a] -> [a]
++) (ArgumentDescription -> [String]
argdesc_long_args ArgumentDescription
desc) ))
argname_short :: ArgumentDescription
-> String
argname_short :: ArgumentDescription -> String
argname_short desc :: ArgumentDescription
desc =
if (ArgumentDescription -> String
argdesc_short_args ArgumentDescription
desc, ArgumentDescription -> [String]
argdesc_long_args ArgumentDescription
desc) (String, [String]) -> (String, [String]) -> Bool
forall a. Eq a => a -> a -> Bool
== ([],[""])
then ""
else if (ArgumentDescription -> String
argdesc_short_args ArgumentDescription
desc, ArgumentDescription -> [String]
argdesc_long_args ArgumentDescription
desc) (String, [String]) -> (String, [String]) -> Bool
forall a. Eq a => a -> a -> Bool
== ([],[])
then "yet unnamed argument"
else
case (ArgumentDescription -> String
argdesc_short_args ArgumentDescription
desc, ArgumentDescription -> Maybe String
argdesc_argargname ArgumentDescription
desc) of
([], _) -> ""
(sl :: String
sl, Just name :: String
name) -> [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse "/" ((Char -> String) -> String -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\s :: Char
s -> "-" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
s]) String
sl)) String -> ShowS
forall a. [a] -> [a] -> [a]
++ " " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name
(sl :: String
sl, Nothing) -> [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse "/" ((Char -> String) -> String -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\s :: Char
s -> "-" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
s]) String
sl))
argname_long :: ArgumentDescription
-> String
argname_long :: ArgumentDescription -> String
argname_long desc :: ArgumentDescription
desc =
if (ArgumentDescription -> String
argdesc_short_args ArgumentDescription
desc, ArgumentDescription -> [String]
argdesc_long_args ArgumentDescription
desc) (String, [String]) -> (String, [String]) -> Bool
forall a. Eq a => a -> a -> Bool
== ([],[""])
then ""
else if (ArgumentDescription -> String
argdesc_short_args ArgumentDescription
desc, ArgumentDescription -> [String]
argdesc_long_args ArgumentDescription
desc) (String, [String]) -> (String, [String]) -> Bool
forall a. Eq a => a -> a -> Bool
== ([],[])
then "yet unnamed argument"
else
case (ArgumentDescription -> [String]
argdesc_long_args ArgumentDescription
desc, ArgumentDescription -> Maybe String
argdesc_argargname ArgumentDescription
desc) of
([], _) -> ""
(sl :: [String]
sl, Just name :: String
name) -> [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse "/" (ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\s :: String
s -> "--" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s) [String]
sl)) String -> ShowS
forall a. [a] -> [a] -> [a]
++ " " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name
(sl :: [String]
sl, Nothing) -> [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse "/" (ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\s :: String
s -> "--" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s) [String]
sl))
up1 :: ShowS
up1 "" = ""
up1 (x :: Char
x:xs :: String
xs) = Char -> Char
toUpper Char
x Char -> ShowS
forall a. a -> [a] -> [a]
: String
xs
prop_final :: ArgumentProperty
prop_final :: ArgumentProperty
prop_final = (ArgumentDescription -> ArgumentDescription) -> ArgumentProperty
ArgumentProperty
(\desc :: ArgumentDescription
desc ->
() -> ArgumentDescription -> ArgumentDescription
forall a b. a -> b -> b
seq (if ArgumentDescription -> ArgumentValueSpec
argdesc_argarg ArgumentDescription
desc ArgumentValueSpec -> ArgumentValueSpec -> Bool
forall a. Eq a => a -> a -> Bool
/= ArgumentValueSpec
ArgumentValue_none Bool -> Bool -> Bool
&& ArgumentDescription -> Maybe String
argdesc_argargname ArgumentDescription
desc Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe String
forall a. Maybe a
Nothing
then String -> ()
forall a. HasCallStack => String -> a
error (String -> ()) -> String -> ()
forall a b. (a -> b) -> a -> b
$ "Bug in description of " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ArgumentDescription -> String
argname_a ArgumentDescription
desc String -> ShowS
forall a. [a] -> [a] -> [a]
++ ": Argument's value must be given a name using desc_argname."
else if ArgumentDescription -> ArgumentValueSpec
argdesc_argarg ArgumentDescription
desc ArgumentValueSpec -> ArgumentValueSpec -> Bool
forall a. Eq a => a -> a -> Bool
== ArgumentValueSpec
ArgumentValue_none Bool -> Bool -> Bool
&& ArgumentDescription -> Maybe String
argdesc_argargname ArgumentDescription
desc Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe String
forall a. Maybe a
Nothing
then String -> ()
forall a. HasCallStack => String -> a
error (String -> ()) -> String -> ()
forall a b. (a -> b) -> a -> b
$ "Bug in description of " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ArgumentDescription -> String
argname_a ArgumentDescription
desc
String -> ShowS
forall a. [a] -> [a] -> [a]
++ ": Argument doesn't take a sub argument, but a name for it is specified."
else ()
) (ArgumentDescription -> ArgumentDescription)
-> ArgumentDescription -> ArgumentDescription
forall a b. (a -> b) -> a -> b
$
ArgumentDescription
desc { argdesc_times :: Maybe (Int, Int)
argdesc_times = (Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just ((Int, Int) -> Maybe (Int, Int) -> (Int, Int)
forall a. a -> Maybe a -> a
fromMaybe (Int, Int)
times_default (ArgumentDescription -> Maybe (Int, Int)
argdesc_times ArgumentDescription
desc))
, argdesc_description :: Maybe String
argdesc_description = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe "" (ArgumentDescription -> Maybe String
argdesc_description ArgumentDescription
desc))
}
)
argdesc :: [ArgumentProperty]
-> ArgumentDescription
argdesc :: [ArgumentProperty] -> ArgumentDescription
argdesc propl :: [ArgumentProperty]
propl =
((ArgumentDescription -> ArgumentDescription)
-> (ArgumentDescription -> ArgumentDescription)
-> ArgumentDescription
-> ArgumentDescription)
-> (ArgumentDescription -> ArgumentDescription)
-> [ArgumentDescription -> ArgumentDescription]
-> ArgumentDescription
-> ArgumentDescription
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (ArgumentDescription -> ArgumentDescription)
-> (ArgumentDescription -> ArgumentDescription)
-> ArgumentDescription
-> ArgumentDescription
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) ArgumentDescription -> ArgumentDescription
forall a. a -> a
id ((ArgumentProperty -> ArgumentDescription -> ArgumentDescription)
-> [ArgumentProperty]
-> [ArgumentDescription -> ArgumentDescription]
forall a b. (a -> b) -> [a] -> [b]
map ArgumentProperty -> ArgumentDescription -> ArgumentDescription
argumentproperty (ArgumentProperty
prop_finalArgumentProperty -> [ArgumentProperty] -> [ArgumentProperty]
forall a. a -> [a] -> [a]
:[ArgumentProperty]
propl)) ArgumentDescription
nulldesc
getargs0 :: String
-> ArgOrder ArgOcc
-> [String]
-> [ArgumentDescription]
-> Either ArgError
Arguments
getargs0 :: String
-> ArgOrder ArgOcc
-> [String]
-> [ArgumentDescription]
-> Either ArgError Arguments
getargs0 header :: String
header ordering :: ArgOrder ArgOcc
ordering cmdlargs :: [String]
cmdlargs descs :: [ArgumentDescription]
descs =
let ( descs_direct :: [ArgumentDescription]
descs_direct
, descs_regular :: [ArgumentDescription]
descs_regular
) = (ArgumentDescription -> Bool)
-> [ArgumentDescription]
-> ([ArgumentDescription], [ArgumentDescription])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ArgumentDescription -> Bool
is_direct [ArgumentDescription]
descs
nonunique :: Eq a => [a] -> Maybe a
nonunique :: [a] -> Maybe a
nonunique (a :: a
a:b :: a
b:r :: [a]
r) = if (a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b) then (a -> Maybe a
forall a. a -> Maybe a
Just a
a) else [a] -> Maybe a
forall a. Eq a => [a] -> Maybe a
nonunique (a
ba -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
r)
nonunique _ = Maybe a
forall a. Maybe a
Nothing
test_unique :: (Show a, Ord a) => (ArgumentDescription -> [a]) -> String -> b -> b
test_unique :: (ArgumentDescription -> [a]) -> String -> b -> b
test_unique extr :: ArgumentDescription -> [a]
extr what :: String
what x :: b
x =
case [a] -> Maybe a
forall a. Eq a => [a] -> Maybe a
nonunique ([a] -> [a]
forall a. Ord a => [a] -> [a]
sort ([[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ((ArgumentDescription -> [a]) -> [ArgumentDescription] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map ArgumentDescription -> [a]
extr [ArgumentDescription]
descs))) of
Just y :: a
y -> String -> b
forall a. HasCallStack => String -> a
error ("Bug: Several occurences of " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
what String -> ShowS
forall a. [a] -> [a] -> [a]
++ " " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
y String -> ShowS
forall a. [a] -> [a] -> [a]
++
" in command line argument specifications")
Nothing -> b
x
optdescr :: [OptDescr ArgOcc]
optdescr = (ArgumentDescription -> OptDescr ArgOcc)
-> [ArgumentDescription] -> [OptDescr ArgOcc]
forall a b. (a -> b) -> [a] -> [b]
map ArgumentDescription -> OptDescr ArgOcc
make_optdescr [ArgumentDescription]
descs_regular
make_optdescr :: ArgumentDescription -> OptDescr ArgOcc
make_optdescr :: ArgumentDescription -> OptDescr ArgOcc
make_optdescr desc :: ArgumentDescription
desc =
String -> [String] -> ArgDescr ArgOcc -> String -> OptDescr ArgOcc
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option (ArgumentDescription -> String
argdesc_short_args ArgumentDescription
desc)
(ArgumentDescription -> [String]
argdesc_long_args ArgumentDescription
desc)
(case ArgumentDescription -> ArgumentValueSpec
argdesc_argarg ArgumentDescription
desc of
ArgumentValue_none -> ArgOcc -> ArgDescr ArgOcc
forall a. a -> ArgDescr a
NoArg (ArgumentDescription
desc, Maybe String
forall a. Maybe a
Nothing)
ArgumentValue_required -> (String -> ArgOcc) -> String -> ArgDescr ArgOcc
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\arg :: String
arg -> (ArgumentDescription
desc, String -> Maybe String
forall a. a -> Maybe a
Just String
arg))
(Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (ArgumentDescription -> Maybe String
argdesc_argargname ArgumentDescription
desc))
ArgumentValue_optional -> (Maybe String -> ArgOcc) -> String -> ArgDescr ArgOcc
forall a. (Maybe String -> a) -> String -> ArgDescr a
OptArg (\arg :: Maybe String
arg -> (ArgumentDescription
desc, Maybe String
arg))
(Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (ArgumentDescription -> Maybe String
argdesc_argargname ArgumentDescription
desc))
)
(Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (ArgumentDescription -> Maybe String
argdesc_description ArgumentDescription
desc))
getopt_post :: [ArgOcc] -> [String] -> Either ArgError Arguments
getopt_post :: [ArgOcc] -> [String] -> Either ArgError Arguments
getopt_post pars :: [ArgOcc]
pars rest :: [String]
rest =
case ([String]
rest, [ArgumentDescription]
descs_direct) of
([],[]) ->
[ArgOcc] -> Either ArgError Arguments
getopt_post' [ArgOcc]
pars
(r :: [String]
r, [d :: ArgumentDescription
d]) ->
[ArgOcc] -> Either ArgError Arguments
getopt_post' ([ArgOcc]
pars [ArgOcc] -> [ArgOcc] -> [ArgOcc]
forall a. [a] -> [a] -> [a]
++ [ArgumentDescription] -> [Maybe String] -> [ArgOcc]
forall a b. [a] -> [b] -> [(a, b)]
zip (ArgumentDescription -> [ArgumentDescription]
forall a. a -> [a]
repeat ArgumentDescription
d) ((String -> Maybe String) -> [String] -> [Maybe String]
forall a b. (a -> b) -> [a] -> [b]
map String -> Maybe String
forall a. a -> Maybe a
Just [String]
r))
((x :: String
x:xs :: [String]
xs), []) ->
ArgError -> Either ArgError Arguments
forall a b. a -> Either a b
Left (String -> String -> ArgError
ArgError "Surplus arguments."
([ArgumentDescription] -> String
make_usage_info1 [ArgumentDescription]
descs)
)
_ ->
String -> Either ArgError Arguments
forall a. HasCallStack => String -> a
error "Bug in argument descriptions: Several descriptions for direct arguments \
\(desc_direct) specified."
add :: (ArgumentDescription, Maybe String)
-> [(ArgumentDescription, [Maybe String])]
-> [(ArgumentDescription, [Maybe String])]
add :: ArgOcc
-> [(ArgumentDescription, [Maybe String])]
-> [(ArgumentDescription, [Maybe String])]
add (a :: ArgumentDescription
a,str :: Maybe String
str) [] = [(ArgumentDescription
a,[Maybe String
str])]
add (b :: ArgumentDescription
b,str :: Maybe String
str) ((a :: ArgumentDescription
a,l :: [Maybe String]
l):r :: [(ArgumentDescription, [Maybe String])]
r) =
if ArgumentDescription -> ArgumentDescription -> Bool
same_arg ArgumentDescription
a ArgumentDescription
b then (ArgumentDescription
a,Maybe String
strMaybe String -> [Maybe String] -> [Maybe String]
forall a. a -> [a] -> [a]
:[Maybe String]
l) (ArgumentDescription, [Maybe String])
-> [(ArgumentDescription, [Maybe String])]
-> [(ArgumentDescription, [Maybe String])]
forall a. a -> [a] -> [a]
: [(ArgumentDescription, [Maybe String])]
r
else (ArgumentDescription
a,[Maybe String]
l) (ArgumentDescription, [Maybe String])
-> [(ArgumentDescription, [Maybe String])]
-> [(ArgumentDescription, [Maybe String])]
forall a. a -> [a] -> [a]
: ArgOcc
-> [(ArgumentDescription, [Maybe String])]
-> [(ArgumentDescription, [Maybe String])]
add (ArgumentDescription
b,Maybe String
str) [(ArgumentDescription, [Maybe String])]
r
getopt_post' :: [ArgOcc] -> Either ArgError Arguments
getopt_post' :: [ArgOcc] -> Either ArgError Arguments
getopt_post' pars :: [ArgOcc]
pars =
let pars' :: [(ArgumentDescription, [Maybe String])]
pars' = (ArgOcc
-> [(ArgumentDescription, [Maybe String])]
-> [(ArgumentDescription, [Maybe String])])
-> [(ArgumentDescription, [Maybe String])]
-> [ArgOcc]
-> [(ArgumentDescription, [Maybe String])]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ArgOcc
-> [(ArgumentDescription, [Maybe String])]
-> [(ArgumentDescription, [Maybe String])]
add ((ArgumentDescription -> (ArgumentDescription, [Maybe String]))
-> [ArgumentDescription] -> [(ArgumentDescription, [Maybe String])]
forall a b. (a -> b) -> [a] -> [b]
map (\d :: ArgumentDescription
d -> (ArgumentDescription
d,[])) [ArgumentDescription]
descs) [ArgOcc]
pars
check_num :: [(ArgumentDescription, [Maybe String])] -> Maybe ArgError
check_num :: [(ArgumentDescription, [Maybe String])] -> Maybe ArgError
check_num [] = Maybe ArgError
forall a. Maybe a
Nothing
check_num ((desc :: ArgumentDescription
desc,args :: [Maybe String]
args):rest :: [(ArgumentDescription, [Maybe String])]
rest) =
let (min :: Int
min,max :: Int
max) = Maybe (Int, Int) -> (Int, Int)
forall a. HasCallStack => Maybe a -> a
fromJust (ArgumentDescription -> Maybe (Int, Int)
argdesc_times ArgumentDescription
desc)
number :: Int
number = [Maybe String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Maybe String]
args
wrong_number_msg :: String
wrong_number_msg =
(if ArgumentDescription -> Bool
is_direct ArgumentDescription
desc then (String, String) -> String
forall a b. (a, b) -> a
fst else (String, String) -> String
forall a b. (a, b) -> b
snd) ((String, String) -> String) -> (String, String) -> String
forall a b. (a -> b) -> a -> b
$
if Int
number Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 Bool -> Bool -> Bool
&& Int
min Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 then
( "Missing argument."
, "Missing " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ArgumentDescription -> String
argname_a ArgumentDescription
desc String -> ShowS
forall a. [a] -> [a] -> [a]
++ "."
)
else if Int
number Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
min then
( "Too few arguments. " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
min String -> ShowS
forall a. [a] -> [a] -> [a]
++ " required."
, "Too few instances of " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ArgumentDescription -> String
argname_a ArgumentDescription
desc String -> ShowS
forall a. [a] -> [a] -> [a]
++ ". "String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
min String -> ShowS
forall a. [a] -> [a] -> [a]
++ " required."
)
else if Int
number Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
max Bool -> Bool -> Bool
&& Int
max Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 then
( "Only one argument may be specified."
, "Repeated " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ArgumentDescription -> String
argname_a ArgumentDescription
desc String -> ShowS
forall a. [a] -> [a] -> [a]
++ "."
)
else if Int
number Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
max Bool -> Bool -> Bool
&& Int
max Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
unlimited then
( "Too many arguments."
, "Too many instances of " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ArgumentDescription -> String
argname_a ArgumentDescription
desc String -> ShowS
forall a. [a] -> [a] -> [a]
++ "."
)
else String -> (String, String)
forall a. HasCallStack => String -> a
error "bug in HsShellScript.Args.hs"
in if Int
number Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
min Bool -> Bool -> Bool
&& (Int
number Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
max Bool -> Bool -> Bool
|| Int
max Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
unlimited)
then [(ArgumentDescription, [Maybe String])] -> Maybe ArgError
check_num [(ArgumentDescription, [Maybe String])]
rest
else ArgError -> Maybe ArgError
forall a. a -> Maybe a
Just (String -> String -> ArgError
ArgError String
wrong_number_msg ([ArgumentDescription] -> String
make_usage_info1 [ArgumentDescription]
descs))
check_testers :: [(ArgumentDescription, [Maybe String])] -> Maybe ArgError
check_testers :: [(ArgumentDescription, [Maybe String])] -> Maybe ArgError
check_testers [] = Maybe ArgError
forall a. Maybe a
Nothing
check_testers ((desc :: ArgumentDescription
desc,args :: [Maybe String]
args):rest :: [(ArgumentDescription, [Maybe String])]
rest) =
case ArgumentDescription -> Maybe Argtester
argdesc_argarg_tester ArgumentDescription
desc of
Just argdesc_argarg_tester :: Argtester
argdesc_argarg_tester ->
if ArgumentDescription -> ArgumentValueSpec
argdesc_argarg ArgumentDescription
desc ArgumentValueSpec -> ArgumentValueSpec -> Bool
forall a. Eq a => a -> a -> Bool
== ArgumentValueSpec
ArgumentValue_none
then String -> ArgumentDescription -> Maybe ArgError
forall a. String -> ArgumentDescription -> a
abort "Bug in HsShellScript argument descriptions: Argument value tester \
\specified,\n\
\but no argument value has been allowed. Add desc_value_optional or\n\
\desc_value_required."
ArgumentDescription
desc
else case (Maybe (ArgumentDescription -> String) -> Bool)
-> [Maybe (ArgumentDescription -> String)]
-> [Maybe (ArgumentDescription -> String)]
forall a. (a -> Bool) -> [a] -> [a]
filter Maybe (ArgumentDescription -> String) -> Bool
forall a. Maybe a -> Bool
isJust ((Maybe String -> Maybe (ArgumentDescription -> String))
-> [Maybe String] -> [Maybe (ArgumentDescription -> String)]
forall a b. (a -> b) -> [a] -> [b]
map (Argtester
argdesc_argarg_tester Argtester
-> (Maybe String -> String)
-> Maybe String
-> Maybe (ArgumentDescription -> String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust) ((Maybe String -> Bool) -> [Maybe String] -> [Maybe String]
forall a. (a -> Bool) -> [a] -> [a]
filter Maybe String -> Bool
forall a. Maybe a -> Bool
isJust [Maybe String]
args)) of
[] -> [(ArgumentDescription, [Maybe String])] -> Maybe ArgError
check_testers [(ArgumentDescription, [Maybe String])]
rest
(Just msgf :: ArgumentDescription -> String
msgf : _) -> ArgError -> Maybe ArgError
forall a. a -> Maybe a
Just (String -> String -> ArgError
ArgError (ArgumentDescription -> String
msgf ArgumentDescription
desc) ([ArgumentDescription] -> String
make_usage_info1 [ArgumentDescription]
descs))
Nothing -> [(ArgumentDescription, [Maybe String])] -> Maybe ArgError
check_testers [(ArgumentDescription, [Maybe String])]
rest
in case [(ArgumentDescription, [Maybe String])] -> Maybe ArgError
check_testers [(ArgumentDescription, [Maybe String])]
pars' of
Nothing -> case [(ArgumentDescription, [Maybe String])] -> Maybe ArgError
check_num [(ArgumentDescription, [Maybe String])]
pars' of
Nothing -> Arguments -> Either ArgError Arguments
forall a b. b -> Either a b
Right (([(ArgumentDescription, [Maybe String])], String) -> Arguments
Arguments ([(ArgumentDescription, [Maybe String])]
pars', String
header))
Just err :: ArgError
err -> ArgError -> Either ArgError Arguments
forall a b. a -> Either a b
Left ArgError
err
Just err :: ArgError
err -> ArgError -> Either ArgError Arguments
forall a b. a -> Either a b
Left ArgError
err
args :: Either ArgError Arguments
args =
(ArgumentDescription -> String)
-> String -> Either ArgError Arguments -> Either ArgError Arguments
forall a b.
(Show a, Ord a) =>
(ArgumentDescription -> [a]) -> String -> b -> b
test_unique ArgumentDescription -> String
argdesc_short_args "short argument" (Either ArgError Arguments -> Either ArgError Arguments)
-> Either ArgError Arguments -> Either ArgError Arguments
forall a b. (a -> b) -> a -> b
$
(ArgumentDescription -> [String])
-> String -> Either ArgError Arguments -> Either ArgError Arguments
forall a b.
(Show a, Ord a) =>
(ArgumentDescription -> [a]) -> String -> b -> b
test_unique ArgumentDescription -> [String]
argdesc_long_args "long argument" (Either ArgError Arguments -> Either ArgError Arguments)
-> Either ArgError Arguments -> Either ArgError Arguments
forall a b. (a -> b) -> a -> b
$
case ArgOrder ArgOcc
-> [OptDescr ArgOcc] -> [String] -> ([ArgOcc], [String], [String])
forall a.
ArgOrder a -> [OptDescr a] -> [String] -> ([a], [String], [String])
getOpt ArgOrder ArgOcc
ordering [OptDescr ArgOcc]
optdescr [String]
cmdlargs of
(pars :: [ArgOcc]
pars, rest :: [String]
rest, []) ->
[ArgOcc] -> [String] -> Either ArgError Arguments
getopt_post [ArgOcc]
pars [String]
rest
(_,_,f :: [String]
f) ->
ArgError -> Either ArgError Arguments
forall a e. Exception e => e -> a
throw (String -> String -> ArgError
ArgError ([String] -> String
unlines (ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
chomp [String]
f)) (String -> [OptDescr ArgOcc] -> String
forall a. String -> [OptDescr a] -> String
usageInfo String
header [OptDescr ArgOcc]
optdescr))
in Either ArgError Arguments
args
where
chomp :: ShowS
chomp "" = ""
chomp "\n" = ""
chomp [x :: Char
x] = [Char
x]
chomp (x :: Char
x:xs :: String
xs) = let xs' :: String
xs' = ShowS
chomp String
xs
in if String
xs' String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "" Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\n' then "" else Char
xChar -> ShowS
forall a. a -> [a] -> [a]
:String
xs'
getargs :: String
-> [ArgumentDescription]
-> IO Arguments
getargs :: String -> [ArgumentDescription] -> IO Arguments
getargs header :: String
header descs :: [ArgumentDescription]
descs = do
[String]
args <- IO [String]
getArgs
let res :: Either ArgError Arguments
res = String
-> ArgOrder ArgOcc
-> [String]
-> [ArgumentDescription]
-> Either ArgError Arguments
getargs0 String
header ArgOrder ArgOcc
forall a. ArgOrder a
Permute [String]
args [ArgumentDescription]
descs
(ArgError -> IO Arguments)
-> (Arguments -> IO Arguments)
-> Either ArgError Arguments
-> IO Arguments
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ArgError -> IO Arguments
forall a e. Exception e => e -> a
throw
Arguments -> IO Arguments
forall (m :: * -> *) a. Monad m => a -> m a
return
Either ArgError Arguments
res
getargs_ordered :: String
-> [ArgumentDescription]
-> IO Arguments
getargs_ordered :: String -> [ArgumentDescription] -> IO Arguments
getargs_ordered header :: String
header descs :: [ArgumentDescription]
descs = do
[String]
args <- IO [String]
getArgs
(ArgError -> IO Arguments)
-> (Arguments -> IO Arguments)
-> Either ArgError Arguments
-> IO Arguments
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ArgError -> IO Arguments
forall a e. Exception e => e -> a
throw
Arguments -> IO Arguments
forall (m :: * -> *) a. Monad m => a -> m a
return
(String
-> ArgOrder ArgOcc
-> [String]
-> [ArgumentDescription]
-> Either ArgError Arguments
getargs0 String
header ArgOrder ArgOcc
forall a. ArgOrder a
RequireOrder [String]
args [ArgumentDescription]
descs)
getargs' :: String
-> [String]
-> [ArgumentDescription]
-> Either ArgError Arguments
getargs' :: String
-> [String] -> [ArgumentDescription] -> Either ArgError Arguments
getargs' header :: String
header args :: [String]
args descs :: [ArgumentDescription]
descs = String
-> ArgOrder ArgOcc
-> [String]
-> [ArgumentDescription]
-> Either ArgError Arguments
getargs0 String
header ArgOrder ArgOcc
forall a. ArgOrder a
Permute [String]
args [ArgumentDescription]
descs
getargs_ordered' :: String
-> [String]
-> [ArgumentDescription]
-> Either ArgError Arguments
getargs_ordered' :: String
-> [String] -> [ArgumentDescription] -> Either ArgError Arguments
getargs_ordered' header :: String
header args :: [String]
args descs :: [ArgumentDescription]
descs = String
-> ArgOrder ArgOcc
-> [String]
-> [ArgumentDescription]
-> Either ArgError Arguments
getargs0 String
header ArgOrder ArgOcc
forall a. ArgOrder a
RequireOrder [String]
args [ArgumentDescription]
descs
test_desc :: ArgumentDescription -> Bool -> String -> b -> b
test_desc :: ArgumentDescription -> Bool -> String -> b -> b
test_desc desc :: ArgumentDescription
desc ok :: Bool
ok msg :: String
msg x :: b
x =
if Bool
ok then b
x
else String -> ArgumentDescription -> b
forall a. String -> ArgumentDescription -> a
abort String
msg ArgumentDescription
desc
maybe_head :: [a] -> Maybe a
maybe_head :: [a] -> Maybe a
maybe_head [] = Maybe a
forall a. Maybe a
Nothing
maybe_head [a :: a
a] = a -> Maybe a
forall a. a -> Maybe a
Just a
a
arg_switch :: Arguments
-> ArgumentDescription
-> Bool
arg_switch :: Arguments -> ArgumentDescription -> Bool
arg_switch args :: Arguments
args desc :: ArgumentDescription
desc =
ArgumentDescription -> Bool -> String -> Bool -> Bool
forall b. ArgumentDescription -> Bool -> String -> b -> b
test_desc ArgumentDescription
desc (ArgumentDescription -> ArgumentValueSpec
argdesc_argarg ArgumentDescription
desc ArgumentValueSpec -> ArgumentValueSpec -> Bool
forall a. Eq a => a -> a -> Bool
== ArgumentValueSpec
ArgumentValue_none Bool -> Bool -> Bool
&& ArgumentDescription -> Maybe (Int, Int)
argdesc_times ArgumentDescription
desc Maybe (Int, Int) -> Maybe (Int, Int) -> Bool
forall a. Eq a => a -> a -> Bool
== (Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just (0,1))
"bug: querying argument with is not a switch with arg_switch" (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
case Arguments -> ArgumentDescription -> [Maybe String]
argvalues Arguments
args ArgumentDescription
desc of
[] -> Bool
False
[Nothing] -> Bool
True
arg_times :: Arguments
-> ArgumentDescription
-> Int
arg_times :: Arguments -> ArgumentDescription -> Int
arg_times args :: Arguments
args desc :: ArgumentDescription
desc =
[Maybe String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Arguments -> ArgumentDescription -> [Maybe String]
argvalues Arguments
args ArgumentDescription
desc)
args_opt :: Arguments
-> ArgumentDescription
-> [Maybe String]
args_opt :: Arguments -> ArgumentDescription -> [Maybe String]
args_opt args :: Arguments
args desc :: ArgumentDescription
desc =
ArgumentDescription
-> Bool -> String -> [Maybe String] -> [Maybe String]
forall b. ArgumentDescription -> Bool -> String -> b -> b
test_desc ArgumentDescription
desc (ArgumentDescription -> ArgumentValueSpec
argdesc_argarg ArgumentDescription
desc ArgumentValueSpec -> ArgumentValueSpec -> Bool
forall a. Eq a => a -> a -> Bool
== ArgumentValueSpec
ArgumentValue_optional Bool -> Bool -> Bool
&& (Int, Int) -> Int
forall a b. (a, b) -> b
snd (Maybe (Int, Int) -> (Int, Int)
forall a. HasCallStack => Maybe a -> a
fromJust (ArgumentDescription -> Maybe (Int, Int)
argdesc_times ArgumentDescription
desc)) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= 1)
"Bug: Querying argument which doesn't take an optional value, or may not occur several times, \
\with args_opt."
([Maybe String] -> [Maybe String])
-> [Maybe String] -> [Maybe String]
forall a b. (a -> b) -> a -> b
$ Arguments -> ArgumentDescription -> [Maybe String]
argvalues Arguments
args ArgumentDescription
desc
args_req :: Arguments
-> ArgumentDescription
-> [String]
args_req :: Arguments -> ArgumentDescription -> [String]
args_req args :: Arguments
args desc :: ArgumentDescription
desc =
ArgumentDescription -> Bool -> String -> [String] -> [String]
forall b. ArgumentDescription -> Bool -> String -> b -> b
test_desc ArgumentDescription
desc (ArgumentDescription -> ArgumentValueSpec
argdesc_argarg ArgumentDescription
desc ArgumentValueSpec -> ArgumentValueSpec -> Bool
forall a. Eq a => a -> a -> Bool
== ArgumentValueSpec
ArgumentValue_required Bool -> Bool -> Bool
&& (Int, Int) -> Int
forall a b. (a, b) -> b
snd (Maybe (Int, Int) -> (Int, Int)
forall a. HasCallStack => Maybe a -> a
fromJust (ArgumentDescription -> Maybe (Int, Int)
argdesc_times ArgumentDescription
desc)) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= 1)
"Bug: Querying argument which doesn't require a value, or may not occur several times, with \
\args_req." ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$
(Maybe String -> String) -> [Maybe String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (Arguments -> ArgumentDescription -> [Maybe String]
argvalues Arguments
args ArgumentDescription
desc)
reqarg_opt :: Arguments
-> ArgumentDescription
-> Maybe String
reqarg_opt :: Arguments -> ArgumentDescription -> Maybe String
reqarg_opt args :: Arguments
args desc :: ArgumentDescription
desc =
ArgumentDescription
-> Bool -> String -> Maybe String -> Maybe String
forall b. ArgumentDescription -> Bool -> String -> b -> b
test_desc ArgumentDescription
desc (ArgumentDescription -> ArgumentValueSpec
argdesc_argarg ArgumentDescription
desc ArgumentValueSpec -> ArgumentValueSpec -> Bool
forall a. Eq a => a -> a -> Bool
== ArgumentValueSpec
ArgumentValue_optional Bool -> Bool -> Bool
&& ArgumentDescription -> Maybe (Int, Int)
argdesc_times ArgumentDescription
desc Maybe (Int, Int) -> Maybe (Int, Int) -> Bool
forall a. Eq a => a -> a -> Bool
== (Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just (1,1))
"Bug: Querying argument which doesn't take an optional value, or which must not occur exactly \
\once, with reqarg_opt." (Maybe String -> Maybe String) -> Maybe String -> Maybe String
forall a b. (a -> b) -> a -> b
$
[Maybe String] -> Maybe String
forall a. [a] -> a
head (Arguments -> ArgumentDescription -> [Maybe String]
argvalues Arguments
args ArgumentDescription
desc)
reqarg_req :: Arguments
-> ArgumentDescription
-> String
reqarg_req :: Arguments -> ArgumentDescription -> String
reqarg_req args :: Arguments
args desc :: ArgumentDescription
desc =
ArgumentDescription -> Bool -> String -> ShowS
forall b. ArgumentDescription -> Bool -> String -> b -> b
test_desc ArgumentDescription
desc (ArgumentDescription -> ArgumentValueSpec
argdesc_argarg ArgumentDescription
desc ArgumentValueSpec -> ArgumentValueSpec -> Bool
forall a. Eq a => a -> a -> Bool
== ArgumentValueSpec
ArgumentValue_required Bool -> Bool -> Bool
&& ArgumentDescription -> Maybe (Int, Int)
argdesc_times ArgumentDescription
desc Maybe (Int, Int) -> Maybe (Int, Int) -> Bool
forall a. Eq a => a -> a -> Bool
== (Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just (1,1))
"Bug: Querying argument with non-required value, or which doesn't occur exactly once, with reqarg_req." ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust ([Maybe String] -> Maybe String
forall a. [a] -> a
head (Arguments -> ArgumentDescription -> [Maybe String]
argvalues Arguments
args ArgumentDescription
desc))
optarg_opt :: Arguments
-> ArgumentDescription
-> Maybe (Maybe String)
optarg_opt :: Arguments -> ArgumentDescription -> Maybe (Maybe String)
optarg_opt args :: Arguments
args desc :: ArgumentDescription
desc =
ArgumentDescription
-> Bool -> String -> Maybe (Maybe String) -> Maybe (Maybe String)
forall b. ArgumentDescription -> Bool -> String -> b -> b
test_desc ArgumentDescription
desc (ArgumentDescription -> ArgumentValueSpec
argdesc_argarg ArgumentDescription
desc ArgumentValueSpec -> ArgumentValueSpec -> Bool
forall a. Eq a => a -> a -> Bool
== ArgumentValueSpec
ArgumentValue_optional)
"Bug: Querying argument with non-optional value with optarg_opt." (Maybe (Maybe String) -> Maybe (Maybe String))
-> Maybe (Maybe String) -> Maybe (Maybe String)
forall a b. (a -> b) -> a -> b
$
ArgumentDescription
-> Bool -> String -> Maybe (Maybe String) -> Maybe (Maybe String)
forall b. ArgumentDescription -> Bool -> String -> b -> b
test_desc ArgumentDescription
desc ((Int, Int) -> Int
forall a b. (a, b) -> a
fst (Maybe (Int, Int) -> (Int, Int)
forall a. HasCallStack => Maybe a -> a
fromJust (ArgumentDescription -> Maybe (Int, Int)
argdesc_times ArgumentDescription
desc)) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0)
"Bug: Querying argument which isn't optional with optarg_opt." (Maybe (Maybe String) -> Maybe (Maybe String))
-> Maybe (Maybe String) -> Maybe (Maybe String)
forall a b. (a -> b) -> a -> b
$
ArgumentDescription
-> Bool -> String -> Maybe (Maybe String) -> Maybe (Maybe String)
forall b. ArgumentDescription -> Bool -> String -> b -> b
test_desc ArgumentDescription
desc ((Int, Int) -> Int
forall a b. (a, b) -> b
snd (Maybe (Int, Int) -> (Int, Int)
forall a. HasCallStack => Maybe a -> a
fromJust (ArgumentDescription -> Maybe (Int, Int)
argdesc_times ArgumentDescription
desc)) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1)
"Bug: Querying argument which may occur several times optarg_opt." (Maybe (Maybe String) -> Maybe (Maybe String))
-> Maybe (Maybe String) -> Maybe (Maybe String)
forall a b. (a -> b) -> a -> b
$
[Maybe String] -> Maybe (Maybe String)
forall a. [a] -> Maybe a
maybe_head (Arguments -> ArgumentDescription -> [Maybe String]
argvalues Arguments
args ArgumentDescription
desc)
optarg_req :: Arguments
-> ArgumentDescription
-> Maybe String
optarg_req :: Arguments -> ArgumentDescription -> Maybe String
optarg_req args :: Arguments
args desc :: ArgumentDescription
desc =
ArgumentDescription
-> Bool -> String -> Maybe String -> Maybe String
forall b. ArgumentDescription -> Bool -> String -> b -> b
test_desc ArgumentDescription
desc (ArgumentDescription -> ArgumentValueSpec
argdesc_argarg ArgumentDescription
desc ArgumentValueSpec -> ArgumentValueSpec -> Bool
forall a. Eq a => a -> a -> Bool
== ArgumentValueSpec
ArgumentValue_required)
"Bug: Querying argument with non-required value with optarg_req."
(Maybe String -> Maybe String) -> Maybe String -> Maybe String
forall a b. (a -> b) -> a -> b
$ ArgumentDescription
-> Bool -> String -> Maybe String -> Maybe String
forall b. ArgumentDescription -> Bool -> String -> b -> b
test_desc ArgumentDescription
desc ((Int, Int) -> Int
forall a b. (a, b) -> a
fst (Maybe (Int, Int) -> (Int, Int)
forall a. HasCallStack => Maybe a -> a
fromJust (ArgumentDescription -> Maybe (Int, Int)
argdesc_times ArgumentDescription
desc)) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0)
"Bug: Querying argument which isn't optional with optarg_req."
(Maybe String -> Maybe String) -> Maybe String -> Maybe String
forall a b. (a -> b) -> a -> b
$ ArgumentDescription
-> Bool -> String -> Maybe String -> Maybe String
forall b. ArgumentDescription -> Bool -> String -> b -> b
test_desc ArgumentDescription
desc ((Int, Int) -> Int
forall a b. (a, b) -> b
snd (Maybe (Int, Int) -> (Int, Int)
forall a. HasCallStack => Maybe a -> a
fromJust (ArgumentDescription -> Maybe (Int, Int)
argdesc_times ArgumentDescription
desc)) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1)
"Bug: Querying argument which may occur several times optarg_req."
(Maybe String -> Maybe String) -> Maybe String -> Maybe String
forall a b. (a -> b) -> a -> b
$ (Maybe String -> String) -> Maybe (Maybe String) -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust ([Maybe String] -> Maybe (Maybe String)
forall a. [a] -> Maybe a
maybe_head (Arguments -> ArgumentDescription -> [Maybe String]
argvalues Arguments
args ArgumentDescription
desc))
args_none :: [ArgumentDescription]
-> Arguments
-> IO ()
args_none :: [ArgumentDescription] -> Arguments -> IO ()
args_none descs :: [ArgumentDescription]
descs args :: Arguments
args@(Arguments argl :: ([(ArgumentDescription, [Maybe String])], String)
argl) =
(ArgumentDescription -> IO ()) -> [ArgumentDescription] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\desc :: ArgumentDescription
desc ->
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Arguments -> ArgumentDescription -> Int
arg_times Arguments
args ArgumentDescription
desc Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
String -> [ArgumentDescription] -> IO ()
forall a. String -> [ArgumentDescription] -> a
argerror_ui (ShowS
up1 (ArgumentDescription -> String
argname_a ArgumentDescription
desc) String -> ShowS
forall a. [a] -> [a] -> [a]
++ " is not allowed.\n")
[ArgumentDescription]
descs
)
[ArgumentDescription]
descs
args_all :: [ArgumentDescription]
-> Arguments
-> IO ()
args_all :: [ArgumentDescription] -> Arguments -> IO ()
args_all descs :: [ArgumentDescription]
descs args :: Arguments
args@(Arguments argl :: ([(ArgumentDescription, [Maybe String])], String)
argl) =
(ArgumentDescription -> IO ()) -> [ArgumentDescription] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\desc :: ArgumentDescription
desc ->
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Arguments -> ArgumentDescription -> Int
arg_times Arguments
args ArgumentDescription
desc Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
String -> [ArgumentDescription] -> IO ()
forall a. String -> [ArgumentDescription] -> a
argerror_ui ("Missing " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ArgumentDescription -> String
argname_a ArgumentDescription
desc String -> ShowS
forall a. [a] -> [a] -> [a]
++ "\n") [ArgumentDescription]
descs
)
[ArgumentDescription]
descs
args_one :: [ArgumentDescription]
-> Arguments
-> IO ()
args_one :: [ArgumentDescription] -> Arguments -> IO ()
args_one descs :: [ArgumentDescription]
descs args :: Arguments
args@(Arguments argl :: ([(ArgumentDescription, [Maybe String])], String)
argl) =
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([ArgumentDescription] -> Arguments -> Int
occuring [ArgumentDescription]
descs Arguments
args Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= 1) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
String -> [ArgumentDescription] -> IO ()
forall a. String -> [ArgumentDescription] -> a
argerror_ui ("Exactly one of the following arguments must be present.\n"
String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse ", " ((ArgumentDescription -> String)
-> [ArgumentDescription] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ArgumentDescription -> String
argname [ArgumentDescription]
descs)) String -> ShowS
forall a. [a] -> [a] -> [a]
++ "\n")
[ArgumentDescription]
descs
args_at_most_one :: [ArgumentDescription]
-> Arguments
-> IO ()
args_at_most_one :: [ArgumentDescription] -> Arguments -> IO ()
args_at_most_one descs :: [ArgumentDescription]
descs args :: Arguments
args@(Arguments argl :: ([(ArgumentDescription, [Maybe String])], String)
argl) =
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([ArgumentDescription] -> Arguments -> Int
occuring [ArgumentDescription]
descs Arguments
args Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
String -> [ArgumentDescription] -> IO ()
forall a. String -> [ArgumentDescription] -> a
argerror_ui ("Only one of the following arguments may be present.\n"
String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse ", " ((ArgumentDescription -> String)
-> [ArgumentDescription] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ArgumentDescription -> String
argname [ArgumentDescription]
descs)) String -> ShowS
forall a. [a] -> [a] -> [a]
++ "\n")
[ArgumentDescription]
descs
args_at_least_one :: [ArgumentDescription]
-> Arguments
-> IO ()
args_at_least_one :: [ArgumentDescription] -> Arguments -> IO ()
args_at_least_one descs :: [ArgumentDescription]
descs args :: Arguments
args@(Arguments argl :: ([(ArgumentDescription, [Maybe String])], String)
argl) =
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([ArgumentDescription] -> Arguments -> Int
occuring [ArgumentDescription]
descs Arguments
args Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
String -> [ArgumentDescription] -> IO ()
forall a. String -> [ArgumentDescription] -> a
argerror_ui ("One of the following arguments must be present.\n"
String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse ", " ((ArgumentDescription -> String)
-> [ArgumentDescription] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ArgumentDescription -> String
argname [ArgumentDescription]
descs)) String -> ShowS
forall a. [a] -> [a] -> [a]
++ "\n")
[ArgumentDescription]
descs
arg_conflicts :: ArgumentDescription
-> [ArgumentDescription]
-> Arguments
-> IO ()
arg_conflicts :: ArgumentDescription -> [ArgumentDescription] -> Arguments -> IO ()
arg_conflicts desc :: ArgumentDescription
desc descs :: [ArgumentDescription]
descs args :: Arguments
args@(Arguments argl :: ([(ArgumentDescription, [Maybe String])], String)
argl) =
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Arguments -> ArgumentDescription -> Bool
arg_occurs Arguments
args ArgumentDescription
desc Bool -> Bool -> Bool
&& [ArgumentDescription] -> Arguments -> Int
occuring [ArgumentDescription]
descs Arguments
args Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
String -> [ArgumentDescription] -> IO ()
forall a. String -> [ArgumentDescription] -> a
argerror_ui ("When " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ArgumentDescription -> String
argname ArgumentDescription
desc String -> ShowS
forall a. [a] -> [a] -> [a]
++ " is present, none of the following arguments may be present.\n"
String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse ", " ((ArgumentDescription -> String)
-> [ArgumentDescription] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ArgumentDescription -> String
argname [ArgumentDescription]
descs)) String -> ShowS
forall a. [a] -> [a] -> [a]
++ "\n")
[ArgumentDescription]
descs
occuring :: [ArgumentDescription] -> Arguments -> Int
occuring :: [ArgumentDescription] -> Arguments -> Int
occuring descs :: [ArgumentDescription]
descs args :: Arguments
args =
[Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((ArgumentDescription -> Int) -> [ArgumentDescription] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\desc :: ArgumentDescription
desc -> if Arguments -> ArgumentDescription -> Int
arg_times Arguments
args ArgumentDescription
desc Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 then 0 else 1) [ArgumentDescription]
descs)
arg_occurs :: Arguments
-> ArgumentDescription
-> Bool
arg_occurs :: Arguments -> ArgumentDescription -> Bool
arg_occurs args :: Arguments
args desc :: ArgumentDescription
desc =
[ArgumentDescription] -> Arguments -> Int
occuring [ArgumentDescription
desc] Arguments
args Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1
usage_info :: Arguments -> String
usage_info :: Arguments -> String
usage_info (Arguments (l :: [(ArgumentDescription, [Maybe String])]
l, header :: String
header)) =
[String] -> String
unlines (Int -> String -> [String]
wrap 80 String
header) String -> ShowS
forall a. [a] -> [a] -> [a]
++
[String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse "\n" ([ArgumentDescription] -> Int -> Int -> Int -> Int -> [String]
make_usage_info (((ArgumentDescription, [Maybe String]) -> ArgumentDescription)
-> [(ArgumentDescription, [Maybe String])] -> [ArgumentDescription]
forall a b. (a -> b) -> [a] -> [b]
map (ArgumentDescription, [Maybe String]) -> ArgumentDescription
forall a b. (a, b) -> a
fst [(ArgumentDescription, [Maybe String])]
l) 0 10 30 80))
unsafe_getargs :: String
-> [ArgumentDescription]
-> Arguments
unsafe_getargs :: String -> [ArgumentDescription] -> Arguments
unsafe_getargs header :: String
header descs :: [ArgumentDescription]
descs =
IO Arguments -> Arguments
forall a. IO a -> a
GHC.IO.unsafePerformIO (IO Arguments -> Arguments) -> IO Arguments -> Arguments
forall a b. (a -> b) -> a -> b
$ String -> [ArgumentDescription] -> IO Arguments
getargs String
header [ArgumentDescription]
descs
unsafe_getargs_ordered :: String
-> [ArgumentDescription]
-> Arguments
unsafe_getargs_ordered :: String -> [ArgumentDescription] -> Arguments
unsafe_getargs_ordered header :: String
header descs :: [ArgumentDescription]
descs =
IO Arguments -> Arguments
forall a. IO a -> a
GHC.IO.unsafePerformIO (IO Arguments -> Arguments) -> IO Arguments -> Arguments
forall a b. (a -> b) -> a -> b
$ String -> [ArgumentDescription] -> IO Arguments
getargs_ordered String
header [ArgumentDescription]
descs
make_usage_info1 :: [ArgumentDescription] -> String
make_usage_info1 :: [ArgumentDescription] -> String
make_usage_info1 argdescs :: [ArgumentDescription]
argdescs =
[String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse "\n" ([ArgumentDescription] -> Int -> Int -> Int -> Int -> [String]
make_usage_info [ArgumentDescription]
argdescs 0 10 30 80))
make_usage_info :: [ArgumentDescription]
-> Int
-> Int
-> Int
-> Int
-> [String]
make_usage_info :: [ArgumentDescription] -> Int -> Int -> Int -> Int -> [String]
make_usage_info descs :: [ArgumentDescription]
descs colsleft :: Int
colsleft colsshort :: Int
colsshort colslong :: Int
colslong width :: Int
width =
if Int
colsleft Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
colsshort Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
colslong Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
width
then String -> [String]
forall a. HasCallStack => String -> a
error (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ "make_usage_info: colsleft, colsshort, and colslong arguments \
\are too large for the specified width argument.\n\
\colsleft = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
colsleft String -> ShowS
forall a. [a] -> [a] -> [a]
++ " \n\
\colsshort = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
colsshort String -> ShowS
forall a. [a] -> [a] -> [a]
++ " \n\
\colslong = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
colslong String -> ShowS
forall a. [a] -> [a] -> [a]
++ " \n\
\width = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
width
else
([String] -> String) -> [[String]] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map [String] -> String
unlines ([[(String, String, String)]] -> [[String]]
verbinden ([ArgumentDescription] -> [[(String, String, String)]]
zll' ((ArgumentDescription -> Bool)
-> [ArgumentDescription] -> [ArgumentDescription]
forall a. (a -> Bool) -> [a] -> [a]
filter (\d :: ArgumentDescription
d -> Bool -> Bool
not (ArgumentDescription -> Bool
is_direct ArgumentDescription
d))
[ArgumentDescription]
descs)
))
where
beschr :: ArgumentDescription -> [String]
beschr :: ArgumentDescription -> [String]
beschr desc :: ArgumentDescription
desc = Int -> String -> [String]
wrap (Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
colsleft Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
gesamtbr_kurz Int -> Int -> Int
forall a. Num a => a -> a -> a
- 2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
gesamtbr_lang Int -> Int -> Int
forall a. Num a => a -> a -> a
- 2)
(String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe "" (ArgumentDescription -> Maybe String
argdesc_description ArgumentDescription
desc))
auff1 :: ArgumentDescription
-> ([String], [String], [String])
auff1 :: ArgumentDescription -> ([String], [String], [String])
auff1 desc :: ArgumentDescription
desc = [String] -> [String] -> [String] -> ([String], [String], [String])
auff (ArgumentDescription -> [String]
kurzname ArgumentDescription
desc)
(ArgumentDescription -> [String]
langname ArgumentDescription
desc)
(ArgumentDescription -> [String]
beschr ArgumentDescription
desc)
zus :: ([String], [String], [String]) -> [(String, String, String)]
zus :: ([String], [String], [String]) -> [(String, String, String)]
zus (as :: [String]
as, bs :: [String]
bs, cs :: [String]
cs) = [String] -> [String] -> [String] -> [(String, String, String)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [String]
as [String]
bs [String]
cs
kurzbr :: ArgumentDescription -> Int
kurzbr :: ArgumentDescription -> Int
kurzbr desc :: ArgumentDescription
desc =
(Int -> Int -> Int) -> Int -> [Int] -> Int
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Int -> Int -> Int
forall a. Ord a => a -> a -> a
max 0 ((String -> Int) -> [String] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (ArgumentDescription -> [String]
kurzname ArgumentDescription
desc))
langbr :: ArgumentDescription -> Int
langbr :: ArgumentDescription -> Int
langbr desc :: ArgumentDescription
desc =
(Int -> Int -> Int) -> Int -> [Int] -> Int
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Int -> Int -> Int
forall a. Ord a => a -> a -> a
max 0 ((String -> Int) -> [String] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (ArgumentDescription -> [String]
langname ArgumentDescription
desc))
gesamtbr_kurz :: Int
gesamtbr_kurz =
(Int -> Int -> Int) -> Int -> [Int] -> Int
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Int -> Int -> Int
forall a. Ord a => a -> a -> a
max 0 ((ArgumentDescription -> Int) -> [ArgumentDescription] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\desc :: ArgumentDescription
desc -> ArgumentDescription -> Int
kurzbr ArgumentDescription
desc) [ArgumentDescription]
descs)
gesamtbr_lang :: Int
gesamtbr_lang =
(Int -> Int -> Int) -> Int -> [Int] -> Int
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Int -> Int -> Int
forall a. Ord a => a -> a -> a
max 0 ((ArgumentDescription -> Int) -> [ArgumentDescription] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\desc :: ArgumentDescription
desc -> ArgumentDescription -> Int
langbr ArgumentDescription
desc) [ArgumentDescription]
descs)
breite_descr :: Int
breite_descr :: Int
breite_descr = Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
colsleft Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
gesamtbr_kurz Int -> Int -> Int
forall a. Num a => a -> a -> a
- 2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
gesamtbr_lang Int -> Int -> Int
forall a. Num a => a -> a -> a
- 2
zll :: [ArgumentDescription]
-> [[(String, String, String)]]
zll :: [ArgumentDescription] -> [[(String, String, String)]]
zll descs :: [ArgumentDescription]
descs =
(ArgumentDescription -> [(String, String, String)])
-> [ArgumentDescription] -> [[(String, String, String)]]
forall a b. (a -> b) -> [a] -> [b]
map (([String], [String], [String]) -> [(String, String, String)]
zus (([String], [String], [String]) -> [(String, String, String)])
-> (ArgumentDescription -> ([String], [String], [String]))
-> ArgumentDescription
-> [(String, String, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ArgumentDescription -> ([String], [String], [String])
auff1) [ArgumentDescription]
descs
zll' :: [ArgumentDescription]
-> [[(String, String, String)]]
zll' :: [ArgumentDescription] -> [[(String, String, String)]]
zll' [] =
[]
zll' descs :: [ArgumentDescription]
descs =
([(String, String, String)] -> [(String, String, String)])
-> [[(String, String, String)]] -> [[(String, String, String)]]
forall a b. (a -> b) -> [a] -> [b]
map (\l :: [(String, String, String)]
l -> ((String, String, String) -> (String, String, String))
-> [(String, String, String)] -> [(String, String, String)]
forall a b. (a -> b) -> [a] -> [b]
map (\(a :: String
a,b :: String
b,c :: String
c) -> (Int -> ShowS
fuell Int
gesamtbr_kurz String
a,
Int -> ShowS
fuell Int
gesamtbr_lang String
b,
String
c))
[(String, String, String)]
l)
([ArgumentDescription] -> [[(String, String, String)]]
zll [ArgumentDescription]
descs)
verbinden :: [[(String, String, String)]]
-> [[String]]
verbinden :: [[(String, String, String)]] -> [[String]]
verbinden l :: [[(String, String, String)]]
l =
([(String, String, String)] -> [String])
-> [[(String, String, String)]] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map (\l' :: [(String, String, String)]
l' -> ((String, String, String) -> String)
-> [(String, String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\(a :: String
a,b :: String
b,c :: String
c) -> Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
colsleft (Char -> String
forall a. a -> [a]
repeat ' ')
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ " " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
b String -> ShowS
forall a. [a] -> [a] -> [a]
++ " " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
c) [(String, String, String)]
l')
[[(String, String, String)]]
l
kurzname :: ArgumentDescription -> [String]
kurzname :: ArgumentDescription -> [String]
kurzname desc :: ArgumentDescription
desc =
Int -> String -> [String]
wrap Int
colsshort (ArgumentDescription -> String
argname_short ArgumentDescription
desc)
langname :: ArgumentDescription -> [String]
langname :: ArgumentDescription -> [String]
langname desc :: ArgumentDescription
desc =
Int -> String -> [String]
wrap Int
colslong (ArgumentDescription -> String
argname_long ArgumentDescription
desc)
fuell :: Int -> String -> String
fuell :: Int -> ShowS
fuell br :: Int
br txt :: String
txt =
String
txt String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> ShowS
forall a. Int -> [a] -> [a]
take (Int
br Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
txt) (Char -> String
forall a. a -> [a]
repeat ' ')
auff :: [String] -> [String] -> [String] -> ([String], [String], [String])
auff :: [String] -> [String] -> [String] -> ([String], [String], [String])
auff a :: [String]
a b :: [String]
b c :: [String]
c =
([String] -> [String]
forall a. [a] -> [a]
reverse [String]
x, [String] -> [String]
forall a. [a] -> [a]
reverse [String]
y, [String] -> [String]
forall a. [a] -> [a]
reverse [String]
z)
where
(x :: [String]
x,y :: [String]
y,z :: [String]
z) = [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> ([String], [String], [String])
auff' [String]
a [String]
b [String]
c [] [] []
auff' :: [String] -> [String] -> [String]
-> [String] -> [String] -> [String]
-> ([String], [String], [String])
auff' :: [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> ([String], [String], [String])
auff' [] [] [] a1 :: [String]
a1 b1 :: [String]
b1 c1 :: [String]
c1 =
([String]
a1, [String]
b1, [String]
c1)
auff' a :: [String]
a b :: [String]
b c :: [String]
c a1 :: [String]
a1 b1 :: [String]
b1 c1 :: [String]
c1 =
[String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> ([String], [String], [String])
auff' (if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
a then [] else [String] -> [String]
forall a. [a] -> [a]
tail [String]
a)
(if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
b then [] else [String] -> [String]
forall a. [a] -> [a]
tail [String]
b)
(if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
c then [] else [String] -> [String]
forall a. [a] -> [a]
tail [String]
c)
((if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
a then "" else [String] -> String
forall a. [a] -> a
head [String]
a) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
a1)
((if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
b then "" else [String] -> String
forall a. [a] -> a
head [String]
b) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
b1)
((if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
c then "" else [String] -> String
forall a. [a] -> a
head [String]
c) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
c1)
print_usage_info :: Handle
-> String
-> [ArgumentDescription]
-> IO ()
print_usage_info :: Handle -> String -> [ArgumentDescription] -> IO ()
print_usage_info h :: Handle
h header :: String
header descs :: [ArgumentDescription]
descs = do
Maybe Int
mw <- Handle -> IO (Maybe Int)
terminal_width Handle
h
let w :: Int
w = case Maybe Int
mw of
Just w :: Int
w -> Int
w
Nothing -> 80
if Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 12
then Handle -> String -> IO ()
hPutStr Handle
h "Terminal too narrow"
else do
Handle -> String -> IO ()
hPutStr Handle
h ([String] -> String
unlines (Int -> String -> [String]
wrap Int
w String
header))
(String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Handle -> String -> IO ()
hPutStr Handle
h)
([ArgumentDescription] -> Int -> Int -> Int -> Int -> [String]
make_usage_info [ArgumentDescription]
descs
0
(Int
w Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 5)
(Int
w Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 3)
Int
w)
wrap :: Int
-> String
-> [String]
wrap :: Int -> String -> [String]
wrap breite :: Int
breite [] = []
wrap breite :: Int
breite txt :: String
txt =
[ String
zl | String
txtzl <- String -> [String]
lines String
txt,
String
zl <- Int -> String -> [String]
wrap' Int
breite String
txtzl
]
where
wrap' :: Int -> String -> [String]
wrap' :: Int -> String -> [String]
wrap' breite :: Int
breite [] = [""]
wrap' breite :: Int
breite txt :: String
txt =
Int -> String -> [String]
wrap'' Int
breite ((Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace String
txt)
wrap'' :: Int -> String -> [String]
wrap'' :: Int -> String -> [String]
wrap'' breite :: Int
breite txt :: String
txt =
if String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
txt Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
breite
then [String
txt]
else
if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
txt_anf
then
String
txt_br String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Int -> String -> [String]
wrap' Int
breite String
txt_rest
else String
txt_anf String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Int -> String -> [String]
wrap' Int
breite String
rest
where
(txt_br :: String
txt_br, txt_rest :: String
txt_rest) =
Int -> String -> (String, String)
forall a. Int -> [a] -> ([a], [a])
splitAt Int
breite String
txt
(txt_anf :: String
txt_anf, txt_anf_rest :: String
txt_anf_rest) =
String -> (String, String)
letzter_teil String
txt_br
rest :: String
rest = String
txt_anf_rest String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
txt_rest
letzter_teil :: String -> (String, String)
letzter_teil zl :: String
zl =
let zl' :: String
zl' = ShowS
forall a. [a] -> [a]
reverse String
zl
(wort :: String
wort, zl'' :: String
zl'') = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= ' ') String
zl'
zl''1 :: String
zl''1 = (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ' ') String
zl''
zl''' :: String
zl''' = ShowS
forall a. [a] -> [a]
reverse String
zl''1
wort' :: String
wort' = ShowS
forall a. [a] -> [a]
reverse String
wort
in (String
zl''', String
wort')