multiarg 0.26.0.0 → 0.30.0.10
raw patch · 34 files changed
Files
- ChangeLog +23/−0
- README.md +60/−10
- current-versions.txt +0/−51
- lib/Multiarg.hs +37/−0
- lib/Multiarg/Examples.hs +31/−0
- lib/Multiarg/Examples/Grover.hs +110/−0
- lib/Multiarg/Examples/Telly.hs +88/−0
- lib/Multiarg/Internal.hs +176/−0
- lib/Multiarg/Limeline.hs +44/−0
- lib/Multiarg/Maddash.hs +319/−0
- lib/Multiarg/Mode.hs +15/−0
- lib/Multiarg/Mode/Internal.hs +254/−0
- lib/Multiarg/Types.hs +185/−0
- lib/Multiarg/Util.hs +34/−0
- lib/Multiarg/Vocabulary.hs +94/−0
- lib/System/Console/MultiArg.hs +0/−167
- lib/System/Console/MultiArg/Combinator.hs +0/−478
- lib/System/Console/MultiArg/CommandLine.hs +0/−536
- lib/System/Console/MultiArg/Option.hs +0/−45
- lib/System/Console/MultiArg/Prim.hs +0/−681
- lib/System/Console/MultiArg/SampleParser.hs +0/−70
- minimum-versions.txt +0/−44
- multiarg.cabal +171/−46
- sunlight-test.hs +0/−15
- tests/Ernie.hs +122/−0
- tests/Grover/Tests.hs +136/−0
- tests/Makeopt.hs +62/−0
- tests/Multiarg/Maddash/Instances.hs +31/−0
- tests/Multiarg/Maddash/Tests.hs +138/−0
- tests/Multiarg/Types/Instances.hs +42/−0
- tests/Telly/Tests.hs +81/−0
- tests/grover-main.hs +9/−0
- tests/multiarg-tests.hs +13/−0
- tests/telly-main.hs +6/−0
ChangeLog view
@@ -1,3 +1,26 @@+Release 0.30.0.4++* Version bump for QuickCheck++Release 0.30.0.0++* Completely changed the API. This version is much better tested than+ previous versions. Instead of using parser combinators as a model,+ this version is built on a Mealy finite state machine.++* The tests are particularly exhaustive; there is a module that+ produces all possible command-line words that can parse to a+ particular option (for instance, the user might enter "-a -b foo" or+ "-abfoo" if -b is an option that takes a single option argument.)+ Different combinations are tested randomly.++Release 0.28.0.0++* Renamed everything from System.Console.MultiArg to Multiarg+ (shorter; note also case change from MultiArg to Multiarg)++* Removed existentials from Multiarg.CommandLine+ Release 0.24.0.4, February 24, 2014 * Changed lower bound on base down to 4.5.0.0
README.md view
@@ -10,19 +10,69 @@ http://www.github.com/massysett/multiarg +## Building++If you obtained this code through Hackage, just build it using the+ordinary Cabal command:++cabal install++If you obtain this code on Github, you will first need to generate the+Cabal file and generate the tests. This will require that you install+two libraries:++cabal install cartel quickpull++Then run this script to generate the Cabal file and the tests:++sh generate+ ## Versioning multiarg releases are numbered in accordance with the Haskell Package Versioning Policy. -multiarg does not set its dependencies in accordance with the-Package Versioning Policy, as I do not set upper bounds. multiarg-is guaranteed to build with the *minimum* versions specified in the-cabal file. I also include a current-versions.txt file that-documents more recent dependencies that are also known to work.+Currently the multiarg library depends only on the "base" package, so+multiarg should have wide compatibility with different compilers and+sets of libraries. The tests have some additional dependencies. -If you find that multiarg does not build due to dependency problems:-1) please let me know at omari@smileystation.com; 2) feel free to-add appropriate upper bounds or patches to the package as-appropriate; and 3) feel free to add command-line contraints to your-cabal command to get it to build.+## Build history++If you're having trouble building multiarg, try looking at the+travis-ci build history at:++https://travis-ci.org/massysett/multiarg++It shows successful builds and the versions of any package+dependencies that were installed when that build succeeded, so it+might help you diagnose any dependency issues.++[](https://travis-ci.org/massysett/multiarg)++## Similar libraries++Of course there are many command-line parsing modules and libraries+out there; here are some comparisons.++[optparse-applicative](https://hackage.haskell.org/package/optparse-applicative):+very featureful with a well thought-out interface. Builds help for+you. I often use this if it meets my needs. From what I can tell,+though, it strips out information about the relative ordering of the+words from the command line; for instance, if the user typed "hello+--opt1 --opt2", you cannot tell whether she entered "--opt1" before+she entered "--opt2". Also, from what I can tell it cannot easily+parse options that take more than one argument.++[GetOpt](https://hackage.haskell.org/package/base-4.7.0.2/docs/System-Console-GetOpt.html):+comes with the base libraries, so you don't have to install anything+extra, which gives it a huge advantage. Keeps information about the+relative ordering of the words from the command line. Cannot easily+parse options that take more than one argument.++[cmdargs](https://hackage.haskell.org/package/cmdargs): after multiple+passes through the Haddocks I could never make any sense of this+library at all, which must be a reflection of my level of Haskell+ignorance.++More comparisons are at the [Haskell+Wiki](https://www.haskell.org/haskellwiki/Command_line_option_parsers).
− current-versions.txt
@@ -1,51 +0,0 @@-This package was tested to work with these dependency-versions and compiler version.-These are the default versions fetched by cabal install.-Tested as of: 2014-03-01 20:12:15.212998 UTC-Path to compiler: ghc-7.6.3-Compiler description: 7.6.3--/opt/ghc-7.6.3/lib/ghc-7.6.3/package.conf.d:- Cabal-1.16.0- array-0.4.0.1- base-4.6.0.1- bin-package-db-0.0.0.0- binary-0.5.1.1- bytestring-0.10.0.2- containers-0.5.0.0- deepseq-1.3.0.1- directory-1.2.0.1- filepath-1.3.0.1- (ghc-7.6.3)- ghc-prim-0.3.0.0- (haskell2010-1.1.1.0)- (haskell98-2.0.0.2)- hoopl-3.9.0.0- hpc-0.6.0.0- integer-gmp-0.5.0.0- old-locale-1.0.0.5- old-time-1.1.0.1- pretty-1.1.1.0- process-1.1.0.2- rts-1.0- template-haskell-2.8.0.0- time-1.4.0.1- unix-2.6.0.1--/home/massysett/multiarg/sunlight-29118/db:- bifunctors-4.1.1- comonad-4.0- contravariant-0.4.4- distributive-0.4- hashable-1.2.1.0- mtl-2.1.2- multiarg-0.26.0.0- nats-0.1.2- semigroupoids-4.0- semigroups-0.12.2- tagged-0.7- text-1.1.0.0- transformers-0.3.0.0- transformers-compat-0.1.1.1- unordered-containers-0.2.3.3-
+ lib/Multiarg.hs view
@@ -0,0 +1,37 @@+-- | Parse command lines with /options/ that might take multiple+-- /option arguments/.+--+-- I built this library could not find anything that would readily+-- parse command lines where the /options/ took more than one+-- /option argument/. For example, for the @tail@ command on GNU systems, the+-- @--lines@ /option/ takes one /option argument/ to specify how many+-- lines you want to see. Well, what if you want to build a program+-- with an option that takes two /option arguments/, like @--foo bar+-- baz@? I found no such library so I built this one.+--+-- Please consult the "Multiarg.Vocabulary" module to learn common+-- vocabulary used throughout Multiarg and its documentation. Words+-- that appear in /italics/ are defined in "Multiarg.Vocabulary".+--+-- Use this module to build parsers for simple commands. The+-- 'parseCommandLine' function runs in the IO monad and will cause+-- your program to exit unsuccessfully if there are any errors in the+-- command line, printing an error message in the process. If you+-- want more control over error handling, use the "Multiarg.Internal"+-- module.+--+-- To write parsers for commands with multiple modes (for instance,+-- @ghc-pkg@ has multiple modes, such as @ghc-pkg list@ and @ghc-pkg+-- check@) use the "Multiarg.Mode" module.+--+-- You will find examples in "Multiarg.Examples.Telly" for non-mode+-- parsers, and in "Multiarg.Examples.Grover" for mode parsers.+module Multiarg+ ( ArgSpec(..)+ , OptSpec+ , optSpec+ , parseCommandLine+ ) where++import Multiarg.Internal+import Multiarg.Types
+ lib/Multiarg/Examples.hs view
@@ -0,0 +1,31 @@+-- | These modules provide examples. Since they are live code, cabal+-- compiles them, which ensures that the examples actually compile.+-- In addition, the examples are used as fodder for the test cases;+-- this provides assurance not only that the library is tested but+-- also that the examples work as they should.+--+-- "Multiarg.Examples.Telly" provides an example parser for a command+-- that does not have modes; this is the sort of parser you build with+-- "Multiarg". "Multiarg.Examples.Grover" provides an example of a+-- parser for multiple modes; you build this sort of parser using+-- "Multiarg.Mode".+--+-- To see these examples in action, compile the library using the+-- "programs" flag, like so:+--+-- > cabal configure -fprograms+-- > cabal build+--+-- This will create two programs, @telly@ and @grover@. You simply+-- pass /words/ to these programs just like an ordinary user would,+-- and the programs will print the results of what they parse. If you+-- entered /words/ that parse correctly, you will see this result; if+-- there are any errors, you will see that instead. For example:+--+-- >>> dist/build/telly/telly --uno testarg filename+-- [Uno "testarg",PosArg "filename"]+--+-- >>> dist/build/grover/grover --verbose 2 int --double 5 2+-- Right (ModeResult [Right (Verbose 2)] (Right (Ints [Right (Double 5 2)])))++module Multiarg.Examples where
+ lib/Multiarg/Examples/Grover.hs view
@@ -0,0 +1,110 @@+-- | Grover is a simple example program that shows how to write a+-- parser for commands with multiple modes. You build such parsers+-- using "Multiarg.Mode". It provides an example for the+-- documentation, and it also provides fodder for the QuickCheck+-- tests. You will want to look at the source code.+--+-- Grover has three modes: @int@, @string@, and @maybe@. Each of+-- these modes has three options: @-z@ or @--zero@, which takes no+-- arguments; @-s@ or @--single@, which takes one argument; @-d@ or+-- @--double@, which takes two arguments; and @-t@ or @--triple@,+-- which takes three arguments. The type of the argument depends on+-- the mode. For @int@, the argument or arguments must be an integer;+-- for @string@ the arguments can be any string; and for @maybe@ the+-- arguments must be a Maybe Int, such as @Nothing@ or @Just 5@.+--+-- Each mode also accepts any number of positional arguments, which+-- can be any string.+--+-- Grover handles simple errors right inside the parser by using the+-- @Either@ type as a return value.++module Multiarg.Examples.Grover where++import Control.Applicative+import Multiarg.Mode+import Text.Read (readMaybe)++-- | Grover's global options.+data Global+ = Help+ | Verbose Int+ -- ^ The Int would indicate, for example, the desired level of+ -- verbosity.+ | Version+ deriving (Eq, Ord, Show)++-- | Handles all options and positional arguments for any Grover mode.+data GroverOpt a+ = Zero+ | Single a+ | Double a a+ | Triple a a a+ | PosArg String+ deriving (Eq, Ord, Show)++instance Functor GroverOpt where+ fmap f g = case g of+ Zero -> Zero+ Single a -> Single (f a)+ Double a b -> Double (f a) (f b)+ Triple a b c -> Triple (f a) (f b) (f c)+ PosArg a -> PosArg a++-- | All of Grover's global options. The 'OptSpec' is parameterized+-- on an 'Either' to allow for error handling. If the user enters a+-- non-integer argument for the @--verbose@ option, a @Left@ with an+-- error message is returned.+globalOptSpecs :: [OptSpec (Either String Global)]+globalOptSpecs =+ [ optSpec "h" ["help"] . ZeroArg . return $ Help+ , optSpec "v" ["verbose"] . OneArg $ \s ->+ Verbose <$> readErr s+ , optSpec "" ["version"] . ZeroArg . return $ Version+ ]++-- | A list of 'OptSpec' that works for any 'Mode'.+modeOptSpecs :: Read a => [OptSpec (Either String (GroverOpt a))]+modeOptSpecs =+ [ optSpec "z" ["zero"] . ZeroArg . Right $ Zero+ , optSpec "s" ["single"] . OneArg $ \s -> Single <$> readErr s++ , optSpec "d" ["double"] . TwoArg $ \s1 s2 ->+ Double <$> readErr s1 <*> readErr s2++ , optSpec "t" ["triple"] . ThreeArg $ \s1 s2 s3 ->+ Triple <$> readErr s1 <*> readErr s2 <*> readErr s3+ ]++-- | Holds the results of parsing Grover's modes.+data Result+ = Ints [Either String (GroverOpt Int)]+ | Strings [Either String (GroverOpt String)]+ | Maybes [Either String (GroverOpt (Maybe Int))]+ deriving (Eq, Ord, Show)++-- | All Grover modes.+modes :: [Mode Result]+modes =+ [ mode "int" modeOptSpecs (return . PosArg) Ints+ , mode "string" modeOptSpecs (return . PosArg) Strings+ , mode "maybe" modeOptSpecs (return . PosArg) Maybes+ ]++-- | Reads a value. If it cannot be read, returns an error message.+readErr :: Read a => String -> Either String a+readErr s = case readMaybe s of+ Nothing -> Left $ "could not read value: " ++ s+ Just a -> Right a++-- | Parses all of Grover's options and modes.+parseGrover+ :: [String]+ -- ^ Command line arguments, presumably from 'getArgs'+ -> Either (String, [String])+ (ModeResult (Either String Global) Result)+ -- ^ Returns a 'Left' if there are errors, or a 'Right' if there are+ -- no errors. (In an actual application, further processing of a+ -- 'Right' would be necessary to determine whether all entered+ -- arguments were valid.)+parseGrover = parseModeLine globalOptSpecs modes
+ lib/Multiarg/Examples/Telly.hs view
@@ -0,0 +1,88 @@+-- | Telly is a simple command-line program to test command-line+-- parsers that do not have multiple modes. This includes most+-- command-line programs; you build parsers like this using+-- "Multiarg". This module provides an example for documentation+-- purposes; it also provides fodder for the QuickCheck test cases.+-- You will want to look at the source code.++module Multiarg.Examples.Telly where++import Multiarg++-- | A data type to hold the result of command line parsing.+data Telly+ = PosArg String+ -- ^ Positional argument++ | Empty+ -- ^ @--empty@, @-e@+ | Single String+ -- ^ @--single@, @-s@+ | Double String String+ -- ^ @--double@, @-d@+ | Triple String String String+ -- ^ @--triple@, @-t@++ | Zero+ -- ^ @-0@+ | One String+ -- ^ @-1@+ | Two String String+ -- ^ @-2@+ | Three String String String+ -- ^ @-3@++ | Cero+ -- ^ @--cero@+ | Uno String+ -- ^ @--uno@+ | Dos String String+ -- ^ @--dos@+ | Tres String String String+ -- ^ @--tres@+ deriving (Eq, Ord, Show)++optSpecs :: [OptSpec Telly]+optSpecs =+ [ optSpec "e" ["empty"] (ZeroArg Empty)+ , optSpec "s" ["single"] (OneArg Single)+ , optSpec "d" ["double"] (TwoArg Double)+ , optSpec "t" ["triple"] (ThreeArg Triple)++ , optSpec "0" [] (ZeroArg Zero)+ , optSpec "1" [] (OneArg One)+ , optSpec "2" [] (TwoArg Two)+ , optSpec "3" [] (ThreeArg Three)++ , optSpec "" ["cero"] (ZeroArg Cero)+ , optSpec "" ["uno"] (OneArg Uno)+ , optSpec "" ["dos"] (TwoArg Dos)+ , optSpec "" ["tres"] (ThreeArg Tres)+ ]++help :: String -> String+help progName = unlines+ [ progName ++ " - simple program to test Multiarg."+ , "Parses command line and prints the results to standard output."+ , "Usage:"+ , progName ++ " [options] ARGUMENTS..."+ , ""+ , "Options:"+ , ""+ , "--empty, -e - option that takes no arguments"+ , "--single ARG, -s ARG - option that takes one argument"+ , "--double ARG1 ARG2, -d ARG1 ARG2 - option that takes two arguments"+ , "--triple ARG1 ARG2 ARG3, -t ARG1 ARG2 ARG3"+ , " - option that takes three arguments"+ , ""+ , "--cero - same as --empty"+ , "--uno - same as --single"+ , "--dos - same as --double"+ , "--tres - same as --triple"+ , ""+ , "--help, -h - show help and exit"+ ]++parse :: IO [Telly]+parse = parseCommandLine help optSpecs PosArg+
+ lib/Multiarg/Internal.hs view
@@ -0,0 +1,176 @@+-- | Functions and types used by the "Multiarg" module. You don't+-- have to worry about \"breaking\" anything by using this module.+-- This module is separate from "Multiarg" only because it makes the+-- documentation in that module cleaner, as that module should satisfy+-- most use cases. Use this module if you want more control over+-- error handling, or if you want to process arguments using pure+-- functions rather than IO functions.+module Multiarg.Internal where++import Multiarg.Maddash+import Multiarg.Limeline+import Multiarg.Types+import Multiarg.Util+import Data.Either (partitionEithers)+import System.Environment+import System.Exit+import qualified System.IO as IO++limelineOutputToParsedCommandLine+ :: ([Either [Output a] (PosArg a)], Maybe OptName)+ -> ParsedCommandLine a+limelineOutputToParsedCommandLine (ls, mayOpt) =+ ParsedCommandLine (concatMap f ls) mayOpt+ where+ f ei = case ei of+ Left os -> map g os+ where+ g o = case o of+ Good a -> Right a+ OptionError oe -> Left oe+ Right (PosArg pa) -> [Right pa]+++-- | Indicates the result of parsing a command line.+data ParsedCommandLine a+ = ParsedCommandLine [Either OptionError a] (Maybe OptName)+ -- ^ @ParsedCommandLine a b@, where:+ --+ -- @a@ is a list of errors and results, in the original order in+ -- which they appeared on the command line.+ --+ -- @b@ is @Just p@ if the user included an /option/ at the end of+ -- the command line and there were not enough following /words/ to+ -- provide the /option/ with its necessary /option arguments/, where+ -- @p@ is the /name/ of the /option/ with insufficient+ -- /option arguments/;+ -- otherwise 'Nothing'.+ deriving (Eq, Ord, Show)++instance Functor ParsedCommandLine where+ fmap f (ParsedCommandLine ls m) = ParsedCommandLine+ (map (fmap f) ls) m++-- | Gets the results from a parsed command line. If there were+-- errors, returns a 'Left' with an error message; otherwise, returns+-- a 'Right' with a list of the results.+parsedResults+ :: ParsedCommandLine a+ -> Either (String, [String]) [a]+parsedResults (ParsedCommandLine ls mayOpt) =+ let (ers, gds) = partitionEithers ls+ in case (ers, mayOpt) of+ ([], Nothing) -> Right gds+ ([], Just opt) -> Left (insufficientOptArgs opt, [])+ (x:xs, Just opt) -> Left+ (optError x, map optError xs ++ [insufficientOptArgs opt])+ (x:xs, Nothing) -> Left+ (optError x, map optError xs)++insufficientOptArgs :: OptName -> String+insufficientOptArgs n = "not enough arguments given for option: "+ ++ optNameToString n++optError :: OptionError -> String+optError oe = case oe of+ BadOption opt ->+ "unrecognized option: " ++ optNameToString opt+ LongArgumentForZeroArgumentOption lng arg ->+ "argument given for option that takes no arguments. "+ ++ "option: --" ++ longNameToString lng+ ++ " argument: " ++ optArgToString arg+++-- | Parses a command line; a pure function (unlike+-- 'parseCommandLineIO').+parseCommandLinePure++ :: [OptSpec a]+ -- ^ All program options++ -> (String -> a)+ -- ^ Processes non-option positional arguments++ -> [String]+ -- ^ Input tokens from the command line, probably obtained from+ -- 'getArgs'++ -> ParsedCommandLine a++parseCommandLinePure os fPos inp =+ limelineOutputToParsedCommandLine limeOut+ where+ limeOut = interspersed shrts lngs fPos (map Word inp)+ (shrts, lngs) = splitOptSpecs os++-- | Parses a command line. Runs in the IO monad so that it can do+-- some tedious things for you:+--+-- * fetches the /words/ on command line using 'getArgs' and the name+-- of the program with 'getProgName'+--+-- * prints help, if the user requested help, and exits+-- successfully+--+-- * prints an error message and exits unsuccessfully, if the user+-- entered a bad command line (such as an unknown option)+--+-- If you don't want this degree of automation or if you want a pure+-- function, see the 'parseCommandLinePure' function in the+-- "Multiarg.Internal" module.+parseCommandLine+ :: (String -> String)+ -- ^ Returns help for your command. This function is applied to the+ -- name of the program being run, which is obtained from+ -- 'getProgName'. The function should return a string that gives+ -- help for how to use your command; this string is printed as-is.++ -> [OptSpec a]+ -- ^ All program /options/. An /option/ for @-h@ and for @--help@ is+ -- added for you, using the help function given above. If the user+ -- asks for help, then it is printed and the program exits+ -- successfully. If the user gives a command line with one or more+ -- errors in it, an error message is printed, along with something+ -- like @Enter program-name --help for help@.++ -> (String -> a)+ -- ^ Processes /positional arguments/.++ -> IO [a]+ -- ^ Fetches the /words/ from the command line arguments using+ -- 'getArgs' and parses them. If there is an error, prints an error+ -- message and exits unsuccessfully. Otherwise, returns the parsed+ -- result, where each item in the list corresponds to a parsed+ -- /option/ or /positional argument/ in the order in which it+ -- appeared on the command line.+parseCommandLine fHelp os fPos = do+ progName <- getProgName+ args <- getArgs+ case parsedResults $ parseCommandLineHelp os fPos args of+ Left (e1, es) -> do+ IO.hPutStrLn IO.stderr $ progName ++ ": error"+ _ <- mapM (IO.hPutStrLn IO.stderr) $ e1 : es+ IO.hPutStrLn IO.stderr $ "enter \"" ++ progName ++ " --help\" "+ ++ "for help."+ exitFailure+ Right mayResults -> case sequence mayResults of+ Nothing -> do+ putStr (fHelp progName)+ exitSuccess+ Just ls -> return ls+++-- | Automatically adds a /short option/, @-h@, and a /long option/,+-- @--help@. Intended primarily for use by the 'parseCommandLineIO'+-- function.+parseCommandLineHelp+ :: [OptSpec a]+ -> (String -> a)+ -> [String]+ -> ParsedCommandLine (Maybe a)+parseCommandLineHelp os fPos inp =+ limelineOutputToParsedCommandLine+ $ interspersed shrts lngs (fmap Just fPos) (map Word inp)+ where+ (shrts, lngs) = addHelpOption os+
+ lib/Multiarg/Limeline.hs view
@@ -0,0 +1,44 @@+-- | Processes both /options/ and /positional arguments/. Functions+-- here return both any successful results and any errors. Ordinarily+-- you will not need this module; instead, see "Multiarg" for most+-- uses or "Multiarg.Mode" for commands that have more than one mode.+module Multiarg.Limeline where++import Multiarg.Types+import Multiarg.Maddash+-- GHC 7.10 exports Word from the Prelude+import Prelude hiding (Word)++data PosArg a = PosArg a+ deriving (Eq, Ord, Show)++instance Functor PosArg where+ fmap f (PosArg a) = PosArg (f a)++-- | Processes a command line where /options/ are interspersed with+-- /positional arguments/. A /stopper/ is not returned; all+-- /words/ after a /stopper/ are treated as+-- /positional arguments/.+interspersed+ :: [(ShortName, ArgSpec a)]+ -> [(LongName, ArgSpec a)]+ -> (String -> a)+ -> [Word]+ -> ([Either [Output a] (PosArg a)], Maybe OptName)+interspersed shorts longs fTok = go+ where+ go toks = (map Left outs ++ outsRest, err)+ where+ (outs, ei) = processWords shorts longs toks+ (outsRest, err) = case ei of+ Left (opt, _) -> ([], Just opt)+ Right [] -> ([], Nothing)+ Right ((Word x):xs)+ | x == "--" ->+ ( map (\(Word t) -> Right . PosArg . fTok $ t) xs+ , Nothing )+ | otherwise -> ( (Right . PosArg . fTok $ x) : rest+ , mayErrRest )+ where+ (rest, mayErrRest) = go xs+
+ lib/Multiarg/Maddash.hs view
@@ -0,0 +1,319 @@+-- | Maddash is a Mealy finite state machine that processes /options/.+-- Ordinarily you will not need this module; instead, see "Multiarg"+-- for most uses or "Multiarg.Mode" for commands that have more than+-- one mode.+--+-- The machine consists of the following parts:+--+-- * The set of states, in 'State'+--+-- * The start state, which is 'Ready'+--+-- * The input alphabet, which is all 'Word's. A 'Word' is an+-- input /word/ from the command line.+--+-- * The output alphabet, which is 'Pallet'. A 'Pallet' indicates+-- whether its input is not an option at all with 'NotAnOption'. This+-- indicates that the input 'Word' was not a short option and was not+-- a long option; that is, it was not a single dash followed by a+-- non-dash character and it was not a double dash followed by another+-- character. (Neither a single dash alone nor a double dash alone is+-- an option.) Anything else is an option and will return 'Full',+-- which is a list of 'Output'. Each 'Output' indicates either an+-- error or a good result.+--+-- * The transition function and the output function are combined into+-- a single function, 'processWord'.++module Multiarg.Maddash+ ( -- * /Options/ and /option arguments/+ OptName(..)+ , optSpec+ , ArgSpec(..)+ , ShortName+ , LongName+ , shortName+ , longName+ , shortNameToChar+ , longNameToString++ -- * Machine components+ , Output(..)+ , Pallet(..)+ , State(..)+ , isReady+ , isPending+ , processWord++ -- * Multi-word processor+ , processWords++ -- * Errors+ , OptArg(..)+ , OptionError(..)+ ) where++import Control.Applicative+import Multiarg.Types+-- GHC 7.10 exports Word from the Prelude+import Prelude hiding (Word)++-- * Machine components++data Output a+ = Good a+ | OptionError OptionError+ deriving (Eq, Ord, Show)++instance Functor Output where+ fmap f (Good a) = Good (f a)+ fmap _ (OptionError e) = OptionError e++data Pallet a+ = NotAnOption+ | Full [Output a]+ deriving (Eq, Ord, Show)++instance Functor Pallet where+ fmap _ NotAnOption = NotAnOption+ fmap f (Full os) = Full (map (fmap f) os)++data State a+ = Ready+ -- ^ Accepting new words++ | Pending OptName (Word -> ([Output a], State a))+ -- ^ In the middle of processing an /option/; this function will be+ -- applied to the next word to get a result+++instance Functor State where+ fmap _ Ready = Ready+ fmap f (Pending o g)+ = Pending o (\t -> let (os, st') = g t+ in (map (fmap f) os, fmap f st'))++instance Show (State a) where+ show Ready = "Ready"+ show (Pending o _) = "Pending - " ++ show o++isReady :: State a -> Bool+isReady Ready = True+isReady _ = False++isPending :: State a -> Bool+isPending (Pending _ _) = True+isPending _ = False++-- | Process a single word in the machine.+processWord+ :: [(ShortName, ArgSpec a)]+ -> [(LongName, ArgSpec a)]+ -> State a+ -> Word+ -> (Pallet a, State a)+processWord shorts longs st inp = case st of+ Pending _ f -> (Full os, st')+ where+ (os, st') = f inp+ Ready -> case procOpt of+ Just (os, st') -> (Full os, st')+ Nothing -> (NotAnOption, Ready)+ where+ procOpt = procShort shorts inp <|> procLong longs inp++-- * Multi-word processor++-- | Processes multiple /words/ in the machine. Processing ends with+-- the first /word/ that is 'NotAnOption'. This first /word/ that is+-- 'NotAnOption', and all remaining /words/, are returned in the+-- result. A list of all lists of 'Output' are also returned, with+-- one list for each input 'Word' that was processed. Each of these+-- lists may be of any length. For instance, if the input /word/ is+-- the /flag/ for a /long option/ that takes two /option arguments/,+-- the corresponding list will be empty. If the input /word/ is a+-- /flag/ for a /short option/, this list may have more than one+-- element.+processWords+ :: [(ShortName, ArgSpec a)]+ -> [(LongName, ArgSpec a)]+ -> [Word]+ -> ([[Output a]], Either (OptName, Word -> ([Output a], State a)) [Word])+processWords shorts longs = go Ready+ where+ go Ready [] = ([], Right [])+ go (Pending opt f) [] = ([], Left (opt, f))+ go st (t:ts) = (rs, eiToksPend)+ where+ (pallet, st') = processWord shorts longs st t+ (rs, eiToksPend) = case pallet of+ NotAnOption -> ([], Right (t:ts))+ Full out -> (out : outRest, ei)+ where+ (outRest, ei) = go st' ts++-- * Errors++data OptionError+ = BadOption OptName+ | LongArgumentForZeroArgumentOption LongName OptArg+ -- ^ The user gave an argument for a long option that does not take+ -- an argument.+ deriving (Eq, Ord, Show)++-- * All exported types and functions above this line++-- * Internal functions - not exported++-- | Examines a word to determine if it is a short option. If so,+-- processes it; otherwise, returns Nothing.+procShort+ :: [(ShortName, ArgSpec a)]+ -> Word+ -> Maybe ([Output a], State a)+procShort shorts inp = fmap (getShortOpt shorts) (isShort inp)++getShortOpt+ :: [(ShortName, ArgSpec a)]+ -> (ShortName, ShortTail)+ -> ([Output a], State a)+getShortOpt shorts (short, rest) = case lookup short shorts of+ Nothing -> ( [OptionError (BadOption (OptName (Left short))) ], Ready)+ Just arg -> procShortOpt shorts short arg rest++procShortOpt+ :: [(ShortName, ArgSpec a)]+ -> ShortName+ -> ArgSpec a+ -> ShortTail+ -> ([Output a], State a)+procShortOpt opts _ (ZeroArg a) inp = (this : rest, st)+ where+ this = Good a+ (rest, st) = case splitShortTail inp of+ Nothing -> ([], Ready)+ Just (opt,arg) -> getShortOpt opts (opt, arg)++procShortOpt _ shrt (OneArg f) (ShortTail inp) = case inp of+ [] -> ([], Pending opt g)+ where+ g tok = ([res], Ready)+ where+ res = Good . f . optArgToString $ arg+ arg = wordToOptArg tok+ xs -> ([res], Ready)+ where+ res = Good . f . optArgToString $ optArg+ optArg = OptArg xs+ where+ opt = OptName (Left shrt)++procShortOpt _ shrt (TwoArg f) (ShortTail inp) = ([], Pending opt g)+ where+ g tok1 = case inp of+ [] -> ([], Pending opt h)+ where+ h tok2 = ([res], Ready)+ where+ oa2 = wordToOptArg tok2+ res = Good $ f (optArgToString oa1) (optArgToString oa2)++ xs -> ([res], Ready)+ where+ res = Good $ f (optArgToString tokArg) (optArgToString oa1)+ tokArg = OptArg xs+ where+ oa1 = wordToOptArg tok1+ opt = OptName (Left shrt)++procShortOpt _ shrt (ThreeArg f) (ShortTail inp) = ([], Pending opt g)+ where+ opt = OptName (Left shrt)+ g tok1 = ([], Pending opt h)+ where+ oa1 = wordToOptArg tok1+ h tok2 = case inp of+ [] -> ([], Pending opt i)+ where+ i tok3 = ([res], Ready)+ where+ oa3 = wordToOptArg tok3+ res = Good $ f (optArgToString oa1) (optArgToString oa2)+ (optArgToString oa3)+ tokInp -> ([res], Ready)+ where+ tokArg = wordToOptArg (Word tokInp)+ res = Good $ f (optArgToString tokArg) (optArgToString oa1)+ (optArgToString oa2)+ where+ oa2 = wordToOptArg tok2++procLong+ :: [(LongName, ArgSpec a)]+ -> Word+ -> Maybe ([Output a], State a)+procLong longs inp = fmap (procLongOpt longs) (isLong inp)++procLongOpt+ :: [(LongName, ArgSpec a)]+ -> (LongName, Maybe OptArg)+ -> ([Output a], State a)+procLongOpt longs (inp, mayArg) = case lookup inp longs of+ Nothing -> ( [OptionError (BadOption . OptName . Right $ inp)], Ready)+ Just (ZeroArg r) -> ([result], Ready)+ where+ result = case mayArg of+ Nothing -> Good r+ Just arg -> OptionError (LongArgumentForZeroArgumentOption inp arg)++ Just (OneArg f) -> case mayArg of+ Nothing -> ([], Pending opt run)+ where+ run tok = ([out], Ready)+ where+ out = Good $ f (optArgToString arg1)+ arg1 = wordToOptArg tok+ Just arg -> ([out], Ready)+ where+ out = Good $ f (optArgToString arg)++ Just (TwoArg f) -> ([], Pending opt g)+ where+ g gTok = case mayArg of+ Just arg1 -> ([out], Ready)+ where+ out = Good $ f (optArgToString arg1) (optArgToString gArg)+ Nothing -> ([], Pending opt h)+ where+ h hTok = ([out], Ready)+ where+ out = Good $ f (optArgToString gArg)+ (optArgToString hArg)+ hArg = wordToOptArg hTok+ where+ gArg = wordToOptArg gTok++ Just (ThreeArg f) -> ([], Pending opt g)+ where+ g gTok = ([], Pending opt h)+ where+ gArg = wordToOptArg gTok+ h hTok = case mayArg of+ Just arg1 -> ([out], Ready)+ where+ out = Good $ f (optArgToString arg1) (optArgToString gArg)+ (optArgToString hArg)+ Nothing -> ([], Pending opt i)+ where+ i iTok = ([out], Ready)+ where+ iArg = wordToOptArg iTok+ out = Good $ f (optArgToString gArg)+ (optArgToString hArg)+ (optArgToString iArg)+ where+ hArg = wordToOptArg hTok+ where+ opt = OptName (Right inp)++-- * end
+ lib/Multiarg/Mode.hs view
@@ -0,0 +1,15 @@+-- | Helps you build command-line parsers for programs that have more+-- than one so-called /mode/; examples of such programs include @git@,+-- @darcs@, and @ghc-pkg@.+module Multiarg.Mode+ ( ArgSpec(..)+ , OptSpec+ , optSpec+ , Mode+ , mode+ , ModeResult(..)+ , parseModeLine+ ) where++import Multiarg.Mode.Internal+import Multiarg.Types
+ lib/Multiarg/Mode/Internal.hs view
@@ -0,0 +1,254 @@+-- | Internal functions used by "Multiarg.Mode". You don't have to+-- worry about \"breaking\" anything by using this module; it is+-- separate from "Multiarg.Mode" primarily to tidy up the+-- documentation in that module. The functions in "Multiarg.Mode"+-- should satisfy most use cases. However, if you want more control+-- over error handling, you can use this module.+module Multiarg.Mode.Internal where++import Data.Either (partitionEithers)+import Multiarg.Maddash+import Multiarg.Internal+import Multiarg.Util+import Multiarg.Types+-- GHC 7.10 exports Word from the Prelude+import Prelude hiding (Word)++newtype ModeName = ModeName String+ deriving (Eq, Ord, Show)++data ParsedMode a+ = ModeGood a+ | ModeError [OptionError] (Either OptionError OptName)+ -- ^ There was an error. There may be zero or more initial+ -- OptionError. There must be at least one error, which is either+ -- an OptionError or the name of an option, if the error is that+ -- there were not enough words following the option to provide it+ -- with its necessary arguments.+ deriving (Eq, Ord, Show)++instance Functor ParsedMode where+ fmap f (ModeGood a) = ModeGood (f a)+ fmap _ (ModeError ls ei) = ModeError ls ei++-- | A 'Mode' represents a single command line mode, such as @check@+-- for @ghc-pkg check@. It contains the name of the mode, as well as+-- a parser that handles all /options/ and /positional arguments/ for+-- the mode. Ordinarily you will create a 'Mode' using the 'mode'+-- function rather than by using the constructor directly.+data Mode r = Mode ModeName ([Word] -> ParsedMode r)++instance Functor Mode where+ fmap f (Mode s p) = Mode s (fmap (fmap f) p)++parsedCommandLineToParsedMode+ :: ([a] -> r)+ -> ParsedCommandLine a+ -> ParsedMode r+parsedCommandLineToParsedMode fMode (ParsedCommandLine ls mayOpt)+ = case mayOpt of+ Nothing -> case mayLast errs of+ Nothing -> ModeGood (fMode goods)+ Just (errs1st, errsLst) -> ModeError errs1st (Left errsLst)+ Just opt -> ModeError errs (Right opt)+ where+ (errs, goods) = partitionEithers ls++-- | Creates a new 'Mode'.+mode+ :: String+ -- ^ Mode name. For instance, for the @check@ mode of @ghc-pkg@,+ -- this would be @check@.+ -> [OptSpec a]+ -- ^ Mode /options/+ -> (String -> a)+ -- ^ Parses /positional arguments/+ -> ([a] -> r)+ -- ^ Processes the result of all mode /options/+ -> Mode r+mode name opts fPos fMode+ = Mode (ModeName name)+ $ parsedCommandLineToParsedMode fMode+ . parseCommandLinePure opts fPos+ . map (\(Word s) -> s)++data GlobalLocalEnd a+ = GlobalInsufficientOptArgs OptName+ | ModeNotFound String [String]+ | NoMode+ | ModeFound (ParsedMode a)+ deriving (Eq, Ord, Show)++data GlobalLocal g r+ = GlobalLocal [Either OptionError g] (GlobalLocalEnd r)+ deriving (Eq, Ord, Show)++-- | The result of parsing a mode command line.+data ModeResult g r+ = ModeResult [g] (Either [String] r)+ -- ^ @ModeResult a b@ is a successfully parsed mode command line,+ -- where:+ --+ -- @a@ is a list of all global options parsed; and+ --+ -- @b@ indicates the result of parsing the mode. It is @Either c+ -- d@, where @Left c@ indicates that no mode was parsed. This+ -- arises under two circumstances. If the user did not include any+ -- /words/ after the global /options/, then @c@ will be the empty+ -- list, @[]@. If the user did include /words/ after the global+ -- options, but the first /word/ was not recognized as a mode, then+ -- this list will contain the first /word/ and any subsequent /words/.+ -- Therefore, note that if the user attempted to use a mode that+ -- does not exist (e.g. she misspelled it), this is not treated as+ -- an error. It's up to the client code to deal with this issue+ -- (for instance, your program might not view this situation as+ -- being an error.)+ --+ -- If @b@ is @Right d@, this indicates that the user entered a+ -- recognized mode, and the result is @d@.++ deriving (Eq, Ord, Show)++getModeResult+ :: GlobalLocal g r+ -> Either (String, [String]) (ModeResult g r)+getModeResult (GlobalLocal eis end)+ = combine global (endToModeResult end)+ where+ (glblErrs, glblGoods) = partitionEithers eis+ global = case glblErrs of+ [] -> Right glblGoods+ x:xs -> Left (x, xs)++combine+ :: Either (OptionError, [OptionError]) [g]+ -- ^ Global result. Contains either one or more errors, or global+ -- /option/ results.++ -> Either (String, [String]) (Either [String] r)+ -- ^ Result of parsing mode /word/, and the mode /options/ and+ -- /positional arguments/. May be @Left a@, where @a@ is one or+ -- more errors, or @Right b@, where @b@ is a good result. A good+ -- result @b@ may be either @Left c@, where @c@ is a list of+ -- /positional arguments/, or @Right d@, where @d@ is the mode+ -- result. @c@ indicates that no mode was recognized and may be+ -- either @[]@, which indicates that the user passed no /words/ at+ -- all after the global /options/, or @x:xs@, indicating that the+ -- user did pass /words/ after the global /options/, but the first+ -- /word/ was not recognized as a mode.++ -> Either (String, [String]) (ModeResult g r)+combine (Left (oe1, oes)) (Left (me1, mes)) =+ Left ( globalOptErrorToString oe1+ , map globalOptErrorToString oes ++ (me1 : mes) )+combine (Left (oe1, oes)) (Right _) =+ Left (globalOptErrorToString oe1, map globalOptErrorToString oes)+combine (Right _) (Left (me1, mes)) = Left (me1, mes)+combine (Right glbls) (Right r) =+ Right (ModeResult glbls r)++endToModeResult+ :: GlobalLocalEnd a+ -> Either (String, [String]) (Either [String] a)+endToModeResult end = case end of+ GlobalInsufficientOptArgs on -> Left+ (labeledInsufficientOptArgs "global" on, [])+ ModeNotFound s ss -> Right (Left $ s:ss)+ NoMode -> Right (Left [])+ ModeFound pm -> extractParsedMode pm++extractParsedMode+ :: ParsedMode a+ -> Either (String, [String]) (Either b a)+extractParsedMode (ModeGood g) = Right . Right $ g+extractParsedMode (ModeError es lst) = Left $ case es of+ [] -> (eiToError lst, [])+ (x:xs) ->+ ( modeOptErrorToString x+ , (map modeOptErrorToString xs) ++ [eiToError lst] )++globalOptErrorToString :: OptionError -> String+globalOptErrorToString = optErrorToString "global"++modeOptErrorToString :: OptionError -> String+modeOptErrorToString = optErrorToString "mode"++optErrorToString :: String -> OptionError -> String+optErrorToString lbl oe = case oe of+ BadOption opt ->+ "unrecognized " ++ lbl ++ " option: " ++ optNameToString opt+ LongArgumentForZeroArgumentOption lng arg ->+ "argument given for " ++ lbl ++ " option that takes no arguments. "+ ++ "option: --" ++ longNameToString lng+ ++ " argument: " ++ optArgToString arg+++eiToError :: Either OptionError OptName -> String+eiToError ei = case ei of+ Left oe -> modeOptErrorToString oe+ Right on -> labeledInsufficientOptArgs "mode" on+++labeledInsufficientOptArgs :: String -> OptName -> String+labeledInsufficientOptArgs lbl on = "insufficient option arguments "+ ++ "given for " ++ lbl ++ " option: " ++ optNameToString on+++-- | Parses a command line that may contain modes.+parseModeLine+ :: [OptSpec g]+ -- ^ Global /options/. This might, for example, include a @--help@+ -- /option/.+ -> [Mode r]+ -- ^ All modes+ -> [String]+ -- ^ All command line /words/+ -> Either (String, [String]) (ModeResult g r)+ -- ^ Returns @Either a b@. @Left a@ represents an error. Each+ -- String represents a single error (this is returned as a pair+ -- because there must be at least one error; a simple list would not+ -- reflect this requirement.)+ --+ -- @Right b@ indicates that parsing proceeded successfully; consult+ -- 'ModeResult' to see what is returned.+parseModeLine glbl mds =+ getModeResult+ . parseModeLineWithErrors glbl mds++parseModeLineWithErrors+ :: [OptSpec g]+ -- ^ Global options+ -> [Mode r]+ -- ^ All modes+ -> [String]+ -- ^ All command line tokens+ -> GlobalLocal g r+parseModeLineWithErrors glbl mds tokStrings = GlobalLocal lsErrsGoods end+ where+ toks = map Word tokStrings+ (shorts, longs) = splitOptSpecs glbl+ (outs, eiOptTok) = processWords shorts longs toks+ lsErrsGoods = map f . concat $ outs+ where+ f (Good a) = Right a+ f (OptionError e) = Left e+ end = case eiOptTok of+ Left (opt, _) -> GlobalInsufficientOptArgs opt+ Right [] -> NoMode+ Right (x:xs) -> case findExactMode x mds of+ Nothing -> ModeNotFound (unWord x) (map unWord xs)+ where+ unWord (Word t) = t+ Just (Mode _ f) -> ModeFound (f xs)++-- | Takes a token and a list of all modes; returns the matching mode+-- if there is one, or Nothing if there is no match.+findExactMode+ :: Word+ -> [Mode a]+ -> Maybe (Mode a)+findExactMode _ [] = Nothing+findExactMode tok@(Word s) (m@(Mode (ModeName n) _) : ms)+ | s == n = Just m+ | otherwise = findExactMode tok ms+
+ lib/Multiarg/Types.hs view
@@ -0,0 +1,185 @@+-- | Types used throughout Multiarg, and associated functions.+-- Ordinarily you should not need this module; "Multiarg" and+-- "Multiarg.Mode" export all the types and constructors you should+-- ordinarily need. However, if you want more control than those+-- modules afford, you can import this one.+module Multiarg.Types+ ( ArgSpec(..)+ , OptSpec(..)+ , optSpec+ , ShortName+ , shortNameToChar+ , shortName+ , LongName+ , longNameToString+ , longName+ , Word(..)+ , OptName(..)+ , optNameToString+ , OptArg(..)+ , ShortTail(..)+ , isLong+ , isShort+ , wordToOptArg+ , splitShortTail+ ) where++-- GHC 7.10 incorporates 'Data.Word' into the Prelude, which clashes+-- with a binding below.+import Prelude hiding (Word)++-- | Specifies how many /option arguments/ an /option/ takes.+data ArgSpec a+ = ZeroArg a+ -- ^ This /option/ takes no /option arguments/+ | OneArg (String -> a)+ -- ^ This /option/ takes one /option argument/+ | TwoArg (String -> String -> a)+ -- ^ This /option/ takes two /option arguments/+ | ThreeArg (String -> String -> String -> a)+ -- ^ This /option/ takes three /option arguments/++instance Functor ArgSpec where+ fmap f (ZeroArg a) = ZeroArg (f a)+ fmap f (OneArg g) = OneArg $ \a -> f (g a)+ fmap f (TwoArg g) = TwoArg $ \a b -> f (g a b)+ fmap f (ThreeArg g) = ThreeArg $ \a b c -> f (g a b c)++instance Show (ArgSpec a) where+ show (ZeroArg _) = "ZeroArg"+ show (OneArg _) = "OneArg"+ show (TwoArg _) = "TwoArg"+ show (ThreeArg _) = "ThreeArg"++-- | Specifies an /option/. Typically you will use 'optSpec' to+-- create an 'OptSpec' rather than using the constructor directly.+-- Each 'OptSpec' may contain mulitple /short option names/ and+-- /long option names/; but each 'OptSpec' contains only one 'ArgSpec'.+-- Therefore, all /short option names/ and /long option names/+-- specified in a single 'OptSpec' are synonymous.+data OptSpec a = OptSpec [ShortName] [LongName] (ArgSpec a)+ deriving Show++instance Functor OptSpec where+ fmap f (OptSpec s l p) = OptSpec s l (fmap f p)++-- | Creates an 'OptSpec'.+optSpec+ :: [Char]+ -- ^ There is one character for each desired /short option name/.+ -- Each of these characters may not be a hyphen; otherwise,+ -- 'optSpec' will apply 'error'.++ -> [String]+ -- ^ There is one string for each desired /long option name/. Each+ -- string:+ --+ -- * cannot be empty;+ --+ -- * must not begin with a hyphen; and+ --+ -- * must not contain an equal sign.+ --+ -- Otherwise, 'optSpec' will apply 'error'.++ -> ArgSpec a+ -- ^ How many /option arguments/ this /option/ takes. This also+ -- specifies what is returned when the /option/ is parsed on the+ -- command line.++ -> OptSpec a+optSpec ss ls = OptSpec (map mkShort ss) (map mkLong ls)+ where+ mkShort s = case shortName s of+ Nothing -> error $ "invalid short option name: " ++ [s]+ Just n -> n+ mkLong s = case longName s of+ Nothing -> error $ "invalid long option name: " ++ s+ Just n -> n+++-- | A /short option name/.+newtype ShortName = ShortName { shortNameToChar :: Char }+ deriving (Eq, Ord, Show)++-- | A /long option name/.+newtype LongName = LongName { longNameToString :: String }+ deriving (Eq, Ord, Show)++-- | Creates a /short option name/. Any character other than a single+-- hyphen will succeed.+shortName :: Char -> Maybe ShortName+shortName '-' = Nothing+shortName x = Just $ ShortName x++-- | Creates a /long option name/. The string may not be empty, and the+-- first character may not be a hyphen. In addition, no character may+-- be an equal sign.+longName :: String -> Maybe LongName+longName s = case s of+ [] -> Nothing+ '-':_ -> Nothing+ xs | '=' `elem` xs -> Nothing+ | otherwise -> Just $ LongName xs++-- | The /name/ of an /option/ (either a /short option name/+-- or a /long option name/).+newtype OptName = OptName (Either ShortName LongName)+ deriving (Eq, Ord, Show)++optNameToString :: OptName -> String+optNameToString (OptName ei) = case ei of+ Left shrt -> '-' : shortNameToChar shrt : []+ Right lng -> "--" ++ longNameToString lng++-- | A /word/ supplied by the user on the command line.+newtype Word = Word String+ deriving (Eq, Ord, Show)++-- | An /option argument/.+newtype OptArg = OptArg { optArgToString :: String }+ deriving (Eq, Ord, Show)++-- | Is this /word/ an input for a /long option/?+isLong+ :: Word+ -> Maybe (LongName, Maybe OptArg)+ -- ^ Nothing if the option does not begin with a double dash and is+ -- not at least three characters long. Otherwise, returns the+ -- characters following the double dash to the left of any equal+ -- sign. The Maybe in the tuple is Nothing if there is no equal+ -- sign, or Just followed by characters following the equal sign if+ -- there is one.+isLong (Word ('-':'-':[])) = Nothing+isLong (Word ('-':'-':xs)) = Just (LongName optName, arg)+ where+ (optName, end) = span (/= '=') xs+ arg = case end of+ [] -> Nothing+ _:rs -> Just . OptArg $ rs+isLong _ = Nothing++-- | Characters after the first /short option name/ in a /flag/ that+-- specifies a /short option/ instance, if the user supplies+-- @-afoobar@, then this will be @foobar@.+newtype ShortTail = ShortTail String+ deriving (Eq, Ord, Show)++-- | Is this an input /word/ for a /short argument/?+isShort+ :: Word+ -> Maybe (ShortName, ShortTail)+isShort (Word ('-':'-':_)) = Nothing+isShort (Word ('-':[])) = Nothing+isShort (Word ('-':x:xs)) = Just (ShortName x, ShortTail xs)+isShort _ = Nothing++wordToOptArg :: Word -> OptArg+wordToOptArg (Word t) = OptArg t++-- | If possible, splits a ShortTail into a /short option name/ and a+-- remaining tail.+splitShortTail :: ShortTail -> Maybe (ShortName, ShortTail)+splitShortTail (ShortTail s) = case s of+ [] -> Nothing+ x:xs -> Just (ShortName x, ShortTail xs)
+ lib/Multiarg/Util.hs view
@@ -0,0 +1,34 @@+-- | Grab bag of miscellaneous functions.+module Multiarg.Util where++import Multiarg.Types++-- | Returns a list of the first items in a list and the last item, or+-- Nothing if the list is empty.+mayLast :: [a] -> Maybe ([a], a)+mayLast [] = Nothing+mayLast xs = Just (init xs, last xs)++-- | Partitions a list of 'OptSpec' into the short flags and long+-- flags.+splitOptSpecs+ :: [OptSpec a]+ -> ([(ShortName, ArgSpec a)], [(LongName, ArgSpec a)])+splitOptSpecs = foldr f ([], [])+ where+ f (OptSpec so lo sp) (ss, ls) = (so' ++ ss, lo' ++ ls)+ where+ so' = map (\o -> (o, sp)) so+ lo' = map (\o -> (o, sp)) lo++-- | Adds an option for @h@ and @help@. The resulting 'ArgSpec'+-- return 'Nothing' if help was requested, or 'Just' with the original+-- argument for any other option.+addHelpOption+ :: [OptSpec a]+ -> ( [(ShortName, ArgSpec (Maybe a))]+ , [(LongName, ArgSpec (Maybe a))] )+addHelpOption os = splitOptSpecs os'+ where+ os' = optSpec "h" ["help"] (ZeroArg Nothing) : map (fmap Just) os+
+ lib/Multiarg/Vocabulary.hs view
@@ -0,0 +1,94 @@+-- | Vocabulary used throughout Multiarg.+--+-- Each time one of these words is used in the documentation, it is+-- /italicized/ (or, if you are viewing the source code directly+-- rather than through Haddock, it is /surrounded by slashes/).+--+-- [/word/] When you run your program from the Unix shell prompt, your+-- shell is responsible for splitting the command line into+-- /words/. Typically you separate /words/ with spaces, although+-- quoting can affect this. multiarg parses lists of /words/. Each+-- /word/ can consist of a single /long option/, a single /long option/+-- and an accompanying /option argument/, a single /short option/,+-- multiple /short options/, and even one or more /short options/+-- with the last /short option/ being accompanied by an+-- /option argument/. Or, a word can be a /positional argument/ or a+-- /stopper/. All these are described below.+--+-- [/option/] /Options/ allow a user to specify ways to tune the+-- operation of a program. Typically /options/ are indeed optional,+-- although some programs do sport \"required options\" (a bit of an+-- oxymoron). /Options/ can be either /short options/ or /long options/.+-- Also, /options/ can take /option arguments/.+-- The option is specified on the command line with both the /flag/+-- that specifies the option and of any /option arguments/ that are+-- included with the /option/. Therefore the /option/ might be+-- specified on the command line using one /word/ or multiple /words/,+-- and in the case of short /options/, multiple /options/ might be in+-- one /word/.+--+-- [/short option/] An /option/ that is specified on the command line+-- using a /flag/ whose /word/ begins with a hyphen, and with a single+-- letter. For example, for the program @tail(1)@, possible short+-- options include @n@ and @v@. Multiarg will parse /words/ that+-- contain mulitple /short options/. For example, if a user wants to+-- run @tail@ with two options, he might type @tail -v -f@ or he might+-- type @tail -vf@.+--+-- [/flag/] A /flag/ uniquely specifies an /option/. To specify an+-- /option/ on the command line, the user must present both a /flag/+-- and any /option arguments/. In the case of a /long option/, the+-- /flag/ consists of one or more characters (typically a mnemonic+-- word), preceded by two hyphens. In the case of a /short option/,+-- the /flag/ consists of a single character, in a /word/ that begins+-- with a single hyphen; the /word/ might contain more than one /flag/+-- for multiple /short options/.+--+-- [/short option name/] A short option is specified on the command+-- line using a /flag/ and any /option arguments/. The /flag/+-- contains the /short option name/, which is a single character. A+-- /short option name/ is never a single hyphen.+--+-- [/long option name/] A long option is specified on the command line+-- using a /flag/ and any /option arguments/. The /flag/ begins with+-- two hyphens, followed by the /long option name/, which must be at+-- least one letter but typically is a mnemonic word.+--+-- [/name/] Either a /short option name/ or /long option name/, as+-- appropriate.+--+-- [/long option/] An option that is specified using two hyphens and+-- what is usually a mnemonic word, though it could be as short as a+-- single letter. For example, @tail(1)@ has long options including+-- @follow@ and @verbose@. The user would specify these on the command+-- line by typing @tail --follow --verbose@. A long option is+-- specified on the command line with a /flag/ and any /option arguments/.+--+-- [/option argument/] An /option/ may take anywhere from zero to+-- three /option arguments/. When using a /short option/, the first+-- /option argument/ and the /flag/ may be contained in the same+-- /word/ by appending the /option argument/ immediately after the+-- /flag/ without an intervening space. When using a /long option/,+-- the first /option argument/ and the /flag/ may be contained in the+-- same word by separating the /flag/ and the /option argument with an+-- equal sign. In any case in which an /option argument/ and a /flag/+-- are in the same /word/, the /option argument/ must be the last+-- thing to appear in the /word/. When using either /short options/+-- or /long options/, the first /option argument/ may appear in the+-- same /word/ as the /flag/ or in the /word/ following the /flag/;+-- the second and third /option arguments/ (if applicable) must each+-- appear in its own /word/.+--+-- [/positional argument/] A /word/ on the command line that does not+-- contain a /flag/, is not a /stopper/, and is not an /option argument/.+-- For instance, with @tail(1)@, you specify the files you+-- want to see by using /positional arguments/. In the command @tail -n 10 myfile@,+-- @myfile@ is a /positional argument/.+--+-- [/stopper/] A /word/ consisting solely of two hyphens,+-- @--@. The user types this to indicate that all subsequent words+-- on the command line are /positional arguments/, even if they begin+-- with hyphens and therefore look like they might be /options/.++module Multiarg.Vocabulary where+
− lib/System/Console/MultiArg.hs
@@ -1,167 +0,0 @@--- | A combinator library for building command-line parsers.--module System.Console.MultiArg (-- -- | To say this library is inspired by Parsec would probably insult the- -- creators of Parsec, as this library could not possibly be as- -- elegant or throughly considered as Parsec is. Nevertheless this- -- library can be used in a similar style as Parsec, but is- -- specialized for parsing command lines.- --- -- This parser was built because I could not find anything that would- -- readily parse command lines where the options took more than one- -- argument. For example, for the @tail@ command on GNU systems, the- -- --lines option takes one argument to specify how many lines you- -- want to see. Well, what if you want to build a program with an- -- option that takes /two/ arguments, like @--foo bar baz@? I found no- -- such library so I built this one. Nevertheless, using this library- -- you can build parsers to parse a variety of command line- -- vocabularies, from simple to complex.-- -- * Terminology-- -- | Some terms are used throughout multiarg:- --- -- [@word@] When you run your program from the Unix shell prompt,- -- your shell is responsible for splitting the command line into- -- words. Typically you separate words with spaces, although quoting- -- can affect this. multiarg parses lists of words. Each word can- -- consist of a single long option, a single long option and an- -- accompanying option argument, a single short option, multiple- -- short options, and even one or more multiple short options and an- -- accompanying short option argument. Or, a word can be a- -- positional argument or a stopper. All these are described below.- --- -- [@option@] Options allow a user to specify ways to tune the- -- operation of a program. Typically options are indeed optional,- -- although some programs do sport \"required options\" (a bit of an- -- oxymoron). Options can be either short options or long- -- options. Also, options can take arguments.- --- -- [@short option@] An option that is specified with a single hyphen- -- and a single letter. For example, for the program @tail(1)@,- -- possible short options include @n@ and @v@. With multiarg it is- -- possible to easily parse short options that are specified in- -- different words or in the same word. For example, if a user wants- -- to run @tail@ with two options, he might type @tail -v -f@ or he- -- might type @tail -vf@.- --- -- [@long option@] An option that is specified using two hyphens and- -- what is usually a mnemonic word, though it could be as short as a- -- single letter. For example, @tail(1)@ has long options including- -- @follow@ and @verbose@. The user would specify these on the- -- command line by typing @tail --follow --verbose@.- --- -- [@option argument@] Some options take additional arguments that- -- are specific to the option and change what the option does. For- -- instance, the @lines@ option to @tail(1)@ takes a single,- -- optional argument, which is the number of lines to show. Option- -- arguments can be optional or required, and a single option can- -- take a mulitple, fixed number of arguments and it can take a- -- variable number of arguments. Option arguments can be given in- -- various ways. They can be specified in the same word as a long- -- option by using an equals sign; they can also be specified in the- -- same word as a short option simply by placing them in the same- -- word, or they can be specified in the following word. For- -- example, these different command lines all mean the same thing;- -- @tail --verbose --lines=20@, @tail --verbose --lines 20@, @tail- -- -vn 20@, @tail -v -n20@, @tail -vn20@, and @tail -v -n 20@, and- -- numerous other combinations also have the same meaning.- --- -- [@GNU-style option argument@] A long option with an argument- -- given with an equal sign, such as [@lines=20@].- --- -- [@positional argument@] A word on the command line that is not an- -- option or an argument to an option. For instance, with @tail(1)@,- -- you specify the files you want to see by using positional- -- arguments. In the command @tail -n 10 myfile@, @myfile@ is a- -- positional argument. For some programs, such as @git@ or @darcs@,- -- a positional argument might be a \"command\" or a \"mode\", such- -- as the @commit@ in @git commit@ or the @whatsnew@ in @darcs- -- whatsnew@. multiarg has no primitive parsers that treat these- -- positional arguments specially but it is trivial to build a- -- parser for command lines such as this, too.- --- -- [@stopper@] A single word consisting solely of two hyphens,- -- @--@. The user types this to indicate that all subsequent words- -- on the command line are positional arguments, even if they begin- -- with hyphens and therefore look like they might be options.- --- -- [@pending@] The user might specify more than one short option, or- -- a short option and a short option argument, in a single word. For- -- example, she might type @tail -vl20@. After parsing the @v@- -- option, the Parser makes @l20@ into a \"pending\". The next- -- parser can then treat @l20@ as an option argument to the @v@- -- option (which is probably not what was wanted) or the next parser- -- can parse @l@ as a short option. This would result in a- -- \"pending\" of @20@. Then, the next parser can treat @20@ as an- -- option argument. After that parse there will be no pendings.-- -- * Getting started-- -- |If your needs are simple to moderately complicated just look at the- -- "System.Console.MultiArg.CommandLine" module, which uses the- -- underlying combinators to build a simple parser for you. That- -- module is already exported from this module for easy usage.- --- -- "System.Console.MultiArg.CommandLine" also has a parser that can- -- handle multi-mode commands (examples include @git@, @darcs@, and- -- @cvs@.)- --- -- For maximum flexibility you will want to start with the- -- "System.Console.MultiArg.Prim" module. Using those parsers you- -- can easily build parsers that are quite complicated. The parsers- -- can check for errors along the way, simplifying the sometimes- -- complex task of ensuring that data a user supplied on the command- -- line is good. You can easily build parsers for programs that take- -- no options, take dozens of options, require that options be given- -- in a particular order, require that some options be given, or bar- -- some combinations of options. You might also require particular- -- positional arguments. Other helpful functions are in- -- "System.Console.MultiArg.Combinator". You will also want to- -- examine the source code for "System.Console.MultiArg.Combinator"- -- and "System.Console.MultiArg.CommandLine" as these show some- -- ways to use the primitive parsers and combinators.-- -- * Non-features and shortcomings- --- -- | multiarg isn't perfect; no software is. multiarg does not- -- automatically make online help for your command line- -- parsers. Getting this right would be tricky given the nature of- -- the code and I don't even want to bother trying, as I just write- -- my own online help in a text editor.- --- -- multiarg partially embraces \"The Tao of Option Parsing\" that- -- Python's Optik (<http://optik.sourceforge.net/>) follows. Read- -- \"The Tao of Option Parsing\" here:- --- -- <http://optik.sourceforge.net/doc/1.5/tao.html>- --- -- multiarg's philosophy is similar to that of Optik, which- -- means you won't be able to use multiarg to (easily) build a clone- -- to the UNIX @find(1)@ command. (You could do it, but multiarg won't- -- help you very much.)- --- -- multiarg can be complicated, although I'd like to believe this is- -- because it addresses a complicated problem in a flexible way.-- -- * Projects usings multiarg-- -- | * Penny, an extensible double-entry accounting- -- system. <http://hackage.haskell.org/package/penny-lib> The code- -- using multiarg is woven throughout the system; for example, see- -- the Penny.Liberty module.--- module System.Console.MultiArg.Combinator- , module System.Console.MultiArg.CommandLine- , module System.Console.MultiArg.Option- , module System.Console.MultiArg.Prim- , module System.Environment- ) where--import System.Console.MultiArg.Combinator-import System.Console.MultiArg.CommandLine-import System.Console.MultiArg.Option-import System.Console.MultiArg.Prim-import System.Environment
− lib/System/Console/MultiArg/Combinator.hs
@@ -1,478 +0,0 @@--- | Combinators that are useful for building command-line--- parsers. These build off the functions in--- "System.Console.MultiArg.Prim". Unlike those functions, these--- functions have no access to the internals of the parser.-module System.Console.MultiArg.Combinator (- -- * Parser combinators- notFollowedBy,-- -- * Combined long and short option parser- OptSpec(OptSpec, longOpts, shortOpts, argSpec),- InputError(..),- reader,- optReader,- ArgSpec(..),- parseOption,-- -- * Formatting errors- formatError- ) where--import Data.List (isPrefixOf, intersperse, nubBy)-import Data.Set ( Set )-import qualified Data.Set as Set-import Control.Applicative- ((<*>), optional, (<$), (*>), (<|>), many)--import System.Console.MultiArg.Prim- ( Parser, try, approxLongOpt,- nextWord, pendingShortOptArg, nonOptionPosArg,- pendingShortOpt, nonPendingShortOpt, nextWord, (<?>),- Error(..), Description(..))-import System.Console.MultiArg.Option- ( LongOpt, ShortOpt, unLongOpt,- makeLongOpt, makeShortOpt, unShortOpt )-import qualified Data.Map as M-import Data.Map ((!))-import Data.Maybe (fromMaybe, mapMaybe)-import Data.Monoid ( mconcat )----- | @notFollowedBy p@ succeeds only if parser p fails. If p fails,--- notFollowedBy succeeds without consuming any input. If p succeeds--- and consumes input, notFollowedBy fails and consumes input. If p--- succeeds and does not consume any input, notFollowedBy fails and--- does not consume any input.-notFollowedBy :: Parser a -> Parser ()-notFollowedBy p =- () <$ ((try p >> fail "notFollowedBy failed")- <|> return ())---unsafeShortOpt :: Char -> ShortOpt-unsafeShortOpt c =- fromMaybe (error $ "invalid short option: " ++ [c])- (makeShortOpt c)--unsafeLongOpt :: String -> LongOpt-unsafeLongOpt c =- fromMaybe (error $ "invalid long option: " ++ c)- (makeLongOpt c)----- |Specifies options for the 'parseOption' function. Each OptSpec--- represents one command-line option.-data OptSpec a = OptSpec {- longOpts :: [String]- -- ^ Each String is a single long option, such as @version@. When- -- the user specifies long options on the command line, she must- -- type two dashes; however, do not include the dashes when you- -- specify the long option here. Strings you specify as long options- -- cannot include a dash as either the first or the second- -- character, and they cannot include an equal sign anywhere. If- -- your long option does not meet these conditions, a runtime error- -- will occur.--- , shortOpts :: [Char]- -- ^ Each Char is a single short option, such as @v@. The- -- character cannot be a dash; if it is, a runtime error will occur.-- , argSpec :: ArgSpec a- -- ^ What to do each time one of the given long options or- -- short options appears on the command line.- }--instance Functor OptSpec where- fmap f (OptSpec ls ss as) = OptSpec ls ss (fmap f as)---- | Reads in values that are members of Read. Provides a generic--- error message if the read fails.-reader :: Read a => String -> Either InputError a-reader s = case reads s of- (x, ""):[] -> return x- _ -> Left . ErrorMsg $ "could not parse option argument"---- | Reads in values that are members of Read, but the value does not--- have to appear on the command line. Provides a generic error--- message if the read fails. If the argument is Nothing, returns--- Nothing.-optReader- :: Read a- => Maybe String- -> Either InputError (Maybe a)-optReader ms = case ms of- Nothing -> return Nothing- Just s -> case reads s of- (x, ""):[] -> return (Just x)- _ -> Left . ErrorMsg $ "could not parse option argument"---- | Indicates errors when parsing options to arguments.-data InputError- = NoMsg- -- ^ No error message accompanies this failure. multiarg will create- -- a generic error message for you.-- | ErrorMsg String- -- ^ Parsing the argument failed with this error message. An example- -- might be @option argument is not an integer@ or @option argument- -- is too large@. The text of the options the user provided is- -- automatically prepended to the error message, so do not replicate- -- this in your message.-- deriving (Eq, Show)---- | Create an error message from an InputError.-errorMsg- :: Either LongOpt ShortOpt- -- ^ The option with the faulty argument-- -> [String]- -- ^ The faulty command line arguments-- -> InputError- -> String-errorMsg badOpt ss err = arg ++ opt ++ msg- where- arg = let aw = if length ss > 1 then "arguments " else "argument "- ws = concat . intersperse " " . map quote $ ss- quote s = "\"" ++ s ++ "\""- in aw ++ ws- opt = " to option " ++ optDesc- optDesc = case badOpt of- Left lo -> "--" ++ unLongOpt lo- Right so -> "-" ++ [unShortOpt so]- msg = " invalid" ++ detail- detail = case err of- NoMsg -> ""- ErrorMsg s -> ": " ++ s------ | Specifies how many arguments each option takes. As with--- 'System.Console.GetOpt.ArgDescr', there are (at least) two ways to--- use this type. You can simply represent each possible option using--- different data constructors in an algebraic data type. Or you can--- have each ArgSpec yield a function that transforms a record. For an--- example that uses an algebraic data type, see--- "System.Console.MultiArg.SampleParser".------ Most of these value constructors take as an argument a function--- that returns an Either. The function should return a @Left--- InputError@ if the parsing of the arguments failed--if, for--- example, the user needs to enter an integer but she instead input a--- letter. The functions should return a Right if parsing of the--- arguments was successful.-data ArgSpec a =- NoArg a- -- ^ This option takes no arguments-- | OptionalArg (Maybe String -> Either InputError a)- -- ^ This option takes an optional argument. As noted in \"The Tao- -- of Option Parsing\", optional arguments can result in some- -- ambiguity. (Read it here:- -- <http://optik.sourceforge.net/doc/1.5/tao.html>) If option @a@- -- takes an optional argument, and @b@ is also an option, what- -- does @-ab@ mean? SimpleParser resolves this ambiguity by- -- assuming that @b@ is an argument to @a@. If the user does not- -- like this, she can specify @-a -b@ (in such an instance @-b@ is- -- not parsed as an option to @-a@, because @-b@ begins with a- -- hyphen and therefore \"looks like\" an option.) Certainly- -- though, optional arguments lead to ambiguity, so if you don't- -- like it, don't use them :)-- | OneArg (String -> Either InputError a)- -- ^ This option takes one argument. Here, if option @a@ takes one- -- argument, @-a -b@ will be parsed with @-b@ being an argument to- -- option @a@, even though @-b@ starts with a hyphen and therefore- -- \"looks like\" an option.-- | TwoArg (String -> String -> Either InputError a)- -- ^ This option takes two arguments. Parsed similarly to- -- 'OneArg'.-- | ThreeArg (String -> String -> String -> Either InputError a)- -- ^ This option takes three arguments. Parsed similarly to- -- 'OneArg'.-- | VariableArg ([String] -> Either InputError a)- -- ^ This option takes a variable number of arguments--zero or- -- more. Option arguments continue until the command line contains- -- a word that begins with a hyphen. For example, if option @a@- -- takes a variable number of arguments, then @-a one two three- -- -b@ will be parsed as @a@ taking three arguments, and @-a -b@- -- will be parsed as @a@ taking no arguments. If the user enters- -- @-a@ as the last option on the command line, then the only way- -- to indicate the end of arguments for @a@ and the beginning of- -- positional argments is with a stopper.-- | ChoiceArg [(String, a)]- -- ^ This option takes a single argument, which must match one of- -- the strings given in the list. The user may supply the shortest- -- unambiguous string. If the argument list to ChoiceArg has- -- duplicate strings, only the first string is used. For instance,- -- ChoiceArg could be useful if you were parsing the @--color@- -- option to GNU grep, which requires the user to supply one of- -- three arguments: @always@, @never@, or @auto@.---instance Functor ArgSpec where- fmap f a = case a of- NoArg i -> NoArg $ f i- ChoiceArg gs ->- ChoiceArg . map (\(s, r) -> (s, f r)) $ gs-- OptionalArg g -> OptionalArg $ \ms -> fmap f (g ms)-- OneArg g ->- OneArg $ \s1 -> fmap f (g s1)-- TwoArg g ->- TwoArg $ \s1 s2 -> fmap f (g s1 s2)-- ThreeArg g ->- ThreeArg $ \s1 s2 s3 -> fmap f (g s1 s2 s3)-- VariableArg g ->- VariableArg $ \ls -> fmap f (g ls)----- | Parses a single command line option. Examines all the options--- specified using multiple OptSpec and parses one option on the--- command line accordingly. Fails without consuming any input if the--- next word on the command line is not a recognized option. Allows--- the user to specify the shortest unambiguous match for long--- options; for example, the user could type @--verb@ for @--verbose@--- and @--vers@ for @--version@.------ This function is applied to a list of OptSpec, rather than to a--- single OptSpec, because in order to correctly handle the parsing of--- shortened long options (e.g. @--verb@ rather than @--verbose@) it--- is necessary for one function to have access to all of the--- OptSpec. Applying this function multiple times to different lists--- of OptSpec and then using the @<|>@ function to combine them will--- break the proper parsing of shortened long options.------ For an example that uses this function, see--- "System.Console.MultiArg.SimpleParser".-parseOption :: [OptSpec a] -> Parser a-parseOption os =- let longs = longOptParser os- in case mconcat ([shortOpt] <*> os) of- Nothing -> longs- Just shorts -> longs <|> shorts--longOptParser :: [OptSpec a] -> Parser a-longOptParser os = longOpt (longOptSet os) (longOptMap os)---longOptSet :: [OptSpec a] -> Set LongOpt-longOptSet = Set.fromList . concatMap toOpts where- toOpts = map unsafeLongOpt . longOpts--longOptMap :: [OptSpec a] -> M.Map LongOpt (ArgSpec a)-longOptMap = M.fromList . concatMap toPairs where- toPairs (OptSpec los _ as) = map (toPair as) los where- toPair a s = (unsafeLongOpt s, a)--longOpt ::- Set LongOpt- -> M.Map LongOpt (ArgSpec a)- -> Parser a-longOpt set mp = do- (_, lo, maybeArg) <- approxLongOpt set- let spec = mp ! lo- maybeNextArg = maybe nextWord return maybeArg- case spec of- NoArg a -> case maybeArg of- Nothing -> return a- Just _ -> fail $ "option " ++ unLongOpt lo- ++ " does not take argument"- ChoiceArg ls -> do- s <- maybeNextArg- case matchAbbrev ls s of- Nothing -> fail $ "option " ++ unLongOpt lo- ++ " requires an argument: "- ++ (concat . intersperse ", " . map fst $ ls)- Just g -> return g-- OptionalArg f -> case maybeArg of- Nothing -> either (fail . errorMsg (Left lo) []) return- $ f Nothing- Just s -> either (fail . errorMsg (Left lo) [s]) return- $ f (Just s)--- OneArg f -> maybeNextArg >>= g- where- g a = either (fail . errorMsg (Left lo) [a]) return- $ f a-- TwoArg f -> do- a1 <- maybeNextArg- a2 <- nextWord- either (fail . errorMsg (Left lo) [a1, a2]) return- $ f a1 a2-- ThreeArg f -> do- a1 <- maybeNextArg- a2 <- nextWord- a3 <- nextWord- either (fail . errorMsg (Left lo) [a1, a2, a3]) return- $ f a1 a2 a3-- VariableArg f -> do- as <- many nonOptionPosArg- let args = case maybeArg of- Nothing -> as- Just a -> a:as- either (fail . errorMsg (Left lo) args) return- $ f args---shortOpt :: OptSpec a -> Maybe (Parser a)-shortOpt o = mconcat parsers where- parsers = map mkParser . shortOpts $ o- mkParser c =- let opt = unsafeShortOpt c- in Just $ nextShort opt *> case argSpec o of- NoArg a -> return a- ChoiceArg ls -> shortChoiceArg opt ls- OptionalArg f -> shortOptionalArg opt f- OneArg f -> shortOneArg opt f- TwoArg f -> shortTwoArg opt f- ThreeArg f -> shortThreeArg opt f- VariableArg f -> shortVariableArg opt f---- | Parses a short option without an argument, either pending or--- non-pending. Fails with a single error message rather than two.-nextShort :: ShortOpt -> Parser ()-nextShort o = p <?> ("short option: -" ++ [unShortOpt o])- where- p = do- r1 <- optional $ pendingShortOpt o- case r1 of- Just () -> return ()- Nothing -> nonPendingShortOpt o---shortVariableArg- :: ShortOpt- -> ([String] -> Either InputError a)- -> Parser a-shortVariableArg so f = do- maybeSameWordArg <- optional pendingShortOptArg- args <- many nonOptionPosArg- let as = case maybeSameWordArg of- Nothing -> args- Just a -> a:args- either (fail . errorMsg (Right so) as) return $ f as---shortOneArg- :: ShortOpt- -> (String -> Either InputError a)- -> Parser a-shortOneArg so f = do- a <- firstShortArg- either (fail . errorMsg (Right so) [a]) return $ f a--firstShortArg :: Parser String-firstShortArg =- optional pendingShortOptArg >>= maybe nextWord return---shortChoiceArg :: ShortOpt -> [(String, a)] -> Parser a-shortChoiceArg opt ls =- firstShortArg- >>= maybe err return . matchAbbrev ls- where- err = fail $ "option " ++ [unShortOpt opt] ++ " requires "- ++ "one argument: "- ++ (concat . intersperse " " . map fst $ ls)---shortTwoArg- :: ShortOpt- -> (String -> String -> Either InputError a)- -> Parser a-shortTwoArg so f = do- a1 <- firstShortArg- a2 <- nextWord- either (fail . errorMsg (Right so) [a1, a2]) return- $ f a1 a2---shortThreeArg- :: ShortOpt- -> (String -> String -> String -> Either InputError a)- -> Parser a-shortThreeArg so f = do- a1 <- firstShortArg- a2 <- nextWord- a3 <- nextWord- either (fail . errorMsg (Right so) [a1, a2, a3]) return- $ f a1 a2 a3--shortOptionalArg- :: ShortOpt- -> (Maybe String -> Either InputError a)- -> Parser a-shortOptionalArg so f = do- maybeSameWordArg <- optional pendingShortOptArg- case maybeSameWordArg of- Nothing -> do- maybeArg <- optional nonOptionPosArg- case maybeArg of- Nothing -> either (fail . errorMsg (Right so) []) return- $ f Nothing- Just a -> either (fail . errorMsg (Right so) [a]) return- $ f (Just a)- Just a -> either (fail . errorMsg (Right so) [a]) return- $ f (Just a)------ | Finds the unambiguous short match for a string, if there is--- one. Returns a string describing the error condition if there is--- one, or the matching result if successful.-matchAbbrev :: [(String, a)] -> String -> Maybe a-matchAbbrev ls s =- let ls' = nubBy (\x y -> fst x == fst y) ls- in case lookup s ls' of- Just a -> return a- Nothing ->- let pdct (t, _) = s `isPrefixOf` t- in case filter pdct ls of- (_, a):[] -> return a- _ -> Nothing---- | Formats error messages for nice display. Returns a multi-line--- string (there is no need to append a newline to the end of the--- string returned).-formatError- :: String- -- ^ Pass the name of your program here. Displayed at the beginning- -- of the error message.-- -> Error- -> String-formatError p (Error loc ls) =- p ++ ": error: could not parse command line.\n"- ++ "Error at: " ++ loc ++ "\n"- ++ expError- ++ genError- ++ unk- where- toExp m = case m of { Expected s -> Just s; _ -> Nothing }- expc = unlines . mapMaybe toExp $ ls- expError = if null expc then "" else "Expecting:\n" ++ expc- toGeneral m = case m of { General s -> Just s; _ -> Nothing }- gen = unlines . mapMaybe toGeneral $ ls- genError = if null gen- then ""- else let sep = if null expError- then "" else "\n"- in sep ++ gen- unk = if any (== Unknown) ls then "Unknown error\n" else ""-
− lib/System/Console/MultiArg/CommandLine.hs
@@ -1,536 +0,0 @@-{-# LANGUAGE ExistentialQuantification #-}--- | Some pre-built command line parsers. One is a simple command line--- parser that can parse options that take an optional argument, one--- or two arguments, or a variable number of arguments. For sample--- code that uses this parser, see--- "System.Console.MultiArg.SampleParser".------ Another parser is provided for multi-mode programs that are similar--- to @git@ or @darcs@.------ Previously there was a bug in System.Environment.getArgs that would--- not properly encode Unicode command line arguments. multiarg used--- to provide its own GetArgs module to deal with this. This bug was--- in base 4.3.1.0, which was bundled with ghc 7.0.4. This bug was--- fixed in base 4.4.0.0, which came with ghc 7.2. Since this bug has--- been fixed for awhile, multiarg no longer has its own GetArgs--- module.-module System.Console.MultiArg.CommandLine (- -- * Interspersion control- Intersperse (Intersperse, StopOptions)-- -- * Types- , ProgName- , Opts(..)- , OptsWithPosArgs(..)- , Mode(..)-- -- * Simple parsers- , simplePure- , simpleIO- , simpleHelp- , simpleHelpVersion-- -- * Mode parsers- , modesPure- , modesIO-- -- * Helpers to create various options and modes- , optsHelp- , optsHelpVersion- , modeHelp-- ) where--import qualified System.Console.MultiArg.Combinator as C-import qualified System.Console.MultiArg.Prim as P-import System.Environment (getArgs, getProgName)-import System.Exit (exitFailure, exitSuccess)-import qualified System.IO as IO-import Control.Applicative ( many, (<|>), optional,- (<$), (<*>), (<*), (<$>))-import Data.Bifunctor-import Data.List (find)-import Data.Maybe (catMaybes, fromJust)-import qualified Data.Set as Set----- | What to do after encountering the first non-option,--- non-option-argument word on the command line? In either case, no--- more options are parsed after a stopper.-data Intersperse =- Intersperse- -- ^ Additional options are allowed on the command line after- -- encountering the first positional argument. For example, if @a@- -- and @b@ are options, in the command line @-a posarg -b@, @b@ will- -- be parsed as an option. If @b@ is /not/ an option and the same- -- command line is entered, then @-b@ will result in an error- -- because @-b@ starts with a hyphen and therefore \"looks like\" an- -- option.-- | StopOptions- -- ^ No additional options will be parsed after encountering the- -- first positional argument. For example, if @a@ and @b@ are- -- options, in the command line @-a posarg -b@, @b@ will be parsed- -- as a positional argument rather than as an option.----- | Specifies a set of options.-data Opts s a = Opts- { oShortcuts :: [C.OptSpec s]- -- ^ Shortcut options are commonly options such as @--help@ or- -- @--version@. Such options must be specified alone on the command- -- line. The parser looks for one of these options first. If it- -- finds one and it is the only option on the command line, only- -- this option is processed and returned. If the option is not- -- alone on the command line, an error occurs. If no shortcut- -- option is found, the parser processes non-shortcut options- -- instead.-- , oOptions :: [C.OptSpec a]- -- ^ If the user does not specify any shortcut options, she may- -- specify any number of these options.-- }--instance Bifunctor Opts where- bimap fa fc o = Opts- { oShortcuts = map (fmap fa) . oShortcuts $ o- , oOptions = map (fmap fc) . oOptions $ o- }--instance Functor (Opts a) where- fmap f o = o { oOptions = fmap (fmap f) . oOptions $ o }---- | Creates an Opts with a help shortcut option.-optsHelp- :: h- -- ^ Whatever type you wish to use for help- -> [C.OptSpec a]- -> Opts h a-optsHelp h = Opts [C.OptSpec ["help"] "h" (C.NoArg h)]---- | Creates an Opts with help and version shortcut options.-optsHelpVersion- :: h- -- ^ What you wish to use for help-- -> h- -- ^ What you wish to use for version-- -> [C.OptSpec a]- -> Opts h a-optsHelpVersion h v = Opts [ C.OptSpec ["help"] "h" (C.NoArg h)- , C.OptSpec ["version"] "v" (C.NoArg v) ]---- | Specification for both options and positional arguments.-data OptsWithPosArgs s a = OptsWithPosArgs- { opOpts :: Opts s a- , opIntersperse :: Intersperse- , opPosArg :: String -> Either C.InputError a- }--instance Bifunctor OptsWithPosArgs where- bimap fa fc o = OptsWithPosArgs- { opOpts = bimap fa fc . opOpts $ o- , opIntersperse = opIntersperse o- , opPosArg = fmap (fmap fc) . opPosArg $ o- }--instance Functor (OptsWithPosArgs s) where- fmap f o = o- { opOpts = fmap f . opOpts $ o- , opPosArg = fmap (fmap f) . opPosArg $ o- }---- | Specifies a mode.-data Mode s r = forall a. Mode- { mModeName :: String- -- ^ How the user specifies the mode on the command line. For @git@- -- for example this might be @commit@ or @log@.-- , mGetResult :: [a] -> r- -- ^ This function is applied to a list of the results of parsing the- -- options that are specific to this mode. The function returns a- -- type of your choosing (though all modes in the same parser will- -- have to return the same type.)-- , mOpts :: OptsWithPosArgs s a- -- ^ Options and positional arguments that are specific to this- -- mode. For example, in the command line @git commit -a -m 'this- -- is a log message'@, @commit@ is the mode name and everything- -- after that is specified here as an option or positional argument- -- that is specific to this mode.- }--instance Bifunctor Mode where- bimap fa fc (Mode n r o) = Mode- { mModeName = n- , mGetResult = fmap fc r- , mOpts = first fa o- }--instance Functor (Mode s) where- fmap f (Mode n gr os) = Mode n (fmap f gr) os---- | Creates a Mode with a help option (help specific to the mode.)-modeHelp- :: String- -- ^ Mode name-- -> h- -- ^ Whatever you want to use for the help (perhaps a string, or a- -- function, or an IO action). Its type will have to match up with- -- the type of the global shortcut options and with the shortcut- -- type of the other modes.-- -> ([a] -> r)- -- ^ When applied to the the mode options, returns the result.-- -> [C.OptSpec a]- -- ^ Options for this mode-- -> Intersperse- -- ^ Allow interspersion of mode options and positional arguments?-- -> (String -> Either C.InputError a)- -- ^ Parses positional arguments-- -> Mode h r--modeHelp n h getR os i p =- Mode n getR (OptsWithPosArgs (Opts ss os) i p)- where- ss = [C.OptSpec ["help"] "h" (C.NoArg h)]--parseOpts :: Opts s a -> P.Parser (Either s [a])-parseOpts os = do- let specials = oShortcuts os- maySpecial <- optional (C.parseOption specials <* P.end)- case maySpecial of- Nothing -> fmap Right- $ P.manyTill (C.parseOption (oOptions os)) endOrNonOpt- Just spec -> return . Left $ spec--parseOptsWithPosArgs- :: OptsWithPosArgs s a- -> P.Parser (Either s [a])-parseOptsWithPosArgs os = do- let specials = oShortcuts . opOpts $ os- maySpecial <- optional (C.parseOption specials <* P.end)- case maySpecial of- Nothing ->- let f = case opIntersperse os of- Intersperse -> parseIntersperse- StopOptions -> parseStopOpts- parser = C.parseOption (oOptions . opOpts $ os)- in fmap Right $ f parser (opPosArg os)- Just spec -> return . Left $ spec--parseModes- :: [Mode s r]- -> P.Parser (Either s r)-parseModes ms = do- let modeWords = Set.fromList . map mModeName $ ms- (_, w) <- P.matchApproxWord modeWords- processMode (fromJust . find (\c -> mModeName c == w) $ ms)- where- processMode (Mode _ gr os) = do- eiOpts <- parseOptsWithPosArgs os- return $ case eiOpts of- Left x -> Left x- Right opts -> Right (gr opts)----- | A pure (non-IO) parser for simple command lines--that is, command--- lines that do not have modes.-simplePure- :: OptsWithPosArgs s a- -- ^ Specifies allowed regular options, allowed shortcut options,- -- and how to parse positional arguments. Also specifies whether- -- the user may intersperse options with positional arguments.-- -> [String]- -- ^ The command line arguments to parse-- -> Either P.Error (Either s [a])- -- ^ Returns an error if the command line arguments could not be- -- parsed. If the parse was successful, returns an Either. A Left- -- indicates that the user selected a shortcut option. A Right- -- indicates that the user did not specify a shortcut option, and- -- will contain a list of the options and positional arguments.-simplePure os ss = P.parse ss (parseOptsWithPosArgs os)---- | A pure (non-IO) parser for command lines that contain modes.-modesPure- :: Opts s g- -- ^ Global options. These are specified before any mode. For- -- instance, in the command @git --no-pager commit -a@, the option- -- @--no-pager@ is a global option. Global options can contain- -- shortcut options. For instance, @git --help@ contains a single- -- shortcut option.-- -> ([g] -> Either String (Either r [Mode s r]))- -- ^ This function processes the global options. If there are no- -- shortcut options specified in the global options, it is applied- -- to the result of processing the global options. This function- -- may return a Left if there is something wrong with the- -- global options (a nonsensical combination, perhaps.) Otherwise,- -- it returns a @Right Either@. Return a Left if there is no need to- -- process any modes at all after seeing the global options.- -- Otherwise, return a Right with a list of modes.-- -> [String]- -- ^ Command line arguments to parse-- -> Either P.Error (Either s r)- -- ^ If the command line arguments fail to parse, this will be a- -- Left with the error. If the parser is successful, this- -- returns a @Right Either@. A Left indicates that the user entered a- -- shortcut option, either in the global options or in one of the- -- mode-specific options. A Right indicates that the user selected- -- a mode.-modesPure os process ss = P.parse ss p- where- p = do- eiGs <- parseOpts os- case eiGs of- Left spec -> return . Left $ spec- Right gs -> case process gs of- Left s -> fail s- Right eiModes -> case eiModes of- Left r -> return (Right r)- Right modes -> parseModes modes---- | A parser for simple command lines that do not contain modes.--- Runs in the IO monad.-simpleIO- :: [C.OptSpec a]- -- ^ Options to parse-- -> Intersperse- -- ^ Allow interspersion of options and arguments?-- -> (String -> Either C.InputError a)- -- ^ How to parse positional arguments-- -> IO [a]- -- ^ If there is an error parsing the command line, the program will- -- exit with an error message. If successful the results are- -- returned here.-simpleIO os i getArg = do- let optsWithArgs = OptsWithPosArgs (Opts os []) i getArg- ss <- getArgs- case simplePure optsWithArgs ss of- Left e -> errorAct e- Right g -> case g of- Left _ ->- error "simpleIO: should never happen: no shortcut options"- Right gs -> return gs--simpleIOCustomError- :: (P.Error -> IO ())- -> OptsWithPosArgs s a- -> IO (Either s [a])-simpleIOCustomError showErr os = do- ss <- getArgs- case simplePure os ss of- Left e -> showErr e >> exitFailure- Right g -> return g- ---- | A command line parser for multi-mode command lines. Runs in the--- IO monad.-modesIO- :: Opts s g- -- ^ Specifies global options and global shortcut options-- -> ([g] -> Either String (Either r [Mode s r]))- -- ^ This function processes the global options. If there are no- -- shortcut options specified in the global options, it is applied- -- to the result of processing the global options. This function- -- may return a Left if there is something wrong with the- -- global options (a nonsensical combination, perhaps.) Otherwise,- -- it returns a @Right Either@. Return a Left if there is no need to- -- process any modes at all after seeing the global options.- -- Otherwise, return a Right with a list of modes.-- -> IO (Either s r)- -- ^ If parsing fails, the program will exit with a failure. If- -- successful, the result is returned here. A Left indicates a- -- shortcut option, either from the global options or from the- -- mode-specific options; a Right indicates the mode a user- -- selected.-modesIO os ms = do- ss <- getArgs- case modesPure os ms ss of- Left e -> errorAct e- Right g -> return g----- | The name of the program that was entered on the command line,--- obtained from System.Environment.getProgName.-type ProgName = String--displayAct :: (ProgName -> String) -> IO a-displayAct getHelp = do- pn <- getProgName- putStr $ getHelp pn- exitSuccess--errorAct :: P.Error -> IO a-errorAct e = do- pn <- getProgName- IO.hPutStr IO.stderr $ C.formatError pn e- exitFailure--errorActDisplayHelp :: P.Error -> IO a-errorActDisplayHelp e = do- pn <- getProgName- IO.hPutStr IO.stderr $ C.formatError pn e- IO.hPutStrLn IO.stderr $ "enter \"" ++ pn ++ " -h\" for help."- exitFailure---- | A parser for simple command lines. Adds a @--help@ option for--- you.-simpleHelp- :: (ProgName -> String)- -- ^ Indicate the help here. This function, when applied to the name- -- of the program, returns help. simpleHelp automatically adds- -- options for @--help@ and @-h@ for you.-- -> [C.OptSpec a]- -- ^ Options to parse-- -> Intersperse- -- ^ Allow interspersion of options and positional arguments?-- -> (String -> Either C.InputError a)- -- ^ How to parse positional arguments-- -> IO [a]- -- ^ If the parser fails, the program will exit with an error. If- -- the user requested help, it will be displayed and the program- -- exits successfully. Otherwise, the options and positional- -- arguments are returned here.-simpleHelp getHelp os ir getArg = do- let shortcuts = [C.OptSpec ["help"] "h" (C.NoArg (displayAct getHelp))]- opts = OptsWithPosArgs (Opts shortcuts os) ir getArg- ei <- simpleIOCustomError errorActDisplayHelp opts- case ei of- Left act -> act- Right as -> return as---- | A parser for simple command lines without modes. Adds options--- for @--help@ and @--version@ for you.-simpleHelpVersion- :: (ProgName -> String)- -- ^ Indicate the help here. This function, when applied to the name- -- of the program, returns help. simpleHelpVersion automatically adds- -- options for @--help@ and @-h@ for you.-- -> (ProgName -> String)- -- ^ Indicate the version here. This function, when applied to the- -- name of the program, returns a version string. simpleHelpVersion- -- automatically adds an option for @--version@ for you.-- -> [C.OptSpec a]- -- ^ Options to parse-- -> Intersperse- -- ^ Allow interspersion of options and positional arguments?-- -> (String -> Either C.InputError a)- -- ^ How to parse positional arguments-- -> IO [a]- -- ^ If the parser fails, the program will exit with an error. If- -- the user requested help or version information, it will be- -- displayed and the program exits successfully. Otherwise, the- -- options and positional arguments are returned here.--simpleHelpVersion getHelp getVer os ir getArg = do- let shortcuts = [ C.OptSpec ["help"] "h"- (C.NoArg (displayAct getHelp))- , C.OptSpec ["version"] ""- (C.NoArg (displayAct getVer)) ]- opts = OptsWithPosArgs (Opts shortcuts os) ir getArg- ei <- simpleIOCustomError errorActDisplayHelp opts- case ei of- Left act -> act- Right as -> return as---- # Helpers---- | Handles positional arguments and errors with them. The parser for--- the positional argument must be passed in (this way it can--- be parsed with nonOptionPosArg or nextWord, as appropriate; when--- parsing interpsersed command lines, you will want nonOptionPosArg;--- when parsing non-interspersed command lines, you will need--- nextWord.)-parsePosArg- :: P.Parser String- -- ^ Parser for Word for next positional argument- -> (String -> Either C.InputError a)- -- ^ Function to handle positional arguments- -> P.Parser a-parsePosArg pa f = do- a <- pa- case f a of- Left e ->- let msg = "invalid positional argument: \"" ++ a ++ "\""- in case e of- C.NoMsg -> fail msg- C.ErrorMsg s -> fail $ msg ++ ": " ++ s- Right g -> return g---- | Parses options only, where they are not interspersed with--- positional arguments. Stops parsing only where it encouters a word--- that does not begin with a dash. This way if the user enters a bad--- option, it shows in the error message as a bad option rather than--- simply not getting parsed.-parseOptsNoIntersperse :: P.Parser a -> P.Parser [a]-parseOptsNoIntersperse p = P.manyTill p e where- e = P.end <|> nonOpt- nonOpt = P.lookAhead next- next = (() <$ P.nonOptionPosArg) <|> P.stopper---- | Parses options and positional arguments where the two are not--- interspersed. Stops parsing options when a stopper is encountered--- or at the first word that does not look like an option.-parseStopOpts- :: P.Parser a- -> (String -> Either C.InputError a)- -> P.Parser [a]-parseStopOpts optParser p =- (++)- <$> parseOptsNoIntersperse optParser- <* optional P.stopper- <*> many (parsePosArg P.nextWord p)----- | @parseIntersperse o p@ parses options and positional arguments,--- where o is a parser that parses options, and p is a function that,--- when applied to a string, returns the appropriate type.------ If a stopper has not yet been seen, any word that begins with a--- hyphen will not be parsed as a positional argument. Therefore, if--- there is a word before a stopper and it begins with a hyphen, if it--- is not a valid option then the parse will fail with an error.-parseIntersperse- :: P.Parser a- -> (String -> Either C.InputError a)- -> P.Parser [a]-parseIntersperse optParser p =- let pa = Just <$> parsePosArg P.nonOptionPosArg p- po = Just <$> optParser- ps = Nothing <$ P.stopper- parser = po <|> ps <|> pa- in catMaybes <$> P.manyTill parser P.end---- | Looks at the next word. Succeeds if it is a non-option, or if we--- are at the end of input. Fails otherwise.-endOrNonOpt :: P.Parser ()-endOrNonOpt = (P.lookAhead P.nonOptionPosArg >> return ())- <|> P.end-
− lib/System/Console/MultiArg/Option.hs
@@ -1,45 +0,0 @@--- | These types represent options. Option names cannot have a dash as--- their first or second character, and long option names cannot have--- an equals sign anywhere in the name.-module System.Console.MultiArg.Option (- ShortOpt,- unShortOpt,- makeShortOpt,- LongOpt,- unLongOpt,- makeLongOpt )- where---- | Short options. Options that are preceded with a single dash on--- the command line and consist of a single letter. That single letter--- cannot be a dash. Any other Unicode character is good (including--- pathological ones like newlines).-newtype ShortOpt = ShortOpt { unShortOpt :: Char } deriving (Show, Eq, Ord)---- | Creates a short option. Returns Nothing if the character is not--- valid for a short option.-makeShortOpt :: Char -> Maybe ShortOpt-makeShortOpt c = case c of- '-' -> Nothing- x -> Just $ ShortOpt x---- | Long options. Options that are preceded with two dashes on the--- command line and typically consist of an entire mnemonic word, such--- as @lines@. However, anything that is at least one letter long is--- fine for a long option name. The name must be at least one--- character long. It cannot have an equal sign anywhere in its--- name. Otherwise any Unicode character is good (including--- pathological ones like newlines).-data LongOpt = LongOpt { unLongOpt :: String } deriving (Show, Eq, Ord)---- | Makes a long option. Returns Nothing if the string is not a valid--- long option.-makeLongOpt :: String -> Maybe LongOpt-makeLongOpt t =- if isValidLongOptText t then Just $ LongOpt t else Nothing---isValidLongOptText :: String -> Bool-isValidLongOptText s = case s of- [] -> False- xs -> not $ '=' `elem` xs
− lib/System/Console/MultiArg/Prim.hs
@@ -1,681 +0,0 @@--- | Parser primitives. These are the only functions that have access--- to the internals of the parser. Use these functions if you want to--- build your own parser from scratch. If your needs are simpler, you--- will want to look at "System.Console.MultiArg.SimpleParser" or--- "System.Console.MultiArg.Combinator", which do a lot of grunt work--- for you.------ Internal design, especially the error handling, is based in large--- part on Parsec, as described in the paper at--- <http://legacy.cs.uu.nl/daan/pubs.html#parsec>.-module System.Console.MultiArg.Prim (- -- * Parser types- Parser,-- -- * Running a parser-- -- | Each parser runner is applied to a list of Strings, which are the- -- command line arguments to parse.- parse,-- -- * Higher-level parser combinators- good,- choice,- bind,- lookAhead,-- -- ** Running parsers multiple times- several,- several1,- manyTill,-- -- ** Failure and errors- failString,- genericThrow,- (<?>),- try,-- -- * Parsers- -- ** Short options and arguments- pendingShortOpt,- nonPendingShortOpt,- pendingShortOptArg,-- -- ** Long options and arguments- exactLongOpt,- approxLongOpt,-- -- ** Stoppers- stopper,- resetStopper,-- -- ** Positional (non-option) arguments- nextWord,- nextWordIs,- nonOptionPosArg,- matchApproxWord,-- -- ** Miscellaneous- end,-- -- * Errors- Description(..),- Error(Error),- InputDesc-- ) where---import System.Console.MultiArg.Option- (ShortOpt,- unShortOpt,- LongOpt,- unLongOpt,- makeLongOpt )-import Control.Applicative ( Applicative, Alternative, optional )-import qualified Control.Applicative as A-import qualified Data.Set as Set-import Data.Set ( Set )-import qualified Control.Monad-import Control.Monad ( when, MonadPlus(mzero, mplus), guard, liftM )-import Data.Maybe (mapMaybe)-import Data.Monoid ( Monoid ( mempty, mappend ) )-import qualified Data.List as L-import Data.List (isPrefixOf)---- | Parsers. Internally the parser tracks what input remains to be--- parsed, whether there are any pending short options, and whether a--- stopper has been seen. A parser can return a value of any type.------ The parser also includes the notion of failure. Any parser can--- fail; a failed parser affects the behavior of combinators such as--- choice.-newtype Parser a = Parser { runParser :: State -> Consumed a }--instance Monad Parser where- (>>=) = bind- return = good- fail = failString--instance Functor Parser where- fmap = liftM--instance Applicative Parser where- (<*>) = Control.Monad.ap- pure = return--instance Alternative Parser where- empty = genericThrow- (<|>) = choice- some = several1- many = several--instance Monoid (Parser a) where- mempty = genericThrow- mappend = choice--instance MonadPlus Parser where- mzero = genericThrow- mplus = choice--type PendingShort = String-type Remaining = [String]-type SawStopper = Bool-data State = State PendingShort Remaining SawStopper--type InputDesc = String-data Description = Unknown | General String | Expected String- deriving (Eq, Show, Ord)---- | Error messages. To format error messages for nice display, see--- 'System.Console.MultiArg.Combinator.formatError'.-data Error = Error InputDesc [Description]- deriving (Eq, Show, Ord)--data Reply a = Ok a State Error- | Fail Error--data Consumed a = Consumed (Reply a)- | Empty (Reply a)---- | @good a@ always succeeds without consuming any input and has--- result a. This provides the implementation for--- 'Control.Monad.Monad.return' and--- 'Control.Applicative.Applicative.pure'.-good :: a -> Parser a-good x = Parser $ \st -> Empty (Ok x st (Error (descLocation st) []))---- | Combines two parsers into a single parser. The second parser can--- optionally depend upon the result from the first parser.------ This applies the first parser. If the first parser succeeds,--- combine then takes the result from the first parser, applies the--- function given to the result from the first parser, and then--- applies the resulting parser.------ If the first parser fails, combine will not apply the second--- function but instead will bypass the second parser.------ This provides the implementation for '>>=' in--- 'Control.Monad.Monad'.-bind :: Parser a -> (a -> Parser b) -> Parser b-bind (Parser p) f = Parser $ \s ->- case p s of- Empty r1 -> case r1 of- Ok x s' _ -> runParser (f x) s'- Fail m -> Empty (Fail m)- Consumed r1 -> Consumed $- case r1 of- Ok x s' _ -> case runParser (f x) s' of- Consumed r -> r- Empty r -> r- Fail e -> Fail e--descLocation :: State -> InputDesc-descLocation (State ps rm st) = pending ++ next ++ stop- where- pending- | null ps = ""- | otherwise = "short option or short option argument: "- ++ ps ++ " "- next = case rm of- [] -> "no words remaining"- x:_ -> "next word: " ++ x- stop = if st then " (stopper already seen)" else ""----- | @failString s@ always fails without consuming any input. The--- failure contains a record of the string passed in by s. This--- provides the implementation for 'Control.Monad.Monad.fail'.-failString :: String -> Parser a-failString str = Parser $ \s ->- Empty (Fail (Error (descLocation s) [General str]))----- | Fail with an unhelpful error message. Usually 'throwString' is--- more useful, but this is handy to implement some typeclass--- instances.-genericThrow :: Parser a-genericThrow = Parser $ \s ->- Empty (Fail (Error (descLocation s) [Unknown]))---- | Runs the first parser. If it fails without consuming any input,--- then runs the second parser. If the first parser succeeds, then--- returns the result of the first parser. If the first parser fails--- and consumes input, then returns the result of the first--- parser. This provides the implementation for--- '<|>' in 'Control.Applicative.Alternative'.-choice :: Parser a -> Parser a -> Parser a-choice p q = Parser $ \s ->- case runParser p s of- Empty (Fail msg1) ->- case runParser q s of- Empty (Fail msg2) -> mergeError msg1 msg2- Empty (Ok x s' msg2) -> mergeOk x s' msg1 msg2- c -> c- Empty (Ok x s' msg1) ->- case runParser q s of- Empty (Fail msg2) -> mergeOk x s' msg1 msg2- Empty (Ok _ _ msg2) -> mergeOk x s' msg1 msg2- c -> c- c -> c- where- mergeOk x s msg1 msg2 = Empty (Ok x s (merge msg1 msg2))- mergeError msg1 msg2 = Empty (Fail (merge msg1 msg2))- merge (Error loc exp1) (Error _ exp2) =- Error loc (exp1 ++ exp2)---- | Applies 'error' if a parser would succeed without consuming any--- input. Useful for preventing infinite loops on parsers like--- 'several1'.-crashOnEmptyOk- :: String- -- ^ Use this label when applying 'error'-- -> Parser a- -> Parser a-crashOnEmptyOk str p = Parser $ \s ->- case runParser p s of- Empty r -> case r of- Ok _ _ _ ->- error $ "multiarg: error: " ++ str- ++ " applied to parser that succeeds without "- ++ "consuming any input. Aborted to prevent "- ++ "an infinite loop."- e -> Empty e- o -> o- ---- | Runs a parser one or more times. Runs the parser once and then--- applies 'several'.-several1 :: Parser a -> Parser [a]-several1 p = do- r1 <- p- rs <- several p- return $ r1:rs----- | Runs a parser zero or more times. If the last run of the parser--- fails without consuming any input, this parser succeeds without--- consuming any input. If the last run of the parser fails while--- consuming input, this parser fails while consuming input. This--- provides the implementation for 'many' in Control.Applicative.-several :: Parser a -> Parser [a]-several unwrapped =- let p = crashOnEmptyOk "several" unwrapped- in do- maybeA <- optional p- case maybeA of- Nothing -> return []- Just a -> do- rest <- several unwrapped- return $ a:rest- ---- | Runs the parser given. If it fails without consuming any input,--- replaces all Expected messages with the one given. Otherwise,--- returns the result of the parser unchanged.-(<?>) :: Parser a -> String -> Parser a-p <?> str = Parser $ \s ->- case runParser p s of- Empty (Fail m) -> Empty (Fail (expect m str))- Empty (Ok x s' m) -> Empty (Ok x s' (expect m str))- x -> x- where- expect (Error pos ls) s =- let ls' = mapMaybe notExpected ls- notExpected d = case d of- Expected _ -> Nothing- x -> Just x- in Error pos ((Expected s) : ls')--infix 0 <?>---- | Runs a parser. This is the only way to change a value of type--- @Parser a@ into a value of type @a@ (that is, it is the only way to--- \"get out of the Parser monad\" or to \"escape the Parser monad\".)-parse- :: [String]- -- ^ Command line arguments to parse. Presumably you got these from- -- 'getArgs'. If there is any chance that you will be parsing- -- Unicode strings, see the documentation in- -- "System.Console.MultiArg.GetArgs" before you use- -- 'System.Environment.getArgs'.-- -> Parser a- -- ^ Parser to run-- -> Either Error a- -- ^ Success or failure. Any parser might fail; for example, the- -- command line might not have any values left to parse. Use of the- -- 'choice' combinator can lead to a list of failures.--parse ss p =- let s = State "" ss False- procReply r = case r of- Ok x _ _ -> Right x- Fail m -> Left m- in case runParser p s of- Consumed r -> procReply r- Empty r -> procReply r---- | Parses only pending short options. Fails without consuming any--- input if there has already been a stopper or if there are no--- pending short options. Fails without consuming any input if there--- is a pending short option, but it does not match the short option--- given. Succeeds and consumes a pending short option if it matches--- the short option given.-pendingShortOpt :: ShortOpt -> Parser ()-pendingShortOpt so = Parser $ \s@(State pends rm stop) ->- let msg = Error (descLocation s)- [Expected ("pending short option: -" ++ [unShortOpt so])]- gd s' = Consumed (Ok () s' msg)- err = Empty (Fail msg)- in maybe err gd $ do- guard $ not stop- (first, rest) <- case pends of- [] -> mzero- x:xs -> return (x, xs)- when (unShortOpt so /= first) mzero- return $ State rest rm stop---- | @lookAhead p@ runs parser p. If p succeeds, lookAhead p succeeds--- without consuming any input. If p fails without consuming any--- input, so does lookAhead. If p fails and consumes input, lookAhead--- also fails and consumes input. If this is undesirable, combine with--- "try".-lookAhead :: Parser a -> Parser a-lookAhead p = Parser $ \s ->- case runParser p s of- Consumed r -> case r of- Ok x _ e -> Empty (Ok x s e)- e -> Consumed e- e -> e--nextW :: Remaining -> Maybe (String, Remaining)-nextW rm = case rm of- [] -> Nothing- x:xs -> Just (x, xs)---- | Parses only non-pending short options. Fails without consuming--- any input if:------ * there are pending short options------ * there has already been a stopper------ * there are no arguments left to parse------ * the next argument is an empty string------ * the next argument does not begin with a dash------ * the next argument is a single dash------ * the next argument is a short option but it does not match--- the one given------ * the next argument is a stopper------ Otherwise, consumes the next argument, puts any remaining letters--- from the argument into a pending short, and removes the first word--- from remaining arguments to be parsed.-nonPendingShortOpt :: ShortOpt -> Parser ()-nonPendingShortOpt so = Parser $ \s@(State ps rm stop) ->- let dsc = [Expected- $ "non pending short option: -" ++ [unShortOpt so]]- err = Error (descLocation s) dsc- errRet = Empty (Fail err)- gd (ps'', rm'') = Consumed (Ok () (State ps'' rm'' stop) err)- in maybe errRet gd $ do- guard $ null ps- guard $ not stop- (a, rm') <- nextW rm- (maybeDash, word) <- case a of- [] -> mzero- x:xs -> return (x, xs)- guard (maybeDash == '-')- (letter, arg) <- case word of- [] -> mzero- x:xs -> return (x, xs)- guard (letter == unShortOpt so)- return (arg, rm')----- | Parses an exact long option. That is, the text of the--- command-line option must exactly match the text of the--- option. Returns any argument that is attached to--- the same word of the option with an equal sign (for example,--- @--follow=\/dev\/random@ will return @Just \"\/dev\/random\"@ for the--- argument.) If there is no equal sign, returns Nothing for the--- argument. If there is an equal sign but there is nothing after it,--- returns @Just \"\"@ for the argument.------ If you do not want your long option to have equal signs and--- GNU-style option arguments, wrap this parser in something that will--- fail if there is an option argument.------ Fails without consuming any input if:------ * there are pending short options------ * a stopper has been parsed------ * there are no arguments left on the command line------ * the next argument on the command line does not begin with--- two dashes------ * the next argument on the command line is @--@ (a stopper)------ * the next argument on the command line does begin with two--- dashes but its text does not match the argument we're looking for--exactLongOpt :: LongOpt -> Parser (Maybe String)-exactLongOpt lo = Parser $ \s@(State ps rm sp) ->- let msg = Error (descLocation s)- [Expected ("long option: --" ++ unLongOpt lo)]- gd (arg, newRm) = Consumed (Ok arg (State ps newRm sp) msg)- err = Empty (Fail msg)- in maybe err gd $ do- guard $ null ps- guard $ not sp- (x, rm') <- nextW rm- (word, afterEq) <- getLongOption x- guard (word == unLongOpt lo)- return (afterEq, rm')- --getLongOption :: String -> Maybe (String, Maybe String)-getLongOption str = do- guard (str /= "--")- let (pre, word, afterEq) = splitLongWord str- guard (pre == "--")- return (word, afterEq)---- | Takes a single String and returns a tuple, where the first element--- is the first two letters, the second element is everything from the--- third letter to the equal sign, and the third element is Nothing if--- there is no equal sign, or Just String with everything after the--- equal sign if there is one.-splitLongWord :: String -> (String, String, Maybe String)-splitLongWord t = (f, s, r) where- (f, rest) = L.splitAt 2 t- (s, withEq) = L.break (== '=') rest- r = case withEq of- [] -> Nothing- _:xs -> Just xs--approxLongOptError :: [LongOpt] -> [Description]-approxLongOptError =- map (Expected . ("long option: --" ++) . unLongOpt)---assert :: e -> Bool -> Either e ()-assert e b = if b then Right () else Left e--fromMaybe :: e -> Maybe a -> Either e a-fromMaybe e = maybe (Left e) Right---- | Examines the next word. If it matches a LongOpt in the set--- unambiguously, returns a tuple of the word actually found and the--- matching word in the set and the accompanying text after the equal--- sign (if any). If the Set is empty, this parser will always fail.-approxLongOpt ::- Set LongOpt- -> Parser (String, LongOpt, Maybe String)-approxLongOpt ts = Parser $ \s@(State ps rm stop) ->- let err ls = Error (descLocation s) (approxLongOptError ls)- ert ls = Empty (Fail $ err ls)- gd (found, opt, arg, rm'') =- Consumed (Ok (found, opt, arg) (State ps rm'' stop)- (err allOpts))- allOpts = Set.toList ts- in either ert gd $ do- assert allOpts $ null ps- assert allOpts $ not stop- (x, rm') <- fromMaybe allOpts $ nextW rm- (word, afterEq) <- fromMaybe allOpts $ getLongOption x- opt <- fromMaybe allOpts $ makeLongOpt word- if Set.member opt ts- then return (word, opt, afterEq, rm')- else do- let p t = word `isPrefixOf` unLongOpt t- matches = Set.filter p ts- case Set.toList matches of- [] -> Left allOpts- (m:[]) -> return (word, m, afterEq, rm')- ls -> Left ls----- | Parses only pending short option arguments. For example, for the--- @tail@ command, if you enter the option @-c25@, then after parsing--- the @-c@ option the @25@ becomes a pending short option argument--- because it was in the same command line argument as the @-c@.------ Fails without consuming any input if:------ * a stopper has already been parsed------ * there are no pending short option arguments------ On success, returns the String of the pending short option argument--- (this String will never be empty).-pendingShortOptArg :: Parser String-pendingShortOptArg = Parser $ \st@(State ps rm sp) ->- let msg = [Expected "pending short option argument"]- err = Error (descLocation st) msg- ert = Empty (Fail err)- gd str = Consumed (Ok str (State "" rm sp) err)- in maybe ert gd $ do- guard $ not sp- case ps of- [] -> mzero- xs -> return xs----- | Parses a \"stopper\" - that is, a double dash. Changes the internal--- state of the parser to reflect that a stopper has been seen.-stopper :: Parser ()-stopper = Parser $ \s@(State ps rm sp) ->- let err = Error (descLocation s)- [Expected "stopper, \"--\""]- ert = Empty (Fail err)- gd rm'' = Consumed (Ok () (State ps rm'' True) err)- in maybe ert gd $ do- guard $ not sp- guard . null $ ps- (x, rm') <- nextW rm- guard $ x == "--"- return rm'----- | If a stopper has already been seen, change the internal state--- back to indicating that no stopper has been seen.-resetStopper :: Parser ()-resetStopper = Parser $ \s@(State ps rm _) ->- Empty (Ok () (State ps rm False) (Error (descLocation s) []))----- | try p behaves just like p, but if p fails, try p will not consume--- any input.-try :: Parser a -> Parser a-try a = Parser $ \s ->- case runParser a s of- Consumed r -> case r of- Fail e -> Empty (Fail e)- o -> Consumed o- o -> o----- | Returns the next string on the command line as long as there are--- no pendings. Succeeds even if a stopper is present. Be careful ---- this will return the next string even if it looks like an option--- (that is, it starts with a dash.) Consider whether you should be--- using nonOptionPosArg instead. However this can be useful when--- parsing command line options after a stopper.-nextWord :: Parser String-nextWord = Parser $ \s@(State ps rm sp) ->- let err = Error (descLocation s) [dsc]- dsc = Expected "next word"- ert = Empty (Fail err)- gd (str, rm'') = Consumed $ Ok str (State ps rm'' sp) err- in maybe ert gd $ do- guard $ null ps- nextW rm- ---- | Parses the next word on the command line, but only if it exactly--- matches the word given. Otherwise, fails without consuming any--- input. Also fails without consuming any input if there are pending--- short options or if a stopper has already been parsed. Does not pay--- any attention to whether a stopper is present.-nextWordIs :: String -> Parser ()-nextWordIs str = Parser $ \s@(State ps rm sp) ->- let err = Error (descLocation s) [dsc]- dsc = Expected $ "next argument \"" ++ str ++ "\""- ert = Empty $ Fail err- gd rm'' = Consumed $ Ok () (State ps rm'' sp) err- in maybe ert gd $ do- guard $ null ps- (a, rm') <- nextW rm- guard (a == str)- return rm'----- | If there are pending short options, fails without consuming any input.------ Otherwise, if a stopper has NOT already been parsed, then returns--- the next word if it is either a single dash or any other word that--- does not begin with a dash. If the next word does not meet these--- criteria, fails without consuming any input.------ Otherwise, if a stopper has already been parsed, then returns the--- next word, regardless of whether it begins with a dash or not.-nonOptionPosArg :: Parser String-nonOptionPosArg = Parser $ \s@(State ps rm sp) ->- let err = Error (descLocation s) [dsc]- dsc = Expected "non option positional argument"- ert = Empty $ Fail err- gd (str, rm'') = Consumed $ Ok str (State ps rm'' sp) err- in maybe ert gd $ do- guard $ null ps- (x, rm') <- nextW rm- result <- if sp- then return x- else case x of- [] -> return x- '-':[] -> return "-"- f:_ -> if f == '-' then mzero else return x- return (result, rm')----- | Succeeds if there is no more input left.-end :: Parser ()-end = Parser $ \s@(State ps rm _) ->- let err = Error (descLocation s) [dsc]- dsc = Expected "end of input"- ert = Empty $ Fail err- gd = Empty $ Ok () s err- in if null ps && null rm then gd else ert----- | Examines the possible words in Set. If there are no pendings,--- then get the next word and see if it matches one of the words in--- Set. If so, returns the word actually parsed and the matching word--- from Set. If there is no match, fails without consuming any--- input. Pays no attention to whether a stopper has been seen.-matchApproxWord :: Set String -> Parser (String, String)-matchApproxWord set = Parser $ \s@(State ps rm sp) ->- let err = Error (descLocation s) . lsDsc- lsDsc = map (Expected . ("next word: " ++))- ert = Empty . Fail . err- gd (act, mtch, rm'') =- Consumed $ Ok (act, mtch) (State ps rm'' sp) (err allWords)- allWords = Set.toList set- in either ert gd $ do- assert allWords $ null ps- (x, rm') <- fromMaybe allWords $ nextW rm- let matches = Set.filter p set- p t = x `isPrefixOf` t- case Set.toList matches of- [] -> Left allWords- r:[] -> return (x, r, rm')- xs -> Left xs- --- | @manyTill p end@ runs parser p zero or more times until parser--- @end@ succeeds. If @end@ succeeds and consumes input, that input is--- also consumed. in the result of @manyTill@. If that is a problem,--- wrap it in @lookAhead@. Also, if @end@ fails and consumes input,--- @manyTill@ fails and consumes input. If that is a problem, wrap--- @end@ in @try@.-manyTill :: Parser a -> Parser end -> Parser [a]-manyTill p e = do- maybeEnd <- optional e- case maybeEnd of- Just _ -> return []- Nothing -> do- a <- crashOnEmptyOk "manyTill" p- rs <- manyTill p e- return $ a:rs-
− lib/System/Console/MultiArg/SampleParser.hs
@@ -1,70 +0,0 @@--- | This is sample code using "System.Console.MultiArg". This could--- be a command-line parser for the version of the Unix command @tail@--- that is included with GNU coreutils version 8.5. "main" simply gets--- the command line arguments, parses them, and prints out what was--- parsed. To test it out, simply compile an executable that looks--- like this and then feed it different options:------ > import System.Console.MultiArg.SampleParser--- > main = sampleMain Intersperse------ or:------ > import System.Console.MultiArg.SampleParser--- > main = sampleMain StopOptions------ The code in the module is the sample code; the sample code is not--- in the Haddock documentation! If you're reading this in Haddock,--- you will want to also take a look at the actual source code.-module System.Console.MultiArg.SampleParser where--import qualified System.Console.MultiArg.Combinator as C-import qualified System.Console.MultiArg.CommandLine as P--data Flag =- Bytes String- | Follow (Maybe String)- | Retry- | Lines String- | Stats String- | Pid String- | Quiet- | Sleep String- | Verbose- | Help- | Version- | Filename String- deriving Show--specs :: [C.OptSpec Flag]--specs =- [ C.OptSpec ["bytes"] ['c']- (C.OneArg (return . Bytes))-- , C.OptSpec ["follow"] ['f']- (C.OptionalArg (return . Follow))-- , C.OptSpec ["follow-retry"] ['F'] (C.NoArg Retry)-- , C.OptSpec ["lines"] ['n']- (C.OneArg (return . Lines))-- , C.OptSpec ["max-unchanged-stats"] []- (C.OneArg (return . Stats))-- , C.OptSpec ["pid"] []- (C.OneArg (return . Pid))- , C.OptSpec ["quiet"] ['q'] (C.NoArg Quiet)-- , C.OptSpec ["sleep-interval"] ['s']- (C.OneArg (return . Sleep))- , C.OptSpec ["verbose"] ['v'] (C.NoArg Verbose)- , C.OptSpec ["help"] [] (C.NoArg Help)- , C.OptSpec ["version"] [] (C.NoArg Version)- ]--sampleMain :: P.Intersperse -> IO ()-sampleMain i = do- r <- P.simpleIO specs i (return . Filename)- print r
− minimum-versions.txt
@@ -1,44 +0,0 @@-This package was tested to work with these dependency-versions and compiler version.-These are the minimum versions given in the .cabal file.-Tested as of: 2014-03-01 20:12:15.212998 UTC-Path to compiler: ghc-7.4.1-Compiler description: 7.4.1--/opt/ghc/7.4.1/lib/ghc-7.4.1/package.conf.d:- Cabal-1.14.0- array-0.4.0.0- base-4.5.0.0- bin-package-db-0.0.0.0- binary-0.5.1.0- bytestring-0.9.2.1- containers-0.4.2.1- deepseq-1.3.0.0- directory-1.1.0.2- extensible-exceptions-0.1.1.4- filepath-1.3.0.0- (ghc-7.4.1)- ghc-prim-0.2.0.0- (haskell2010-1.1.0.1)- (haskell98-2.0.0.1)- hoopl-3.8.7.3- hpc-0.5.1.1- integer-gmp-0.4.0.0- old-locale-1.0.0.4- old-time-1.1.0.0- pretty-1.1.1.0- process-1.1.0.1- rts-1.0- template-haskell-2.7.0.0- time-1.4- unix-2.5.1.0--/home/massysett/multiarg/sunlight-29118/db:- bifunctors-0.1.3.1- comonad-1.1.1.6- contravariant-0.2.0.2- multiarg-0.26.0.0- semigroupoids-1.3.4- semigroups-0.8.5- transformers-0.3.0.0-
multiarg.cabal view
@@ -1,57 +1,182 @@-Name: multiarg-Version: 0.26.0.0-Cabal-version: >=1.8-Build-Type: Simple-License: BSD3-Copyright: 2011-2013 Omari Norman.+-- This Cabal file generated using the Cartel library.+-- Cartel is available at:+-- http://www.github.com/massysett/cartel+--+-- Script name used to generate: genCabal.hs+-- Generated on: 2015-09-09 21:55:24.296803 EDT+-- Cartel library version: 0.14.2.6++name: multiarg+version: 0.30.0.10+cabal-version: >= 1.18+license: BSD3+license-file: LICENSE+build-type: Simple+copyright: Copyright 2011-2015 Omari Norman author: Omari Norman maintainer: omari@smileystation.com stability: Experimental homepage: https://github.com/massysett/multiarg-bug-reports: omari@smileystation.com-Category: Console, Parsing-License-File: LICENSE-synopsis: Combinators to build command line parsers-extra-source-files: ChangeLog, README.md,- minimum-versions.txt, current-versions.txt,- sunlight-test.hs--tested-with: GHC==7.4.1, GHC==7.6.3+bug-reports: https://github.com/massysett/multiarg/issues+synopsis: Command lines for options that take multiple arguments+description:+ multiarg helps you build command-line parsers for+ programs with options that take more than one argument.+ See the documentation in the Multiarg module for details.+category: Console, Parsing+extra-source-files:+ ChangeLog+ README.md -description: multiarg is a parser combinator library to build command- line parsers. With it you can easily create parsers with options- that take more than one option argument--for example, I created- multiarg due to the apparent lack of such ability amongst other- parsers. Its basic design is loosely inspired by Parsec.- .- Provides Parser, a monad you use to build parsers. This monad exposes- multiarg's full functionality. The library also has a simple,- pre-built parser built with the underlying combinators, which works- for many situtations and shields you from the underlying complexity- if you don't need it.- .- See the documentation in the System.Console.MultiArg module for- details.+Library+ hs-source-dirs:+ lib+ ghc-options:+ -Wall+ default-language: Haskell2010+ build-depends:+ base >= 4.7.0.0 && < 5+ exposed-modules:+ Multiarg+ Multiarg.Examples+ Multiarg.Examples.Grover+ Multiarg.Examples.Telly+ Multiarg.Internal+ Multiarg.Limeline+ Multiarg.Maddash+ Multiarg.Mode+ Multiarg.Mode.Internal+ Multiarg.Types+ Multiarg.Util+ Multiarg.Vocabulary source-repository head- type: git- location: git://github.com/massysett/multiarg.git--Library- Build-depends:- base >=4.5.0.0 && < 5- , bifunctors >= 0.1.3.1- , containers >=0.4.2.1+ type: git+ location: https://github.com/massysett/multiarg.git - hs-source-dirs: lib+Executable grover+ main-is: grover-main.hs+ if flag(programs)+ buildable: True+ hs-source-dirs:+ lib+ ghc-options:+ -Wall+ default-language: Haskell2010+ build-depends:+ base >= 4.7.0.0 && < 5+ build-depends:+ QuickCheck >= 2.7+ , tasty >= 0.10+ , tasty-quickcheck >= 0.8+ , tasty-th >= 0.1+ other-modules:+ Multiarg+ Multiarg.Examples+ Multiarg.Examples.Grover+ Multiarg.Examples.Telly+ Multiarg.Internal+ Multiarg.Limeline+ Multiarg.Maddash+ Multiarg.Mode+ Multiarg.Mode.Internal+ Multiarg.Types+ Multiarg.Util+ Multiarg.Vocabulary+ Ernie+ Grover.Tests+ Makeopt+ Multiarg.Maddash.Instances+ Multiarg.Maddash.Tests+ Multiarg.Types.Instances+ Telly.Tests+ hs-source-dirs:+ tests+ else+ buildable: False - Exposed-modules:- System.Console.MultiArg- , System.Console.MultiArg.Combinator- , System.Console.MultiArg.CommandLine- , System.Console.MultiArg.Option- , System.Console.MultiArg.Prim- , System.Console.MultiArg.SampleParser+Executable telly+ main-is: telly-main.hs+ if flag(programs)+ buildable: True+ hs-source-dirs:+ lib+ ghc-options:+ -Wall+ default-language: Haskell2010+ build-depends:+ base >= 4.7.0.0 && < 5+ build-depends:+ QuickCheck >= 2.7+ , tasty >= 0.10+ , tasty-quickcheck >= 0.8+ , tasty-th >= 0.1+ other-modules:+ Multiarg+ Multiarg.Examples+ Multiarg.Examples.Grover+ Multiarg.Examples.Telly+ Multiarg.Internal+ Multiarg.Limeline+ Multiarg.Maddash+ Multiarg.Mode+ Multiarg.Mode.Internal+ Multiarg.Types+ Multiarg.Util+ Multiarg.Vocabulary+ Ernie+ Grover.Tests+ Makeopt+ Multiarg.Maddash.Instances+ Multiarg.Maddash.Tests+ Multiarg.Types.Instances+ Telly.Tests+ hs-source-dirs:+ tests+ else+ buildable: False - ghc-options: -Wall+Test-Suite multiarg-tests+ hs-source-dirs:+ lib+ ghc-options:+ -Wall+ default-language: Haskell2010+ build-depends:+ base >= 4.7.0.0 && < 5+ type: exitcode-stdio-1.0+ main-is: multiarg-tests.hs+ other-modules:+ Multiarg+ Multiarg.Examples+ Multiarg.Examples.Grover+ Multiarg.Examples.Telly+ Multiarg.Internal+ Multiarg.Limeline+ Multiarg.Maddash+ Multiarg.Mode+ Multiarg.Mode.Internal+ Multiarg.Types+ Multiarg.Util+ Multiarg.Vocabulary+ Ernie+ Grover.Tests+ Makeopt+ Multiarg.Maddash.Instances+ Multiarg.Maddash.Tests+ Multiarg.Types.Instances+ Telly.Tests+ hs-source-dirs:+ tests+ other-extensions:+ TemplateHaskell+ build-depends:+ QuickCheck >= 2.7+ , tasty >= 0.10+ , tasty-quickcheck >= 0.8+ , tasty-th >= 0.1 +Flag programs+ description: Build sample programs+ default: False+ manual: True
− sunlight-test.hs
@@ -1,15 +0,0 @@-module Main where--import Test.Sunlight--ghc v = (v, "ghc-" ++ v, "ghc-pkg-" ++ v)--inputs = TestInputs- { tiDescription = Nothing- , tiCabal = "cabal"- , tiLowest = ghc "7.4.1"- , tiDefault = [ ghc "7.4.1", ghc "7.6.3" ]- , tiTest = []- }--main = runTests inputs
+ tests/Ernie.hs view
@@ -0,0 +1,122 @@+-- | Functions to assist with testing.+module Ernie where++import Control.Applicative+import Makeopt+import Multiarg.Types+import Test.QuickCheck++-- | Generates words that start with a single hyphen.+startsWithOneHyphen :: Gen String+startsWithOneHyphen = fmap ('-':) (listOf1 arbitrary)++-- | Generates words that start with two hyphens.+startsWithTwoHyphens :: Gen String+startsWithTwoHyphens = fmap ("--" ++) arbitrary++-- | Generates words that do not start with a hyphen.+startsWithNonHyphen :: Gen String+startsWithNonHyphen = (:) <$> (arbitrary `suchThat` (/= '-'))+ <*> arbitrary++-- | Generates words for option arguments. Ensures that some start+-- with hyphens (these are valid option arguments.)+optArg :: Gen String+optArg = oneof [ startsWithOneHyphen, startsWithNonHyphen ]++short :: Char -> [String] -> [[String]]+short c os = case shortName c of+ Nothing -> error "Ernie.hs: error: could not create short name"+ Just o -> processShortOptions [] (o, os)++long :: String -> [String] -> [[String]]+long s os = case longName s of+ Nothing -> error "Ernie.hs: error: could not create long name"+ Just o -> processLongOption o os++pickItem :: [a] -> Gen a+pickItem a+ | null a = fail "pickItem: empty list"+ | otherwise = fmap (a !!) (choose (0, length a - 1))++-- | Generates non-option positional arguments that appear to the+-- right of the stopper. This can be any word at all.+posArgRight :: Gen String+posArgRight = oneof+ [ arbitrary, startsWithOneHyphen, startsWithTwoHyphens ]++-- | Generates non-option positional arguments that appear to the left+-- of the stopper. Cannot be preceded by a dash; can, however, be a+-- single hyphen only.+posArgLeft :: Gen String+posArgLeft =+ frequency [ (5, startsWithNonHyphen)+ , (1, return "-") ]++-- | Generates options, non-option positional arguments that are a+-- single hyphen only, and non-option positional arguments that do not+-- start with a hyphen; these may appear to the left of a stopper.+preStopper+ :: Gen a+ -- ^ Generates options+ -> (String -> a)+ -- ^ Creates non-option positional arguments+ -> Gen [a]+preStopper genOpt fPos =+ listOf (oneof [ genOpt, fmap fPos posArgLeft ])++-- | Generates any word at all, with a healthy mix of empty lists+-- (stoppers are unusual.)+postStopper+ :: (String -> a)+ -- ^ Creates non-option positional arguments+ -> Gen [a]+postStopper fPos =+ oneof [ return [], listOf (fmap fPos posArgRight) ]++-- | Generates a valid list of interspersed command-line options; that+-- is, a list that the user could have entered in the command line.+-- This list may be transformed into strings, which can then be parsed+-- and compared against this original value.+--+-- Returns a pair @(a, b)@, where @a@ is everything to the left of the+-- stopper, and @b@ (if non-empty) is everything to the right of the+-- stopper.++interspersedLine+ :: Gen a+ -- ^ Generates options+ -> (String -> a)+ -- ^ Creates non-option positional arguments+ -> Gen ([a], [a])+interspersedLine genOpt fPos =+ (,)+ <$> preStopper genOpt fPos+ <*> postStopper fPos+++-- | Takes an interspersed line and creates a set of strings that+-- would, when parsed, yield the interspersed line.+interspersedLineToStrings++ :: ([a], [a])+ -- ^ @(a, b)@, where+ --+ -- @a@ is everything to the left of the stopper, and+ --+ -- @b@ is everything to the right of the stopper++ -> (a -> [[String]])+ -- ^ Converts a single item to a nested list of String. Each list+ -- of String is a possible way to render this item. This list must+ -- not be empty.++ -> Gen [String]++interspersedLineToStrings (left, right) fConv = do+ l <- fmap concat . mapM pickItem . map fConv $ left+ r <- fmap concat . mapM pickItem . map fConv $ right+ alwaysStopper <- arbitrary+ let stop | not (null r) || alwaysStopper = ["--"]+ | otherwise = []+ return $ l ++ stop ++ r
+ tests/Grover/Tests.hs view
@@ -0,0 +1,136 @@+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# LANGUAGE TemplateHaskell #-}+module Grover.Tests where++import Ernie+import Multiarg.Examples.Grover+import Control.Applicative+import Test.QuickCheck hiding (Result)+import Multiarg.Mode+import Test.Tasty+import Test.Tasty.TH+import Test.Tasty.QuickCheck++tests :: TestTree+tests = $(testGroupGenerator)++genGlobal :: Gen Global+genGlobal = oneof+ [ return Help+ , Verbose <$> arbitrary+ , return Version+ ]++data GroverOpts+ = GOInts [GroverOpt Int]+ | GOStrings [GroverOpt String]+ | GOMaybes [GroverOpt (Maybe Int)]+ deriving (Eq, Ord, Show)++instance Arbitrary GroverOpts where+ arbitrary = oneof+ [ fmap GOInts . listOf . genGroverOpt $ arbitrary+ , fmap GOStrings . listOf . genGroverOpt $ arbitrary+ , fmap GOMaybes . listOf . genGroverOpt $ arbitrary+ ]++-- | Generates a mode option. Does not generate positional arguments.+genGroverOpt+ :: Gen a+ -- ^ Generates arguments+ -> Gen (GroverOpt a)+genGroverOpt g = oneof+ [ return Zero+ , Single <$> g+ , Double <$> g <*> g+ , Triple <$> g <*> g <*> g+ ]++globalToNestedList :: Global -> [[String]]+globalToNestedList glbl = case glbl of+ Help -> long "help" [] ++ short 'h' []+ Verbose i -> long "verbose" [show i] ++ short 'v' [show i]+ Version -> long "version" []++groverOptToNestedList :: Show a => GroverOpt a -> [[String]]+groverOptToNestedList gvr = case gvr of+ Zero -> long "zero" [] ++ short 'z' []+ Single a -> long "single" ls ++ short 's' ls+ where+ ls = [show a]+ Double a b -> long "double" ls ++ short 'd' ls+ where+ ls = [show a, show b]+ Triple a b c -> long "triple" ls ++ short 't' ls+ where+ ls = [show a, show b, show c]+ PosArg s -> [[s]]++-- | A valid Grover AST, combined with a set of strings that, when+-- parsed, should yield that AST.+data ValidGrover+ = ValidGrover [Global] (Either [String] Result) [String]+ -- ^ @ValidGrover a b c@, where+ --+ -- @a@ is the list of global options+ --+ -- @b@ is either a list of strings (indicates that the user entered+ -- no mode), or the mode, and its associated options+ --+ -- @c@ is a list of strings that, when parsed, should return @a@ and @b@.+ deriving (Eq, Ord, Show)++instance Arbitrary ValidGrover where+ arbitrary = do+ globals <- listOf genGlobal+ glblStrings <- fmap concat . mapM pickItem+ . map globalToNestedList $ globals+ (ei, endStrings) <- oneof+ [ resultAndStrings Ints "int"+ , resultAndStrings Strings "string"+ , resultAndStrings Maybes "maybe"+ ]+ return $ ValidGrover globals ei (glblStrings ++ endStrings)++-- | Generates a list of String, where the first String will not be+-- interpreted as a mode.++genNonModePosArg :: Gen [String]+genNonModePosArg = frequency ([ (1, return []), (3, nonEmpty)])+ where+ nonEmpty = (:) <$> firstWord <*> listOf arbitrary+ where+ firstWord = arbitrary `suchThat`+ (\s -> not (s `elem` ["int", "string", "maybe"])+ && not (startsWithHyphen s))+ startsWithHyphen s = case s of+ '-':_ -> True+ _ -> False+++resultAndStrings+ :: (Arbitrary a, Show a)++ => ([Either String (GroverOpt a)] -> Result)+ -- ^ Function that creates a Result++ -> String+ -- ^ Name of mode++ -> Gen (Either [String] Result, [String])+resultAndStrings fRes modeName = frequency [(1, nonMode), (4, withMode)]+ where+ nonMode = fmap (\ls -> (Left ls, ls)) genNonModePosArg+ withMode = do+ ispLine <- interspersedLine (genGroverOpt arbitrary) PosArg+ strings <- interspersedLineToStrings ispLine groverOptToNestedList+ return ( Right . fRes . map Right $ fst ispLine ++ snd ispLine+ , modeName : strings )++prop_ValidGrover (ValidGrover globals ei strings) = result === expected+ where+ result = parseModeLine globalOptSpecs modes strings+ expected = Right (ModeResult (map Right globals) ei)+++prop_alwaysTrue = True
+ tests/Makeopt.hs view
@@ -0,0 +1,62 @@+-- | Makeopt produces all possible partitions for a given set of+-- command line options.++module Makeopt where++import Multiarg.Maddash++processShortOptions+ :: [ShortName]+ -> (ShortName, [String])+ -> [[String]]+processShortOptions firstNames (inLast, args)+ = shortPartitions firstName restNames args+ where+ (firstName, restNames) = case firstNames of+ [] -> (shortNameToChar inLast, [])+ (x:xs) -> (shortNameToChar x, map shortNameToChar $ xs ++ [inLast])++processLongOption+ :: LongName+ -> [String]+ -> [[String]]+processLongOption lngName ss = lists ss+ where+ lng = "--" ++ longNameToString lngName+ lists [] = [[lng]]+ lists (x:xs) = [ (lng ++ "=" ++ x) : xs+ , lng : x : xs+ ]++partitions :: [a] -> [[[a]]]+partitions [] = [[]]+partitions (x:xs) = [[x]:p | p <- partitions xs]+ ++ [(x:ys):yss | (ys:yss) <- partitions xs]+++shortPartitions+ :: Char+ -- ^ First flag+ -> String+ -- ^ Remaining flags+ -> [String] + -- ^ Arguments+ -> [[String]]+shortPartitions c1 cs args = case args of+ [] -> flags+ x:xs+ | null x -> separate+ | otherwise -> together ++ separate+ where+ separate = [ list ++ (x:xs) | list <- flags ]+ together = do+ list <- flags+ case addToEnd list x of+ Nothing -> error "shortPartitions: error"+ Just r -> return $ r ++ xs+ where+ flags = map (map ('-':)) $ partitions (c1 : cs)+ +addToEnd :: [[a]] -> [a] -> Maybe [[a]]+addToEnd [] _ = Nothing+addToEnd xs toAdd = Just (init xs ++ [last xs ++ toAdd])
+ tests/Multiarg/Maddash/Instances.hs view
@@ -0,0 +1,31 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Multiarg.Maddash.Instances where++import Control.Applicative+import Test.QuickCheck+import Multiarg.Maddash+import Multiarg.Types.Instances ()++instance Arbitrary OptionError where+ arbitrary = oneof+ [ BadOption <$> arbitrary+ , LongArgumentForZeroArgumentOption <$> arbitrary <*> arbitrary+ ]++instance Arbitrary a => Arbitrary (Output a) where+ arbitrary = oneof+ [ Good <$> arbitrary+ , OptionError <$> arbitrary+ ]++instance Arbitrary a => Arbitrary (Pallet a) where+ arbitrary = oneof+ [ return NotAnOption+ , Full <$> arbitrary+ ]++instance Arbitrary a => Arbitrary (State a) where+ arbitrary = oneof+ [ return Ready+ , Pending <$> arbitrary <*> arbitrary+ ]
+ tests/Multiarg/Maddash/Tests.hs view
@@ -0,0 +1,138 @@+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# LANGUAGE TemplateHaskell #-}+module Multiarg.Maddash.Tests where++import Control.Applicative+import Multiarg.Types+import Multiarg.Maddash+import Makeopt+import Test.QuickCheck+import Test.Tasty+import Test.Tasty.TH+import Test.Tasty.QuickCheck+import Multiarg.Types.Instances ()+import Multiarg.Maddash.Instances ()+import Multiarg.Types.Instances ()++tests :: TestTree+tests = $(testGroupGenerator)++genInt :: Gen Int+genInt = arbitrary++singleDash :: Multiarg.Types.Word+singleDash = Multiarg.Types.Word "-"++stopper :: Multiarg.Types.Word+stopper = Multiarg.Types.Word "--"++genNonOptWord :: Gen Multiarg.Types.Word+genNonOptWord = oneof+ [ return singleDash+ , return stopper+ , do+ c1 <- arbitrary `suchThat` (/= '-')+ cs <- listOf arbitrary+ return $ Multiarg.Types.Word (c1 : cs)+ ]++genPending :: Arbitrary a => Gen (State a)+genPending = Pending <$> arbitrary <*> arbitrary++-- * Properties++-- | Non-option token always returns NotAnOption if State is Ready+prop_nonOptWordNotAnOptionIfStateIsReady :: Property+prop_nonOptWordNotAnOptionIfStateIsReady =+ forAll arbitrary $ \shorts ->+ forAll arbitrary $ \longs ->+ forAll genNonOptWord $ \token ->+ let (pallet, _) = processWord shorts longs Ready token+ _types = shorts :: [(ShortName, ArgSpec Int)]+ in pallet == NotAnOption++-- | Stopper always returns NotAnOption if State is Ready+prop_stopperNotAnOptionIfStateIsReady :: Property+prop_stopperNotAnOptionIfStateIsReady =+ forAll arbitrary $ \shorts ->+ forAll arbitrary $ \longs ->+ let (pallet, _) = processWord shorts longs Ready stopper+ _types = shorts :: [(ShortName, ArgSpec Int)]+ in pallet == NotAnOption++-- | Single dash always returns NotAnOption if State is Ready+prop_singleDashNotAnOptionIfStateIsReady :: Property+prop_singleDashNotAnOptionIfStateIsReady =+ forAll arbitrary $ \shorts ->+ forAll arbitrary $ \longs ->+ let (pallet, _) = processWord shorts longs Ready singleDash+ _types = shorts :: [(ShortName, ArgSpec Int)]+ in pallet == NotAnOption++-- | processWord never returns NotAnOption when input is Pending+prop_processWordNeverReturnsNotAnOptionOnPending =+ forAll arbitrary $ \shorts ->+ forAll arbitrary $ \longs ->+ forAll genPending $ \state ->+ forAll arbitrary $ \token ->+ let (pallet, _) = processWord shorts longs state token+ _types = shorts :: [(ShortName, ArgSpec Int)]+ in pallet /= NotAnOption++-- | NotAnOption is always returned with Ready+prop_processWordNotAnOptionWithReady =+ forAll arbitrary $ \shorts ->+ forAll arbitrary $ \longs ->+ forAll arbitrary $ \state ->+ forAll arbitrary $ \token ->+ let (pallet, state') = processWord shorts longs state token+ _types = shorts :: [(ShortName, ArgSpec Int)]+ in pallet == NotAnOption ==> isReady state'++pickOne :: [a] -> Gen a+pickOne ls+ | null ls = error "pickOne: null list"+ | otherwise = fmap (\ix -> ls !! ix) (choose (0, length ls - 1))++data OptionWithToks = OptionWithToks+ { owtOptName :: OptName+ , owtArgSpec :: ArgSpec Int+ , owtArgs :: [String]+ , owtWords :: [Multiarg.Types.Word]+ , owtResultOuts :: [[Output Int]]+ , owtResultToks :: Maybe [Multiarg.Types.Word]+ , owtExpected :: Int+ } deriving Show++instance Arbitrary OptionWithToks where+ arbitrary = do+ OptName on <- arbitrary+ as <- arbitrary+ (args, expected) <- case as of+ ZeroArg a -> return ([], a)+ OneArg f -> do+ s <- arbitrary+ return ([s], f s)+ TwoArg f -> do+ s1:s2:[] <- vectorOf 2 arbitrary+ return ([s1,s2], f s1 s2)+ ThreeArg f -> do+ s1:s2:s3:[] <- vectorOf 3 arbitrary+ return ([s1,s2,s3], f s1 s2 s3)+ let strings = case on of+ Left shrt -> processShortOptions [] (shrt, args)+ Right lng -> processLongOption lng args+ toks <- fmap (map Multiarg.Types.Word) $ pickOne strings+ let (shrts, lngs) = case on of+ Left shrt -> ([(shrt, as)], [])+ Right lng -> ([], [(lng, as)])+ (procRslts, procEi) = processWords shrts lngs toks+ mayToks = either (const Nothing) Just procEi+ return $ OptionWithToks (OptName on) as args toks procRslts+ mayToks expected++prop_optionWithToksResultToksEmpty = (== Just []) . owtResultToks++prop_optionWithToksResultIsExpected owt+ = concat (owtResultOuts owt) == [Good . owtExpected $ owt]+
+ tests/Multiarg/Types/Instances.hs view
@@ -0,0 +1,42 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Multiarg.Types.Instances where++import Control.Applicative+import Test.QuickCheck+import Multiarg.Types++instance Arbitrary a => Arbitrary (ArgSpec a) where+ arbitrary = oneof+ [ ZeroArg <$> arbitrary+ , OneArg <$> arbitrary+ , TwoArg <$> arbitrary+ , ThreeArg <$> arbitrary+ ]++instance Arbitrary ShortName where+ arbitrary = do+ c <- arbitrary+ case shortName c of+ Nothing -> arbitrary+ Just n -> return n++instance Arbitrary LongName where+ arbitrary = do+ c1 <- arbitrary `suchThat` (\c -> c /= '-' && c /= '=')+ cs <- listOf (arbitrary `suchThat` (/= '='))+ case longName (c1 : cs) of+ Nothing -> error $ "could not generate long name: " ++ (c1:cs)+ Just n -> return n++instance Arbitrary OptName where+ arbitrary = fmap OptName arbitrary++instance Arbitrary Multiarg.Types.Word where+ arbitrary = Multiarg.Types.Word <$> arbitrary++instance CoArbitrary Multiarg.Types.Word where+ coarbitrary (Multiarg.Types.Word s) = coarbitrary s++instance Arbitrary OptArg where+ arbitrary = OptArg <$> arbitrary+
+ tests/Telly/Tests.hs view
@@ -0,0 +1,81 @@+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# LANGUAGE TemplateHaskell #-}+module Telly.Tests where++import Multiarg.Examples.Telly+import Test.QuickCheck+import Control.Applicative+import Ernie+import Multiarg.Internal+import Test.Tasty+import Test.Tasty.TH+import Test.Tasty.QuickCheck++tests :: TestTree+tests = $(testGroupGenerator)++-- | Generates any option.+option :: Gen Telly+option = oneof+ [ return Empty+ , Single <$> optArg+ , Double <$> optArg <*> optArg+ , Triple <$> optArg <*> optArg <*> optArg++ , return Zero+ , One <$> optArg+ , Two <$> optArg <*> optArg+ , Three <$> optArg <*> optArg <*> optArg++ , return Cero+ , Uno <$> optArg+ , Dos <$> optArg <*> optArg+ , Tres <$> optArg <*> optArg <*> optArg+ ]++tellyToNestedList :: Telly -> [[String]]+tellyToNestedList telly = case telly of+ PosArg s -> [[s]]+ Empty -> long "empty" [] ++ short 'e' []+ Single s -> long "single" [s] ++ short 's' [s]+ Double s1 s2 -> long "double" [s1, s2] ++ short 'd' [s1, s2]+ Triple s1 s2 s3 -> long "triple" [s1, s2, s3]+ ++ short 't' [s1, s2, s3]++ Zero -> short '0' []+ One s -> short '1' [s]+ Two s1 s2 -> short '2' [s1, s2]+ Three s1 s2 s3 -> short '3' [s1, s2, s3]++ Cero -> long "cero" []+ Uno s -> long "uno" [s]+ Dos s1 s2 -> long "dos" [s1, s2]+ Tres s1 s2 s3 -> long "tres" [s1, s2, s3]++tellyToStrings :: Telly -> Gen [String]+tellyToStrings = pickItem . tellyToNestedList++validTellyStrings :: Gen ([Telly], [String])+validTellyStrings = do+ unneededStopper <- arbitrary+ (start, end) <- interspersedLine option PosArg+ let startStrings = map tellyToNestedList start+ endStrings = map tellyToNestedList end+ startList <- fmap concat $ mapM pickItem startStrings+ endList <- fmap concat $ mapM pickItem endStrings+ let endList'+ | null end && not unneededStopper = endList+ | otherwise = "--" : endList+ return (start ++ end, startList ++ endList')++prop_parseStringsYieldsTellies+ = forAll validTellyStrings $ \(tellies, strings) ->+ let ParsedCommandLine ls _+ = parseCommandLinePure optSpecs PosArg strings+ in map Right tellies === ls++prop_parseStringsYieldsNoEndError+ = forAll validTellyStrings $ \(_, strings) ->+ let ParsedCommandLine _ mayOpt+ = parseCommandLinePure optSpecs PosArg strings+ in mayOpt === Nothing
+ tests/grover-main.hs view
@@ -0,0 +1,9 @@+module Main where++import Multiarg.Examples.Grover+import System.Environment++main :: IO ()+main = do+ as <- getArgs+ putStrLn . show $ parseGrover as
+ tests/multiarg-tests.hs view
@@ -0,0 +1,13 @@+module Main where++import qualified Multiarg.Maddash.Tests+import qualified Grover.Tests+import qualified Telly.Tests+import Test.Tasty++main :: IO ()+main = defaultMain $ testGroup "all properties"+ [ Multiarg.Maddash.Tests.tests+ , Grover.Tests.tests+ , Telly.Tests.tests+ ]
+ tests/telly-main.hs view
@@ -0,0 +1,6 @@+module Main where++import Multiarg.Examples.Telly++main :: IO ()+main = parse >>= print