packages feed

optparse-applicative 0.1.1 → 0.2.0

raw patch · 8 files changed

+336/−149 lines, 8 filesdep ~optparse-applicative

Dependency ranges changed: optparse-applicative

Files

Options/Applicative/Builder.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE DeriveFunctor #-} module Options.Applicative.Builder (   -- * Parser builders   --@@ -23,6 +24,7 @@   argument,   arguments,   flag,+  flag',   switch,   nullOption,   strOption,@@ -35,8 +37,8 @@   value,   metavar,   reader,-  hide,-  multi,+  hidden,+  internal,   transform,   command,   idm,@@ -44,7 +46,7 @@    -- * Readers   ---  -- | A collection of basic option readers.+  -- | A collection of basic 'Option' readers.   auto,   str,   disabled,@@ -56,19 +58,25 @@   FlagFields,   CommandFields, -  -- * Builder for `ParserInfo`+  -- * Builder for 'ParserInfo'   InfoMod,   fullDesc,   header,   progDesc,   footer,   failureCode,-  info+  info,++  -- * Builder for 'ParserPrefs'+  PrefsMod,+  multiSuffix,+  prefs   ) where  import Control.Applicative import Control.Category import Control.Monad+import Data.Functor.Identity import Data.Lens.Common  import Options.Applicative.Common@@ -79,12 +87,16 @@ data OptionFields a = OptionFields   { _optNames :: [OptName]   , _optReader :: String -> Maybe a }+  deriving Functor  data FlagFields a = FlagFields-  { _flagNames :: [OptName] }+  { _flagNames :: [OptName]+  , _flagActive :: a }+  deriving Functor  data CommandFields a = CommandFields   { _cmdCommands :: [(String, ParserInfo a)] }+  deriving Functor  optNames :: Lens (OptionFields a) [OptName] optNames = lens _optNames $ \x o -> o { _optNames = x }@@ -109,77 +121,67 @@  -- mod -- -data Mod f r a b = Mod (f r -> f r) (Option r a -> Option r b)+data Mod f a b = Mod (f a -> f b) (OptProperties a -> OptProperties b) -optionMod :: (Option r a -> Option r b) -> Mod f r a b+optionMod :: (OptProperties a -> OptProperties a) -> Mod f a a optionMod = Mod id -fieldMod :: (f r -> f r) -> Mod f r a a+fieldMod :: (f a -> f a) -> Mod f a a fieldMod f = Mod f id -instance Category (Mod f r) where+instance Category (Mod f) where   id = Mod id id   Mod f1 g1 . Mod f2 g2 = Mod (f1 . f2) (g1 . g2)  -- readers -- --- | Option reader based on the 'Read' type class.+-- | 'Option' reader based on the 'Read' type class. auto :: Read a => String -> Maybe a auto arg = case reads arg of   [(r, "")] -> Just r   _         -> Nothing --- | String option reader.+-- | String 'Option' reader. str :: String -> Maybe String str = Just --- | Null option reader. All arguments will fail validation.+-- | Null 'Option' reader. All arguments will fail validation. disabled :: String -> Maybe a disabled = const Nothing  -- modifiers --  -- | Specify a short name for an option.-short :: HasName f => Char -> Mod f r a a+short :: HasName f => Char -> Mod f a a short = fieldMod . name . OptShort  -- | Specify a long name for an option.-long :: HasName f => String -> Mod f r a a+long :: HasName f => String -> Mod f a a long = fieldMod . name . OptLong  -- | Specify a default value for an option.-value :: a -> Mod f r a a-value = optionMod . setL optDefault . Just+value :: a -> Mod f a a+value = optionMod . setL propDefault . Just  -- | Specify the help text for an option.-help :: String -> Mod f r a a-help = optionMod . setL optHelp+help :: String -> Mod f a a+help = optionMod . setL propHelp --- | Specify the option reader.-reader :: (String -> Maybe r) -> Mod OptionFields r a a+-- | Specify the 'Option' reader.+reader :: (String -> Maybe a) -> Mod OptionFields a a reader = fieldMod . setL optReader  -- | Specify the metavariable.-metavar :: String -> Mod f r a a-metavar = optionMod . setL optMetaVar+metavar :: String -> Mod f a a+metavar = optionMod . setL propMetaVar --- | Hide this option.-hide :: Mod f r a a-hide = optionMod $ optShow^=False+-- | Hide this option from the brief description.+hidden :: Mod f a a+hidden = optionMod $ propVisibility ^%= min Hidden --- | Create a multi-valued option.-multi :: Mod f r a [a]-multi = optionMod f-  where-    f opt = optCont ^%= (fmap (fmap reverse) . ) $ mkOptGroup []-      where-        mkOptGroup xs = opt-          { _optDefault = Just xs-          , _optCont = mkCont xs }-        mkCont xs r = do-          p' <- getL optCont opt r-          x <- evalParser p'-          return $ liftOpt (mkOptGroup (x:xs))+-- | Hide this option from the help text+internal :: Mod f a a+internal = optionMod $ propVisibility ^= Internal  -- | Apply a transformation to the return value of this option. --@@ -188,78 +190,110 @@ -- -- >strOption -- >( transform Just--- >, value Nothing )-transform :: (a -> b) -> Mod f r a b-transform f = optionMod $ fmap f+-- >& value Nothing )+transform :: Functor f => (a -> b) -> Mod f a b+transform f = Mod (fmap f) (fmap f)  -- | Add a command to a subparser option.-command :: String -> ParserInfo r -> Mod CommandFields r a a+command :: String -> ParserInfo a -> Mod CommandFields a a command cmd pinfo = fieldMod $ cmdCommands^%=((cmd, pinfo):)  -- parsers -- --- | Base default option.-baseOpts :: OptReader a -> Option a a-baseOpts opt = Option-  { _optMain = opt-  , _optMetaVar = ""-  , _optShow = True-  , _optCont = return . pure-  , _optHelp = ""-  , _optDefault = Nothing }+-- | Base default properties.+baseProps :: OptProperties a+baseProps = OptProperties+  { _propMetaVar = ""+  , _propVisibility = Visible+  , _propHelp = ""+  , _propDefault = Nothing }  -- | Builder for a command parser. The 'command' modifier can be used to -- specify individual commands.-subparser :: Mod CommandFields a a b -> Parser b-subparser m = liftOpt . g . baseOpts $ opt+subparser :: Mod CommandFields a b -> Parser b+subparser m = liftOpt $ Option rdr (g baseProps)   where     Mod f g = m . metavar "COMMAND"     CommandFields cmds = f (CommandFields [])-    opt = CmdReader (map fst cmds) (`lookup` cmds)+    rdr = CmdReader (map fst cmds) (`lookup` cmds)  -- | Builder for an argument parser.-argument :: (String -> Maybe a) -> Mod f a a b -> Parser b-argument p (Mod _ g) = liftOpt . g . baseOpts $ ArgReader p+argument :: (String -> Maybe a) -> Mod Identity a b -> Parser b+argument p (Mod f g) = liftOpt $ Option (ArgReader p') (g baseProps)+  where p' s = fmap (runIdentity . f . Identity) (p s)  -- | Builder for an argument list parser. All arguments are collected and -- returned as a list.-arguments :: (String -> Maybe a) -> Mod f a [a] b -> Parser b-arguments p m = argument p (m . multi)+--+-- Note that arguments starting with @'-'@ are ignored.+--+-- This parser accepts a special argument: @--@. When a @--@ is found on the+-- command line, all following arguments are included in the result, even if+-- they start with @'-'@.+arguments :: (String -> Maybe a) -> Mod Identity a b -> Parser [b]+arguments p m = args+  where+    p' ('-':_) = Nothing+    p' s = p s +    args1 = ((Just <$> arg') <|> (ddash *> pure Nothing)) `BindP` \x -> case x of+      Nothing -> many arg+      Just a -> fmap (a:) args+    args = args1 <|> pure []++    arg' = argument p' m+    arg = argument p m++    ddash = argument (guard . (== "--")) internal+ -- | Builder for a flag parser. -- -- A flag that switches from a \"default value\" to an \"active value\" when -- encountered. For a simple boolean value, use `switch` instead. flag :: a                         -- ^ default value      -> a                         -- ^ active value-     -> Mod FlagFields a a b      -- ^ option modifier+     -> Mod FlagFields a b        -- ^ option modifier      -> Parser b-flag defv actv (Mod f g) = liftOpt . g . set_default . baseOpts $ rdr+flag defv actv m = flag' actv (m . value defv)++-- | Builder for a flag parser without a default value.+--+-- Same as 'flag', but with no default value. In particular, this flag will+-- never parse successfully by itself.+--+-- It still makes sense to use it as part of a composite parser. For example+--+-- > length <$> many (flag' () (short 't'))+--+-- is a parser that counts the number of "-t" arguments on the command line.+flag' :: a                         -- ^ active value+      -> Mod FlagFields a b        -- ^ option modifier+      -> Parser b+flag' actv (Mod f g) = liftOpt $ Option rdr (g baseProps)   where-    rdr = let fields = f (FlagFields [])-          in FlagReader (fields^.flagNames) actv-    set_default = optDefault ^= Just defv+    rdr = let FlagFields ns actv' = f (FlagFields [] actv)+          in FlagReader ns actv'  -- | Builder for a boolean flag. -- -- > switch = flag False True-switch :: Mod FlagFields Bool Bool a -> Parser a+switch :: Mod FlagFields Bool a -> Parser a switch = flag False True  -- | Builder for an option with a null reader. A non-trivial reader can be -- added using the 'reader' modifier.-nullOption :: Mod OptionFields a a b -> Parser b-nullOption (Mod f g) = liftOpt . g . baseOpts $ rdr+nullOption :: Mod OptionFields a b -> Parser b+nullOption (Mod f g) = liftOpt $ Option rdr (g baseProps)   where     rdr = let fields = f (OptionFields [] disabled)           in OptReader (fields^.optNames) (fields^.optReader)  -- | Builder for an option taking a 'String' argument.-strOption :: Mod OptionFields String String a -> Parser a+strOption :: Mod OptionFields String a -> Parser a strOption m = nullOption $ m . reader str  -- | Builder for an option using the 'auto' reader.-option :: Read a => Mod OptionFields a a b -> Parser b+option :: Read a => Mod OptionFields a b -> Parser b option m = nullOption $ m . reader auto  -- | Modifier for 'ParserInfo'.@@ -304,6 +338,27 @@         , _descFailureCode = 1         }       }++newtype PrefsModC a b = PrefsMod+  { applyPrefsMod :: a -> b }+  -- this newtype is just to define a Category instance, for consistency with+  -- the other modifiers; we're only going to use it with a = b = ParserPrefs++-- | Modifier for 'ParserPrefs'.+type PrefsMod = PrefsModC ParserPrefs ParserPrefs++instance Category PrefsModC where+  id = PrefsMod id+  m1 . m2 = PrefsMod $ applyPrefsMod m1 . applyPrefsMod m2++multiSuffix :: String -> PrefsMod+multiSuffix s = PrefsMod $ prefMultiSuffix ^= s++prefs :: PrefsMod -> ParserPrefs+prefs m = applyPrefsMod m base+  where+    base = ParserPrefs+      { _prefMultiSuffix = "" }  -- | Trivial option modifier. idm :: Category hom => hom a a
Options/Applicative/Common.hs view
@@ -61,8 +61,8 @@ optionNames _ = []  -- | Create a parser composed of a single option.-liftOpt :: Option r a -> Parser a-liftOpt opt = ConsP (fmap const opt) (pure ())+liftOpt :: Option a -> Parser a+liftOpt = OptP  uncons :: [a] -> Maybe (a, [a]) uncons [] = Nothing@@ -126,14 +126,25 @@  stepParser :: Parser a -> String -> [String] -> P (Parser a, [String]) stepParser (NilP _) _ _ = empty-stepParser (ConsP opt p) arg args-  | Just matcher <- optMatches (opt^.optMain) arg+stepParser (OptP opt) arg args+  | Just matcher <- optMatches (opt ^. optMain) arg   = do (r, args') <- matcher args-       liftOpt' <- getL optCont opt r-       return (liftOpt' <*> p, args')-  | otherwise-  = do (p', args') <- stepParser p arg args-       return (ConsP opt p', args')+       return (pure r, args')+  | otherwise = empty+stepParser (MultP p1 p2) arg args = msum+  [ do (p1', args') <- stepParser p1 arg args+       return (p1' <*> p2, args')+  , do (p2', args') <- stepParser p2 arg args+       return (p1 <*> p2', args') ]+stepParser (AltP p1 p2) arg args = msum+  [ do (p1', args') <- stepParser p1 arg args+       return (p1' <|> p2, args')+  , do (p2', args') <- stepParser p2 arg args+       return (p1 <|> p2', args') ]+stepParser (BindP p k) arg args = do+  (p', args') <- stepParser p arg args+  x <- evalParser p'+  return (k x, args')  -- | 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@@ -159,13 +170,31 @@ -- | The default value of a 'Parser'.  This function returns an error if any of -- the options don't have a default value. evalParser :: Parser a -> P a-evalParser (NilP r) = pure r-evalParser (ConsP opt p) = tryP (opt^.optDefault) <*> evalParser p+evalParser (NilP r) = tryP r+evalParser (OptP opt) = tryP (opt ^. optDefault)+evalParser (MultP p1 p2) = evalParser p1 <*> evalParser p2+evalParser (AltP p1 p2) = evalParser p1 <|> evalParser p2+evalParser (BindP p k) = evalParser p >>= evalParser . k  -- | Map a polymorphic function over all the options of a parser, and collect -- the results.-mapParser :: (forall r x . Option r x -> b)+mapParser :: (forall x . OptHelpInfo -> Option x -> b)           -> Parser a           -> [b]-mapParser _ (NilP _) = []-mapParser f (ConsP opt p) = f opt : mapParser f p+mapParser = go False False+  where+    has_default :: Parser a -> Bool+    has_default p = case runP (evalParser p) of+      (Left _, _) -> False+      (Right _, _) -> True++    go :: Bool -> Bool+       -> (forall x . OptHelpInfo -> Option x -> b)+       -> Parser a -> [b]+    go _ _ _ (NilP _) = []+    go m d f (OptP opt) = [f (OptHelpInfo m d') opt]+      where d' = d || isJust (opt^.optDefault)+    go m d f (MultP p1 p2) = go m d f p1 ++ go m d f p2+    go m d f (AltP p1 p2) = go m d' f p1 ++ go m d' f p2+      where d' = d || has_default p1 || has_default p2+    go _ d f (BindP p _) = go True d f p
Options/Applicative/Extra.hs view
@@ -27,16 +27,20 @@        & short 'h'        & help "Show this help text"        & value id-       & hide )+       & hidden )  -- | Run a program description. -- -- Parse command line arguments. Display help text and exit if any parse error -- occurs. execParser :: ParserInfo a -> IO a-execParser pinfo = do+execParser = customExecParser (prefs idm)++-- | Run a program description with custom preferences.+customExecParser :: ParserPrefs -> ParserInfo a -> IO a+customExecParser pprefs pinfo = do   args <- getArgs-  case execParserPure pinfo args of+  case execParserPure pprefs pinfo args of     Right a -> return a     Left failure -> do       progn <- getProgName@@ -44,16 +48,17 @@       exitWith (errExitCode failure)  -- | A pure version 'execParser'.-execParserPure :: ParserInfo a      -- ^ Description of the program to run+execParserPure :: ParserPrefs       -- ^ Global preferences for this parser+               -> ParserInfo a      -- ^ Description of the program to run                -> [String]          -- ^ Program arguments                -> Either ParserFailure a-execParserPure pinfo args =+execParserPure pprefs pinfo args =   case runP p of     (Right a, _) -> Right a     (Left msg, ctx) -> Left ParserFailure       { errMessage = \progn           -> with_context ctx pinfo $ \name ->-                 parserHelpText+                 parserHelpText pprefs                . add_error msg                . add_usage name progn       , errExitCode = ExitFailure (pinfo^.infoFailureCode) }@@ -61,7 +66,7 @@     parser = pinfo^.infoParser     add_usage name progn i =       modL infoHeader-           (\h -> vcat [h, usage (i^.infoParser) ename])+           (\h -> vcat [h, usage pprefs (i^.infoParser) ename])            i       where         ename = maybe progn (\n -> progn ++ " " ++ n) name@@ -77,8 +82,8 @@     p = runParserFully parser args  -- | Generate option summary.-usage :: Parser a -> String -> String-usage p progn = foldr (<+>) ""+usage :: ParserPrefs -> Parser a -> String -> String+usage pprefs p progn = foldr (<+>) ""   [ "Usage:"   , progn-  , briefDesc p ]+  , briefDesc pprefs p ]
Options/Applicative/Help.hs view
@@ -24,30 +24,40 @@   , descSurround :: Bool }  -- | Generate description for a single option.-optDesc :: OptDescStyle -> Option r a -> String-optDesc style opt =+optDesc :: ParserPrefs -> OptDescStyle -> OptHelpInfo -> Option a -> String+optDesc pprefs style info opt =   let ns = optionNames $ opt^.optMain       mv = opt^.optMetaVar       descs = map showOption (sort ns)       desc' = intercalate (descSep style) descs <+> mv+      show_opt+        | opt^.optVisibility == Hidden+        = descHidden style+        | otherwise+        = opt^.optVisibility == Visible+      suffix+        | hinfoMulti info+        = pprefs^.prefMultiSuffix+        | otherwise+        = ""       render text-        | not (opt^.optShow) && not (descHidden style)+        | not show_opt         = ""         | null text || not (descSurround style)-        = text-        | isJust (opt^.optDefault)-        = "[" ++ text ++ "]"+        = text ++ suffix+        | hinfoDefault info+        = "[" ++ text ++ "]" ++ suffix         | null (drop 1 descs)-        = text+        = text ++ suffix         | otherwise-        = "(" ++ text ++ ")"+        = "(" ++ text ++ ")" ++ suffix   in render desc'  -- | Generate descriptions for commands. cmdDesc :: Parser a -> [String] cmdDesc = concat . mapParser desc   where-    desc opt+    desc _ opt       | CmdReader cmds p <- opt^.optMain       = tabulate [(cmd, d)                  | cmd <- cmds@@ -56,8 +66,8 @@       = []  -- | Generate a brief help text for a parser.-briefDesc :: Parser a -> String-briefDesc = foldr (<+>) "" . mapParser (optDesc style)+briefDesc :: ParserPrefs -> Parser a -> String+briefDesc pprefs = foldr (<+>) "" . mapParser (optDesc pprefs style)   where     style = OptDescStyle       { descSep = "|"@@ -65,14 +75,14 @@       , descSurround = True }  -- | Generate a full help text for a parser.-fullDesc :: Parser a -> [String]-fullDesc = tabulate . catMaybes . mapParser doc+fullDesc :: ParserPrefs -> Parser a -> [String]+fullDesc pprefs = tabulate . catMaybes . mapParser doc   where-    doc opt+    doc info opt       | null n = Nothing       | null h = Nothing       | otherwise = Just (n, h)-      where n = optDesc style opt+      where n = optDesc pprefs style info opt             h = opt^.optHelp     style = OptDescStyle       { descSep = ","@@ -80,11 +90,11 @@       , descSurround = False }  -- | Generate the help text for a program.-parserHelpText :: ParserInfo a -> String-parserHelpText pinfo = unlines+parserHelpText :: ParserPrefs -> ParserInfo a -> String+parserHelpText pprefs pinfo = unlines    $ nn [pinfo^.infoHeader]   ++ [ "  " ++ line | line <- nn [pinfo^.infoProgDesc] ]-  ++ [ line | let opts = fullDesc p+  ++ [ line | let opts = fullDesc pprefs p             , not (null opts)             , line <- ["", "Common options:"] ++ opts             , pinfo^.infoFullDesc ]
Options/Applicative/Types.hs view
@@ -2,6 +2,7 @@ module Options.Applicative.Types (   ParserInfo(..),   ParserDesc(..),+  ParserPrefs(..),   Context(..),   P, @@ -22,15 +23,22 @@   Option(..),   OptName(..),   OptReader(..),+  OptProperties(..),+  OptVisibility(..),   Parser(..),   ParserFailure(..),+  OptHelpInfo(..),    optMain,   optDefault,-  optShow,+  optVisibility,   optHelp,   optMetaVar,-  optCont+  propDefault,+  propVisibility,+  propHelp,+  propMetaVar,+  prefMultiSuffix,   ) where  import Control.Applicative@@ -58,6 +66,11 @@   , _descFailureCode :: Int       -- ^ exit code for a parser failure   } +-- | Global preferences for a top-level 'Parser'.+data ParserPrefs = ParserPrefs+  { _prefMultiSuffix :: String    -- ^ metavar suffix for multiple options+  }+ data Context where   Context :: Maybe String -> ParserInfo a -> Context   NullContext :: Context@@ -73,14 +86,26 @@              | OptLong !String   deriving (Eq, Ord) +-- | Visibility of an option in the help text.+data OptVisibility+  = Internal          -- ^ does not appear in the help text at all+  | Hidden            -- ^ only visible in the full description+  | Visible           -- ^ visible both in the full and brief descriptions+  deriving (Eq, Ord)+ -- | Specification for an individual parser option.-data Option r a = Option-  { _optMain :: OptReader r               -- ^ reader for this option-  , _optDefault :: Maybe a                -- ^ default value-  , _optShow :: Bool                      -- ^ whether this flag is shown is the brief description-  , _optHelp :: String                    -- ^ help text for this option-  , _optMetaVar :: String                 -- ^ metavariable for this option-  , _optCont :: r -> P (Parser a) }       -- ^ option continuation+data OptProperties a = OptProperties+  { _propDefault :: Maybe a                -- ^ default value+  , _propVisibility :: OptVisibility       -- ^ whether this flag is shown is the brief description+  , _propHelp :: String                    -- ^ help text for this option+  , _propMetaVar :: String                 -- ^ metavariable for this option+  } deriving Functor++-- | A single option of a parser.+data Option a = Option+  { _optMain :: OptReader a               -- ^ reader for this option+  , _optProps :: OptProperties a          -- ^ properties of this option+  }   deriving Functor  -- | An 'OptReader' defines whether an option matches an command line argument.@@ -93,21 +118,29 @@  -- | A @Parser a@ is an option parser returning a value of type 'a'. data Parser a where-  NilP :: a -> Parser a-  ConsP :: Option r (a -> b)-        -> Parser a-        -> Parser b+  NilP :: Maybe a -> Parser a+  OptP :: Option a -> Parser a+  MultP :: Parser (a -> b) -> Parser a -> Parser b+  AltP :: Parser a -> Parser a -> Parser a+  BindP :: Parser a -> (a -> Parser b) -> Parser b  instance Functor Parser where-  fmap f (NilP x) = NilP (f x)-  fmap f (ConsP opt p) = ConsP (fmap (f.) opt) p+  fmap f (NilP x) = NilP (fmap f x)+  fmap f (OptP opt) = OptP (fmap f opt)+  fmap f (MultP p1 p2) = MultP (fmap (f.) p1) p2+  fmap f (AltP p1 p2) = AltP (fmap f p1) (fmap f p2)+  fmap f (BindP p k) = BindP p (fmap f . k)  instance Applicative Parser where-  pure = NilP-  NilP f <*> p = fmap f p-  ConsP opt p1 <*> p2 =-    ConsP (fmap uncurry opt) $ (,) <$> p1 <*> p2+  pure = NilP . Just+  (<*>) = MultP +instance Alternative Parser where+  empty = NilP Nothing+  (<|>) = AltP+  many p = some p <|> pure []+  some p = p `BindP` (\r -> (r:) <$> many p)+ -- | Result after a parse error. data ParserFailure = ParserFailure   { errMessage :: String -> String -- ^ Function which takes the program name@@ -120,26 +153,42 @@     { errMessage = \_ -> msg     , errExitCode = ExitFailure 1 } +data OptHelpInfo = OptHelpInfo+  { hinfoMulti :: Bool+  , hinfoDefault :: Bool }+ -- lenses -optMain :: Lens (Option r a) (OptReader r)+optMain :: Lens (Option a) (OptReader a) optMain = lens _optMain $ \x o -> o { _optMain = x } -optDefault :: Lens (Option r a) (Maybe a)-optDefault = lens _optDefault $ \x o -> o { _optDefault = x }+optProps :: Lens (Option a) (OptProperties a)+optProps = lens _optProps $ \x o -> o { _optProps = x } -optShow :: Lens (Option r a) Bool-optShow = lens _optShow $ \x o -> o { _optShow = x }+propDefault :: Lens (OptProperties a) (Maybe a)+propDefault = lens _propDefault $ \x o -> o { _propDefault = x } -optHelp :: Lens (Option r a) String-optHelp = lens _optHelp $ \x o -> o { _optHelp = x }+propVisibility :: Lens (OptProperties a) OptVisibility+propVisibility = lens _propVisibility $ \x o -> o { _propVisibility = x } -optMetaVar :: Lens (Option r a) String-optMetaVar = lens _optMetaVar $ \x o -> o { _optMetaVar = x }+propHelp :: Lens (OptProperties a) String+propHelp = lens _propHelp $ \x o -> o { _propHelp = x } -optCont :: Lens (Option r a) (r -> P (Parser a))-optCont = lens _optCont $ \x o -> o { _optCont = x }+propMetaVar :: Lens (OptProperties a) String+propMetaVar = lens _propMetaVar $ \x o -> o { _propMetaVar = x } +optDefault :: Lens (Option a) (Maybe a)+optDefault = propDefault . optProps++optVisibility :: Lens (Option a) OptVisibility+optVisibility = propVisibility . optProps++optHelp :: Lens (Option a) String+optHelp = propHelp . optProps++optMetaVar :: Lens (Option a) String+optMetaVar = propMetaVar . optProps+ descFull :: Lens ParserDesc Bool descFull = lens _descFull $ \x p -> p { _descFull = x } @@ -175,3 +224,6 @@  infoFailureCode :: Lens (ParserInfo a) Int infoFailureCode = descFailureCode . infoDesc++prefMultiSuffix :: Lens ParserPrefs String+prefMultiSuffix = lens _prefMultiSuffix $ \x p -> p { _prefMultiSuffix = x }
README.md view
@@ -180,7 +180,7 @@ ```haskell switch ( long "keep-tmp-files"-, help "Retain all intermediate temporary files" )+& help "Retain all intermediate temporary files" ) ```  ### Arguments@@ -288,8 +288,11 @@   returnA -< Options args verbose ``` -where parsers can be converted to arrows using `asA`, and the resulting-composed arrow is converted back to a `Parser` with `runA`.+where parsers are converted to arrows using `asA`, and the resulting composed+arrow is converted back to a `Parser` with `runA`.++See `tests/Examples/Cabal.hs` for a slightly more elaborate example using the+arrow syntax for defining parsers.  ## How it works
optparse-applicative.cabal view
@@ -1,5 +1,5 @@ name:                optparse-applicative-version:             0.1.1+version:             0.2.0 synopsis:            Utilities and combinators for parsing command line options description:     Here is a simple example of an applicative option parser:
tests/Tests.hs view
@@ -4,14 +4,17 @@ import qualified Examples.Hello as Hello import qualified Examples.Commands as Commands import qualified Examples.Cabal as Cabal+import qualified Examples.Alternatives as Alternatives -import Options.Applicative.Extra-import Options.Applicative.Types+import Options.Applicative import System.Exit import Test.HUnit import Test.Framework.Providers.HUnit import Test.Framework.TH.Prime +run :: ParserInfo a -> [String] -> Either ParserFailure a+run = execParserPure (prefs idm)+ assertLeft :: Show b => Either a b -> (a -> Assertion) -> Assertion assertLeft x f = either f err x   where@@ -19,7 +22,7 @@  checkHelpText :: Show a => String -> ParserInfo a -> [String] -> Assertion checkHelpText name p args = do-  let result = execParserPure p args+  let result = run p args   assertLeft result $ \(ParserFailure err code) -> do     expected <- readFile $ "tests/" ++ name ++ ".err.txt"     expected @=? err name@@ -36,7 +39,7 @@  case_args :: Assertion case_args = do-  let result = execParserPure Commands.opts ["hello", "foo", "bar"]+  let result = run Commands.opts ["hello", "foo", "bar"]   case result of     Left _ ->       assertFailure "unexpected parse error"@@ -44,6 +47,36 @@       ["foo", "bar"] @=? args     Right Commands.Goodbye ->       assertFailure "unexpected result: Goodbye"++case_args_opts :: Assertion+case_args_opts = do+  let result = run Commands.opts ["hello", "foo", "--bar"]+  case result of+    Left _ -> return ()+    Right (Commands.Hello xs) ->+      assertFailure $ "unexpected result: Hello " ++ show xs+    Right Commands.Goodbye ->+      assertFailure "unexpected result: Goodbye"++case_args_ddash :: Assertion+case_args_ddash = do+  let result = run Commands.opts ["hello", "foo", "--", "--bar", "baz"]+  case result of+    Left _ ->+      assertFailure "unexpected parse error"+    Right (Commands.Hello args) ->+      ["foo", "--bar", "baz"] @=? args+    Right Commands.Goodbye ->+      assertFailure "unexpected result: Goodbye"++case_alts :: Assertion+case_alts = do+  let result = run Alternatives.opts ["-b", "-a", "-b", "-a", "-a", "-b"]+  case result of+    Left _ -> assertFailure "unexpected parse error"+    Right xs -> [b, a, b, a, a, b] @=? xs+      where a = Alternatives.A+            b = Alternatives.B  main :: IO () main = $(defaultMainGenerator)