1{-# LANGUAGE DeriveDataTypeable #-}
2{-# LANGUAGE DeriveGeneric #-}
3
4-----------------------------------------------------------------------------
5-- |
6-- Module      :  Distribution.Verbosity
7-- Copyright   :  Ian Lynagh 2007
8-- License     :  BSD3
9--
10-- Maintainer  :  cabal-devel@haskell.org
11-- Portability :  portable
12--
13-- A 'Verbosity' type with associated utilities.
14--
15-- There are 4 standard verbosity levels from 'silent', 'normal',
16-- 'verbose' up to 'deafening'. This is used for deciding what logging
17-- messages to print.
18--
19-- Verbosity also is equipped with some internal settings which can be
20-- used to control at a fine granularity the verbosity of specific
21-- settings (e.g., so that you can trace only particular things you
22-- are interested in.)  It's important to note that the instances
23-- for 'Verbosity' assume that this does not exist.
24
25-- Verbosity for Cabal functions.
26
27module Distribution.Verbosity (
28  -- * Verbosity
29  Verbosity,
30  silent, normal, verbose, deafening,
31  moreVerbose, lessVerbose, isVerboseQuiet,
32  intToVerbosity, flagToVerbosity,
33  showForCabal, showForGHC,
34  verboseNoFlags, verboseHasFlags,
35  modifyVerbosity,
36
37  -- * Call stacks
38  verboseCallSite, verboseCallStack,
39  isVerboseCallSite, isVerboseCallStack,
40
41  -- * Output markets
42  verboseMarkOutput, isVerboseMarkOutput,
43  verboseUnmarkOutput,
44
45  -- * line-wrapping
46  verboseNoWrap, isVerboseNoWrap,
47
48  -- * timestamps
49  verboseTimestamp, isVerboseTimestamp,
50  verboseNoTimestamp,
51
52  -- * Stderr
53  verboseStderr, isVerboseStderr,
54  verboseNoStderr,
55  ) where
56
57import Prelude ()
58import Distribution.Compat.Prelude
59
60import Distribution.ReadE
61
62import Data.List (elemIndex)
63import Distribution.Parsec
64import Distribution.Pretty
65import Distribution.Verbosity.Internal
66import Distribution.Utils.Generic (isAsciiAlpha)
67
68import qualified Data.Set as Set
69import qualified Distribution.Compat.CharParsing as P
70import qualified Text.PrettyPrint as PP
71
72data Verbosity = Verbosity {
73    vLevel :: VerbosityLevel,
74    vFlags :: Set VerbosityFlag,
75    vQuiet :: Bool
76  } deriving (Generic, Show, Read, Typeable)
77
78mkVerbosity :: VerbosityLevel -> Verbosity
79mkVerbosity l = Verbosity { vLevel = l, vFlags = Set.empty, vQuiet = False }
80
81instance Eq Verbosity where
82    x == y = vLevel x == vLevel y
83
84instance Ord Verbosity where
85    compare x y = compare (vLevel x) (vLevel y)
86
87instance Enum Verbosity where
88    toEnum = mkVerbosity . toEnum
89    fromEnum = fromEnum . vLevel
90
91instance Bounded Verbosity where
92    minBound = mkVerbosity minBound
93    maxBound = mkVerbosity maxBound
94
95instance Binary Verbosity
96instance Structured Verbosity
97
98-- We shouldn't print /anything/ unless an error occurs in silent mode
99silent :: Verbosity
100silent = mkVerbosity Silent
101
102-- Print stuff we want to see by default
103normal :: Verbosity
104normal = mkVerbosity Normal
105
106-- Be more verbose about what's going on
107verbose :: Verbosity
108verbose = mkVerbosity Verbose
109
110-- Not only are we verbose ourselves (perhaps even noisier than when
111-- being "verbose"), but we tell everything we run to be verbose too
112deafening :: Verbosity
113deafening = mkVerbosity Deafening
114
115moreVerbose :: Verbosity -> Verbosity
116moreVerbose v =
117    case vLevel v of
118        Silent    -> v -- silent should stay silent
119        Normal    -> v { vLevel = Verbose }
120        Verbose   -> v { vLevel = Deafening }
121        Deafening -> v
122
123lessVerbose :: Verbosity -> Verbosity
124lessVerbose v =
125    verboseQuiet $
126    case vLevel v of
127        Deafening -> v -- deafening stays deafening
128        Verbose   -> v { vLevel = Normal }
129        Normal    -> v { vLevel = Silent }
130        Silent    -> v
131
132-- | Combinator for transforming verbosity level while retaining the
133-- original hidden state.
134--
135-- For instance, the following property holds
136--
137-- prop> isVerboseNoWrap (modifyVerbosity (max verbose) v) == isVerboseNoWrap v
138--
139-- __Note__: you can use @modifyVerbosity (const v1) v0@ to overwrite
140-- @v1@'s flags with @v0@'s flags.
141--
142-- @since 2.0.1.0
143modifyVerbosity :: (Verbosity -> Verbosity) -> Verbosity -> Verbosity
144modifyVerbosity f v = v { vLevel = vLevel (f v) }
145
146intToVerbosity :: Int -> Maybe Verbosity
147intToVerbosity 0 = Just (mkVerbosity Silent)
148intToVerbosity 1 = Just (mkVerbosity Normal)
149intToVerbosity 2 = Just (mkVerbosity Verbose)
150intToVerbosity 3 = Just (mkVerbosity Deafening)
151intToVerbosity _ = Nothing
152
153-- | Parser verbosity
154--
155-- >>> explicitEitherParsec parsecVerbosity "normal"
156-- Right (Verbosity {vLevel = Normal, vFlags = fromList [], vQuiet = False})
157--
158-- >>> explicitEitherParsec parsecVerbosity "normal+nowrap  "
159-- Right (Verbosity {vLevel = Normal, vFlags = fromList [VNoWrap], vQuiet = False})
160--
161-- >>> explicitEitherParsec parsecVerbosity "normal+nowrap +markoutput"
162-- Right (Verbosity {vLevel = Normal, vFlags = fromList [VNoWrap,VMarkOutput], vQuiet = False})
163--
164-- >>> explicitEitherParsec parsecVerbosity "normal +nowrap +markoutput"
165-- Right (Verbosity {vLevel = Normal, vFlags = fromList [VNoWrap,VMarkOutput], vQuiet = False})
166--
167-- >>> explicitEitherParsec parsecVerbosity "normal+nowrap+markoutput"
168-- Right (Verbosity {vLevel = Normal, vFlags = fromList [VNoWrap,VMarkOutput], vQuiet = False})
169--
170-- >>> explicitEitherParsec parsecVerbosity "deafening+nowrap+stdout+stderr+callsite+callstack"
171-- Right (Verbosity {vLevel = Deafening, vFlags = fromList [VCallStack,VCallSite,VNoWrap,VStderr], vQuiet = False})
172--
173-- /Note:/ this parser will eat trailing spaces.
174--
175instance Parsec Verbosity where
176    parsec = parsecVerbosity
177
178instance Pretty Verbosity where
179    pretty = PP.text . showForCabal
180
181parsecVerbosity :: CabalParsing m => m Verbosity
182parsecVerbosity = parseIntVerbosity <|> parseStringVerbosity
183  where
184    parseIntVerbosity = do
185        i <- P.integral
186        case intToVerbosity i of
187            Just v  -> return v
188            Nothing -> P.unexpected $ "Bad integral verbosity: " ++ show i ++ ". Valid values are 0..3"
189
190    parseStringVerbosity = do
191        level <- parseVerbosityLevel
192        _ <- P.spaces
193        flags <- many (parseFlag <* P.spaces)
194        return $ foldl' (flip ($)) (mkVerbosity level) flags
195
196    parseVerbosityLevel = do
197        token <- P.munch1 isAsciiAlpha
198        case token of
199            "silent"    -> return Silent
200            "normal"    -> return Normal
201            "verbose"   -> return Verbose
202            "debug"     -> return Deafening
203            "deafening" -> return Deafening
204            _           -> P.unexpected $ "Bad verbosity level: " ++ token
205    parseFlag = do
206        _ <- P.char '+'
207        token <- P.munch1 isAsciiAlpha
208        case token of
209            "callsite"   -> return verboseCallSite
210            "callstack"  -> return verboseCallStack
211            "nowrap"     -> return verboseNoWrap
212            "markoutput" -> return verboseMarkOutput
213            "timestamp"  -> return verboseTimestamp
214            "stderr"     -> return verboseStderr
215            "stdout"     -> return verboseNoStderr
216            _            -> P.unexpected $ "Bad verbosity flag: " ++ token
217
218flagToVerbosity :: ReadE Verbosity
219flagToVerbosity = parsecToReadE id parsecVerbosity
220
221showForCabal :: Verbosity -> String
222showForCabal v
223    | Set.null (vFlags v)
224    = maybe (error "unknown verbosity") show $
225        elemIndex v [silent,normal,verbose,deafening]
226    | otherwise
227    = unwords
228        $ showLevel (vLevel v)
229        : concatMap showFlag (Set.toList (vFlags v))
230  where
231    showLevel Silent    = "silent"
232    showLevel Normal    = "normal"
233    showLevel Verbose   = "verbose"
234    showLevel Deafening = "debug"
235
236    showFlag VCallSite   = ["+callsite"]
237    showFlag VCallStack  = ["+callstack"]
238    showFlag VNoWrap     = ["+nowrap"]
239    showFlag VMarkOutput = ["+markoutput"]
240    showFlag VTimestamp  = ["+timestamp"]
241    showFlag VStderr     = ["+stderr"]
242
243showForGHC :: Verbosity -> String
244showForGHC   v = maybe (error "unknown verbosity") show $
245    elemIndex v [silent,normal,__,verbose,deafening]
246        where __ = silent -- this will be always ignored by elemIndex
247
248-- | Turn on verbose call-site printing when we log.
249verboseCallSite :: Verbosity -> Verbosity
250verboseCallSite = verboseFlag VCallSite
251
252-- | Turn on verbose call-stack printing when we log.
253verboseCallStack :: Verbosity -> Verbosity
254verboseCallStack = verboseFlag VCallStack
255
256-- | Turn on @-----BEGIN CABAL OUTPUT-----@ markers for output
257-- from Cabal (as opposed to GHC, or system dependent).
258verboseMarkOutput :: Verbosity -> Verbosity
259verboseMarkOutput = verboseFlag VMarkOutput
260
261-- | Turn off marking; useful for suppressing nondeterministic output.
262verboseUnmarkOutput :: Verbosity -> Verbosity
263verboseUnmarkOutput = verboseNoFlag VMarkOutput
264
265-- | Disable line-wrapping for log messages.
266verboseNoWrap :: Verbosity -> Verbosity
267verboseNoWrap = verboseFlag VNoWrap
268
269-- | Mark the verbosity as quiet
270verboseQuiet :: Verbosity -> Verbosity
271verboseQuiet v = v { vQuiet = True }
272
273-- | Turn on timestamps for log messages.
274verboseTimestamp :: Verbosity -> Verbosity
275verboseTimestamp = verboseFlag VTimestamp
276
277-- | Turn off timestamps for log messages.
278verboseNoTimestamp :: Verbosity -> Verbosity
279verboseNoTimestamp = verboseNoFlag VTimestamp
280
281-- | Turn on timestamps for log messages.
282--
283-- @since 3.4.0.0
284verboseStderr :: Verbosity -> Verbosity
285verboseStderr = verboseFlag VStderr
286
287-- | Turn off timestamps for log messages.
288--
289-- @since 3.4.0.0
290verboseNoStderr :: Verbosity -> Verbosity
291verboseNoStderr = verboseNoFlag VStderr
292
293-- | Helper function for flag enabling functions
294verboseFlag :: VerbosityFlag -> (Verbosity -> Verbosity)
295verboseFlag flag v = v { vFlags = Set.insert flag (vFlags v) }
296
297-- | Helper function for flag disabling functions
298verboseNoFlag :: VerbosityFlag -> (Verbosity -> Verbosity)
299verboseNoFlag flag v = v { vFlags = Set.delete flag (vFlags v) }
300
301-- | Turn off all flags
302verboseNoFlags :: Verbosity -> Verbosity
303verboseNoFlags v = v { vFlags = Set.empty }
304
305verboseHasFlags :: Verbosity -> Bool
306verboseHasFlags = not . Set.null . vFlags
307
308-- | Test if we should output call sites when we log.
309isVerboseCallSite :: Verbosity -> Bool
310isVerboseCallSite = isVerboseFlag VCallSite
311
312-- | Test if we should output call stacks when we log.
313isVerboseCallStack :: Verbosity -> Bool
314isVerboseCallStack = isVerboseFlag VCallStack
315
316-- | Test if we should output markets.
317isVerboseMarkOutput :: Verbosity -> Bool
318isVerboseMarkOutput = isVerboseFlag VMarkOutput
319
320-- | Test if line-wrapping is disabled for log messages.
321isVerboseNoWrap :: Verbosity -> Bool
322isVerboseNoWrap = isVerboseFlag VNoWrap
323
324-- | Test if we had called 'lessVerbose' on the verbosity
325isVerboseQuiet :: Verbosity -> Bool
326isVerboseQuiet = vQuiet
327
328-- | Test if we should output timestamps when we log.
329isVerboseTimestamp :: Verbosity -> Bool
330isVerboseTimestamp = isVerboseFlag VTimestamp
331
332-- | Test if we should output to stderr when we log.
333--
334-- @since 3.4.0.0
335isVerboseStderr :: Verbosity -> Bool
336isVerboseStderr = isVerboseFlag VStderr
337
338-- | Helper function for flag testing functions.
339isVerboseFlag :: VerbosityFlag -> Verbosity -> Bool
340isVerboseFlag flag = (Set.member flag) . vFlags
341
342-- $setup
343-- >>> import Test.QuickCheck (Arbitrary (..), arbitraryBoundedEnum)
344-- >>> instance Arbitrary VerbosityLevel where arbitrary = arbitraryBoundedEnum
345-- >>> instance Arbitrary Verbosity where arbitrary = fmap mkVerbosity arbitrary
346