-- |
-- Module: Options.Help
-- License: MIT
module Options.Help
  ( addHelpFlags,
    checkHelpFlag,
    helpFor,
    HelpFlag (..),
  )
where

import Control.Monad.Writer
import Data.Char (isSpace)
import Data.List (intercalate, partition)
import qualified Data.Map as Map
import Data.Maybe (isNothing, listToMaybe)
import qualified Data.Set as Set
import Options.Tokenize
import Options.Types

data HelpFlag = HelpSummary | HelpAll | HelpGroup String
  deriving (HelpFlag -> HelpFlag -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HelpFlag -> HelpFlag -> Bool
$c/= :: HelpFlag -> HelpFlag -> Bool
== :: HelpFlag -> HelpFlag -> Bool
$c== :: HelpFlag -> HelpFlag -> Bool
Eq, Int -> HelpFlag -> ShowS
[HelpFlag] -> ShowS
HelpFlag -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HelpFlag] -> ShowS
$cshowList :: [HelpFlag] -> ShowS
show :: HelpFlag -> String
$cshow :: HelpFlag -> String
showsPrec :: Int -> HelpFlag -> ShowS
$cshowsPrec :: Int -> HelpFlag -> ShowS
Show)

addHelpFlags :: OptionDefinitions -> OptionDefinitions
addHelpFlags :: OptionDefinitions -> OptionDefinitions
addHelpFlags (OptionDefinitions [OptionInfo]
opts [(String, [OptionInfo])]
subcmds) = [OptionInfo] -> [(String, [OptionInfo])] -> OptionDefinitions
OptionDefinitions [OptionInfo]
withHelp [(String, [OptionInfo])]
subcmdsWithHelp
  where
    shortFlags :: Set Char
shortFlags = forall a. Ord a => [a] -> Set a
Set.fromList do
      OptionInfo
opt <- [OptionInfo]
opts
      OptionInfo -> String
optionInfoShortFlags OptionInfo
opt
    longFlags :: Set String
longFlags = forall a. Ord a => [a] -> Set a
Set.fromList do
      OptionInfo
opt <- [OptionInfo]
opts
      OptionInfo -> [String]
optionInfoLongFlags OptionInfo
opt

    withHelp :: [OptionInfo]
withHelp = [OptionInfo]
optHelpSummary forall a. [a] -> [a] -> [a]
++ [OptionInfo]
optsGroupHelp forall a. [a] -> [a] -> [a]
++ [OptionInfo]
opts

    groupHelp :: Group
groupHelp =
      Group
        { groupName :: String
groupName = String
"all",
          groupTitle :: String
groupTitle = String
"Help Options",
          groupDescription :: String
groupDescription = String
"Show all help options."
        }

    optSummary :: OptionInfo
optSummary =
      OptionInfo
        { optionInfoKey :: OptionKey
optionInfoKey = OptionKey
OptionKeyHelpSummary,
          optionInfoShortFlags :: String
optionInfoShortFlags = [],
          optionInfoLongFlags :: [String]
optionInfoLongFlags = [],
          optionInfoDefault :: String
optionInfoDefault = String
"",
          optionInfoUnary :: Bool
optionInfoUnary = Bool
True,
          optionInfoUnaryOnly :: Bool
optionInfoUnaryOnly = Bool
True,
          optionInfoDescription :: String
optionInfoDescription = String
"Show option summary.",
          optionInfoGroup :: Maybe Group
optionInfoGroup = forall a. a -> Maybe a
Just Group
groupHelp,
          optionInfoLocation :: Maybe Location
optionInfoLocation = forall a. Maybe a
Nothing,
          optionInfoTypeName :: String
optionInfoTypeName = String
""
        }

    optGroupHelp :: Group -> String -> OptionInfo
optGroupHelp Group
group String
flag =
      OptionInfo
        { optionInfoKey :: OptionKey
optionInfoKey = String -> OptionKey
OptionKeyHelpGroup (Group -> String
groupName Group
group),
          optionInfoShortFlags :: String
optionInfoShortFlags = [],
          optionInfoLongFlags :: [String]
optionInfoLongFlags = [String
flag],
          optionInfoDefault :: String
optionInfoDefault = String
"",
          optionInfoUnary :: Bool
optionInfoUnary = Bool
True,
          optionInfoUnaryOnly :: Bool
optionInfoUnaryOnly = Bool
True,
          optionInfoDescription :: String
optionInfoDescription = Group -> String
groupDescription Group
group,
          optionInfoGroup :: Maybe Group
optionInfoGroup = forall a. a -> Maybe a
Just Group
groupHelp,
          optionInfoLocation :: Maybe Location
optionInfoLocation = forall a. Maybe a
Nothing,
          optionInfoTypeName :: String
optionInfoTypeName = String
""
        }

    optHelpSummary :: [OptionInfo]
optHelpSummary =
      if forall a. Ord a => a -> Set a -> Bool
Set.member Char
'h' Set Char
shortFlags
        then
          if forall a. Ord a => a -> Set a -> Bool
Set.member String
"help" Set String
longFlags
            then []
            else
              [ OptionInfo
optSummary
                  { optionInfoLongFlags :: [String]
optionInfoLongFlags = [String
"help"]
                  }
              ]
        else
          if forall a. Ord a => a -> Set a -> Bool
Set.member String
"help" Set String
longFlags
            then
              [ OptionInfo
optSummary
                  { optionInfoShortFlags :: String
optionInfoShortFlags = [Char
'h']
                  }
              ]
            else
              [ OptionInfo
optSummary
                  { optionInfoShortFlags :: String
optionInfoShortFlags = [Char
'h'],
                    optionInfoLongFlags :: [String]
optionInfoLongFlags = [String
"help"]
                  }
              ]

    optsGroupHelp :: [OptionInfo]
optsGroupHelp = do
      let ([(Group, [OptionInfo])]
groupsAndOpts, [OptionInfo]
_) = [OptionInfo] -> ([(Group, [OptionInfo])], [OptionInfo])
uniqueGroups [OptionInfo]
opts
      let groups :: [Group]
groups = [Group
g | (Group
g, [OptionInfo]
_) <- [(Group, [OptionInfo])]
groupsAndOpts]
      Group
group <- (Group
groupHelp forall a. a -> [a] -> [a]
: [Group]
groups)
      let flag :: String
flag = String
"help-" forall a. [a] -> [a] -> [a]
++ Group -> String
groupName Group
group
      if forall a. Ord a => a -> Set a -> Bool
Set.member String
flag Set String
longFlags
        then []
        else [Group -> String -> OptionInfo
optGroupHelp Group
group String
flag]

    subcmdsWithHelp :: [(String, [OptionInfo])]
subcmdsWithHelp = do
      (String
subcmdName, [OptionInfo]
subcmdOpts) <- [(String, [OptionInfo])]
subcmds
      let subcmdLongFlags :: Set String
subcmdLongFlags = forall a. Ord a => [a] -> Set a
Set.fromList do
            OptionInfo
opt <- [OptionInfo]
subcmdOpts forall a. [a] -> [a] -> [a]
++ [OptionInfo]
optsGroupHelp
            OptionInfo -> [String]
optionInfoLongFlags OptionInfo
opt

      let ([(Group, [OptionInfo])]
groupsAndOpts, [OptionInfo]
_) = [OptionInfo] -> ([(Group, [OptionInfo])], [OptionInfo])
uniqueGroups [OptionInfo]
subcmdOpts
      let groups :: [Group]
groups = [Group
g | (Group
g, [OptionInfo]
_) <- [(Group, [OptionInfo])]
groupsAndOpts]
      let newOpts :: [OptionInfo]
newOpts = do
            Group
group <- [Group]
groups
            let flag :: String
flag = String
"help-" forall a. [a] -> [a] -> [a]
++ Group -> String
groupName Group
group
            if forall a. Ord a => a -> Set a -> Bool
Set.member String
flag (forall a. Ord a => Set a -> Set a -> Set a
Set.union Set String
longFlags Set String
subcmdLongFlags)
              then []
              else [Group -> String -> OptionInfo
optGroupHelp Group
group String
flag]
      forall (m :: * -> *) a. Monad m => a -> m a
return (String
subcmdName, [OptionInfo]
newOpts forall a. [a] -> [a] -> [a]
++ [OptionInfo]
subcmdOpts)

checkHelpFlag :: Tokens -> Maybe HelpFlag
checkHelpFlag :: Tokens -> Maybe HelpFlag
checkHelpFlag Tokens
tokens = Maybe HelpFlag
flag
  where
    flag :: Maybe HelpFlag
flag = forall a. [a] -> Maybe a
listToMaybe [HelpFlag]
helpKeys
    helpKeys :: [HelpFlag]
helpKeys = do
      ([OptionKey]
k, Token
_) <- Tokens -> [([OptionKey], Token)]
tokensList Tokens
tokens
      case [OptionKey]
k of
        [OptionKey
OptionKeyHelpSummary] -> forall (m :: * -> *) a. Monad m => a -> m a
return HelpFlag
HelpSummary
        [OptionKeyHelpGroup String
"all"] -> forall (m :: * -> *) a. Monad m => a -> m a
return HelpFlag
HelpAll
        [OptionKeyHelpGroup String
name] -> forall (m :: * -> *) a. Monad m => a -> m a
return (String -> HelpFlag
HelpGroup String
name)
        [OptionKey]
_ -> []

helpFor :: HelpFlag -> OptionDefinitions -> Maybe String -> String
helpFor :: HelpFlag -> OptionDefinitions -> Maybe String -> String
helpFor HelpFlag
flag OptionDefinitions
defs Maybe String
subcmd = case HelpFlag
flag of
  HelpFlag
HelpSummary -> forall w a. Writer w a -> w
execWriter (OptionDefinitions -> Maybe String -> Writer String ()
showHelpSummary OptionDefinitions
defs Maybe String
subcmd)
  HelpFlag
HelpAll -> forall w a. Writer w a -> w
execWriter (OptionDefinitions -> Maybe String -> Writer String ()
showHelpAll OptionDefinitions
defs Maybe String
subcmd)
  HelpGroup String
name -> forall w a. Writer w a -> w
execWriter (OptionDefinitions -> String -> Maybe String -> Writer String ()
showHelpOneGroup OptionDefinitions
defs String
name Maybe String
subcmd)

showOptionHelp :: OptionInfo -> Writer String ()
showOptionHelp :: OptionInfo -> Writer String ()
showOptionHelp OptionInfo
info = do
  let safeHead :: [a] -> [a]
safeHead [a]
xs = case [a]
xs of
        [] -> []
        (a
x : [a]
_) -> [a
x]
  let shorts :: String
shorts = OptionInfo -> String
optionInfoShortFlags OptionInfo
info
  let longs :: [String]
longs = OptionInfo -> [String]
optionInfoLongFlags OptionInfo
info
  let optStrings :: [String]
optStrings = forall a b. (a -> b) -> [a] -> [b]
map (\Char
x -> [Char
'-', Char
x]) (forall {a}. [a] -> [a]
safeHead String
shorts) forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (\String
x -> String
"--" forall a. [a] -> [a] -> [a]
++ String
x) (forall {a}. [a] -> [a]
safeHead [String]
longs)
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
optStrings) do
    let optStringCsv :: String
optStringCsv = forall a. [a] -> [[a]] -> [a]
intercalate String
", " [String]
optStrings
    forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
tell String
"  "
    forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
tell String
optStringCsv
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null (OptionInfo -> String
optionInfoTypeName OptionInfo
info)) do
      forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
tell String
" :: "
      forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
tell (OptionInfo -> String
optionInfoTypeName OptionInfo
info)
    forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
tell String
"\n"
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null (OptionInfo -> String
optionInfoDescription OptionInfo
info)) do
      forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Int -> String -> [String]
wrapWords Int
76 (OptionInfo -> String
optionInfoDescription OptionInfo
info)) \String
line -> do
        forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
tell String
"    "
        forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
tell String
line
        forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
tell String
"\n"
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null (OptionInfo -> String
optionInfoDefault OptionInfo
info)) do
      forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
tell String
"    default: "
      forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
tell (OptionInfo -> String
optionInfoDefault OptionInfo
info)
      forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
tell String
"\n"

-- A simple greedy word-wrapper for fixed-width terminals, permitting overruns
-- and ragged edges.
wrapWords :: Int -> String -> [String]
wrapWords :: Int -> String -> [String]
wrapWords Int
breakWidth = String -> [String]
wrap
  where
    wrap :: String -> [String]
wrap String
line =
      if forall (t :: * -> *) a. Foldable t => t a -> Int
length String
line forall a. Ord a => a -> a -> Bool
<= Int
breakWidth
        then [String
line]
        else
          if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Char -> Bool
isBreak String
line
            then case forall a. Int -> [a] -> ([a], [a])
splitAt Int
breakWidth String
line of
              (String
beforeBreak, String
afterBreak) -> case forall a. (a -> Bool) -> [a] -> ([a], [a])
reverseBreak Char -> Bool
isBreak String
beforeBreak of
                (String
beforeWrap, String
afterWrap) -> String
beforeWrap forall a. a -> [a] -> [a]
: String -> [String]
wrap (String
afterWrap forall a. [a] -> [a] -> [a]
++ String
afterBreak)
            else [String
line]
    isBreak :: Char -> Bool
isBreak Char
c = case Char
c of
      Char
'\xA0' -> Bool
False -- NO-BREAK SPACE
      Char
'\x202F' -> Bool
False -- NARROW NO-BREAK SPACE
      Char
'\x2011' -> Bool
False -- NON-BREAKING HYPHEN
      Char
'-' -> Bool
True
      Char
_ -> Char -> Bool
isSpace Char
c
    reverseBreak :: (a -> Bool) -> [a] -> ([a], [a])
    reverseBreak :: forall a. (a -> Bool) -> [a] -> ([a], [a])
reverseBreak a -> Bool
f [a]
xs = case forall a. (a -> Bool) -> [a] -> ([a], [a])
break a -> Bool
f (forall {a}. [a] -> [a]
reverse [a]
xs) of
      ([a]
after, [a]
before) -> (forall {a}. [a] -> [a]
reverse [a]
before, forall {a}. [a] -> [a]
reverse [a]
after)

showHelpSummary :: OptionDefinitions -> Maybe String -> Writer String ()
showHelpSummary :: OptionDefinitions -> Maybe String -> Writer String ()
showHelpSummary (OptionDefinitions [OptionInfo]
mainOpts [(String, [OptionInfo])]
subcmds) Maybe String
subcmd = do
  let subcmdOptions :: Maybe (String, [OptionInfo])
subcmdOptions = do
        String
subcmdName <- Maybe String
subcmd
        [OptionInfo]
opts <- forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
subcmdName [(String, [OptionInfo])]
subcmds
        forall (m :: * -> *) a. Monad m => a -> m a
return (String
subcmdName, [OptionInfo]
opts)

  let ([(Group, [OptionInfo])]
groupInfos, [OptionInfo]
ungroupedMainOptions) = [OptionInfo] -> ([(Group, [OptionInfo])], [OptionInfo])
uniqueGroups [OptionInfo]
mainOpts

  -- Always print --help group
  let hasHelp :: [(Group, [OptionInfo])]
hasHelp = forall a. (a -> Bool) -> [a] -> [a]
filter (\(Group
g, [OptionInfo]
_) -> Group -> String
groupName Group
g forall a. Eq a => a -> a -> Bool
== String
"all") [(Group, [OptionInfo])]
groupInfos
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Group, [OptionInfo])]
hasHelp (Group, [OptionInfo]) -> Writer String ()
showHelpGroup

  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [OptionInfo]
ungroupedMainOptions) do
    forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
tell String
"Application Options:\n"
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [OptionInfo]
ungroupedMainOptions OptionInfo -> Writer String ()
showOptionHelp
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(String, [OptionInfo])]
subcmds) (forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
tell String
"\n")

  case Maybe (String, [OptionInfo])
subcmdOptions of
    Maybe (String, [OptionInfo])
Nothing -> forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(String, [OptionInfo])]
subcmds) do
      forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
tell String
"Subcommands:\n"
      forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(String, [OptionInfo])]
subcmds \(String
subcmdName, [OptionInfo]
_) -> do
        forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
tell String
"  "
        forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
tell String
subcmdName
        -- TODO: subcommand help description
        forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
tell String
"\n"
      forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
tell String
"\n"
    Just (String
n, [OptionInfo]
subOpts) -> do
      -- TODO: subcommand description
      -- TODO: handle grouped options in subcommands?
      forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
tell (String
"Options for subcommand " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
n forall a. [a] -> [a] -> [a]
++ String
":\n")
      forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [OptionInfo]
subOpts OptionInfo -> Writer String ()
showOptionHelp
      forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
tell String
"\n"

showHelpAll :: OptionDefinitions -> Maybe String -> Writer String ()
showHelpAll :: OptionDefinitions -> Maybe String -> Writer String ()
showHelpAll (OptionDefinitions [OptionInfo]
mainOpts [(String, [OptionInfo])]
subcmds) Maybe String
subcmd = do
  let subcmdOptions :: Maybe (String, [OptionInfo])
subcmdOptions = do
        String
subcmdName <- Maybe String
subcmd
        [OptionInfo]
opts <- forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
subcmdName [(String, [OptionInfo])]
subcmds
        forall (m :: * -> *) a. Monad m => a -> m a
return (String
subcmdName, [OptionInfo]
opts)

  let ([(Group, [OptionInfo])]
groupInfos, [OptionInfo]
ungroupedMainOptions) = [OptionInfo] -> ([(Group, [OptionInfo])], [OptionInfo])
uniqueGroups [OptionInfo]
mainOpts

  -- Always print --help group first, if present
  let ([(Group, [OptionInfo])]
hasHelp, [(Group, [OptionInfo])]
noHelp) = forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (\(Group
g, [OptionInfo]
_) -> Group -> String
groupName Group
g forall a. Eq a => a -> a -> Bool
== String
"all") [(Group, [OptionInfo])]
groupInfos
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Group, [OptionInfo])]
hasHelp (Group, [OptionInfo]) -> Writer String ()
showHelpGroup
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Group, [OptionInfo])]
noHelp (Group, [OptionInfo]) -> Writer String ()
showHelpGroup

  forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
tell String
"Application Options:\n"
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [OptionInfo]
ungroupedMainOptions OptionInfo -> Writer String ()
showOptionHelp
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(String, [OptionInfo])]
subcmds) (forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
tell String
"\n")

  case Maybe (String, [OptionInfo])
subcmdOptions of
    Maybe (String, [OptionInfo])
Nothing -> forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(String, [OptionInfo])]
subcmds \(String
subcmdName, [OptionInfo]
subcmdOpts) -> do
      -- no subcommand description
      forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
tell (String
"Options for subcommand " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
subcmdName forall a. [a] -> [a] -> [a]
++ String
":\n")
      forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [OptionInfo]
subcmdOpts OptionInfo -> Writer String ()
showOptionHelp
      forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
tell String
"\n"
    Just (String
n, [OptionInfo]
subOpts) -> do
      -- TODO: subcommand description
      -- TODO: handle grouped options in subcommands?
      forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
tell (String
"Options for subcommand " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
n forall a. [a] -> [a] -> [a]
++ String
":\n")
      forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [OptionInfo]
subOpts OptionInfo -> Writer String ()
showOptionHelp
      forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
tell String
"\n"

showHelpGroup :: (Group, [OptionInfo]) -> Writer String ()
showHelpGroup :: (Group, [OptionInfo]) -> Writer String ()
showHelpGroup (Group
groupInfo, [OptionInfo]
opts) = do
  forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
tell (Group -> String
groupTitle Group
groupInfo forall a. [a] -> [a] -> [a]
++ String
":\n")
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [OptionInfo]
opts OptionInfo -> Writer String ()
showOptionHelp
  forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
tell String
"\n"

showHelpOneGroup :: OptionDefinitions -> String -> Maybe String -> Writer String ()
showHelpOneGroup :: OptionDefinitions -> String -> Maybe String -> Writer String ()
showHelpOneGroup (OptionDefinitions [OptionInfo]
mainOpts [(String, [OptionInfo])]
subcmds) String
name Maybe String
subcmd = do
  let opts :: [OptionInfo]
opts = case Maybe String
subcmd of
        Maybe String
Nothing -> [OptionInfo]
mainOpts
        Just String
n -> case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
n [(String, [OptionInfo])]
subcmds of
          Just [OptionInfo]
infos -> [OptionInfo]
mainOpts forall a. [a] -> [a] -> [a]
++ [OptionInfo]
infos -- both
          Maybe [OptionInfo]
Nothing -> [OptionInfo]
mainOpts
  let ([(Group, [OptionInfo])]
groupInfos, [OptionInfo]
_) = [OptionInfo] -> ([(Group, [OptionInfo])], [OptionInfo])
uniqueGroups [OptionInfo]
opts

  -- Always print --help group
  let group :: [(Group, [OptionInfo])]
group = forall a. (a -> Bool) -> [a] -> [a]
filter (\(Group
g, [OptionInfo]
_) -> Group -> String
groupName Group
g forall a. Eq a => a -> a -> Bool
== String
name) [(Group, [OptionInfo])]
groupInfos
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Group, [OptionInfo])]
group (Group, [OptionInfo]) -> Writer String ()
showHelpGroup

uniqueGroups :: [OptionInfo] -> ([(Group, [OptionInfo])], [OptionInfo])
uniqueGroups :: [OptionInfo] -> ([(Group, [OptionInfo])], [OptionInfo])
uniqueGroups [OptionInfo]
allOptions = (forall k a. Map k a -> [a]
Map.elems Map String (Group, [OptionInfo])
infoMap, [OptionInfo]
ungroupedOptions)
  where
    infoMap :: Map String (Group, [OptionInfo])
infoMap = forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith forall {a} {a} {a}. (a, [a]) -> (a, [a]) -> (a, [a])
merge do
      OptionInfo
opt <- [OptionInfo]
allOptions
      case OptionInfo -> Maybe Group
optionInfoGroup OptionInfo
opt of
        Maybe Group
Nothing -> []
        Just Group
g -> [(Group -> String
groupName Group
g, (Group
g, [OptionInfo
opt]))]
    merge :: (a, [a]) -> (a, [a]) -> (a, [a])
merge (a
g, [a]
opts1) (a
_, [a]
opts2) = (a
g, [a]
opts2 forall a. [a] -> [a] -> [a]
++ [a]
opts1)
    ungroupedOptions :: [OptionInfo]
ungroupedOptions = [OptionInfo
o | OptionInfo
o <- [OptionInfo]
allOptions, forall a. Maybe a -> Bool
isNothing (OptionInfo -> Maybe Group
optionInfoGroup OptionInfo
o)]