{-# OPTIONS_GHC -fno-warn-orphans #-} -- Not good reasons, but shouldn't be too fatal
{-
Sample renderings:

-- ONE MODE
Program description

programname [OPTIONS] FILE1 FILE2 [FILES]
  Program to perform some action

  -f --flag     description
Flag grouping:
  -a --another  description


-- MANY MODES WITH ONE SHOWN
Program description

programname [COMMAND] [OPTIONS] ...
  Program to perform some action

Commands:
  [build]  Build action here
  test     Test action here

Flags:
  -s --special  Special for the root only
Common flags:
  -? --help     Build action here


-- MANY MODES WITH ALL SHOWN
Program description

programname [COMMAND] [OPTIONS] ...
  Program to perform some action

  -s --special  Special for the root only
Common flags:
  -? --help     Build action here

programname [build] [OPTIONS] [FILES}
  Action to perform here
-}

module System.Console.CmdArgs.Explicit.Help(HelpFormat(..), helpText) where

import System.Console.CmdArgs.Explicit.Type
import System.Console.CmdArgs.Explicit.Complete
import System.Console.CmdArgs.Text
import System.Console.CmdArgs.Default
import Data.List
import Data.Maybe


-- | Specify the format to output the help.
data HelpFormat
    = HelpFormatDefault -- ^ Equivalent to 'HelpFormatAll' if there is not too much text, otherwise 'HelpFormatOne'.
    | HelpFormatOne -- ^ Display only the first mode.
    | HelpFormatAll -- ^ Display all modes.
    | HelpFormatBash -- ^ Bash completion information
    | HelpFormatZsh -- ^ Z shell completion information
      deriving (ReadPrec [HelpFormat]
ReadPrec HelpFormat
Int -> ReadS HelpFormat
ReadS [HelpFormat]
(Int -> ReadS HelpFormat)
-> ReadS [HelpFormat]
-> ReadPrec HelpFormat
-> ReadPrec [HelpFormat]
-> Read HelpFormat
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [HelpFormat]
$creadListPrec :: ReadPrec [HelpFormat]
readPrec :: ReadPrec HelpFormat
$creadPrec :: ReadPrec HelpFormat
readList :: ReadS [HelpFormat]
$creadList :: ReadS [HelpFormat]
readsPrec :: Int -> ReadS HelpFormat
$creadsPrec :: Int -> ReadS HelpFormat
Read,Int -> HelpFormat -> ShowS
[HelpFormat] -> ShowS
HelpFormat -> String
(Int -> HelpFormat -> ShowS)
-> (HelpFormat -> String)
-> ([HelpFormat] -> ShowS)
-> Show HelpFormat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HelpFormat] -> ShowS
$cshowList :: [HelpFormat] -> ShowS
show :: HelpFormat -> String
$cshow :: HelpFormat -> String
showsPrec :: Int -> HelpFormat -> ShowS
$cshowsPrec :: Int -> HelpFormat -> ShowS
Show,Int -> HelpFormat
HelpFormat -> Int
HelpFormat -> [HelpFormat]
HelpFormat -> HelpFormat
HelpFormat -> HelpFormat -> [HelpFormat]
HelpFormat -> HelpFormat -> HelpFormat -> [HelpFormat]
(HelpFormat -> HelpFormat)
-> (HelpFormat -> HelpFormat)
-> (Int -> HelpFormat)
-> (HelpFormat -> Int)
-> (HelpFormat -> [HelpFormat])
-> (HelpFormat -> HelpFormat -> [HelpFormat])
-> (HelpFormat -> HelpFormat -> [HelpFormat])
-> (HelpFormat -> HelpFormat -> HelpFormat -> [HelpFormat])
-> Enum HelpFormat
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: HelpFormat -> HelpFormat -> HelpFormat -> [HelpFormat]
$cenumFromThenTo :: HelpFormat -> HelpFormat -> HelpFormat -> [HelpFormat]
enumFromTo :: HelpFormat -> HelpFormat -> [HelpFormat]
$cenumFromTo :: HelpFormat -> HelpFormat -> [HelpFormat]
enumFromThen :: HelpFormat -> HelpFormat -> [HelpFormat]
$cenumFromThen :: HelpFormat -> HelpFormat -> [HelpFormat]
enumFrom :: HelpFormat -> [HelpFormat]
$cenumFrom :: HelpFormat -> [HelpFormat]
fromEnum :: HelpFormat -> Int
$cfromEnum :: HelpFormat -> Int
toEnum :: Int -> HelpFormat
$ctoEnum :: Int -> HelpFormat
pred :: HelpFormat -> HelpFormat
$cpred :: HelpFormat -> HelpFormat
succ :: HelpFormat -> HelpFormat
$csucc :: HelpFormat -> HelpFormat
Enum,HelpFormat
HelpFormat -> HelpFormat -> Bounded HelpFormat
forall a. a -> a -> Bounded a
maxBound :: HelpFormat
$cmaxBound :: HelpFormat
minBound :: HelpFormat
$cminBound :: HelpFormat
Bounded,HelpFormat -> HelpFormat -> Bool
(HelpFormat -> HelpFormat -> Bool)
-> (HelpFormat -> HelpFormat -> Bool) -> Eq HelpFormat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HelpFormat -> HelpFormat -> Bool
$c/= :: HelpFormat -> HelpFormat -> Bool
== :: HelpFormat -> HelpFormat -> Bool
$c== :: HelpFormat -> HelpFormat -> Bool
Eq,Eq HelpFormat
Eq HelpFormat
-> (HelpFormat -> HelpFormat -> Ordering)
-> (HelpFormat -> HelpFormat -> Bool)
-> (HelpFormat -> HelpFormat -> Bool)
-> (HelpFormat -> HelpFormat -> Bool)
-> (HelpFormat -> HelpFormat -> Bool)
-> (HelpFormat -> HelpFormat -> HelpFormat)
-> (HelpFormat -> HelpFormat -> HelpFormat)
-> Ord HelpFormat
HelpFormat -> HelpFormat -> Bool
HelpFormat -> HelpFormat -> Ordering
HelpFormat -> HelpFormat -> HelpFormat
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 :: HelpFormat -> HelpFormat -> HelpFormat
$cmin :: HelpFormat -> HelpFormat -> HelpFormat
max :: HelpFormat -> HelpFormat -> HelpFormat
$cmax :: HelpFormat -> HelpFormat -> HelpFormat
>= :: HelpFormat -> HelpFormat -> Bool
$c>= :: HelpFormat -> HelpFormat -> Bool
> :: HelpFormat -> HelpFormat -> Bool
$c> :: HelpFormat -> HelpFormat -> Bool
<= :: HelpFormat -> HelpFormat -> Bool
$c<= :: HelpFormat -> HelpFormat -> Bool
< :: HelpFormat -> HelpFormat -> Bool
$c< :: HelpFormat -> HelpFormat -> Bool
compare :: HelpFormat -> HelpFormat -> Ordering
$ccompare :: HelpFormat -> HelpFormat -> Ordering
$cp1Ord :: Eq HelpFormat
Ord)

instance Default HelpFormat where def :: HelpFormat
def = HelpFormat
HelpFormatDefault


instance Show (Mode a) where
    show :: Mode a -> String
show = [Text] -> String
forall a. Show a => a -> String
show ([Text] -> String) -> (Mode a -> [Text]) -> Mode a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mode a -> [Text]
forall a. Mode a -> [Text]
helpTextDefault

instance Show (Flag a) where
    show :: Flag a -> String
show = [Text] -> String
forall a. Show a => a -> String
show ([Text] -> String) -> (Flag a -> [Text]) -> Flag a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flag a -> [Text]
forall a. Flag a -> [Text]
helpFlag

instance Show (Arg a) where
    show :: Arg a -> String
show = ShowS
forall a. Show a => a -> String
show ShowS -> (Arg a -> String) -> Arg a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arg a -> String
forall a. Arg a -> String
argType

-- | Generate a help message from a mode.  The first argument is a prefix,
--   which is prepended when not using 'HelpFormatBash' or 'HelpFormatZsh'.
helpText :: [String] -> HelpFormat -> Mode a -> [Text]
helpText :: [String] -> HelpFormat -> Mode a -> [Text]
helpText [String]
pre HelpFormat
HelpFormatDefault Mode a
x = [String] -> [Text]
helpPrefix [String]
pre [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ Mode a -> [Text]
forall a. Mode a -> [Text]
helpTextDefault Mode a
x
helpText [String]
pre HelpFormat
HelpFormatOne Mode a
x = [String] -> [Text]
helpPrefix [String]
pre [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ Mode a -> [Text]
forall a. Mode a -> [Text]
helpTextOne Mode a
x
helpText [String]
pre HelpFormat
HelpFormatAll Mode a
x = [String] -> [Text]
helpPrefix [String]
pre [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ Mode a -> [Text]
forall a. Mode a -> [Text]
helpTextAll Mode a
x
helpText [String]
pre HelpFormat
HelpFormatBash Mode a
x = (String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map String -> Text
Line ([String] -> [Text]) -> [String] -> [Text]
forall a b. (a -> b) -> a -> b
$ String -> [String]
completeBash (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall a. [a] -> a
head ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ Mode a -> [String]
forall a. Mode a -> [String]
modeNames Mode a
x [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"unknown"]
helpText [String]
pre HelpFormat
HelpFormatZsh Mode a
x = (String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map String -> Text
Line ([String] -> [Text]) -> [String] -> [Text]
forall a b. (a -> b) -> a -> b
$ String -> [String]
completeZsh (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall a. [a] -> a
head ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ Mode a -> [String]
forall a. Mode a -> [String]
modeNames Mode a
x [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"unknown"]


helpPrefix :: [String] -> [Text]
helpPrefix :: [String] -> [Text]
helpPrefix [String]
xs = (String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map String -> Text
Line [String]
xs [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [String -> Text
Line String
"" | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
xs]


helpTextDefault :: Mode a -> [Text]
helpTextDefault Mode a
x = if [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
all Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
40 then [Text]
one else [Text]
all
    where all :: [Text]
all = Mode a -> [Text]
forall a. Mode a -> [Text]
helpTextAll Mode a
x
          one :: [Text]
one = Mode a -> [Text]
forall a. Mode a -> [Text]
helpTextOne Mode a
x


-- | Help text for all modes
--
-- > <program> [OPTIONS] <file_args>
-- > <options>
-- > <program> MODE [SUBMODE] [OPTIONS] [FLAG]
helpTextAll :: Mode a -> [Text]
helpTextAll :: Mode a -> [Text]
helpTextAll = Mode a -> [Text]
forall a. Mode a -> [Text]
disp (Mode a -> [Text]) -> (Mode a -> Mode a) -> Mode a -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Mode a -> Mode a
forall a. String -> Mode a -> Mode a
push String
""
    where
        disp :: Mode a -> [Text]
disp Mode a
m = ([Text] -> [Text] -> [Text]) -> ([Text], [Text]) -> [Text]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
(++) (Mode a -> ([Text], [Text])
forall a. Mode a -> ([Text], [Text])
helpTextMode Mode a
m) [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ (Mode a -> [Text]) -> [Mode a] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Mode a
x -> String -> Text
Line String
"" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Mode a -> [Text]
disp Mode a
x) (Mode a -> [Mode a]
forall a. Mode a -> [Mode a]
modeModes Mode a
m)
        push :: String -> Mode a -> Mode a
push String
s Mode a
m = Mode a
m{modeNames :: [String]
modeNames = ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
sString -> ShowS
forall a. [a] -> [a] -> [a]
++) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ Mode a -> [String]
forall a. Mode a -> [String]
modeNames Mode a
m
                    ,modeGroupModes :: Group (Mode a)
modeGroupModes = (Mode a -> Mode a) -> Group (Mode a) -> Group (Mode a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> Mode a -> Mode a
push String
s2) (Group (Mode a) -> Group (Mode a))
-> Group (Mode a) -> Group (Mode a)
forall a b. (a -> b) -> a -> b
$ Mode a -> Group (Mode a)
forall a. Mode a -> Group (Mode a)
modeGroupModes Mode a
m}
            where s2 :: String
s2 = String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
1 ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ Mode a -> [String]
forall a. Mode a -> [String]
modeNames Mode a
m) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" "


-- | Help text for only this mode
--
-- > <program> [OPTIONS] <file_args>
-- > <options>
-- > <program> MODE [FLAGS]
-- > <options>
helpTextOne :: Mode a -> [Text]
helpTextOne :: Mode a -> [Text]
helpTextOne Mode a
m = [Text]
pre [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
ms [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
suf
    where
        ([Text]
pre,[Text]
suf) = Mode a -> ([Text], [Text])
forall a. Mode a -> ([Text], [Text])
helpTextMode Mode a
m
        ms :: [Text]
ms = [Text] -> [Text]
space ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ [String -> Text
Line String
"Commands:" | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Mode a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Mode a] -> Bool) -> [Mode a] -> Bool
forall a b. (a -> b) -> a -> b
$ Group (Mode a) -> [Mode a]
forall a. Group a -> [a]
groupUnnamed (Group (Mode a) -> [Mode a]) -> Group (Mode a) -> [Mode a]
forall a b. (a -> b) -> a -> b
$ Mode a -> Group (Mode a)
forall a. Mode a -> Group (Mode a)
modeGroupModes Mode a
m] [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ (Mode a -> [Text]) -> Group (Mode a) -> [Text]
forall a. (a -> [Text]) -> Group a -> [Text]
helpGroup Mode a -> [Text]
forall (m :: * -> *) a. Monad m => Mode a -> m Text
f (Mode a -> Group (Mode a)
forall a. Mode a -> Group (Mode a)
modeGroupModes Mode a
m)
        f :: Mode a -> m Text
f Mode a
m = Text -> m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$ [String] -> Text
cols [[String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
1 ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ Mode a -> [String]
forall a. Mode a -> [String]
modeNames Mode a
m, Char
' ' Char -> ShowS
forall a. a -> [a] -> [a]
: Mode a -> String
forall a. Mode a -> String
modeHelp Mode a
m]


helpTextMode :: Mode a -> ([Text], [Text])
helpTextMode :: Mode a -> ([Text], [Text])
helpTextMode x :: Mode a
x@Mode{modeGroupFlags :: forall a. Mode a -> Group (Flag a)
modeGroupFlags=Group (Flag a)
flags,modeGroupModes :: forall a. Mode a -> Group (Mode a)
modeGroupModes=Group (Mode a)
modes} = ([Text]
pre,[Text]
suf)
    where
        pre :: [Text]
pre = [String -> Text
Line (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
1 (Mode a -> [String]
forall a. Mode a -> [String]
modeNames Mode a
x) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
                  [String
"[COMMAND] ..." | Group (Mode a) -> Bool
forall a. Group a -> Bool
notNullGroup Group (Mode a)
modes] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
                  [String
"[OPTIONS]" | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Flag a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Flag a] -> Bool) -> [Flag a] -> Bool
forall a b. (a -> b) -> a -> b
$ Group (Flag a) -> [Flag a]
forall a. Group a -> [a]
fromGroup Group (Flag a)
flags] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
                  ([Arg a], Maybe (Arg a)) -> [String]
forall a. ([Arg a], Maybe (Arg a)) -> [String]
helpArgs (Mode a -> ([Arg a], Maybe (Arg a))
forall a. Mode a -> ([Arg a], Maybe (Arg a))
modeArgs Mode a
x)] [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++
              [String -> Text
Line (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"  " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Mode a -> String
forall a. Mode a -> String
modeHelp Mode a
x | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ Mode a -> String
forall a. Mode a -> String
modeHelp Mode a
x]
        suf :: [Text]
suf = [Text] -> [Text]
space
                  ([String -> Text
Line String
"Flags:" | Group (Flag a) -> Bool
forall a. Group a -> Bool
mixedGroup Group (Flag a)
flags] [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++
                   (Flag a -> [Text]) -> Group (Flag a) -> [Text]
forall a. (a -> [Text]) -> Group a -> [Text]
helpGroup Flag a -> [Text]
forall a. Flag a -> [Text]
helpFlag (Mode a -> Group (Flag a)
forall a. Mode a -> Group (Flag a)
modeGroupFlags Mode a
x)) [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++
              [Text] -> [Text]
space ((String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map String -> Text
Line ([String] -> [Text]) -> [String] -> [Text]
forall a b. (a -> b) -> a -> b
$ Mode a -> [String]
forall a. Mode a -> [String]
modeHelpSuffix Mode a
x)


helpGroup :: (a -> [Text]) -> Group a -> [Text]
helpGroup :: (a -> [Text]) -> Group a -> [Text]
helpGroup a -> [Text]
f Group a
xs = (a -> [Text]) -> [a] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap a -> [Text]
f (Group a -> [a]
forall a. Group a -> [a]
groupUnnamed Group a
xs) [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ ((String, [a]) -> [Text]) -> [(String, [a])] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (String, [a]) -> [Text]
forall (t :: * -> *). Foldable t => (String, t a) -> [Text]
g (Group a -> [(String, [a])]
forall a. Group a -> [(String, [a])]
groupNamed Group a
xs)
    where g :: (String, t a) -> [Text]
g (String
a,t a
b) = String -> Text
Line (String
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":") Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: (a -> [Text]) -> t a -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap a -> [Text]
f t a
b


helpArgs :: ([Arg a], Maybe (Arg a)) -> [String]
helpArgs :: ([Arg a], Maybe (Arg a)) -> [String]
helpArgs ([Arg a]
ys,Maybe (Arg a)
y) = [[Char
'['|Bool
o] String -> ShowS
forall a. [a] -> [a] -> [a]
++ Arg a -> String
forall a. Arg a -> String
argType Arg a
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
']'|Bool
o] | (Integer
i,Arg a
x) <- [Integer] -> [Arg a] -> [(Integer, Arg a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
0..] [Arg a]
xs, let o :: Bool
o = Bool
False Bool -> Bool -> Bool
&& Integer
req Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
i]
    where xs :: [Arg a]
xs = [Arg a]
ys [Arg a] -> [Arg a] -> [Arg a]
forall a. [a] -> [a] -> [a]
++ Maybe (Arg a) -> [Arg a]
forall a. Maybe a -> [a]
maybeToList Maybe (Arg a)
y
          req :: Integer
req = [Integer] -> Integer
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Integer] -> Integer) -> [Integer] -> Integer
forall a b. (a -> b) -> a -> b
$ Integer
0 Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
: [Integer
i | (Integer
i,Arg a
x) <- [Integer] -> [Arg a] -> [(Integer, Arg a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
1..] [Arg a]
xs, Arg a -> Bool
forall a. Arg a -> Bool
argRequire Arg a
x]


helpFlag :: Flag a -> [Text]
helpFlag :: Flag a -> [Text]
helpFlag Flag a
x = [[String] -> Text
cols [[String] -> String
unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
"-"String -> ShowS
forall a. [a] -> [a] -> [a]
++) [String]
a2, [String] -> String
unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
"--"String -> ShowS
forall a. [a] -> [a] -> [a]
++) [String]
b2, Char
' ' Char -> ShowS
forall a. a -> [a] -> [a]
: Flag a -> String
forall a. Flag a -> String
flagHelp Flag a
x]]
        where
            ([String]
a,[String]
b) = (String -> Bool) -> [String] -> ([String], [String])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
(==) Int
1 (Int -> Bool) -> (String -> Int) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) ([String] -> ([String], [String]))
-> [String] -> ([String], [String])
forall a b. (a -> b) -> a -> b
$ Flag a -> [String]
forall a. Flag a -> [String]
flagNames Flag a
x
            ([String]
a2,[String]
b2) = if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
b then ([String] -> String -> [String]
forall a. [[a]] -> [a] -> [[a]]
add [String]
a String
opt, [String]
b) else ([String]
a, [String] -> String -> [String]
forall a. [[a]] -> [a] -> [[a]]
add [String]
b String
opt)
            add :: [[a]] -> [a] -> [[a]]
add [[a]]
x [a]
y = if [[a]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[a]]
x then [[a]]
x else ([[a]] -> [a]
forall a. [a] -> a
head [[a]]
x [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
y) [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [[a]] -> [[a]]
forall a. [a] -> [a]
tail [[a]]
x
            hlp :: String
hlp = if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Flag a -> String
forall a. Flag a -> String
flagType Flag a
x) then String
"ITEM" else Flag a -> String
forall a. Flag a -> String
flagType Flag a
x
            opt :: String
opt = case Flag a -> FlagInfo
forall a. Flag a -> FlagInfo
flagInfo Flag a
x of
                FlagInfo
FlagReq -> Char
'=' Char -> ShowS
forall a. a -> [a] -> [a]
: String
hlp
                FlagOpt String
x -> String
"[=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
hlp String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]"
                FlagInfo
_ -> String
""

cols :: [String] -> Text
cols (String
x:[String]
xs) = [String] -> Text
Cols ([String] -> Text) -> [String] -> Text
forall a b. (a -> b) -> a -> b
$ (String
"  "String -> ShowS
forall a. [a] -> [a] -> [a]
++String
x) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Char
' 'Char -> ShowS
forall a. a -> [a] -> [a]
:) [String]
xs
space :: [Text] -> [Text]
space [Text]
xs = [String -> Text
Line String
"" | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
xs] [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
xs


nullGroup :: Group a -> Bool
nullGroup Group a
x = [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Group a -> [a]
forall a. Group a -> [a]
groupUnnamed Group a
x) Bool -> Bool -> Bool
&& [(String, [a])] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Group a -> [(String, [a])]
forall a. Group a -> [(String, [a])]
groupNamed Group a
x)
notNullGroup :: Group a -> Bool
notNullGroup = Bool -> Bool
not (Bool -> Bool) -> (Group a -> Bool) -> Group a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Group a -> Bool
forall a. Group a -> Bool
nullGroup
mixedGroup :: Group a -> Bool
mixedGroup Group a
x = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Group a -> [a]
forall a. Group a -> [a]
groupUnnamed Group a
x) Bool -> Bool -> Bool
|| [(String, [a])] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Group a -> [(String, [a])]
forall a. Group a -> [(String, [a])]
groupNamed Group a
x) -- has both unnamed and named