From 151e90f4693b4198ba176fecad9ba2620ec7a29a Mon Sep 17 00:00:00 2001
From: Duncan Coutts <duncan@haskell.org>
Date: Fri, 12 Oct 2007 11:32:37 +0000
Subject: [PATCH] Add logging functions notice, info, debug functions and use
them consistently We previously had this kind of code all over the place: >
when (verbosity >= verbose) > (putStrLn "some message") We now replace
that with: > info verbosity "some message" Much nicer.
---
Distribution/PackageDescription.hs | 5 +--
Distribution/Simple.hs | 9 ++---
Distribution/Simple/Configure.hs | 64 ++++++++++++++----------------
Distribution/Simple/GHC.hs | 17 ++++----
Distribution/Simple/Haddock.hs | 21 +++++-----
Distribution/Simple/Hugs.hs | 9 ++---
Distribution/Simple/Install.hs | 15 ++++---
Distribution/Simple/JHC.hs | 8 ++--
Distribution/Simple/PreProcess.hs | 3 +-
Distribution/Simple/Program.hs | 25 +++++-------
Distribution/Simple/Register.hs | 5 +--
Distribution/Simple/SrcDist.hs | 11 +++--
Distribution/Simple/Utils.hs | 55 +++++++++++++++++++------
13 files changed, 128 insertions(+), 119 deletions(-)
diff --git a/Distribution/PackageDescription.hs b/Distribution/PackageDescription.hs
index 27d8549f7c..94cebe9cea 100644
--- a/Distribution/PackageDescription.hs
+++ b/Distribution/PackageDescription.hs
@@ -120,7 +120,7 @@ import Distribution.Version(Dependency(..))
import Distribution.Verbosity
import Distribution.Compiler(CompilerFlavor(..))
import Distribution.Configuration
-import Distribution.Simple.Utils(currentDir, die, dieWithLocation, warn)
+import Distribution.Simple.Utils(currentDir, die, dieWithLocation, warn, notice)
import Language.Haskell.Extension(Extension(..))
import Distribution.Compat.ReadP as ReadP hiding (get)
@@ -783,8 +783,7 @@ haddockName pkg_descr = pkgName (package pkg_descr) <.> "haddock"
setupMessage :: Verbosity -> String -> PackageDescription -> IO ()
setupMessage verbosity msg pkg_descr =
- when (verbosity >= normal) $
- putStrLn (msg ++ ' ':showPackageId (package pkg_descr) ++ "...")
+ notice verbosity (msg ++ ' ':showPackageId (package pkg_descr) ++ "...")
-- ---------------------------------------------------------------
-- Parsing
diff --git a/Distribution/Simple.hs b/Distribution/Simple.hs
index 9c1711fa6c..9b2f9ca64a 100644
--- a/Distribution/Simple.hs
+++ b/Distribution/Simple.hs
@@ -93,7 +93,7 @@ import Distribution.Simple.Haddock (haddock, hscolour)
import Distribution.Simple.Utils (die, currentDir, moduleToFilePath,
defaultPackageDesc, defaultHookedPackageDesc)
-import Distribution.Simple.Utils (rawSystemPathExit)
+import Distribution.Simple.Utils (rawSystemPathExit, notice, info)
import Distribution.Verbosity
import Language.Haskell.Extension
-- Base
@@ -461,8 +461,8 @@ pfe pkg_descr _lbi hooks (PFEFlags verbosity) = do
-- Cleaning
clean :: PackageDescription -> Maybe LocalBuildInfo -> UserHooks -> CleanFlags -> IO ()
-clean pkg_descr maybeLbi _ (CleanFlags saveConfigure _verbosity) = do
- putStrLn "cleaning..."
+clean pkg_descr maybeLbi _ (CleanFlags saveConfigure verbosity) = do
+ notice verbosity "cleaning..."
maybeConfig <- if saveConfigure then maybeGetPersistBuildConfig
else return Nothing
@@ -631,8 +631,7 @@ autoconfUserHooks
Nothing -> return emptyHookedBuildInfo
Just infoFile -> do
let verbosity = get_verbosity flags
- when (verbosity >= normal) $
- putStrLn $ "Reading parameters from " ++ infoFile
+ info verbosity $ "Reading parameters from " ++ infoFile
readHookedBuildInfo verbosity infoFile
defaultInstallHook :: PackageDescription -> LocalBuildInfo
diff --git a/Distribution/Simple/Configure.hs b/Distribution/Simple/Configure.hs
index 11ccbdbf63..240ad2ed98 100644
--- a/Distribution/Simple/Configure.hs
+++ b/Distribution/Simple/Configure.hs
@@ -92,7 +92,7 @@ import Distribution.Simple.LocalBuildInfo
( LocalBuildInfo(..), distPref, absoluteInstallDirs
, prefixRelativeInstallDirs )
import Distribution.Simple.Utils
- ( die, warn )
+ ( die, warn, info )
import Distribution.Simple.Register
( removeInstalledConfig )
import Distribution.System
@@ -101,7 +101,7 @@ import Distribution.Version
( Version(..), Dependency(..), VersionRange(..), showVersion, readVersion
, showVersionRange, orLaterVersion, withinRange )
import Distribution.Verbosity
- ( Verbosity, verbose, lessVerbose )
+ ( Verbosity, lessVerbose )
import qualified Distribution.Simple.GHC as GHC
import qualified Distribution.Simple.JHC as JHC
@@ -220,8 +220,8 @@ configure (pkg_descr0, pbi) cfg
Right pd -> return (pd,[])
- when (not (null flags) && verbosity >= verbose) $
- message $ "Flags chosen: " ++ (concat . intersperse ", " .
+ when (not (null flags)) $
+ info verbosity $ "Flags chosen: " ++ (concat . intersperse ", " .
map (\(n,b) -> n ++ "=" ++ show b) $ flags)
(warns, ers) <- sanityCheckPackage $
@@ -304,29 +304,28 @@ configure (pkg_descr0, pbi) cfg
let dirs = absoluteInstallDirs pkg_descr lbi NoCopyDest
relative = prefixRelativeInstallDirs pkg_descr lbi
- when (verbosity >= verbose) $ do
- message $ "Using compiler: " ++ showCompilerId comp
- message $ "Using install prefix: " ++ prefix dirs
+ info verbosity $ "Using compiler: " ++ showCompilerId comp
+ info verbosity $ "Using install prefix: " ++ prefix dirs
- messageDir "Binaries" pkg_descr (bindir dirs) (bindir relative)
- messageDir "Libraries" pkg_descr (libdir dirs) (libdir relative)
- messageDir "Private binaries" pkg_descr (libexecdir dirs)(libexecdir relative)
- messageDir "Data files" pkg_descr (datadir dirs) (datadir relative)
- messageDir "Documentation" pkg_descr (docdir dirs) (docdir relative)
+ let dirinfo name dir isPrefixRelative =
+ info verbosity $ name ++ " installed in: " ++ dir ++ relNote
+ where relNote = case os of
+ Windows MingW | not (hasLibs pkg_descr)
+ && isNothing isPrefixRelative
+ -> " (fixed location)"
+ _ -> ""
- sequence_ [ reportProgram prog configuredProg
- | (prog, configuredProg) <- knownPrograms programsConfig' ]
+ dirinfo "Binaries" (bindir dirs) (bindir relative)
+ dirinfo "Libraries" (libdir dirs) (libdir relative)
+ dirinfo "Private binaries" (libexecdir dirs) (libexecdir relative)
+ dirinfo "Data files" (datadir dirs) (datadir relative)
+ dirinfo "Documentation" (docdir dirs) (docdir relative)
+
+ sequence_ [ reportProgram verbosity prog configuredProg
+ | (prog, configuredProg) <- knownPrograms programsConfig' ]
return lbi
-messageDir :: String -> PackageDescription -> FilePath -> Maybe FilePath -> IO ()
-messageDir name pkg_descr dir isPrefixRelative
- = message (name ++ " installed in: " ++ dir ++ rel_note)
- where
- rel_note = case os of
- Windows MingW | not (hasLibs pkg_descr)
- && isNothing isPrefixRelative -> " (fixed location)"
- _ -> ""
-- -----------------------------------------------------------------------------
-- Configuring package dependencies
@@ -341,11 +340,11 @@ setDepByVersion (Dependency s (ThisVersion v)) = PackageIdentifier s v
-- otherwise, just set it to empty
setDepByVersion (Dependency s _) = PackageIdentifier s (Version [] [])
-reportProgram :: Program -> Maybe ConfiguredProgram -> IO ()
-reportProgram prog Nothing
- = message $ "No " ++ programName prog ++ " found"
-reportProgram prog (Just configuredProg)
- = message $ "Using " ++ programName prog ++ version ++ location
+reportProgram :: Verbosity -> Program -> Maybe ConfiguredProgram -> IO ()
+reportProgram verbosity prog Nothing
+ = info verbosity $ "No " ++ programName prog ++ " found"
+reportProgram verbosity prog (Just configuredProg)
+ = info verbosity $ "Using " ++ programName prog ++ version ++ location
where location = case programLocation configuredProg of
FoundOnSystem p -> " found on system at: " ++ p
UserSpecified p -> " given by user at: " ++ p
@@ -364,8 +363,7 @@ configDependency verbosity ps dep@(Dependency pkgname vrange) =
++ pkgname ++ showVersionRange vrange ++ "\n"
++ "Perhaps you need to download and install it from\n"
++ hackageUrl ++ pkgname ++ "?"
- Just pkg -> do when (verbosity >= verbose) $
- message $ "Dependency " ++ pkgname
+ Just pkg -> do info verbosity $ "Dependency " ++ pkgname
++ showVersionRange vrange
++ ": using " ++ showPackageId pkg
return pkg
@@ -373,7 +371,7 @@ configDependency verbosity ps dep@(Dependency pkgname vrange) =
getInstalledPackages :: Verbosity -> Compiler -> PackageDB -> ProgramConfiguration
-> IO (Maybe [PackageIdentifier])
getInstalledPackages verbosity comp packageDb progconf = do
- when (verbosity >= verbose) $ message "Reading installed packages..."
+ info verbosity "Reading installed packages..."
case compilerFlavor comp of
GHC | compilerVersion comp >= Version [6,3] []
-> Just `fmap` GHC.getInstalledPackages verbosity packageDb progconf
@@ -421,8 +419,7 @@ configurePkgconfigPackages verbosity pkg_descr conf
case readVersion version of
Nothing -> die "parsing output of pkg-config --modversion failed"
Just v | not (withinRange v range) -> die (badVersion v)
- | verbosity >= verbose -> message (depSatisfied v)
- | otherwise -> return ()
+ | otherwise -> info verbosity (depSatisfied v)
where
notFound = "The pkg-config package " ++ pkg ++ versionRequirement
++ " is required but it could not be found."
@@ -487,9 +484,6 @@ configCompiler (Just hcFlavor) hcPath hcPkg conf verbosity = do
NHC -> NHC.configure verbosity hcPath hcPkg conf
_ -> die "Unknown compiler"
-message :: String -> IO ()
-message s = putStrLn $ "configure: " ++ s
-
-- |Output warnings and errors. Exit if any errors.
errorOut :: Verbosity -- ^Verbosity
diff --git a/Distribution/Simple/GHC.hs b/Distribution/Simple/GHC.hs
index d33099066b..a7f241b372 100644
--- a/Distribution/Simple/GHC.hs
+++ b/Distribution/Simple/GHC.hs
@@ -166,13 +166,11 @@ guessGhcPkgFromGhcPath ghcProg verbosity
guessVersioned = dir </> ("ghc-pkg" ++ versionSuffix) <.> exeExtension
guesses | null versionSuffix = [guessNormal]
| otherwise = [guessVersioned, guessNormal]
- when (verbosity >= verbose) $
- putStrLn $ "looking for package tool: ghc-pkg near compiler in " ++ dir
+ info verbosity $ "looking for package tool: ghc-pkg near compiler in " ++ dir
exists <- mapM doesFileExist guesses
case [ file | (file, True) <- zip guesses exists ] of
[] -> return Nothing
- (pkgtool:_) -> do when (verbosity >= verbose) $
- putStrLn $ "found package tool in " ++ pkgtool
+ (pkgtool:_) -> do info verbosity $ "found package tool in " ++ pkgtool
return (Just pkgtool)
where takeVersionSuffix :: FilePath -> String
@@ -275,7 +273,7 @@ build pkg_descr lbi verbosity = do
-- Build lib
withLib pkg_descr () $ \lib -> do
- when (verbosity >= verbose) (putStrLn "Building library...")
+ info verbosity "Building library..."
let libBi = libBuildInfo lib
libTargetDir = pref
forceVanillaLib = TemplateHaskell `elem` extensions libBi
@@ -314,7 +312,7 @@ build pkg_descr lbi verbosity = do
-- build any C sources
unless (null (cSources libBi)) $ do
- when (verbosity >= verbose) (putStrLn "Building C Sources...")
+ info verbosity "Building C Sources..."
sequence_ [do let (odir,args) = constructCcCmdLine lbi libBi pref
filename verbosity
createDirectoryIfMissingVerbose verbosity True odir
@@ -323,7 +321,7 @@ build pkg_descr lbi verbosity = do
| filename <- cSources libBi]
-- link:
- when (verbosity > verbose) (putStrLn "cabal-linking...")
+ info verbosity "Linking..."
let cObjs = map (`replaceExtension` objExtension) (cSources libBi)
cSharedObjs = map (`replaceExtension` ("dyn_" ++ objExtension)) (cSources libBi)
libName = mkLibName pref (showPackageId (package pkg_descr))
@@ -424,8 +422,7 @@ build pkg_descr lbi verbosity = do
-- build any executables
withExe pkg_descr $ \ (Executable exeName' modPath exeBi) -> do
- when (verbosity >= verbose)
- (putStrLn $ "Building executable: " ++ exeName' ++ "...")
+ info verbosity $ "Building executable: " ++ exeName' ++ "..."
-- exeNameReal, the name that GHC really uses (with .exe on Windows)
let exeNameReal = exeName' <.>
@@ -442,7 +439,7 @@ build pkg_descr lbi verbosity = do
-- build executables
unless (null (cSources exeBi)) $ do
- when (verbosity >= verbose) (putStrLn "Building C Sources.")
+ info verbosity "Building C Sources."
sequence_ [do let (odir,args) = constructCcCmdLine lbi exeBi
exeDir filename verbosity
createDirectoryIfMissingVerbose verbosity True odir
diff --git a/Distribution/Simple/Haddock.hs b/Distribution/Simple/Haddock.hs
index 7642ec6ed6..54f978740c 100644
--- a/Distribution/Simple/Haddock.hs
+++ b/Distribution/Simple/Haddock.hs
@@ -64,7 +64,7 @@ import Distribution.Simple.InstallDirs (InstallDirTemplates(..),
initialPathTemplateEnv)
import Distribution.Simple.LocalBuildInfo ( LocalBuildInfo(..), hscolourPref,
haddockPref, distPref )
-import Distribution.Simple.Utils (die, warn, createDirectoryIfMissingVerbose,
+import Distribution.Simple.Utils (die, warn, notice, createDirectoryIfMissingVerbose,
moduleToFilePath, findFile)
import Distribution.Simple.Utils (rawSystemStdout)
@@ -86,10 +86,11 @@ import Distribution.Version
haddock :: PackageDescription -> LocalBuildInfo -> [PPSuffixHandler] -> HaddockFlags -> IO ()
haddock pkg_descr _ _ haddockFlags
- | not (hasLibs pkg_descr) && not (haddockExecutables haddockFlags) = do
- when (haddockVerbose haddockFlags >= normal) $
- putStrLn $ "No documentation was generated as this package does not contain a library.\n"
- ++ "Perhaps you want to use the haddock command with the --executables flag."
+ | not (hasLibs pkg_descr) && not (haddockExecutables haddockFlags) =
+ warn (haddockVerbose haddockFlags) $
+ "No documentation was generated as this package does not contain "
+ ++ "a\nlibrary. Perhaps you want to use the haddock command with the "
+ ++ "--executables flag."
haddock pkg_descr lbi suffixes haddockFlags@HaddockFlags {
haddockExecutables = doExes,
@@ -204,9 +205,8 @@ haddock pkg_descr lbi suffixes haddockFlags@HaddockFlags {
++ map ("--hide=" ++) (otherModules bi)
)
removeFile prologName
- when (verbosity >= normal) $
- putStrLn $ "Documentation created: "
- ++ (haddockPref pkg_descr </> "index.html")
+ notice verbosity $ "Documentation created: "
+ ++ (haddockPref pkg_descr </> "index.html")
withExe pkg_descr $ \exe -> when doExes $ do
let bi = buildInfo exe
@@ -235,9 +235,8 @@ haddock pkg_descr lbi suffixes haddockFlags@HaddockFlags {
++ outFiles
)
removeFile prologName
- when (verbosity >= normal) $
- putStrLn $ "Documentation created: "
- ++ (exeTargetDir </> "index.html")
+ notice verbosity $ "Documentation created: "
+ ++ (exeTargetDir </> "index.html")
removeDirectoryRecursive tmpDir
where
diff --git a/Distribution/Simple/Hugs.hs b/Distribution/Simple/Hugs.hs
index c4396517ca..25b8f746c9 100644
--- a/Distribution/Simple/Hugs.hs
+++ b/Distribution/Simple/Hugs.hs
@@ -60,8 +60,8 @@ import Distribution.Simple.PreProcess.Unlit
( unlit )
import Distribution.Simple.LocalBuildInfo
( LocalBuildInfo(..), autogenModulesDir )
-import Distribution.Simple.Utils( createDirectoryIfMissingVerbose, die,
- dotToSep, moduleToFilePath,
+import Distribution.Simple.Utils( createDirectoryIfMissingVerbose, dotToSep,
+ moduleToFilePath, die, info, notice,
smartCopySources, findFile, dllExtension )
import Language.Haskell.Extension
( Extension(..) )
@@ -168,8 +168,7 @@ build pkg_descr lbi verbosity = do
-- Pass 1: copy or cpp files from build directory to scratch directory
let useCpp = CPP `elem` extensions bi
let srcDirs = nub $ srcDir : hsSourceDirs bi ++ mLibSrcDirs
- when (verbosity >= verbose)
- (putStrLn $ "Source directories: " ++ show srcDirs)
+ info verbosity $ "Source directories: " ++ show srcDirs
flip mapM_ mods $ \ m -> do
fs <- moduleToFilePath srcDirs m suffixes
case fs of
@@ -202,7 +201,7 @@ build pkg_descr lbi verbosity = do
compileFiles bi modDir fileList = do
ffiFileList <- filterM testFFI fileList
unless (null ffiFileList) $ do
- when (verbosity >= normal) (putStrLn "Compiling FFI stubs")
+ notice verbosity "Compiling FFI stubs"
mapM_ (compileFFI bi modDir) ffiFileList
-- Only compile FFI stubs for a file if it contains some FFI stuff
diff --git a/Distribution/Simple/Install.hs b/Distribution/Simple/Install.hs
index eeae5eab8d..63fc37ec67 100644
--- a/Distribution/Simple/Install.hs
+++ b/Distribution/Simple/Install.hs
@@ -71,7 +71,7 @@ import Distribution.PackageDescription (
import Distribution.Simple.LocalBuildInfo (
LocalBuildInfo(..), InstallDirs(..), absoluteInstallDirs, haddockPref)
import Distribution.Simple.Utils (createDirectoryIfMissingVerbose,
- copyFileVerbose, die,
+ copyFileVerbose, die, info, notice,
copyDirectoryRecursiveVerbose)
import Distribution.Simple.Compiler (CompilerFlavor(..), Compiler(..))
import Distribution.Simple.Setup (CopyFlags(..), CopyDest(..))
@@ -110,9 +110,8 @@ install pkg_descr lbi (CopyFlags copydest verbosity) = do
includedir = incPref
} = absoluteInstallDirs pkg_descr lbi copydest
docExists <- doesDirectoryExist $ haddockPref pkg_descr
- when (verbosity >= verbose)
- (putStrLn ("directory " ++ haddockPref pkg_descr ++
- " does exist: " ++ show docExists))
+ info verbosity ("directory " ++ haddockPref pkg_descr ++
+ " does exist: " ++ show docExists)
flip mapM_ (dataFiles pkg_descr) $ \ file -> do
let dir = takeDirectory file
createDirectoryIfMissingVerbose verbosity True (dataPref </> dir)
@@ -128,10 +127,10 @@ install pkg_descr lbi (CopyFlags copydest verbosity) = do
copyFileVerbose verbosity lfile (docPref </> lfile)
let buildPref = buildDir lbi
- when (hasLibs pkg_descr && verbosity >= normal) $
- putStrLn ("Installing: " ++ libPref)
- when (hasExes pkg_descr && verbosity >= normal) $
- putStrLn ("Installing: " ++ binPref)
+ when (hasLibs pkg_descr) $
+ notice verbosity ("Installing: " ++ libPref)
+ when (hasExes pkg_descr) $
+ notice verbosity ("Installing: " ++ binPref)
-- install include files for all compilers - they may be needed to compile
-- haskell files (using the CPP extension)
diff --git a/Distribution/Simple/JHC.hs b/Distribution/Simple/JHC.hs
index f5f91f43f2..e0027b815b 100644
--- a/Distribution/Simple/JHC.hs
+++ b/Distribution/Simple/JHC.hs
@@ -63,13 +63,12 @@ import Distribution.Version ( VersionRange(AnyVersion) )
import Distribution.Package ( PackageIdentifier(..), showPackageId,
parsePackageId )
import Distribution.Simple.Utils( createDirectoryIfMissingVerbose,
- copyFileVerbose, exeExtension, die )
+ copyFileVerbose, exeExtension, die, info )
import System.FilePath ( (</>) )
import Distribution.Verbosity
import Distribution.Compat.ReadP
( readP_to_S, many, skipSpaces )
-import Control.Monad ( when )
import Data.List ( nub, intersperse )
import Data.Char ( isSpace )
@@ -122,7 +121,7 @@ build :: PackageDescription -> LocalBuildInfo -> Verbosity -> IO ()
build pkg_descr lbi verbosity = do
let Just jhcProg = lookupProgram jhcProgram (withPrograms lbi)
withLib pkg_descr () $ \lib -> do
- when (verbosity >= verbose) (putStrLn "Building library...")
+ info verbosity "Building library..."
let libBi = libBuildInfo lib
let args = constructJHCCmdLine lbi libBi (buildDir lbi) verbosity
rawSystemProgram verbosity jhcProg (["-c"] ++ args ++ libModules pkg_descr)
@@ -132,8 +131,7 @@ build pkg_descr lbi verbosity = do
writeFile pfile $ jhcPkgConf pkg_descr
rawSystemProgram verbosity jhcProg ["--build-hl="++pfile, "-o", hlfile]
withExe pkg_descr $ \exe -> do
- when (verbosity >= verbose)
- (putStrLn ("Building executable "++exeName exe))
+ info verbosity ("Building executable "++exeName exe)
let exeBi = buildInfo exe
let out = buildDir lbi </> exeName exe
let args = constructJHCCmdLine lbi exeBi (buildDir lbi) verbosity
diff --git a/Distribution/Simple/PreProcess.hs b/Distribution/Simple/PreProcess.hs
index e36c98fa0c..0a5d6c364d 100644
--- a/Distribution/Simple/PreProcess.hs
+++ b/Distribution/Simple/PreProcess.hs
@@ -92,8 +92,7 @@ import System.FilePath (splitExtension, dropExtensions, (</>), (<.>),
-- > PreProcessor {
-- > platformIndependent = True,
-- > runPreProcessor = mkSimplePreProcessor $ \inFile outFile verbosity ->
--- > do when (verbosity >= normal) $
--- > putStrLn (inFile++" has been preprocessed to "++outFile)
+-- > do info verbosity (inFile++" has been preprocessed to "++outFile)
-- > stuff <- readFile inFile
-- > writeFile outFile ("-- preprocessed as a test\n\n" ++ stuff)
-- > return ExitSuccess
diff --git a/Distribution/Simple/Program.hs b/Distribution/Simple/Program.hs
index 78a0eb3f94..d363249331 100644
--- a/Distribution/Simple/Program.hs
+++ b/Distribution/Simple/Program.hs
@@ -85,12 +85,12 @@ module Distribution.Simple.Program (
import qualified Distribution.Compat.Map as Map
import Distribution.Compat.Directory (findExecutable)
-import Distribution.Simple.Utils (die, rawSystemExit, rawSystemStdout)
+import Distribution.Simple.Utils (die, debug, warn, rawSystemExit, rawSystemStdout)
import Distribution.Version (Version, readVersion, showVersion,
VersionRange(..), withinRange, showVersionRange)
import Distribution.Verbosity
import System.Directory (doesFileExist)
-import Control.Monad (when, join, foldM)
+import Control.Monad (join, foldM)
import Control.Exception as Exception (catch)
-- | Represents a program which can be configured.
@@ -157,12 +157,11 @@ simpleProgram name =
-- | Look for a program on the path.
findProgramOnPath :: FilePath -> Verbosity -> IO (Maybe FilePath)
findProgramOnPath prog verbosity = do
- when (verbosity >= deafening) $
- putStrLn $ "searching for " ++ prog ++ " in path."
+ debug verbosity $ "searching for " ++ prog ++ " in path."
res <- findExecutable prog
- when (verbosity >= deafening) $ case res of
- Nothing -> putStrLn ("Cannot find " ++ prog ++ " on the path")
- Just path -> putStrLn ("found " ++ prog ++ " at "++ path)
+ case res of
+ Nothing -> debug verbosity ("Cannot find " ++ prog ++ " on the path")
+ Just path -> debug verbosity ("found " ++ prog ++ " at "++ path)
return res
-- | Look for a program and try to find it's version number. It can accept
@@ -180,11 +179,9 @@ findProgramVersion versionArg selectVersion verbosity path = do
`Exception.catch` \_ -> return ""
let version = readVersion (selectVersion str)
case version of
- Nothing -> when (verbosity >= normal) $
- putStrLn $ "cannot determine version of " ++ path ++ " :\n"
- ++ show str
- Just v -> when (verbosity >= deafening) $
- putStrLn $ path ++ " is version " ++ showVersion v
+ Nothing -> warn verbosity $ "cannot determine version of " ++ path
+ ++ " :\n" ++ show str
+ Just v -> debug verbosity $ path ++ " is version " ++ showVersion v
return version
-- ------------------------------------------------------------
@@ -425,7 +422,7 @@ rawSystemProgramConf :: Verbosity -- ^verbosity
-> IO ()
rawSystemProgramConf verbosity prog programConf extraArgs =
case lookupProgram prog programConf of
- Nothing -> die (programName prog ++ " command not found")
+ Nothing -> die ("The program " ++ programName prog ++ " is required but it could not be found")
Just configuredProg -> rawSystemProgram verbosity configuredProg extraArgs
-- | Looks up the given program in the program configuration and runs it.
@@ -436,7 +433,7 @@ rawSystemProgramStdoutConf :: Verbosity -- ^verbosity
-> IO String
rawSystemProgramStdoutConf verbosity prog programConf extraArgs =
case lookupProgram prog programConf of
- Nothing -> die (programName prog ++ " command not found")
+ Nothing -> die ("The program " ++ programName prog ++ " is required but it could not be found")
Just configuredProg -> rawSystemProgramStdout verbosity configuredProg extraArgs
-- ------------------------------------------------------------
diff --git a/Distribution/Simple/Register.hs b/Distribution/Simple/Register.hs
index aa9b4aa09d..72f32df06f 100644
--- a/Distribution/Simple/Register.hs
+++ b/Distribution/Simple/Register.hs
@@ -81,7 +81,7 @@ import Distribution.InstalledPackageInfo
emptyInstalledPackageInfo)
import qualified Distribution.InstalledPackageInfo as IPI
import Distribution.Simple.Utils (createDirectoryIfMissingVerbose,
- copyFileVerbose, die)
+ copyFileVerbose, die, info)
import Distribution.Simple.GHC.PackageConfig (mkGHCPackageConfig, showGHCPackageConfig)
import qualified Distribution.Simple.GHC.PackageConfig
as GHC (localPackageConfig, canWriteLocalPackageConfig, maybeCreateLocalPackageConfig)
@@ -164,8 +164,7 @@ register pkg_descr lbi regFlags
| otherwise = installedPkgConfigFile
when (genPkgConf || not genScript) $ do
- when (verbosity >= verbose) $
- putStrLn ("create " ++ instConf)
+ info verbosity ("create " ++ instConf)
writeInstalledConfig pkg_descr lbi inplace (Just instConf)
let register_flags
diff --git a/Distribution/Simple/SrcDist.hs b/Distribution/Simple/SrcDist.hs
index 7cae6ed78c..f45d5c62a6 100644
--- a/Distribution/Simple/SrcDist.hs
+++ b/Distribution/Simple/SrcDist.hs
@@ -63,8 +63,8 @@ import Distribution.PackageDescription
import Distribution.Package (showPackageId, PackageIdentifier(pkgVersion))
import Distribution.Version (Version(versionBranch), VersionRange(AnyVersion))
import Distribution.Simple.Utils (createDirectoryIfMissingVerbose,
- smartCopySources, die, findPackageDesc,
- findFile, copyFileVerbose)
+ smartCopySources, die, warn, notice,
+ findPackageDesc, findFile, copyFileVerbose)
import Distribution.Simple.Setup (SDistFlags(..))
import Distribution.Simple.PreProcess (PPSuffixHandler, ppSuffixes, preprocessSources)
import Distribution.Simple.LocalBuildInfo ( LocalBuildInfo(..) )
@@ -163,8 +163,8 @@ prepareTree pkg_descr verbosity mb_lbi snapshot tmpDir pps date = do
case mb_lbi of
Just lbi -> preprocessSources pkg_descr (lbi { buildDir = targetDir })
True verbosity pps
- Nothing -> putStrLn $
- "Warning: Cannot run preprocessors. Run 'configure' command first."
+ Nothing -> warn verbosity
+ "Cannot run preprocessors. Run 'configure' command first."
-- setup isn't listed in the description file.
hsExists <- doesFileExist "Setup.hs"
@@ -224,8 +224,7 @@ createArchive pkg_descr verbosity mb_lbi tmpDir targetPref = do
["-C", tmpDir, "-czf", tarBallFilePath, nameVersion pkg_descr]
-- XXX this should be done back where tmpDir is made, not here
`finally` removeDirectoryRecursive tmpDir
- when (verbosity >= normal) $
- putStrLn $ "Source tarball created: " ++ tarBallFilePath
+ notice verbosity $ "Source tarball created: " ++ tarBallFilePath
return tarBallFilePath
-- |Move the sources into place based on buildInfo
diff --git a/Distribution/Simple/Utils.hs b/Distribution/Simple/Utils.hs
index 6724be0874..371b39a771 100644
--- a/Distribution/Simple/Utils.hs
+++ b/Distribution/Simple/Utils.hs
@@ -44,7 +44,7 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -}
module Distribution.Simple.Utils (
die,
dieWithLocation,
- warn,
+ warn, notice, info, debug,
breaks,
wrapText,
rawSystemExit,
@@ -150,11 +150,45 @@ die msg = do
hPutStrLn stderr (pname ++ ": " ++ msg)
exitWith (ExitFailure 1)
+-- | Non fatal conditions that may be indicative of an error or problem.
+--
+-- We display these at the 'normal' verbosity level.
+--
warn :: Verbosity -> String -> IO ()
-warn verbosity msg = do
- hFlush stdout
- pname <- getProgName
- when (verbosity >= normal) $ hPutStrLn stderr (pname ++ ": Warning: " ++ msg)
+warn verbosity msg =
+ when (verbosity >= normal) $ do
+ hFlush stdout
+ hPutStrLn stderr ("Warning: " ++ msg)
+
+-- | Useful status messages.
+--
+-- We display these at the 'normal' verbosity level.
+--
+-- This is for the ordinary helpful status messages that users see. Just
+-- enough information to know that things are working but not floods of detail.
+--
+notice :: Verbosity -> String -> IO ()
+notice verbosity msg =
+ when (verbosity >= normal) $
+ putStrLn msg
+
+-- | More detail on the operation of some action.
+--
+-- We display these messages when the verbosity level is 'verbose'
+--
+info :: Verbosity -> String -> IO ()
+info verbosity msg =
+ when (verbosity >= verbose) $
+ putStrLn msg
+
+-- | Detailed internal debugging information
+--
+-- We display these messages when the verbosity level is 'deafening'
+--
+debug :: Verbosity -> String -> IO ()
+debug verbosity msg =
+ when (verbosity >= deafening) $
+ putStrLn msg
-- -----------------------------------------------------------------------------
-- Helper functions
@@ -366,22 +400,19 @@ smartCopySources verbosity srcDirs targetDir sources searchSuffixes exitIfNone p
createDirectoryIfMissingVerbose :: Verbosity -> Bool -> FilePath -> IO ()
createDirectoryIfMissingVerbose verbosity parentsToo dir = do
- when (verbosity >= verbose) $
- let msgParents = if parentsToo then " (and its parents)" else ""
- in putStrLn ("Creating " ++ dir ++ msgParents)
+ let msgParents = if parentsToo then " (and its parents)" else ""
+ info verbosity ("Creating " ++ dir ++ msgParents)
createDirectoryIfMissing parentsToo dir
copyFileVerbose :: Verbosity -> FilePath -> FilePath -> IO ()
copyFileVerbose verbosity src dest = do
- when (verbosity >= verbose) $
- putStrLn ("copy " ++ src ++ " to " ++ dest)
+ info verbosity ("copy " ++ src ++ " to " ++ dest)
copyFile src dest
-- adaptation of removeDirectoryRecursive
copyDirectoryRecursiveVerbose :: Verbosity -> FilePath -> FilePath -> IO ()
copyDirectoryRecursiveVerbose verbosity srcDir destDir = do
- when (verbosity >= verbose) $
- putStrLn ("copy directory '" ++ srcDir ++ "' to '" ++ destDir ++ "'.")
+ info verbosity ("copy directory '" ++ srcDir ++ "' to '" ++ destDir ++ "'.")
let aux src dest =
let cp :: FilePath -> IO ()
cp f = let srcFile = src </> f
--
GitLab