cleaning up the logger.

This commit is contained in:
Kazu Yamamoto 2014-03-18 12:38:04 +09:00
parent dd7b7b8305
commit 710ac6636e
1 changed files with 23 additions and 7 deletions

View File

@ -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)
----------------------------------------------------------------