parseargs-0.1.3.2/0000755000000000000000000000000011521314255012027 5ustar0000000000000000parseargs-0.1.3.2/parseargs-example.hs0000644000000000000000000000400511521314255016002 0ustar0000000000000000module Main where import Prelude hiding (catch) import Control.Exception import Control.Monad import Data.Maybe import System.Environment import System.Console.ParseArgs 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 (ArgsTrailing "junk") argd putStrLn "parse successful" when (gotArg args OptionFlag) (putStrLn "saw flag") case (getArg args OptionFlagString) of Just s -> putStrLn ("saw string " ++ s) Nothing -> return () case (getArg args OptionFlagInt) of Just d -> putStrLn ("saw int " ++ (show (d::Int))) Nothing -> return () putStrLn ("saw fixed " ++ (fromJust (getArgString args OptionFixed))) case (getArg args OptionOptional) of Just s -> putStrLn ("saw optional " ++ s) Nothing -> return () putStrLn ("saw rest: " ++ show (argsRest args)) parseargs-0.1.3.2/COPYING0000644000000000000000000000274211521314255013067 0ustar0000000000000000Copyright © 2008 Bart Massey 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 copyright holders nor the names of contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS 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 COPYRIGHT HOLDERS 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. parseargs-0.1.3.2/README0000644000000000000000000000221211521314255012704 0ustar0000000000000000parseargs -- 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. parseargs-0.1.3.2/Setup.hs0000644000000000000000000000005611521314255013464 0ustar0000000000000000import Distribution.Simple main = defaultMain parseargs-0.1.3.2/parseargs.cabal0000644000000000000000000000125711521314255015007 0ustar0000000000000000Name: parseargs Build-Type: Simple Description: Parse command-line arguments Version: 0.1.3.2 Cabal-Version: >= 1.2 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 Synopsis: Command-line argument parsing library for Haskell programs Extra-Source-Files: README Library Build-Depends: base < 5, containers < 1 Exposed-Modules: System.Console.ParseArgs Executable parseargs-example Build-Depends: base < 5 Main-Is: parseargs-example.hs Other-Modules: System.Console.ParseArgs parseargs-0.1.3.2/System/0000755000000000000000000000000011521314255013313 5ustar0000000000000000parseargs-0.1.3.2/System/Console/0000755000000000000000000000000011521314255014715 5ustar0000000000000000parseargs-0.1.3.2/System/Console/ParseArgs.hs0000644000000000000000000006550211521314255017150 0ustar0000000000000000{-# LANGUAGE FlexibleInstances #-} -- Full-featured argument parsing library for Haskell programs -- Bart Massey -- Copyright © 2007-2010 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`, `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 -- using the functions described here. Arg(..), Argtype(..), ArgsComplete(..), -- ** DataArg and its pseudo-constructors DataArg, 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, ArgType(..), getArgString, getArgFile, getArgStdio, getArgInteger, getArgInt, getArgDouble, getArgFloat, ArgFileOpener(..), -- * Misc 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 Data.Maybe import Data.Typeable import System.Environment import System.IO -- The main job of this module is to provide parseArgs. -- See below for its contract. -- -- Provided datatypes. -- -- |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. } -- |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. -- -- |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. } -- -- 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. -- -- |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 String -- ^Trailing extraneous arguments are -- permitted, and will be skipped, -- saved, and returned. The -- constructor argument is the -- name of the args. | 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' -- |Generate a usage error with the given supplementary message string. parseError :: String -- ^Usage message. -> String -- ^Specific error message. -> a -- ^Bogus polymorphic result. 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. -> [ 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 -> parseError 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 = summary_line ++ arg_lines where flag_args = filter arg_flag argd posn_args = filter arg_posn argd n = maximum (map (length . arg_string) argd) --- 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 -> "" ArgsTrailing s -> " [--] [" ++ s ++ " ...]" ArgsInterspersed -> " ... [--] ...") ++ "\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 -> 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)") _ -> ([], (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])) _ -> parseError 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 ('-' : _) -> parseError usage ("bad internal '-' in argument " ++ aa) _ -> (['-' : abbrs] ++ args', state') Nothing -> case acomplete of ArgsInterspersed -> (['-' : abbrs] ++ aas, (am, posn, rest ++ [['-', abbr]])) _ -> 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])) 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 = let am' = add_entry name am (index, ArgvalFlag) in (argl, (am', posn, rest)) 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)) -- |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 -- |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 = getArg instance ArgType Integer where getArg = getArgPrimitive (\(ArgvalInteger i) -> i) -- |[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 = getArg 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 = getArg 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 = getArg 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 = getArg -- |`ArgType` instance for opening a file from its string name. newtype ArgFileOpener = ArgFileOpener { argFileOpener :: IOMode -> IO Handle -- ^Function to open the file } instance ArgType ArgFileOpener where getArg args index = case getArg args index of Nothing -> Nothing Just s -> Just (ArgFileOpener { argFileOpener = openFile s }) -- |[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 usageError args msg = error (argsUsage args ++ "\n" ++ msg)