parseargs 0.1.3.5 → 0.1.5.2
raw patch · 5 files changed
+214/−142 lines, 5 files
Files
- README +0/−32
- README.md +50/−0
- System/Console/ParseArgs.hs +137/−92
- parseargs-example.hs +19/−11
- parseargs.cabal +8/−7
− README
@@ -1,32 +0,0 @@-parseargs -- command-line argument parsing for Haskell programs-version 0.1.3-Bart Massey <bart@cs.pdx.edu>-25 February 2010--This library provides System.Console.Parseargs, a module to-assist in argument parsing for Haskell stand-alone command-line programs.--To use this library, your program needs a structured-description of the arguments it expects. It supplies this-description to an argument parser, which creates a data-structure from which parsed arguments can be extracted as-needed. See the Haddock documentation for the gory details.--I have used this code with ghc 6.{6, 8, 10, 12} and various-development versions on Linux. It is a fairly standard-Hackage-ready package, to the extent I know how to construct-such.--The 0.1.2 release includes a typeclass for argument types for-easier use.--The 0.1.3 release includes more uniform and usable error-handling.--This is not what I set out to build. It definitely could-also use some work. I use it all the time for writing-little programs, though.I thought others might find it-useful; I also have released other code that depends on it.--Have fun with it, and let me know if there are problems.
+ README.md view
@@ -0,0 +1,50 @@+# parseargs+Command-line argument parsing for Haskell programs +Bart Massey <bart@cs.pdx.edu>++This library provides System.Console.Parseargs, a module to+assist in argument parsing for Haskell stand-alone command+line programs.++The package provides a Haskell command-line argument+"parser". You supply a specification of the arguments to+your command-line program; `parseargs` reads the arguments+and checks that they meet your spec. It then fills in a data+structure that captures the relevant data, from which parsed+arguments can be extracted as needed. See the Haddock+documentation for the gory details.++I have used this code with `ghc` 6 and 7 on Linux. It is a+fairly standard Hackage-ready package, to the extent I know+how to construct such.++The 0.1.2 release includes a typeclass for argument types for+easier use.++The 0.1.3 release includes more uniform and usable error+handling.++The various 0.1.3.x point releases include bug fixes and+various extra-minor enhancements. See the Git log.++The 0.1.4 release includes the ability to mix optional and+required positional arguments.++The 0.1.5 release includes the "soft dash" option, giving+the ability to allow positional arguments to begin with a+dash if possible.++The 0.1.5.1 release fixes some warnings and stuff.++The 0.1.5.2 release fixes some missing documentation.++This library is not what I set out to build. It definitely+could also use some work. However, I use it all the time+for writing little programs. I thought others might find it+useful, and I also have released other code that depends on+it, so I put it out there.++Have fun with it, and let me know if there are problems.++This code is released under a "3-clause BSD" license. Please+see the file COPYING in this distribution for license terms.
System/Console/ParseArgs.hs view
@@ -30,6 +30,9 @@ Arg(..), Argtype(..), ArgsComplete(..),+ ArgsDash(..),+ ArgsParseControl(..),+ APCData(..), -- ** DataArg and its pseudo-constructors DataArg, argDataRequired, argDataOptional, argDataDefaulted,@@ -218,6 +221,11 @@ arg_optional (Arg { argData = Just (DataArg { dataArgOptional = b }) }) = b arg_optional _ = True +arg_required :: (Ord a) =>+ Arg a -- ^Argument.+ -> Bool -- ^True if argument is required to be present.+arg_required a = not (arg_optional a)+ -- |Return the value of a defaulted argument. arg_default_value :: (Ord a) => Arg a -- ^Argument.@@ -236,6 +244,7 @@ arg_default_value _ = Nothing -- |There's probably a better way to do this.+perhaps :: Bool -> String -> String perhaps b s = if b then s else "" -- |Format the described argument as a string.@@ -294,10 +303,10 @@ ((Arg a) -> Maybe k) -- ^Mapping from argdesc to flag key. -> [ Arg a ] -- ^List of argdesc. -> (Map.Map k (Arg a)) -- ^Map from key to argdesc.-make_keymap f_field args =+make_keymap f_field ads = (keymap_from_list . filter_keys .- map (\arg -> (f_field arg, arg))) args+ map (\arg -> (f_field arg, arg))) ads -- |How \"sloppy\" the parse is. data ArgsComplete = ArgsComplete -- ^Any extraneous arguments@@ -312,16 +321,45 @@ -- permitted, and will be skipped, -- saved, and returned. +-- |Whether to always treat an unknown argument beginning+-- with \"-\" as an error, or to allow it to be used as a+-- positional argument when possible.+data ArgsDash = ArgsHardDash -- ^If an argument begins with+ -- a \"-\", it will always be+ -- treated as an error unless+ -- it corresponds to a flag description.+ | ArgsSoftDash -- ^If an argument beginning with+ -- a \"-\" is unrecognized as a flag,+ -- treat it as a positional argument+ -- if possible. Otherwise it is an error.+ deriving Eq++-- |Record containing the collective parse control information.+data ArgsParseControl = ArgsParseControl {+ apcComplete :: ArgsComplete,+ apcDash :: ArgsDash }++-- |Class for building parse control information,+-- for backward compatibility.+class APCData a where+ getAPCData :: a -> ArgsParseControl++instance APCData ArgsParseControl where+ getAPCData a = a++instance APCData ArgsComplete where+ getAPCData a = ArgsParseControl a ArgsHardDash+ -- |The iteration function is given a state and a list, and -- expected to produce a new state and list. The function--- is again invoked with the resulting state and list.--- When the function returns the empty list, `exhaust` returns--- the final state produced.+-- is again invoked with the resulting state and list. When+-- the supplied function returns the empty list, this+-- function returns the final state produced. exhaust :: (s -> [e] -> ([e], s)) -- ^Function to iterate. -> s -- ^Initial state. -> [e] -- ^Initial list. -> s -- ^Final state.-exhaust f s [] = s+exhaust _ s [] = s exhaust f s l = let (l', s') = f s l in exhaust f s' l'@@ -333,30 +371,29 @@ parseError usage msg = throw (ParseArgsException usage msg) --- |Given a description of the arguments, `parseArgs` produces--- a map from the arguments to their \"values\" and some other--- useful byproducts. `parseArgs` requires that the argument--- descriptions occur in the order 1) flag arguments, 2) required--- positional arguments, 3) optional positional arguments; otherwise--- a runtime error will be thrown.-parseArgs :: (Show a, Ord a) =>- ArgsComplete -- ^Degree of completeness of parse.+-- |Given a description of the arguments, `parseArgs`+-- produces a map from the arguments to their \"values\" and+-- some other useful byproducts. `parseArgs` requires that+-- the argument descriptions occur in the order 1) flag+-- arguments, then 2) positional arguments; otherwise a+-- runtime error will be thrown.+parseArgs :: (Show a, Ord a, APCData b) =>+ b -- ^Configuration for parse. -> [ Arg a ] -- ^Argument descriptions. -> String -- ^Full program pathname. -> [ String ] -- ^Incoming program argument list. -> Args a -- ^Outgoing argument parse results.-parseArgs acomplete argd pathname argv =+parseArgs apcData argd pathname argv = runST (do check_argd- let flag_args = takeWhile arg_flag argd- let posn_args = dropWhile arg_flag argd+ let (flag_args, posn_args) = span arg_flag argd let name_hash = make_keymap argName flag_args let abbr_hash = make_keymap argAbbr flag_args let prog_name = baseName pathname let usage = make_usage_string prog_name- let (am, posn, rest) = exhaust (parse usage name_hash abbr_hash)- (Map.empty, posn_args, [])- argv+ let (am, _, rest) = exhaust (parse usage name_hash abbr_hash)+ (Map.empty, posn_args, [])+ argv let required_args = filter (not . arg_optional) argd unless (and (map (check_present usage am) required_args)) (error "internal error")@@ -380,19 +417,15 @@ --- Check for various possible misuses. check_argd :: ST s () check_argd = do- --- Order must be flags, posn args, optional posn args- let residue = dropWhile arg_flag argd- let residue' = dropWhile arg_fixed_posn residue- let residue'' = dropWhile arg_opt_posn residue'- unless (null residue'')- (argdesc_error "argument description in wrong order")+ --- Order must be flags, then posn args+ let (_, posns) = span arg_flag argd+ unless (all arg_posn posns)+ (argdesc_error "argument description mixes flags and positionals") --- No argument may be "nullary". when (or (map arg_nullary argd)) (argdesc_error "bogus 'nothing' argument") return () where- arg_fixed_posn a = (arg_posn a) && (not (arg_optional a))- arg_opt_posn a = (arg_posn a) && (arg_optional a) arg_nullary (Arg { argName = Nothing, argAbbr = Nothing, argData = Nothing }) = True@@ -413,109 +446,120 @@ perhaps (not (null posn_args)) (" " ++ unwords (map arg_string posn_args)) ++- (case acomplete of+ (case apcComplete $ getAPCData apcData of ArgsComplete -> "" ArgsTrailing s -> " [--] [" ++ s ++ " ...]" ArgsInterspersed -> " ... [--] ...") ++ "\n" --- argument lines arg_lines = concatMap (arg_line n) argd where- arg_line n a =+ arg_line na a = let s = arg_string a in " " ++ s ++ - replicate (n - (length s)) ' ' +++ replicate (na - (length s)) ' ' ++ " " ++ argDesc a ++ "\n" --- simple recursive-descent parser parse _ _ _ av@(_, _, []) [] = ([], av) parse usage _ _ av [] =- case acomplete of+ case apcComplete $ getAPCData apcData of ArgsComplete -> parseError usage "unexpected extra arguments" _ -> ([], av) parse usage name_hash abbr_hash (am, posn, rest) av@(aa : aas) = case aa of- "--" -> case acomplete of- ArgsComplete -> parseError usage- ("unexpected -- " ++- "(extra arguments not allowed)")+ "--" -> case getAPCData apcData of+ ArgsParseControl ArgsComplete ArgsHardDash -> + parseError usage ("unexpected -- " +++ "(extra arguments not allowed)") _ -> ([], (am, posn, (rest ++ aas)))- s@('-' : '-' : name) ->+ s@('-' : '-' : name) + | isJust (Map.lookup name name_hash) ||+ apcDash (getAPCData apcData) == ArgsHardDash -> case Map.lookup name name_hash of- Just ad -> peel s ad aas+ Just ad -> + let (args', am') = peel s ad aas in+ (args', (am', posn, rest)) Nothing ->- case acomplete of- ArgsInterspersed ->- (aas, (am, posn, rest ++ ["--" ++ name]))- _ -> parseError usage- ("unknown argument --" ++ name)- ('-' : abbr : abbrs) ->+ case getAPCData apcData of+ ArgsParseControl ArgsInterspersed _ ->+ (aas, (am, posn, rest ++ ["--" ++ name]))+ _ -> + parseError usage+ ("unknown argument --" ++ name)+ ('-' : abbr : abbrs)+ | isJust (Map.lookup abbr abbr_hash) ||+ apcDash (getAPCData apcData) == ArgsHardDash -> case Map.lookup abbr abbr_hash of Just ad ->- let p@(args', state') = peel ['-', abbr] ad aas+ let (args', am') = peel ['-', abbr] ad aas+ state' = (am', posn, rest) in case abbrs of- [] -> p+ [] -> (args', state') ('-' : _) -> parseError usage ("bad internal '-' in argument " ++ aa) _ -> (['-' : abbrs] ++ args', state') Nothing ->- case acomplete of+ case apcComplete $ getAPCData apcData of ArgsInterspersed -> (aas, (am, posn, rest ++ ['-' : abbr : abbrs])) _ -> parseError usage ("unknown argument -" ++ [abbr])- aa -> case posn of- (ad@(Arg { argData = Just adata }) : ps) ->- let (argl', (am', _, rest')) =- peel_process (dataArgName adata) ad av- in (argl', (am', ps, rest'))- [] -> case acomplete of- ArgsComplete -> parseError usage- ("unexpected argument " ++ aa)- _ -> (aas, (am, [], rest ++ [aa]))+ _ ->+ case posn of+ (p : ps) ->+ let (_, req_posn) = partition arg_optional posn in+ case length av - length req_posn of+ n_extra | n_extra > 0 || (n_extra == 0 && arg_required p) ->+ let (args', am') = peel (dataArgName $ fromJust $ + argData p) p av in+ (args', (am', ps, rest))+ 0 -> (av, (am, ps, rest))+ _ -> parseError usage + "missing required positional argument(s)"+ [] -> ([], (am, [], rest ++ av)) where add_entry s m (k, a) = case Map.member k m of False -> Map.insert k a m True -> parseError usage ("duplicate argument " ++ s)- peel name ad@(Arg { argData = Nothing, argIndex = index }) argl =+ peel name (Arg { argData = Nothing, argIndex = index }) argl = let am' = add_entry name am (index, ArgvalFlag)- in (argl, (am', posn, rest))+ in (argl, am') peel name (Arg { argData = Just (DataArg {}) }) [] = parseError usage (name ++ " is missing its argument")- peel name ad argl = peel_process name ad argl- peel_process name- ad@(Arg { argData = Just (DataArg {- dataArgArgtype = atype }),- argIndex = index })- (a : argl) =- let read_arg constructor kind =- case reads a of- [(v, "")] -> constructor v- _ -> parseError usage ("argument " ++- a ++ " to " ++ name ++- " is not " ++ kind)- v = case atype of- ArgtypeString _ -> ArgvalString a- ArgtypeInteger _ -> read_arg ArgvalInteger- "an integer"- ArgtypeInt _ -> read_arg ArgvalInt "an int"- ArgtypeDouble _ -> read_arg ArgvalDouble "a double"- ArgtypeFloat _ -> read_arg ArgvalFloat "a float"- am' = add_entry name am (index, v)- in (argl, (am', posn, rest))+ peel name (Arg { argData = + Just (DataArg { dataArgArgtype = atype }),+ argIndex = index })+ (a : argl) =+ let v = case atype of+ ArgtypeString _ -> ArgvalString a+ ArgtypeInteger _ -> read_arg ArgvalInteger+ "an integer"+ ArgtypeInt _ -> read_arg ArgvalInt "an int"+ ArgtypeDouble _ -> read_arg ArgvalDouble "a double"+ ArgtypeFloat _ -> read_arg ArgvalFloat "a float"+ where+ read_arg constructor kind =+ case reads a of+ [(val, "")] -> constructor val+ _ -> parseError usage ("argument " +++ a ++ " to " ++ name +++ " is not " ++ kind)+ am' = add_entry name am (index, v)+ in (argl, am') -- |Most of the time, you just want the environment's -- arguments and are willing to live in the IO monad. -- This version of `parseArgs` digs the pathname and arguments -- out of the system directly.-parseArgsIO :: (Show a, Ord a) =>- ArgsComplete -- ^Degree of completeness of parse.+parseArgsIO :: (Show a, Ord a, APCData b) =>+ b -- ^Degree of completeness of parse. -> [ Arg a ] -- ^Argument descriptions. -> IO (Args a) -- ^Argument parse results.-parseArgsIO acomplete argd = do+parseArgsIO apcData argd = do argv <- getArgs pathname <- getProgName- return (parseArgs acomplete argd pathname argv)+ return (parseArgs apcData argd pathname argv) -- |Check whether a given optional argument was supplied. Works on all types.@@ -540,12 +584,13 @@ => Args a -- ^Parsed arguments. -> a -- ^Index of argument to be retrieved. -> b -- ^Argument value.- getRequiredArg args index =- case getArg args index of+ getRequiredArg ads index =+ case getArg ads index of Just v -> v Nothing -> error ("internal error: required argument " ++ show index ++ "not supplied") +getArgPrimitive :: Ord a => (Argval -> Maybe b) -> Args a -> a -> Maybe b getArgPrimitive decons (Args { args = ArgRecord am }) k = Map.lookup k am >>= decons @@ -608,8 +653,8 @@ } instance ArgType ArgFileOpener where- getArg args index =- getArg args index >>= + getArg ads index =+ getArg ads index >>= (\s -> return $ ArgFileOpener { argFileOpener = openFile s }) -- |[Deprecated] Treat the `String` value, if any, of the given argument as@@ -620,8 +665,8 @@ -> IOMode -- ^IO mode the file should be opened in. -> IO (Maybe Handle) -- ^Handle of opened file, if the argument -- was present.-getArgFile args k m =- case getArg args k of+getArgFile ads k m =+ case getArg ads k of Just fo -> (do h <- argFileOpener fo m; return (Just h)) Nothing -> return Nothing @@ -636,8 +681,8 @@ -> IOMode -- ^IO mode the file should be opened in. -- Must not be `ReadWriteMode`. -> IO Handle -- ^Appropriate file handle.-getArgStdio args k m =- case getArg args k of+getArgStdio ads k m =+ case getArg ads k of Just s -> openFile s m Nothing -> case m of@@ -664,4 +709,4 @@ -- |Generate a usage error with the given supplementary message string. usageError :: (Ord a) => Args a -> String -> b-usageError args msg = error (argsUsage args ++ "\n" ++ msg)+usageError ads msg = error (argsUsage ads ++ "\n" ++ msg)
parseargs-example.hs view
@@ -1,12 +1,8 @@ module Main where -import Prelude hiding (catch)--import Control.Exception import Control.Monad import Data.Maybe-import System.Environment import System.Console.ParseArgs @@ -14,6 +10,7 @@ OptionFlag | OptionFlagInt | OptionFlagString |+ OptionPreoptional | OptionFixed | OptionOptional deriving (Ord, Eq, Show)@@ -34,6 +31,11 @@ argAbbr = Nothing, argData = argDataDefaulted "test-value" ArgtypeInt 7, argDesc = "Test int flag" },+ Arg { argIndex = OptionPreoptional,+ argName = Nothing,+ argAbbr = Nothing,+ argData = argDataOptional "pre-optional" ArgtypeString,+ argDesc = "Test optional string before fixed" }, Arg { argIndex = OptionFixed, argName = Nothing, argAbbr = Nothing,@@ -45,19 +47,25 @@ argData = argDataOptional "optional" ArgtypeString, argDesc = "Test optional string" }] +main :: IO () main = do- args <- parseArgsIO (ArgsTrailing "junk") argd+ argv <- parseArgsIO + (ArgsParseControl (ArgsTrailing "junk") ArgsSoftDash) + argd putStrLn "parse successful"- when (gotArg args OptionFlag)+ when (gotArg argv OptionFlag) (putStrLn "saw flag")- case (getArg args OptionFlagString) of+ case (getArg argv OptionFlagString) of Just s -> putStrLn ("saw string " ++ s) Nothing -> return ()- case (getArg args OptionFlagInt) of+ case (getArg argv OptionFlagInt) of Just d -> putStrLn ("saw int " ++ (show (d::Int))) Nothing -> return ()- putStrLn ("saw fixed " ++ (fromJust (getArgString args OptionFixed)))- case (getArg args OptionOptional) of+ case (getArg argv OptionPreoptional) of+ Just s -> putStrLn ("saw pre-optional " ++ s)+ Nothing -> return ()+ putStrLn ("saw fixed " ++ (fromJust (getArgString argv OptionFixed)))+ case (getArg argv OptionOptional) of Just s -> putStrLn ("saw optional " ++ s) Nothing -> return ()- putStrLn ("saw rest: " ++ show (argsRest args))+ putStrLn ("saw rest: " ++ show (argsRest argv))
parseargs.cabal view
@@ -1,17 +1,18 @@ Name: parseargs Build-Type: Simple Description: Parse command-line arguments-Version: 0.1.3.5+-- Don't forget to bump the source-repository this below+Version: 0.1.5.2 Cabal-Version: >= 1.6 License: BSD3 License-File: COPYING Author: Bart Massey <bart@cs.pdx.edu> Copyright: Copyright (C) 2008 Bart Massey Maintainer: Bart Massey <bart@cs.pdx.edu>-Homepage: http://wiki.cs.pdx.edu/bartforge/parseargs-Category: System.Console+Homepage: http://github.com/BartMassey/parseargs+Category: Console Synopsis: Command-line argument parsing library for Haskell programs-Extra-Source-Files: README+Extra-Source-Files: README.md Library Build-Depends: base < 5, containers < 1@@ -24,9 +25,9 @@ Source-repository head Type: git- Location: git://svcs.cs.pdx.edu/git/parseargs.git+ Location: git://github.com/BartMassey/parseargs.git Source-repository this Type: git- Location: git://svcs.cs.pdx.edu/git/parseargs.git- Tag: v0.1.3.4+ Location: git://github.com/BartMassey/parseargs.git+ Tag: v0.1.5.2