module Options.Applicative.Builder.Extra
(boolFlags
,boolFlagsNoDefault
,maybeBoolFlags
,firstBoolFlags
,enableDisableFlags
,enableDisableFlagsNoDefault
,extraHelpOption
,execExtraHelp
,textOption
,textArgument
,optionalFirst
,absFileOption
,relFileOption
,absDirOption
,relDirOption
,eitherReader'
) where
import Control.Monad (when)
import Data.Either.Combinators
import Data.Monoid
import Options.Applicative
import Options.Applicative.Types (readerAsk)
import Path
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 ("[no-]" ++ name) <>
help ("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
absFileOption :: Mod OptionFields (Path Abs File) -> Parser (Path Abs File)
absFileOption = option (eitherReader' parseAbsFile)
relFileOption :: Mod OptionFields (Path Rel File) -> Parser (Path Rel File)
relFileOption = option (eitherReader' parseRelFile)
absDirOption :: Mod OptionFields (Path Abs Dir) -> Parser (Path Abs Dir)
absDirOption = option (eitherReader' parseAbsDir)
relDirOption :: Mod OptionFields (Path Rel Dir) -> Parser (Path Rel Dir)
relDirOption = option (eitherReader' parseRelDir)
eitherReader' :: Show e => (String -> Either e a) -> ReadM a
eitherReader' f = eitherReader (mapLeft show . f)