Unverified Commit 6b71c4bc authored by fisx's avatar fisx

More general Renderer type.

parent a99e5a9f
......@@ -10,8 +10,7 @@ module Main (main) where
import Criterion
import Criterion.Main
import Data.Int
import Data.Monoid
import System.Logger.Message
import System.Logger
import qualified Data.ByteString.Builder as B
import qualified Data.ByteString.Lazy as L
......@@ -52,21 +51,21 @@ main = defaultMain
f :: Renderer -> Int -> Int64
f r n = L.length
. render ", " r
. render ", " iso8601UTC Trace r
. foldr1 (.)
. replicate n
$ msg (val "hello world" +++ (10000 :: Int) +++ (-42 :: Int64))
g :: Renderer -> Int -> Int64
g r n = L.length
. render ", " r
. render ", " iso8601UTC Trace r
. foldr1 (.)
. replicate n
$ "key" .= (val "hello world" +++ (10000 :: Int) +++ (-42 :: Int64))
renderCustom :: Renderer
renderCustom s = encAll mempty
renderCustom s _ _ = encAll mempty
where
encAll !acc [] = acc
encAll !acc (b:[]) = acc <> encOne b
......
......@@ -32,6 +32,7 @@ module System.Logger
, Level (..)
, Output (..)
, DateFormat (..)
, Renderer
, iso8601UTC
-- * Core API
......@@ -184,7 +185,9 @@ putMsg g l f = liftIO $ do
let r = renderer $ settings g
let x = delimiter $ settings g
let s = nameMsg $ settings g
let m = render x r (d . lmsg l . s . f)
let df = fromMaybe iso8601UTC . format $ settings g
let ll = logLevel $ settings g
let m = render x df ll r (d . lmsg l . s . f)
FL.pushLogStr (logger g) (FL.toLogStr m)
lmsg :: Level -> (Msg -> Msg)
......
......@@ -21,7 +21,7 @@ module System.Logger.Message
, Msg
, Builder
, Element (..)
, Renderer
, Renderer_
, msg
, field
, (.=)
......@@ -132,7 +132,8 @@ len10 !n = if n > 0 then go n 0 else 1 + go (-n) 0
-- | Type representing log messages.
newtype Msg = Msg { elements :: [Element] }
type Renderer = ByteString -> [Element] -> B.Builder
-- | 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
......@@ -167,13 +168,15 @@ infixr 6 +++
val :: ByteString -> Builder
val = bytes
-- | Intersperse parts of the log message with the given delimiter and
-- render the whole builder into a 'L.ByteString'.
render :: ByteString -> Renderer -> (Msg -> Msg) -> L.ByteString
render s f m = finish . f s . elements . m $ empty
-- | 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
renderDefault :: Renderer
renderDefault s = encAll mempty
renderDefault :: Renderer_ dateformat level
renderDefault s _ _ = encAll mempty
where
encAll !acc [] = acc
encAll !acc (b:[]) = acc <> encOne b
......@@ -185,8 +188,8 @@ renderDefault s = encAll mempty
eq = B.char8 '='
sep = B.byteString s
renderNetstr :: Renderer
renderNetstr _ = encAll mempty
renderNetstr :: Renderer_ dateformat level
renderNetstr _ _ _ = encAll mempty
where
encAll !acc [] = acc
encAll !acc (b:bb) = encAll (acc <> encOne b) bb
......
......@@ -9,6 +9,7 @@ module System.Logger.Settings
, Level (..)
, Output (..)
, DateFormat (..)
, Renderer
, defSettings
, output
......@@ -43,8 +44,6 @@ import Data.UnixTime
import System.Log.FastLogger (defaultBufSize)
import System.Logger.Message
import qualified Data.ByteString.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
......@@ -54,7 +53,7 @@ data Settings = Settings
, _bufSize :: !Int -- ^ how many bytes to buffer before commiting to sink
, _name :: !(Maybe Text) -- ^ logger name
, _nameMsg :: !(Msg -> Msg)
, _renderer :: !(ByteString -> [Element] -> B.Builder)
, _renderer :: !Renderer
}
output :: Settings -> Output
......@@ -122,10 +121,10 @@ nameMsg :: Settings -> (Msg -> Msg)
nameMsg = _nameMsg
-- | Output format
renderer :: Settings -> (ByteString -> [Element] -> B.Builder)
renderer :: Settings -> Renderer
renderer = _renderer
setRenderer :: (ByteString -> [Element] -> B.Builder) -> Settings -> Settings
setRenderer :: Renderer -> Settings -> Settings
setRenderer f s = s { _renderer = f }
data Level
......@@ -154,6 +153,8 @@ instance IsString DateFormat where
iso8601UTC :: DateFormat
iso8601UTC = "%Y-%0m-%0dT%0H:%0M:%0SZ"
type Renderer = Renderer_ DateFormat Level
-- | Default settings:
--
-- * 'logLevel' = 'Debug'
......
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