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"
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
Char
'\x202F' -> Bool
False
Char
'\x2011' -> Bool
False
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
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
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
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
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
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
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
Maybe [OptionInfo]
Nothing -> [OptionInfo]
mainOpts
let ([(Group, [OptionInfo])]
groupInfos, [OptionInfo]
_) = [OptionInfo] -> ([(Group, [OptionInfo])], [OptionInfo])
uniqueGroups [OptionInfo]
opts
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)]