Fix severity prefix doubling (#689)
This commit is contained in:
parent
bb3333efe3
commit
49b5c4bb2d
@ -76,18 +76,19 @@ gmLog level loc' doc = do
|
||||
|
||||
let loc | loc' == "" = empty
|
||||
| otherwise = text loc' <+>: empty
|
||||
msgDoc = gmLogLevelDoc level <+>: sep [loc, doc]
|
||||
msg = dropWhileEnd isSpace $ gmRenderDoc msgDoc
|
||||
msgDoc = sep [loc, doc]
|
||||
msg = dropWhileEnd isSpace $ gmRenderDoc $ gmLogLevelDoc level <+>: msgDoc
|
||||
|
||||
when (level <= level') $ gmErrStrLn msg
|
||||
gmLogQuiet level loc' doc
|
||||
|
||||
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
|
||||
gmAppendLog :: (MonadIO m, GmLog m, GmOut m) => GhcModLog -> m ()
|
||||
gmAppendLog GhcModLog { gmLogMessages } = (\(level, loc, msgDoc) -> gmLog level loc msgDoc) `mapM_` gmLogMessages
|
||||
gmLogQuiet :: GmLog m => GmLogLevel -> String -> Doc -> m ()
|
||||
gmLogQuiet level loc doc =
|
||||
gmlJournal (GhcModLog Nothing (Last Nothing) [(level, loc, doc)])
|
||||
|
||||
gmAppendLogQuiet :: GmLog m => GhcModLog -> m ()
|
||||
gmAppendLogQuiet GhcModLog { gmLogMessages } =
|
||||
forM_ gmLogMessages $ \(level, loc, doc) -> gmLogQuiet level loc doc
|
||||
|
||||
gmVomit :: (MonadIO m, GmLog m, GmOut m, GmEnv m) => String -> Doc -> String -> m ()
|
||||
gmVomit filename doc content = do
|
||||
|
@ -108,9 +108,9 @@ runGhcModT :: IOish m
|
||||
runGhcModT opt action = liftIO (getCurrentDirectory >>= canonicalizePath) >>= \dir' -> do
|
||||
runGmOutT opt $
|
||||
withGhcModEnv dir' opt $ \(env,lg) ->
|
||||
first (fst <$>) <$> runGhcModT' env defaultGhcModState
|
||||
(gmSetLogLevel (ooptLogLevel $ optOutput opt) >>
|
||||
gmAppendLog lg >>
|
||||
first (fst <$>) <$> runGhcModT' env defaultGhcModState (do
|
||||
gmSetLogLevel (ooptLogLevel $ optOutput opt)
|
||||
gmAppendLogQuiet lg
|
||||
action)
|
||||
|
||||
-- | @hoistGhcModT result@. Embed a GhcModT computation's result into a GhcModT
|
||||
|
Loading…
Reference in New Issue
Block a user