@@ -2,11 +2,6 @@
22
33module Katip.Scribes.Handle
44 ( mkHandleScribe
5− -- * exported for benchmarking
6− , mkHandleScribe'
7− , bbFormat
8− , bbFormatColor
9− , colorFormat
105 ) where
116
127-------------------------------------------------------------------------------
@@ -14,19 +9,14 @@ import Blaze.ByteString.Builder
149import Blaze.ByteString.Builder.Char.Utf8
1510import Control.Lens
1611import Control.Monad
17−import qualified Data.String as S
1812import Data.Aeson.Lens
1913import qualified Data.ByteString.Char8 as B
2014import qualified Data.HashMap.Strict as HM
2115import Data.Monoid
22−import Data.Text.Lazy (pack, fromStrict, fromChunks)
23−import Data.Text.Lazy.Encoding
2416import Data.Time
2517import System.IO
2618import System.IO.Unsafe (unsafePerformIO)
2719import System.Locale
28−
29−import qualified Text.PrettyPrint.Leijen.Text as PP
3020-------------------------------------------------------------------------------
3121import Katip.Core
3222-------------------------------------------------------------------------------
@@ -55,38 +45,17 @@ renderPrim NullPrim = fromByteString "null"
5545
5646-------------------------------------------------------------------------------
5747mkHandleScribe :: Handle -> Severity -> Verbosity -> IO Scribe
58−mkHandleScribe = mkHandleScribe' bbFormat
59−
60−
61−-------------------------------------------------------------------------------
62−mkHandleScribe' :: (forall a. LogContext a => Verbosity -> Item a -> Builder) -> Handle -> Severity -> Verbosity -> IO Scribe
63−mkHandleScribe' fmt h sev verb = do
48+mkHandleScribe h sev verb = do
6449 hSetBuffering h LineBuffering
50+ colorize <- hIsTerminalDevice h
6551 return $ Scribe $ \ i@Item{..} -> do
6652 when (itemSeverity >= sev) $
67− B.hPutStrLn h $ toByteString $ fmt verb i
68−
69−
70−-------------------------------------------------------------------------------
71−bbFormat :: LogContext a => Verbosity -> Item a -> Builder
72−bbFormat verb Item{..} =
73− brackets nowStr <>
74− brackets (mconcat $ map fromText $ intercalateNs itemNamespace) <>
75− brackets (fromText (renderSeverity itemSeverity)) <>
76− brackets (fromString itemHost) <>
77− brackets (fromString (show itemProcess)) <>
78− brackets (fromString (show itemThread)) <>
79− mconcat ks <>
80− maybe mempty (brackets . fromString . locationToString) itemLoc <>
81− fromText " " <> fromText itemMessage
82− where
83− nowStr = fromString $ formatTime defaultTimeLocale "%Y-%m-%d %H:%M:%S" itemTime
84− ks = map brackets $ getKeys verb itemPayload
53+ B.hPutStrLn h $ toByteString $ formatItem colorize verb i
8554
8655
8756-------------------------------------------------------------------------------
88−bbFormatColor :: LogContext a => Verbosity -> Item a -> Builder
89−bbFormatColor verb Item{..} =
57+formatItem :: LogContext a => Bool -> Verbosity -> Item a -> Builder
58+formatItem withColor verb Item{..} =
9059 brackets nowStr <>
9160 brackets (mconcat $ map fromText $ intercalateNs itemNamespace) <>
9261 brackets (fromText (renderSeverity' itemSeverity)) <>
@@ -108,34 +77,9 @@ bbFormatColor verb Item{..} =
10877 _ -> renderSeverity s
10978 red = colorize "31"
11079 yellow = colorize "33"
111− colorize c s = "\ESC["<> c <> "m" <> s <> "\ESC[0m"
112−
113−-------------------------------------------------------------------------------
114−colorFormat :: LogContext a => Verbosity -> Item a -> Builder
115−colorFormat verb Item{..} = disp $
116− PP.brackets (PP.string nowStr) <>
117− PP.brackets (PP.string $ fromChunks $ intercalateNs itemNamespace) <>
118− PP.brackets (PP.string $ fromStrict (renderSeverity' itemSeverity)) <>
119− PP.brackets (PP.string $ pack itemHost) <>
120− PP.brackets (PP.string $ pack (show itemProcess)) <>
121− PP.brackets (PP.string $ pack (show itemThread)) <>
122− mconcat ks <>
123− maybe mempty (PP.brackets . S.fromString . locationToString) itemLoc <>
124− PP.space <> PP.string (fromStrict itemMessage)
125− where
126− disp = fromLazyByteString . encodeUtf8 . PP.displayT . PP.renderCompact
127− nowStr = pack $ formatTime defaultTimeLocale "%Y-%m-%d %H:%M:%S" itemTime
128− ks = map (PP.brackets . PP.string . decodeUtf8 . toLazyByteString) $ getKeys verb itemPayload
129− renderSeverity' s = case s of
130− Emergency -> red $ renderSeverity s
131− Alert -> red $ renderSeverity s
132− Critical -> red $ renderSeverity s
133− Error -> red $ renderSeverity s
134− Warning -> yellow $ renderSeverity s
135− _ -> renderSeverity s
136− red = colorize "31"
137− yellow = colorize "33"
138− colorize c s = "\ESC["<> c <> "m" <> s <> "\ESC[0m"
80+ colorize c s
81+ | withColor = "\ESC["<> c <> "m" <> s <> "\ESC[0m"
82+ | otherwise = s
13983
14084
14185-------------------------------------------------------------------------------
@@ -152,4 +96,3 @@ _ioLogEnv = unsafePerformIO $ do
15296-- | A default IO instance to make prototype development easy. User
15397-- your own 'Monad' for production.
15498instance Katip IO where getLogEnv = return _ioLogEnv
155−