diff --git a/Cabal/Distribution/Simple/Utils.hs b/Cabal/Distribution/Simple/Utils.hs
index 2f28f880c8dc351519f7d52bd764560df3a17aee..12fdaff6c2755590d4fb866a1afa0145208c139a 100644
--- a/Cabal/Distribution/Simple/Utils.hs
+++ b/Cabal/Distribution/Simple/Utils.hs
@@ -333,8 +333,8 @@ dieMsg verbosity msg = do
-- | As 'dieMsg' but with pre-formatted text.
--
-dieMsgNoWrap :: String -> NoCallStackIO ()
-dieMsgNoWrap msg = do
+dieMsgNoWrap :: Verbosity -> String -> NoCallStackIO ()
+dieMsgNoWrap _verbosity msg = do
hFlush stdout
hPutStr stderr msg
diff --git a/Cabal/Distribution/Utils/LogProgress.hs b/Cabal/Distribution/Utils/LogProgress.hs
index 07aaa2e27380122160e40a349098c0a8faf739e9..12953aaac7b867f470d631266d52cc890d303e35 100644
--- a/Cabal/Distribution/Utils/LogProgress.hs
+++ b/Cabal/Distribution/Utils/LogProgress.hs
@@ -58,7 +58,7 @@ runLogProgress verbosity (LogProgress m) =
go
fail_fn :: Doc -> NoCallStackIO a
fail_fn doc = do
- dieMsgNoWrap (render doc ++ "\n")
+ dieMsgNoWrap verbosity (render doc ++ "\n")
die "Configuration failed"
-- | Output a warning trace message in 'LogProgress'.
diff --git a/Cabal/Distribution/Verbosity.hs b/Cabal/Distribution/Verbosity.hs
index aa9734a4482215005c2b2cc9f4d700646a7c5da0..03763cc1bac62f9256279308715dc32bd23a56fb 100644
--- a/Cabal/Distribution/Verbosity.hs
+++ b/Cabal/Distribution/Verbosity.hs
@@ -160,8 +160,21 @@ flagToVerbosity = ReadE $ \s ->
showForCabal, showForGHC :: Verbosity -> String
-showForCabal v = maybe (error "unknown verbosity") show $
- elemIndex v [silent,normal,verbose,deafening]
+showForCabal v
+ | Set.null (vFlags v)
+ = maybe (error "unknown verbosity") show $
+ elemIndex v [silent,normal,verbose,deafening]
+ | otherwise
+ = unwords $ (case vLevel v of
+ Silent -> "silent"
+ Normal -> "normal"
+ Verbose -> "verbose"
+ Deafening -> "debug")
+ : map showFlag (Set.toList (vFlags v))
+ where
+ showFlag VCallSite = "+callsite"
+ showFlag VCallStack = "+callstack"
+ showFlag VNoWrap = "+nowrap"
showForGHC v = maybe (error "unknown verbosity") show $
elemIndex v [silent,normal,__,verbose,deafening]
where __ = silent -- this will be always ignored by elemIndex
diff --git a/cabal-install/Distribution/Client/ProjectOrchestration.hs b/cabal-install/Distribution/Client/ProjectOrchestration.hs
index 0b37a00adc2d0c20bd35497361c092690f7258d8..e3a892857976bc1e0e178fca694dfc7d0b0fa464 100644
--- a/cabal-install/Distribution/Client/ProjectOrchestration.hs
+++ b/cabal-install/Distribution/Client/ProjectOrchestration.hs
@@ -644,7 +644,7 @@ dieOnBuildFailures verbosity plan buildOutcomes
[ do dieMsg verbosity $
'\n' : renderFailureDetail False pkg reason
++ "\nBuild log ( " ++ logfile ++ " ):"
- readFile logfile >>= dieMsgNoWrap
+ readFile logfile >>= dieMsgNoWrap verbosity
| verbosity >= normal
, (pkg, ShowBuildSummaryAndLog reason logfile)
<- failuresClassification
diff --git a/cabal-install/Distribution/Client/Setup.hs b/cabal-install/Distribution/Client/Setup.hs
index 4e136da9590778071fb502c79ce2af629f5be14f..bf868e5e9d0715d19a809e5fb42a7ca135edd685 100644
--- a/cabal-install/Distribution/Client/Setup.hs
+++ b/cabal-install/Distribution/Client/Setup.hs
@@ -113,7 +113,7 @@ import qualified Distribution.Compat.ReadP as Parse
import Distribution.ParseUtils
( readPToMaybe )
import Distribution.Verbosity
- ( Verbosity, lessVerbose, normal )
+ ( Verbosity, lessVerbose, normal, verboseNoFlags )
import Distribution.Simple.Utils
( wrapText, wrapLine )
import Distribution.Client.GlobalFlags
@@ -399,8 +399,12 @@ filterConfigureFlags flags cabalLibVersion
configAllowNewer = Just (Cabal.AllowNewer Cabal.RelaxDepsNone)
}
- -- Cabal < 1.25.0 doesn't know about --dynlibdir.
- flags_1_25_0 = flags_latest { configInstallDirs = configInstallDirs_1_25_0}
+ flags_1_25_0 = flags_latest {
+ -- Cabal < 1.25.0 doesn't know about --dynlibdir.
+ configInstallDirs = configInstallDirs_1_25_0,
+ -- Cabal < 1.25 doesn't have extended verbosity syntax
+ configVerbosity = fmap verboseNoFlags (configVerbosity flags_latest)
+ }
configInstallDirs_1_25_0 = (configInstallDirs flags) { dynlibdir = NoFlag }
-- Cabal < 1.23 doesn't know about '--profiling-detail'.
diff --git a/cabal-install/Distribution/Client/SetupWrapper.hs b/cabal-install/Distribution/Client/SetupWrapper.hs
index 69fe07d49320929fee827daf9d880d03933b84c9..44fa1407ea9d8d86db46cdc5f9c71e2afb1088c4 100644
--- a/cabal-install/Distribution/Client/SetupWrapper.hs
+++ b/cabal-install/Distribution/Client/SetupWrapper.hs
@@ -1,4 +1,5 @@
{-# LANGUAGE CPP #-}
+{-# LANGUAGE FlexibleContexts #-}
-----------------------------------------------------------------------------
-- |
-- Module : Distribution.Client.SetupWrapper
@@ -85,7 +86,7 @@ import Distribution.Client.JobControl
import Distribution.Simple.Setup
( Flag(..) )
import Distribution.Simple.Utils
- ( die, debug, info, cabalVersion, tryFindPackageDesc, comparing
+ ( die, debug, info, infoNoWrap, cabalVersion, tryFindPackageDesc, comparing
, createDirectoryIfMissingVerbose, installExecutableFile
, copyFileVerbose, rewriteFile )
import Distribution.Client.Utils
@@ -95,15 +96,17 @@ import Distribution.Client.Utils
, canonicalizePathNoThrow
#endif
)
+
+import Distribution.ReadE
import Distribution.System ( Platform(..), buildPlatform )
import Distribution.Text
( display )
import Distribution.Utils.NubList
( toNubListR )
import Distribution.Verbosity
- ( Verbosity, normal )
import Distribution.Compat.Exception
( catchIO )
+import Distribution.Compat.Stack
import System.Directory ( doesFileExist )
import System.FilePath ( (</>), (<.>) )
@@ -335,7 +338,7 @@ getSetupMethod verbosity options pkg buildType'
return (cabalVersion, SelfExecMethod, options)
| otherwise = return (cabalVersion, InternalMethod, options)
-runSetupMethod :: SetupMethod -> SetupRunner
+runSetupMethod :: WithCallStack (SetupMethod -> SetupRunner)
runSetupMethod InternalMethod = internalSetupMethod
runSetupMethod (ExternalMethod path) = externalSetupMethod path
runSetupMethod SelfExecMethod = selfExecSetupMethod
@@ -344,11 +347,45 @@ runSetupMethod SelfExecMethod = selfExecSetupMethod
runSetup :: Verbosity -> Setup
-> [String] -- ^ command-line arguments
-> IO ()
-runSetup verbosity setup args =
+runSetup verbosity setup args0 = do
let method = setupMethod setup
options = setupScriptOptions setup
bt = setupBuildType setup
- in runSetupMethod method verbosity options bt args
+ args = verbosityHack (setupVersion setup) args0
+ when (verbosity >= deafening {- avoid test if not debug -} && args /= args0) $
+ infoNoWrap verbose $
+ "Applied verbosity hack:\n" ++
+ " Before: " ++ show args0 ++ "\n" ++
+ " After: " ++ show args ++ "\n"
+ runSetupMethod method verbosity options bt args
+
+-- | This is a horrible hack to make sure passing fancy verbosity
+-- flags (e.g., @-v'info +callstack'@) doesn't break horribly on
+-- old Setup. We can't do it in 'filterConfigureFlags' because
+-- verbosity applies to ALL commands.
+verbosityHack :: Version -> [String] -> [String]
+verbosityHack ver args0
+ | ver >= mkVersion [1,25] = args0
+ | otherwise = go args0
+ where
+ go (('-':'v':rest) : args)
+ | Just rest' <- munch rest = ("-v" ++ rest') : go args
+ go (('-':'-':'v':'e':'r':'b':'o':'s':'e':'=':rest) : args)
+ | Just rest' <- munch rest = ("--verbose=" ++ rest') : go args
+ go ("--verbose" : rest : args)
+ | Just rest' <- munch rest = "--verbose" : rest' : go args
+ go rest@("--" : _) = rest
+ go (arg:args) = arg : go args
+ go [] = []
+
+ munch rest =
+ case runReadE flagToVerbosity rest of
+ Right v | verboseHasFlags v
+ -- We could preserve the prefix, but since we're assuming
+ -- it's Cabal's verbosity flag, we can assume that
+ -- any format is OK
+ -> Just (showForCabal (verboseNoFlags v))
+ _ -> Nothing
-- | Run a command through a configured 'Setup'.
runSetupCommand :: Verbosity -> Setup
@@ -459,7 +496,7 @@ selfExecSetupMethod verbosity options bt args0 = do
-- * External SetupMethod
-- ------------------------------------------------------------
-externalSetupMethod :: FilePath -> SetupRunner
+externalSetupMethod :: WithCallStack (FilePath -> SetupRunner)
externalSetupMethod path verbosity options _ args = do
info verbosity $ unwords (path : args)
case useLoggingHandle options of