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 +version 0.1.2 Bart Massey -8 March 2008 +28 September 2008 This library provides System.Console.Parseargs, a module to assist in argument parsing for Haskell stand-alone command @@ -13,11 +13,14 @@ 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 +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 Hackage-ready package, to the extent I know how to construct such. + +The 1.2 release includes a typeclass for argument types for +easier use. 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 @@ -1,3 +1,4 @@ +{-# LANGUAGE FlexibleInstances #-} -- Full-featured argument parsing library for Haskell programs -- Bart Massey @@ -14,20 +15,23 @@ -- PARTICULAR PURPOSE. -- |This module supplies an argument parser. --- Given a description of type ['Arg'] of the legal +-- 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 +-- 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. +-- `Args` data structure suitable for querying using the +-- provided functions `gotArg`, `getArg`, 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 + -- supplied as a list of `Arg` records, built up -- using the functions described here. - Argtype(..), DataArg, Arg(..), + Arg(..), + Argtype(..), ArgsComplete(..), + -- ** DataArg and its pseudo-constructors + DataArg, argDataRequired, argDataOptional, argDataDefaulted, -- * Argument processing -- |The argument descriptions are used to parse @@ -44,10 +48,11 @@ -- ** Using parse results -- |Query functions permit checking for the existence -- and values of command-line arguments. - gotArg, + gotArg, ArgType(..), getArgString, getArgFile, getArgStdio, getArgInteger, getArgInt, getArgDouble, getArgFloat, + ArgFileOpener(..), -- * Misc baseName, usageError, System.IO.IOMode(ReadMode, WriteMode, AppendMode)) @@ -68,38 +73,24 @@ -- 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 +-- 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; +-- one of `argAbbr` and `argName` is provided; -- -- (2) The argument is positional, in which case neither --- 'argAbbr' nor 'argName' are provided, but 'argData' is. +-- `argAbbr` nor `argName` are provided, but `argData` is. -- --- If none of 'argAbbr', 'argName', or 'argData' are +-- 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'. +-- `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. @@ -109,7 +100,58 @@ , argDesc :: String -- ^Documentation for the argument. } + +-- |The types of an argument carrying data. The constructor +-- argument is used to carry a default value. -- +-- The constructor argument should really be hidden. +-- Values of this type are normally constructed within +-- the pseudo-constructors pseudo-constructors +-- `argDataRequired`, `argDataOptional`, and +-- `argDataDefaulted`, to which only the constructor +-- function itself is passed. +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. This +-- is an opaque type, whose instances are constructed using the +-- pseudo-constructors `argDataRequired`, `argDataOptional`, +-- and `argDataDefaulted`. +data DataArg = DataArg { dataArgName :: String -- ^Print name of datum. + , dataArgArgtype :: Argtype -- ^Type of datum. + , dataArgOptional :: Bool -- ^Datum is not required. + } + +-- |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 }) +-- -- Returned datatypes. -- @@ -124,8 +166,8 @@ -- |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'. +-- |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. @@ -137,16 +179,6 @@ -- 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. @@ -263,7 +295,7 @@ -- |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 +-- When the function returns the empty list, `exhaust` returns -- the final state produced. exhaust :: (s -> [e] -> ([e], s)) -- ^Function to iterate. -> s -- ^Initial state. @@ -281,9 +313,12 @@ parse_error usage msg = error (usage ++ "\n" ++ msg) --- |Given a description of the arguments, 'parseArgs' produces +-- |Given a description of the arguments, `parseArgs` produces -- a map from the arguments to their \"values\" and some other --- useful byproducts. +-- 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. -> [ Arg a ] -- ^Argument descriptions. @@ -440,7 +475,7 @@ -- |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 +-- 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. @@ -462,122 +497,139 @@ Just _ -> True Nothing -> False --- |Return the String, if any, of the given argument. +-- |Type of values that can be parsed by the argument parser. +class ArgType b where + -- |Fetch an argument's value if it is present. + getArg :: (Show a, Ord a) + => Args a -- ^Parsed arguments. + -> a -- ^Index of argument to be retrieved. + -> Maybe b -- ^Argument value if present. + -- |Fetch the value of a required argument. + getRequiredArg :: (Show a, Ord a) + => Args a -- ^Parsed arguments. + -> a -- ^Index of argument to be retrieved. + -> b -- ^Argument value. + getRequiredArg args index = + case getArg args index of + Just v -> v + Nothing -> error ("internal error: required argument " + ++ show index ++ "not supplied") + +getArgPrimitive decons (Args { args = ArgRecord am }) k = + case Map.lookup k am of + Just v -> Just (decons v) + Nothing -> Nothing + +instance ArgType ([] Char) where + getArg = getArgPrimitive (\(ArgvalString s) -> s) + +-- |[Deprecated] Return the `String` value, 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 +getArgString = getArg --- |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") +instance ArgType Integer where + getArg = getArgPrimitive (\(ArgvalInteger i) -> i) --- |Return the Integer, if any, of the given argument. +-- |[Deprecated] Return the `Integer` value, 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)) +getArgInteger = getArg --- |Return the Int, if any, of the given argument. +instance ArgType Int where + getArg = getArgPrimitive (\(ArgvalInt i) -> i) + +-- |[Deprecated] Return the `Int` value, 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)) +getArgInt = getArg --- |Return the Double, if any, of the given argument. +instance ArgType Double where + getArg = getArgPrimitive (\(ArgvalDouble i) -> i) + +-- |[Deprecated] Return the `Double` value, 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)) +getArgDouble = getArg --- |Return the Float, if any, of the given argument. +instance ArgType Float where + getArg = getArgPrimitive (\(ArgvalFloat i) -> i) + +-- |[Deprecated] Return the `Float` value, 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)) +getArgFloat = getArg --- |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 }) +-- |`ArgType` instance for opening a file from its string name. +newtype ArgFileOpener = ArgFileOpener { + argFileOpener :: IOMode -> IO Handle -- ^Function to open the file + } --- |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 }) +instance ArgType ArgFileOpener where + getArg args index = + case getArg args index of + Nothing -> Nothing + Just s -> Just (ArgFileOpener { argFileOpener = openFile s }) --- |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 }) +-- |[Deprecated] Treat the `String` value, 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 getArg args k of + Just fo -> (do h <- argFileOpener fo m; return (Just h)) + Nothing -> return Nothing + + +-- |Treat the `String` value, 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 = + case getArg args k of + Just s -> openFile s m + Nothing -> + case m of + ReadMode -> return stdin + WriteMode -> return stdout + AppendMode -> return stdout + ReadWriteMode -> + error ("internal error: tried to open stdio " + ++ "in ReadWriteMode") + +--- +--- Misc +--- + +-- |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') + -- |Generate a usage error with the given supplementary message string. usageError :: (Ord a) => Args a -> String -> b diff --git a/parseargs-example.hs b/parseargs-example.hs --- a/parseargs-example.hs +++ b/parseargs-example.hs @@ -46,13 +46,13 @@ putStrLn "parse successful" when (gotArg args OptionFlag) (putStrLn "saw flag") - case (getArgString args OptionFlagString) of + case (getArg args OptionFlagString) of Just s -> putStrLn ("saw string " ++ s) Nothing -> return () - case (getArgInt args OptionFlagInt) of - Just d -> putStrLn ("saw int " ++ (show d)) + case (getArg args OptionFlagInt) of + Just d -> putStrLn ("saw int " ++ (show (d::Int))) Nothing -> return () putStrLn ("saw fixed " ++ (fromJust (getArgString args OptionFixed))) - case (getArgString args OptionOptional) of + case (getArg args OptionOptional) of Just s -> putStrLn ("saw optional " ++ s) Nothing -> return () diff --git a/parseargs.cabal b/parseargs.cabal --- a/parseargs.cabal +++ b/parseargs.cabal @@ -1,12 +1,12 @@ Name: parseargs Build-Type: Simple Description: Parse command-line arguments -Version: 0.1 +Version: 0.1.2 Cabal-Version: >= 1.2 License: BSD3 License-File: COPYING Author: Bart Massey -Copyright: Copyright (C) 2007 Bart Massey +Copyright: Copyright (C) 2008 Bart Massey Maintainer: Bart Massey Homepage: http://wiki.cs.pdx.edu/bartforge/parseargs Category: System.Console