module Options.Help
( addHelpFlags
, checkHelpFlag
, helpFor
, HelpFlag(..)
) where
import Control.Monad.Writer
import Data.Char (isSpace)
import Data.List (intercalate, partition)
import Data.Maybe (isNothing, listToMaybe)
import qualified Data.Set as Set
import qualified Data.Map as Map
import Options.Tokenize
import Options.Types
data HelpFlag = HelpSummary | HelpAll | HelpGroup String
deriving (HelpFlag -> HelpFlag -> Bool
(HelpFlag -> HelpFlag -> Bool)
-> (HelpFlag -> HelpFlag -> Bool) -> Eq HelpFlag
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
(Int -> HelpFlag -> ShowS)
-> (HelpFlag -> String) -> ([HelpFlag] -> ShowS) -> Show HelpFlag
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 opts :: [OptionInfo]
opts subcmds :: [(String, [OptionInfo])]
subcmds) = [OptionInfo] -> [(String, [OptionInfo])] -> OptionDefinitions
OptionDefinitions [OptionInfo]
withHelp [(String, [OptionInfo])]
subcmdsWithHelp where
shortFlags :: Set Char
shortFlags = String -> Set Char
forall a. Ord a => [a] -> Set a
Set.fromList (String -> Set Char) -> String -> Set Char
forall a b. (a -> b) -> a -> b
$ do
OptionInfo
opt <- [OptionInfo]
opts
OptionInfo -> String
optionInfoShortFlags OptionInfo
opt
longFlags :: Set String
longFlags = [String] -> Set String
forall a. Ord a => [a] -> Set a
Set.fromList ([String] -> Set String) -> [String] -> Set String
forall a b. (a -> b) -> a -> b
$ do
OptionInfo
opt <- [OptionInfo]
opts
OptionInfo -> [String]
optionInfoLongFlags OptionInfo
opt
withHelp :: [OptionInfo]
withHelp = [OptionInfo]
optHelpSummary [OptionInfo] -> [OptionInfo] -> [OptionInfo]
forall a. [a] -> [a] -> [a]
++ [OptionInfo]
optsGroupHelp [OptionInfo] -> [OptionInfo] -> [OptionInfo]
forall a. [a] -> [a] -> [a]
++ [OptionInfo]
opts
groupHelp :: Group
groupHelp = Group :: String -> String -> String -> Group
Group
{ groupName :: String
groupName = "all"
, groupTitle :: String
groupTitle = "Help Options"
, groupDescription :: String
groupDescription = "Show all help options."
}
optSummary :: OptionInfo
optSummary = OptionInfo :: OptionKey
-> String
-> [String]
-> String
-> Bool
-> Bool
-> String
-> Maybe Group
-> Maybe Location
-> String
-> OptionInfo
OptionInfo
{ optionInfoKey :: OptionKey
optionInfoKey = OptionKey
OptionKeyHelpSummary
, optionInfoShortFlags :: String
optionInfoShortFlags = []
, optionInfoLongFlags :: [String]
optionInfoLongFlags = []
, optionInfoDefault :: String
optionInfoDefault = ""
, optionInfoUnary :: Bool
optionInfoUnary = Bool
True
, optionInfoUnaryOnly :: Bool
optionInfoUnaryOnly = Bool
True
, optionInfoDescription :: String
optionInfoDescription = "Show option summary."
, optionInfoGroup :: Maybe Group
optionInfoGroup = Group -> Maybe Group
forall a. a -> Maybe a
Just Group
groupHelp
, optionInfoLocation :: Maybe Location
optionInfoLocation = Maybe Location
forall a. Maybe a
Nothing
, optionInfoTypeName :: String
optionInfoTypeName = ""
}
optGroupHelp :: Group -> String -> OptionInfo
optGroupHelp group :: Group
group flag :: String
flag = OptionInfo :: OptionKey
-> String
-> [String]
-> String
-> Bool
-> Bool
-> String
-> Maybe Group
-> Maybe Location
-> String
-> OptionInfo
OptionInfo
{ optionInfoKey :: OptionKey
optionInfoKey = String -> OptionKey
OptionKeyHelpGroup (Group -> String
groupName Group
group)
, optionInfoShortFlags :: String
optionInfoShortFlags = []
, optionInfoLongFlags :: [String]
optionInfoLongFlags = [String
flag]
, optionInfoDefault :: String
optionInfoDefault = ""
, optionInfoUnary :: Bool
optionInfoUnary = Bool
True
, optionInfoUnaryOnly :: Bool
optionInfoUnaryOnly = Bool
True
, optionInfoDescription :: String
optionInfoDescription = Group -> String
groupDescription Group
group
, optionInfoGroup :: Maybe Group
optionInfoGroup = Group -> Maybe Group
forall a. a -> Maybe a
Just Group
groupHelp
, optionInfoLocation :: Maybe Location
optionInfoLocation = Maybe Location
forall a. Maybe a
Nothing
, optionInfoTypeName :: String
optionInfoTypeName = ""
}
optHelpSummary :: [OptionInfo]
optHelpSummary = if Char -> Set Char -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member 'h' Set Char
shortFlags
then if String -> Set String -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member "help" Set String
longFlags
then []
else [OptionInfo
optSummary
{ optionInfoLongFlags :: [String]
optionInfoLongFlags = ["help"]
}]
else if String -> Set String -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member "help" Set String
longFlags
then [OptionInfo
optSummary
{ optionInfoShortFlags :: String
optionInfoShortFlags = ['h']
}]
else [OptionInfo
optSummary
{ optionInfoShortFlags :: String
optionInfoShortFlags = ['h']
, optionInfoLongFlags :: [String]
optionInfoLongFlags = ["help"]
}]
optsGroupHelp :: [OptionInfo]
optsGroupHelp = do
let (groupsAndOpts :: [(Group, [OptionInfo])]
groupsAndOpts, _) = [OptionInfo] -> ([(Group, [OptionInfo])], [OptionInfo])
uniqueGroups [OptionInfo]
opts
let groups :: [Group]
groups = [Group
g | (g :: Group
g, _) <- [(Group, [OptionInfo])]
groupsAndOpts]
Group
group <- (Group
groupHelp Group -> [Group] -> [Group]
forall a. a -> [a] -> [a]
: [Group]
groups)
let flag :: String
flag = "help-" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Group -> String
groupName Group
group
if String -> Set String -> Bool
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
(subcmdName :: String
subcmdName, subcmdOpts :: [OptionInfo]
subcmdOpts) <- [(String, [OptionInfo])]
subcmds
let subcmdLongFlags :: Set String
subcmdLongFlags = [String] -> Set String
forall a. Ord a => [a] -> Set a
Set.fromList ([String] -> Set String) -> [String] -> Set String
forall a b. (a -> b) -> a -> b
$ do
OptionInfo
opt <- [OptionInfo]
subcmdOpts [OptionInfo] -> [OptionInfo] -> [OptionInfo]
forall a. [a] -> [a] -> [a]
++ [OptionInfo]
optsGroupHelp
OptionInfo -> [String]
optionInfoLongFlags OptionInfo
opt
let (groupsAndOpts :: [(Group, [OptionInfo])]
groupsAndOpts, _) = [OptionInfo] -> ([(Group, [OptionInfo])], [OptionInfo])
uniqueGroups [OptionInfo]
subcmdOpts
let groups :: [Group]
groups = [Group
g | (g :: Group
g, _) <- [(Group, [OptionInfo])]
groupsAndOpts]
let newOpts :: [OptionInfo]
newOpts = do
Group
group <- [Group]
groups
let flag :: String
flag = "help-" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Group -> String
groupName Group
group
if String -> Set String -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member String
flag (Set String -> Set String -> Set String
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]
(String, [OptionInfo]) -> [(String, [OptionInfo])]
forall (m :: * -> *) a. Monad m => a -> m a
return (String
subcmdName, [OptionInfo]
newOpts [OptionInfo] -> [OptionInfo] -> [OptionInfo]
forall a. [a] -> [a] -> [a]
++ [OptionInfo]
subcmdOpts)
checkHelpFlag :: Tokens -> Maybe HelpFlag
checkHelpFlag :: Tokens -> Maybe HelpFlag
checkHelpFlag tokens :: Tokens
tokens = Maybe HelpFlag
flag where
flag :: Maybe HelpFlag
flag = [HelpFlag] -> Maybe HelpFlag
forall a. [a] -> Maybe a
listToMaybe [HelpFlag]
helpKeys
helpKeys :: [HelpFlag]
helpKeys = do
(k :: [OptionKey]
k, _) <- Tokens -> [([OptionKey], Token)]
tokensList Tokens
tokens
case [OptionKey]
k of
[OptionKeyHelpSummary] -> HelpFlag -> [HelpFlag]
forall (m :: * -> *) a. Monad m => a -> m a
return HelpFlag
HelpSummary
[OptionKeyHelpGroup "all"] -> HelpFlag -> [HelpFlag]
forall (m :: * -> *) a. Monad m => a -> m a
return HelpFlag
HelpAll
[OptionKeyHelpGroup name :: String
name] -> HelpFlag -> [HelpFlag]
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> HelpFlag
HelpGroup String
name)
_ -> []
helpFor :: HelpFlag -> OptionDefinitions -> Maybe String -> String
helpFor :: HelpFlag -> OptionDefinitions -> Maybe String -> String
helpFor flag :: HelpFlag
flag defs :: OptionDefinitions
defs subcmd :: Maybe String
subcmd = case HelpFlag
flag of
HelpSummary -> Writer String () -> String
forall w a. Writer w a -> w
execWriter (OptionDefinitions -> Maybe String -> Writer String ()
showHelpSummary OptionDefinitions
defs Maybe String
subcmd)
HelpAll -> Writer String () -> String
forall w a. Writer w a -> w
execWriter (OptionDefinitions -> Maybe String -> Writer String ()
showHelpAll OptionDefinitions
defs Maybe String
subcmd)
HelpGroup name :: String
name -> Writer String () -> String
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 info :: OptionInfo
info = do
let safeHead :: [a] -> [a]
safeHead xs :: [a]
xs = case [a]
xs of
[] -> []
(x :: a
x:_) -> [a
x]
let shorts :: String
shorts = OptionInfo -> String
optionInfoShortFlags OptionInfo
info
let longs :: [String]
longs = OptionInfo -> [String]
optionInfoLongFlags OptionInfo
info
let optStrings :: [String]
optStrings = (Char -> String) -> String -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\x :: Char
x -> ['-', Char
x]) (ShowS
forall a. [a] -> [a]
safeHead String
shorts) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\x :: String
x -> "--" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
x) ([String] -> [String]
forall a. [a] -> [a]
safeHead [String]
longs)
Bool -> Writer String () -> Writer String ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
optStrings) (Writer String () -> Writer String ())
-> Writer String () -> Writer String ()
forall a b. (a -> b) -> a -> b
$ do
let optStringCsv :: String
optStringCsv = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate ", " [String]
optStrings
WriterType (WriterT String Identity) -> Writer String ()
forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
tell WriterType (WriterT String Identity)
" "
WriterType (WriterT String Identity) -> Writer String ()
forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
tell String
WriterType (WriterT String Identity)
optStringCsv
Bool -> Writer String () -> Writer String ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (OptionInfo -> String
optionInfoTypeName OptionInfo
info)) (Writer String () -> Writer String ())
-> Writer String () -> Writer String ()
forall a b. (a -> b) -> a -> b
$ do
WriterType (WriterT String Identity) -> Writer String ()
forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
tell WriterType (WriterT String Identity)
" :: "
WriterType (WriterT String Identity) -> Writer String ()
forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
tell (OptionInfo -> String
optionInfoTypeName OptionInfo
info)
WriterType (WriterT String Identity) -> Writer String ()
forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
tell WriterType (WriterT String Identity)
"\n"
Bool -> Writer String () -> Writer String ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (OptionInfo -> String
optionInfoDescription OptionInfo
info)) (Writer String () -> Writer String ())
-> Writer String () -> Writer String ()
forall a b. (a -> b) -> a -> b
$ do
[String] -> (String -> Writer String ()) -> Writer String ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Int -> String -> [String]
wrapWords 76 (OptionInfo -> String
optionInfoDescription OptionInfo
info)) ((String -> Writer String ()) -> Writer String ())
-> (String -> Writer String ()) -> Writer String ()
forall a b. (a -> b) -> a -> b
$ \line :: String
line -> do
WriterType (WriterT String Identity) -> Writer String ()
forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
tell WriterType (WriterT String Identity)
" "
WriterType (WriterT String Identity) -> Writer String ()
forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
tell String
WriterType (WriterT String Identity)
line
WriterType (WriterT String Identity) -> Writer String ()
forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
tell WriterType (WriterT String Identity)
"\n"
Bool -> Writer String () -> Writer String ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (OptionInfo -> String
optionInfoDefault OptionInfo
info)) (Writer String () -> Writer String ())
-> Writer String () -> Writer String ()
forall a b. (a -> b) -> a -> b
$ do
WriterType (WriterT String Identity) -> Writer String ()
forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
tell WriterType (WriterT String Identity)
" default: "
WriterType (WriterT String Identity) -> Writer String ()
forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
tell (OptionInfo -> String
optionInfoDefault OptionInfo
info)
WriterType (WriterT String Identity) -> Writer String ()
forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
tell WriterType (WriterT String Identity)
"\n"
wrapWords :: Int -> String -> [String]
wrapWords :: Int -> String -> [String]
wrapWords breakWidth :: Int
breakWidth = String -> [String]
wrap where
wrap :: String -> [String]
wrap line :: String
line = if String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
line Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
breakWidth
then [String
line]
else if (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Char -> Bool
isBreak String
line
then case Int -> String -> (String, String)
forall a. Int -> [a] -> ([a], [a])
splitAt Int
breakWidth String
line of
(beforeBreak :: String
beforeBreak, afterBreak :: String
afterBreak) -> case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
reverseBreak Char -> Bool
isBreak String
beforeBreak of
(beforeWrap :: String
beforeWrap, afterWrap :: String
afterWrap) -> String
beforeWrap String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String -> [String]
wrap (String
afterWrap String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
afterBreak)
else [String
line]
isBreak :: Char -> Bool
isBreak c :: Char
c = case Char
c of
'\xA0' -> Bool
False
'\x202F' -> Bool
False
'\x2011' -> Bool
False
'-' -> Bool
True
_ -> Char -> Bool
isSpace Char
c
reverseBreak :: (a -> Bool) -> [a] -> ([a], [a])
reverseBreak :: (a -> Bool) -> [a] -> ([a], [a])
reverseBreak f :: a -> Bool
f xs :: [a]
xs = case (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break a -> Bool
f ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
xs) of
(after :: [a]
after, before :: [a]
before) -> ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
before, [a] -> [a]
forall a. [a] -> [a]
reverse [a]
after)
showHelpSummary :: OptionDefinitions -> Maybe String -> Writer String ()
showHelpSummary :: OptionDefinitions -> Maybe String -> Writer String ()
showHelpSummary (OptionDefinitions mainOpts :: [OptionInfo]
mainOpts subcmds :: [(String, [OptionInfo])]
subcmds) subcmd :: Maybe String
subcmd = do
let subcmdOptions :: Maybe (String, [OptionInfo])
subcmdOptions = do
String
subcmdName <- Maybe String
subcmd
[OptionInfo]
opts <- String -> [(String, [OptionInfo])] -> Maybe [OptionInfo]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
subcmdName [(String, [OptionInfo])]
subcmds
(String, [OptionInfo]) -> Maybe (String, [OptionInfo])
forall (m :: * -> *) a. Monad m => a -> m a
return (String
subcmdName, [OptionInfo]
opts)
let (groupInfos :: [(Group, [OptionInfo])]
groupInfos, ungroupedMainOptions :: [OptionInfo]
ungroupedMainOptions) = [OptionInfo] -> ([(Group, [OptionInfo])], [OptionInfo])
uniqueGroups [OptionInfo]
mainOpts
let hasHelp :: [(Group, [OptionInfo])]
hasHelp = ((Group, [OptionInfo]) -> Bool)
-> [(Group, [OptionInfo])] -> [(Group, [OptionInfo])]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(g :: Group
g,_) -> Group -> String
groupName Group
g String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "all") [(Group, [OptionInfo])]
groupInfos
[(Group, [OptionInfo])]
-> ((Group, [OptionInfo]) -> Writer String ()) -> Writer String ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Group, [OptionInfo])]
hasHelp (Group, [OptionInfo]) -> Writer String ()
showHelpGroup
Bool -> Writer String () -> Writer String ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([OptionInfo] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [OptionInfo]
ungroupedMainOptions) (Writer String () -> Writer String ())
-> Writer String () -> Writer String ()
forall a b. (a -> b) -> a -> b
$ do
WriterType (WriterT String Identity) -> Writer String ()
forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
tell WriterType (WriterT String Identity)
"Application Options:\n"
[OptionInfo]
-> (OptionInfo -> Writer String ()) -> Writer String ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [OptionInfo]
ungroupedMainOptions OptionInfo -> Writer String ()
showOptionHelp
Bool -> Writer String () -> Writer String ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([(String, [OptionInfo])] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(String, [OptionInfo])]
subcmds) (WriterType (WriterT String Identity) -> Writer String ()
forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
tell WriterType (WriterT String Identity)
"\n")
case Maybe (String, [OptionInfo])
subcmdOptions of
Nothing -> Bool -> Writer String () -> Writer String ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([(String, [OptionInfo])] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(String, [OptionInfo])]
subcmds) (Writer String () -> Writer String ())
-> Writer String () -> Writer String ()
forall a b. (a -> b) -> a -> b
$ do
WriterType (WriterT String Identity) -> Writer String ()
forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
tell WriterType (WriterT String Identity)
"Subcommands:\n"
[(String, [OptionInfo])]
-> ((String, [OptionInfo]) -> Writer String ()) -> Writer String ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(String, [OptionInfo])]
subcmds (((String, [OptionInfo]) -> Writer String ()) -> Writer String ())
-> ((String, [OptionInfo]) -> Writer String ()) -> Writer String ()
forall a b. (a -> b) -> a -> b
$ \(subcmdName :: String
subcmdName, _) -> do
WriterType (WriterT String Identity) -> Writer String ()
forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
tell WriterType (WriterT String Identity)
" "
WriterType (WriterT String Identity) -> Writer String ()
forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
tell String
WriterType (WriterT String Identity)
subcmdName
WriterType (WriterT String Identity) -> Writer String ()
forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
tell WriterType (WriterT String Identity)
"\n"
WriterType (WriterT String Identity) -> Writer String ()
forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
tell WriterType (WriterT String Identity)
"\n"
Just (n :: String
n, subOpts :: [OptionInfo]
subOpts) -> do
WriterType (WriterT String Identity) -> Writer String ()
forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
tell ("Options for subcommand " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ ":\n")
[OptionInfo]
-> (OptionInfo -> Writer String ()) -> Writer String ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [OptionInfo]
subOpts OptionInfo -> Writer String ()
showOptionHelp
WriterType (WriterT String Identity) -> Writer String ()
forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
tell WriterType (WriterT String Identity)
"\n"
showHelpAll :: OptionDefinitions -> Maybe String -> Writer String ()
showHelpAll :: OptionDefinitions -> Maybe String -> Writer String ()
showHelpAll (OptionDefinitions mainOpts :: [OptionInfo]
mainOpts subcmds :: [(String, [OptionInfo])]
subcmds) subcmd :: Maybe String
subcmd = do
let subcmdOptions :: Maybe (String, [OptionInfo])
subcmdOptions = do
String
subcmdName <- Maybe String
subcmd
[OptionInfo]
opts <- String -> [(String, [OptionInfo])] -> Maybe [OptionInfo]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
subcmdName [(String, [OptionInfo])]
subcmds
(String, [OptionInfo]) -> Maybe (String, [OptionInfo])
forall (m :: * -> *) a. Monad m => a -> m a
return (String
subcmdName, [OptionInfo]
opts)
let (groupInfos :: [(Group, [OptionInfo])]
groupInfos, ungroupedMainOptions :: [OptionInfo]
ungroupedMainOptions) = [OptionInfo] -> ([(Group, [OptionInfo])], [OptionInfo])
uniqueGroups [OptionInfo]
mainOpts
let (hasHelp :: [(Group, [OptionInfo])]
hasHelp, noHelp :: [(Group, [OptionInfo])]
noHelp) = ((Group, [OptionInfo]) -> Bool)
-> [(Group, [OptionInfo])]
-> ([(Group, [OptionInfo])], [(Group, [OptionInfo])])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (\(g :: Group
g,_) -> Group -> String
groupName Group
g String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "all") [(Group, [OptionInfo])]
groupInfos
[(Group, [OptionInfo])]
-> ((Group, [OptionInfo]) -> Writer String ()) -> Writer String ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Group, [OptionInfo])]
hasHelp (Group, [OptionInfo]) -> Writer String ()
showHelpGroup
[(Group, [OptionInfo])]
-> ((Group, [OptionInfo]) -> Writer String ()) -> Writer String ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Group, [OptionInfo])]
noHelp (Group, [OptionInfo]) -> Writer String ()
showHelpGroup
WriterType (WriterT String Identity) -> Writer String ()
forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
tell WriterType (WriterT String Identity)
"Application Options:\n"
[OptionInfo]
-> (OptionInfo -> Writer String ()) -> Writer String ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [OptionInfo]
ungroupedMainOptions OptionInfo -> Writer String ()
showOptionHelp
Bool -> Writer String () -> Writer String ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([(String, [OptionInfo])] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(String, [OptionInfo])]
subcmds) (WriterType (WriterT String Identity) -> Writer String ()
forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
tell WriterType (WriterT String Identity)
"\n")
case Maybe (String, [OptionInfo])
subcmdOptions of
Nothing -> [(String, [OptionInfo])]
-> ((String, [OptionInfo]) -> Writer String ()) -> Writer String ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(String, [OptionInfo])]
subcmds (((String, [OptionInfo]) -> Writer String ()) -> Writer String ())
-> ((String, [OptionInfo]) -> Writer String ()) -> Writer String ()
forall a b. (a -> b) -> a -> b
$ \(subcmdName :: String
subcmdName, subcmdOpts :: [OptionInfo]
subcmdOpts) -> do
WriterType (WriterT String Identity) -> Writer String ()
forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
tell ("Options for subcommand " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
subcmdName String -> ShowS
forall a. [a] -> [a] -> [a]
++ ":\n")
[OptionInfo]
-> (OptionInfo -> Writer String ()) -> Writer String ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [OptionInfo]
subcmdOpts OptionInfo -> Writer String ()
showOptionHelp
WriterType (WriterT String Identity) -> Writer String ()
forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
tell WriterType (WriterT String Identity)
"\n"
Just (n :: String
n, subOpts :: [OptionInfo]
subOpts) -> do
WriterType (WriterT String Identity) -> Writer String ()
forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
tell ("Options for subcommand " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ ":\n")
[OptionInfo]
-> (OptionInfo -> Writer String ()) -> Writer String ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [OptionInfo]
subOpts OptionInfo -> Writer String ()
showOptionHelp
WriterType (WriterT String Identity) -> Writer String ()
forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
tell WriterType (WriterT String Identity)
"\n"
showHelpGroup :: (Group, [OptionInfo]) -> Writer String ()
showHelpGroup :: (Group, [OptionInfo]) -> Writer String ()
showHelpGroup (groupInfo :: Group
groupInfo, opts :: [OptionInfo]
opts) = do
WriterType (WriterT String Identity) -> Writer String ()
forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
tell (Group -> String
groupTitle Group
groupInfo String -> ShowS
forall a. [a] -> [a] -> [a]
++ ":\n")
[OptionInfo]
-> (OptionInfo -> Writer String ()) -> Writer String ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [OptionInfo]
opts OptionInfo -> Writer String ()
showOptionHelp
WriterType (WriterT String Identity) -> Writer String ()
forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
tell WriterType (WriterT String Identity)
"\n"
showHelpOneGroup :: OptionDefinitions -> String -> Maybe String -> Writer String ()
showHelpOneGroup :: OptionDefinitions -> String -> Maybe String -> Writer String ()
showHelpOneGroup (OptionDefinitions mainOpts :: [OptionInfo]
mainOpts subcmds :: [(String, [OptionInfo])]
subcmds) name :: String
name subcmd :: Maybe String
subcmd = do
let opts :: [OptionInfo]
opts = case Maybe String
subcmd of
Nothing -> [OptionInfo]
mainOpts
Just n :: String
n -> case String -> [(String, [OptionInfo])] -> Maybe [OptionInfo]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
n [(String, [OptionInfo])]
subcmds of
Just infos :: [OptionInfo]
infos -> [OptionInfo]
mainOpts [OptionInfo] -> [OptionInfo] -> [OptionInfo]
forall a. [a] -> [a] -> [a]
++ [OptionInfo]
infos
Nothing -> [OptionInfo]
mainOpts
let (groupInfos :: [(Group, [OptionInfo])]
groupInfos, _) = [OptionInfo] -> ([(Group, [OptionInfo])], [OptionInfo])
uniqueGroups [OptionInfo]
opts
let group :: [(Group, [OptionInfo])]
group = ((Group, [OptionInfo]) -> Bool)
-> [(Group, [OptionInfo])] -> [(Group, [OptionInfo])]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(g :: Group
g,_) -> Group -> String
groupName Group
g String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
name) [(Group, [OptionInfo])]
groupInfos
[(Group, [OptionInfo])]
-> ((Group, [OptionInfo]) -> Writer String ()) -> Writer String ()
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 allOptions :: [OptionInfo]
allOptions = (Map String (Group, [OptionInfo]) -> [(Group, [OptionInfo])]
forall k a. Map k a -> [a]
Map.elems Map String (Group, [OptionInfo])
infoMap, [OptionInfo]
ungroupedOptions) where
infoMap :: Map String (Group, [OptionInfo])
infoMap = ((Group, [OptionInfo])
-> (Group, [OptionInfo]) -> (Group, [OptionInfo]))
-> [(String, (Group, [OptionInfo]))]
-> Map String (Group, [OptionInfo])
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith (Group, [OptionInfo])
-> (Group, [OptionInfo]) -> (Group, [OptionInfo])
forall a a a. (a, [a]) -> (a, [a]) -> (a, [a])
merge ([(String, (Group, [OptionInfo]))]
-> Map String (Group, [OptionInfo]))
-> [(String, (Group, [OptionInfo]))]
-> Map String (Group, [OptionInfo])
forall a b. (a -> b) -> a -> b
$ do
OptionInfo
opt <- [OptionInfo]
allOptions
case OptionInfo -> Maybe Group
optionInfoGroup OptionInfo
opt of
Nothing -> []
Just g :: Group
g -> [(Group -> String
groupName Group
g, (Group
g, [OptionInfo
opt]))]
merge :: (a, [a]) -> (a, [a]) -> (a, [a])
merge (g :: a
g, opts1 :: [a]
opts1) (_, opts2 :: [a]
opts2) = (a
g, [a]
opts2 [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
opts1)
ungroupedOptions :: [OptionInfo]
ungroupedOptions = [OptionInfo
o | OptionInfo
o <- [OptionInfo]
allOptions, Maybe Group -> Bool
forall a. Maybe a -> Bool
isNothing (OptionInfo -> Maybe Group
optionInfoGroup OptionInfo
o)]