github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-22 14:21:31 +03:00
Code Issues Projects Releases Wiki Activity

Generalize Semantic.Log to MonadIO.

Browse Source
This commit is contained in:
Rob Rix 2018-04-03 14:11:30 -04:00
parent a63efe7c78
commit 0ce1bdcaeb
1 changed files with 7 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
src/Semantic/Log.hs
View File

@ -1,5 +1,6 @@
module Semantic.Log where
import Control.Monad.IO.Class
import Data.Error (withSGRCode)
import Data.List (intersperse)
import qualified Data.Time.Clock.POSIX as Time (getCurrentTime)
@ -27,14 +28,14 @@ data Level
-- | Queue a message to be logged.
queueLogMessage :: AsyncQueue Message Options -> Level -> String -> [(String, String)] -> IO ()
queueLogMessage :: MonadIO io => AsyncQueue Message Options -> Level -> String -> [(String, String)] -> io ()
queueLogMessage q@AsyncQueue{..} level message pairs
| Just logLevel <- optionsLevel asyncQueueExtra, level <= logLevel = Time.getCurrentTime >>= LocalTime.utcToLocalZonedTime >>= queue q . Message level message pairs
| Just logLevel <- optionsLevel asyncQueueExtra, level <= logLevel = liftIO Time.getCurrentTime >>= liftIO . LocalTime.utcToLocalZonedTime >>= liftIO . queue q . Message level message pairs
| otherwise = pure ()
-- | Log a message to stderr.
logMessage :: Options -> Message -> IO ()
logMessage options@Options{..} = hPutStr stderr . optionsFormatter options
logMessage :: MonadIO io => Options -> Message -> io ()
logMessage options@Options{..} = liftIO . hPutStr stderr . optionsFormatter options
-- | Format log messaging using "logfmt".
--
@ -102,8 +103,8 @@ defaultOptions = Options
, optionsProcessID = 0
}
configureOptionsForHandle :: Handle -> Options -> IO Options
configureOptionsForHandle handle options = do
configureOptionsForHandle :: MonadIO io => Handle -> Options -> io Options
configureOptionsForHandle handle options = liftIO $ do
pid <- getProcessID
isTerminal <- hIsTerminalDevice handle
pure $ options