module Options.Applicative.Builder.Extra
(boolFlags
,boolFlagsNoDefault
,maybeBoolFlags
,enableDisableFlags
,enableDisableFlagsNoDefault
,extraHelpOption
,execExtraHelp)
where
import Control.Monad (when)
import Options.Applicative
import System.Environment (withArgs)
import System.FilePath (takeBaseName)
boolFlags :: Bool -> String -> String -> Mod FlagFields Bool -> Parser Bool
boolFlags defaultValue = enableDisableFlags defaultValue True False
boolFlagsNoDefault :: String -> String -> Mod FlagFields Bool -> Parser Bool
boolFlagsNoDefault = enableDisableFlagsNoDefault True False
maybeBoolFlags :: String -> String -> Mod FlagFields (Maybe Bool) -> Parser (Maybe Bool)
maybeBoolFlags = enableDisableFlags Nothing (Just True) (Just False)
enableDisableFlags :: a -> a -> a -> String -> String -> Mod FlagFields a -> Parser a
enableDisableFlags defaultValue enabledValue disabledValue name helpSuffix mods =
enableDisableFlagsNoDefault enabledValue disabledValue name helpSuffix mods <|>
pure defaultValue
enableDisableFlagsNoDefault :: a -> a -> String -> String -> Mod FlagFields a -> Parser a
enableDisableFlagsNoDefault enabledValue disabledValue name helpSuffix mods =
flag' enabledValue
(long name <>
help ("Enable " ++ helpSuffix) <>
mods) <|>
flag' enabledValue
(internal <>
long ("enable-" ++ name) <>
help ("Enable " ++ helpSuffix) <>
mods) <|>
flag' disabledValue
(long ("no-" ++ name) <>
help ("Disable " ++ helpSuffix) <>
mods) <|>
flag' disabledValue
(internal <>
long ("disable-" ++ name) <>
help ("Disable " ++ helpSuffix) <>
mods)
extraHelpOption :: String -> String -> String -> Parser (a -> a)
extraHelpOption progName fakeName helpName =
infoOption (optDesc ++ ".") (long helpName <> hidden <> internal) <*>
infoOption (optDesc ++ ".") (long fakeName <> help optDesc)
where optDesc = concat ["Run '", takeBaseName progName, " --", helpName, "' for details"]
execExtraHelp :: [String] -> String -> Parser a -> String -> IO ()
execExtraHelp args helpOpt parser pd = do
when (args == ["--" ++ helpOpt]) $
withArgs ["--help"] $ do
_ <- execParser (info (hiddenHelper <*>
((,) <$>
parser <*>
some (strArgument (metavar "OTHER ARGUMENTS"))))
(fullDesc <> progDesc pd))
return ()
where hiddenHelper = abortOption ShowHelpText (long "help" <> hidden <> internal)