{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
module Preamble.Trace
( newStderrLogger
, newStdoutLogger
, nullLogger
, traceDebug
, traceInfo
, traceWarn
, traceError
, (.=)
) where
import Control.Monad.Logger
import Data.Aeson
#if MIN_VERSION_aeson(1,0,2)
import Data.Aeson.Text
#else
import Data.Aeson.Encode
#endif
import qualified Data.HashMap.Strict as M
import Data.Text hiding (singleton)
import qualified Data.Text.Lazy as LT
import Data.Text.Lazy.Builder
import Data.Time
import Preamble.Prelude hiding (null)
import Preamble.Types
import System.Log.FastLogger
logger :: LogLevel -> LoggerSet -> Logger
logger level ls _loc _source level' s =
unless (level' < level) $ do
pushLogStr ls s
flushLogStr ls
newStderrLogger :: MonadIO m => LogLevel -> m Logger
newStderrLogger level = liftIO $ logger level <$> newStderrLoggerSet defaultBufSize
newStdoutLogger :: MonadIO m => LogLevel -> m Logger
newStdoutLogger level = liftIO $ logger level <$> newStdoutLoggerSet defaultBufSize
nullLogger :: Logger
nullLogger _loc _source _level _s = pure ()
trace :: MonadCtx c m => (Text -> m ()) -> Text -> Pairs -> m ()
trace logN e ps = do
p <- view cPreamble
t <- liftIO getCurrentTime
let preamble = bool [ "event" .= e, "time" .= t ] [ "time" .= t ] $ null e
logN $ LT.toStrict $ toLazyText $ (<> singleton '\n') $
encodeToTextBuilder $ Object $ M.fromList $ preamble <> p <> ps
traceDebug :: MonadCtx c m => Text -> Pairs -> m ()
traceDebug = trace logDebugN
traceInfo :: MonadCtx c m => Text -> Pairs -> m ()
traceInfo = trace logInfoN
traceWarn :: MonadCtx c m => Text -> Pairs -> m ()
traceWarn = trace logWarnN
traceError :: MonadCtx c m => Text -> Pairs -> m ()
traceError = trace logErrorN