Unverified Commit 9bffbfe3 authored by Matthias Fischmann's avatar Matthias Fischmann
Browse files

Let renderers have type `Renderer`.

parent 8285e26f

bench/Bench.hs

+12 −12
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 $ \s _ _ -> renderDefault s) 8)

        , bench "msg/16" (whnf (f $ \s _ _ -> renderDefault s) 16)

        , bench "msg/32" (whnf (f $ \s _ _ -> renderDefault s) 32)

        [ bench "msg/8"  (whnf (f renderDefault) 8)

        , bench "msg/16" (whnf (f renderDefault) 16)

        , bench "msg/32" (whnf (f renderDefault) 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 $ \s _ _ -> renderDefault s) 8)

        , bench "field/16" (whnf (g $ \s _ _ -> renderDefault s) 16)

        , bench "field/32" (whnf (g $ \s _ _ -> renderDefault s) 32)

        [ bench "field/8"  (whnf (g renderDefault) 8)

        , bench "field/16" (whnf (g renderDefault) 16)

        , bench "field/32" (whnf (g renderDefault) 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)

src/System/Logger.hs

+4 −2
Original line number Diff line number Diff line
@@ -22,8 +22,10 @@ module System.Logger 
    , delimiter

    , setDelimiter

    , setNetStrings

    , setRendererNetstr

    , setRendererDefault

    , setRendererNetstr

    , renderDefault

    , renderNetstr

    , bufSize

    , setBufSize

    , name
@@ -67,7 +69,7 @@ import Data.Maybe (fromMaybe) 
import Data.Text (Text)

import Data.UnixTime

import System.Environment (lookupEnv)

import System.Logger.Message as M

import System.Logger.Message as M hiding (renderDefault_, renderNetstr_)

import System.Logger.Settings

import Prelude hiding (log)

src/System/Logger/Message.hs

+8 −10
Original line number Diff line number Diff line
@@ -31,8 +31,8 @@ module System.Logger.Message 
    , builderSize

    , builderBytes

    , render

    , renderDefault

    , renderNetstr

    , renderDefault_

    , renderNetstr_

    ) where



#if MIN_VERSION_base(4,9,0)
@@ -169,10 +169,9 @@ val = bytes 
render :: ([Element] -> B.Builder) -> (Msg -> Msg) -> L.ByteString

render f m = finish . f . elements . m $ empty



-- | Simple 'Renderer' with '=' between field names and values and a custom

-- separator.

renderDefault :: ByteString -> [Element] -> B.Builder

renderDefault s = encAll mempty

-- | See 'renderDefault'.

renderDefault_ :: ByteString -> [Element] -> B.Builder

renderDefault_ s = encAll mempty

  where

    encAll !acc    []  = acc

    encAll !acc (b:[]) = acc <> encOne b
@@ -184,10 +183,9 @@ renderDefault s = encAll mempty 
    eq  = B.char8 '='

    sep = B.byteString s



-- | 'Renderer' that uses <http://cr.yp.to/proto/netstrings.txt netstring>

-- encoding for log lines.

renderNetstr :: [Element] -> B.Builder

renderNetstr = encAll mempty

-- | See 'renderNetstr'.

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

+20 −8
Original line number Diff line number Diff line
@@ -21,8 +21,10 @@ module System.Logger.Settings 
    , delimiter

    , setDelimiter

    , setNetStrings

    , setRendererNetstr

    , setRendererDefault

    , setRendererNetstr

    , renderDefault

    , renderNetstr

    , logLevel

    , logLevelMap

    , logLevelOf
@@ -91,16 +93,26 @@ setDelimiter x s = s { _delimiter = x } 
--

-- {#- DEPRECATED setNetStrings "Use setRendererNetstr or setRendererDefault instead" #-}

setNetStrings :: Bool -> Settings -> Settings

setNetStrings True  = setRenderer $ \_ _ _ -> renderNetstr

setNetStrings False = setRenderer $ \s _ _ -> renderDefault s

setNetStrings True  = setRendererNetstr

setNetStrings False = setRendererDefault



-- | Shortcut for calling 'setRenderer' with 'renderDefault'.

setRendererDefault :: Settings -> Settings

setRendererDefault = setRenderer renderDefault



-- | Shortcut for calling 'setRenderer' with 'renderNetstr'.

setRendererNetstr :: Settings -> Settings

setRendererNetstr = setRenderer $ \_ _ _ -> renderNetstr

setRendererNetstr = setRenderer renderNetstr



-- | Shortcut for calling 'setRenderer' with 'renderDefault'.

setRendererDefault :: Settings -> Settings

setRendererDefault = setRenderer $ \s _ _ -> renderDefault s

-- | Simple 'Renderer' with '=' between field names and values and a custom

-- separator.

renderDefault :: Renderer

renderDefault s _ _ = renderDefault_ s



-- | 'Renderer' that uses <http://cr.yp.to/proto/netstrings.txt netstring>

-- encoding for log lines.

renderNetstr :: Renderer

renderNetstr _ _ _ = renderNetstr_



logLevel :: Settings -> Level

logLevel = _logLevel
@@ -202,4 +214,4 @@ defSettings = Settings 
    defaultBufSize

    Nothing

    id

    (\s _ _ -> renderDefault s)
 
    renderDefault