diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2012, Paolo Capriotti + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Paolo Capriotti nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Options/Applicative.hs b/Options/Applicative.hs new file mode 100644 --- /dev/null +++ b/Options/Applicative.hs @@ -0,0 +1,32 @@ +module Options.Applicative ( + -- * Applicative option parsers + -- + -- | This is an empty module which simply re-exports all the public definitions + -- of this package. + -- + -- See for a tutorial, + -- and a general introduction to applicative option parsers. + -- + -- See the documentation of individual modules for more details. + + -- * Exported modules + -- + -- | The standard @Applicative@ module is re-exported here for convenience. + module Control.Applicative, + + -- | Parser type and low-level parsing functionality. + module Options.Applicative.Common, + + -- | Utilities to build parsers out of basic primitives. + module Options.Applicative.Builder, + + -- | Utilities to run parsers and display a help text. + module Options.Applicative.Extra, + ) where + +-- reexport Applicative here for convenience +import Control.Applicative + +import Options.Applicative.Common +import Options.Applicative.Builder +import Options.Applicative.Extra diff --git a/Options/Applicative/Builder.hs b/Options/Applicative/Builder.hs new file mode 100644 --- /dev/null +++ b/Options/Applicative/Builder.hs @@ -0,0 +1,305 @@ +{-# LANGUAGE TemplateHaskell, ScopedTypeVariables #-} +module Options.Applicative.Builder ( + -- * Parser builders + -- + -- | This module contains utility functions and combinators to create parsers + -- for individual options. + -- + -- Each parser builder takes an option modifier, which can be specified by + -- composing basic modifiers using '&' and 'idm' (which are just convenient + -- synonyms for the 'Category' operations 'Control.Category.>>>' and + -- 'Control.Category.id'). + -- + -- For example: + -- + -- + -- > out = strOption + -- > ( long "output" + -- > & short 'o' + -- > & metavar "FILENAME" ) + -- + -- + -- creates a parser for an option called \"output\". + subparser, + argument, + arguments, + flag, + switch, + nullOption, + strOption, + option, + + -- * Modifiers + short, + long, + help, + value, + metavar, + reader, + hide, + multi, + transform, + command, + idm, + (&), + + -- * Readers + -- + -- | A collection of basic option readers. + auto, + str, + disabled, + + -- * Internals + Mod, + HasName, + OptionFields, + FlagFields, + CommandFields, + + -- * Builder for `ParserInfo` + InfoMod, + fullDesc, + header, + progDesc, + footer, + failureCode, + info + ) where + +import Control.Applicative +import Control.Category +import Control.Monad +import Data.Lens.Common +import Data.Lens.Template + +import Options.Applicative.Common +import Options.Applicative.Types + +import Prelude hiding (id, (.)) + +data OptionFields a = OptionFields + { _optNames :: [OptName] + , _optReader :: String -> Maybe a } + +data FlagFields a = FlagFields + { _flagNames :: [OptName] } + +data CommandFields a = CommandFields + { _cmdCommands :: [(String, ParserInfo a)] } + +$( makeLenses [ ''OptionFields + , ''FlagFields + , ''CommandFields ] ) + +class HasName f where + name :: OptName -> f a -> f a + +instance HasName OptionFields where + name n = modL optNames (n:) + +instance HasName FlagFields where + name n = modL flagNames (n:) + +-- mod -- + +data Mod f r a b = Mod (f r -> f r) (Option r a -> Option r b) + +optionMod :: (Option r a -> Option r b) -> Mod f r a b +optionMod = Mod id + +fieldMod :: (f r -> f r) -> Mod f r a a +fieldMod f = Mod f id + +instance Category (Mod f r) 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. +auto :: Read a => String -> Maybe a +auto arg = case reads arg of + [(r, "")] -> Just r + _ -> Nothing + +-- | String option reader. +str :: String -> Maybe String +str = Just + +-- | 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 = fieldMod . name . OptShort + +-- | Specify a long name for an option. +long :: HasName f => String -> Mod f r 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 + +-- | Specify the help text for an option. +help :: String -> Mod f r a a +help = optionMod . setL optHelp + +-- | Specify the option reader. +reader :: (String -> Maybe r) -> Mod OptionFields r a a +reader = fieldMod . setL optReader + +-- | Specify the metavariable. +metavar :: String -> Mod f r a a +metavar = optionMod . setL optMetaVar + +-- | Hide this option. +hide :: Mod f r a a +hide = optionMod $ optShow^=False + +-- | Create a multi-valued option. +multi :: Mod f r a [a] +multi = optionMod f + where + f opt = 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)) + +-- | Apply a transformation to the return value of this option. +-- +-- This can be used, for example, to provide a default value for +-- a required option, like: +-- +-- >strOption +-- >( transform Just +-- >, value Nothing ) +transform :: (a -> b) -> Mod f r a b +transform f = optionMod $ fmap f + +-- | Add a command to a subparser option. +command :: String -> ParserInfo r -> Mod CommandFields r 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 = Just . pure + , _optHelp = "" + , _optDefault = 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 + where + Mod f g = m . metavar "COMMAND" + CommandFields cmds = f (CommandFields []) + opt = 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 + +-- | 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) + +-- | 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 + -> Parser b +flag defv actv (Mod f g) = liftOpt . g . set_default . baseOpts $ rdr + where + rdr = let fields = f (FlagFields []) + in FlagReader (fields^.flagNames) actv + set_default = optDefault ^= Just defv + +-- | Builder for a boolean flag. +-- +-- > switch = flag False True +switch :: Mod FlagFields Bool 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 + 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 m = nullOption $ m . reader str + +-- | Builder for an option using the 'auto' reader. +option :: Read a => Mod OptionFields a a b -> Parser b +option m = nullOption $ m . reader auto + +-- | Modifier for 'ParserInfo'. +newtype InfoMod a b = InfoMod + { applyInfoMod :: ParserInfo a -> ParserInfo b } + +instance Category InfoMod where + id = InfoMod id + m1 . m2 = InfoMod $ applyInfoMod m1 . applyInfoMod m2 + +-- | Specify a full description for this parser. +fullDesc :: InfoMod a a +fullDesc = InfoMod $ infoFullDesc^=True + +-- | Specify a header for this parser. +header :: String -> InfoMod a a +header s = InfoMod $ infoHeader^=s + +-- | Specify a footer for this parser. +footer :: String -> InfoMod a a +footer s = InfoMod $ infoFooter^=s + +-- | Specify a short program description. +progDesc :: String -> InfoMod a a +progDesc s = InfoMod $ infoProgDesc^=s + +-- | Specify an exit code if a parse error occurs. +failureCode :: Int -> InfoMod a a +failureCode n = InfoMod $ infoFailureCode^=n + +-- | Create a 'ParserInfo' given a 'Parser' and a modifier. +info :: Parser a -> InfoMod a a -> ParserInfo a +info parser m = applyInfoMod m base + where + base = ParserInfo + { _infoParser = parser + , _infoFullDesc = True + , _infoHeader = "" + , _infoProgDesc = "" + , _infoFooter = "" + , _infoFailureCode = 1 } + +-- | Trivial option modifier. +idm :: Category hom => hom a a +idm = id + +-- | Compose modifiers. +(&) :: Category hom => hom a b -> hom b c -> hom a c +(&) = flip (.) diff --git a/Options/Applicative/Common.hs b/Options/Applicative/Common.hs new file mode 100644 --- /dev/null +++ b/Options/Applicative/Common.hs @@ -0,0 +1,147 @@ +{-# LANGUAGE Rank2Types, PatternGuards #-} +module Options.Applicative.Common ( + -- * Option parsers + -- + -- | A 'Parser' is composed of a list of options. Several kinds of options + -- are supported: + -- + -- * Flags: simple no-argument options. When a flag is encountered on the + -- command line, its value is returned. + -- + -- * Options: options with an argument. An option can define a /reader/, + -- which converts its argument from String to the desired value, or throws a + -- parse error if the argument does not validate correctly. + -- + -- * Arguments: positional arguments, validated in the same way as option + -- arguments. + -- + -- * Commands. A command defines a completely independent sub-parser. When a + -- command is encountered, the whole command line is passed to the + -- corresponding parser. + -- + Parser, + liftOpt, + + -- * Program descriptions + -- + -- A 'ParserInfo' describes a command line program, used to generate a help + -- screen. Two help modes are supported: brief and full. In brief mode, only + -- an option and argument summary is displayed, while in full mode each + -- available option and command, including hidden ones, is described. + -- + -- A basic 'ParserInfo' with default values for fields can be created using + -- the 'info' function. + ParserInfo(..), + + -- * Running parsers + evalParser, + runParser, + + -- * Low-level utilities + mapParser, + optionNames + ) where + +import Control.Applicative +import Data.Lens.Common +import Data.Maybe +import Data.Monoid +import Options.Applicative.Types + +optionNames :: OptReader a -> [OptName] +optionNames (OptReader names _) = names +optionNames (FlagReader names _) = names +optionNames _ = [] + +-- | Create a parser composed of a single option. +liftOpt :: Option r a -> Parser a +liftOpt opt = ConsP (fmap const opt) (pure ()) + +uncons :: [a] -> Maybe (a, [a]) +uncons [] = Nothing +uncons (x : xs) = Just (x, xs) + +data MatchResult + = NoMatch + | Match (Maybe String) + +instance Monoid MatchResult where + mempty = NoMatch + mappend m@(Match _) _ = m + mappend _ m = m + +type Matcher a = [String] -> P (a, [String]) + +optMatches :: OptReader a -> String -> Maybe (Matcher a) +optMatches rdr arg = case rdr of + OptReader names f + | Just (arg1, val) <- parsed + , arg1 `elem` names + -> Just $ \args -> do + (arg', args') <- tryP . uncons $ maybeToList val ++ args + r <- tryP $ f arg' + return (r, args') + | otherwise -> Nothing + FlagReader names x + | Just (arg1, Nothing) <- parsed + , arg1 `elem` names + -> Just $ \args -> return (x, args) + ArgReader f + | Just result <- f arg + -> Just $ \args -> return (result, args) + CmdReader _ f + | Just cmdInfo <- f arg + -> Just $ \args -> tryP $ runParser (cmdInfo^.infoParser) args + _ -> Nothing + where + parsed + | '-' : '-' : arg1 <- arg + = case span (/= '=') arg1 of + (_, "") -> Just (OptLong arg1, Nothing) + (arg1', _ : rest) -> Just (OptLong arg1', Just rest) + | '-' : arg1 <- arg + = case arg1 of + [] -> Nothing + [a] -> Just (OptShort a, Nothing) + (a : rest) -> Just (OptShort a, Just rest) + | otherwise = Nothing + +tryP :: Maybe a -> P a +tryP = maybe ParseError return + +stepParser :: Parser a -> String -> [String] -> P (Parser a, [String]) +stepParser (NilP _) _ _ = ParseError +stepParser (ConsP opt p) arg args + | Just matcher <- optMatches (opt^.optMain) arg + = do (r, args') <- matcher args + liftOpt' <- tryP $ getL optCont opt r + return (liftOpt' <*> p, args') + | otherwise + = do (p', args') <- stepParser p arg args + return (ConsP opt p', args') + +-- | Apply a 'Parser' to a command line, and return a result and leftover +-- arguments. This function returns 'Nothing' if any parsing error occurs, or +-- if any options are missing and don't have a default value. +runParser :: Parser a -> [String] -> Maybe (a, [String]) +runParser p args = case args of + [] -> result + (arg : argt) -> case stepParser p arg argt of + ParseError -> result + ParseResult (p', args') -> runParser p' args' + where + result = (,) <$> evalParser p <*> pure args + +-- | The default value of a 'Parser'. This function returns 'Nothing' if any +-- of the options don't have a default value. +evalParser :: Parser a -> Maybe a +evalParser (NilP r) = pure r +evalParser (ConsP opt p) = opt^.optDefault <*> evalParser p + +-- | Map a polymorphic function over all the options of a parser, and collect +-- the results. +mapParser :: (forall r x . Option r x -> b) + -> Parser a + -> [b] +mapParser _ (NilP _) = [] +mapParser f (ConsP opt p) = f opt : mapParser f p diff --git a/Options/Applicative/Extra.hs b/Options/Applicative/Extra.hs new file mode 100644 --- /dev/null +++ b/Options/Applicative/Extra.hs @@ -0,0 +1,72 @@ +module Options.Applicative.Extra ( + -- * Extra parser utilities + -- + -- | This module contains high-level functions to run parsers. + helper, + execParser, + execParserPure, + usage, + ParserFailure(..), + ) where + +import Data.Lens.Common +import Options.Applicative.Common +import Options.Applicative.Builder +import Options.Applicative.Help +import Options.Applicative.Utils +import Options.Applicative.Types +import System.Environment +import System.Exit +import System.IO + +-- | A hidden \"helper\" option which always fails. +helper :: Parser (a -> a) +helper = nullOption + ( long "help" + & short 'h' + & help "Show this help text" + & value id + & hide ) + +-- | Result after a parse error. +data ParserFailure = ParserFailure + { errMessage :: String -> String -- ^ Function which takes the program name + -- as input and returns an error message + , errExitCode :: ExitCode -- ^ Exit code to use for this error + } + +-- | 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 + args <- getArgs + case execParserPure pinfo args of + Right a -> return a + Left failure -> do + progn <- getProgName + hPutStr stderr (errMessage failure progn) + exitWith (errExitCode failure) + +-- | A pure version 'execParser'. +execParserPure :: ParserInfo a -- ^ Description of the program to run + -> [String] -- ^ Program arguments + -> Either ParserFailure a +execParserPure pinfo args = + case runParser parser args of + Just (a, []) -> Right a + _ -> Left ParserFailure + { errMessage = \progn -> parserHelpText (add_usage progn pinfo) + , errExitCode = ExitFailure (pinfo^.infoFailureCode) } + where + parser = pinfo^.infoParser + add_usage progn = modL infoHeader $ \h -> vcat [h, usage parser progn] + + +-- | Generate option summary. +usage :: Parser a -> String -> String +usage p progn = foldr (<+>) "" + [ "Usage:" + , progn + , briefDesc p ] diff --git a/Options/Applicative/Help.hs b/Options/Applicative/Help.hs new file mode 100644 --- /dev/null +++ b/Options/Applicative/Help.hs @@ -0,0 +1,99 @@ +{-# LANGUAGE PatternGuards #-} +module Options.Applicative.Help ( + cmdDesc, + briefDesc, + fullDesc, + parserHelpText, + ) where + +import Data.Lens.Common +import Data.List +import Data.Maybe +import Options.Applicative.Common +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 + , descHidden :: Bool + , descSurround :: Bool } + +-- | Generate description for a single option. +optDesc :: OptDescStyle -> Option r a -> String +optDesc style opt = + let ns = optionNames $ opt^.optMain + mv = opt^.optMetaVar + descs = map showOption (sort ns) + desc' = intercalate (descSep style) descs <+> mv + render text + | not (opt^.optShow) && not (descHidden style) + = "" + | null text || not (descSurround style) + = text + | isJust (opt^.optDefault) + = "[" ++ text ++ "]" + | null (drop 1 descs) + = text + | otherwise + = "(" ++ text ++ ")" + in render desc' + +-- | Generate descriptions for commands. +cmdDesc :: Parser a -> String +cmdDesc = intercalate "\n" + . filter (not . null) + . mapParser desc + where + desc opt + | CmdReader cmds p <- opt^.optMain + = tabulate [(cmd, d) + | cmd <- cmds + , d <- maybeToList . fmap (getL infoProgDesc) $ p cmd ] + | otherwise + = "" + +-- | Generate a brief help text for a parser. +briefDesc :: Parser a -> String +briefDesc = foldr (<+>) "" . mapParser (optDesc style) + where + style = OptDescStyle + { descSep = "|" + , descHidden = False + , descSurround = True } + +-- | Generate a full help text for a parser. +fullDesc :: Parser a -> String +fullDesc = tabulate . catMaybes . mapParser doc + where + doc opt + | null n = Nothing + | null h = Nothing + | otherwise = Just (n, h) + where n = optDesc style opt + h = opt^.optHelp + style = OptDescStyle + { descSep = "," + , descHidden = True + , descSurround = False } + +-- | Generate the help text for a program. +parserHelpText :: ParserInfo a -> String +parserHelpText pinfo = unlines + $ nn [pinfo^.infoHeader] + ++ [ " " ++ line | line <- nn [pinfo^.infoProgDesc] ] + ++ [ line | desc <- nn [fullDesc p] + , line <- ["", "Common options:", desc] + , pinfo^.infoFullDesc ] + ++ [ line | desc <- nn [cmdDesc p] + , line <- ["", "Available commands:", desc] + , pinfo^.infoFullDesc ] + ++ [ line | footer <- nn [pinfo^.infoFooter] + , line <- ["", footer] ] + where + nn = filter (not . null) + p = pinfo^.infoParser diff --git a/Options/Applicative/Types.hs b/Options/Applicative/Types.hs new file mode 100644 --- /dev/null +++ b/Options/Applicative/Types.hs @@ -0,0 +1,95 @@ +{-# LANGUAGE GADTs, DeriveFunctor, TemplateHaskell #-} +module Options.Applicative.Types ( + ParserInfo(..), + + infoParser, + infoFullDesc, + infoProgDesc, + infoHeader, + infoFooter, + infoFailureCode, + + Option(..), + OptName(..), + OptReader(..), + Parser(..), + P(..), + + optMain, + optDefault, + optShow, + optHelp, + optMetaVar, + optCont + ) where + +import Control.Applicative +import Control.Monad +import Data.Lens.Template + +-- | A full description for a runnable 'Parser' for a program. +data ParserInfo a = ParserInfo + { _infoParser :: Parser a -- ^ the option parser for the program + , _infoFullDesc :: Bool -- ^ whether the help text should contain full documentation + , _infoProgDesc :: String -- ^ brief parser description + , _infoHeader :: String -- ^ header of the full parser description + , _infoFooter :: String -- ^ footer of the full parser description + , _infoFailureCode :: Int -- ^ exit code for a parser failure + } deriving Functor + + +data OptName = OptShort !Char + | OptLong !String + 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 -> Maybe (Parser a) } -- ^ option continuation + deriving Functor + +-- | An 'OptReader' defines whether an option matches an command line argument. +data OptReader a + = OptReader [OptName] (String -> Maybe a) -- ^ option reader + | FlagReader [OptName] !a -- ^ flag reader + | ArgReader (String -> Maybe a) -- ^ argument reader + | CmdReader [String] (String -> Maybe (ParserInfo a)) -- ^ command reader + deriving Functor + +-- | 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 + +instance Functor Parser where + fmap f (NilP x) = NilP (f x) + fmap f (ConsP opt p) = ConsP (fmap (f.) opt) p + +instance Applicative Parser where + pure = NilP + NilP f <*> p = fmap f p + ConsP opt p1 <*> p2 = + ConsP (fmap uncurry opt) $ (,) <$> p1 <*> p2 + +data P a + = ParseError + | ParseResult a + deriving Functor + +instance Monad P where + return = ParseResult + ParseError >>= _ = ParseError + ParseResult a >>= f = f a + fail _ = ParseError + +instance Applicative P where + pure = return + (<*>) = ap + +$( makeLenses [''Option, ''ParserInfo] ) diff --git a/Options/Applicative/Utils.hs b/Options/Applicative/Utils.hs new file mode 100644 --- /dev/null +++ b/Options/Applicative/Utils.hs @@ -0,0 +1,32 @@ +module Options.Applicative.Utils ( + (<+>), + vcat, + tabulate, + pad + ) where + +import Data.List + +-- | Concatenate two strings with a space in the middle. +(<+>) :: String -> String -> String +"" <+> s = s +s <+> "" = s +s1 <+> s2 = s1 ++ " " ++ s2 + +-- | Concatenate strings vertically with empty lines in between. +vcat :: [String] -> String +vcat = intercalate "\n\n" . filter (not . null) + +tabulate' :: Int -> [(String, String)] -> String +tabulate' size table = unlines + [ " " ++ pad size key ++ " " ++ value + | (key, value) <- table ] + +-- | Display pairs of strings in a table. +tabulate :: [(String, String)] -> String +tabulate = tabulate' 24 + +-- | Pad a string to a fixed size with whitespace. +pad :: Int -> String -> String +pad size str = str ++ replicate (size - n `max` 0) ' ' + where n = length str diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,281 @@ +# Applicative option parser + +This package contains utilities and combinators to define command line option +parsers. + +[![Continuous Integration status][status-png]][status] + +## Getting started + +Here is a simple example of an applicative option parser: + +```haskell +data Sample = Sample + { hello :: String + , quiet :: Bool } + +sample :: Parser Sample +sample = Sample + <$> strOption + ( long "hello" + & metavar "TARGET" + & help "Target for the greeting" ) + <*> switch + ( long "quiet" + & help "Whether to be quiet" ) +``` + +The parser is built using [applicative style][applicative] starting from a set +of basic combinators. In this example, `hello` is defined as an option with a +`String` argument, while `quiet` is a boolean flag (called `switch`). + +A parser can be used like this: + +```haskell +greet :: Sample -> IO () +greet (Sample h True) = putStrLn $ "Hello, " ++ h +greet _ = return () + +main :: IO () +main = execParser opts >>= greet + where + opts = info (helper <*> sample) + ( fullDesc + & progDesc "Print a greeting for TARGET" + & header "hello - a test for optparse-applicative" ) +``` + +The `greet` function is the entry point of the program, while `opts` is a +complete description of the program, used when generating a help text. The +`helper` combinator takes any parser, and adds a `help` option to it (which +always fails). + +The `hello` option in this example is mandatory (since it doesn't have a +default value), so running the program without any argument will display the +help text: + + hello - a test for optparse-applicative + + Usage: hello --hello TARGET [--quiet] + Print a greeting for TARGET + + Common options: + -h,--help Show this help text + --hello TARGET Target for the greeting + --quiet Whether to be quiet + +containing a short usage summary, and a detailed list of options with +descriptions. + + [applicative]: http://www.soi.city.ac.uk/~ross/papers/Applicative.html + +## Supported options + +`optparse-applicative` supports four kinds of options: regular options, flags, +arguments and commands. + +### Regular options + +A **regular option** is an option which takes a single argument, parses it, and +returns a value. + +A regular option can have a default value, which is used as the result if the +option is not found in the command line. An option without a default value is +considered mandatory, and produces an error when not found. + +Regular options can have **long** names, or **short** (one-character) names, +which determine when the option matches and how the argument is extracted. + +An option with a long name (say "output") is specified on the command line as + + --output filename.txt + +or + + --output=filename.txt + +while a short name option (say "o") can be specified with + + -o filename.txt + +or + + -ofilename.txt + +Options can have more than one name, usually one long and one short, although +you are free to create options with an arbitrary combination of long and short +names. + +Regular options returning strings are the most common, and they can be created +using the `strOption` builder. For example, + +```haskell +strOption +( long "output" +& short 'o' +& metavar "FILE" +& help "Write output to FILE" ) +``` + +creates a regular option with a string argument (which can be referred to as +`FILE` in the help text and documentation), a long name "option" and a short +name "o". See below for more information on the builder syntax and modifiers. + +A regular option can return an object of any type, provided you specify a +**reader** for it. A common reader is `auto`, used by the `option` builder, +which assumes a `Read` instance for the return type and uses it to parse its +argument. For example: + +```haskell +lineCount :: Parser Int +lineCount = option + ( long "lines" + & short 'n' + & metavar "K" + & help "Output the last K lines" ) +``` + +specifies a regular option with an `Int` argument. We added an explicit type +annotation here, since without it the parser would have been polymorphic in the +output type. There's usually no need to add type annotations, however, because +the type will be normally inferred from the context in which the parser is +used. + +You can also create a custom reader without using the `Read` typeclass, and set +it as the reader for an option using the `reader` modifier and the `nullOption` +builder: + +```haskell +data FluxCapacitor = ... + +parseFluxCapacitor :: String -> Maybe FluxCapacitor + +option +( long "flux-capacitor" +& reader parseFluxCapacitor ) +``` + +### Flags + +A **flag** is just like a regular option, but it doesn't take any arguments: it is +either present in the command line or not. + +A flag has a default value and an **active value**. If the flag is found on the +command line, the active value is returned, otherwise the default value is +used. For example: + +```haskell +data Verbosity = Normal | Verbose + +flag Normal Verbose +( long "verbose" +& short 'v' +& help "Enable verbose mode" +``` + +is a flag parser returning a `Verbosity` value. + +Simple boolean flags can be specified using the `switch` builder, like so: + +```haskell +switch +( long "keep-tmp-files" +, help "Retain all intermediate temporary files" ) +``` + +### Arguments + +An **argument** parser specifies a positional command line argument. + +The `argument` builder takes a reader parameter, and creates a parser which +will return the parsed value every time it is passed a command line argument +for which the reader succeeds. For example + +```haskell +argument str ( metavar "FILE" ) +``` + +creates an argument accepting any string. + +Arguments are only displayed in the brief help text, so there's no need to +attach a description to them. They should manually documented in the program +description. + +### Commands + +A **command** can be used to specify a sub-parser to be used when a certain +string is encountered in the command line. + +Commands are useful to implement command line programs with multiple functions, +each with its own set of options, and possibly some global options that apply +to all of them. Typical examples are version control systems like `git`, or +build tools like `cabal`. + +A command can be created using the `subparser` builder, and commands can be +added with the `command` modifier. For example + +```haskell +subparser +( command "add" (info addOptions) + ( progDesc "Add a file to the repository" ) +& command "commit") (info commitOptions) + ( progDesc "Record changes to the repository" ) +) +``` + +Each command takes a full `ParserInfo` structure, which will be used to extract +a description for this command when generating a help text. + +Note that all the parsers appearing in a command need to have the same type. +For this reason, it is often best to use a sum type which has the same +structure as the command itself. For example, for the parser above, you would +define a type like: + +```haskell +data Options = Options + { globalOpt :: String + , globalFlag :: Bool + ... + , commandOpts :: CommandOptions } + +data CommandOptions + = AddOptions { ... } + | CommitOptions { ... } + ... +``` + +# Option builders + +Builders allow you to define parsers using a convenient combinator-based +syntax. Each builder takes a **modifier** as parameter, and returns a parser. + +A modifier is a composition of functions which act on the option, setting +values for properties or adding features, and is used to build the option from +scratch and finally lift it to a single-option parser, which can then be +combined with other parsers using normal `Applicative` combinators. + +Modifiers are instances of the `Category` typeclass, so they can be combined +using the composition operator `(.)` from `Control.Category`, but the +`Options.Applicative.Builders` module provides a convenience operator `(&)`, +which is just a specialized version of flipped composition, so that you don't +need to import the `Category` module and hide the `(.)` operator from the +`Prelude`. + +See the haddock documentation for `Options.Applicative.Builder` for a full list +of builders and modifiers. + +## How it works + +A `Parser a` is essentially a heterogeneous list of `Option`s, implemented with +existential types. + +All options are therefore known statically (i.e. before parsing, not +necessarily before runtime), and can, for example, be traversed to generate a +help text. + +See [this blog post][blog] for a more detailed explanation based on a +simplified implementation. + + [status-png]: https://secure.travis-ci.org/pcapriotti/optparse-applicative.png?branch=master + [status]: http://travis-ci.org/pcapriotti/optparse-applicative?branch=master + [blog]: http://paolocapriotti.com/blog/2012/04/27/applicative-option-parser/ diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/optparse-applicative.cabal b/optparse-applicative.cabal new file mode 100644 --- /dev/null +++ b/optparse-applicative.cabal @@ -0,0 +1,95 @@ +name: optparse-applicative +version: 0.0.1 +synopsis: Utilities and combinators for parsing command line options +description: + Here is a simple example of an applicative option parser: + . + @ + data Sample = Sample + { hello :: String + , quiet :: Bool } + . + sample :: Parser Sample + sample = Sample + \<$\> strOption + ( long \"hello\" + & metavar \"TARGET\" + & help \"Target for the greeting\" ) + \<*\> switch + ( long \"quiet\" + & help \"Whether to be quiet\" ) + @ + . + The parser is built using applicative style starting from a set of basic + combinators. In this example, @hello@ is defined as an 'option' with a + @String@ argument, while @quiet@ is a boolean 'flag' (called 'switch'). + . + A parser can be used like this: + . + @ + greet :: Sample -> IO () + greet (Sample h True) = putStrLn $ \"Hello, \" ++ h + greet _ = return () + . + main :: IO () + main = execParser opts \>\>= greet + where + opts = info (helper \<*\> sample) + ( fullDesc + & progDesc \"Print a greeting for TARGET\" + & header \"hello - a test for optparse-applicative\" ) + @ + . + The @greet@ function is the entry point of the program, while @opts@ is a + complete description of the program, used when generating a help text. The + 'helper' combinator takes any parser, and adds a @help@ option to it (which + always fails). + . + The @hello@ option in this example is mandatory (since it doesn't have a + default value), so running the program without any argument will display a + help text: + . + >hello - a test for optparse-applicative + > + >Usage: hello --hello TARGET [--quiet] + > Print a greeting for TARGET + > + >Common options: + > -h,--help Show this help text + > --hello TARGET Target for the greeting + > --quiet Whether to be quiet + . + containing a short usage summary, and a detailed list of options with + descriptions. +license: BSD3 +license-file: LICENSE +author: Paolo Capriotti +maintainer: p.capriotti@gmail.com +copyright: (c) 2012 Paolo Capriotti +category: System +build-type: Simple +cabal-version: >= 1.8 +extra-source-files: README.md + +library + exposed-modules: Options.Applicative, + Options.Applicative.Common, + Options.Applicative.Types, + Options.Applicative.Builder, + Options.Applicative.Utils, + Options.Applicative.Extra, + Options.Applicative.Help + build-depends: base == 4.*, + data-lens == 2.10.*, + data-lens-template == 2.1.*, + data-default == 0.4.* +test-suite tests + type: exitcode-stdio-1.0 + hs-source-dirs: tests + main-is: Tests.hs + build-depends: base == 4.*, + HUnit == 1.2.*, + optparse-applicative == 0.0.*, + test-framework == 0.6.*, + test-framework-hunit == 0.2.*, + test-framework-th-prime == 0.0.* diff --git a/tests/Tests.hs b/tests/Tests.hs new file mode 100644 --- /dev/null +++ b/tests/Tests.hs @@ -0,0 +1,34 @@ +{-# LANGUAGE TemplateHaskell #-} +module Main where + +import qualified Examples.Hello as Hello +import qualified Examples.Commands as Commands + +import Options.Applicative.Extra +import Options.Applicative.Types +import System.Exit +import Test.HUnit +import Test.Framework.Providers.HUnit +import Test.Framework.TH.Prime + +assertLeft :: Show b => Either a b -> (a -> Assertion) -> Assertion +assertLeft x f = either f err x + where + err b = assertFailure $ "expected Left, got " ++ show b + +checkHelpText :: Show a => String -> ParserInfo a -> Assertion +checkHelpText name p = do + let result = execParserPure p ["--help"] + assertLeft result $ \(ParserFailure err code) -> do + expected <- readFile $ "tests/" ++ name ++ ".err.txt" + expected @=? err name + ExitFailure 1 @=? code + +case_hello :: Assertion +case_hello = checkHelpText "hello" Hello.opts + +case_modes :: Assertion +case_modes = checkHelpText "commands" Commands.opts + +main :: IO () +main = $(defaultMainGenerator)