module Options.Applicative.Builder.Extra
(boolFlags
,boolFlagsNoDefault
,maybeBoolFlags
,firstBoolFlags
,enableDisableFlags
,enableDisableFlagsNoDefault
,extraHelpOption
,execExtraHelp
,textOption
,textArgument
,optionalFirst
) where
import Control.Monad (when)
import Data.Monoid
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)
firstBoolFlags :: String -> String -> Mod FlagFields (Maybe Bool) -> Parser (First Bool)
firstBoolFlags long0 help0 mod0 = First <$> maybeBoolFlags long0 help0 mod0
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 =
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)
optionalFirst :: Alternative f => f a -> f (First a)
optionalFirst = fmap First . optional