Cleanup (e3c860e1) · Commits · Yuanle Song / tinylog

bench/Bench.hs

+14 −14

Original line number	Diff line number	Diff line
		@@ -18,14 +18,14 @@ import qualified Data.ByteString.Lazy as L
		main :: IO ()
		main = defaultMain
		[ bgroup "direct"
		[ bench "msg/8" (whnf (f renderDefault) 8)
		, bench "msg/16" (whnf (f renderDefault) 16)
		, bench "msg/32" (whnf (f renderDefault) 32)
		[ bench "msg/8" (whnf (f $ \s _ _ -> renderDefault s) 8)
		, bench "msg/16" (whnf (f $ \s _ _ -> renderDefault s) 16)
		, bench "msg/32" (whnf (f $ \s _ _ -> renderDefault s) 32)
		]
		, bgroup "netstr"
		[ bench "msg/8" (whnf (f renderNetstr) 8)
		, bench "msg/16" (whnf (f renderNetstr) 16)
		, bench "msg/32" (whnf (f renderNetstr) 32)
		[ bench "msg/8" (whnf (f $ \_ _ _ -> renderNetstr) 8)
		, bench "msg/16" (whnf (f $ \_ _ _ -> renderNetstr) 16)
		, bench "msg/32" (whnf (f $ \_ _ _ -> renderNetstr) 32)
		]
		, bgroup "custom"
		[ bench "msg/8" (whnf (f renderCustom) 8)
		@@ -33,14 +33,14 @@ main = defaultMain
		, bench "msg/32" (whnf (f renderCustom) 32)
		]
		, bgroup "direct"
		[ bench "field/8" (whnf (g renderDefault) 8)
		, bench "field/16" (whnf (g renderDefault) 16)
		, bench "field/32" (whnf (g renderDefault) 32)
		[ bench "field/8" (whnf (g $ \s _ _ -> renderDefault s) 8)
		, bench "field/16" (whnf (g $ \s _ _ -> renderDefault s) 16)
		, bench "field/32" (whnf (g $ \s _ _ -> renderDefault s) 32)
		]
		, bgroup "netstr"
		[ bench "field/8" (whnf (g renderNetstr) 8)
		, bench "field/16" (whnf (g renderNetstr) 16)
		, bench "field/32" (whnf (g renderNetstr) 32)
		[ bench "field/8" (whnf (g $ \_ _ _ -> renderNetstr) 8)
		, bench "field/16" (whnf (g $ \_ _ _ -> renderNetstr) 16)
		, bench "field/32" (whnf (g $ \_ _ _ -> renderNetstr) 32)
		]
		, bgroup "custom"
		[ bench "field/8" (whnf (g renderCustom) 8)
		@@ -51,14 +51,14 @@ main = defaultMain

		f :: Renderer -> Int -> Int64
		f r n = L.length
		. render ", " iso8601UTC Trace r
		. render (r ", " iso8601UTC Trace)
		. foldr1 (.)
		. replicate n
		$ msg (val "hello world" +++ (10000 :: Int) +++ (-42 :: Int64))

		g :: Renderer -> Int -> Int64
		g r n = L.length
		. render ", " iso8601UTC Trace r
		. render (r ", " iso8601UTC Trace)
		. foldr1 (.)
		. replicate n
		$ "key" .= (val "hello world" +++ (10000 :: Int) +++ (-42 :: Int64))

src/System/Logger.hs

+3 −1

Original line number	Diff line number	Diff line
		@@ -26,6 +26,8 @@ module System.Logger
		, setBufSize
		, name
		, setName
		, setRenderer
		, renderer

		-- * Type definitions
		, Logger
		@@ -187,7 +189,7 @@ putMsg g l f = liftIO $ do
		let s = nameMsg $ settings g
		let df = fromMaybe iso8601UTC . format $ settings g
		let ll = logLevel $ settings g
		let m = render x df ll r (d . lmsg l . s . f)
		let m = render (r x df ll) (d . lmsg l . s . f)
		FL.pushLogStr (logger g) (FL.toLogStr m)

		lmsg :: Level -> (Msg -> Msg)

src/System/Logger/Class.hs

+2 −0

Original line number	Diff line number	Diff line
		@@ -21,6 +21,8 @@ module System.Logger.Class
		, L.setBufSize
		, L.name
		, L.setName
		, L.setRenderer
		, L.renderer

		, L.Level (..)
		, L.Output (..)

src/System/Logger/Message.hs

+6 −12

Original line number	Diff line number	Diff line
		@@ -21,7 +21,6 @@ module System.Logger.Message
		, Msg
		, Builder
		, Element (..)
		, Renderer_
		, msg
		, field
		, (.=)
		@@ -132,9 +131,6 @@ len10 !n = if n > 0 then go n 0 else 1 + go (-n) 0
		-- \| Type representing log messages.
		newtype Msg = Msg { elements :: [Element] }

		-- \| See 'Renderer'. 'Renderer_' is just used here to avoid import cycles.
		type Renderer_ dateformat level = ByteString -> dateformat -> level -> [Element] -> B.Builder

		data Element
		= Bytes Builder
		\| Field Builder Builder
		@@ -170,13 +166,11 @@ val = bytes

		-- \| Construct elements, call a renderer, and run the whole builder
		-- into a 'L.ByteString'.
		render :: ByteString
		-> dateformat -> level -> Renderer_ dateformat level
		-> (Msg -> Msg) -> L.ByteString
		render s d l f m = finish . f s d l . elements . m $ empty
		render :: ([Element] -> B.Builder) -> (Msg -> Msg) -> L.ByteString
		render f m = finish . f . elements . m $ empty

		renderDefault :: Renderer_ dateformat level
		renderDefault s _ _ = encAll mempty
		renderDefault :: ByteString -> [Element] -> B.Builder
		renderDefault s = encAll mempty
		where
		encAll !acc [] = acc
		encAll !acc (b:[]) = acc <> encOne b
		@@ -188,8 +182,8 @@ renderDefault s _ _ = encAll mempty
		eq = B.char8 '='
		sep = B.byteString s

		renderNetstr :: Renderer_ dateformat level
		renderNetstr _ _ _ = encAll mempty
		renderNetstr :: [Element] -> B.Builder
		renderNetstr = encAll mempty
		where
		encAll !acc [] = acc
		encAll !acc (b:bb) = encAll (acc <> encOne b) bb

src/System/Logger/Settings.hs

+6 −4

Original line number	Diff line number	Diff line
		@@ -44,6 +44,8 @@ import Data.UnixTime
		import System.Log.FastLogger (defaultBufSize)
		import System.Logger.Message

		import qualified Data.ByteString.Lazy.Builder as B

		data Settings = Settings
		{ _logLevel :: !Level -- ^ messages below this log level will be suppressed
		, _levelMap :: !(Map Text Level) -- ^ log level per named logger
		@@ -85,8 +87,8 @@ setDelimiter x s = s { _delimiter = x }
		-- \| Whether to use <http://cr.yp.to/proto/netstrings.txt netstring>
		-- encoding for log lines.
		setNetStrings :: Bool -> Settings -> Settings
		setNetStrings True = setRenderer renderNetstr
		setNetStrings False = setRenderer renderDefault
		setNetStrings True = setRenderer $ \_ _ _ -> renderNetstr
		setNetStrings False = setRenderer $ \s _ _ -> renderDefault s

		logLevel :: Settings -> Level
		logLevel = _logLevel
		@@ -153,7 +155,7 @@ instance IsString DateFormat where
		iso8601UTC :: DateFormat
		iso8601UTC = "%Y-%0m-%0dT%0H:%0M:%0SZ"

		type Renderer = Renderer_ DateFormat Level
		type Renderer = ByteString -> DateFormat -> Level -> [Element] -> B.Builder

		-- \| Default settings:
		--
		@@ -181,4 +183,4 @@ defSettings = Settings
		defaultBufSize
		Nothing
		id
		renderDefault
		(\s _ _ -> renderDefault s)