optparse-applicative 0.5.2.1 → 0.6.0
raw patch · 14 files changed
+348/−87 lines, 14 filesdep ~process
Dependency ranges changed: process
Files
- Options/Applicative/Builder.hs +14/−7
- Options/Applicative/Builder/Completer.hs +3/−1
- Options/Applicative/Builder/Internal.hs +8/−1
- Options/Applicative/Common.hs +56/−46
- Options/Applicative/Extra.hs +15/−4
- Options/Applicative/Help.hs +0/−4
- Options/Applicative/Internal.hs +126/−11
- Options/Applicative/Types.hs +28/−2
- README.md +1/−1
- optparse-applicative.cabal +2/−2
- tests/Examples/Cabal.hs +12/−7
- tests/Examples/Commands.hs +7/−0
- tests/Examples/Hello.hs +7/−0
- tests/Tests.hs +69/−1
Options/Applicative/Builder.hs view
@@ -76,7 +76,14 @@ disambiguate, showHelpOnError, noBacktrack,- prefs+ prefs,++ -- * Types+ Mod,+ OptionFields,+ FlagFields,+ ArgumentFields,+ CommandFields ) where import Control.Applicative (pure, (<|>))@@ -98,7 +105,7 @@ auto :: Monad m => Read a => String -> m a auto arg = case reads arg of [(r, "")] -> return r- _ -> fail "Cannot parse value"+ _ -> fail $ "cannot parse value `" ++ arg ++ "'" -- | String 'Option' reader. str :: Monad m => String -> m String@@ -106,7 +113,7 @@ -- | Null 'Option' reader. All arguments will fail validation. disabled :: Monad m => String -> m a-disabled = const . fail $ "Disabled option"+disabled = const . fail $ "disabled option" -- modifiers -- @@ -135,7 +142,7 @@ help s = optionMod $ \p -> p { propHelp = s } -- | Specify the 'Option' reader.-reader :: (String -> Either ParseError a) -> Mod OptionFields a+reader :: (String -> ReadM a) -> Mod OptionFields a reader f = fieldMod $ \p -> p { optReader = f } -- | Specify the error to display when no argument is provided to this option.@@ -181,9 +188,9 @@ subparser :: Mod CommandFields a -> Parser a subparser m = mkParser d g rdr where- Mod f d g = m `mappend` metavar "COMMAND"- CommandFields cmds = f (CommandFields [])- rdr = CmdReader (map fst cmds) (`lookup` cmds)+ Mod _ d g = m `mappend` metavar "COMMAND"+ rdr = uncurry CmdReader (mkCommand m)+ -- | Builder for a flag parser. -- -- A flag that switches from a \"default value\" to an \"active value\" when
Options/Applicative/Builder/Completer.hs view
@@ -1,5 +1,7 @@ module Options.Applicative.Builder.Completer- ( listIOCompleter+ ( Completer+ , mkCompleter+ , listIOCompleter , listCompleter , bashCompleter ) where
Options/Applicative/Builder/Internal.hs view
@@ -13,6 +13,7 @@ fieldMod, baseProps,+ mkCommand, mkParser, mkOption, mkProps,@@ -30,7 +31,7 @@ data OptionFields a = OptionFields { optNames :: [OptName] , optCompleter :: Completer- , optReader :: String -> Either ParseError a+ , optReader :: String -> ReadM a , optNoArgError :: ParseError } data FlagFields a = FlagFields@@ -119,6 +120,12 @@ , propVisibility = Visible , propHelp = "" , propShowDefault = Nothing }++mkCommand :: Mod CommandFields a -> ([String], String -> Maybe (ParserInfo a))+mkCommand m = (map fst cmds, (`lookup` cmds))+ where+ Mod f _ _ = m+ CommandFields cmds = f (CommandFields []) mkParser :: DefaultProp a -> (OptProperties -> OptProperties)
Options/Applicative/Common.hs view
@@ -21,6 +21,7 @@ -- Parser, liftOpt,+ showOption, -- * Program descriptions --@@ -44,8 +45,10 @@ optionNames ) where -import Control.Applicative (pure, (<*>), (<$>), (<|>), empty)-import Control.Monad (guard, msum)+import Control.Applicative (pure, (<*>), (<$>), (<|>))+import Control.Monad (guard, mzero, msum, when)+import Control.Monad.Trans.Class (lift)+import Control.Monad.Trans.State (StateT(..), get, put, runStateT) import Data.List (isPrefixOf) import Data.Maybe (maybeToList, isJust) import Data.Monoid (Monoid(..))@@ -53,6 +56,10 @@ import Options.Applicative.Internal import Options.Applicative.Types +showOption :: OptName -> String+showOption (OptLong n) = "--" ++ n+showOption (OptShort n) = '-' : [n]+ optionNames :: OptReader a -> [OptName] optionNames (OptReader names _ _) = names optionNames (FlagReader names _) = names@@ -76,28 +83,31 @@ mappend m@(Match _) _ = m mappend _ m = m -type Matcher m a = [String] -> m (a, [String])+type Args = [String] -optMatches :: MonadP m => Bool -> OptReader a -> String -> Maybe (Matcher m a)+optMatches :: MonadP m => Bool -> OptReader a -> String -> Maybe (StateT Args m a) optMatches disambiguate opt arg = case opt of OptReader names rdr no_arg_err -> do (arg1, val) <- parsed guard $ has_name arg1 names- return $ \args -> do+ Just $ do+ args <- get let mb_args = uncons $ maybeToList val ++ args- let missing_arg = missingArgP no_arg_err (crCompleter rdr)+ let missing_arg = lift $ missingArgP no_arg_err (crCompleter rdr) (arg', args') <- maybe missing_arg return mb_args- r <- liftEither (crReader rdr arg')- return (r, args')+ put args'+ case runReadM (crReader rdr arg') of+ Left e -> lift $ errorFor arg1 e+ Right r -> return r FlagReader names x -> do (arg1, Nothing) <- parsed guard $ has_name arg1 names- return $ \args -> return (x, args)+ Just $ return x ArgReader rdr -> do result <- crReader rdr arg- return $ \args -> return (result, args)+ Just $ return result CmdReader _ f ->- flip fmap (f arg) $ \subp args -> do+ flip fmap (f arg) $ \subp -> StateT $ \args -> do setContext (Just arg) subp prefs <- getPrefs let runSubparser@@ -106,6 +116,10 @@ -> (,) <$> runParserFully p a <*> pure [] runSubparser (infoParser subp) args where+ errorFor name (ErrorMsg msg) =+ errorP (ErrorMsg ("option " ++ showOption name ++ ": " ++ msg))+ errorFor _ e = errorP e+ parsed = case arg of '-' : '-' : arg1 ->@@ -122,42 +136,43 @@ | disambiguate = any (isOptionPrefix a) | otherwise = elem a -stepParser :: MonadP m => ParserPrefs -> Parser a -> String -> [String] -> [m (Parser a, [String])]-stepParser _ (NilP _) _ _ = []-stepParser prefs (OptP opt) arg args =+isArg :: OptReader a -> Bool+isArg (ArgReader _) = True+isArg _ = False++stepParser :: MonadP m => ParserPrefs -> String -> Parser a+ -> NondetT (StateT Args m) (Parser a)+stepParser _ _ (NilP _) = mzero+stepParser prefs arg (OptP opt) = do+ when (isArg (optMain opt)) cut case optMatches disambiguate (optMain opt) arg of- Just matcher -> pure $ do- (r, args') <- matcher args- return (pure r, args')- Nothing -> empty+ Just matcher -> pure <$> lift matcher+ Nothing -> mzero where disambiguate = prefDisambiguate prefs && optVisibility opt > Internal-stepParser prefs (MultP p1 p2) arg args = msum- [ flip map (stepParser prefs p1 arg args) $ \m ->- do (p1', args') <- m- return (p1' <*> p2, args')- , flip map (stepParser prefs p2 arg args) $ \m ->- do (p2', args') <- m- return (p1 <*> p2', args') ]-stepParser prefs (AltP p1 p2) arg args = msum- [ stepParser prefs p1 arg args- , stepParser prefs p2 arg args ]-stepParser prefs (BindP p k) arg args =- flip map (stepParser prefs p arg args) $ \m -> do- (p', args') <- m- x <- liftMaybe $ evalParser p'- return (k x, args')+stepParser prefs arg (MultP p1 p2) = foldr1 (<!>)+ [ do p1' <- stepParser prefs arg p1+ return (p1' <*> p2)+ , do p2' <- stepParser prefs arg p2+ return (p1 <*> p2') ]+stepParser prefs arg (AltP p1 p2) = msum+ [ stepParser prefs arg p1+ , stepParser prefs arg p2 ]+stepParser prefs arg (BindP p k) = do+ p' <- stepParser prefs arg p+ x <- hoistMaybe $ evalParser p'+ return (k x) -- | Apply a 'Parser' to a command line, and return a result and leftover -- arguments. This function returns an error if any parsing error occurs, or -- if any options are missing and don't have a default value.-runParser :: MonadP m => Parser a -> [String] -> m (a, [String])+runParser :: MonadP m => Parser a -> Args -> m (a, Args) runParser p args = case args of [] -> exitP p result (arg : argt) -> do prefs <- getPrefs- x <- tryP $ do_step prefs arg argt+ x <- do_step prefs arg argt case x of Left e -> case (result, e) of (Just r, ErrorMsg _) -> return r@@ -165,16 +180,11 @@ Right (p', args') -> runParser p' args' where result = (,) <$> evalParser p <*> pure args- do_step prefs arg argt- | prefDisambiguate prefs- = case parses of- [m] -> m- _ -> empty- | otherwise- = case parses of- [] -> parseError arg- (m : _) -> m- where parses = stepParser prefs p arg argt+ do_step prefs arg argt = tryP+ . (`runStateT` argt)+ . (>>= maybe ((lift . parseError) arg) return)+ . disamb (not (prefDisambiguate prefs))+ $ stepParser prefs arg p parseError :: MonadP m => String -> m a parseError arg = errorP . ErrorMsg $ msg@@ -183,7 +193,7 @@ ('-':_) -> "Invalid option `" ++ arg ++ "'" _ -> "Invalid argument `" ++ arg ++ "'" -runParserFully :: MonadP m => Parser a -> [String] -> m a+runParserFully :: MonadP m => Parser a -> Args -> m a runParserFully p args = do (r, args') <- runParser p args guard $ null args'
Options/Applicative/Extra.hs view
@@ -4,6 +4,7 @@ -- -- | This module contains high-level functions to run parsers. helper,+ hsubparser, execParser, execParserPure, customExecParser,@@ -11,31 +12,41 @@ ParserFailure(..), ) where -import Control.Applicative ((<$>), (<|>))+import Control.Applicative ((<$>), (<|>), (<**>)) import Data.Monoid (mconcat) import System.Environment (getArgs, getProgName) import System.Exit (exitWith, ExitCode(..)) import System.IO (hPutStr, stderr) import Options.Applicative.BashCompletion-import Options.Applicative.Common import Options.Applicative.Builder hiding (briefDesc)+import Options.Applicative.Builder.Internal+import Options.Applicative.Common import Options.Applicative.Help import Options.Applicative.Internal-import Options.Applicative.Utils import Options.Applicative.Types+import Options.Applicative.Utils -- | A hidden \"helper\" option which always fails. helper :: Parser (a -> a) helper = nullOption $ mconcat [ long "help"- , reader (const (Left ShowHelpText))+ , reader (const (ReadM (Left ShowHelpText))) , noArgError ShowHelpText , short 'h' , help "Show this help text" , value id , metavar "" , hidden ]++hsubparser :: Mod CommandFields a -> Parser a+hsubparser m = mkParser d g rdr+ where+ Mod _ d g = m `mappend` metavar "COMMAND"+ (cmds, subs) = mkCommand m+ rdr = CmdReader cmds (fmap add_helper . subs)+ add_helper pinfo = pinfo+ { infoParser = infoParser pinfo <**> helper } -- | Run a program description. --
Options/Applicative/Help.hs view
@@ -12,10 +12,6 @@ import Options.Applicative.Types import Options.Applicative.Utils -showOption :: OptName -> String-showOption (OptLong n) = "--" ++ n-showOption (OptShort n) = '-' : [n]- -- | Style for rendering an option. data OptDescStyle = OptDescStyle { descSep :: String
Options/Applicative/Internal.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE GADTs #-}+{-# LANGUAGE GADTs, RankNTypes #-} module Options.Applicative.Internal ( P , Context(..)@@ -6,8 +6,8 @@ , ParseError(..) , uncons- , liftMaybe- , liftEither+ , hoistMaybe+ , hoistEither , runP @@ -15,16 +15,26 @@ , runCompletion , SomeParser(..) , ComplError(..)++ , ListT+ , takeListT+ , runListT++ , NondetT+ , cut+ , (<!>)+ , disamb ) where import Control.Applicative (Applicative(..), Alternative(..), (<$>))-import Control.Monad (MonadPlus(..), liftM, ap)-import Control.Monad.Trans.Class (lift)+import Control.Monad (MonadPlus(..), liftM, ap, guard)+import Control.Monad.Trans.Class (MonadTrans, lift) import Control.Monad.Trans.Error- (runErrorT, ErrorT, Error(..), throwError, catchError)+ (runErrorT, ErrorT(..), Error(..), throwError, catchError) import Control.Monad.Trans.Reader (runReader, runReaderT, Reader, ReaderT, ask) import Control.Monad.Trans.Writer (runWriterT, WriterT, tell)+import Control.Monad.Trans.State (StateT, get, put, evalStateT) import Data.Maybe (maybeToList) import Data.Monoid (Monoid(..)) @@ -82,14 +92,14 @@ missingArgP e _ = errorP e tryP (P p) = P $ lift $ runErrorT p- exitP _ = P . liftMaybe+ exitP _ = P . hoistMaybe errorP = P . throwError -liftMaybe :: MonadPlus m => Maybe a -> m a-liftMaybe = maybe mzero return+hoistMaybe :: MonadPlus m => Maybe a -> m a+hoistMaybe = maybe mzero return -liftEither :: MonadP m => Either ParseError a -> m a-liftEither = either errorP return+hoistEither :: MonadP m => Either ParseError a -> m a+hoistEither = either errorP return runP :: P a -> ParserPrefs -> (Either ParseError a, Context) runP (P p) = runReader . runWriterT . runErrorT $ p@@ -164,3 +174,108 @@ ComplResult _ -> Nothing ComplParser p' -> Just $ Left p' ComplOption compl -> Just $ Right compl++-- A "ListT done right" implementation++newtype ListT m a = ListT+ { stepListT :: m (TStep a (ListT m a)) }++data TStep a x+ = TNil+ | TCons a x++bimapTStep :: (a -> b) -> (x -> y) -> TStep a x -> TStep b y+bimapTStep _ _ TNil = TNil+bimapTStep f g (TCons a x) = TCons (f a) (g x)++hoistList :: Monad m => [a] -> ListT m a+hoistList = foldr (\x xt -> ListT (return (TCons x xt))) mzero++takeListT :: Monad m => Int -> ListT m a -> ListT m a+takeListT 0 = const mzero+takeListT n = ListT . liftM (bimapTStep id (takeListT (n - 1))) . stepListT++runListT :: Monad m => ListT m a -> m [a]+runListT xs = do+ s <- stepListT xs+ case s of+ TNil -> return []+ TCons x xt -> liftM (x :) (runListT xt)++instance Monad m => Functor (ListT m) where+ fmap f = ListT+ . liftM (bimapTStep f (fmap f))+ . stepListT++instance Monad m => Applicative (ListT m) where+ pure = hoistList . pure+ (<*>) = ap++instance Monad m => Monad (ListT m) where+ return = pure+ xs >>= f = ListT $ do+ s <- stepListT xs+ case s of+ TNil -> return TNil+ TCons x xt -> stepListT $ f x `mplus` (xt >>= f)++instance Monad m => Alternative (ListT m) where+ empty = mzero+ (<|>) = mplus++instance MonadTrans ListT where+ lift = ListT . liftM (`TCons` mzero)++instance Monad m => MonadPlus (ListT m) where+ mzero = ListT (return TNil)+ mplus xs ys = ListT $ do+ s <- stepListT xs+ case s of+ TNil -> stepListT ys+ TCons x xt -> return $ TCons x (xt `mplus` ys)++-- nondeterminism monad with cut operator++newtype NondetT m a = NondetT+ { runNondetT :: ListT (StateT Bool m) a }++instance Monad m => Functor (NondetT m) where+ fmap f = NondetT . fmap f . runNondetT++instance Monad m => Applicative (NondetT m) where+ pure = NondetT . pure+ NondetT m1 <*> NondetT m2 = NondetT (m1 <*> m2)++instance Monad m => Monad (NondetT m) where+ return = pure+ NondetT m1 >>= f = NondetT $ m1 >>= runNondetT . f++instance Monad m => MonadPlus (NondetT m) where+ mzero = NondetT mzero+ NondetT m1 `mplus` NondetT m2 = NondetT (m1 `mplus` m2)++instance Monad m => Alternative (NondetT m) where+ empty = mzero+ (<|>) = mplus++instance MonadTrans NondetT where+ lift = NondetT . lift . lift++(<!>) :: Monad m => NondetT m a -> NondetT m a -> NondetT m a+(<!>) m1 m2 = NondetT . mplus (runNondetT m1) $ do+ s <- lift get+ guard (not s)+ runNondetT m2++cut :: Monad m => NondetT m ()+cut = NondetT $ lift (put True)++disamb :: Monad m => Bool -> NondetT m a -> m (Maybe a)+disamb allow_amb xs = do+ xs' <- (`evalStateT` False)+ . runListT+ . takeListT (if allow_amb then 1 else 2)+ . runNondetT $ xs+ return $ case xs' of+ [x] -> Just x+ _ -> Nothing
Options/Applicative/Types.hs view
@@ -9,10 +9,12 @@ OptReader(..), OptProperties(..), OptVisibility(..),+ ReadM(..), CReader(..), Parser(..), ParserM(..), Completer(..),+ mkCompleter, ParserFailure(..), OptHelpInfo(..), OptTree(..),@@ -30,7 +32,7 @@ import Control.Applicative (Applicative(..), Alternative(..), (<$>), optional)-import Control.Monad (ap, liftM)+import Control.Monad (ap, liftM, MonadPlus, mzero, mplus) import Control.Monad.Trans.Error (Error(..)) import Data.Monoid (Monoid(..)) import System.Exit (ExitCode(..))@@ -99,7 +101,28 @@ instance Functor m => Functor (CReader m) where fmap f (CReader c r) = CReader c (fmap f . r) -type OptCReader = CReader (Either ParseError)+newtype ReadM a = ReadM+ { runReadM :: Either ParseError a }++instance Functor ReadM where+ fmap f (ReadM m) = ReadM (fmap f m)++instance Applicative ReadM where+ pure = ReadM . Right+ ReadM b <*> ReadM a = ReadM (b <*> a)++instance Monad ReadM where+ return = ReadM . Right+ ReadM m >>= f = ReadM $ m >>= runReadM . f+ fail = ReadM . Left . ErrorMsg++instance MonadPlus ReadM where+ mzero = ReadM $ Left (strMsg "")+ mplus m1 m2 = case runReadM m1 of+ Left _ -> m2+ Right r -> return r++type OptCReader = CReader ReadM type ArgCReader = CReader Maybe -- | An 'OptReader' defines whether an option matches an command line argument.@@ -172,6 +195,9 @@ newtype Completer = Completer { runCompleter :: String -> IO [String] }++mkCompleter :: (String -> IO [String]) -> Completer+mkCompleter = Completer instance Monoid Completer where mempty = Completer $ \_ -> return []
README.md view
@@ -161,7 +161,7 @@ ```haskell data FluxCapacitor = ... -parseFluxCapacitor :: String -> Maybe FluxCapacitor+parseFluxCapacitor :: Monad m => String -> m FluxCapacitor option ( long "flux-capacitor"
optparse-applicative.cabal view
@@ -1,5 +1,5 @@ name: optparse-applicative-version: 0.5.2.1+version: 0.6.0 synopsis: Utilities and combinators for parsing command line options description: Here is a simple example of an applicative option parser:@@ -103,7 +103,7 @@ ghc-options: -Wall build-depends: base == 4.*, transformers >= 0.2 && < 0.4,- process == 1.1.*+ process >= 1.0 && < 1.3 test-suite tests type: exitcode-stdio-1.0 hs-source-dirs: tests
tests/Examples/Cabal.hs view
@@ -1,9 +1,15 @@-{-# LANGUAGE Arrows #-}+{-# LANGUAGE Arrows, CPP #-} module Examples.Cabal where import Options.Applicative import Options.Applicative.Arrows +#if __GLASGOW_HASKELL__ <= 702+import Data.Monoid+(<>) :: Monoid a => a -> a -> a+(<>) = mappend+#endif+ data Args = Args CommonOpts Command deriving Show @@ -35,7 +41,7 @@ parser :: Parser Args parser = runA $ proc () -> do opts <- asA commonOpts -< ()- cmds <- (asA . subparser)+ cmds <- (asA . hsubparser) ( command "install" (info installParser (progDesc "Installs a list of packages"))@@ -63,7 +69,7 @@ installParser = runA $ proc () -> do config <- asA configureOpts -< () inst <- asA installOpts -< ()- A helper -< Install config inst+ returnA -< Install config inst installOpts :: Parser InstallOpts installOpts = runA $ proc () -> do@@ -74,13 +80,12 @@ , instForce = force } updateParser :: Parser Command-updateParser = runA $ proc () ->- A helper -< Update+updateParser = pure Update configureParser :: Parser Command configureParser = runA $ proc () -> do config <- asA configureOpts -< ()- A helper -< Configure config+ returnA -< Configure config configureOpts :: Parser ConfigureOpts configureOpts = runA $ proc () -> do@@ -97,7 +102,7 @@ buildParser :: Parser Command buildParser = runA $ proc () -> do opts <- asA buildOpts -< ()- A helper -< Build opts+ returnA -< Build opts buildOpts :: Parser BuildOpts buildOpts = runA $ proc () -> do
tests/Examples/Commands.hs view
@@ -1,7 +1,14 @@+{-# LANGUAGE CPP #-} module Examples.Commands where import Data.List import Options.Applicative++#if __GLASGOW_HASKELL__ <= 702+import Data.Monoid+(<>) :: Monoid a => a -> a -> a+(<>) = mappend+#endif data Sample = Hello [String]
tests/Examples/Hello.hs view
@@ -1,6 +1,13 @@+{-# LANGUAGE CPP #-} module Examples.Hello where import Options.Applicative++#if __GLASGOW_HASKELL__ <= 702+import Data.Monoid+(<>) :: Monoid a => a -> a -> a+(<>) = mappend+#endif data Sample = Sample { hello :: String
tests/Tests.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TemplateHaskell, CPP #-} module Main where import qualified Examples.Hello as Hello@@ -6,12 +6,20 @@ import qualified Examples.Cabal as Cabal import qualified Examples.Alternatives as Alternatives +import Control.Monad+import Data.List import Options.Applicative import System.Exit import Test.HUnit import Test.Framework.Providers.HUnit import Test.Framework.TH.Prime +#if __GLASGOW_HASKELL__ <= 702+import Data.Monoid+(<>) :: Monoid a => a -> a -> a+(<>) = mappend+#endif+ run :: ParserInfo a -> [String] -> Either ParserFailure a run = execParserPure (prefs idm) @@ -241,6 +249,66 @@ i = info (p1 <**> helper) idm result = execParserPure (prefs noBacktrack) i ["c", "-b"] assertLeft result $ \ _ -> return ()++case_error_context :: Assertion+case_error_context = do+ let p = pk <$> option (long "port")+ <*> option (long "key")+ i = info p idm+ result = run i ["--port", "foo", "--key", "291"]+ case result of+ Left (ParserFailure err _) -> do+ msg <- err "test"+ let errMsg = head $ lines msg+ assertBool "no context in error message (option)"+ ("port" `isInfixOf` errMsg)+ assertBool "no context in error message (value)"+ ("foo" `isInfixOf` errMsg)+ Right val ->+ assertFailure $ "unexpected result " ++ show val+ where+ pk :: Int -> Int -> (Int, Int)+ pk = (,)++condr :: MonadPlus m => (Int -> Bool) -> String -> m Int+condr f arg = do+ x <- auto arg+ guard (f (x :: Int))+ return x++case_arg_order_1 :: Assertion+case_arg_order_1 = do+ let p = (,)+ <$> argument (condr even) idm+ <*> argument (condr odd) idm+ i = info p idm+ result = run i ["3", "6"]+ assertLeft result $ \_ -> return ()++case_arg_order_2 :: Assertion+case_arg_order_2 = do+ let p = (,,)+ <$> argument (condr even) idm+ <*> option (reader (condr even) <> short 'a')+ <*> option (reader (condr odd) <> short 'b')+ i = info p idm+ result = run i ["2", "-b", "3", "-a", "6"]+ case result of+ Left _ -> assertFailure "unexpected parse error"+ Right res -> (2, 6, 3) @=? res++case_arg_order_3 :: Assertion+case_arg_order_3 = do+ let p = (,)+ <$> ( argument (condr even) idm+ <|> option (short 'n') )+ <*> argument (condr odd) idm+ i = info p idm+ result = run i ["-n", "3", "5"]+ case result of+ Left _ ->+ assertFailure "unexpected parse error"+ Right res -> (3, 5) @=? res main :: IO () main = $(defaultMainGenerator)