    {-# 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 (Read,Show,Enum,Bounded,Eq,Ord)

    instance Default HelpFormat where def = HelpFormatDefault

    instance Show (Mode a) where
        show = show . helpTextDefault

    instance Show (Flag a) where
        show = show . helpFlag

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

    helpPrefix :: [String] -> [Text]
    helpPrefix xs = map Line xs ++ [Line "" | not $ null xs]

    helpTextDefault x = if length all > 40 then one else all
        where all = helpTextAll x
              one = helpTextOne x

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

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

    helpTextMode :: Mode a -> ([Text], [Text])
    helpTextMode x@Mode{modeGroupFlags=flags,modeGroupModes=modes} = (pre,suf)
        where
            pre = [Line $ unwords $ take 1 (modeNames x) ++
                      ["[COMMAND] ..." | notNullGroup modes] ++
                      ["[OPTIONS]" | not $ null $ fromGroup flags] ++
                      helpArgs (modeArgs x)] ++
                  [Line $ "  " ++ modeHelp x | not $ null $ modeHelp x]
            suf = space
                      ([Line "Flags:" | mixedGroup flags] ++
                       helpGroup helpFlag (modeGroupFlags x)) ++
                  space (map Line $ modeHelpSuffix x)

    helpGroup :: (a -> [Text]) -> Group a -> [Text]
    helpGroup f xs = concatMap f (groupUnnamed xs) ++ concatMap g (groupNamed xs)
        where g (a,b) = Line (a ++ ":") : concatMap f b

    helpArgs :: ([Arg a], Maybe (Arg a)) -> [String]
    helpArgs (ys,y) = [['['|o] ++ argType x ++ [']'|o] | (i,x) <- zip [0..] xs, let o = False && req <= i]
        where xs = ys ++ maybeToList y
              req = maximum $ 0 : [i | (i,x) <- zip [1..] xs, argRequire x]

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

    cols (x:xs) = Cols $ ("  "++x) : map (' ':) xs
    space xs = [Line "" | not $ null xs] ++ xs

    nullGroup x = null (groupUnnamed x) && null (groupNamed x)
    notNullGroup = not . nullGroup
    mixedGroup x = not $ null (groupUnnamed x) || null (groupNamed x) -- has both unnamed and named