packages feed

parseargs 0.1.3.5 → 0.2.0.9

raw patch · 14 files changed

Files

COPYING view
@@ -1,4 +1,6 @@-Copyright © 2008 Bart Massey+Copyright © 2007 Bart Massey++[This program is licensed under the "3-clause ('new') BSD License"]  Redistribution and use in source and binary forms, with or without modification, are permitted provided that the
− README
@@ -1,32 +0,0 @@-parseargs -- command-line argument parsing for Haskell programs-version 0.1.3-Bart Massey <bart@cs.pdx.edu>-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.
+ README.md view
@@ -0,0 +1,72 @@+# parseargs: Command-line argument parsing for Haskell programs+Copyright (c) 2007 Bart Massey++This library provides System.Console.Parseargs, a module to+assist in argument parsing for Haskell stand-alone command+line programs.++The package provides a Haskell command-line argument+"parser".  You supply a specification of the arguments to+your command-line program; `parseargs` reads the arguments+and checks that they meet your spec. It then fills in a data+structure that captures the relevant data, 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 and later on Linux.  It+is a fairly standard Hackage-ready package, to the extent I+know how to construct such.++This library is not what I set out to build.  It definitely+could also use some work.  However, I use it all the time+for writing little programs. I thought others might find it+useful, and I also have released other code that depends on+it, so I put it out there.++Have fun with it, and let me know if there are problems.++## Release History++* 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.++* The various 0.1.3.x point releases include bug fixes and+various extra-minor enhancements. See the Git log.++* The 0.1.4 release includes the ability to mix optional and+required positional arguments.++* The 0.1.5 release includes the "soft dash" option, giving+the ability to allow positional arguments to begin with a+dash if possible.++* The 0.1.5.1 release fixes some warnings and stuff.++* The 0.1.5.2 release fixes some missing documentation.++* The 0.2 release cleans up some namespace pollution by+removing `ArgRecord` and the `args` accessor from the public+namespace.  This allows the use of the name `args` by the+user to describe program arguments.++* The 0.2.0.1 release cleans up a bunch of documentation nits+and cleans up copyright notices and license information.++* The 0.2.0.2 release fixes the botched release of 0.2.0.1. Sigh.++* The 0.2.0.3 release fixes the missing `Args` constructor+documentation of 0.2.0.2.++* The 0.2.0.4 release suppresses a GHC 7.10 warning for `Control.Monad.Safe`.++* Subsequent releases are maintenance for new GHC, Cabal and+  Stackage stuff.++## License++This program is licensed under the "3-clause ('new') BSD+License".  Please see the file COPYING in this distribution+for license terms.
System/Console/ParseArgs.hs view
@@ -1,26 +1,28 @@-{-# LANGUAGE FlexibleInstances, DeriveDataTypeable #-}--- Full-featured argument parsing library for Haskell programs--- Bart Massey <bart@cs.pdx.edu>---- 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.+{-# LANGUAGE FlexibleInstances, DeriveDataTypeable, CPP #-}+#if __GLASGOW_HASKELL__ > 720+{-# LANGUAGE Safe #-}+#endif+------------------------------------------------------------+-- |+-- Module      :  System.Console.ParseArgs+-- Description :  Full-featured command-line argument parsing library.+-- Copyright   :  (c) 2007 Bart Massey+-- License     :  BSD-style (see the file COPYING)+-- Maintainer  :  Bart Massey <bart.massey@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- `ParseArgs` is a full-featured command-line argument+-- parsing library.+--+-- 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.+------------------------------------------------------------ --- |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@@ -30,6 +32,9 @@   Arg(..),   Argtype(..),    ArgsComplete(..),+  ArgsDash(..),+  APCData(..),+  ArgsParseControl(..),   -- ** DataArg and its pseudo-constructors   DataArg,   argDataRequired, argDataOptional, argDataDefaulted,@@ -43,7 +48,7 @@   -- |The argument parser returns an opaque map   -- from argument index to parsed argument data   -- (plus some convenience information).-  ArgRecord, Args(..),+  Args(..),   parseArgs, parseArgsIO,   -- ** Using parse results   -- |Query functions permit checking for the existence@@ -169,10 +174,12 @@ -- |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. There is a should-be-hidden+-- field that describes the parse. data (Ord a) => Args a =-    Args { args :: ArgRecord a      -- ^The argument map.+    Args { __args :: ArgRecord a    -- ^The argument parse, only listed here+                                    -- to work around a Haddock bug. See+                                    -- <https://github.com/haskell/haddock/issues/456>.          , argsProgName :: String   -- ^Basename of 0th argument.          , argsUsage :: String      -- ^Full usage string.          , argsRest :: [ String ]   -- ^Remaining unprocessed arguments.@@ -218,6 +225,11 @@ arg_optional (Arg { argData = Just (DataArg { dataArgOptional = b }) }) = b arg_optional _ = True +arg_required :: (Ord a) =>+                Arg a   -- ^Argument.+             -> Bool    -- ^True if argument is required to be present.+arg_required a = not (arg_optional a)+ -- |Return the value of a defaulted argument. arg_default_value :: (Ord a)                   => Arg a         -- ^Argument.@@ -236,6 +248,7 @@ arg_default_value _ = Nothing  -- |There's probably a better way to do this.+perhaps :: Bool -> String -> String perhaps b s = if b then s else ""  -- |Format the described argument as a string.@@ -290,14 +303,14 @@                                    (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 =+make_keymap :: (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 ads =     (keymap_from_list .      filter_keys .-     map (\arg -> (f_field arg, arg))) args+     map (\arg -> (f_field arg, arg))) ads  -- |How \"sloppy\" the parse is. data ArgsComplete = ArgsComplete         -- ^Any extraneous arguments@@ -312,16 +325,48 @@                                          -- permitted, and will be skipped,                                          -- saved, and returned. +-- |Whether to always treat an unknown argument beginning+-- with \"-\" as an error, or to allow it to be used as a+-- positional argument when possible.+data ArgsDash = ArgsHardDash   -- ^If an argument begins with+                               -- a \"-\", it will always be+                               -- treated as an error unless+                               -- it corresponds to a flag description.+              | ArgsSoftDash   -- ^If an argument beginning with+                               -- a \"-\" is unrecognized as a flag,+                               -- treat it as a positional argument+                               -- if possible. Otherwise it is an error.+              deriving Eq++-- |Record containing the collective parse control information.+data ArgsParseControl = ArgsParseControl {+  -- |Level of completeness of parse.+  apcComplete :: ArgsComplete,+  -- |Handling of dashes in parse.+  apcDash :: ArgsDash }++-- |Class for building parse control information,+-- for backward compatibility.+class APCData a where+  getAPCData :: a -> ArgsParseControl  -- ^Build an 'ArgsParseControl'+                                       -- structure from the given info.++instance APCData ArgsParseControl where+  getAPCData a = a++instance APCData ArgsComplete where+  getAPCData a = ArgsParseControl a ArgsHardDash+ -- |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.+-- is again invoked with the resulting state and list.  When+-- the supplied function returns the empty list, this+-- function 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 _ s [] = s exhaust f s l =   let (l', s') = f s l   in exhaust f s' l'@@ -333,35 +378,34 @@ 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.+-- |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, then 2) positional arguments; otherwise a+-- runtime error will be thrown.+parseArgs :: (Show a, Ord a, APCData b) =>+             b              -- ^Configuration for 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 =+parseArgs apcData argd pathname argv =   runST (do            check_argd-           let flag_args = takeWhile arg_flag argd-           let posn_args = dropWhile arg_flag argd+           let (flag_args, posn_args) = span 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 (am, _, 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',+           return (Args { __args = ArgRecord am',                           argsProgName = prog_name,                           argsUsage = usage,                           argsRest = rest }))@@ -380,19 +424,15 @@     --- 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")+      --- Order must be flags, then posn args+      let (_, posns) = span arg_flag argd+      unless (all arg_posn posns)+             (argdesc_error "argument description mixes flags and positionals")       --- 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@@ -413,109 +453,120 @@             perhaps               (not (null posn_args))               (" " ++ unwords (map arg_string posn_args)) ++-            (case acomplete of+            (case apcComplete $ getAPCData apcData of                ArgsComplete -> ""                ArgsTrailing s -> " [--] [" ++ s ++ " ...]"                ArgsInterspersed -> " ... [--] ...") ++ "\n"         --- argument lines         arg_lines = concatMap (arg_line n) argd where-            arg_line n a =+            arg_line na a =                 let s = arg_string a in                 "  " ++ s ++ -                replicate (n - (length s)) ' ' +++                replicate (na - (length s)) ' ' ++                 "  " ++ argDesc a ++ "\n"     --- simple recursive-descent parser     parse _ _ _ av@(_, _, []) [] = ([], av)     parse usage _ _ av [] =-        case acomplete of+        case apcComplete $ getAPCData apcData 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)")+          "--" -> case getAPCData apcData of+                    ArgsParseControl ArgsComplete ArgsHardDash -> +                      parseError usage ("unexpected -- " +++                        "(extra arguments not allowed)")                     _ -> ([], (am, posn, (rest ++ aas)))-          s@('-' : '-' : name) ->+          s@('-' : '-' : name) +            | isJust (Map.lookup name name_hash) ||+              apcDash (getAPCData apcData) == ArgsHardDash ->               case Map.lookup name name_hash of-                Just ad -> peel s ad aas+                Just ad -> +                  let (args', am') = peel s ad aas in+                  (args', (am', posn, rest))                 Nothing ->-                    case acomplete of-                      ArgsInterspersed ->-                          (aas, (am, posn, rest ++ ["--" ++ name]))-                      _ -> parseError usage-                           ("unknown argument --" ++ name)-          ('-' : abbr : abbrs) ->+                  case getAPCData apcData of+                    ArgsParseControl ArgsInterspersed _ ->+                      (aas, (am, posn, rest ++ ["--" ++ name]))+                    _ -> +                      parseError usage+                        ("unknown argument --" ++ name)+          ('-' : abbr : abbrs)+            | isJust (Map.lookup abbr abbr_hash) ||+              apcDash (getAPCData apcData) == ArgsHardDash ->               case Map.lookup abbr abbr_hash of                 Just ad ->-                  let p@(args', state') = peel ['-', abbr] ad aas+                  let (args', am') = peel ['-', abbr] ad aas+                      state' = (am', posn, rest)                   in case abbrs of-                    [] -> p+                    [] -> (args', state')                     ('-' : _) -> parseError usage                                  ("bad internal '-' in argument " ++ aa)                     _ -> (['-' : abbrs] ++ args', state')                 Nothing ->-                    case acomplete of+                    case apcComplete $ getAPCData apcData of                       ArgsInterspersed ->                           (aas,                            (am, posn, rest ++ ['-' : abbr : abbrs]))                       _ -> 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]))+          _ ->+            case posn of+              (p : ps) ->+                let (_, req_posn) = partition arg_optional posn in+                case length av - length req_posn of+                  n_extra | n_extra > 0 || (n_extra == 0 && arg_required p) ->+                    let (args', am') = peel (dataArgName $ fromJust $ +                                             argData p) p av in+                    (args', (am', ps, rest))+                  0 -> (av, (am, ps, rest))+                  _ -> parseError usage +                         "missing required positional argument(s)"+              [] -> ([], (am, [], rest ++ av))         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 =+          peel name (Arg { argData = Nothing, argIndex = index }) argl =               let am' = add_entry name am (index, ArgvalFlag)-              in (argl, (am', posn, rest))+              in (argl, am')           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))+          peel name (Arg { argData = +                                 Just (DataArg { dataArgArgtype = atype }),+                              argIndex = index })+              (a : argl) =+                let 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"+                        where+                          read_arg constructor kind =+                            case reads a of+                              [(val, "")] -> constructor val+                              _ -> parseError usage ("argument " +++                                                     a ++ " to " ++ name +++                                                     " is not " ++ kind)+                    am' = add_entry name am (index, v)+                in (argl, am')   -- |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.+parseArgsIO :: (Show a, Ord a, APCData b) =>+               b             -- ^Degree of completeness of parse.             -> [ Arg a ]     -- ^Argument descriptions.             -> IO (Args a)   -- ^Argument parse results.-parseArgsIO acomplete argd = do+parseArgsIO apcData argd = do   argv <- getArgs   pathname <- getProgName-  return (parseArgs acomplete argd pathname argv)+  return (parseArgs apcData argd pathname argv)   -- |Check whether a given optional argument was supplied. Works on all types.@@ -523,37 +574,49 @@           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 =+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++    getRequiredArg ads index =+        case getArg ads index of           Just v -> v           Nothing -> error ("internal error: required argument "                           ++ show index ++ "not supplied") -getArgPrimitive decons (Args { args = ArgRecord am }) k =+getArgPrimitive :: Ord a => (Argval -> Maybe b) -> Args a -> a -> Maybe b+getArgPrimitive decons (Args { __args = ArgRecord am }) k =   Map.lookup k am >>= decons  instance ArgType () where-  getArg = getArgPrimitive (\ArgvalFlag -> return ())+  getArg =+      getArgPrimitive flagArg+      where+        flagArg ArgvalFlag = return ()+        flagArg _ = error "internal error: flag arg at wrong type"  instance ArgType ([] Char) where-  getArg = getArgPrimitive (\(ArgvalString s) -> return s)+  getArg =+      getArgPrimitive stringArg+      where+        stringArg (ArgvalString s) = return s+        stringArg _ = error "internal error: string arg at wrong type"  -- |[Deprecated]  Return the `String` value, if any, of the given argument. getArgString :: (Show a, Ord a) =>@@ -563,7 +626,11 @@ getArgString = getArg  instance ArgType Integer where-  getArg = getArgPrimitive (\(ArgvalInteger i) -> return i)+  getArg =+      getArgPrimitive integerArg+      where+        integerArg (ArgvalInteger i) = return i+        integerArg _ = error "internal error: integer arg at wrong type"  -- |[Deprecated] Return the `Integer` value, if any, of the given argument. getArgInteger :: (Show a, Ord a) =>@@ -573,7 +640,11 @@ getArgInteger = getArg  instance ArgType Int where-  getArg = getArgPrimitive (\(ArgvalInt i) -> return i)+  getArg =+      getArgPrimitive intArg+      where+        intArg (ArgvalInt i) = return i+        intArg _ = error "internal error: int arg at wrong type"  -- |[Deprecated] Return the `Int` value, if any, of the given argument. getArgInt :: (Show a, Ord a) =>@@ -583,7 +654,11 @@ getArgInt = getArg  instance ArgType Double where-  getArg = getArgPrimitive (\(ArgvalDouble i) -> return i)+  getArg =+      getArgPrimitive doubleArg+      where+        doubleArg (ArgvalDouble d) = return d+        doubleArg _ = error "internal error: double arg at wrong type"  -- |[Deprecated] Return the `Double` value, if any, of the given argument. getArgDouble :: (Show a, Ord a) =>@@ -593,7 +668,11 @@ getArgDouble = getArg  instance ArgType Float where-  getArg = getArgPrimitive (\(ArgvalFloat i) -> return i)+  getArg =+      getArgPrimitive floatArg+      where+        floatArg (ArgvalFloat f) = return f+        floatArg _ = error "internal error: float arg at wrong type"  -- |[Deprecated] Return the `Float` value, if any, of the given argument. getArgFloat :: (Show a, Ord a) =>@@ -608,8 +687,8 @@     }  instance ArgType ArgFileOpener where-    getArg args index =-        getArg args index >>= +    getArg ads index =+        getArg ads index >>=            (\s -> return $ ArgFileOpener { argFileOpener = openFile s })  -- |[Deprecated] Treat the `String` value, if any, of the given argument as@@ -620,8 +699,8 @@            -> 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+getArgFile ads k m =+  case getArg ads k of     Just fo -> (do h <- argFileOpener fo m; return (Just h))     Nothing -> return Nothing @@ -636,8 +715,8 @@             -> 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+getArgStdio ads k m =+    case getArg ads k of       Just s -> openFile s m       Nothing ->           case m of@@ -664,4 +743,4 @@  -- |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)+usageError ads msg = error (argsUsage ads ++ "\n" ++ msg)
parseargs-example.hs view
@@ -1,12 +1,12 @@+-- Copyright © 2010 Bart Massey+-- This program is licensed under the "3-clause ('new') BSD License".+-- Please see the file COPYING in this distribution for license terms.+ module Main where -import Prelude hiding (catch)--import Control.Exception import Control.Monad import Data.Maybe-import System.Environment  import System.Console.ParseArgs @@ -14,6 +14,7 @@     OptionFlag |     OptionFlagInt |     OptionFlagString |+    OptionPreoptional |     OptionFixed |     OptionOptional     deriving (Ord, Eq, Show)@@ -34,6 +35,11 @@                argAbbr = Nothing,                argData = argDataDefaulted "test-value" ArgtypeInt 7,                argDesc = "Test int flag" },+         Arg { argIndex = OptionPreoptional,+               argName = Nothing,+               argAbbr = Nothing,+               argData = argDataOptional "pre-optional" ArgtypeString,+               argDesc = "Test optional string before fixed" },          Arg { argIndex = OptionFixed,                argName = Nothing,                argAbbr = Nothing,@@ -45,8 +51,11 @@                argData = argDataOptional "optional" ArgtypeString,                argDesc = "Test optional string" }] +main :: IO () main = do-  args <- parseArgsIO (ArgsTrailing "junk") argd+  args <- parseArgsIO +            (ArgsParseControl (ArgsTrailing "junk") ArgsSoftDash) +            argd   putStrLn "parse successful"   when (gotArg args OptionFlag)        (putStrLn "saw flag")@@ -55,6 +64,9 @@     Nothing -> return ()   case (getArg args OptionFlagInt) of     Just d -> putStrLn ("saw int " ++ (show (d::Int)))+    Nothing -> return ()+  case (getArg args OptionPreoptional) of+    Just s -> putStrLn ("saw pre-optional " ++ s)     Nothing -> return ()   putStrLn ("saw fixed " ++ (fromJust (getArgString args OptionFixed)))   case (getArg args OptionOptional) of
parseargs.cabal view
@@ -1,32 +1,46 @@+-- Copyright © 2010 Bart Massey+-- This work is licensed under the "3-clause ('new') BSD License".+-- Please see the file COPYING in this distribution for license terms.+ Name: parseargs Build-Type: Simple-Description: Parse command-line arguments-Version: 0.1.3.5-Cabal-Version: >= 1.6+Description: Full-featured command-line argument parsing library.+-- Don't forget to bump the source-repository this below+Version: 0.2.0.9+Cabal-Version: >= 1.8 License: BSD3 License-File: COPYING Author: Bart Massey <bart@cs.pdx.edu>-Copyright: Copyright (C) 2008 Bart Massey+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-Extra-Source-Files: README+Homepage: http://github.com/BartMassey/parseargs+Category: Console+Synopsis: Parse command-line arguments+Extra-Source-Files: README.md test-parseargs.sh tests/*.in tests/*.out+Tested-With: GHC >= 6 && <= 8.4.4  Library   Build-Depends:   base < 5, containers < 1   Exposed-Modules: System.Console.ParseArgs+  GHC-Options:     -Wall  Executable parseargs-example-  Build-Depends:   base < 5+  Build-Depends:   base < 5, containers < 1   Main-Is:         parseargs-example.hs   Other-Modules:   System.Console.ParseArgs+  GHC-Options:     -Wall +Test-Suite test-parseargs+  Type:            exitcode-stdio-1.0+  Main-Is:         test-parseargs.hs+  build-depends:   base < 5, process < 2+  build-tool-depends: parseargs:parseargs-example+ Source-repository head   Type:     git-  Location: git://svcs.cs.pdx.edu/git/parseargs.git+  Location: git://github.com/BartMassey/parseargs.git  Source-repository this   Type:     git-  Location: git://svcs.cs.pdx.edu/git/parseargs.git-  Tag:      v0.1.3.4+  Location: git://github.com/BartMassey/parseargs.git+  Tag:      v0.2.0.9
+ test-parseargs.hs view
@@ -0,0 +1,11 @@+-- Stupid glue for "cabal test"+-- http://stackoverflow.com/a/31214045/364875++import System.Exit+import System.Process++main = do+  result <- system "./test-parseargs.sh"+  case result of+    ExitSuccess -> return ()+    _ -> exitFailure
+ test-parseargs.sh view
@@ -0,0 +1,21 @@+#!/bin/sh+# Copyright © 2016 Bart Massey+# Run simple parseargs tests+PA=parseargs-example+TMP=/tmp/test-parseargs-$$+trap "rm -f $TMP" 0 1 2 3 15+for f in tests/*.in+do+    T="`basename $f .in`"+    $PA `cat $f` >$TMP+    if ! cmp $TMP tests/$T.out+    then+        echo "test $T failed"+        echo "expected:"+        cat tests/$T.out+        echo "got:"+        cat $TMP+        exit 1+    fi+done+exit 0
+ tests/t1.in view
@@ -0,0 +1,1 @@+x
+ tests/t1.out view
@@ -0,0 +1,4 @@+parse successful+saw int 7+saw fixed x+saw rest: []
+ tests/t2.in view
@@ -0,0 +1,1 @@+x y
+ tests/t2.out view
@@ -0,0 +1,5 @@+parse successful+saw int 7+saw pre-optional x+saw fixed y+saw rest: []
+ tests/t3.in view
@@ -0,0 +1,1 @@+x y z
+ tests/t3.out view
@@ -0,0 +1,6 @@+parse successful+saw int 7+saw pre-optional x+saw fixed y+saw optional z+saw rest: []