Unverified Commit e3c860e1 authored by Toralf Wittner's avatar Toralf Wittner Committed by fisx

Cleanup

parent 6b71c4bc
......@@ -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))
......
......@@ -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)
......
......@@ -21,6 +21,8 @@ module System.Logger.Class
, L.setBufSize
, L.name
, L.setName
, L.setRenderer
, L.renderer
, L.Level (..)
, L.Output (..)
......
......@@ -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
......
......@@ -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)
resolver: nightly-2018-03-24
resolver: lts-12.10
packages:
- .
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment