Don't write multiple equal signs

optparse-applicative.cabal

@@ -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

src/Options/Applicative/Common.hs

@@ -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

src/Options/Applicative/Extra.hs

@@ -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

src/Options/Applicative/Help/Chunk.hs

@@ -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

src/Options/Applicative/Help/Core.hs

@@ -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)

src/Options/Applicative/Types.hs

@@ -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

tests/long_equals.err.txt

@@ -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

tests/test.hs

@@ -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
 
 ---