Unverified Commit 6b71c4bc authored by Matthias Fischmann's avatar Matthias Fischmann
Browse files

More general Renderer type.

parent a99e5a9f

bench/Bench.hs

+4 −5
Original line number Diff line number Diff line
@@ -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

src/System/Logger.hs

+4 −1
Original line number Diff line number Diff line
@@ -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)

src/System/Logger/Message.hs

+13 −10
Original line number Diff line number Diff line
@@ -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

src/System/Logger/Settings.hs

+6 −5
Original line number Diff line number Diff line
@@ -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'