mirror of
https://github.com/ilyakooo0/optparse-applicative.git
synced 2024-10-26 10:52:43 +03:00
Don't write multiple equal signs
This commit is contained in:
parent
bc29e669a5
commit
dbbd534a0c
@ -34,6 +34,7 @@ extra-source-files: CHANGELOG.md
|
||||
tests/hello.err.txt
|
||||
tests/helponempty.err.txt
|
||||
tests/helponemptysub.err.txt
|
||||
tests/long_equals.err.txt
|
||||
tests/formatting.err.txt
|
||||
tests/nested.err.txt
|
||||
tests/optional.err.txt
|
||||
|
@ -22,7 +22,6 @@ module Options.Applicative.Common (
|
||||
Parser,
|
||||
liftOpt,
|
||||
showOption,
|
||||
showOptionEquals,
|
||||
|
||||
-- * Program descriptions
|
||||
--
|
||||
@ -66,12 +65,6 @@ showOption :: OptName -> String
|
||||
showOption (OptLong n) = "--" ++ n
|
||||
showOption (OptShort n) = '-' : [n]
|
||||
|
||||
-- | Like 'showOption', but puts an equals sign or a space after long options if the
|
||||
-- 'ParserPrefs' indicate we should do so.
|
||||
showOptionEquals :: ParserPrefs -> OptName -> String
|
||||
showOptionEquals prefs (OptLong n) = "--" ++ n ++ (if prefHelpLongEquals prefs then "=" else "")
|
||||
showOptionEquals _ (OptShort n) = '-' : [n]
|
||||
|
||||
optionNames :: OptReader a -> [OptName]
|
||||
optionNames (OptReader names _ _) = names
|
||||
optionNames (FlagReader names _) = names
|
||||
@ -104,7 +97,7 @@ optMatches disambiguate opt (OptWord arg1 val) = case opt of
|
||||
-- We'll not match a long option for a flag if there's a word attached.
|
||||
-- This was revealing an implementation detail as
|
||||
-- `--foo=val` was being parsed as `--foo -val`, which is gibberish.
|
||||
guard $ is_short arg1 || isNothing val
|
||||
guard $ isShortName arg1 || isNothing val
|
||||
Just $ do
|
||||
args <- get
|
||||
let val' = ('-' :) <$> val
|
||||
@ -114,9 +107,6 @@ optMatches disambiguate opt (OptWord arg1 val) = case opt of
|
||||
where
|
||||
errorFor name msg = "option " ++ showOption name ++ ": " ++ msg
|
||||
|
||||
is_short (OptShort _) = True
|
||||
is_short (OptLong _) = False
|
||||
|
||||
has_name a
|
||||
| disambiguate = any (isOptionPrefix a)
|
||||
| otherwise = elem a
|
||||
|
@ -258,7 +258,7 @@ parserFailure pprefs pinfo msg ctx = ParserFailure $ \progn ->
|
||||
-- reader also ensure that it can be immediately
|
||||
-- reachable from where the error was given.
|
||||
opt_completions hinfo opt = case optMain opt of
|
||||
OptReader ns _ _ -> fmap (showOptionEquals pprefs) ns
|
||||
OptReader ns _ _ -> fmap showOption ns
|
||||
FlagReader ns _ -> fmap showOption ns
|
||||
ArgReader _ -> []
|
||||
CmdReader _ ns _ | hinfoUnreachableArgs hinfo
|
||||
|
@ -16,7 +16,7 @@ module Options.Applicative.Help.Chunk
|
||||
|
||||
import Control.Applicative
|
||||
import Control.Monad
|
||||
import Data.List.NonEmpty ( NonEmpty(..) )
|
||||
import Data.List.NonEmpty (NonEmpty(..))
|
||||
import Data.Maybe
|
||||
import Data.Semigroup
|
||||
import Prelude
|
||||
|
@ -18,9 +18,11 @@ import Control.Applicative
|
||||
import Control.Monad (guard)
|
||||
import Data.Function (on)
|
||||
import Data.List (sort, intersperse, groupBy)
|
||||
import Data.Foldable (any)
|
||||
import Data.Maybe (maybeToList, catMaybes, fromMaybe)
|
||||
import Data.Monoid
|
||||
import Prelude
|
||||
import Data.Monoid (mempty)
|
||||
import Data.Semigroup (Semigroup (..))
|
||||
import Prelude hiding (any)
|
||||
|
||||
import Options.Applicative.Common
|
||||
import Options.Applicative.Types
|
||||
@ -32,21 +34,25 @@ data OptDescStyle = OptDescStyle
|
||||
{ descSep :: Doc
|
||||
, descHidden :: Bool }
|
||||
|
||||
safelast :: [a] -> Maybe a
|
||||
safelast = foldl (const Just) Nothing
|
||||
|
||||
-- | Generate description for a single option.
|
||||
optDesc :: ParserPrefs -> OptDescStyle -> OptHelpInfo -> Option a -> (Chunk Doc, Wrapping)
|
||||
optDesc pprefs style info opt =
|
||||
let ns = optionNames $ optMain opt
|
||||
mv = stringChunk $ optMetaVar opt
|
||||
has_arg = case mv of
|
||||
Chunk Nothing -> True
|
||||
_ -> False
|
||||
descs | has_arg = map (string . showOption) (sort ns)
|
||||
| otherwise = map (string . showOptionEquals pprefs) (sort ns)
|
||||
isLong (OptLong _) = True
|
||||
isLong _ = False
|
||||
has_equals = any isLong ns && prefHelpLongEquals pprefs
|
||||
desc | has_equals = listToChunk (intersperse (descSep style) descs) <> mv
|
||||
| otherwise = listToChunk (intersperse (descSep style) descs) <<+>> mv
|
||||
let names
|
||||
= sort . optionNames . optMain $ opt
|
||||
meta
|
||||
= stringChunk $ optMetaVar opt
|
||||
descs
|
||||
= map (string . showOption) names
|
||||
descriptions
|
||||
= listToChunk (intersperse (descSep style) descs)
|
||||
desc
|
||||
| prefHelpLongEquals pprefs && not (isEmpty meta) && any isLongName (safelast names)
|
||||
= descriptions <> stringChunk "=" <> meta
|
||||
| otherwise
|
||||
= descriptions <<+>> meta
|
||||
show_opt
|
||||
| optVisibility opt == Hidden
|
||||
= descHidden style
|
||||
@ -58,12 +64,12 @@ optDesc pprefs style info opt =
|
||||
| otherwise
|
||||
= mempty
|
||||
wrapping
|
||||
= wrapIf (length ns > 1)
|
||||
= wrapIf (length names > 1)
|
||||
rendered
|
||||
| not show_opt
|
||||
= mempty
|
||||
| otherwise
|
||||
= desc `mappend` suffix
|
||||
= desc <> suffix
|
||||
modified
|
||||
= maybe id fmap (optDescMod opt) rendered
|
||||
in (modified, wrapping)
|
||||
|
@ -6,6 +6,9 @@ module Options.Applicative.Types (
|
||||
|
||||
Option(..),
|
||||
OptName(..),
|
||||
isShortName,
|
||||
isLongName,
|
||||
|
||||
OptReader(..),
|
||||
OptProperties(..),
|
||||
OptVisibility(..),
|
||||
@ -126,6 +129,13 @@ data OptName = OptShort !Char
|
||||
| OptLong !String
|
||||
deriving (Eq, Ord, Show)
|
||||
|
||||
isShortName :: OptName -> Bool
|
||||
isShortName (OptShort _) = True
|
||||
isShortName (OptLong _) = False
|
||||
|
||||
isLongName :: OptName -> Bool
|
||||
isLongName = not . isShortName
|
||||
|
||||
-- | Visibility of an option in the help text.
|
||||
data OptVisibility
|
||||
= Internal -- ^ does not appear in the help text at all
|
||||
|
@ -1,6 +1,6 @@
|
||||
Usage: long_equals (-i|-j|--intval=|--intval2=ARG)
|
||||
Usage: long_equals (-i|-j|--intval|--intval2=ARG)
|
||||
|
||||
Available options:
|
||||
-i,-j,--intval=,--intval2=ARG
|
||||
-i,-j,--intval,--intval2=ARG
|
||||
integer value
|
||||
-h,--help Show this help text
|
||||
|
@ -205,7 +205,7 @@ prop_nested_optional_help = once $
|
||||
prop_long_equals :: Property
|
||||
prop_long_equals = once $
|
||||
let p :: Parser String
|
||||
p = option auto (long "intval"
|
||||
p = option auto ( long "intval"
|
||||
<> short 'j'
|
||||
<> long "intval2"
|
||||
<> short 'i'
|
||||
@ -213,6 +213,17 @@ prop_long_equals = once $
|
||||
i = info (p <**> helper) fullDesc
|
||||
in checkHelpTextWith ExitSuccess (prefs helpLongEquals) "long_equals" i ["--help"]
|
||||
|
||||
prop_long_equals_doesnt_do_shorts :: Property
|
||||
prop_long_equals_doesnt_do_shorts = once $
|
||||
let p :: Parser String
|
||||
p = option auto ( short 'i'
|
||||
<> help "integer value")
|
||||
i = info (p <**> helper) fullDesc
|
||||
result = execParserPure (prefs helpLongEquals) i ["--help"]
|
||||
in assertError result $ \failure ->
|
||||
let text = head . lines . fst $ renderFailure failure "test"
|
||||
in "Usage: test -i ARG" === text
|
||||
|
||||
prop_nested_fun :: Property
|
||||
prop_nested_fun = once $
|
||||
let p :: Parser (String, Maybe (String, Maybe String))
|
||||
@ -756,10 +767,10 @@ prop_bytestring_reader :: Property
|
||||
prop_bytestring_reader = once $
|
||||
let t = "testValue"
|
||||
p :: Parser ByteString
|
||||
p = argument (fmap BS8.pack readerAsk) idm
|
||||
p = argument str idm
|
||||
i = info p idm
|
||||
result = run i ["testValue"]
|
||||
in assertResult result $ \xs -> fromString t === xs
|
||||
in assertResult result $ \xs -> BS8.pack t === xs
|
||||
|
||||
---
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user