parseargs (empty) → 0.1
raw patch · 6 files changed
+721/−0 lines, 6 filesdep +basedep +containerssetup-changed
Dependencies added: base, containers
Files
- COPYING +26/−0
- README +27/−0
- Setup.hs +2/−0
- System/Console/ParseArgs.hs +584/−0
- parseargs-example.hs +58/−0
- parseargs.cabal +24/−0
+ COPYING view
@@ -0,0 +1,26 @@+Copyright (c) The Regents of the University of California.+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:+1. Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.+2. Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in the+ documentation and/or other materials provided with the distribution.+3. Neither the name of the University nor the names of its contributors+ may be used to endorse or promote products derived from this software+ without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF+SUCH DAMAGE.
+ README view
@@ -0,0 +1,27 @@+parseargs -- command-line argument parsing for Haskell programs+version 0.1+Bart Massey <bart@cs.pdx.edu>+8 March 2008++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 and ghc 6.8 on Linux,+although the current cabal setup has only been tested with+cabal 1.2 and ghc 6.8. It is a fairly standard+Hackage-ready package, to the extent I know how to construct+such.++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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ System/Console/ParseArgs.hs view
@@ -0,0 +1,584 @@+-- Full-featured argument parsing library for Haskell programs+-- Bart Massey <bart@cs.pdx.edu>++-- Copyright (C) 2007 Bart Massey+-- ALL RIGHTS RESERVED++-- You can redistribute and/or modify this library under the+-- terms of the "3-clause BSD LICENSE", as stated in the file+-- COPYING in the top-level directory of this distribution.+-- +-- This library is distributed in the hope that it will be+-- useful, but WITHOUT ANY WARRANTY; without even the+-- implied warranty of MERCHANTABILITY or FITNESS FOR A+-- PARTICULAR PURPOSE.++-- |This module supplies an argument parser.+-- Given a description of type ['Arg'] of the legal+-- arguments to the program, a list of argument strings,+-- and a bit of extra information, the 'parseArgs' function+-- in this module returns an+-- 'Args' data structure suitable for querying using the+-- provided functions 'gotArg', 'getArgString', etc.+module System.Console.ParseArgs (+ -- * Describing allowed arguments+ -- |The argument parser requires a description of+ -- the arguments that will be parsed. This is+ -- supplied as a list of 'Arg' records, built up+ -- using the functions described here.+ Argtype(..), DataArg, Arg(..),+ ArgsComplete(..),+ argDataRequired, argDataOptional, argDataDefaulted,+ -- * Argument processing+ -- |The argument descriptions are used to parse+ -- the command line arguments, and the results+ -- of the parse can later be (efficiently) queried+ -- to determine program behavior.++ -- ** Getting parse results+ -- |The argument parser returns an opaque map+ -- from argument index to parsed argument data+ -- (plus some convenience information).+ ArgRecord, Args(..),+ parseArgs, parseArgsIO,+ -- ** Using parse results+ -- |Query functions permit checking for the existence+ -- and values of command-line arguments.+ gotArg,+ getArgString, getArgFile, getArgStdio,+ getArgInteger, getArgInt,+ getArgDouble, getArgFloat,+ -- * Misc+ baseName, usageError,+ System.IO.IOMode(ReadMode, WriteMode, AppendMode))+where++import Data.List+import qualified Data.Map as Map+import Control.Monad+import Data.Maybe+import System.Environment+import Control.Monad.ST+import System.IO++-- The main job of this module is to provide parseArgs.+-- See below for its contract.++--+-- Provided datatypes.+--++-- |The types of arguments carrying data;+-- the constructor arguments are for default values.+data Argtype = ArgtypeString (Maybe String)+ | ArgtypeInteger (Maybe Integer)+ | ArgtypeInt (Maybe Int)+ | ArgtypeDouble (Maybe Double)+ | ArgtypeFloat (Maybe Float)++-- |Information specific to an argument carrying a datum.+data DataArg = DataArg { dataArgName :: String -- ^Print name of datum.+ , dataArgArgtype :: Argtype -- ^Type of datum.+ , dataArgOptional :: Bool -- ^Datum is not required.+ }++-- |The description of an argument, suitable for+-- messages and for parsing. The 'argData' field+-- is used both for flags with a data argument, and+-- for positional data arguments.+-- +-- There are two cases:+--+-- (1) The argument is a flag, in which case at least+-- one of 'argAbbr' and 'argName' is provided;+--+-- (2) The argument is positional, in which case neither+-- 'argAbbr' nor 'argName' are provided, but 'argData' is.+-- +-- If none of 'argAbbr', 'argName', or 'argData' are+-- provided, this is an error. See also the+-- 'argDataRequired', 'argDataOptional', and+-- 'argDataDefaulted' functions below, which are used to+-- generate 'argData'.+data (Ord a) => Arg a =+ Arg { argIndex :: a -- ^Connects the input description+ -- to the output argument.+ , argAbbr :: Maybe Char -- ^One-character flag name.+ , argName :: Maybe String -- ^\"Long name\" of flag.+ , argData :: Maybe DataArg -- ^Datum description.+ , argDesc :: String -- ^Documentation for the argument.+ } ++--+-- Returned datatypes.+--++-- |The \"kinds of values\" an argument can have.+data Argval = ArgvalFlag -- ^For simple present vs not-present flags.+ | ArgvalString String+ | ArgvalInteger Integer+ | ArgvalInt Int+ | ArgvalDouble Double+ | ArgvalFloat Float++-- |The type of the mapping from argument index to value.+newtype ArgRecord a = ArgRecord (Map.Map a Argval)++-- |The data structure 'parseArgs' produces. The key+-- element is the 'ArgRecord' 'args'.+data (Ord a) => Args a =+ Args { args :: ArgRecord a -- ^The argument map.+ , argsProgName :: String -- ^Basename of 0th argument.+ , argsUsage :: String -- ^Full usage string.+ , argsRest :: [ String ] -- ^Remaining unprocessed arguments.+ }++--+-- Implementation.+--++-- |Return the filename part of a pathname.+-- Unnecessarily efficient implementation does a single+-- tail-call traversal with no construction.+baseName :: String -- ^Pathname.+ -> String -- ^Rightmost component of pathname.+baseName s =+ let s' = dropWhile (/= '/') s in+ if null s' then s else baseName (tail s')+++-- |True if the described argument is positional.+arg_posn :: (Ord a) =>+ Arg a -- ^Argument.+ -> Bool -- ^True if argument is positional.+arg_posn (Arg { argAbbr = Nothing,+ argName = Nothing }) = True+arg_posn _ = False++-- |True if the described argument is a flag.+arg_flag :: (Ord a) =>+ Arg a -- ^Argument.+ -> Bool -- ^True if argument is a flag.+arg_flag a = not (arg_posn a)++-- |True if the described argument is optional.+arg_optional :: (Ord a) =>+ Arg a -- ^Argument.+ -> Bool -- ^False if argument is required to be present.+arg_optional (Arg { argData = Just (DataArg { dataArgOptional = b }) }) = b+arg_optional _ = True++-- |Return the value of a defaulted argument.+arg_default_value :: (Ord a)+ => Arg a -- ^Argument.+ -> Maybe Argval -- ^Optional default value.+arg_default_value arg@(Arg { argData = Just+ (DataArg { dataArgArgtype = da }) }) |+ arg_optional arg =+ defval da+ where+ defval (ArgtypeString (Just v)) = Just (ArgvalString v)+ defval (ArgtypeInteger (Just v)) = Just (ArgvalInteger v)+ defval (ArgtypeInt (Just v)) = Just (ArgvalInt v)+ defval (ArgtypeDouble (Just v)) = Just (ArgvalDouble v)+ defval (ArgtypeFloat (Just v)) = Just (ArgvalFloat v)+ defval _ = Nothing+arg_default_value _ = Nothing++-- |There's probably a better way to do this.+perhaps b s = if b then s else ""++-- |Format the described argument as a string.+arg_string :: (Ord a) =>+ Arg a -- ^Argument to be described.+ -> String -- ^String describing argument.+arg_string a@(Arg { argAbbr = abbr,+ argName = name,+ argData = arg }) =+ (optionally "[") +++ (sometimes flag_abbr abbr) +++ (perhaps ((isJust abbr) && (isJust name)) ",") +++ (sometimes flag_name name) +++ (perhaps ((arg_flag a) && (isJust arg)) " ") +++ (sometimes data_arg arg) +++ (optionally "]")+ where+ sometimes = maybe ""+ optionally s = perhaps (arg_optional a) s+ flag_name s = "--" ++ s+ flag_abbr c = [ '-', c ]+ data_arg (DataArg {dataArgName = s}) = "<" ++ s ++ ">"++-- |Filter out the empty keys for a hash.+filter_keys :: [ (Maybe a, b) ] -- ^List of (optional key, value) pairs.+ -> [ (a, b) ] -- ^Pairs with actual keys.+filter_keys l =+ foldr check_key [] l+ where+ check_key (Nothing, _) rest = rest+ check_key (Just k, v) rest = (k, v) : rest++-- |Fail with an error if the argument description is bad+-- for some reason.+argdesc_error :: String -- ^Error message.+ -> a -- ^Bogus polymorphic result.+argdesc_error msg =+ error ("internal error: argument description: " ++ msg)++-- |Make a keymap.+keymap_from_list :: (Ord k, Show k) =>+ [ (k, a) ] -- ^List of key-value pairs.+ -- Will be checked for duplicate keys.+ -> Map.Map k a -- ^Key-value map.+keymap_from_list l =+ foldl add_entry Map.empty l+ where+ add_entry m (k, a) = + case Map.member k m of+ False -> Map.insert k a m+ True -> argdesc_error ("duplicate argument description name " +++ (show k))++-- |Make a keymap for looking up a flag argument.+make_keymap :: (Ord a, Ord k, Show k) =>+ ((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 =+ (keymap_from_list .+ filter_keys .+ map (\arg -> (f_field arg, arg))) args++-- |How \"sloppy\" the parse is.+data ArgsComplete = ArgsComplete -- ^Any extraneous arguments+ -- (unparseable from description)+ -- will cause the parser to fail.+ | ArgsTrailing -- ^Trailing extraneous arguments are+ -- permitted, and will be skipped,+ -- saved, and returned.+ | ArgsInterspersed -- ^All extraneous arguments are+ -- permitted, and will be skipped,+ -- saved, and returned.++-- |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.+exhaust :: (s -> [e] -> ([e], s)) -- ^Function to iterate.+ -> s -- ^Initial state.+ -> [e] -- ^Initial list.+ -> s -- ^Final state.+exhaust f s [] = s+exhaust f s l =+ let (l', s') = f s l+ in exhaust f s' l'++-- |Print an error message during parsing.+parse_error :: String -- ^Usage message.+ -> String -- ^Specific error message.+ -> a -- ^Bogus polymorphic result.+parse_error usage msg =+ error (usage ++ "\n" ++ msg)++-- |Given a description of the arguments, 'parseArgs' produces+-- a map from the arguments to their \"values\" and some other+-- useful byproducts.+parseArgs :: (Show a, Ord a) =>+ ArgsComplete -- ^Degree of completeness of 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 =+ runST (do+ check_argd+ let flag_args = takeWhile arg_flag argd+ let posn_args = dropWhile 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 required_args = filter (not . arg_optional) argd+ unless (and (map (check_present usage am) required_args))+ (error "internal error")+ let am' = foldl supply_defaults am argd+ return (Args { args = ArgRecord am',+ argsProgName = prog_name,+ argsUsage = usage,+ argsRest = rest }))+ where+ supply_defaults am ad@(Arg { argIndex = k }) =+ case Map.lookup k am of+ Just _ -> am+ Nothing -> case arg_default_value ad of+ Just v -> Map.insert k v am+ Nothing -> am+ check_present usage am ad@(Arg { argIndex = k }) =+ case Map.lookup k am of+ Just _ -> True+ Nothing -> parse_error usage ("missing required argument " +++ (arg_string ad))+ --- 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")+ --- 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+ arg_nullary _ = False+ --- Generate a usage message string+ make_usage_string prog_name =+ --- top (summary) line+ ("usage: " ++ prog_name) +++ (perhaps (not (null flag_args))+ " [options]") +++ (perhaps (not (null posn_args))+ (" " ++ (unwords (map arg_string posn_args)))) +++ (case acomplete of+ ArgsComplete -> ""+ _ -> " [--] ...") +++ "\n" +++ --- argument lines+ (concatMap (arg_line n) argd)+ where+ flag_args = filter arg_flag argd+ posn_args = filter arg_posn argd+ n = maximum (map (length . arg_string) argd)+ arg_line n a =+ let s = arg_string a in+ " " ++ s ++ + (replicate (n - (length s)) ' ') +++ " " ++ (argDesc a) ++ "\n"+ --- simple recursive-descent parser+ parse _ _ _ av@(_, _, []) [] = ([], av)+ parse usage _ _ av [] =+ case acomplete of+ ArgsComplete -> parse_error usage "unexpected extra arguments"+ _ -> ([], av)+ parse usage name_hash abbr_hash (am, posn, rest) av@(aa : aas) =+ case aa of+ "--" -> case acomplete of+ ArgsComplete -> parse_error usage+ ("unexpected -- " +++ "(extra arguments not allowed)")+ _ -> ([], (am, posn, (rest ++ aas)))+ s@('-' : '-' : name) ->+ case Map.lookup name name_hash of+ Just ad -> peel s ad aas+ Nothing ->+ case acomplete of+ ArgsInterspersed ->+ (aas, (am, posn, rest ++ ["--" ++ name]))+ _ -> parse_error usage+ ("unknown argument --" ++ name)+ ('-' : abbr : abbrs) ->+ case Map.lookup abbr abbr_hash of+ Just ad ->+ let p@(args', state') = peel ['-', abbr] ad aas+ in case abbrs of+ [] -> p+ ('-' : _) -> parse_error usage+ ("bad internal '-' in argument " ++ aa)+ _ -> (['-' : abbrs] ++ args', state')+ Nothing ->+ case acomplete of+ ArgsInterspersed ->+ (['-' : abbrs] ++ aas,+ (am, posn, rest ++ [['-', abbr]]))+ _ -> parse_error 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 -> parse_error usage+ ("unexpected argument " ++ aa)+ _ -> (aas, (am, [], rest ++ [aa]))+ where+ add_entry s m (k, a) =+ case Map.member k m of+ False -> Map.insert k a m+ True -> parse_error usage ("duplicate argument " ++ s)+ peel name ad@(Arg { argData = Nothing, argIndex = index }) argl =+ let am' = add_entry name am (index, ArgvalFlag)+ in (argl, (am', posn, rest))+ peel name (Arg { argData = Just (DataArg {}) }) [] =+ parse_error 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 v = case atype of+ ArgtypeString _ -> ArgvalString a+ ArgtypeInteger _ -> ArgvalInteger (read a)+ ArgtypeInt _ -> ArgvalInt (read a)+ ArgtypeDouble _ -> ArgvalDouble (read a)+ ArgtypeFloat _ -> ArgvalFloat (read a)+ am' = add_entry name am (index, v)+ in (argl, (am', posn, rest))+++-- |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.+ -> [ Arg a ] -- ^Argument descriptions.+ -> IO (Args a) -- ^Argument parse results.+parseArgsIO acomplete argd = do+ argv <- getArgs+ pathname <- getProgName+ return (parseArgs acomplete argd pathname argv)+++-- |Check whether a given optional argument was supplied. Works on all types.+gotArg :: (Ord a) =>+ Args a -- ^Parsed arguments.+ -> a -- ^Index of argument to be checked for.+ -> Bool -- ^True if the arg was present.+gotArg (Args { args = ArgRecord am }) k =+ case Map.lookup k am of+ Just _ -> True+ Nothing -> False++-- |Return the String, if any, of the given argument.+getArgString :: (Show a, Ord a) =>+ Args a -- ^Parsed arguments.+ -> a -- ^Index of argument to be retrieved.+ -> Maybe String -- ^Argument value if present.+getArgString (Args { args = ArgRecord am }) k =+ case Map.lookup k am of+ Just (ArgvalString s) -> Just s+ Nothing -> Nothing+ _ -> error ("internal error: getArgString " ++ (show k))++-- |Treat the 'String', if any, of the given argument as+-- a file handle and try to open it as requested.+getArgFile :: (Show a, Ord a) =>+ Args a -- ^Parsed arguments.+ -> a -- ^Index of argument to be retrieved.+ -> 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 getArgString args k of+ Just s -> do+ h <- openFile s m+ return (Just h)+ Nothing -> return Nothing++-- |Treat the 'String', if any, of the given argument as a+-- file handle and try to open it as requested. If not+-- present, substitute the appropriate one of stdin or+-- stdout as indicated by 'IOMode'.+getArgStdio :: (Show a, Ord a) =>+ Args a -- ^Parsed arguments.+ -> a -- ^Index of argument to be retrieved.+ -> IOMode -- ^IO mode the file should be opened in.+ -- Must not be 'ReadWriteMode'.+ -> IO Handle -- ^Appropriate file handle.+getArgStdio args k m = do+ mh <- getArgFile args k m+ case mh of+ Just h -> return h+ Nothing -> case m of+ ReadMode -> return stdin+ WriteMode -> return stdout+ AppendMode -> return stdout+ ReadWriteMode -> error ("internal error: getArgStdio " +++ "called with ReadWriteMode")++-- |Return the Integer, if any, of the given argument.+getArgInteger :: (Show a, Ord a) =>+ Args a -- ^Parsed arguments.+ -> a -- ^Index of argument to be retrieved.+ -> Maybe Integer -- ^Argument value if present.+getArgInteger (Args { args = ArgRecord am }) k =+ case Map.lookup k am of+ Just (ArgvalInteger s) -> Just s+ Nothing -> Nothing+ _ -> error ("internal error: getArgInteger " ++ (show k))++-- |Return the Int, if any, of the given argument.+getArgInt :: (Show a, Ord a) =>+ Args a -- ^Parsed arguments.+ -> a -- ^Index of argument to be retrieved.+ -> Maybe Int -- ^Argument value if present.+getArgInt (Args { args = ArgRecord am }) k =+ case Map.lookup k am of+ Just (ArgvalInt s) -> Just s+ Nothing -> Nothing+ _ -> error ("internal error: getArgInt " ++ (show k))++-- |Return the Double, if any, of the given argument.+getArgDouble :: (Show a, Ord a) =>+ Args a -- ^Parsed arguments.+ -> a -- ^Index of argument to be retrieved.+ -> Maybe Double -- ^Argument value if present.+getArgDouble (Args { args = ArgRecord am }) k =+ case Map.lookup k am of+ Just (ArgvalDouble s) -> Just s+ Nothing -> Nothing+ _ -> error ("internal error: getArgDouble " ++ (show k))++-- |Return the Float, if any, of the given argument.+getArgFloat :: (Show a, Ord a) =>+ Args a -- ^Parsed arguments.+ -> a -- ^Index of argument to be retrieved.+ -> Maybe Float -- ^Argument value if present.+getArgFloat (Args { args = ArgRecord am }) k =+ case Map.lookup k am of+ Just (ArgvalFloat s) -> Just s+ Nothing -> Nothing+ _ -> error ("internal error: getArgFloat " ++ (show k))++-- |Generate the 'argData' for the given non-optional argument.+argDataRequired :: String -- ^Datum print name.+ -> (Maybe a -> Argtype) -- ^Type constructor for datum.+ -> Maybe DataArg -- ^Result is 'argData'-ready.+argDataRequired s c = Just (DataArg { dataArgName = s,+ dataArgArgtype = c Nothing,+ dataArgOptional = False })++-- |Generate the 'argData' for the given optional argument with no default.+argDataOptional :: String -- ^Datum print name.+ -> (Maybe a -> Argtype) -- ^Type constructor for datum.+ -> Maybe DataArg -- ^Result is 'argData'-ready.+argDataOptional s c = Just (DataArg { dataArgName = s,+ dataArgArgtype = c Nothing,+ dataArgOptional = True })++-- |Generate the 'argData' for the given optional argument with the+-- given default.+argDataDefaulted :: String -- ^Datum print name.+ -> (Maybe a -> Argtype) -- ^Type constructor for datum.+ -> a -- ^Datum default value.+ -> Maybe DataArg -- ^Result is 'argData'-ready.+argDataDefaulted s c d = Just (DataArg { dataArgName = s,+ dataArgArgtype = c (Just d),+ dataArgOptional = True })++-- |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)
+ parseargs-example.hs view
@@ -0,0 +1,58 @@+module Main+where++import System.Console.ParseArgs+import System.Environment+import Control.Monad+import Data.Maybe++data Options =+ OptionFlag |+ OptionFlagInt |+ OptionFlagString |+ OptionFixed |+ OptionOptional+ deriving (Ord, Eq, Show)++argd :: [ Arg Options ]+argd = [ Arg { argIndex = OptionFlag,+ argName = Just "flag",+ argAbbr = Just 'f',+ argData = Nothing,+ argDesc = "Test flag" },+ Arg { argIndex = OptionFlagString,+ argName = Just "string-flag",+ argAbbr = Just 's',+ argData = argDataOptional "test-value" ArgtypeString,+ argDesc = "Test string flag" },+ Arg { argIndex = OptionFlagInt,+ argName = Just "int-flag",+ argAbbr = Nothing,+ argData = argDataDefaulted "test-value" ArgtypeInt 7,+ argDesc = "Test int flag" },+ Arg { argIndex = OptionFixed,+ argName = Nothing,+ argAbbr = Nothing,+ argData = argDataRequired "fixed" ArgtypeString,+ argDesc = "Test fixed string" },+ Arg { argIndex = OptionOptional,+ argName = Nothing,+ argAbbr = Nothing,+ argData = argDataOptional "optional" ArgtypeString,+ argDesc = "Test optional string" }]++main = do+ args <- parseArgsIO ArgsComplete argd+ putStrLn "parse successful"+ when (gotArg args OptionFlag)+ (putStrLn "saw flag")+ case (getArgString args OptionFlagString) of+ Just s -> putStrLn ("saw string " ++ s)+ Nothing -> return ()+ case (getArgInt args OptionFlagInt) of+ Just d -> putStrLn ("saw int " ++ (show d))+ Nothing -> return ()+ putStrLn ("saw fixed " ++ (fromJust (getArgString args OptionFixed)))+ case (getArgString args OptionOptional) of+ Just s -> putStrLn ("saw optional " ++ s)+ Nothing -> return ()
+ parseargs.cabal view
@@ -0,0 +1,24 @@+Name: parseargs+Build-Type: Simple+Description: Parse command-line arguments+Version: 0.1+Cabal-Version: >= 1.2+License: BSD3+License-File: COPYING+Author: Bart Massey <bart@cs.pdx.edu>+Copyright: Copyright (C) 2007 Bart Massey+Maintainer: Bart Massey <bart@cs.pdx.edu>+Homepage: http://wiki.cs.pdx.edu/bartforge/parseargs+Category: System.Console+Synopsis: Command-line argument parsing library for Haskell programs+Stability: Alpha+Extra-Source-Files: README++Library+ Build-Depends: base+ Exposed-Modules: System.Console.ParseArgs++Executable parseargs-example+ Build-Depends: base, containers+ Main-Is: parseargs-example.hs+ Other-Modules: System.Console.ParseArgs