git.iko.soy/typeable/katip
on master help sign in
Use the simple color formatter
2a6b6edMichael Xavier
bench/Main.hs+5−18
compare with master
unifiedsplit
@@ -1,5 +1,4 @@
1{-# LANGUAGE OverloadedStrings #-}
1{-# LANGUAGE OverloadedStrings #-}
2−{-# LANGUAGE RankNTypes #-}
3module Main
2module Main
4 ( main
3 ( main
5 ) where
4 ) where
@@ -29,22 +28,10 @@ main = benchmark $
29
28
30-------------------------------------------------------------------------------
29-------------------------------------------------------------------------------
31handleScribeBench :: Benchmark ()
30handleScribeBench :: Benchmark ()
32−handleScribeBench = standoff "Katip.Scribes.Handle" $ do
31+handleScribeBench = standoff "Katip.Scribes.Handle" $
33 subject "Bytestring Builder" $ do
32 subject "Bytestring Builder" $ do
34 pause
33 pause
35− (Scribe push) <- liftIO $ setup bbFormat
34+ (Scribe push) <- liftIO setup
36− tid <- liftIO myThreadId
37− continue
38− whnfIO $ push $ exItem tid
39− subject "Bytestring Builder + Colored" $ do
40− pause
41− (Scribe push) <- liftIO $ setup bbFormatColor
42− tid <- liftIO myThreadId
43− continue
44− whnfIO $ push $ exItem tid
45− subject "WL + Colored" $ do
46− pause
47− (Scribe push) <- liftIO $ setup colorFormat
48 tid <- liftIO myThreadId
35 tid <- liftIO myThreadId
49 continue
36 continue
50 whnfIO $ push $ exItem tid
37 whnfIO $ push $ exItem tid
@@ -86,7 +73,7 @@ mkUTCTime y mt d h mn s = UTCTime day dt
86
73
87
74
88-------------------------------------------------------------------------------
75-------------------------------------------------------------------------------
89−setup :: (forall a. LogContext a => Verbosity -> Item a -> Builder) -> IO Scribe
76+setup :: IO Scribe
90−setup format = do
77+setup = do
91 h <- openFile "/dev/null" WriteMode
78 h <- openFile "/dev/null" WriteMode
92− mkHandleScribe' format h Debug V0
79+ mkHandleScribe h Debug V0
katip.cabal−1
@@ -31,7 +31,6 @@ library
31 build-depends:
31 build-depends:
32 base >=4.6 && <4.7
32 base >=4.6 && <4.7
33 , aeson >=0.7 && <0.8
33 , aeson >=0.7 && <0.8
34− , wl-pprint-text >= 1.1.0.3 && < 1.2
35 , auto-update >= 0.1 && < 0.2
34 , auto-update >= 0.1 && < 0.2
36 , blaze-builder >= 0.3 && < 0.4
35 , blaze-builder >= 0.3 && < 0.4
37 , bytestring >= 0.9 && < 0.11
36 , bytestring >= 0.9 && < 0.11
src/Katip/Scribes/Handle.hs+8−65
@@ -2,11 +2,6 @@
2
2
3module Katip.Scribes.Handle
3module Katip.Scribes.Handle
4 ( mkHandleScribe
4 ( mkHandleScribe
5− -- * exported for benchmarking
6− , mkHandleScribe'
7− , bbFormat
8− , bbFormatColor
9− , colorFormat
10 ) where
5 ) where
11
6
12-------------------------------------------------------------------------------
7-------------------------------------------------------------------------------
@@ -14,19 +9,14 @@ import Blaze.ByteString.Builder
14import Blaze.ByteString.Builder.Char.Utf8
9import Blaze.ByteString.Builder.Char.Utf8
15import Control.Lens
10import Control.Lens
16import Control.Monad
11import Control.Monad
17−import qualified Data.String as S
18import Data.Aeson.Lens
12import Data.Aeson.Lens
19import qualified Data.ByteString.Char8 as B
13import qualified Data.ByteString.Char8 as B
20import qualified Data.HashMap.Strict as HM
14import qualified Data.HashMap.Strict as HM
21import Data.Monoid
15import Data.Monoid
22−import Data.Text.Lazy (pack, fromStrict, fromChunks)
23−import Data.Text.Lazy.Encoding
24import Data.Time
16import Data.Time
25import System.IO
17import System.IO
26import System.IO.Unsafe (unsafePerformIO)
18import System.IO.Unsafe (unsafePerformIO)
27import System.Locale
19import System.Locale
28−
29−import qualified Text.PrettyPrint.Leijen.Text as PP
30-------------------------------------------------------------------------------
20-------------------------------------------------------------------------------
31import Katip.Core
21import Katip.Core
32-------------------------------------------------------------------------------
22-------------------------------------------------------------------------------
@@ -55,38 +45,17 @@ renderPrim NullPrim = fromByteString "null"
55
45
56-------------------------------------------------------------------------------
46-------------------------------------------------------------------------------
57mkHandleScribe :: Handle -> Severity -> Verbosity -> IO Scribe
47mkHandleScribe :: Handle -> Severity -> Verbosity -> IO Scribe
58−mkHandleScribe = mkHandleScribe' bbFormat
48+mkHandleScribe h sev verb = do
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
64 hSetBuffering h LineBuffering
49 hSetBuffering h LineBuffering
50+ colorize <- hIsTerminalDevice h
65 return $ Scribe $ \ i@Item{..} -> do
51 return $ Scribe $ \ i@Item{..} -> do
66 when (itemSeverity >= sev) $
52 when (itemSeverity >= sev) $
67− B.hPutStrLn h $ toByteString $ fmt verb i
53+ B.hPutStrLn h $ toByteString $ formatItem colorize 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
85
54
86
55
87-------------------------------------------------------------------------------
56-------------------------------------------------------------------------------
88−bbFormatColor :: LogContext a => Verbosity -> Item a -> Builder
57+formatItem :: LogContext a => Bool -> Verbosity -> Item a -> Builder
89−bbFormatColor verb Item{..} =
58+formatItem withColor verb Item{..} =
90 brackets nowStr <>
59 brackets nowStr <>
91 brackets (mconcat $ map fromText $ intercalateNs itemNamespace) <>
60 brackets (mconcat $ map fromText $ intercalateNs itemNamespace) <>
92 brackets (fromText (renderSeverity' itemSeverity)) <>
61 brackets (fromText (renderSeverity' itemSeverity)) <>
@@ -108,34 +77,9 @@ bbFormatColor verb Item{..} =
108 _ -> renderSeverity s
77 _ -> renderSeverity s
109 red = colorize "31"
78 red = colorize "31"
110 yellow = colorize "33"
79 yellow = colorize "33"
111− colorize c s = "\ESC["<> c <> "m" <> s <> "\ESC[0m"
80+ colorize c s
112−
81+ | withColor = "\ESC["<> c <> "m" <> s <> "\ESC[0m"
113−-------------------------------------------------------------------------------
82+ | otherwise = s
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"
139
83
140
84
141-------------------------------------------------------------------------------
85-------------------------------------------------------------------------------
@@ -152,4 +96,3 @@ _ioLogEnv = unsafePerformIO $ do
152-- | A default IO instance to make prototype development easy. User
96-- | A default IO instance to make prototype development easy. User
153-- your own 'Monad' for production.
97-- your own 'Monad' for production.
154instance Katip IO where getLogEnv = return _ioLogEnv
98instance Katip IO where getLogEnv = return _ioLogEnv
155−