diff --git a/COPYING b/COPYING new file mode 100644 --- /dev/null +++ b/COPYING @@ -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. diff --git a/README b/README new file mode 100644 --- /dev/null +++ b/README @@ -0,0 +1,27 @@ +parseargs -- command-line argument parsing for Haskell programs +version 0.1 +Bart Massey +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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/System/Console/ParseArgs.hs b/System/Console/ParseArgs.hs new file mode 100644 --- /dev/null +++ b/System/Console/ParseArgs.hs @@ -0,0 +1,584 @@ +-- Full-featured argument parsing library for Haskell programs +-- Bart Massey + +-- 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) diff --git a/parseargs-example.hs b/parseargs-example.hs new file mode 100644 --- /dev/null +++ b/parseargs-example.hs @@ -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 () diff --git a/parseargs.cabal b/parseargs.cabal new file mode 100644 --- /dev/null +++ b/parseargs.cabal @@ -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 +Copyright: Copyright (C) 2007 Bart Massey +Maintainer: Bart Massey +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