diff --git a/README b/README --- a/README +++ b/README @@ -1,7 +1,7 @@ parseargs -- command-line argument parsing for Haskell programs -version 0.1.2 +version 0.1.3 Bart Massey -28 September 2008 +25 February 2010 This library provides System.Console.Parseargs, a module to assist in argument parsing for Haskell stand-alone command @@ -13,14 +13,16 @@ 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, ghc 6.8, and current GHC -on Linux, although the current cabal setup has only been -tested with cabal 1.2 and ghc 6.8. It is a fairly standard +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 1.2 release includes a typeclass for argument types for +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 diff --git a/System/Console/ParseArgs.hs b/System/Console/ParseArgs.hs --- a/System/Console/ParseArgs.hs +++ b/System/Console/ParseArgs.hs @@ -2,7 +2,7 @@ -- Full-featured argument parsing library for Haskell programs -- Bart Massey --- Copyright (C) 2007 Bart Massey +-- Copyright © 2007-2010 Bart Massey -- ALL RIGHTS RESERVED -- You can redistribute and/or modify this library under the @@ -54,16 +54,19 @@ getArgDouble, getArgFloat, ArgFileOpener(..), -- * Misc - baseName, usageError, + ParseArgsException(..), + baseName, parseError, usageError, System.IO.IOMode(ReadMode, WriteMode, AppendMode)) where +import Control.Exception +import Control.Monad +import Control.Monad.ST import Data.List import qualified Data.Map as Map -import Control.Monad import Data.Maybe +import Data.Typeable import System.Environment -import Control.Monad.ST import System.IO -- The main job of this module is to provide parseArgs. @@ -176,6 +179,26 @@ } -- +-- Exception type. +-- + +-- |This exception is raised with an appropriate error message +-- when argument parsing fails. The first argument is the usage +-- message, the second the actual error message from the parser. +data ParseArgsException = ParseArgsException String String + deriving Eq + +instance Typeable ParseArgsException where + typeOf _ = mkTyConApp e [s, s] where + e = mkTyCon "ParseArgsException" + s = typeOf "" + +instance Exception ParseArgsException + +instance Show ParseArgsException where + show (ParseArgsException usage msg) = msg ++ "\n" ++ usage + +-- -- Implementation. -- @@ -306,12 +329,12 @@ let (l', s') = f s l in exhaust f s' l' --- |Print an error message during parsing. -parse_error :: String -- ^Usage message. +-- |Generate a usage error with the given supplementary message string. +parseError :: String -- ^Usage message. -> String -- ^Specific error message. -> a -- ^Bogus polymorphic result. -parse_error usage msg = - error (usage ++ "\n" ++ msg) +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 @@ -355,7 +378,7 @@ check_present usage am ad@(Arg { argIndex = k }) = case Map.lookup k am of Just _ -> True - Nothing -> parse_error usage ("missing required argument " ++ + Nothing -> parseError usage ("missing required argument " ++ (arg_string ad)) --- Check for various possible misuses. check_argd :: ST s () @@ -379,37 +402,41 @@ 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) + summary_line ++ arg_lines 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" + --- top (summary) line + 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 + arg_lines = concatMap (arg_line n) argd where + 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" + 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 -> parse_error usage + ArgsComplete -> parseError usage ("unexpected -- " ++ "(extra arguments not allowed)") _ -> ([], (am, posn, (rest ++ aas))) @@ -420,7 +447,7 @@ case acomplete of ArgsInterspersed -> (aas, (am, posn, rest ++ ["--" ++ name])) - _ -> parse_error usage + _ -> parseError usage ("unknown argument --" ++ name) ('-' : abbr : abbrs) -> case Map.lookup abbr abbr_hash of @@ -428,7 +455,7 @@ let p@(args', state') = peel ['-', abbr] ad aas in case abbrs of [] -> p - ('-' : _) -> parse_error usage + ('-' : _) -> parseError usage ("bad internal '-' in argument " ++ aa) _ -> (['-' : abbrs] ++ args', state') Nothing -> @@ -436,7 +463,7 @@ ArgsInterspersed -> (['-' : abbrs] ++ aas, (am, posn, rest ++ [['-', abbr]])) - _ -> parse_error usage + _ -> parseError usage ("unknown argument -" ++ [abbr]) aa -> case posn of (ad@(Arg { argData = Just adata }) : ps) -> @@ -444,31 +471,38 @@ peel_process (dataArgName adata) ad av in (argl', (am', ps, rest')) [] -> case acomplete of - ArgsComplete -> parse_error usage + ArgsComplete -> parseError 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) + True -> parseError 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") + 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 v = case atype of + 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 _ -> ArgvalInteger (read a) - ArgtypeInt _ -> ArgvalInt (read a) - ArgtypeDouble _ -> ArgvalDouble (read a) - ArgtypeFloat _ -> ArgvalFloat (read 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)) diff --git a/parseargs-example.hs b/parseargs-example.hs --- a/parseargs-example.hs +++ b/parseargs-example.hs @@ -1,10 +1,14 @@ module Main where -import System.Console.ParseArgs -import System.Environment +import Prelude hiding (catch) + +import Control.Exception import Control.Monad import Data.Maybe +import System.Environment + +import System.Console.ParseArgs data Options = OptionFlag | diff --git a/parseargs.cabal b/parseargs.cabal --- a/parseargs.cabal +++ b/parseargs.cabal @@ -1,7 +1,7 @@ Name: parseargs Build-Type: Simple Description: Parse command-line arguments -Version: 0.1.2 +Version: 0.1.3 Cabal-Version: >= 1.2 License: BSD3 License-File: COPYING @@ -15,10 +15,10 @@ Extra-Source-Files: README Library - Build-Depends: base + Build-Depends: base <= 5 Exposed-Modules: System.Console.ParseArgs Executable parseargs-example - Build-Depends: base, containers + Build-Depends: base <= 5, containers <= 0.4 Main-Is: parseargs-example.hs Other-Modules: System.Console.ParseArgs