Commit 83c93c10 authored by Edward Z. Yang's avatar Edward Z. Yang

Add support for extended verbosity specification -v"debug +callsite"

This patch uses CallStack support in GHC 7.10 and GHC 8.0 to make
it possible to get stack traces when we log output.

This is the bare minimum to make this patch useful: there is
plenty of tuning that can be done.  For example:

* Insertions of withFrozenCallStack can help make the "callsite" output
  more useful, though be careful, we lose all stack information at that point!

* Insertions of 'WithVerbosity', which will let us get deeper stacks
  (at the moment, they are basically always 1-deep.)

Fixes #3768.

CC @23SkidooSigned-off-by: default avatarEdward Z. Yang <ezyang@cs.stanford.edu>
parent c171c78f
......@@ -313,6 +313,7 @@ library
Distribution.Compat.Internal.TempFile
Distribution.Compat.ReadP
Distribution.Compat.Semigroup
Distribution.Compat.Stack
Distribution.Compat.Time
Distribution.Compiler
Distribution.InstalledPackageInfo
......
......@@ -37,6 +37,7 @@ module Distribution.Compat.ReadP
-- * Other operations
pfail, -- :: ReadP a
eof, -- :: ReadP ()
satisfy, -- :: (Char -> Bool) -> ReadP Char
char, -- :: Char -> ReadP Char
string, -- :: String -> ReadP String
......@@ -204,6 +205,12 @@ pfail :: ReadP r a
-- ^ Always fails.
pfail = R (const Fail)
eof :: ReadP r ()
-- ^ Succeeds iff we are at the end of input
eof = do { s <- look
; if null s then return ()
else pfail }
(+++) :: ReadP r a -> ReadP r a -> ReadP r a
-- ^ Symmetric choice.
R f1 +++ R f2 = R (\k -> f1 k `mplus` f2 k)
......
{-# LANGUAGE CPP #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ImplicitParams #-}
module Distribution.Compat.Stack (
WithCallStack,
CallStack,
withFrozenCallStack,
callStack,
prettyCallStack,
parentSrcLocPrefix
) where
#ifdef MIN_VERSION_base
#if MIN_VERSION_base(4,8,1)
#define GHC_STACK_SUPPORTED 1
#endif
#endif
#ifdef GHC_STACK_SUPPORTED
import GHC.Stack
#endif
#ifdef GHC_STACK_SUPPORTED
#if MIN_VERSION_base(4,9,0)
type WithCallStack a = HasCallStack => a
#elif MIN_VERSION_base(4,8,1)
type WithCallStack a = (?loc :: CallStack) => a
#endif
#if !MIN_VERSION_base(4,9,0)
-- NB: Can't say WithCallStack (WithCallStack a -> a);
-- Haskell doesn't support this kind of implicit parameter!
-- See https://mail.haskell.org/pipermail/ghc-devs/2016-January/011096.html
-- Since this function doesn't do anything, it's OK to
-- give it a less good type.
withFrozenCallStack :: WithCallStack (a -> a)
withFrozenCallStack x = x
callStack :: (?loc :: CallStack) => CallStack
callStack = ?loc
prettyCallStack :: CallStack -> String
prettyCallStack = showCallStack
#endif
-- | Give the *parent* of the person who invoked this;
-- so it's most suitable for being called from a utility function.
-- You probably want to call this using 'withFrozenCallStack'; otherwise
-- it's not very useful. We didn't implement this for base-4.8.1
-- because we cannot rely on freezing to have taken place.
--
parentSrcLocPrefix :: WithCallStack String
#if MIN_VERSION_base(4,9,0)
parentSrcLocPrefix =
case getCallStack callStack of
(_:(_, loc):_) -> showLoc loc
[(_, loc)] -> showLoc loc
[] -> error "parentSrcLocPrefix: empty call stack"
where
showLoc loc =
srcLocFile loc ++ ":" ++ show (srcLocStartLine loc) ++ ": "
#else
parentSrcLocPrefix = "Call sites not available with base < 4.9.0.0 (GHC 8.0): "
#endif
#else
data CallStack = CallStack
deriving (Eq, Show)
type WithCallStack a = a
withFrozenCallStack :: a -> a
withFrozenCallStack x = x
callStack :: CallStack
callStack = CallStack
prettyCallStack :: CallStack -> String
prettyCallStack _ = "Call stacks not available with base < 4.8.1.0 (GHC 7.10)"
parentSrcLocPrefix :: String
parentSrcLocPrefix = "Call sites not available with base < 4.9.0.0 (GHC 8.0): "
#endif
This diff is collapsed.
......@@ -9,9 +9,17 @@
-- Maintainer : cabal-devel@haskell.org
-- Portability : portable
--
-- A simple 'Verbosity' type with associated utilities. There are 4 standard
-- verbosity levels from 'silent', 'normal', 'verbose' up to 'deafening'. This
-- is used for deciding what logging messages to print.
-- A 'Verbosity' type with associated utilities.
--
-- There are 4 standard verbosity levels from 'silent', 'normal',
-- 'verbose' up to 'deafening'. This is used for deciding what logging
-- messages to print.
--
-- Verbosity also is equipped with some internal settings which can be
-- used to control at a fine granularity the verbosity of specific
-- settings (e.g., so that you can trace only particular things you
-- are interested in.) It's important to note that the instances
-- for 'Verbosity' assume that this does not exist.
-- Verbosity for Cabal functions.
......@@ -21,65 +29,126 @@ module Distribution.Verbosity (
silent, normal, verbose, deafening,
moreVerbose, lessVerbose,
intToVerbosity, flagToVerbosity,
showForCabal, showForGHC
showForCabal, showForGHC,
-- * Call stacks
verboseCallSite, verboseCallStack,
isVerboseCallSite, isVerboseCallStack,
) where
import Prelude ()
import Distribution.Compat.Prelude
import Distribution.ReadE
import Distribution.Compat.ReadP
import Data.List (elemIndex)
data Verbosity = Silent | Normal | Verbose | Deafening
deriving (Generic, Show, Read, Eq, Ord, Enum, Bounded)
data Verbosity = Verbosity {
vLevel :: VerbosityLevel,
vCallStack :: CallStackLevel
} deriving (Generic)
mkVerbosity :: VerbosityLevel -> Verbosity
mkVerbosity l = Verbosity { vLevel = l, vCallStack = NoStack }
instance Show Verbosity where
showsPrec n = showsPrec n . vLevel
instance Read Verbosity where
readsPrec n s = map (\(x,y) -> (mkVerbosity x,y)) (readsPrec n s)
instance Eq Verbosity where
x == y = vLevel x == vLevel y
instance Ord Verbosity where
compare x y = compare (vLevel x) (vLevel y)
instance Enum Verbosity where
toEnum = mkVerbosity . toEnum
fromEnum = fromEnum . vLevel
instance Bounded Verbosity where
minBound = mkVerbosity minBound
maxBound = mkVerbosity maxBound
instance Binary Verbosity
data VerbosityLevel = Silent | Normal | Verbose | Deafening
deriving (Generic, Show, Read, Eq, Ord, Enum, Bounded)
instance Binary VerbosityLevel
-- We shouldn't print /anything/ unless an error occurs in silent mode
silent :: Verbosity
silent = Silent
silent = mkVerbosity Silent
-- Print stuff we want to see by default
normal :: Verbosity
normal = Normal
normal = mkVerbosity Normal
-- Be more verbose about what's going on
verbose :: Verbosity
verbose = Verbose
verbose = mkVerbosity Verbose
-- Not only are we verbose ourselves (perhaps even noisier than when
-- being "verbose"), but we tell everything we run to be verbose too
deafening :: Verbosity
deafening = Deafening
deafening = mkVerbosity Deafening
moreVerbose :: Verbosity -> Verbosity
moreVerbose Silent = Silent --silent should stay silent
moreVerbose Normal = Verbose
moreVerbose Verbose = Deafening
moreVerbose Deafening = Deafening
moreVerbose v =
case vLevel v of
Silent -> v -- silent should stay silent
Normal -> v { vLevel = Verbose }
Verbose -> v { vLevel = Deafening }
Deafening -> v
lessVerbose :: Verbosity -> Verbosity
lessVerbose Deafening = Deafening
lessVerbose Verbose = Normal
lessVerbose Normal = Silent
lessVerbose Silent = Silent
lessVerbose v =
case vLevel v of
Deafening -> v -- deafening stays deafening
Verbose -> v { vLevel = Normal }
Normal -> v { vLevel = Silent }
Silent -> v
intToVerbosity :: Int -> Maybe Verbosity
intToVerbosity 0 = Just Silent
intToVerbosity 1 = Just Normal
intToVerbosity 2 = Just Verbose
intToVerbosity 3 = Just Deafening
intToVerbosity 0 = Just (mkVerbosity Silent)
intToVerbosity 1 = Just (mkVerbosity Normal)
intToVerbosity 2 = Just (mkVerbosity Verbose)
intToVerbosity 3 = Just (mkVerbosity Deafening)
intToVerbosity _ = Nothing
parseVerbosity :: ReadP r (Either Int Verbosity)
parseVerbosity = parseIntVerbosity <++ parseStringVerbosity
where
parseIntVerbosity = fmap Left (readS_to_P reads)
parseStringVerbosity = fmap Right $ do
level <- parseVerbosityLevel
_ <- skipSpaces
extras <- sepBy parseExtra skipSpaces
return (foldr (.) id extras (mkVerbosity level))
parseVerbosityLevel = choice
[ string "silent" >> return Silent
, string "normal" >> return Normal
, string "verbose" >> return Verbose
, string "debug" >> return Deafening
, string "deafening" >> return Deafening
]
parseExtra = char '+' >> choice
[ string "callsite" >> return verboseCallSite
, string "callstack" >> return verboseCallStack
]
flagToVerbosity :: ReadE Verbosity
flagToVerbosity = ReadE $ \s ->
case reads s of
[(i, "")] ->
case readP_to_S (parseVerbosity >>= \r -> eof >> return r) s of
[(Left i, "")] ->
case intToVerbosity i of
Just v -> Right v
Nothing -> Left ("Bad verbosity: " ++ show i ++
". Valid values are 0..3")
[(Right v, "")] -> Right v
_ -> Left ("Can't parse verbosity " ++ s)
showForCabal, showForGHC :: Verbosity -> String
......@@ -89,3 +158,24 @@ showForCabal v = maybe (error "unknown verbosity") show $
showForGHC v = maybe (error "unknown verbosity") show $
elemIndex v [silent,normal,__,verbose,deafening]
where __ = silent -- this will be always ignored by elemIndex
data CallStackLevel = NoStack | TopStackFrame | FullStack
deriving (Generic, Show, Read, Eq, Ord, Enum, Bounded)
instance Binary CallStackLevel
-- | Turn on verbose call-site printing when we log. Overrides 'verboseCallStack'.
verboseCallSite :: Verbosity -> Verbosity
verboseCallSite v = v { vCallStack = TopStackFrame }
-- | Turn on verbose call-stack printing when we log. Overrides 'verboseCallSite'.
verboseCallStack :: Verbosity -> Verbosity
verboseCallStack v = v { vCallStack = FullStack }
-- | Test if we should output call sites when we log.
isVerboseCallSite :: Verbosity -> Bool
isVerboseCallSite = (== TopStackFrame) . vCallStack
-- | Test if we should output call stacks when we log.
isVerboseCallStack :: Verbosity -> Bool
isVerboseCallStack = (== FullStack) . vCallStack
......@@ -77,6 +77,14 @@
'GHCJS_PACKAGE_PATH', lifting the restriction that they be unset.
(#3728,#2711).
* Add support for new caret-style version range operator `^>=` (#3705)
* Verbosity `-v` now takes an extended format which allows
specifying exactly what you want to be logged. The format is
"[silent|normal|verbose|debug] flags", where flags is a space
separated list of flags. At the moment, only the flags
+callsite and +callstack are supported; these report the
call site/stack of a logging output respectively (these
are only supported if Cabal is built with GHC 8.0/7.10.2
or greater, respectively).
1.24.0.0 Ryan Thomas <ryan@ryant.org> March 2016
* Support GHC 8.
......
......@@ -409,6 +409,15 @@ The following options are understood by all commands:
Set the verbosity level (0-3). The normal level is 1; a missing *n*
defaults to 2.
There is also an extended version of this command which can be
used to fine-tune the verbosity of output. It takes the
form ``[silent|normal|verbose|debug]``\ *flags*, where *flags*
is a list of ``+`` flags which toggle various aspects of
output. At the moment, only ``+callsite`` and ``+callstack``
are supported, which respectively toggle call site and call
stack printing (these are only supported if Cabal
is built with a sufficiently recent GHC.)
The various commands and the additional options they support are
described below. In the simple build infrastructure, any other options
will be reported as errors.
......
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