{-# 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
$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)
type Argtester = String
-> Maybe (ArgumentDescription
-> String
)
data ArgumentDescription = ArgumentDescription {
ArgumentDescription -> [Char]
argdesc_short_args :: [Char],
ArgumentDescription -> [[Char]]
argdesc_long_args :: [String],
ArgumentDescription -> ArgumentValueSpec
argdesc_argarg :: ArgumentValueSpec,
ArgumentDescription -> Maybe (Int, Int)
argdesc_times :: Maybe (Int,Int),
ArgumentDescription -> Maybe [Char]
argdesc_argargname :: Maybe String,
ArgumentDescription -> Maybe [Char]
argdesc_description :: Maybe String,
ArgumentDescription -> Maybe Argtester
argdesc_argarg_tester :: Maybe Argtester
}
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)
unlimited :: Int
unlimited = -Int
1
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."
newtype ArgumentProperty =
ArgumentProperty { ArgumentProperty -> ArgumentDescription -> ArgumentDescription
argumentproperty :: ArgumentDescription -> ArgumentDescription }
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,
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
}
times_default :: (Int, Int)
times_default = (Int
0,Int
1)
newtype Arguments =
Arguments ([ ( ArgumentDescription
, [Maybe String]
)],
String)
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
type ArgOcc = (ArgumentDescription, Maybe String)
data ArgError = ArgError {
ArgError -> [Char]
argerror_message :: String,
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))
instance Exception ArgError
instance Show ArgError where
show :: ArgError -> [Char]
show ArgError
argerror = ArgError -> [Char]
argerror_message ArgError
argerror
is_direct :: ArgumentDescription
-> 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]
""]
desc_short :: Char
-> ArgumentProperty
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 }
)
desc_long :: String
-> ArgumentProperty
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 }
)
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
)
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
)
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
)
desc_times :: Int
-> Int
-> ArgumentProperty
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
)
desc_once :: ArgumentProperty
desc_once :: ArgumentProperty
desc_once = Int -> Int -> ArgumentProperty
desc_times Int
1 Int
1
desc_at_least_once :: ArgumentProperty
desc_at_least_once :: ArgumentProperty
desc_at_least_once = Int -> Int -> ArgumentProperty
desc_times Int
1 Int
unlimited
desc_at_most_once :: ArgumentProperty
desc_at_most_once :: ArgumentProperty
desc_at_most_once = Int -> Int -> ArgumentProperty
desc_times Int
0 Int
1
desc_at_least :: Int
-> ArgumentProperty
desc_at_least :: Int -> ArgumentProperty
desc_at_least 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 Int
0 Int
unlimited
desc_at_most :: Int
-> ArgumentProperty
desc_at_most :: Int -> ArgumentProperty
desc_at_most Int
n = Int -> Int -> ArgumentProperty
desc_times Int
0 Int
n
desc_argname :: String
-> ArgumentProperty
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
)
desc_description :: String
-> ArgumentProperty
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
)
desc_tester :: Argtester
-> ArgumentProperty
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
)
readtester :: ReadS a
-> String
-> Argtester
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)
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.")
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)
argname :: ArgumentDescription
-> String
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) ))
argname_a :: ArgumentDescription
-> String
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) ))
argname_short :: ArgumentDescription
-> String
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))
argname_long :: ArgumentDescription
-> String
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
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))
}
)
argdesc :: [ArgumentProperty]
-> ArgumentDescription
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
getargs0 :: String
-> ArgOrder ArgOcc
-> [String]
-> [ArgumentDescription]
-> Either ArgError
Arguments
getargs0 :: [Char]
-> ArgOrder ArgOcc
-> [[Char]]
-> [ArgumentDescription]
-> Either ArgError Arguments
getargs0 [Char]
header ArgOrder ArgOcc
ordering [[Char]]
cmdlargs [ArgumentDescription]
descs =
let ( [ArgumentDescription]
descs_direct
, [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 :: 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))
getopt_post :: [ArgOcc] -> [String] -> Either ArgError Arguments
getopt_post :: [ArgOcc] -> [[Char]] -> Either ArgError Arguments
getopt_post [ArgOcc]
pars [[Char]]
rest =
case ([[Char]]
rest, [ArgumentDescription]
descs_direct) of
([],[]) ->
[ArgOcc] -> Either ArgError Arguments
getopt_post' [ArgOcc]
pars
([[Char]]
r, [ArgumentDescription
d]) ->
[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), []) ->
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])
_ ->
[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 =
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_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))
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
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'
getargs :: String
-> [ArgumentDescription]
-> IO Arguments
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
getargs_ordered :: String
-> [ArgumentDescription]
-> IO Arguments
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)
getargs' :: String
-> [String]
-> [ArgumentDescription]
-> Either ArgError Arguments
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
getargs_ordered' :: String
-> [String]
-> [ArgumentDescription]
-> Either ArgError Arguments
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
arg_switch :: Arguments
-> ArgumentDescription
-> Bool
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
arg_times :: Arguments
-> ArgumentDescription
-> Int
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)
args_opt :: Arguments
-> ArgumentDescription
-> [Maybe String]
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
args_req :: Arguments
-> ArgumentDescription
-> [String]
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)
reqarg_opt :: Arguments
-> ArgumentDescription
-> Maybe String
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)
reqarg_req :: Arguments
-> ArgumentDescription
-> String
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))
optarg_opt :: Arguments
-> ArgumentDescription
-> Maybe (Maybe String)
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)
optarg_req :: Arguments
-> ArgumentDescription
-> Maybe String
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))
args_none :: [ArgumentDescription]
-> Arguments
-> 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
args_all :: [ArgumentDescription]
-> Arguments
-> 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
args_one :: [ArgumentDescription]
-> Arguments
-> 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
args_at_most_one :: [ArgumentDescription]
-> Arguments
-> 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
args_at_least_one :: [ArgumentDescription]
-> Arguments
-> 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
arg_conflicts :: ArgumentDescription
-> [ArgumentDescription]
-> Arguments
-> 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
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)
arg_occurs :: Arguments
-> ArgumentDescription
-> Bool
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
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))
unsafe_getargs :: String
-> [ArgumentDescription]
-> 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
unsafe_getargs_ordered :: String
-> [ArgumentDescription]
-> 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))
make_usage_info :: [ArgumentDescription]
-> Int
-> Int
-> Int
-> Int
-> [String]
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
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))
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)
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
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))
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))
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)
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_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
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
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)
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
kurzname :: ArgumentDescription -> [String]
kurzname :: ArgumentDescription -> [[Char]]
kurzname ArgumentDescription
desc =
Int -> [Char] -> [[Char]]
wrap Int
colsshort (ArgumentDescription -> [Char]
argname_short ArgumentDescription
desc)
langname :: ArgumentDescription -> [String]
langname :: ArgumentDescription -> [[Char]]
langname ArgumentDescription
desc =
Int -> [Char] -> [[Char]]
wrap Int
colslong (ArgumentDescription -> [Char]
argname_long ArgumentDescription
desc)
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
' ')
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_usage_info :: Handle
-> String
-> [ArgumentDescription]
-> IO ()
print_usage_info :: Handle -> [Char] -> [ArgumentDescription] -> IO ()
print_usage_info Handle
h [Char]
header [ArgumentDescription]
descs = do
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 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
Handle -> [Char] -> IO ()
hPutStr Handle
h ([[Char]] -> [Char]
unlines (Int -> [Char] -> [[Char]]
wrap Int
w [Char]
header))
([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)
wrap :: Int
-> String
-> [String]
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
[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
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')