{-# 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]
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
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]
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
forall a. a -> a -> Bounded a
maxBound :: HelpFormat
$cmaxBound :: HelpFormat
minBound :: HelpFormat
$cminBound :: HelpFormat
Bounded,HelpFormat -> HelpFormat -> Bool
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
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
Ord)

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


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

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

instance Show (Arg a) where
    show :: Arg a -> String
show = forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a. [String] -> HelpFormat -> Mode a -> [Text]
helpText [String]
pre HelpFormat
HelpFormatDefault Mode a
x = [String] -> [Text]
helpPrefix [String]
pre forall a. [a] -> [a] -> [a]
++ forall {a}. Mode a -> [Text]
helpTextDefault Mode a
x
helpText [String]
pre HelpFormat
HelpFormatOne Mode a
x = [String] -> [Text]
helpPrefix [String]
pre forall a. [a] -> [a] -> [a]
++ forall {a}. Mode a -> [Text]
helpTextOne Mode a
x
helpText [String]
pre HelpFormat
HelpFormatAll Mode a
x = [String] -> [Text]
helpPrefix [String]
pre forall a. [a] -> [a] -> [a]
++ forall {a}. Mode a -> [Text]
helpTextAll Mode a
x
helpText [String]
pre HelpFormat
HelpFormatBash Mode a
x = forall a b. (a -> b) -> [a] -> [b]
map String -> Text
Line forall a b. (a -> b) -> a -> b
$ String -> [String]
completeBash forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ forall a. Mode a -> [String]
modeNames Mode a
x forall a. [a] -> [a] -> [a]
++ [String
"unknown"]
helpText [String]
pre HelpFormat
HelpFormatZsh Mode a
x = forall a b. (a -> b) -> [a] -> [b]
map String -> Text
Line forall a b. (a -> b) -> a -> b
$ String -> [String]
completeZsh forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ forall a. Mode a -> [String]
modeNames Mode a
x forall a. [a] -> [a] -> [a]
++ [String
"unknown"]


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


helpTextDefault :: Mode a -> [Text]
helpTextDefault Mode a
x = if forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
all forall a. Ord a => a -> a -> Bool
> Int
40 then [Text]
one else [Text]
all
    where all :: [Text]
all = forall {a}. Mode a -> [Text]
helpTextAll Mode a
x
          one :: [Text]
one = 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 :: forall {a}. Mode a -> [Text]
helpTextAll = forall {a}. Mode a -> [Text]
disp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. String -> Mode a -> Mode a
push String
""
    where
        disp :: Mode a -> [Text]
disp Mode a
m = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. [a] -> [a] -> [a]
(++) (forall a. Mode a -> ([Text], [Text])
helpTextMode Mode a
m) forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Mode a
x -> String -> Text
Line String
"" forall a. a -> [a] -> [a]
: Mode a -> [Text]
disp Mode a
x) (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 = forall a b. (a -> b) -> [a] -> [b]
map (String
sforall a. [a] -> [a] -> [a]
++) forall a b. (a -> b) -> a -> b
$ forall a. Mode a -> [String]
modeNames Mode a
m
                    ,modeGroupModes :: Group (Mode a)
modeGroupModes = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> Mode a -> Mode a
push String
s2) forall a b. (a -> b) -> a -> b
$ forall a. Mode a -> Group (Mode a)
modeGroupModes Mode a
m}
            where s2 :: String
s2 = String
s forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall a. Int -> [a] -> [a]
take Int
1 forall a b. (a -> b) -> a -> b
$ forall a. Mode a -> [String]
modeNames Mode a
m) 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 :: forall {a}. Mode a -> [Text]
helpTextOne Mode a
m = [Text]
pre forall a. [a] -> [a] -> [a]
++ [Text]
ms forall a. [a] -> [a] -> [a]
++ [Text]
suf
    where
        ([Text]
pre,[Text]
suf) = forall a. Mode a -> ([Text], [Text])
helpTextMode Mode a
m
        ms :: [Text]
ms = [Text] -> [Text]
space forall a b. (a -> b) -> a -> b
$ [String -> Text
Line String
"Commands:" | Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall a b. (a -> b) -> a -> b
$ forall a. Group a -> [a]
groupUnnamed forall a b. (a -> b) -> a -> b
$ forall a. Mode a -> Group (Mode a)
modeGroupModes Mode a
m] forall a. [a] -> [a] -> [a]
++ forall a. (a -> [Text]) -> Group a -> [Text]
helpGroup forall {m :: * -> *} {a}. Monad m => Mode a -> m Text
f (forall a. Mode a -> Group (Mode a)
modeGroupModes Mode a
m)
        f :: Mode a -> m Text
f Mode a
m = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [String] -> Text
cols [forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
take Int
1 forall a b. (a -> b) -> a -> b
$ forall a. Mode a -> [String]
modeNames Mode a
m, Char
' ' forall a. a -> [a] -> [a]
: forall a. Mode a -> String
modeHelp Mode a
m]


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


helpGroup :: (a -> [Text]) -> Group a -> [Text]
helpGroup :: forall a. (a -> [Text]) -> Group a -> [Text]
helpGroup a -> [Text]
f Group a
xs = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap a -> [Text]
f (forall a. Group a -> [a]
groupUnnamed Group a
xs) forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall {t :: * -> *}. Foldable t => (String, t a) -> [Text]
g (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 forall a. [a] -> [a] -> [a]
++ String
":") forall a. a -> [a] -> [a]
: 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 :: forall a. ([Arg a], Maybe (Arg a)) -> [String]
helpArgs ([Arg a]
ys,Maybe (Arg a)
y) = [[Char
'['|Bool
o] forall a. [a] -> [a] -> [a]
++ forall a. Arg a -> String
argType Arg a
x forall a. [a] -> [a] -> [a]
++ [Char
']'|Bool
o] | (Integer
i,Arg a
x) <- forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
0..] [Arg a]
xs, let o :: Bool
o = Bool
False Bool -> Bool -> Bool
&& Integer
req forall a. Ord a => a -> a -> Bool
<= Integer
i]
    where xs :: [Arg a]
xs = [Arg a]
ys forall a. [a] -> [a] -> [a]
++ forall a. Maybe a -> [a]
maybeToList Maybe (Arg a)
y
          req :: Integer
req = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall a b. (a -> b) -> a -> b
$ Integer
0 forall a. a -> [a] -> [a]
: [Integer
i | (Integer
i,Arg a
x) <- forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
1..] [Arg a]
xs, forall a. Arg a -> Bool
argRequire Arg a
x]


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

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


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