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 module Semantic.Log where
import Control.Monad.IO.Class
import Data.Error (withSGRCode) import Data.Error (withSGRCode)
import Data.List (intersperse) import Data.List (intersperse)
import qualified Data.Time.Clock.POSIX as Time (getCurrentTime) import qualified Data.Time.Clock.POSIX as Time (getCurrentTime)
@ -27,14 +28,14 @@ data Level
-- | Queue a message to be logged. -- | 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 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 () | otherwise = pure ()
-- | Log a message to stderr. -- | Log a message to stderr.
logMessage :: Options -> Message -> IO () logMessage :: MonadIO io => Options -> Message -> io ()
logMessage options@Options{..} = hPutStr stderr . optionsFormatter options logMessage options@Options{..} = liftIO . hPutStr stderr . optionsFormatter options
-- | Format log messaging using "logfmt". -- | Format log messaging using "logfmt".
-- --
@ -102,8 +103,8 @@ defaultOptions = Options
, optionsProcessID = 0 , optionsProcessID = 0
} }
configureOptionsForHandle :: Handle -> Options -> IO Options configureOptionsForHandle :: MonadIO io => Handle -> Options -> io Options
configureOptionsForHandle handle options = do configureOptionsForHandle handle options = liftIO $ do
pid <- getProcessID pid <- getProcessID
isTerminal <- hIsTerminalDevice handle isTerminal <- hIsTerminalDevice handle
pure $ options pure $ options