handling logging level
This commit is contained in:
parent
06323ac20f
commit
d0ea69b61b
@ -94,7 +94,7 @@ stackCradle wdir = do
|
||||
-- If dist/setup-config already exists the user probably wants to use cabal
|
||||
-- rather than stack, or maybe that's just me ;)
|
||||
whenM (liftIO $ doesFileExist $ setupConfigPath "dist") $ do
|
||||
gmLog GmDebug "" $ (text
|
||||
gmLog GmWarning "" $ (text
|
||||
"'dist/setup-config' exists, ignoring Stack and using cabal-install instead.")
|
||||
mzero
|
||||
|
||||
|
@ -78,6 +78,17 @@ gmLog level loc' doc = do
|
||||
|
||||
gmlJournal (GhcModLog Nothing (Last Nothing) [(level, loc', msgDoc)])
|
||||
|
||||
-- | Appends a collection of logs to the logging environment, with effects
|
||||
-- | if their log level specifies it should
|
||||
gmLog' :: (MonadIO m, GmLog m, GmOut m) => GhcModLog -> m ()
|
||||
gmLog' newLog@ GhcModLog { gmLogMessages } = do
|
||||
GhcModLog { gmLogLevel = Just level' } <- gmlHistory
|
||||
mapM_ (\(level, _, msgDoc) -> when (level <= level') $ gmErrStrLn (docToString msgDoc)) gmLogMessages
|
||||
-- instance Monoid GhcModLog takes the second debug level for some reason, so we need to force this to nothing
|
||||
gmlJournal (GhcModLog Nothing (Last Nothing) gmLogMessages)
|
||||
where
|
||||
docToString msgDoc = dropWhileEnd isSpace $ gmRenderDoc msgDoc
|
||||
|
||||
gmVomit :: (MonadIO m, GmLog m, GmOut m, GmEnv m) => String -> Doc -> String -> m ()
|
||||
gmVomit filename doc content = do
|
||||
gmLog GmVomit "" $ doc <+>: text content
|
||||
|
@ -99,8 +99,8 @@ runGhcModT opt action = liftIO (getCurrentDirectory >>= canonicalizePath) >>= \d
|
||||
runGmOutT opt $
|
||||
withGhcModEnv dir' opt $ \(env,lg) ->
|
||||
first (fst <$>) <$> runGhcModT' env defaultGhcModState
|
||||
( gmlJournal lg >>
|
||||
gmSetLogLevel (ooptLogLevel $ optOutput opt) >>
|
||||
(gmSetLogLevel (ooptLogLevel $ optOutput opt) >>
|
||||
gmLog' lg >>
|
||||
action)
|
||||
|
||||
-- | @hoistGhcModT result@. Embed a GhcModT computation's result into a GhcModT
|
||||
|
Loading…
Reference in New Issue
Block a user