Verbosity.hs 6.12 KB
Newer Older
ttuegel's avatar
ttuegel committed
1 2
{-# LANGUAGE DeriveGeneric #-}

3 4 5 6
-----------------------------------------------------------------------------
-- |
-- Module      :  Distribution.Verbosity
-- Copyright   :  Ian Lynagh 2007
7
-- License     :  BSD3
8
--
Duncan Coutts's avatar
Duncan Coutts committed
9
-- Maintainer  :  cabal-devel@haskell.org
10 11
-- Portability :  portable
--
12 13 14 15 16 17 18 19 20 21 22
-- 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.
Duncan Coutts's avatar
Duncan Coutts committed
23

24
-- Verbosity for Cabal functions.
25 26 27 28 29

module Distribution.Verbosity (
  -- * Verbosity
  Verbosity,
  silent, normal, verbose, deafening,
30
  moreVerbose, lessVerbose,
mnislaih's avatar
mnislaih committed
31
  intToVerbosity, flagToVerbosity,
32 33 34 35 36
  showForCabal, showForGHC,

  -- * Call stacks
  verboseCallSite, verboseCallStack,
  isVerboseCallSite, isVerboseCallStack,
37 38 39

  -- * line-wrapping
  verboseNoWrap, isVerboseNoWrap,
40 41
 ) where

42 43 44
import Prelude ()
import Distribution.Compat.Prelude

45
import Distribution.ReadE
46
import Distribution.Compat.ReadP
47 48

import Data.List (elemIndex)
49 50
import Data.Set (Set)
import qualified Data.Set as Set
mnislaih's avatar
mnislaih committed
51

52 53
data Verbosity = Verbosity {
    vLevel :: VerbosityLevel,
54
    vFlags :: Set VerbosityFlag
55 56 57
  } deriving (Generic)

mkVerbosity :: VerbosityLevel -> Verbosity
58
mkVerbosity l = Verbosity { vLevel = l, vFlags = Set.empty }
59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78

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
ttuegel's avatar
ttuegel committed
79 80

instance Binary Verbosity
81

82 83 84 85 86
data VerbosityLevel = Silent | Normal | Verbose | Deafening
    deriving (Generic, Show, Read, Eq, Ord, Enum, Bounded)

instance Binary VerbosityLevel

87
-- We shouldn't print /anything/ unless an error occurs in silent mode
88
silent :: Verbosity
89
silent = mkVerbosity Silent
90

91
-- Print stuff we want to see by default
92
normal :: Verbosity
93
normal = mkVerbosity Normal
94

95
-- Be more verbose about what's going on
96
verbose :: Verbosity
97
verbose = mkVerbosity Verbose
98

99 100
-- Not only are we verbose ourselves (perhaps even noisier than when
-- being "verbose"), but we tell everything we run to be verbose too
101
deafening :: Verbosity
102
deafening = mkVerbosity Deafening
103

104
moreVerbose :: Verbosity -> Verbosity
105 106 107 108 109 110
moreVerbose v =
    case vLevel v of
        Silent    -> v -- silent should stay silent
        Normal    -> v { vLevel = Verbose }
        Verbose   -> v { vLevel = Deafening }
        Deafening -> v
111 112

lessVerbose :: Verbosity -> Verbosity
113 114 115 116 117 118
lessVerbose v =
    case vLevel v of
        Deafening -> v -- deafening stays deafening
        Verbose   -> v { vLevel = Normal }
        Normal    -> v { vLevel = Silent }
        Silent    -> v
119

120
intToVerbosity :: Int -> Maybe Verbosity
121 122 123 124
intToVerbosity 0 = Just (mkVerbosity Silent)
intToVerbosity 1 = Just (mkVerbosity Normal)
intToVerbosity 2 = Just (mkVerbosity Verbose)
intToVerbosity 3 = Just (mkVerbosity Deafening)
125 126
intToVerbosity _ = Nothing

127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145
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
146
        , string "nowrap"    >> return verboseNoWrap
147 148
        ]

149 150
flagToVerbosity :: ReadE Verbosity
flagToVerbosity = ReadE $ \s ->
151 152
   case readP_to_S (parseVerbosity >>= \r -> eof >> return r) s of
       [(Left i, "")] ->
153
           case intToVerbosity i of
154 155 156
               Just v -> Right v
               Nothing -> Left ("Bad verbosity: " ++ show i ++
                                     ". Valid values are 0..3")
157
       [(Right v, "")] -> Right v
158
       _ -> Left ("Can't parse verbosity " ++ s)
159

mnislaih's avatar
mnislaih committed
160
showForCabal, showForGHC :: Verbosity -> String
161

Ross Paterson's avatar
Ross Paterson committed
162 163 164
showForCabal v = maybe (error "unknown verbosity") show $
    elemIndex v [silent,normal,verbose,deafening]
showForGHC   v = maybe (error "unknown verbosity") show $
165 166
    elemIndex v [silent,normal,__,verbose,deafening]
        where __ = silent -- this will be always ignored by elemIndex
167

168 169 170
data VerbosityFlag
    = VCallStack
    | VCallSite
171
    | VNoWrap
172 173
    deriving (Generic, Show, Read, Eq, Ord, Enum, Bounded)

174
instance Binary VerbosityFlag
175

176
-- | Turn on verbose call-site printing when we log.
177
verboseCallSite :: Verbosity -> Verbosity
178
verboseCallSite v = v { vFlags = Set.insert VCallSite (vFlags v) }
179

180
-- | Turn on verbose call-stack printing when we log.
181
verboseCallStack :: Verbosity -> Verbosity
182
verboseCallStack v = v { vFlags = Set.insert VCallStack (vFlags v) }
183 184 185

-- | Test if we should output call sites when we log.
isVerboseCallSite :: Verbosity -> Bool
186
isVerboseCallSite = (Set.member VCallSite) . vFlags
187 188 189

-- | Test if we should output call stacks when we log.
isVerboseCallStack :: Verbosity -> Bool
190
isVerboseCallStack = (Set.member VCallStack) . vFlags
191 192 193 194 195 196 197 198

-- | Disable line-wrapping for log messages.
verboseNoWrap :: Verbosity -> Verbosity
verboseNoWrap v = v { vFlags = Set.insert VNoWrap (vFlags v) }

-- | Test if line-wrapping is disabled for log messages.
isVerboseNoWrap :: Verbosity -> Bool
isVerboseNoWrap = (Set.member VNoWrap) . vFlags