module Options.Applicative.Builder.Extra
(boolFlags
,boolFlagsNoDefault
,maybeBoolFlags
,enableDisableFlags
,enableDisableFlagsNoDefault
,extraHelpOption
,execExtraHelp
,textOption
,textArgument)
where
import Control.Monad (when)
import Options.Applicative
import Options.Applicative.Types (readerAsk)
import System.Environment (withArgs)
import System.FilePath (takeBaseName)
import Data.Text (Text)
import qualified Data.Text as T
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 :: (Eq a)
=> 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 :: (Eq a)
=> a
-> a
-> String
-> String
-> Mod FlagFields a
-> Parser a
enableDisableFlagsNoDefault enabledValue disabledValue name helpSuffix mods =
last <$> some
((flag'
enabledValue
(hidden <>
internal <>
long name <>
help helpSuffix <>
mods) <|>
flag'
disabledValue
(hidden <>
internal <>
long ("no-" ++ name) <>
help helpSuffix <>
mods)) <|>
flag'
disabledValue
(long (concat ["[no-]", name]) <>
help (concat ["Enable/disable ", helpSuffix]) <>
mods))
extraHelpOption :: Bool
-> String
-> String
-> String
-> Parser (a -> a)
extraHelpOption hide progName fakeName helpName =
infoOption (optDesc' ++ ".") (long helpName <> hidden <> internal) <*>
infoOption (optDesc' ++ ".") (long fakeName <>
help optDesc' <>
(if hide then hidden <> internal else idm))
where optDesc' = concat ["Run '", takeBaseName progName, " --", helpName, "' for details"]
execExtraHelp :: [String]
-> String
-> Parser a
-> String
-> IO ()
execExtraHelp args helpOpt parser pd =
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)
textOption :: Mod OptionFields Text -> Parser Text
textOption = option (T.pack <$> readerAsk)
textArgument :: Mod ArgumentFields Text -> Parser Text
textArgument = argument (T.pack <$> readerAsk)