Commit eb0593ed authored by Edward Z. Yang's avatar Edward Z. Yang Committed by Edward Z. Yang

Propagate verbosity flags from cabal-install to Cabal

Now if you say cabal -v"info +callstacks", Cabal invocations
will also get call stacks.

There's a heinous hack to handle version of Cabal that don't
support the extended format.
Signed-off-by: default avatarEdward Z. Yang <ezyang@cs.stanford.edu>
parent f925445d
......@@ -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
......
......@@ -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'.
......
......@@ -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
......
......@@ -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
......
......@@ -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'.
......
{-# 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
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment