diff --git a/CHANGES.txt b/CHANGES.txt new file mode 100644 --- /dev/null +++ b/CHANGES.txt @@ -0,0 +1,152 @@ +Changelog for CmdArgs + +0.10.22, released 2023-03-13 + #68, support GHC 9.6 +0.10.21, released 2021-02-14 + Handle GHC 9.0 optimisations + Remove support for GHC 7.4 to 7.8 +0.10.20, released 2018-01-22 + #54, use the getopt data types from base +0.10.19, released 2018-01-01 + #47, ensure Semigroup instance on all GHC versions +0.10.18, released 2017-09-24 + #47, GHC 8.4 compatibility +0.10.17, released 2017-03-31 + Add processValueIO for more controlled error messages + #529, don't include the stack trace in processValue +0.10.16, released 2017-03-22 + Minor improvement to error messages +0.10.15, released 2017-03-06 + #43, GHC 8.2 compatibility +0.10.14, released 2016-02-16 + #39, ensure correct line breaks in HTML help output + #18, preserve manual \n in help messages + #25, reformat the README +0.10.13, released 2015-05-22 + #24, support Ratio in some places +0.10.12, released 2014-10-27 + GHC 7.2 compatibility +0.10.11, released 2014-10-12 + #15, never put [brackets] around optional args in Explicit +0.10.10, released 2014-09-18 + #14, fix @ file arguments +0.10.9, released 2014-07-22 + #10, fix versionArgs (broken in 0.10.8) +0.10.8, released 2014-07-21 + Avoid compilation warnings on GHC 7.8 + #9, add --numeric-version flag + Update the copyright year + Change GetOpt.usageInfo to be more like GetOpt +0.10.7, released 2013-12-09 + #1, fix timestamps in .tar.gz dist file +0.10.6, released 2013-12-05 + #625, more documentation about args/argPos + #626, ensure initial lists don't get reversed (fix after #610) +0.10.5, released 2013-07-29 + #615, support lists inside a newtype +0.10.4, released 2013-06-26 + #610, make sure it is O(n) to append arguments, not O(n^2) +0.10.3, released 2013-04-05 + Append list items under an enum + Support &= ignore on enum fields +0.10.2, released 2013-02-28 + Relax upper bounds to be GHC 7.7 compatible +0.10.1, released 2012-11-17 + #569, set the test program to off by default + Complete revamp of cmdargs-browser, far better Javascript + Add a missing case for Helper marshalling FlagNone +0.10, released 2012-08-09 + Revert to 0.9.6, including modeExpandAt +0.9.7, released 2012-08-09 + Revert to 0.9.5, to fix up PVP breakage +0.9.6, released 2012-07-29 + #539, hopefully more fixes to compiling in profile mode + #522, add modeExpandAt and noAtExpand annotation + #522, don't @expand after -- +0.9.5, released 2012-03-25 + Don't specify TH extension unless quotation is true +0.9.4, released 2012-03-25 + #539, specify the TH extension in the Cabal file + Allow transformers 0.3.* + Correct copyright in license and cabal file +0.9.3, released 2012-02-10 + Add expandArgsAt and support for @ flag file directives +0.9.2, released 2012-01-07 + Don't build the test program if quotation is turned off +0.9.1, released 2012-01-05 + Improve the documentation for the Explicit module + #433, propagate groupname on modes in the Implicit code +0.9, released 2011-11-05 + #467, add completions for people running bash + #334, add a Quote module, to write pure in the impure syntax + #482, fix the sample in Explicit, don't use def + #461, fix the translation for enum/enum_ + Make showHelp take an argument for the prefix bits + Add Helper interface, and initial cmdargs-browser code + Add splitArgs/joinArgs +0.8, released 2011-08-13 + #450, redo the manual generator so Maker example is not cut off + Support all the types in Data.Int/Data.Word + Make modeArgs take a list of arguments as well +0.7, released 2011-05-07 + No changes, just a version bump to allow requiring the GHC fix +0.6.10, released 2011-05-07 + Change the annotate module to cope better with GHC's CSE +0.6.9, released 2011-04-03 + #422, support newtype value as the underlying type +0.6.8, released 2011-02-13 + Allow versionArgs [summary] to override --version + Improve the documentation surrounding opt + Add modeReform to Mode + Add modeEmpty, to construct blank Mode values + Improve the documentation surrounding pure annotations. +0.6.7, released 2011-01-15 + #395, don't put two newlines after --help or --version +0.6.6, released 2010-12-30 + #392, support helpArgs [groupname "something"] +0.6.5, released 2010-12-15 + Don't fail with ambiguous enum if you exactly match a value + Put errors on stderr +0.6.4, released 2010-11-20 + Eliminate the filepath dependence +0.6.3, released 2010-11-10 + Switch mtl for transformers +0.6.2, released 2010-11-10 + Build on GHC 7.0 RC2, add an extra type signature + Add verbosityArgs to customise the verbose/quiet flags + Add helpArg/versionArg flags to customise those flags + Support multiline summary using \n escape codes +0.6.1, released 2010-10-04 + Build on GHC 6.10, don't rely on record name disambiguation +0.6, released 2010-09-18 + Add ignore annotation for modes and flags + #350, make top-level help appear properly +0.5, released 2010-09-15 + #351, name/explicit attributes on mode were broken (regression) +0.4, released 2010-09-05 + #342, display common fields only once + Raise errors if annotations are placed in invalid places + Rewrite the translation of annotation to explicit modes + Treat anything after -- as an argument + Add a pure annotation mechanism + Introduce System.Console.CmdArgs.Annotate +0.3, released 2010-08-23 + Add a documentation example for the Explicit mode + Improve the purity and annotations a bit, try disabling CSE + Change the help format + Rename groupHiden to groupHidden, patch from Matthew Cox + Bug, missing fields and explicit enums didn't work together +0.2, released 2010-08-14 + #252, add support for grouped flags/modes + #333, support missing fields + Add support for reading tuple values (including nested) + #292, add support for automatic enumerations + #221, make argpos work with non-string fields + #222, support opt and args together + #230, different modes can share short flags + #295, make verbosity flags explicit + #231, add support for Maybe + #256, add --option=false support + Complete rewrite to introduce Explicit module +0.1, released 2009-09-12 + Start of changelog diff --git a/Data/Generics/Any.hs b/Data/Generics/Any.hs --- a/Data/Generics/Any.hs +++ b/Data/Generics/Any.hs @@ -2,11 +2,13 @@ module Data.Generics.Any where +import Control.Exception import Control.Monad.Trans.State import qualified Data.Data as D -import Data.Data hiding (toConstr, typeOf, dataTypeOf, isAlgType) +import Data.Data hiding (toConstr, typeOf, dataTypeOf) import Data.List import Data.Maybe +import System.IO.Unsafe type CtorName = String @@ -18,6 +20,8 @@ | otherwise = Nothing where y = init $ tail x +try1 :: a -> Either SomeException a +try1 = unsafePerformIO . try . evaluate --------------------------------------------------------------------- -- BASIC TYPES @@ -62,7 +66,7 @@ typeShell = tyconUQname . typeShellFull typeShellFull :: Any -> String -typeShellFull = tyConString . typeRepTyCon . typeOf +typeShellFull = tyConName . typeRepTyCon . typeOf typeName :: Any -> String typeName = show . typeOf @@ -81,6 +85,7 @@ compose0 :: Any -> CtorName -> Any +compose0 x c | either (const False) (== c) $ try1 $ ctor x = x compose0 (Any x) c = Any $ fromConstrB err y `asTypeOf` x where Just y = readConstr (D.dataTypeOf x) c err = error $ "Data.Generics.Any: Undefined field inside compose0, " ++ c ++ " :: " ++ show (Any x) diff --git a/Data/Generics/Any/Prelude.hs b/Data/Generics/Any/Prelude.hs --- a/Data/Generics/Any/Prelude.hs +++ b/Data/Generics/Any/Prelude.hs @@ -2,7 +2,6 @@ module Data.Generics.Any.Prelude where -import Prelude hiding (head,tail,null) import Data.Generics.Any import Data.Maybe @@ -16,6 +15,11 @@ cons :: AnyT a -> AnyT [a] -> AnyT [a] cons x y = compose y "(:)" [x,y] +uncons :: AnyT [a] -> Maybe (AnyT a, AnyT [a]) +uncons x = case decompose x of + ("[]",[]) -> Nothing + ("(:)",[a,b]) -> Just (a,b) + null :: AnyT [a] -> Bool null x | isList x = ctor x == "[]" @@ -30,12 +34,21 @@ append :: AnyT [a] -> AnyT [a] -> AnyT [a] append x y | typeOf x == typeOf y = f x y - where f x y | null x = y - | otherwise = cons (head x) (f (tail x) y) + where f x y = case uncons x of + Nothing -> y + Just (a,b) -> cons a $ f b y +reverse :: AnyT [a] -> AnyT [a] +reverse xs | isList xs = rev xs (nil_ xs) + where rev xs acc = case uncons xs of + Nothing -> acc + Just (x,xs) -> rev xs (cons x acc) + isString x = typeName x == "[Char]" -isList x = typeShell x == "[]" +-- GHC 9.6 changes from [] to List, so accept either +isList x = ts == "[]" || ts == "List" + where ts = typeShell x isMaybe x = typeShell x == "Maybe" isTuple x = isJust $ readTupleType $ typeShell x diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright Neil Mitchell 2009-2012. +Copyright Neil Mitchell 2009-2023. All rights reserved. Redistribution and use in source and binary forms, with or without diff --git a/Main.hs b/Main.hs --- a/Main.hs +++ b/Main.hs @@ -1,5 +1,5 @@ -module Main where +module Main(main) where import System.Console.CmdArgs.Test.All import qualified System.Console.CmdArgs.Test.Implicit.Diffy as D diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,364 @@ +# CmdArgs: Easy Command Line Processing [![Hackage version](https://img.shields.io/hackage/v/cmdargs.svg?label=Hackage)](https://hackage.haskell.org/package/cmdargs) [![Stackage version](https://www.stackage.org/package/cmdargs/badge/nightly?label=Stackage)](https://www.stackage.org/package/cmdargs) [![Build status](https://img.shields.io/github/workflow/status/ndmitchell/cmdargs/ci/master.svg)](https://github.com/ndmitchell/cmdargs/actions) + +CmdArgs is a Haskell library for defining command line parsers. The two features that make it a better choice than the standard [getopt library](http://haskell.org/ghc/docs/latest/html/libraries/base/System-Console-GetOpt.html) are: + +* It's very concise to use. The HLint command line handling is three times shorter with CmdArgs. +* It supports programs with multiple modes, such as [darcs](http://darcs.net) or [Cabal](http://haskell.org/cabal/). + +A very simple example of a command line processor is: +```haskell +data Sample = Sample {hello :: String} deriving (Show, Data, Typeable) + +sample = Sample{hello = def &= help "World argument" &= opt "world"} + &= summary "Sample v1" + +main = print =<< cmdArgs sample +``` +Despite being very concise, this processor is already fairly well featured: + + $ runghc Sample.hs --hello=world + Sample {hello = "world"} + + $ runghc Sample.hs --help + Sample v1, (C) Neil Mitchell 2009 + + sample [FLAG] + + -? --help[=FORMAT] Show usage information (optional format) + -V --version Show version information + -v --verbose Higher verbosity + -q --quiet Lower verbosity + -h --hello=VALUE World argument (default=world) + +## User Manual + +The rest of this document explains how to write the "hello world" of command line processors, then how to extend it with features into a complex command line processor. Finally this document gives three samples, which the `cmdargs` program can run. The three samples are: + +* `hlint` - the [HLint](https://github.com/ndmitchell/hlint#readme) program. +* `diffy` - a program to compare the differences between directories. +* `maker` - a make style program. + +For each example you are encouraged to look at it's source (in the [repo](https://github.com/ndmitchell/cmdargs/tree/master/System/Console/CmdArgs/Test/Implicit)) and run it (try `cmdargs hlint --help`). The HLint program is fairly standard in terms of it's argument processing, and previously used the [System.Console.GetOpt](http://haskell.org/ghc/docs/latest/html/libraries/base/System-Console-GetOpt.html) library. Using GetOpt required 90 lines and a reasonable amount of duplication. Using CmdArgs the code requires 30 lines, and the logic is much simpler. + +**Acknowledgements** Thanks to Kevin Quick for substantial patches, and additional code contributions from Sebastian Fischer and Daniel Schoepe. + + +## Hello World Example + +The following code defines a complete command line argument processor: +```haskell +{-# LANGUAGE DeriveDataTypeable #-} +{-# OPTIONS_GHC -fno-cse #-} +module Sample where +import System.Console.CmdArgs + +data Sample = Sample {hello :: String} + deriving (Show, Data, Typeable) + +sample = Sample{hello = def} + +main = print =<< cmdArgs sample +``` +To use the CmdArgs library there are three steps: + +* Define a record data type (`Sample`) that contains a field for each argument. This type needs to have instances for `Show`, `Data` and `Typeable`. +* Give a value of that type (`sample`) with default values (`def` is a default value of any type, but I could also have written `""`). This value is turned into a command line by calling the `cmdArgs` function. +* To ensure GHC evalutes attributes the right number of times we disable the CSE optimisation on this module. + +Now we have a reasonably functional command line argument processor. Some sample interactions are: + + $ runghc Sample.hs --hello=world + Sample {hello = "world"} + + $ runghc Sample.hs --version + The sample program + + $ runghc Sample.hs --help + The sample program + + sample [OPTIONS] + + -? --help Display help message + -V --version Print version information + -h --hello=ITEM + +CmdArgs uses defaults to automatically infer a command line parser for a value, and provides annotations to override any of the the defaults. CmdArgs automatically supports `--help` and `--version` flags, and optionally supports verbosity flags. + +## Specifying Attributes + +In order to control the behaviour we can add attributes. For example to add an attribute specifying the help text for the `--hello` argument we can write: +```haskell +sample = Sample{hello = def &= help "Who to say hello to"} +``` +We can add additional attributes, for example to specify the type of the value expected by hello: +```haskell +sample = Sample {hello = def &= help "Who to say hello to" &= typ "WORLD"} +``` +Now when running `--help` the final line is: + + -h --hello=WORLD Who to say hello to + +There are many more attributes, detailed in the [Haddock documentation](http://hackage.haskell.org/packages/archive/cmdargs/latest/doc/html/System-Console-CmdArgs.html#2). + + +## Multiple Modes + +To specify a program with multiple modes, similar to [darcs](http://darcs.net/), we can supply a data type with multiple constructors, for example: +```haskell +data Sample = Hello {whom :: String} + | Goodbye + deriving (Show, Data, Typeable) + +hello = Hello{whom = def} +goodbye = Goodbye + +main = print =<< cmdArgs (modes [hello,goodbye]) +``` +Compared to the first example, we now have multiple constructors, and a sample value for each constructor is passed to `cmdArgs`. Some sample interactions with this command line are: + + $ runghc Sample.hs hello --whom=world + Hello {whom = "world"} + + $ runghc Sample.hs goodbye + Goodbye + + $ runghc Sample.hs --help + The sample program + + sample [OPTIONS] + + Common flags + -? --help Display help message + -V --version Print version information + + sample hello [OPTIONS] + + -w --whom=ITEM + + sample goodbye [OPTIONS] + +As before, the behaviour can be customised using attributes. + + +## Larger Examples + +For each of the following examples we first explain the purpose of the program, then give the source code, and finally the output of `--help`. The programs are intended to show sample uses of CmdArgs, and are available to experiment with through `cmdargs progname`. + +### HLint + +The [HLint](https://github.com/ndmitchell/hlint#readme) program analyses a list of files, using various options to control the analysis. The command line processing is simple, but a few interesting points are: + +* The `--report` flag can be used to output a report in a standard location, but giving the flag a value changes where the file is output. +* The `color` field is assigned two flag aliases, `--colour` and `-c`. Assigning the `-c` short flag explicitly stops either of the CPP fields using it. +* The `show_` field would clash with `show` if given the expected name, but CmdArgs automatically strips the trailing underscore. +* The `cpp_define` field has an underscore in it's name, which is transformed into a hyphen for the flag name. + +The code is: +```haskell +{-# LANGUAGE DeriveDataTypeable #-} +module HLint where +import System.Console.CmdArgs + +data HLint = HLint + {report :: [FilePath] + ,hint :: [FilePath] + ,color :: Bool + ,ignore_ :: [String] + ,show_ :: Bool + ,extension :: [String] + ,language :: [String] + ,utf8 :: Bool + ,encoding :: String + ,find :: [FilePath] + ,test_ :: Bool + ,datadir :: [FilePath] + ,cpp_define :: [String] + ,cpp_include :: [FilePath] + ,files :: [FilePath] + } + deriving (Data,Typeable,Show,Eq) + +hlint = HLint + {report = def &= opt "report.html" &= typFile &= help "Generate a report in HTML" + ,hint = def &= typFile &= help "Hint/ignore file to use" + ,color = def &= name "c" &= name "colour" &= help "Color the output (requires ANSI terminal)" + ,ignore_ = def &= typ "MESSAGE" &= help "Ignore a particular hint" + ,show_ = def &= help "Show all ignored ideas" + ,extension = def &= typ "EXT" &= help "File extensions to search (defaults to hs and lhs)" + ,language = def &= name "X" &= typ "LANG" &= help "Language extension (Arrows, NoCPP)" + ,utf8 = def &= help "Use UTF-8 text encoding" + ,encoding = def &= typ "ENC" &= help "Choose the text encoding" + ,find = def &= typFile &= help "Find hints in a Haskell file" + ,test_ = def &= help "Run in test mode" + ,datadir = def &= typDir &= help "Override the data directory" + ,cpp_define = def &= typ "NAME[=VALUE]" &= help "CPP #define" + ,cpp_include = def &= typDir &= help "CPP include path" + ,files = def &= args &= typ "FILES/DIRS" + } &= + verbosity &= + help "Suggest improvements to Haskell source code" &= + summary "HLint v0.0.0, (C) Neil Mitchell" &= + details ["Hlint gives hints on how to improve Haskell code","" + ,"To check all Haskell files in 'src' and generate a report type:"," hlint src --report"] + +mode = cmdArgsMode hlint +``` +Produces the `--help` output: + + HLint v0.0.0, (C) Neil Mitchell + + hlint [OPTIONS] [FILES/DIRS] + Suggest improvements to Haskell source code + + Common flags: + -r --report[=FILE] Generate a report in HTML + -h --hint=FILE Hint/ignore file to use + -c --colour --color Color the output (requires ANSI terminal) + -i --ignore=MESSAGE Ignore a particular hint + -s --show Show all ignored ideas + --extension=EXT File extensions to search (defaults to hs and lhs) + -X --language=LANG Language extension (Arrows, NoCPP) + -u --utf8 Use UTF-8 text encoding + --encoding=ENC Choose the text encoding + -f --find=FILE Find hints in a Haskell file + -t --test Run in test mode + -d --datadir=DIR Override the data directory + --cpp-define=NAME[=VALUE] CPP #define + --cpp-include=DIR CPP include path + -? --help Display help message + -V --version Print version information + -v --verbose Loud verbosity + -q --quiet Quiet verbosity + + Hlint gives hints on how to improve Haskell code + + To check all Haskell files in 'src' and generate a report type: + hlint src --report + + +### Diffy + +The Diffy sample is a based on the idea of creating directory listings and comparing them. The tool can operate in two separate modes, `create` or `diff`. This sample is fictional, but the ideas are drawn from a real program. A few notable features: + +* There are multiple modes of execution, creating and diffing. +* The diff mode takes exactly two arguments, the old file and the new file. +* Default values are given for the `out` field, which are different in both modes. + +The code is: +```haskell +{-# LANGUAGE DeriveDataTypeable #-} +module Diffy where +import System.Console.CmdArgs + +data Diffy = Create {src :: Maybe FilePath, out :: FilePath} + | Diff {old :: FilePath, new :: FilePath, out :: FilePath} + deriving (Data,Typeable,Show,Eq) + +outFlags x = x &= help "Output file" &= typFile + +create = Create + {src = def &= help "Source directory" &= typDir + ,out = outFlags "ls.txt" + } &= help "Create a fingerprint" + +diff = Diff + {old = def &= typ "OLDFILE" &= argPos 0 + ,new = def &= typ "NEWFILE" &= argPos 1 + ,out = outFlags "diff.txt" + } &= help "Perform a diff" + +mode = cmdArgsMode $ modes [create,diff] &= help "Create and compare differences" &= program "diffy" &= summary "Diffy v1.0" +``` +And `--help` produces: + + Diffy v1.0 + + diffy [COMMAND] ... [OPTIONS] + Create and compare differences + + Common flags: + -o --out=FILE Output file + -? --help Display help message + -V --version Print version information + + diffy create [OPTIONS] + Create a fingerprint + + -s --src=DIR Source directory + + diffy diff [OPTIONS] OLDFILE NEWFILE + Perform a diff + +### Maker + +The Maker sample is based around a build system, where we can either build a project, clean the temporary files, or run a test. Some interesting features are: + +* The build mode is the default, so `maker` on it's own will be interpreted as a build command. +* The build method is an enumeration. +* The `threads` field is in two of the constructors, but not all three. It is given the short flag `-j`, rather than the default `-t`. + +The code is: +```haskell +{-# LANGUAGE DeriveDataTypeable #-} +module Maker where +import System.Console.CmdArgs + +data Method = Debug | Release | Profile + deriving (Data,Typeable,Show,Eq) + +data Maker + = Wipe + | Test {threads :: Int, extra :: [String]} + | Build {threads :: Int, method :: Method, files :: [FilePath]} + deriving (Data,Typeable,Show,Eq) + +threadsMsg x = x &= help "Number of threads to use" &= name "j" &= typ "NUM" + +wipe = Wipe &= help "Clean all build objects" + +test_ = Test + {threads = threadsMsg def + ,extra = def &= typ "ANY" &= args + } &= help "Run the test suite" + +build = Build + {threads = threadsMsg def + ,method = enum + [Release &= help "Release build" + ,Debug &= help "Debug build" + ,Profile &= help "Profile build"] + ,files = def &= args + } &= help "Build the project" &= auto + +mode = cmdArgsMode $ modes [build,wipe,test_] + &= help "Build helper program" + &= program "maker" + &= summary "Maker v1.0\nMake it" +``` +And `--help` produces: + + Maker v1.0 + Make it + + maker [COMMAND] ... [OPTIONS] + Build helper program + + Common flags: + -? --help Display help message + -V --version Print version information + + maker [build] [OPTIONS] [ITEM] + Build the project + + -j --threads=NUM Number of threads to use + -r --release Release build + -d --debug Debug build + -p --profile Profile build + + maker wipe [OPTIONS] + Clean all build objects + + maker test [OPTIONS] [ANY] + Run the test suite + + -j --threads=NUM Number of threads to use diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,4 +1,2 @@ -#! /usr/bin/runhaskell - import Distribution.Simple main = defaultMain diff --git a/System/Console/CmdArgs/Annotate.hs b/System/Console/CmdArgs/Annotate.hs --- a/System/Console/CmdArgs/Annotate.hs +++ b/System/Console/CmdArgs/Annotate.hs @@ -1,4 +1,5 @@ {-# LANGUAGE PatternGuards, ScopedTypeVariables, ExistentialQuantification, DeriveDataTypeable #-} +{-# OPTIONS_GHC -O0 #-} -- | This module captures annotations on a value, and builds a 'Capture' value. -- This module has two ways of writing annotations: diff --git a/System/Console/CmdArgs/Explicit.hs b/System/Console/CmdArgs/Explicit.hs --- a/System/Console/CmdArgs/Explicit.hs +++ b/System/Console/CmdArgs/Explicit.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE ScopedTypeVariables, CPP #-} {-| This module constructs command lines. You may either use the helper functions ('flagNone', 'flagOpt', 'mode' etc.) or construct the type directly. These @@ -53,10 +53,10 @@ -} module System.Console.CmdArgs.Explicit( -- * Running command lines - process, processArgs, processValue, + process, processArgs, processValue, processValueIO, -- * Constructing command lines module System.Console.CmdArgs.Explicit.Type, - flagHelpSimple, flagHelpFormat, flagVersion, flagsVerbosity, + flagHelpSimple, flagHelpFormat, flagVersion, flagNumericVersion, flagsVerbosity, -- * Displaying help module System.Console.CmdArgs.Explicit.Help, -- * Utilities for working with command lines @@ -112,19 +112,15 @@ let var = mplus (lookup ("CMDARGS_HELPER_" ++ show (map toUpper $ head $ modeNames m ++ [nam])) env) (lookup "CMDARGS_HELPER" env) case var of - Nothing -> run =<< (if modeExpandAt m then expandArgsAt else return) =<< getArgs + Nothing -> processValueIO m =<< (if modeExpandAt m then expandArgsAt else return) =<< getArgs Just cmd -> do res <- execute cmd m [] case res of Left err -> do hPutStrLn stderr $ "Error when running helper " ++ cmd hPutStrLn stderr err - exitFailure - Right args -> run args - where - run args = case process m args of - Left x -> do hPutStrLn stderr x; exitFailure - Right x -> return x + exitFailure + Right args -> processValueIO m args readMay :: Read a => String -> Maybe a @@ -133,17 +129,30 @@ _ -> Nothing --- | Process a list of flags (usually obtained from @'getArgs'@ and @'expandArgsAt'@) with a mode. Displays --- an error and exits with failure if the command line fails to parse, or returns +#if __GLASGOW_HASKELL__ < 800 +errorWithoutStackTrace :: String -> a +errorWithoutStackTrace = error +#endif + +-- | Process a list of flags (usually obtained from @'getArgs'@ and @'expandArgsAt'@) with a mode. +-- Throws an error if the command line fails to parse, or returns -- the associated value. Implemeneted in terms of 'process'. This function -- does not take account of any environment variables that may be set -- (see 'processArgs'). +-- +-- If you are in 'IO' you will probably get a better user experience by calling 'processValueIO'. processValue :: Mode a -> [String] -> a processValue m xs = case process m xs of - Left x -> error x + Left x -> errorWithoutStackTrace x Right x -> x +-- | Like 'processValue' but on failure prints to stderr and exits the program. +processValueIO :: Mode a -> [String] -> IO a +processValueIO m xs = case process m xs of + Left x -> do hPutStrLn stderr x; exitFailure + Right x -> return x + -- | Create a help flag triggered by @-?@/@--help@. flagHelpSimple :: (a -> a) -> Flag a flagHelpSimple f = flagNone ["help","?"] f "Display help message" @@ -164,7 +173,7 @@ Right (a,b) -> Right $ f a b v format :: String -> Either String (HelpFormat,TextFormat) - format xs = foldl (\acc x -> either Left (f x) acc) (Right def) (sep xs) + format xs = foldl (\acc x -> f x =<< acc) (Right def) (sep xs) where sep = words . map (\x -> if x `elem` ":," then ' ' else toLower x) f x (a,b) = case x of @@ -182,6 +191,10 @@ -- | Create a version flag triggered by @-V@/@--version@. flagVersion :: (a -> a) -> Flag a flagVersion f = flagNone ["version","V"] f "Print version information" + +-- | Create a version flag triggered by @--numeric-version@. +flagNumericVersion :: (a -> a) -> Flag a +flagNumericVersion f = flagNone ["numeric-version"] f "Print just the version number" -- | Create verbosity flags triggered by @-v@/@--verbose@ and diff --git a/System/Console/CmdArgs/Explicit/Complete.hs b/System/Console/CmdArgs/Explicit/Complete.hs --- a/System/Console/CmdArgs/Explicit/Complete.hs +++ b/System/Console/CmdArgs/Explicit/Complete.hs @@ -60,7 +60,7 @@ pickBy :: (a -> [String]) -> String -> [a] -> Maybe a -pickBy f name xs = find (\x -> name `elem` f x) xs `mplus` +pickBy f name xs = find (\x -> name `elem` f x) xs `mplus` find (\x -> any (name `isPrefixOf`) (f x)) xs @@ -98,9 +98,9 @@ expectArgFlagMode :: [Mode a] -> Maybe (Arg a) -> [Flag a] -> String -> [Complete] -expectArgFlagMode mode arg flag x - | "-" `isPrefixOf` x = expectFlag flag x ++ [CompleteValue "-" | x == "-", isJust arg] - | otherwise = expectMode mode x ++ expectArg arg x ++ expectFlag flag x +expectArgFlagMode mode arg flag x = + (if "-" `isPrefixOf` x then [] else expectMode mode x) ++ + expectArgFlag arg flag x expectArgFlag :: Maybe (Arg a) -> [Flag a] -> String -> [Complete] expectArgFlag arg flag x diff --git a/System/Console/CmdArgs/Explicit/Help.hs b/System/Console/CmdArgs/Explicit/Help.hs --- a/System/Console/CmdArgs/Explicit/Help.hs +++ b/System/Console/CmdArgs/Explicit/Help.hs @@ -1,3 +1,4 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} -- Not good reasons, but shouldn't be too fatal {- Sample renderings: @@ -6,7 +7,7 @@ programname [OPTIONS] FILE1 FILE2 [FILES] Program to perform some action - + -f --flag description Flag grouping: -a --another description @@ -114,7 +115,7 @@ -- > helpTextOne :: Mode a -> [Text] helpTextOne m = pre ++ ms ++ suf - where + where (pre,suf) = helpTextMode m ms = space $ [Line "Commands:" | not $ null $ groupUnnamed $ modeGroupModes m] ++ helpGroup f (modeGroupModes m) f m = return $ cols [concat $ take 1 $ modeNames m, ' ' : modeHelp m] @@ -140,7 +141,7 @@ helpArgs :: ([Arg a], Maybe (Arg a)) -> [String] -helpArgs (ys,y) = [['['|r] ++ argType x ++ [']'|r] | (i,x) <- zip [0..] xs, let r = req > i] +helpArgs (ys,y) = [['['|o] ++ argType x ++ [']'|o] | (i,x) <- zip [0..] xs, let o = False && req <= i] where xs = ys ++ maybeToList y req = maximum $ 0 : [i | (i,x) <- zip [1..] xs, argRequire x] diff --git a/System/Console/CmdArgs/Explicit/Process.hs b/System/Console/CmdArgs/Explicit/Process.hs --- a/System/Console/CmdArgs/Explicit/Process.hs +++ b/System/Console/CmdArgs/Explicit/Process.hs @@ -23,7 +23,7 @@ | null (fst $ modeArgs m) && isNothing (snd $ modeArgs m) && args /= [] && not (null $ modeModes m) && not ("-" `isPrefixOf` concat args) -> Left $ missing "mode" $ concatMap modeNames $ modeModes m - | otherwise -> either Left (modeCheck m) $ processFlags m (modeValue m) args + | otherwise -> modeCheck m =<< processFlags m (modeValue m) args where (find,a,as) = case args of [] -> (NotFound,"",[]) @@ -147,4 +147,3 @@ (xs,_) -> Ambiguous $ map fst xs where match op = [(head ys,v) | (xs,v) <- names, let ys = filter (op value) xs, ys /= []] - diff --git a/System/Console/CmdArgs/Explicit/Type.hs b/System/Console/CmdArgs/Explicit/Type.hs --- a/System/Console/CmdArgs/Explicit/Type.hs +++ b/System/Console/CmdArgs/Explicit/Type.hs @@ -6,7 +6,8 @@ import Data.Char import Data.List import Data.Maybe -import Data.Monoid +import Data.Semigroup hiding (Arg) +import Prelude -- | A name, either the name of a flag (@--/foo/@) or the name of a mode. @@ -22,7 +23,7 @@ --------------------------------------------------------------------- -- UTILITY --- | Parse a boolean, accepts as True: true yes on enabled 1. +-- | Parse a boolean, accepts as True: true yes on enabled 1. parseBool :: String -> Maybe Bool parseBool s | ls `elem` true = Just True | ls `elem` false = Just False @@ -42,14 +43,17 @@ {groupUnnamed :: [a] -- ^ Normal items. ,groupHidden :: [a] -- ^ Items that are hidden (not displayed in the help message). ,groupNamed :: [(Help, [a])] -- ^ Items that have been grouped, along with a description of each group. - } deriving Show + } deriving Show instance Functor Group where fmap f (Group a b c) = Group (map f a) (map f b) (map (second $ map f) c) +instance Semigroup (Group a) where + Group x1 x2 x3 <> Group y1 y2 y3 = Group (x1++y1) (x2++y2) (x3++y3) + instance Monoid (Group a) where mempty = Group [] [] [] - mappend (Group x1 x2 x3) (Group y1 y2 y3) = Group (x1++y1) (x2++y2) (x3++y3) + mappend = (<>) -- | Convert a group into a list. fromGroup :: Group a -> [a] @@ -161,11 +165,11 @@ where checkGroup :: Group a -> Maybe String checkGroup x = msum - [check "Empty group name" $ all (not . null . fst) $ groupNamed x - ,check "Empty group contents" $ all (not . null . snd) $ groupNamed x] + [check "Empty group name" $ not $ any (null . fst) $ groupNamed x + ,check "Empty group contents" $ not $ any (null . snd) $ groupNamed x] checkNames :: String -> [Name] -> Maybe String - checkNames msg xs = check "Empty names" (all (not . null) xs) `mplus` do + checkNames msg xs = check "Empty names" (not (any null xs)) `mplus` do bad <- listToMaybe $ xs \\ nub xs let dupe = filter (== bad) xs return $ "Sanity check failed, multiple " ++ msg ++ ": " ++ unwords (map show dupe) @@ -178,11 +182,14 @@ --------------------------------------------------------------------- -- REMAP +-- | Like functor, but where the the argument isn't just covariant. class Remap m where + -- | Convert between two values. remap :: (a -> b) -- ^ Embed a value -> (b -> (a, a -> b)) -- ^ Extract the mode and give a way of re-embedding -> m a -> m b +-- | Restricted version of 'remap' where the values are isomorphic. remap2 :: Remap m => (a -> b) -> (b -> a) -> m a -> m b remap2 f g = remap f (\x -> (g x, f)) @@ -201,6 +208,8 @@ instance Remap Arg where remap f g x = x{argValue = remapUpdate f g $ argValue x} +-- | Version of 'remap' for the 'Update' type alias. +remapUpdate :: (a -> b) -> (b -> (a, a -> b)) -> Update a -> Update b remapUpdate f g upd = \s v -> let (a,b) = g v in fmap b $ upd s a diff --git a/System/Console/CmdArgs/GetOpt.hs b/System/Console/CmdArgs/GetOpt.hs --- a/System/Console/CmdArgs/GetOpt.hs +++ b/System/Console/CmdArgs/GetOpt.hs @@ -9,6 +9,7 @@ ) where import System.Console.CmdArgs.Explicit +import System.Console.GetOpt(OptDescr(..), ArgDescr(..)) -- | What to do with options following non-options. @@ -16,39 +17,15 @@ -- /Changes:/ Only 'Permute' is allowed, both @RequireOrder@ and @ReturnInOrder@ -- have been removed. data ArgOrder a = Permute - - --- | Each 'OptDescr' describes a single option/flag. --- --- The arguments to 'Option' are: --- --- * list of short option characters --- --- * list of long option strings (without @\"--\"@, may not be 1 character long) --- --- * argument descriptor --- --- * explanation of option for userdata -data OptDescr a = Option - [Char] - [String] - (ArgDescr a) - String - - --- | Describes whether an option takes an argument or not, and if so --- how the argument is injected into a value of type @a@. -data ArgDescr a - = NoArg a -- ^ no argument expected - | ReqArg (String -> a) String -- ^ option requires argument - | OptArg (Maybe String -> a) String -- ^ optional argument +instance Functor ArgOrder where + fmap _ Permute = Permute -- | Return a string describing the usage of a command, derived from --- the header (first argument) and the options described by the +-- the header (first argument) and the options described by the -- second argument. usageInfo :: String -> [OptDescr a] -> String -usageInfo desc flags = show $ convert desc flags +usageInfo desc flags = unlines $ desc : drop 2 (lines $ show $ convert "" flags) -- | Process the command-line, and return the list of values that matched @@ -58,7 +35,7 @@ -- -- * The option descriptions (see 'OptDescr') -- --- * The actual command line arguments (presumably got from +-- * The actual command line arguments (presumably got from -- 'System.Environment.getArgs'). -- -- 'getOpt' returns a triple consisting of the option arguments, a list diff --git a/System/Console/CmdArgs/Helper.hs b/System/Console/CmdArgs/Helper.hs --- a/System/Console/CmdArgs/Helper.hs +++ b/System/Console/CmdArgs/Helper.hs @@ -172,8 +172,8 @@ deriving (Show,Read) newtype NoShow a = NoShow a -instance Show (NoShow a) where -- deliberately leave the methods unimplemented -instance Read (NoShow a) where -- deliberately leave the methods unimplemented +instance Show (NoShow a) where showsPrec = error "Cannot show value of type NoShow" +instance Read (NoShow a) where readsPrec = error "Cannot read value of type NoShow" transformM, descendM :: Monad m => (Pack -> m Pack) -> Pack -> m Pack @@ -264,7 +264,7 @@ unpack x = let y = ctor "Group" x in Group {groupUnnamed = get "groupUnnamed" y ,groupHidden = get "groupHidden" y - ,groupNamed = get "groupNamed" y} + ,groupNamed = get "groupNamed" y} instance Packer a => Packer (Mode a) where pack Mode{..} = Ctor "Mode" @@ -322,5 +322,6 @@ unpack x@(Ctor name _) = case name of "FlagReq" -> FlagReq "FlagOpt" -> FlagOpt $ get "fromFlagOpt" $ ctor name x - "FlagOptRare" -> FlagOpt $ get "fromFlagOpt" $ ctor name x + "FlagOptRare" -> FlagOptRare $ get "fromFlagOpt" $ ctor name x + "FlagNone" -> FlagNone unpack _ = FlagNone diff --git a/System/Console/CmdArgs/Implicit.hs b/System/Console/CmdArgs/Implicit.hs --- a/System/Console/CmdArgs/Implicit.hs +++ b/System/Console/CmdArgs/Implicit.hs @@ -14,13 +14,13 @@ @main = print =<< 'cmdArgs' sample@ Attributes are used to control a number of behaviours: - + * The help message: 'help', 'typ', 'details', 'summary', 'program', 'groupname' - + * Flag behaviour: 'opt', 'enum', 'verbosity', 'ignore' - + * Flag name assignment: 'name', 'explicit' - + * Controlling non-flag arguments: 'args', 'argPos' * multi-mode programs: 'modes', 'auto' @@ -56,7 +56,7 @@ All the examples are written using impure annotations. To convert to pure annotations follow the rules: - + > Ctor {field1 = value1 &= ann1, field2 = value2} &= ann2 ==> record Ctor{} [field1 := value1 += ann1, field2 := value2] += ann2 > Ctor (value1 &= ann1) value2 &= ann2 ==> record Ctor{} [atom value1 += ann1, atom value2] += ann2 > modes [Ctor1{...}, Ctor2{...}] ==> modes_ [record Ctor1{} [...], record Ctor2{} [...]] @@ -216,6 +216,13 @@ -- > cmdArgs $ Mode {state = enum [On &= help "Turn on",Off &= help "Turn off"]} -- > --on Turn on -- > --off Turn off +-- +-- This annotation can be used to allow multiple flags within a field: +-- +-- > data Mode = Mode {state :: [State]} +-- > cmdArgs $ Mode {state = enum [[] &= ignore, [On] &= help "Turn on", [Off] &= help "Turn off"]} +-- +-- Now @--on --off@ would produce @Mode [On,Off]@. enum :: Data val => [val] -> val enum = many diff --git a/System/Console/CmdArgs/Implicit/Global.hs b/System/Console/CmdArgs/Implicit/Global.hs --- a/System/Console/CmdArgs/Implicit/Global.hs +++ b/System/Console/CmdArgs/Implicit/Global.hs @@ -24,7 +24,7 @@ setProgOpts :: Prog_ -> Mode a -> Mode a -setProgOpts p m = m{modeExpandAt = False -- not $ progNoAtExpand p +setProgOpts p m = m{modeExpandAt = not $ progNoAtExpand p ,modeGroupModes = fmap (setProgOpts p) $ modeGroupModes m} @@ -61,11 +61,17 @@ collapseMode :: Mode_ -> Mode (CmdArgs Any) collapseMode x = + applyFixups (map flagFixup $ modeFlags_ x) $ collapseArgs [x | x@Arg_{} <- modeFlags_ x] $ collapseFlags [x | x@Flag_{} <- modeFlags_ x] $ modeMode x +applyFixups :: [Fixup] -> Mode (CmdArgs Any) -> Mode (CmdArgs Any) +applyFixups xs m = m{modeCheck = either Left (Right . fmap fix) . modeCheck m} + where fix a = foldr ($) a [x | Fixup x <- xs] + + collapseFlags :: [Flag_] -> Mode (CmdArgs Any) -> Mode (CmdArgs Any) collapseFlags xs x = x{modeGroupFlags = Group (pick Nothing) [] [(g, pick $ Just g) | g <- groups]} where @@ -159,6 +165,8 @@ wrap x = def{flagFlag=x, flagExplicit=True, flagGroup=grp} flags = changeBuiltin_ (progHelpArg p) (wrap $ flagHelpFormat $ error "flagHelpFormat undefined") ++ changeBuiltin_ (progVersionArg p) (wrap $ flagVersion vers) ++ + [wrap $ flagNumericVersion $ \x -> x{cmdArgsVersion = Just $ unlines v} + | Just v <- [progNumericVersionOutput p]] ++ changeBuiltin_ (fst $ progVerbosityArgs p) (wrap loud) ++ changeBuiltin_ (snd $ progVerbosityArgs p) (wrap quiet) [loud,quiet] = flagsVerbosity verb @@ -221,7 +229,7 @@ isFlag_ _ = False -asName s = map (\x -> if x == '_' then '-' else toLower x) $ if last s == '_' then init s else s +asName s = map (\x -> if x == '_' then '-' else toLower x) $ if last s == '_' then init s else s -- have are already assigned, want are a list of ones I might want data Names = Names {have :: [String], want :: [String]} diff --git a/System/Console/CmdArgs/Implicit/Local.hs b/System/Console/CmdArgs/Implicit/Local.hs --- a/System/Console/CmdArgs/Implicit/Local.hs +++ b/System/Console/CmdArgs/Implicit/Local.hs @@ -5,8 +5,8 @@ -- constraints. module System.Console.CmdArgs.Implicit.Local( local, err, - Prog_(..), Builtin_(..), Mode_(..), Flag_(..), isFlag_, - progHelpOutput, progVersionOutput + Prog_(..), Builtin_(..), Mode_(..), Flag_(..), Fixup(..), isFlag_, + progHelpOutput, progVersionOutput, progNumericVersionOutput ) where import System.Console.CmdArgs.Implicit.Ann @@ -15,11 +15,13 @@ import System.Console.CmdArgs.Explicit import System.Console.CmdArgs.Annotate import System.Console.CmdArgs.Default +import qualified Data.Generics.Any.Prelude as A import Control.Monad import Data.Char import Data.Generics.Any import Data.Maybe +import Data.List data Prog_ = Prog_ @@ -40,8 +42,16 @@ progHelpOutput = progOutput progHelpArg progVersionOutput = progOutput progVersionArg +progNumericVersionOutput x = fmap return $ parseVersion =<< listToMaybe (progVersionOutput x) +-- | Find numbers starting after space/comma, v +parseVersion :: String -> Maybe String +parseVersion xs = listToMaybe + [y | x <- words $ map (\x -> if x `elem` ",;" then ' ' else x) xs + , let y = fromMaybe x $ stripPrefix "v" x + , length (takeWhile isDigit y) >= 1] + data Builtin_ = Builtin_ {builtinNames :: [String] ,builtinExplicit :: Bool @@ -69,16 +79,23 @@ ,flagExplicit :: Bool ,flagGroup :: Maybe String ,flagEnum :: Maybe String -- if you are an enum, what is your string value + ,flagFixup :: Fixup } | Arg_ {flagArg_ :: Arg (CmdArgs Any) ,flagArgPos :: Maybe Int ,flagArgOpt :: Maybe String + ,flagFixup :: Fixup } deriving Show instance Default Flag_ where - def = Flag_ "" (error "Flag_ undefined") def def def + def = Flag_ "" (error "Flag_ undefined") def def def def +newtype Fixup = Fixup (Any -> Any) + +instance Default Fixup where def = Fixup id +instance Show Fixup where show _ = "Fixup" + isFlag_ Flag_{} = True isFlag_ _ = False @@ -108,39 +125,46 @@ mode_ :: Capture Ann -> [Mode_] mode_ (Ann Ignore _) = [] mode_ (Ann a b) = map (modeAnn a) $ mode_ b -mode_ o@(Ctor x ys) = [withMode def{modeFlags_=concat $ zipWith flag_ (fields x) ys} $ \x -> x{modeValue=embed $ fromCapture o}] +mode_ o@(Ctor x ys) = [withMode def{modeFlags_=flgs} $ \x -> x{modeValue=embed $ fixup $ fromCapture o}] + where flgs = concat $ zipWith flag_ (fields x) ys + fixup x = foldl (\x (Fixup f) -> f x) x $ map flagFixup flgs mode_ x = err "mode" $ show x flag_ :: String -> Capture Ann -> [Flag_] flag_ name (Ann Ignore _) = [] flag_ name (Ann a b) = map (flagAnn a) $ flag_ name b -flag_ name (Value x) = [def{flagField=name, flagFlag = remap embed reembed $ value_ name x}] +flag_ name (Value x) = let (fix,flg) = value_ name x in [def{flagField=name, flagFlag=remap embed reembed flg, flagFixup=fix}] flag_ name x@Ctor{} = flag_ name $ Value $ fromCapture x -flag_ name (Many xs) = map (enum_ name) xs +flag_ name (Many xs) = concatMap (enum_ name) xs flag_ name x = errFlag name $ show x -enum_ :: String -> Capture Ann -> Flag_ -enum_ name (Ann a b) = flagAnn a $ enum_ name b -enum_ name (Value x) = def{flagField=name, flagFlag = flagNone [] (fmap $ setField (name,x)) "", flagEnum=Just $ ctor x} +enum_ :: String -> Capture Ann -> [Flag_] +enum_ name (Ann Ignore _) = [] +enum_ name (Ann a b) = map (flagAnn a) $ enum_ name b +enum_ name (Value x) = [def{flagField=name, flagFlag = flagNone [] (fmap upd) "", flagEnum=Just $ ctor x}] + where upd v | not (A.isString x) && A.isList x = setField (name, getField name v `A.append` x) v + | otherwise = setField (name,x) v enum_ name x@Ctor{} = enum_ name $ Value $ fromCapture x enum_ name x = errFlag name $ show x -value_ :: String -> Any -> Flag Any +-- Fixup (ends up in modeCheck) and the flag itself +value_ :: String -> Any -> (Fixup, Flag Any) value_ name x | isNothing mty = errFlag name $ show x | readerBool ty = let f (Right x) = x upd b x = setField (name, f $ readerRead ty (getField name x) $ show b) x - in flagBool [] upd "" + in (fixup, flagBool [] upd "") | otherwise = let upd s x = fmap (\c -> setField (name,c) x) $ readerRead ty (getField name x) s - in flagReq [] upd (readerHelp ty) "" + in (fixup, flagReq [] upd (readerHelp ty) "") where mty = reader x ty = fromJust mty + fixup = Fixup $ \x -> setField (name,readerFixup ty $ getField name x) x --------------------------------------------------------------------- @@ -196,9 +220,9 @@ flagAnn a x = errFlag (head $ words $ show x) $ show a toArg :: Flag_ -> Maybe Int -> Flag_ -toArg (Flag_ fld x False Nothing Nothing) pos +toArg (Flag_ fld x False Nothing Nothing fix) pos | null (flagNames x), null (flagHelp x), Just y <- opt $ flagInfo x - = Arg_ (Arg (flagValue x) (flagType x) (isNothing y)) pos y + = Arg_ (Arg (flagValue x) (flagType x) (isNothing y)) pos y fix where opt FlagReq = Just Nothing opt (FlagOpt x) = Just (Just x) diff --git a/System/Console/CmdArgs/Implicit/Reader.hs b/System/Console/CmdArgs/Implicit/Reader.hs --- a/System/Console/CmdArgs/Implicit/Reader.hs +++ b/System/Console/CmdArgs/Implicit/Reader.hs @@ -16,25 +16,35 @@ {readerHelp :: String ,readerBool :: Bool ,readerParts :: Int + ,readerFixup :: Any -> Any -- If a list, then 'reverse', otherwise nothing, so we can build up using cons in O(n) ,readerRead :: Any -> String -> Either String Any } --- reader tries to use the first argument to readerRead, but reader_ doesn't +-- reader has an actual value of type Any that can be inspected +-- reader_ has a value of type _|_ instead readerRead_ r = readerRead r $ error "Invariant broken: reader/reader_" reader :: Any -> Maybe Reader reader x | A.isList x && not (A.isString x) = do r <- reader_ $ A.fromList x - return r{readerRead = \o s -> fmap (A.append o . A.list_ x) $ readerRead_ r s} + return r{readerRead = \o s -> fmap (`A.cons` o) $ readerRead_ r s, readerFixup = A.reverse} +reader x | isAlgType x, [ctor] <- ctors x, [child] <- children x = do + -- newtype wrapper, just forward it + r <- reader child + let down = head . children + let up o c = recompose o [c] + return r{readerFixup = \x -> up x $ readerFixup r $ down x + ,readerRead = \x -> either Left (Right . up x) . readerRead r (down x) + } reader x = reader_ x reader_ :: Any -> Maybe Reader -reader_ x | A.isString x = Just $ Reader "ITEM" False 1 $ const $ Right . Any +reader_ x | A.isString x = Just $ Reader "ITEM" False 1 id $ const $ Right . Any -reader_ x | typeName x == "Bool" = Just $ Reader "BOOL" True 1 $ const $ \s -> +reader_ x | typeName x == "Bool" = Just $ Reader "BOOL" True 1 id $ const $ \s -> maybe (Left $ "Could not read as boolean, " ++ show s) (Right . Any) $ parseBool s @@ -46,7 +56,7 @@ where ty = typeOf x f hlp t | typeOf (Any t) /= ty = Nothing - | otherwise = Just $ Reader hlp False 1 $ const $ \s -> case reads s of + | otherwise = Just $ Reader hlp False 1 id $ const $ \s -> case reads s of [(x,"")] -> Right $ Any $ x `asTypeOf` t _ -> Left $ "Could not read as type " ++ show (typeOf $ Any t) ++ ", " ++ show s @@ -62,13 +72,13 @@ reader_ x | isAlgType x && length xs > 1 && all ((==) 0 . arity . snd) xs - = Just $ Reader (map toUpper $ typeShell x) (typeName x == "Bool") 1 $ const $ rd . map toLower + = Just $ Reader (map toUpper $ typeShell x) (typeName x == "Bool") 1 id $ const $ rd . map toLower where xs = [(map toLower c, compose0 x c) | c <- ctors x] - rd s | null ys = Left $ "Could not read, expected one of: " ++ unwords (map fst xs) + rd s | null ys = Left $ "Could not read " ++ show s ++ ", expected one of: " ++ unwords (map fst xs) | Just (_,x) <- find ((==) s . fst) ys = Right x - | length ys > 1 = Left $ "Ambiguous read, could be any of: " ++ unwords (map fst ys) + | length ys > 1 = Left $ "Ambiguous read for " ++ show s ++ ", could be any of: " ++ unwords (map fst ys) | otherwise = Right $ snd $ head ys where ys = filter (isPrefixOf s . fst) xs @@ -77,7 +87,7 @@ let cs = children x rs <- mapM reader_ cs let n = sum $ map readerParts rs - return $ Reader (uncommas $ map readerHelp rs) (map readerBool rs == [True]) n $ const $ \s -> + return $ Reader (uncommas $ map readerHelp rs) (map readerBool rs == [True]) n id $ const $ \s -> let ss = commas s in if n == 1 then fmap (recompose x . return) $ readerRead_ (head $ filter ((==) 1 . readerParts) rs) s else if length ss /= n then Left "Incorrect number of commas for fields" diff --git a/System/Console/CmdArgs/Implicit/UI.hs b/System/Console/CmdArgs/Implicit/UI.hs --- a/System/Console/CmdArgs/Implicit/UI.hs +++ b/System/Console/CmdArgs/Implicit/UI.hs @@ -90,6 +90,8 @@ -- | Flag: \"Put non-flag arguments here.\" -- +-- All argument flags not captured by 'argPos' are returned by 'args'. +-- -- > {hello = def &= args} args :: Ann args = FlagArgs @@ -127,7 +129,8 @@ -- | Modes: \"My program name\/version\/copyright is ...\" -- -- One line summary of the entire program, the first line of --- @--help@ and the only line of @--version@. +-- @--help@ and the only line of @--version@. If the string contains a +-- version number component will also provide @--numeric-version@. -- -- > Sample{..} &= summary "CmdArgs v0.0, (C) Neil Mitchell 1981" summary :: String -> Ann diff --git a/System/Console/CmdArgs/Quote.hs b/System/Console/CmdArgs/Quote.hs --- a/System/Console/CmdArgs/Quote.hs +++ b/System/Console/CmdArgs/Quote.hs @@ -13,7 +13,7 @@ -- > $(cmdArgsQuote [d| -- > sample = Sample{hello = def &=# help "World argument" &=# opt "world"} -- > &=# summary "Sample v1" --- > +-- > -- > run = cmdArgs# sample :: IO Sample -- > |]) -- > @@ -114,7 +114,7 @@ bind = [ValD (VarP name) (NormalB val) [] | (name,val) <- zip names vals] args = [anns (VarE 'atom `AppE` VarE name) as | (name,as) <- zip names ass] return $ LetE bind $ VarE 'record `AppE` (ConE x `apps` map VarE names) `AppE` ListE args - + f x = descendM f x apps x [] = x @@ -171,7 +171,7 @@ where -- create an environment where everything in ns is missing, recursively drop one thing each time without ns new = [(n, exp (new2 ++ env) e) | (n,e) <- new, n `notElem` ns, let new2 = without (n:ns) new] - + dec env (FunD n cs) = FunD n $ map (clause env) cs dec env (ValD p x ds) = ValD p (body (addEnv ds env) x) ds diff --git a/System/Console/CmdArgs/Test/Implicit/Diffy.hs b/System/Console/CmdArgs/Test/Implicit/Diffy.hs --- a/System/Console/CmdArgs/Test/Implicit/Diffy.hs +++ b/System/Console/CmdArgs/Test/Implicit/Diffy.hs @@ -54,6 +54,7 @@ isHelp ["diff","--help"] [] isHelpNot ["--help"] ["diffy"] isVersion ["--version"] "Diffy v1.0" + isVersion ["--numeric-version"] "1.0" ["create"] === create fails ["create","file1"] fails ["create","--quiet"] @@ -66,7 +67,6 @@ ["diff","foo1","foo2"] === diff{old="foo1",new="foo2"} fails ["diff","foo1"] fails ["diff","foo1","foo2","foo3"] - completion [] (0,0) [CompleteValue "create",CompleteValue "diff",CompleteValue "--out",CompleteValue "--help",CompleteValue "--version"] + completion [] (0,0) [CompleteValue "create",CompleteValue "diff",CompleteValue "--out",CompleteValue "--help",CompleteValue "--version",CompleteValue "--numeric-version"] completion ["d"] (0,1) [CompleteValue "diff"] completion ["dd"] (0,2) [] - diff --git a/System/Console/CmdArgs/Test/Implicit/HLint.hs b/System/Console/CmdArgs/Test/Implicit/HLint.hs --- a/System/Console/CmdArgs/Test/Implicit/HLint.hs +++ b/System/Console/CmdArgs/Test/Implicit/HLint.hs @@ -61,6 +61,9 @@ isVerbosity [] Normal isHelp ["-?"] ["HLint v0.0.0, (C) Neil Mitchell"] isHelp ["--help"] [" hlint src --report"] + isVersion ["--version"] "HLint v0.0.0, (C) Neil Mitchell" + isVersion ["-V"] "HLint v0.0.0, (C) Neil Mitchell" + isVersion ["--numeric-version"] "0.0.0" ["--colo"] === hlint{color=True} ["--colour","--colour=false"] === hlint ["--colour=true"] === hlint{color=True} diff --git a/System/Console/CmdArgs/Test/Implicit/Maker.hs b/System/Console/CmdArgs/Test/Implicit/Maker.hs --- a/System/Console/CmdArgs/Test/Implicit/Maker.hs +++ b/System/Console/CmdArgs/Test/Implicit/Maker.hs @@ -47,7 +47,7 @@ ] += help "Run the test suite" build = record Build{} - [threads_ + [threads_ ,enum_ method [atom Release += help "Release build" ,atom Debug += help "Debug build" diff --git a/System/Console/CmdArgs/Test/Implicit/Tests.hs b/System/Console/CmdArgs/Test/Implicit/Tests.hs --- a/System/Console/CmdArgs/Test/Implicit/Tests.hs +++ b/System/Console/CmdArgs/Test/Implicit/Tests.hs @@ -1,5 +1,5 @@ {-# LANGUAGE DeriveDataTypeable, RecordWildCards, TemplateHaskell, MagicHash #-} -{-# OPTIONS_GHC -fno-warn-missing-fields -fno-warn-unused-binds #-} +{-# OPTIONS_GHC -fno-warn-missing-fields -fno-warn-unused-binds -fno-cse #-} module System.Console.CmdArgs.Test.Implicit.Tests(test, demos) where @@ -8,6 +8,7 @@ import System.Console.CmdArgs.Test.Implicit.Util import System.Console.CmdArgs.Quote import Data.Int +import Data.Ratio -- from bug #256 and #231 @@ -43,7 +44,7 @@ ["--listbool","--listbool=true","--listbool=false"] === def1{listBool=[True,True,False]} ["--int64=12"] === def1{int64=12} fails ["--listbool=fred"] - invalid $ \_ -> def1{listBool = def &= opt "yes"} + invalid $ const def1{listBool = def &= opt "yes"} -- from bug #230 @@ -248,6 +249,7 @@ ["test13c","--foo13=13"] === Test13C 13 isHelp ["--help"] ["Help text here"] isVersion ["--version"] "Version text here" + fails ["--numeric-version"] -- check a list becomes modes not an enum data Test14 = Test14A | Test14B | Test14C deriving (Eq,Show,Data,Typeable) @@ -264,12 +266,12 @@ data Test15 = Test15 {test15a :: Bool} deriving (Eq,Show,Data,Typeable) mode15 = cmdArgsMode $ Test15 (False &= name "help") - &= helpArg [groupname "GROUP", name "h", name "nohelp", explicit, help "whatever"] &= versionArg [ignore] + &= helpArg [groupname "GROUP", name "h", name "nohelp", explicit, help "whatever\nstuff"] &= versionArg [ignore] &= verbosityArgs [ignore] [explicit,name "silent"] $(cmdArgsQuote [d| mode15_ = cmdArgsMode# $ Test15 (False &=# name "help") - &=# helpArg [groupname "GROUP", name "h", name "nohelp", explicit, help "whatever"] &=# versionArg [ignore] + &=# helpArg [groupname "GROUP", name "h", name "nohelp", explicit, help "whatever\nstuff"] &=# versionArg [ignore] &=# verbosityArgs [ignore] [explicit,name "silent"] |]) @@ -283,6 +285,7 @@ isHelp ["-h"] [] isHelp ["-h"] ["GROUP:"] fails ["--version"] + fails ["--numeric-version"] fails ["--verbose"] fails ["--quiet"] isVerbosity ["--help","--silent"] Quiet @@ -292,11 +295,12 @@ data Test16 = Test16 {test16a :: MyInt, test16b :: [MyInt]} deriving (Eq,Show,Data,Typeable) -mode16 = cmdArgsMode $ Test16 (MyInt 12) [] +mode16 = cmdArgsMode $ Test16 (MyInt 12) [] &= summary "The Glorious Glasgow Haskell Compilation System, version 7.6.3" test16 = do let Tester{..} = tester "Test16" mode16 [] === Test16 (MyInt 12) [] + isVersion ["--numeric-version"] "7.6.3" fails ["--test16a"] ["--test16a=5"] === Test16 (MyInt 5) [] ["--test16b=5","--test16b=82"] === Test16 (MyInt 12) [MyInt 5, MyInt 82] @@ -305,24 +309,111 @@ -- not actually checked because this path doesn't go through processArgs data Test17 = Test17 {test17_ :: [String]} deriving (Eq,Show,Data,Typeable) -mode17 = cmdArgsMode $ Test17 ([] &= args) &= noAtExpand +mode17 = cmdArgsMode $ Test17 ([] &= args) &= noAtExpand &= summary "bzip2 3.5-windows version" test17 = do let Tester{..} = tester "Test17" mode17 [] === Test17 [] ["test","of","this"] === Test17 ["test","of","this"] ["test","--","@foo"] === Test17 ["test","@foo"] + isVersion ["--numeric-version"] "3.5-windows" +data Debuggable = This | That deriving (Eq,Show,Data,Typeable) +data Test18 = Test18 {test18_ :: [Debuggable]} deriving (Eq,Show,Data,Typeable) + +mode18 = cmdArgsMode $ Test18 $ enum [[] &= ignore, [This] &= name "debug-this", [That] &= name "debug-that"] + +test18 = do + let Tester{..} = tester "Test18" mode18 + [] === Test18 [] + ["--debug-this","--debug-that","--debug-this"] === Test18 [This,That,This] + +-- #610, check performance for long lists (took ~20s before) + +data Test19 = Test19 {test19_ :: [String]} deriving (Eq,Show,Data,Typeable) + +mode19 = cmdArgsMode $ Test19 ([] &= args) + +test19 = do + let Tester{..} = tester "Test19" mode19 + let args = map show [1..1000] + args === Test19 args + + +-- #615, newtype wrappers of lists/Maybe should accumulate properly + +newtype Test20A = Test20A [String] deriving (Eq,Show,Data,Typeable) +data Test20 = Test20 {test20_ :: Test20A} deriving (Eq,Show,Data,Typeable) + +mode20 = cmdArgsMode $ Test20 (Test20A [] &= args) + +test20 = do + let Tester{..} = tester "Test20" mode20 + ["a","b","c"] === Test20 (Test20A ["a","b","c"]) + + +-- #626, don't reverse values too much + +newtype Test21A = Test21A [String] deriving (Eq,Show,Data,Typeable) +data Test21 = Test21 {test21A :: Test21A, test21B :: [String], test21C :: [Int]} deriving (Eq,Show,Data,Typeable) + +mode21 = cmdArgsMode $ Test21 (Test21A ["a","b","c"]) ["A","B","C"] [1,2,3] + +test21 = do + let Tester{..} = tester "Test21" mode21 + [] === Test21 (Test21A ["a","b","c"]) ["A","B","C"] [1,2,3] + +-- #10, don't break elm-server + +data Test22 = Test22 {port :: Int, runtime :: Maybe FilePath} deriving (Data,Typeable,Show,Eq) + +mode22 = cmdArgsMode $ Test22 + { port = 8000 &= help "set the port of the server" + , runtime = Nothing &= typFile + &= help "Specify a custom location for Elm's runtime system." + } &= help "Quickly reload Elm projects in your browser. Just refresh to recompile.\n\ + \It serves static files and freshly recompiled Elm files." + &= helpArg [explicit, name "help", name "h"] + &= versionArg [ explicit, name "version", name "v" + , summary "0.12.0.1" + ] + &= summary "Elm Server 0.11.0.1, (c) Evan Czaplicki 2011-2014" + +test22 = do + let Tester{..} = tester "Test22" mode22 + [] === Test22 8000 Nothing + isVersion ["-v"] "0.12.0.1" + isVersion ["--version"] "0.12.0.1" + isVersion ["--numeric-version"] "0.12.0.1" + isHelp ["--help"] ["Elm Server 0.11.0.1, (c) Evan Czaplicki 2011-2014"] + isHelp ["--h"] ["Elm Server 0.11.0.1, (c) Evan Czaplicki 2011-2014"] + fails ["-?"] + ["--port=20"] === Test22 20 Nothing + ["--runtime=20"] === Test22 8000 (Just "20") + fails ["bob"] + +-- # 24, doesn't work with Ratio + +data Test23 = Test23 {test23A :: Ratio Int} deriving (Show, Data, Typeable, Eq) + +mode23 = cmdArgsMode $ Test23 {test23A = 4 % 7 } + +test23 = do + let Tester{..} = tester "Test23" mode23 + [] === Test23 (4 % 7) + ["--test23=1,6"] === Test23 (1 % 6) + + -- For some reason, these must be at the end, otherwise the Template Haskell -- stage restriction kicks in. test = test1 >> test2 >> test3 >> test4 >> test5 >> test6 >> test7 >> test8 >> test9 >> test10 >> - test11 >> test12 >> test13 >> test14 >> test15 >> test16 + test11 >> test12 >> test13 >> test14 >> test15 >> test16 >> test18 >> test19 >> test20 >> + test21 >> test22 >> test23 demos = zipWith f [1..] [toDemo mode1, toDemo mode2, toDemo mode3, toDemo mode4, toDemo mode5, toDemo mode6 ,toDemo mode7, toDemo mode8, toDemo mode9, toDemo mode10, toDemo mode11, toDemo mode12 - ,toDemo mode13, toDemo mode14, toDemo mode15, toDemo mode16, toDemo mode17] + ,toDemo mode13, toDemo mode14, toDemo mode15, toDemo mode16, toDemo mode17, toDemo mode18 + ,toDemo mode19, toDemo mode20, toDemo mode21, toDemo mode22, toDemo mode23] where f i x = x{modeHelp = "Testing various corner cases (" ++ show i ++ ")"} - - diff --git a/System/Console/CmdArgs/Test/Implicit/Util.hs b/System/Console/CmdArgs/Test/Implicit/Util.hs --- a/System/Console/CmdArgs/Test/Implicit/Util.hs +++ b/System/Console/CmdArgs/Test/Implicit/Util.hs @@ -73,17 +73,21 @@ Left x -> success Right x -> failed "Succeeded 52 should have failed" args [("Result",show x)] + showGot sel x = [("Got",show got) | Right x <- [x], Just got <- [sel x]] + isHelp args want = f args $ \x -> case x of Right x | Just got <- cmdArgsHelp x, match want (lines got) -> success - _ -> failed "Failed on isHelp" args [("Want",show want)] + _ -> failed "Failed on isHelp" args $ + ("Want",show want) : showGot cmdArgsHelp x isHelpNot args want = f args $ \x -> case x of Right x | Just got <- cmdArgsHelp x, not $ match want (lines got) -> success _ -> failed "Failed on isHelpNot" args [] isVersion args want = f args $ \x -> case x of - Right x | Just got <- cmdArgsVersion x, match [want] (lines got) -> success - _ -> failed "Failed on isVersion" args [("Want",want)] + Right x | Just got <- cmdArgsVersion x, (want ++ "\n") == got -> success + _ -> failed "Failed on isVersion" args $ + ("Want",show $ want ++ "\n") : showGot cmdArgsVersion x isVerbosity args v = f args $ \x -> case x of Right x | fromMaybe Normal (cmdArgsVerbosity x) == v -> success @@ -106,4 +110,3 @@ matchLine (x:xs) (y:ys) | x == y = matchLine xs ys matchLine [] [] = True matchLine _ _ = False - diff --git a/System/Console/CmdArgs/Test/SplitJoin.hs b/System/Console/CmdArgs/Test/SplitJoin.hs --- a/System/Console/CmdArgs/Test/SplitJoin.hs +++ b/System/Console/CmdArgs/Test/SplitJoin.hs @@ -28,7 +28,7 @@ writeFile src "import System.Environment\nmain = print =<< getArgs\n" quickCheckWith stdArgs{chatty=False} $ \(CmdLine x) -> unsafePerformIO $ do putStr $ ",(,) " ++ (show x) ++ " " - system $ "runhaskell \"" ++ src ++ "\" " ++ x + system $ "runghc \"" ++ src ++ "\" " ++ x return True @@ -45,104 +45,105 @@ -- * Slow to run through the command line -- * Can't figure out how to read the output, without adding more escaping (which breaks the test) tests = - [(,) "" [] - ,(,) "c" ["c"] - ,(,) "b" ["b"] - ,(,) "\\" ["\\"] - ,(,) "'//" ["'//"] - ,(,) "a" ["a"] - ,(,) "cda" ["cda"] - ,(,) "b'" ["b'"] - ,(,) "" [] - ,(,) " " [] - ,(,) "/b" ["/b"] - ,(,) "\"b/\"d a'b'b" ["b/d","a'b'b"] - ,(,) "d'c a\"/\\" ["d'c","a/\\"] - ,(,) "d" ["d"] - ,(,) "bb' " ["bb'"] - ,(,) "b'\\" ["b'\\"] - ,(,) "\"\\ac" ["\\ac"] - ,(,) "\\'\"abbb\"c/''' \\ c" ["\\'abbbc/'''","\\","c"] - ,(,) "/bbdbb a " ["/bbdbb","a"] - ,(,) "b\" d" ["b d"] - ,(,) "" [] - ,(,) "\\cc/''\\b\\ccc\\'\\b\\" ["\\cc/''\\b\\ccc\\'\\b\\"] - ,(,) "/" ["/"] - ,(,) "///\"b\\c/b\"cd//c'\"" ["///b\\c/bcd//c'"] - ,(,) "\\\"d\\\\' /d\\\\/bb'a /\\d" ["\"d\\\\'","/d\\\\/bb'a","/\\d"] - ,(,) "c/ \\''/c b\\'" ["c/","\\''/c","b\\'"] - ,(,) "dd'b\\\\\\' /c'aaa\"" ["dd'b\\\\\\'","/c'aaa"] - ,(,) "b'd''\\/ b\\'b'db/'cd " ["b'd''\\/","b\\'b'db/'cd"] - ,(,) "a\"ba\\/\\ " ["aba\\/\\ "] - ,(,) "b\"'dd'c /b/c\"bbd \"\"\\ad'\"c\\\"" ["b'dd'c /b/cbbd","\\ad'c\""] - ,(,) "da 'c\\\\acd/'dbaaa///dccbc a \\" ["da","'c\\\\acd/'dbaaa///dccbc","a","\\"] - ,(,) "a'ac \"da\"" ["a'ac","da"] - ,(,) "\"'\\\"/\"\"b\\b \"'\"\"ccd'a\"/c /da " ["'\"/\"b\\b","'\"ccd'a/c /da "] - ,(,) "d\"\\c\\\\cb c/\"aa' b\"\\/d \"'c c/" ["d\\c\\\\cb c/aa'","b\\/d 'c","c/"] - ,(,) "dbc\\/\"\"//c/\"accda" ["dbc\\///c/accda"] - ,(,) "aca a'' \\ c b'\\/d\\" ["aca","a''","\\","c","b'\\/d\\"] - ,(,) "dc\"bc/a\\ccdd\\\\aad\\c'ab '\\cddcdba" ["dcbc/a\\ccdd\\\\aad\\c'ab '\\cddcdba"] - ,(,) " c'\"ba \"b\\dc\"" ["c'ba b\\dc"] - ,(,) "a\\acd/a \"'c /'c'" ["a\\acd/a","'c /'c'"] - ,(,) " ac ddc/\"\"a/\\bd\\d c'cac\"c\\a/a''c" ["ac","ddc/a/\\bd\\d","c'cacc\\a/a''c"] - ,(,) "b/cd\"//bb\"/daaab/ b b \"' d\"a\" 'd b" ["b/cd//bb/daaab/","b","b","' da 'd b"] - ,(,) "a\"cc'cd\"\\'ad '\"dcc acb\"\\\\" ["acc'cd\\'ad","'dcc acb\\\\"] - ,(,) "/bc/bc'/\"d \"a/\"\\ad aba\\da" ["/bc/bc'/d a/\\ad aba\\da"] - ,(,) "b\\a" ["b\\a"] - ,(,) "/dc ''c'a\"'/'\\ /'cd\\'d/'db/b\"' cabacaaa\"\"dd" ["/dc","''c'a'/'\\ /'cd\\'d/'db/b'","cabacaaadd"] - ,(,) "\"ac\\\"c'/c'b\"b\"b'd\"c\"\"" ["ac\"c'/c'bbb'dc"] - ,(,) "/ 'ccc\"d\\dc'\"'\\ b" ["/","'cccd\\dc''\\","b"] - ,(,) " '\"/\\cc\\/c '\\\\" ["'/\\cc\\/c '\\\\"] - ,(,) "\\ \\' ' /d \"cc\\\\//da\"d'a/a\"ca\\\\\"\\cb c\"d'b 'acb" ["\\","\\'","'","/d","cc\\\\//dad'a/aca\\\\cb","cd'b 'acb"] - ,(,) "a\"\"d'\"a\"\\ \\c db'da/d\\c\"a/ aa c/db" ["ad'a\\","\\c","db'da/d\\ca/ aa c/db"] - ,(,) " d\\" ["d\\"] - ,(,) "d c b'/\\/'\"/'a'aa\"a\"/ad\\/" ["d","c","b'/\\/'/'a'aaa/ad\\/"] - ,(,) " a \\' /" ["a","\\'","/"] - ,(,) "'/ c" ["'/","c"] - ,(,) "acd 'bcab /ba'daa'/ba/\"dcdadbcacb" ["acd","'bcab","/ba'daa'/ba/dcdadbcacb"] - ,(,) "a\\\"dd'a c\"a\"\"ac\\" ["a\"dd'a","ca\"ac\\"] - ,(,) "\"dba /'bb\\ d ba '/c' \"dd\\' cbcd c /b/\\b///" ["dba /'bb\\ d ba '/c' dd\\'","cbcd","c","/b/\\b///"] - ,(,) "a'c/c \"ccb '/d\\abd/bc " ["a'c/c","ccb '/d\\abd/bc "] - ,(,) "\\da\"\\//add\\\\ c" ["\\da\\//add\\\\ c"] - ,(,) "c/\\\"// a/\"ac\"//''ba\"c/\\bc\\\"d\"bc/d" ["c/\"//","a/ac//''bac/\\bc\"dbc/d"] - ,(,) "/d/ a dc'\\ \"" ["/d/","a","dc'\\",""] - ,(,) " \"dc//b\\cd/ \\ac\"b\"b\"d\"\"\"dd\"\" ' a\\'/ \"/'/\\a/abd\\ddd" ["dc//b\\cd/ \\acbbd\"dd","'","a\\'/","/'/\\a/abd\\ddd"] - ,(,) "\\' ' d\"b bbc" ["\\'","'","db bbc"] - ,(,) "'ba\\a'db/bd d\\'b\\ \\/a'da' " ["'ba\\a'db/bd","d\\'b\\","\\/a'da'"] - ,(,) "\\b\\cc\"\"d' dd ddcb\"d" ["\\b\\ccd'","dd","ddcbd"] - ,(,) "d\"dc'\\d\"/'\\\"b\\c'c\" db' \\'b/\"a' / da'\"/ab'\\ c\\bc\\//dbcb\\" ["ddc'\\d/'\"b\\c'c db' \\'b/a'","/","da'/ab'\\ c\\bc\\//dbcb\\"] - ,(,) " b ddbbbbc\"da\\c\"'\\" ["b","ddbbbbcda\\c'\\"] - ,(,) "b/\"d dacd'/'\\\"''a a /'\\c'b ab\\ dda\\c'abdd'a\"//d \\\\\\ d\"\"" ["b/d dacd'/'\"''a a /'\\c'b ab\\ dda\\c'abdd'a//d","\\\\\\","d"] - ,(,) "/c\"\" dd'a'/b\\/'\"'/" ["/c","dd'a'/b\\/''/"] - ,(,) "/\"'\"\"'cc a a\\dd''\\'b" ["/'\"'cc","a","a\\dd''\\'b"] - ,(,) "c\"dcd''aba\" \" /'" ["cdcd''aba"," /'"] - ,(,) "'\"/''\\\\d'/ad\\baadabdca\\ /\\'''bd\\/\"'/' aca \\ \\a'\\ cd\"d /bdcd''cac" ["'/''\\\\d'/ad\\baadabdca\\ /\\'''bd\\/'/'","aca","\\","\\a'\\","cdd /bdcd''cac"] - ,(,) "\" /\"da" [" /da"] - ,(,) "'\"ca/'d/d/d\\ca\"/\"\" ddac cc\" ''a c''bd\"bc'dc\\/\"b\"a\\\"\"a/\\ " ["'ca/'d/d/d\\ca/","ddac","cc ''a c''bdbc'dc\\/ba\"a/\\ "] - ,(,) "\\\\d'ad ' ''\"cd/a \"\"\\'\\\"'dc\\" ["\\\\d'ad","'","''cd/a \"\\'\"'dc\\"] - ,(,) " ab c'\\a" ["ab","c'\\a"] - ,(,) "b" ["b"] - ,(,) "''c dc c\\'d'ab'd\"\\\"cca\"b'da\"dbcdbd\"cd'/d \\cd'\"d \"\"b cdc''/\\\"b'" ["''c","dc","c\\'d'ab'd\"ccab'dadbcdbdcd'/d","\\cd'd \"b","cdc''/\"b'"] - ,(,) " \"'cb dbddbdd/" ["'cb dbddbdd/"] - ,(,) "a/\"d// dd/cc/\"cc\"d\" d\\/a a \\c\" \\\\/\"\\ bcc'ac'\"\\c//d\"da/\\aac\\b\"c/'b\"\"bbd/\\" ["a/d// dd/cc/ccd","d\\/a","a","\\c \\\\/\\","bcc'ac'\\c//dda/\\aac\\bc/'b\"bbd/\\"] - ,(,) "b\"ddccd\"a\"/ba\"" ["bddccda/ba"] - ,(,) " \" c/b/'/bdd cb d'c a'\"'a d\\\\db//\\\"' c'/'c\\/aa" [" c/b/'/bdd cb d'c a''a","d\\\\db//\"'","c'/'c\\/aa"] - ,(,) "\\caab" ["\\caab"] - ,(,) "bb\"'\"/d'bad 'd\\/'\\b//\\\\ \\d''c\"c b\\b/\\" ["bb'/d'bad","'d\\/'\\b//\\\\","\\d''cc b\\b/\\"] - ,(,) " c'a\" \\cab\"bd\"dcd\"/cb/\"\"b\"b'\"d" ["c'a \\cabbddcd/cb/bb'd"] - ,(,) "\\/ \"c'ca" ["\\/","c'ca"] - ,(,) " d' /c'bc\"'/'\\\\dca'cc\"'\"''/d cb//'a \"bd ab\"dcaadc\\\"'d\\\"/a\"a\\\"ba//b/ d/dbac/d\\caa\"bc/ " ["d'","/c'bc'/'\\\\dca'cc'''/d cb//'a bd","abdcaadc\"'d\"/aa\"ba//b/","d/dbac/d\\caabc/ "] - ,(,) "/\"\\db'd/ ca\"ad b\\\\\"cd/a bbc\\ " ["/\\db'd/ caad","b\\cd/a bbc\\ "] - ,(,) "cdc bd'/\"c''c d \\\"aa \\d\\ bb'b/ /b/a/c'acda\\'\"\"c \"bbbaa/'/a \\aca\"'/ac' " ["cdc","bd'/c''c d \"aa \\d\\ bb'b/ /b/a/c'acda\\'\"c","bbbaa/'/a \\aca'/ac'"] - ,(,) "ad/'b\\d /cc\"\"ab \\ \"' ''b\\\"/\\ a\"'d\"\\ddacdbbabb b b //' acd\"c\\d'd\\b\"'\\\"aaba/bda/c'// \\b" ["ad/'b\\d","/ccab","\\","' ''b\"/\\ a'd\\ddacdbbabb b b //' acdc\\d'd\\b'\"aaba/bda/c'// \\b"] - ,(,) "bac cc \"ac\"/ca/ '\"\" b/b d /cd'\\'bb\" \\ \"b '/ b c ' c''\"a/ad\\ " ["bac","cc","ac/ca/","'","b/b","d","/cd'\\'bb \\ b","'/","b","c","'","c''a/ad\\ "] - ,(,) "baa' b'b''\\dab/'c" ["baa'","b'b''\\dab/'c"] - ,(,) "cb\\\\ " ["cb\\\\"] - ,(,) "/b'a''d\"b\" 'c'b ba\\'b\" bb" ["/b'a''db","'c'b","ba\\'b bb"] - ,(,) "b /\"ca\\cbac " ["b","/ca\\cbac "] - ,(,) " \"\"/\"bcaa\"\"a' \\/bb \"a\\\"'\"" ["/bcaa\"a'","\\/bb","a\"'"] - ,(,) "\"c /''c\"\\badc/\\daa/\\ c\"a c\\ \\/cab \"b\"\\ ba\"\"/d/cd'a ad'c/ad\"' a\\d/d\\c\\'cdccd/\"a'/\"b///ac\"" ["c /''c\\badc/\\daa/\\","ca c\\ \\/cab b\\ ba\"/d/cd'a","ad'c/ad' a\\d/d\\c\\'cdccd/a'/b///ac"] - ,(,) "/cbbd\"/b' /dd\"/c\\ca/'\"\\ cc \\d\"aca/\"b caa\\d\\'\"b'b dc\"cd\\'c\" 'd/ac\"cacc\"" ["/cbbd/b' /dd/c\\ca/'\\ cc \\daca/b caa\\d\\'b'b","dccd\\'c","'d/accacc"] - ,(,) "bc/bd\\ca\\bcacca\"\"\\c/\\ /\"\"a/\"c'//b'\\d/a/'ab/cbd/cacb//b \\d\"aac\\d'\"/" ["bc/bd\\ca\\bcacca\\c/\\","/a/c'//b'\\d/a/'ab/cbd/cacb//b \\daac\\d'/"] - ,(,) "bbac bdc/d\\\"/db\"dbdb\"a \" /\"/'a\\acacbcc c'//\\//b\"ca\"bcca c\\/aaa/c/bccbccaa \"\" cdccc/bddcbc c''" ["bbac","bdc/d\"/dbdbdba"," //'a\\acacbcc","c'//\\//bcabcca","c\\/aaa/c/bccbccaa","","cdccc/bddcbc","c''"] + [f "" [] + ,f "c" ["c"] + ,f "b" ["b"] + ,f "\\" ["\\"] + ,f "'//" ["'//"] + ,f "a" ["a"] + ,f "cda" ["cda"] + ,f "b'" ["b'"] + ,f "" [] + ,f " " [] + ,f "/b" ["/b"] + ,f "\"b/\"d a'b'b" ["b/d","a'b'b"] + ,f "d'c a\"/\\" ["d'c","a/\\"] + ,f "d" ["d"] + ,f "bb' " ["bb'"] + ,f "b'\\" ["b'\\"] + ,f "\"\\ac" ["\\ac"] + ,f "\\'\"abbb\"c/''' \\ c" ["\\'abbbc/'''","\\","c"] + ,f "/bbdbb a " ["/bbdbb","a"] + ,f "b\" d" ["b d"] + ,f "" [] + ,f "\\cc/''\\b\\ccc\\'\\b\\" ["\\cc/''\\b\\ccc\\'\\b\\"] + ,f "/" ["/"] + ,f "///\"b\\c/b\"cd//c'\"" ["///b\\c/bcd//c'"] + ,f "\\\"d\\\\' /d\\\\/bb'a /\\d" ["\"d\\\\'","/d\\\\/bb'a","/\\d"] + ,f "c/ \\''/c b\\'" ["c/","\\''/c","b\\'"] + ,f "dd'b\\\\\\' /c'aaa\"" ["dd'b\\\\\\'","/c'aaa"] + ,f "b'd''\\/ b\\'b'db/'cd " ["b'd''\\/","b\\'b'db/'cd"] + ,f "a\"ba\\/\\ " ["aba\\/\\ "] + ,f "b\"'dd'c /b/c\"bbd \"\"\\ad'\"c\\\"" ["b'dd'c /b/cbbd","\\ad'c\""] + ,f "da 'c\\\\acd/'dbaaa///dccbc a \\" ["da","'c\\\\acd/'dbaaa///dccbc","a","\\"] + ,f "a'ac \"da\"" ["a'ac","da"] + ,f "\"'\\\"/\"\"b\\b \"'\"\"ccd'a\"/c /da " ["'\"/\"b\\b","'\"ccd'a/c /da "] + ,f "d\"\\c\\\\cb c/\"aa' b\"\\/d \"'c c/" ["d\\c\\\\cb c/aa'","b\\/d 'c","c/"] + ,f "dbc\\/\"\"//c/\"accda" ["dbc\\///c/accda"] + ,f "aca a'' \\ c b'\\/d\\" ["aca","a''","\\","c","b'\\/d\\"] + ,f "dc\"bc/a\\ccdd\\\\aad\\c'ab '\\cddcdba" ["dcbc/a\\ccdd\\\\aad\\c'ab '\\cddcdba"] + ,f " c'\"ba \"b\\dc\"" ["c'ba b\\dc"] + ,f "a\\acd/a \"'c /'c'" ["a\\acd/a","'c /'c'"] + ,f " ac ddc/\"\"a/\\bd\\d c'cac\"c\\a/a''c" ["ac","ddc/a/\\bd\\d","c'cacc\\a/a''c"] + ,f "b/cd\"//bb\"/daaab/ b b \"' d\"a\" 'd b" ["b/cd//bb/daaab/","b","b","' da 'd b"] + ,f "a\"cc'cd\"\\'ad '\"dcc acb\"\\\\" ["acc'cd\\'ad","'dcc acb\\\\"] + ,f "/bc/bc'/\"d \"a/\"\\ad aba\\da" ["/bc/bc'/d a/\\ad aba\\da"] + ,f "b\\a" ["b\\a"] + ,f "/dc ''c'a\"'/'\\ /'cd\\'d/'db/b\"' cabacaaa\"\"dd" ["/dc","''c'a'/'\\ /'cd\\'d/'db/b'","cabacaaadd"] + ,f "\"ac\\\"c'/c'b\"b\"b'd\"c\"\"" ["ac\"c'/c'bbb'dc"] + ,f "/ 'ccc\"d\\dc'\"'\\ b" ["/","'cccd\\dc''\\","b"] + ,f " '\"/\\cc\\/c '\\\\" ["'/\\cc\\/c '\\\\"] + ,f "\\ \\' ' /d \"cc\\\\//da\"d'a/a\"ca\\\\\"\\cb c\"d'b 'acb" ["\\","\\'","'","/d","cc\\\\//dad'a/aca\\\\cb","cd'b 'acb"] + ,f "a\"\"d'\"a\"\\ \\c db'da/d\\c\"a/ aa c/db" ["ad'a\\","\\c","db'da/d\\ca/ aa c/db"] + ,f " d\\" ["d\\"] + ,f "d c b'/\\/'\"/'a'aa\"a\"/ad\\/" ["d","c","b'/\\/'/'a'aaa/ad\\/"] + ,f " a \\' /" ["a","\\'","/"] + ,f "'/ c" ["'/","c"] + ,f "acd 'bcab /ba'daa'/ba/\"dcdadbcacb" ["acd","'bcab","/ba'daa'/ba/dcdadbcacb"] + ,f "a\\\"dd'a c\"a\"\"ac\\" ["a\"dd'a","ca\"ac\\"] + ,f "\"dba /'bb\\ d ba '/c' \"dd\\' cbcd c /b/\\b///" ["dba /'bb\\ d ba '/c' dd\\'","cbcd","c","/b/\\b///"] + ,f "a'c/c \"ccb '/d\\abd/bc " ["a'c/c","ccb '/d\\abd/bc "] + ,f "\\da\"\\//add\\\\ c" ["\\da\\//add\\\\ c"] + ,f "c/\\\"// a/\"ac\"//''ba\"c/\\bc\\\"d\"bc/d" ["c/\"//","a/ac//''bac/\\bc\"dbc/d"] + ,f "/d/ a dc'\\ \"" ["/d/","a","dc'\\",""] + ,f " \"dc//b\\cd/ \\ac\"b\"b\"d\"\"\"dd\"\" ' a\\'/ \"/'/\\a/abd\\ddd" ["dc//b\\cd/ \\acbbd\"dd","'","a\\'/","/'/\\a/abd\\ddd"] + ,f "\\' ' d\"b bbc" ["\\'","'","db bbc"] + ,f "'ba\\a'db/bd d\\'b\\ \\/a'da' " ["'ba\\a'db/bd","d\\'b\\","\\/a'da'"] + ,f "\\b\\cc\"\"d' dd ddcb\"d" ["\\b\\ccd'","dd","ddcbd"] + ,f "d\"dc'\\d\"/'\\\"b\\c'c\" db' \\'b/\"a' / da'\"/ab'\\ c\\bc\\//dbcb\\" ["ddc'\\d/'\"b\\c'c db' \\'b/a'","/","da'/ab'\\ c\\bc\\//dbcb\\"] + ,f " b ddbbbbc\"da\\c\"'\\" ["b","ddbbbbcda\\c'\\"] + ,f "b/\"d dacd'/'\\\"''a a /'\\c'b ab\\ dda\\c'abdd'a\"//d \\\\\\ d\"\"" ["b/d dacd'/'\"''a a /'\\c'b ab\\ dda\\c'abdd'a//d","\\\\\\","d"] + ,f "/c\"\" dd'a'/b\\/'\"'/" ["/c","dd'a'/b\\/''/"] + ,f "/\"'\"\"'cc a a\\dd''\\'b" ["/'\"'cc","a","a\\dd''\\'b"] + ,f "c\"dcd''aba\" \" /'" ["cdcd''aba"," /'"] + ,f "'\"/''\\\\d'/ad\\baadabdca\\ /\\'''bd\\/\"'/' aca \\ \\a'\\ cd\"d /bdcd''cac" ["'/''\\\\d'/ad\\baadabdca\\ /\\'''bd\\/'/'","aca","\\","\\a'\\","cdd /bdcd''cac"] + ,f "\" /\"da" [" /da"] + ,f "'\"ca/'d/d/d\\ca\"/\"\" ddac cc\" ''a c''bd\"bc'dc\\/\"b\"a\\\"\"a/\\ " ["'ca/'d/d/d\\ca/","ddac","cc ''a c''bdbc'dc\\/ba\"a/\\ "] + ,f "\\\\d'ad ' ''\"cd/a \"\"\\'\\\"'dc\\" ["\\\\d'ad","'","''cd/a \"\\'\"'dc\\"] + ,f " ab c'\\a" ["ab","c'\\a"] + ,f "b" ["b"] + ,f "''c dc c\\'d'ab'd\"\\\"cca\"b'da\"dbcdbd\"cd'/d \\cd'\"d \"\"b cdc''/\\\"b'" ["''c","dc","c\\'d'ab'd\"ccab'dadbcdbdcd'/d","\\cd'd \"b","cdc''/\"b'"] + ,f " \"'cb dbddbdd/" ["'cb dbddbdd/"] + ,f "a/\"d// dd/cc/\"cc\"d\" d\\/a a \\c\" \\\\/\"\\ bcc'ac'\"\\c//d\"da/\\aac\\b\"c/'b\"\"bbd/\\" ["a/d// dd/cc/ccd","d\\/a","a","\\c \\\\/\\","bcc'ac'\\c//dda/\\aac\\bc/'b\"bbd/\\"] + ,f "b\"ddccd\"a\"/ba\"" ["bddccda/ba"] + ,f " \" c/b/'/bdd cb d'c a'\"'a d\\\\db//\\\"' c'/'c\\/aa" [" c/b/'/bdd cb d'c a''a","d\\\\db//\"'","c'/'c\\/aa"] + ,f "\\caab" ["\\caab"] + ,f "bb\"'\"/d'bad 'd\\/'\\b//\\\\ \\d''c\"c b\\b/\\" ["bb'/d'bad","'d\\/'\\b//\\\\","\\d''cc b\\b/\\"] + ,f " c'a\" \\cab\"bd\"dcd\"/cb/\"\"b\"b'\"d" ["c'a \\cabbddcd/cb/bb'd"] + ,f "\\/ \"c'ca" ["\\/","c'ca"] + ,f " d' /c'bc\"'/'\\\\dca'cc\"'\"''/d cb//'a \"bd ab\"dcaadc\\\"'d\\\"/a\"a\\\"ba//b/ d/dbac/d\\caa\"bc/ " ["d'","/c'bc'/'\\\\dca'cc'''/d cb//'a bd","abdcaadc\"'d\"/aa\"ba//b/","d/dbac/d\\caabc/ "] + ,f "/\"\\db'd/ ca\"ad b\\\\\"cd/a bbc\\ " ["/\\db'd/ caad","b\\cd/a bbc\\ "] + ,f "cdc bd'/\"c''c d \\\"aa \\d\\ bb'b/ /b/a/c'acda\\'\"\"c \"bbbaa/'/a \\aca\"'/ac' " ["cdc","bd'/c''c d \"aa \\d\\ bb'b/ /b/a/c'acda\\'\"c","bbbaa/'/a \\aca'/ac'"] + ,f "ad/'b\\d /cc\"\"ab \\ \"' ''b\\\"/\\ a\"'d\"\\ddacdbbabb b b //' acd\"c\\d'd\\b\"'\\\"aaba/bda/c'// \\b" ["ad/'b\\d","/ccab","\\","' ''b\"/\\ a'd\\ddacdbbabb b b //' acdc\\d'd\\b'\"aaba/bda/c'// \\b"] + ,f "bac cc \"ac\"/ca/ '\"\" b/b d /cd'\\'bb\" \\ \"b '/ b c ' c''\"a/ad\\ " ["bac","cc","ac/ca/","'","b/b","d","/cd'\\'bb \\ b","'/","b","c","'","c''a/ad\\ "] + ,f "baa' b'b''\\dab/'c" ["baa'","b'b''\\dab/'c"] + ,f "cb\\\\ " ["cb\\\\"] + ,f "/b'a''d\"b\" 'c'b ba\\'b\" bb" ["/b'a''db","'c'b","ba\\'b bb"] + ,f "b /\"ca\\cbac " ["b","/ca\\cbac "] + ,f " \"\"/\"bcaa\"\"a' \\/bb \"a\\\"'\"" ["/bcaa\"a'","\\/bb","a\"'"] + ,f "\"c /''c\"\\badc/\\daa/\\ c\"a c\\ \\/cab \"b\"\\ ba\"\"/d/cd'a ad'c/ad\"' a\\d/d\\c\\'cdccd/\"a'/\"b///ac\"" ["c /''c\\badc/\\daa/\\","ca c\\ \\/cab b\\ ba\"/d/cd'a","ad'c/ad' a\\d/d\\c\\'cdccd/a'/b///ac"] + ,f "/cbbd\"/b' /dd\"/c\\ca/'\"\\ cc \\d\"aca/\"b caa\\d\\'\"b'b dc\"cd\\'c\" 'd/ac\"cacc\"" ["/cbbd/b' /dd/c\\ca/'\\ cc \\daca/b caa\\d\\'b'b","dccd\\'c","'d/accacc"] + ,f "bc/bd\\ca\\bcacca\"\"\\c/\\ /\"\"a/\"c'//b'\\d/a/'ab/cbd/cacb//b \\d\"aac\\d'\"/" ["bc/bd\\ca\\bcacca\\c/\\","/a/c'//b'\\d/a/'ab/cbd/cacb//b \\daac\\d'/"] + ,f "bbac bdc/d\\\"/db\"dbdb\"a \" /\"/'a\\acacbcc c'//\\//b\"ca\"bcca c\\/aaa/c/bccbccaa \"\" cdccc/bddcbc c''" ["bbac","bdc/d\"/dbdbdba"," //'a\\acacbcc","c'//\\//bcabcca","c\\/aaa/c/bccbccaa","","cdccc/bddcbc","c''"] ] + where f = (,) diff --git a/System/Console/CmdArgs/Text.hs b/System/Console/CmdArgs/Text.hs --- a/System/Console/CmdArgs/Text.hs +++ b/System/Console/CmdArgs/Text.hs @@ -107,7 +107,7 @@ -- | Split the text into strips of no-more than the given width wrap :: Int -> String -> [String] -wrap width = combine . split +wrap width = concatMap (combine . split) . lines where split :: String -> [(String,Int)] -- string, amount of space after split "" = [] @@ -131,18 +131,24 @@ map f xs ++ [""] where - cols = maximum [length x | Cols x <- xs] + maxCols = maximum [length x | Cols x <- xs] - f (Line x) = tr $ td cols x - f (Cols xs) = tr $ concatMap (td 1) (init xs) ++ td (cols + 1 - length xs) (last xs) + f (Line x) = tr $ td maxCols x + f (Cols xs) = tr $ concatMap (td 1) (init xs) ++ td (maxCols + 1 - length xs) (last xs) tr x = "" ++ x ++ "" td cols x = "" ++ if null b then " " else concatMap esc b ++ "" where (a,b) = span isSpace x + -- if the first letter of the contents is '-', assume this is a flag + -- and be aware that HTML might try to line-break it, see #39 + isFlag = take 1 b == "-" + styles = [ "padding-left:" ++ show (length a) ++ "ex;" | a /= "" ] + ++ [ "white-space:nowrap;" | isFlag ] esc '&' = "&" esc '>' = ">" esc '<' = "<" + esc '\n' = "
" esc x = [x] diff --git a/cmdargs.cabal b/cmdargs.cabal --- a/cmdargs.cabal +++ b/cmdargs.cabal @@ -1,13 +1,13 @@ -cabal-version: >= 1.6 +cabal-version: 1.18 build-type: Simple name: cmdargs -version: 0.10 +version: 0.10.22 license: BSD3 license-file: LICENSE category: Console author: Neil Mitchell maintainer: Neil Mitchell -copyright: Neil Mitchell 2009-2012 +copyright: Neil Mitchell 2009-2023 synopsis: Command line argument processing description: This library provides an easy way to define command line parsers. Most users @@ -28,35 +28,43 @@ . For a general reference on what command line flags are commonly used, see . -homepage: http://community.haskell.org/~ndm/cmdargs/ -stability: Beta -extra-source-files: - cmdargs.htm +bug-reports: https://github.com/ndmitchell/cmdargs/issues +homepage: https://github.com/ndmitchell/cmdargs#readme +extra-doc-files: + README.md + CHANGES.txt +tested-with: GHC==9.2, GHC==9.0, GHC==8.10, GHC==8.8, GHC==8.6, GHC==8.4, GHC==8.2, GHC==8.0 source-repository head - type: darcs - location: http://community.haskell.org/~ndm/darcs/cmdargs/ + type: git + location: https://github.com/ndmitchell/cmdargs.git flag testprog - default: True + default: False + manual: True description: Build the test program flag quotation default: True + manual: True description: Build the Quote module library + default-language: Haskell2010 build-depends: - base == 4.*, + base >= 4.4 && < 5, filepath, - transformers >= 0.2 && < 0.4, - process >= 1.0 && < 1.2 + transformers >= 0.2, + process >= 1.0 + if impl(ghc < 8.0) + build-depends: semigroups >= 0.18 + if flag(quotation) build-depends: template-haskell exposed-modules: System.Console.CmdArgs.Quote -- See bug #539 for why this magic is required - extensions: TemplateHaskell + other-extensions: TemplateHaskell exposed-modules: System.Console.CmdArgs @@ -87,9 +95,11 @@ System.Console.CmdArgs.Implicit.UI executable cmdargs + default-language: Haskell2010 main-is: Main.hs - if flag(quotation) - extensions: TemplateHaskell + other-extensions: TemplateHaskell + build-depends: + base, transformers, filepath, process, template-haskell if flag(testprog) && flag(quotation) buildable: True else diff --git a/cmdargs.htm b/cmdargs.htm deleted file mode 100644 --- a/cmdargs.htm +++ /dev/null @@ -1,448 +0,0 @@ - - - - - CmdArgs: Easy Command Line Processing - - - - -

CmdArgs: Easy Command Line Processing

- -

- by Neil Mitchell -

- -

- CmdArgs is a library for defining and parsing command lines. The focus of CmdArgs is allowing the concise definition of fully-featured command line argument processors, in a mainly declarative manner (i.e. little coding needed). CmdArgs also supports multiple mode programs, for example as used in darcs and Cabal. -

- This document explains how to write the "hello world" of command line processors, then how to extend it with features into a complex command line processor. Finally this document gives three samples, which the cmdargs program can run. The three samples are: -

-
    -
  1. hlint - the HLint program.
    2. -
  2. diffy - a program to compare the differences between directories.
    3. -
  3. maker - a make style program.
    4. -
-

- For each example you are encouraged to look at it's source (see the darcs repo, or the bottom of this document) and run it (try cmdargs hlint --help). The HLint program is fairly standard in terms of it's argument processing, and previously used the System.Console.GetOpt library. Using GetOpt required 90 lines and a reasonable amount of duplication. Using CmdArgs the code requires 30 lines, and the logic is much simpler. -

-

Acknowledgements

-

- Thanks to Kevin Quick for substantial patches, and additional code contributions from Sebastian Fischer and Daniel Schoepe. -

- - -

Hello World Example

-

- The following code defines a complete command line argument processor: -

-
-{-# LANGUAGE DeriveDataTypeable #-}
-module Sample where
-import System.Console.CmdArgs
-
-data Sample = Sample {hello :: String}
-              deriving (Show, Data, Typeable)
-
-sample = Sample{hello = def}
-
-main = print =<< cmdArgs sample
-
-

- To use the CmdArgs library there are three steps: -

-
    -
  1. Define a record data type (Sample) that contains a field for each argument. This type needs to have instances for Show, Data and Typeable.
    2. -
  2. Give a value of that type (sample) with default values (def is a default value of any type, but I could also have written ""). This value is turned into a command line by calling the cmdArgs function.
    3. -
-

- Now we have a reasonably functional command line argument processor. Some sample interactions are: -

-
-$ runhaskell Sample.hs --hello=world
-Sample {hello = "world"}
-
-$ runhaskell Sample.hs --version
-The sample program
-
-$ runhaskell Sample.hs --help
-The sample program
-
-sample [OPTIONS]
-
-  -? --help        Display help message
-  -V --version     Print version information
-  -h --hello=ITEM
-
-

- CmdArgs uses defaults to automatically infer a command line parser for a value, and provides annotations to override any of the the defaults. CmdArgs automatically supports --help and --version flags, and optionally supports verbosity flags. -

- -

Specifying Attributes

-

- In order to control the behaviour we can add attributes. For example to add an attribute specifying the help text for the --hello argument we can write: -

-
-sample = Sample{hello = def &= help "Who to say hello to"}
-
-

- We can add additional attributes, for example to specify the type of the value expected by hello: -

-
-sample = Sample {hello = def &= help "Who to say hello to" &= typ "WORLD"}
-
-

- Now when running --help the final line is: -

-
-  -h --hello=WORLD  Who to say hello to
-
-

- There are many more attributes, detailed in the Haddock documentation. -

- - -

Multiple Modes

-

- To specify a program with multiple modes, similar to darcs, we can supply a data type with multiple constructors, for example: -

-
-data Sample = Hello {whom :: String}
-            | Goodbye
-              deriving (Show, Data, Typeable)
-
-hello = Hello{whom = def}
-goodbye = Goodbye
-
-main = print =<< cmdArgs (modes [hello,goodbye])
-
-

- Compared to the first example, we now have multiple constructors, and a sample value for each constructor is passed to cmdArgs. Some sample interactions with this command line are: -

-
-$ runhaskell Sample.hs hello --whom=world
-Hello {whom = "world"}
-
-$ runhaskell Sample.hs goodbye
-Goodbye
-
-$ runhaskell Sample.hs --help
-The sample program
-
-sample [OPTIONS]
-
- Common flags
-  -? --help       Display help message
-  -V --version    Print version information
-
-sample hello [OPTIONS]
-
-  -w --whom=ITEM
-
-sample goodbye [OPTIONS]
-
-

- As before, the behaviour can be customised using attributes. -

- -

Larger Examples

- -

- For each of the following examples we first explain the purpose of the program, then give the source code, and finally the output of --help=HTML. The programs are intended to show sample uses of CmdArgs, and are available to experiment with through cmdargs progname. -

- -

HLint

- -

- The HLint program analyses a list of files, using various options to control the analysis. The command line processing is simple, but a few interesting points are: -

-
    -
  • The --report flag can be used to output a report in a standard location, but giving the flag a value changes where the file is output.
    • -
  • The color field is assigned two flag aliases, --colour and -c. Assigning the -c short flag explicitly stops either of the CPP fields using it.
    • -
  • The show_ field would clash with show if given the expected name, but CmdArgs automatically strips the trailing underscore.
    • -
  • The cpp_define field has an underscore in it's name, which is transformed into a hyphen for the flag name.
    • -
- - -
-{-# LANGUAGE DeriveDataTypeable #-}
-module HLint where
-import System.Console.CmdArgs
-
-data HLint = HLint
-    {report :: [FilePath]
-    ,hint :: [FilePath]
-    ,color :: Bool
-    ,ignore_ :: [String]
-    ,show_ :: Bool
-    ,extension :: [String]
-    ,language :: [String]
-    ,utf8 :: Bool
-    ,encoding :: String
-    ,find :: [FilePath]
-    ,test_ :: Bool
-    ,datadir :: [FilePath]
-    ,cpp_define :: [String]
-    ,cpp_include :: [FilePath]
-    ,files :: [FilePath]
-    }
-    deriving (Data,Typeable,Show,Eq)
-
-hlint = HLint
-    {report = def &= opt "report.html" &= typFile &= help "Generate a report in HTML"
-    ,hint = def &= typFile &= help "Hint/ignore file to use"
-    ,color = def &= name "c" &= name "colour" &= help "Color the output (requires ANSI terminal)"
-    ,ignore_ = def &= typ "MESSAGE" &= help "Ignore a particular hint"
-    ,show_ = def &= help "Show all ignored ideas"
-    ,extension = def &= typ "EXT" &= help "File extensions to search (defaults to hs and lhs)"
-    ,language = def &= name "X" &= typ "LANG" &= help "Language extension (Arrows, NoCPP)"
-    ,utf8 = def &= help "Use UTF-8 text encoding"
-    ,encoding = def &= typ "ENC" &= help "Choose the text encoding"
-    ,find = def &= typFile &= help "Find hints in a Haskell file"
-    ,test_ = def &= help "Run in test mode"
-    ,datadir = def &= typDir &= help "Override the data directory"
-    ,cpp_define = def &= typ "NAME[=VALUE]" &= help "CPP #define"
-    ,cpp_include = def &= typDir &= help "CPP include path"
-    ,files = def &= args &= typ "FILES/DIRS"
-    } &=
-    verbosity &=
-    help "Suggest improvements to Haskell source code" &=
-    summary "HLint v0.0.0, (C) Neil Mitchell" &=
-    details ["Hlint gives hints on how to improve Haskell code",""
-            ,"To check all Haskell files in 'src' and generate a report type:","  hlint src --report"]
-
-mode = cmdArgsMode hlint
-
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
HLint v0.0.0, (C) Neil Mitchell
 
hlint [OPTIONS] [FILES/DIRS]
Suggest improvements to Haskell source code
 
Common flags:
-r--report[=FILE]Generate a report in HTML
-h--hint=FILEHint/ignore file to use
-c--colour --colorColor the output (requires ANSI terminal)
-i--ignore=MESSAGEIgnore a particular hint
-s--showShow all ignored ideas
 --extension=EXTFile extensions to search (defaults to hs and lhs)
-X--language=LANGLanguage extension (Arrows, NoCPP)
-u--utf8Use UTF-8 text encoding
 --encoding=ENCChoose the text encoding
-f--find=FILEFind hints in a Haskell file
-t--testRun in test mode
-d--datadir=DIROverride the data directory
 --cpp-define=NAME[=VALUE]CPP #define
 --cpp-include=DIRCPP include path
-?--helpDisplay help message
-V--versionPrint version information
-v--verboseLoud verbosity
-q--quietQuiet verbosity
 
Hlint gives hints on how to improve Haskell code
 
To check all Haskell files in 'src' and generate a report type:
hlint src --report
- - -

Diffy

- -

- The Diffy sample is a based on the idea of creating directory listings and comparing them. The tool can operate in two separate modes, create or diff. This sample is fictional, but the ideas are drawn from a real program. A few notable features: -

-
    -
  • There are multiple modes of execution, creating and diffing.
    • -
  • The diff mode takes exactly two arguments, the old file and the new file.
    • -
  • Default values are given for the out field, which are different in both modes.
    • -
- - -
-{-# LANGUAGE DeriveDataTypeable #-}
-module Diffy where
-import System.Console.CmdArgs
-
-data Diffy = Create {src :: Maybe FilePath, out :: FilePath}
-           | Diff {old :: FilePath, new :: FilePath, out :: FilePath}
-             deriving (Data,Typeable,Show,Eq)
-
-outFlags x = x &= help "Output file" &= typFile
-
-create = Create
-    {src = def &= help "Source directory" &= typDir
-    ,out = outFlags "ls.txt"
-    } &= help "Create a fingerprint"
-
-diff = Diff
-    {old = def &= typ "OLDFILE" &= argPos 0
-    ,new = def &= typ "NEWFILE" &= argPos 1
-    ,out = outFlags "diff.txt"
-    } &= help "Perform a diff"
-
-mode = cmdArgsMode $ modes [create,diff] &= help "Create and compare differences" &= program "diffy" &= summary "Diffy v1.0"
-
- - - - - - - - - - - - - - - - - - - - -
Diffy v1.0
 
diffy [COMMAND] ... [OPTIONS]
Create and compare differences
 
Common flags:
-o--out=FILEOutput file
-?--helpDisplay help message
-V--versionPrint version information
 
diffy create [OPTIONS]
Create a fingerprint
 
-s--src=DIRSource directory
 
diffy diff [OPTIONS] OLDFILE NEWFILE
Perform a diff
- - -

Maker

- -

- The Maker sample is based around a build system, where we can either build a project, clean the temporary files, or run a test. Some interesting features are: -

-
    -
  • The build mode is the default, so maker on it's own will be interpretted as a build command.
    • -
  • The build method is an enumeration.
    • -
  • The threads field is in two of the constructors, but not all three. It is given the short flag -j, rather than the default -t.
    • -
- - - -
-{-# LANGUAGE DeriveDataTypeable #-}
-module Maker where
-import System.Console.CmdArgs
-
-data Method = Debug | Release | Profile
-              deriving (Data,Typeable,Show,Eq)
-
-data Maker
-    = Wipe
-    | Test {threads :: Int, extra :: [String]}
-    | Build {threads :: Int, method :: Method, files :: [FilePath]}
-      deriving (Data,Typeable,Show,Eq)
-
-threadsMsg x = x &= help "Number of threads to use" &= name "j" &= typ "NUM"
-
-wipe = Wipe &= help "Clean all build objects"
-
-test_ = Test
-    {threads = threadsMsg def
-    ,extra = def &= typ "ANY" &= args
-    } &= help "Run the test suite"
-
-build = Build
-    {threads = threadsMsg def
-    ,method = enum
-        [Release &= help "Release build"
-        ,Debug &= help "Debug build"
-        ,Profile &= help "Profile build"]
-    ,files = def &= args
-    } &= help "Build the project" &= auto
-
-mode = cmdArgsMode $ modes [build,wipe,test_] &= help "Build helper program" &= program "maker" &= summary "Maker v1.0\nMake it"
-
- - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Maker v1.0
Make it
 
maker [COMMAND] ... [OPTIONS]
Build helper program
 
Common flags:
-?--helpDisplay help message
-V--versionPrint version information
 
maker [build] [OPTIONS] [ITEM]
Build the project
 
-j--threads=NUMNumber of threads to use
-r--releaseRelease build
-d--debugDebug build
-p--profileProfile build
 
maker wipe [OPTIONS]
Clean all build objects
 
maker test [OPTIONS] [ANY]
Run the test suite
 
-j--threads=NUMNumber of threads to use
- - - -