From 710ac6636eb28f3e686903c3d3d84833c14eda09 Mon Sep 17 00:00:00 2001 From: Kazu Yamamoto Date: Tue, 18 Mar 2014 12:38:04 +0900 Subject: [PATCH] cleaning up the logger. --- Language/Haskell/GhcMod/ErrMsg.hs | 30 +++++++++++++++++++++++------- 1 file changed, 23 insertions(+), 7 deletions(-) diff --git a/Language/Haskell/GhcMod/ErrMsg.hs b/Language/Haskell/GhcMod/ErrMsg.hs index 99e1cf7..637e7ed 100644 --- a/Language/Haskell/GhcMod/ErrMsg.hs +++ b/Language/Haskell/GhcMod/ErrMsg.hs @@ -27,18 +27,34 @@ type LogReader = IO [String] ---------------------------------------------------------------- +type Builder = [String] -> [String] + +newtype LogRef = LogRef (IORef Builder) + +newLogRef :: IO LogRef +newLogRef = LogRef <$> newIORef id + +readAndClearLogRef :: LogRef -> IO [String] +readAndClearLogRef (LogRef ref) = do + b <- readIORef ref + writeIORef ref id + return $! b [] + +appendLogRef :: DynFlags -> LineSeparator -> LogRef -> a -> Severity -> SrcSpan -> b -> SDoc -> IO () +appendLogRef df ls (LogRef ref) _ sev src _ msg = do + let !l = ppMsg src sev df ls msg + modifyIORef ref (\b -> b . (l:)) + +---------------------------------------------------------------- + setLogger :: Bool -> DynFlags -> LineSeparator -> IO (DynFlags, LogReader) setLogger False df _ = return (newdf, undefined) where newdf = Gap.setLogAction df $ \_ _ _ _ _ -> return () setLogger True df ls = do - ref <- newIORef [] :: IO (IORef [String]) - let newdf = Gap.setLogAction df $ appendLog ref - return (newdf, reverse <$> readIORef ref) - where - appendLog ref _ sev src _ msg = do - let !l = ppMsg src sev df ls msg - modifyIORef ref (l:) + logref <- newLogRef + let newdf = Gap.setLogAction df $ appendLogRef df ls logref + return (newdf, readAndClearLogRef logref) ----------------------------------------------------------------