Make a proper verbosity type, rather than using Int values

Hopefully this will make it easier to get better verbosity consistency.

We could, by changing only Distribution.Verbosity, use
"type Verbosity = Int" for now to give users of the library a chance to
catch up, but the upcoming Cabal release seems like a good opportunity
to cram in as much of the interface-changing stuff that we want to do
as we can. I think the added benefit of a slow switch would be very low
indeed.

Cabal.cabal

@@ -48,6 +48,7 @@ Exposed-Modules:
         Distribution.Simple.Register,
         Distribution.Simple.SrcDist,
         Distribution.Simple.Utils,
+        Distribution.Verbosity,
         Distribution.Version,
         Distribution.Compat.ReadP,
         Language.Haskell.Extension,

Distribution/Make.hs

@@ -93,6 +93,7 @@ import Distribution.Simple.Utils (die, maybeExit, defaultPackageDesc)
 
 import Distribution.License (License(..))
 import Distribution.Version (Version(..))
+import Distribution.Verbosity
 
 import System.Environment(getArgs)
 import Data.List  ( intersperse )
@@ -118,7 +119,7 @@ defaultMainNoRead pkg_descr = do
     defaultMainHelper args $ \ _ -> return pkg_descr
 
 -- XXX get_pkg_descr isn't used?!
-defaultMainHelper :: [String] -> (Int -> IO PackageDescription) -> IO ()
+defaultMainHelper :: [String] -> (Verbosity -> IO PackageDescription) -> IO ()
 defaultMainHelper args get_pkg_descr
     = do (action, args) <- parseGlobalArgs defaultProgramConfiguration args
          case action of
@@ -132,7 +133,7 @@ defaultMainHelper args get_pkg_descr
                 exitWith retVal
 
             CopyCmd copydest0 -> do
-                ((CopyFlags copydest _), _, args) <- parseCopyArgs (CopyFlags copydest0 0) args []
+                ((CopyFlags copydest _), _, args) <- parseCopyArgs (CopyFlags copydest0 normal) args []
                 no_extra_flags args
 		let cmd = case copydest of 
 				NoCopyDest      -> "install"

Distribution/PackageDescription.hs

@@ -110,6 +110,7 @@ import Distribution.Version(Version(..), VersionRange(..), withinRange,
                             showVersion, parseVersion, showVersionRange, parseVersionRange)
 import Distribution.License(License(..))
 import Distribution.Version(Dependency(..))
+import Distribution.Verbosity
 import Distribution.Compiler(CompilerFlavor(..))
 import Distribution.Simple.Utils(currentDir, die, dieWithLocation, warn)
 import Language.Haskell.Extension(Extension(..))
@@ -544,17 +545,17 @@ haddockName :: PackageDescription -> FilePath
 haddockName pkg_descr =
    joinFileExt (pkgName (package pkg_descr)) "haddock"
 
-setupMessage :: Int -> String -> PackageDescription -> IO ()
+setupMessage :: Verbosity -> String -> PackageDescription -> IO ()
 setupMessage verbosity msg pkg_descr =
-    when (verbosity > 0) $
+    when (verbosity >= normal) $
         putStrLn (msg ++ ' ':showPackageId (package pkg_descr) ++ "...")
 
 -- ---------------------------------------------------------------
 -- Parsing
 
 -- | Given a parser and a filename, return the parse of the file,
 -- after checking if the file exists.
-readAndParseFile :: Int -> (String -> ParseResult a) -> FilePath -> IO a
+readAndParseFile :: Verbosity -> (String -> ParseResult a) -> FilePath -> IO a
 readAndParseFile verbosity parser fpath = do
   exists <- doesFileExist fpath
   when (not exists) (die $ "Error Parsing: file \"" ++ fpath ++ "\" doesn't exist. Cannot continue.")
@@ -567,12 +568,12 @@ readAndParseFile verbosity parser fpath = do
         mapM_ (warn verbosity) ws
         return x
 
-readHookedBuildInfo :: Int -> FilePath -> IO HookedBuildInfo
+readHookedBuildInfo :: Verbosity -> FilePath -> IO HookedBuildInfo
 readHookedBuildInfo verbosity = readAndParseFile verbosity parseHookedBuildInfo
 
 -- |Parse the given package file.
-readPackageDescription :: Int -> FilePath -> IO PackageDescription
-readPackageDescription verbosity = readAndParseFile verbosity parseDescription 
+readPackageDescription :: Verbosity -> FilePath -> IO PackageDescription
+readPackageDescription verbosity = readAndParseFile verbosity parseDescription
 parseDescription :: String -> ParseResult PackageDescription
 parseDescription str = do 
   all_fields0 <- readFields str

Distribution/PreProcess.hs

@@ -66,6 +66,7 @@ import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(..))
 import Distribution.Simple.Utils (rawSystemExit, die, dieWithLocation,
                                   moduleToFilePath, moduleToFilePath2)
 import Distribution.Version (Version(..))
+import Distribution.Verbosity
 import Control.Monad (when, unless)
 import Data.Maybe (fromMaybe)
 import Data.List (nub)
@@ -85,8 +86,8 @@ import Distribution.Compat.Directory ( createDirectoryIfMissing )
 -- > ppTestHandler =
 -- >   PreProcessor {
 -- >     platformIndependent = True,
--- >     runPreProcessor = mkSimplePreProcessor $ \inFile outFile verbose ->
--- >       do when (verbose > 0) $
+-- >     runPreProcessor = mkSimplePreProcessor $ \inFile outFile verbosity ->
+-- >       do when (verbosity >= normal) $
 -- >            putStrLn (inFile++" has been preprocessed to "++outFile)
 -- >          stuff <- readFile inFile
 -- >          writeFile outFile ("-- preprocessed as a test\n\n" ++ stuff)
@@ -126,20 +127,21 @@ data PreProcessor = PreProcessor {
 
   runPreProcessor :: (FilePath, FilePath) -- Location of the source file relative to a base dir
                   -> (FilePath, FilePath) -- Output file name, relative to an output base dir
-                  -> Int      -- verbosity
-                  -> IO ()    -- Should exit if the preprocessor fails
+                  -> Verbosity -- verbosity
+                  -> IO ()     -- Should exit if the preprocessor fails
   }
 
-mkSimplePreProcessor :: (FilePath -> FilePath -> Int -> IO ())
+mkSimplePreProcessor :: (FilePath -> FilePath -> Verbosity -> IO ())
                       -> (FilePath, FilePath)
-                      -> (FilePath, FilePath) -> Int -> IO ()
+                      -> (FilePath, FilePath) -> Verbosity -> IO ()
 mkSimplePreProcessor simplePP
   (inBaseDir, inRelativeFile)
   (outBaseDir, outRelativeFile) verbosity = simplePP inFile outFile verbosity
   where inFile  = inBaseDir  `joinFileName` inRelativeFile
         outFile = outBaseDir `joinFileName` outRelativeFile
 
-runSimplePreProcessor :: PreProcessor -> FilePath -> FilePath -> Int -> IO ()
+runSimplePreProcessor :: PreProcessor -> FilePath -> FilePath -> Verbosity
+                      -> IO ()
 runSimplePreProcessor pp inFile outFile verbosity =
   runPreProcessor pp (".", inFile) (".", outFile) verbosity
 
@@ -150,29 +152,29 @@ type PPSuffixHandler
 
 -- |Apply preprocessors to the sources from 'hsSourceDirs', to obtain
 -- a Haskell source file for each module.
-preprocessSources :: PackageDescription 
-		  -> LocalBuildInfo 
-		  -> Int                -- ^ verbose
+preprocessSources :: PackageDescription
+                  -> LocalBuildInfo
+                  -> Verbosity          -- ^ verbosity
                   -> [PPSuffixHandler]  -- ^ preprocessors to try
-		  -> IO ()
+                  -> IO ()
 
-preprocessSources pkg_descr lbi verbose handlers = do
+preprocessSources pkg_descr lbi verbosity handlers = do
     withLib pkg_descr () $ \ lib -> do
-        setupMessage verbose "Preprocessing library" pkg_descr
+        setupMessage verbosity "Preprocessing library" pkg_descr
         let bi = libBuildInfo lib
         let biHandlers = localHandlers bi
         sequence_ [ preprocessModule (hsSourceDirs bi) (buildDir lbi) modu
-                                     verbose builtinSuffixes biHandlers
+                                     verbosity builtinSuffixes biHandlers
                   | modu <- libModules pkg_descr]
     unless (null (executables pkg_descr)) $
-        setupMessage verbose "Preprocessing executables for" pkg_descr
+        setupMessage verbosity "Preprocessing executables for" pkg_descr
     withExe pkg_descr $ \ theExe -> do
         let bi = buildInfo theExe
         let biHandlers = localHandlers bi
         sequence_ [ preprocessModule (nub $ (hsSourceDirs bi)
                                   ++ (maybe [] (hsSourceDirs . libBuildInfo) (library pkg_descr)))
                                      (buildDir lbi)
-                                     modu verbose builtinSuffixes biHandlers
+                                     modu verbosity builtinSuffixes biHandlers
                   | modu <- otherModules bi]
   where hc = compilerFlavor (compiler lbi)
 	builtinSuffixes
@@ -183,14 +185,14 @@ preprocessSources pkg_descr lbi verbose handlers = do
 -- |Find the first extension of the file that exists, and preprocess it
 -- if required.
 preprocessModule
-    :: [FilePath]			-- ^source directories
-    -> FilePath                         -- ^build directory
-    -> String				-- ^module name
-    -> Int				-- ^verbose
-    -> [String]				-- ^builtin suffixes
-    -> [(String, PreProcessor)]		-- ^possible preprocessors
+    :: [FilePath]               -- ^source directories
+    -> FilePath                 -- ^build directory
+    -> String                   -- ^module name
+    -> Verbosity                -- ^verbosity
+    -> [String]                 -- ^builtin suffixes
+    -> [(String, PreProcessor)] -- ^possible preprocessors
     -> IO ()
-preprocessModule searchLoc buildLoc modu verbose builtinSuffixes handlers = do
+preprocessModule searchLoc buildLoc modu verbosity builtinSuffixes handlers = do
     -- look for files in the various source dirs with this module name
     -- and a file extension of a known preprocessor
     psrcFiles  <- moduleToFilePath2 searchLoc modu (map fst handlers)
@@ -230,7 +232,7 @@ preprocessModule searchLoc buildLoc modu verbose builtinSuffixes handlers = do
               createDirectoryIfMissing True destDir
               runPreProcessor pp
                  (psrcLoc, psrcRelFile)
-                 (destLoc, srcStem `joinFileExt` "hs") verbose
+                 (destLoc, srcStem `joinFileExt` "hs") verbosity
 
 removePreprocessedPackage :: PackageDescription
                           -> FilePath -- ^root of source tree (where to look for hsSources)
@@ -272,8 +274,8 @@ ppGreenCard' inputArgs _ lbi
     where pp greencard =
             PreProcessor {
               platformIndependent = False,
-              runPreProcessor = mkSimplePreProcessor $ \inFile outFile verbose ->
-                rawSystemExit verbose greencard
+              runPreProcessor = mkSimplePreProcessor $ \inFile outFile verbosity ->
+                rawSystemExit verbosity greencard
                     (["-tffi", "-o" ++ outFile, inFile] ++ inputArgs)
             }
 
@@ -283,7 +285,7 @@ ppUnlit :: PreProcessor
 ppUnlit =
   PreProcessor {
     platformIndependent = True,
-    runPreProcessor = mkSimplePreProcessor $ \inFile outFile _verbose -> do
+    runPreProcessor = mkSimplePreProcessor $ \inFile outFile _verbosity -> do
       contents <- readFile inFile
       writeFile outFile (unlit inFile contents)
   }
@@ -307,8 +309,8 @@ ppCpp' inputArgs bi lbi =
   where 
 	hc = compiler lbi
 
-	use_cpphs cpphs inFile outFile verbose
-	  = rawSystemExit verbose cpphs cpphsArgs
+	use_cpphs cpphs inFile outFile verbosity
+	  = rawSystemExit verbosity cpphs cpphsArgs
 	  where cpphsArgs = ("-O" ++ outFile) : inFile : "--noline" : "--strip"
 				 : extraArgs
 
@@ -319,9 +321,9 @@ ppCpp' inputArgs bi lbi =
                 ["-D" ++ arch ++ "_" ++ loc ++ "_ARCH" | loc <- locations]
         locations = ["BUILD", "HOST"]
 
-	use_ghc inFile outFile verbose
-	  = do p_p <- use_optP_P lbi
-               rawSystemExit verbose (compilerPath hc) 
+	use_ghc inFile outFile verbosity
+	  = do p_p <- use_optP_P verbosity lbi
+               rawSystemExit verbosity (compilerPath hc) 
                    (["-E", "-cpp"] ++
                     -- This is a bit of an ugly hack. We're going to
                     -- unlit the file ourselves later on if appropriate,
@@ -335,8 +337,9 @@ ppCpp' inputArgs bi lbi =
 -- Haddock versions before 0.8 choke on #line and #file pragmas.  Those
 -- pragmas are necessary for correct links when we preprocess.  So use
 -- -optP-P only if the Haddock version is prior to 0.8.
-use_optP_P :: LocalBuildInfo -> IO Bool
-use_optP_P lbi = fmap (< Version [0,8] []) (haddockVersion lbi)
+use_optP_P :: Verbosity -> LocalBuildInfo -> IO Bool
+use_optP_P verbosity lbi
+ = fmap (< Version [0,8] []) (haddockVersion verbosity lbi)
 
 ppHsc2hs :: BuildInfo -> LocalBuildInfo -> PreProcessor
 ppHsc2hs bi lbi
@@ -416,8 +419,8 @@ standardPP :: String -> [String] -> PreProcessor
 standardPP eName args =
   PreProcessor {
     platformIndependent = False,
-    runPreProcessor = mkSimplePreProcessor $ \inFile outFile verbose ->
-      rawSystemExit verbose eName (args ++ ["-o", outFile, inFile])
+    runPreProcessor = mkSimplePreProcessor $ \inFile outFile verbosity ->
+      rawSystemExit verbosity eName (args ++ ["-o", outFile, inFile])
   }
 
 ppNone :: String -> PreProcessor

Distribution/Program.hs

@@ -64,6 +64,7 @@ module Distribution.Program(
 import qualified Distribution.Compat.Map as Map
 import Distribution.Compat.Directory(findExecutable)
 import Distribution.Simple.Utils (die, rawSystemExit)
+import Distribution.Verbosity
 
 -- |Represents a program which cabal may call.
 data Program
@@ -268,35 +269,35 @@ maybeUpdateProgram :: Maybe Program -> ProgramConfiguration -> ProgramConfigurat
 maybeUpdateProgram m c = maybe c (\p -> updateProgram p c) m
 
 -- |Runs the given program.
-rawSystemProgram :: Int      -- ^Verbosity
-                 -> Program  -- ^The program to run
-                 -> [String] -- ^Any /extra/ arguments to add
+rawSystemProgram :: Verbosity -- ^Verbosity
+                 -> Program   -- ^The program to run
+                 -> [String]  -- ^Any /extra/ arguments to add
                  -> IO ()
-rawSystemProgram verbose (Program { programLocation=(UserSpecified p)
-                                  , programArgs=args
-                                  }) extraArgs
-    = rawSystemExit verbose p (extraArgs ++ args)
+rawSystemProgram verbosity (Program { programLocation=(UserSpecified p)
+                                    , programArgs=args
+                                    }) extraArgs
+    = rawSystemExit verbosity p (extraArgs ++ args)
 
-rawSystemProgram verbose (Program { programLocation=(FoundOnSystem p)
-                                  , programArgs=args
-                                  }) extraArgs
-    = rawSystemExit verbose p (args ++ extraArgs)
+rawSystemProgram verbosity (Program { programLocation=(FoundOnSystem p)
+                                    , programArgs=args
+                                    }) extraArgs
+    = rawSystemExit verbosity p (args ++ extraArgs)
 
 rawSystemProgram _ (Program { programLocation=EmptyLocation
                             , programName=n}) _
     = die ("Error: Could not find location for program: " ++ n)
 
-rawSystemProgramConf :: Int -- ^verbosity
-                     -> String -- ^The name of the program to run
+rawSystemProgramConf :: Verbosity            -- ^verbosity
+                     -> String               -- ^The name of the program to run
                      -> ProgramConfiguration -- ^look up the program here
-                     -> [String] -- ^Any /extra/ arguments to add
+                     -> [String]             -- ^Any /extra/ arguments to add
                      -> IO ()
-rawSystemProgramConf verbose progName programConf extraArgs 
+rawSystemProgramConf verbosity progName programConf extraArgs 
     = do prog <- do mProg <- lookupProgram progName programConf
                     case mProg of
                         Nothing -> (die (progName ++ " command not found"))
                         Just h  -> return h
-         rawSystemProgram verbose prog extraArgs
+         rawSystemProgram verbosity prog extraArgs
 
 
 -- ------------------------------------------------------------