Support exactly-one mutually exclusive options

[brandonchinn178]

Related: #111

I want to allow the user to specify exactly one of --modified-files, --staged-files, or --all-files with a nice error. If I follow the current recommendation in #111, I get the following behavior:

oneOf
  [ switch (long "modified-files")
  , switch (long "staged-files")
  , switch (long "all-files")
  ]

oneOf = foldr (<|>) empty

$ example
Missing: (--modified-files | --staged-files | --all-files)

$ example --modified-files
Works

$ example --modified-files --staged-files
Unknown flag: --staged-files

This has the correct semantics, and the error message when no options are passed is pretty good. The only issue is that passing multiple flags shows an unhelpful error message, when clearly a good error message is possible.

My current workaround is:

oneOf :: [Opt.Parser a] -> Opt.Parser a
oneOf parsers = validate <$> traverse Opt.optional parsers
 where
  validate results =
    case catMaybes results of
      [a] -> a
      _ -> error $ "Expected exactly one of: " <> (Text.intercalate ", " . map Text.pack) optNames

  optNames = concatMap getOptNames parsers
  getOptNames :: Opt.Parser x -> [String]
  getOptNames = \case
    Opt.Internal.NilP _ -> []
    Opt.Internal.OptP opt -> [getOptName opt]
    Opt.Internal.MultP p1 p2 -> getOptNames p1 <> getOptNames p2
    Opt.Internal.AltP p1 p2 -> getOptNames p1 <> getOptNames p2
    Opt.Internal.BindP p _ -> getOptNames p
  getOptName opt =
    case Opt.Internal.optMain opt of
      Opt.Internal.OptReader names _ _ | Just name <- getName names -> name
      Opt.Internal.FlagReader names _ | Just name <- getName names -> name
      _ -> Opt.Internal.propMetaVar $ Opt.Internal.optProps opt
  getName names
    | n : _ <- [n | Opt.Internal.OptLong n <- names] = Just ("--" <> n)
    | c : _ <- [c | Opt.Internal.OptShort c <- names] = Just ['-', c]
    | otherwise = Nothing

but it's super hacky and only fails when the result is used in main, instead of during the Parser evaluation. It would be great to have something officially supported here.