hasufell/ghc-mod
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Fix severity prefix doubling (#689)

Browse Source
This commit is contained in:
Daniel Gröber 2016-01-09 23:22:27 +01:00
parent bb3333efe3
commit 49b5c4bb2d
2 changed files with 15 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
Language/Haskell/GhcMod/Logging.hs
View File

@ -45,11 +45,11 @@ gmSetLogLevel :: GmLog m => GmLogLevel -> m ()
gmSetLogLevel level = gmSetLogLevel level =
gmlJournal $ GhcModLog (Just level) (Last Nothing) [] gmlJournal $ GhcModLog (Just level) (Last Nothing) []
gmGetLogLevel :: forall m. GmLog m => m GmLogLevel gmGetLogLevel :: forall m. GmLog m => m GmLogLevel
gmGetLogLevel = do gmGetLogLevel = do
GhcModLog { gmLogLevel = Just level } <- gmlHistory GhcModLog { gmLogLevel = Just level } <- gmlHistory
return level return level
gmSetDumpLevel :: GmLog m => Bool -> m () gmSetDumpLevel :: GmLog m => Bool -> m ()
gmSetDumpLevel level = gmSetDumpLevel level =
gmlJournal $ GhcModLog Nothing (Last (Just level)) [] gmlJournal $ GhcModLog Nothing (Last (Just level)) []
@ -76,18 +76,19 @@ gmLog level loc' doc = do
let loc | loc' == "" = empty let loc | loc' == "" = empty
| otherwise = text loc' <+>: empty | otherwise = text loc' <+>: empty
msgDoc = gmLogLevelDoc level <+>: sep [loc, doc] msgDoc = sep [loc, doc]
msg = dropWhileEnd isSpace $ gmRenderDoc msgDoc msg = dropWhileEnd isSpace $ gmRenderDoc $ gmLogLevelDoc level <+>: msgDoc
when (level <= level') $ gmErrStrLn msg when (level <= level') $ gmErrStrLn msg
gmLogQuiet level loc' doc
gmlJournal (GhcModLog Nothing (Last Nothing) [(level, loc', msgDoc)]) gmLogQuiet :: GmLog m => GmLogLevel -> String -> Doc -> m ()
gmLogQuiet level loc doc =
gmlJournal (GhcModLog Nothing (Last Nothing) [(level, loc, doc)])
-- | Appends a collection of logs to the logging environment, with effects gmAppendLogQuiet :: GmLog m => GhcModLog -> m ()
-- | if their log level specifies it should gmAppendLogQuiet GhcModLog { gmLogMessages } =
gmAppendLog :: (MonadIO m, GmLog m, GmOut m) => GhcModLog -> m () forM_ gmLogMessages $ \(level, loc, doc) -> gmLogQuiet level loc doc
gmAppendLog GhcModLog { gmLogMessages } = (\(level, loc, msgDoc) -> gmLog level loc msgDoc) `mapM_` gmLogMessages
gmVomit :: (MonadIO m, GmLog m, GmOut m, GmEnv m) => String -> Doc -> String -> m () gmVomit :: (MonadIO m, GmLog m, GmOut m, GmEnv m) => String -> Doc -> String -> m ()
gmVomit filename doc content = do gmVomit filename doc content = do

8
Language/Haskell/GhcMod/Monad.hs
View File

@ -108,10 +108,10 @@ runGhcModT :: IOish m
runGhcModT opt action = liftIO (getCurrentDirectory >>= canonicalizePath) >>= \dir' -> do runGhcModT opt action = liftIO (getCurrentDirectory >>= canonicalizePath) >>= \dir' -> do
runGmOutT opt $ runGmOutT opt $
withGhcModEnv dir' opt $ \(env,lg) -> withGhcModEnv dir' opt $ \(env,lg) ->
first (fst <$>) <$> runGhcModT' env defaultGhcModState first (fst <$>) <$> runGhcModT' env defaultGhcModState (do
(gmSetLogLevel (ooptLogLevel $ optOutput opt) >> gmSetLogLevel (ooptLogLevel $ optOutput opt)
gmAppendLog lg >> gmAppendLogQuiet lg
action) action)
-- | @hoistGhcModT result@. Embed a GhcModT computation's result into a GhcModT -- | @hoistGhcModT result@. Embed a GhcModT computation's result into a GhcModT
-- computation. Note that if the computation that returned @result@ modified the -- computation. Note that if the computation that returned @result@ modified the