diff --git a/README b/README deleted file mode 100644 --- a/README +++ /dev/null @@ -1,32 +0,0 @@ -parseargs -- command-line argument parsing for Haskell programs -version 0.1.3 -Bart Massey -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. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,50 @@ +# parseargs +Command-line argument parsing for Haskell programs +Bart Massey + +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. diff --git a/System/Console/ParseArgs.hs b/System/Console/ParseArgs.hs --- a/System/Console/ParseArgs.hs +++ b/System/Console/ParseArgs.hs @@ -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) diff --git a/parseargs-example.hs b/parseargs-example.hs --- a/parseargs-example.hs +++ b/parseargs-example.hs @@ -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)) diff --git a/parseargs.cabal b/parseargs.cabal --- a/parseargs.cabal +++ b/parseargs.cabal @@ -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 Copyright: Copyright (C) 2008 Bart Massey Maintainer: Bart Massey -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