Merge pull request #3870 from dcoutts/getopt-fork-tidy

Clarify the differences with the GetOpt from base

Cabal/Distribution/GetOpt.hs

@@ -7,36 +7,19 @@
 -- Maintainer  :  libraries@haskell.org
 -- Portability :  portable
 --
--- This library provides facilities for parsing the command-line options
--- in a standalone program.  It is essentially a Haskell port of the GNU
--- @getopt@ library.
+-- This is a fork of "System.Console.GetOpt" with the following changes:
+--
+-- * Treat "cabal --flag command" as "cabal command --flag" e.g.
+--   "cabal -v configure" to mean "cabal configure -v" For flags that are
+--   not recognised as global flags, pass them on to the sub-command. See
+--   the difference in 'shortOpt'.
+--
+-- * Line wrapping in the 'usageInfo' output, plus a more compact
+--   rendering of short options, and slightly less padding.
+--
+-- If you want to take on the challenge of merging this with the GetOpt
+-- from the base package then go for it!
 --
------------------------------------------------------------------------------
-
-{-
-Sven Panne <Sven.Panne@informatik.uni-muenchen.de> Oct. 1996 (small
-changes Dec. 1997)
-
-Two rather obscure features are missing: The Bash 2.0 non-option hack
-(if you don't already know it, you probably don't want to hear about
-it...) and the recognition of long options with a single dash
-(e.g. '-help' is recognised as '--help', as long as there is no short
-option 'h').
-
-Other differences between GNU's getopt and this implementation:
-
-* To enforce a coherent description of options and arguments, there
-  are explanation fields in the option/argument descriptor.
-
-* Error messages are now more informative, but no longer POSIX
-  compliant... :-(
-
-And a final Haskell advertisement: The GNU C implementation uses well
-over 1100 lines, we need only 195 here, including a 46 line example!
-:-)
--}
-
-{-# OPTIONS_HADDOCK hide #-}
 module Distribution.GetOpt (
    -- * GetOpt
    getOpt, getOpt',
@@ -46,44 +29,13 @@ module Distribution.GetOpt (
    ArgDescr(..),
 
    -- * Example
-
-   -- $example
+   -- | See "System.Console.GetOpt" for examples
 ) where
 
 import Prelude ()
 import Distribution.Compat.Prelude
-
--- |What to do with options following non-options
-data ArgOrder a
-  = RequireOrder                -- ^ no option processing after first non-option
-  | Permute                     -- ^ freely intersperse options and non-options
-  | ReturnInOrder (String -> a) -- ^ wrap non-options into options
-
-{-|
-Each 'OptDescr' describes a single option.
-
-The arguments to 'Option' are:
-
-* list of short option characters
-
-* list of long option strings (without \"--\")
-
-* argument descriptor
-
-* explanation of option for user
--}
-data OptDescr a =              -- description of a single options:
-   Option [Char]                --    list of short option characters
-          [String]              --    list of long option strings (without "--")
-          (ArgDescr a)          --    argument descriptor
-          String                --    explanation of option for user
-
--- |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
+import System.Console.GetOpt
+         ( ArgOrder(..), OptDescr(..), ArgDescr(..) )
 
 data OptKind a                -- kind of cmd line arg (internal use only):
    = Opt       a                --    an option
@@ -123,6 +75,7 @@ fmtShort :: ArgDescr a -> Char -> String
 fmtShort (NoArg  _   ) so = "-" ++ [so]
 fmtShort (ReqArg _  _) so = "-" ++ [so]
 fmtShort (OptArg _  _) so = "-" ++ [so]
+  -- unlike upstream GetOpt we omit the arg name for short options
 
 fmtLong :: ArgDescr a -> String -> String
 fmtLong (NoArg  _   ) lo = "--" ++ lo
@@ -234,6 +187,11 @@ shortOpt y ys rs optDescr = short ads ys rs
         short (OptArg f _:_) xs rest     = (Opt (f (Just xs)),rest)
         short []             [] rest     = (UnreqOpt optStr,rest)
         short []             xs rest     = (UnreqOpt (optStr++xs),rest)
+        -- This is different vs upstream = (UnreqOpt optStr,('-':xs):rest)
+        -- Apparently this was part of the change so that flags that are
+        -- not recognised as global flags are passed on to the sub-command.
+        -- But why was no equivalent change required for longOpt? So could
+        -- this change go upstream?
 
 -- miscellaneous error formatting
 
@@ -249,87 +207,3 @@ errUnrec optStr = "unrecognized option `" ++ optStr ++ "'\n"
 
 errNoArg :: String -> OptKind a
 errNoArg optStr = OptErr ("option `" ++ optStr ++ "' doesn't allow an argument\n")
-
-{-
------------------------------------------------------------------------------------------
--- and here a small and hopefully enlightening example:
-
-data Flag = Verbose | Version | Name String | Output String | Arg String   deriving Show
-
-options :: [OptDescr Flag]
-options =
-   [Option ['v']     ["verbose"]           (NoArg Verbose)      "verbosely list files",
-    Option ['V','?'] ["version","release"] (NoArg Version)      "show version info",
-    Option ['o']     ["output"]            (OptArg out "FILE")  "use FILE for dump",
-    Option ['n']     ["name"]              (ReqArg Name "USER") "only dump USER's files"]
-
-out :: Maybe String -> Flag
-out Nothing  = Output "stdout"
-out (Just o) = Output o
-
-test :: ArgOrder Flag -> [String] -> String
-test order cmdline = case getOpt order options cmdline of
-                        (o,n,[]  ) -> "options=" ++ show o ++ "  args=" ++ show n ++ "\n"
-                        (_,_,errs) -> concat errs ++ usageInfo header options
-   where header = "Usage: foobar [OPTION...] files..."
-
--- example runs:
--- putStr (test RequireOrder ["foo","-v"])
---    ==> options=[]  args=["foo", "-v"]
--- putStr (test Permute ["foo","-v"])
---    ==> options=[Verbose]  args=["foo"]
--- putStr (test (ReturnInOrder Arg) ["foo","-v"])
---    ==> options=[Arg "foo", Verbose]  args=[]
--- putStr (test Permute ["foo","--","-v"])
---    ==> options=[]  args=["foo", "-v"]
--- putStr (test Permute ["-?o","--name","bar","--na=baz"])
---    ==> options=[Version, Output "stdout", Name "bar", Name "baz"]  args=[]
--- putStr (test Permute ["--ver","foo"])
---    ==> option `--ver' is ambiguous; could be one of:
---          -v      --verbose             verbosely list files
---          -V, -?  --version, --release  show version info
---        Usage: foobar [OPTION...] files...
---          -v        --verbose             verbosely list files
---          -V, -?    --version, --release  show version info
---          -o[FILE]  --output[=FILE]       use FILE for dump
---          -n USER   --name=USER           only dump USER's files
------------------------------------------------------------------------------------------
--}
-
-{- $example
-
-To hopefully illuminate the role of the different data
-structures, here\'s the command-line options for a (very simple)
-compiler:
-
->    module Opts where
->
->    import Distribution.GetOpt
->    import Data.Maybe ( fromMaybe )
->
->    data Flag
->     = Verbose  | Version
->     | Input String | Output String | LibDir String
->       deriving Show
->
->    options :: [OptDescr Flag]
->    options =
->     [ Option ['v']     ["verbose"] (NoArg Verbose)       "chatty output on stderr"
->     , Option ['V','?'] ["version"] (NoArg Version)       "show version number"
->     , Option ['o']     ["output"]  (OptArg outp "FILE")  "output FILE"
->     , Option ['c']     []          (OptArg inp  "FILE")  "input FILE"
->     , Option ['L']     ["libdir"]  (ReqArg LibDir "DIR") "library directory"
->     ]
->
->    inp,outp :: Maybe String -> Flag
->    outp = Output . fromMaybe "stdout"
->    inp  = Input  . fromMaybe "stdin"
->
->    compilerOpts :: [String] -> IO ([Flag], [String])
->    compilerOpts argv =
->       case getOpt Permute options argv of
->          (o,n,[]  ) -> return (o,n)
->          (_,_,errs) -> ioError (userError (concat errs ++ usageInfo header options))
->      where header = "Usage: ic [OPTION...] files..."
-
--}