Add support for netstrings encoding.

0.9

-----------------------------------------------------------------------------

- Add support for netstrings encoding.

0.8

-----------------------------------------------------------------------------

- Initial release.

-- This Source Code Form is subject to the terms of the Mozilla Public

-- License, v. 2.0. If a copy of the MPL was not distributed with this

-- file, You can obtain one at http://mozilla.org/MPL/2.0/.

{-# LANGUAGE OverloadedStrings #-}

module Main (main) where

import Criterion.Main

import Criterion.Config

import Data.Int

import System.Logger.Message

import qualified Data.ByteString.Lazy as L

main :: IO ()

main = defaultMainWith defaultConfig (return ())

    [ bgroup "direct"

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

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

        , bench "msg/32" (whnf (f False) 32)

        ]

    , bgroup "netstr"

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

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

        , bench "msg/32" (whnf (f True) 32)

        ]

    , bgroup "direct"

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

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

        , bench "field/32" (whnf (g False) 32)

        ]

    , bgroup "netstr"

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

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

        , bench "field/32" (whnf (g True) 32)

        ]

    ]

f :: Bool -> Int -> Int64

f b n = L.length

      . render ", " b

      . foldr1 (.)

      . replicate n

      $ msg (val "hello world")

g :: Bool -> Int -> Int64

g b n = L.length

      . render ", " b

      . foldr1 (.)

      . replicate n

      $ field "key" (val "value")

    , output     :: Output     -- ^ log sink

    , format     :: DateFormat -- ^ the timestamp format (use \"\" to disable timestamps)

    , delimiter  :: ByteString -- ^ text to intersperse between fields of a log line

    , netstrings :: Bool       -- ^ use <http://cr.yp.to/proto/netstrings.txt netstrings> encoding (fixes delimiter to \",\")

    , bufSize    :: BufSize    -- ^ how many bytes to buffer before commiting to sink

    } deriving (Eq, Ord, Show)

--

--   * 'delimiter' = \", \"

--

--   * 'netstrings' = False

--

--   * 'bufSize'   = 'FL.defaultBufSize'

--

defSettings :: Settings

defSettings = Settings Debug StdOut iso8601UTC ", " FL.defaultBufSize

defSettings = Settings Debug StdOut iso8601UTC ", " False FL.defaultBufSize

-- | Create a new 'Logger' with the given 'Settings'.

-- Please note that the 'logLevel' can be dynamically adjusted by setting

putMsg :: MonadIO m => Logger -> Level -> (Msg -> Msg) -> m ()

putMsg g l f = liftIO $ do

    d <- maybe (return id) (liftM msg) (_getDate g)

    let m = render (delimiter $ _settings g) (d . msg (l2b l) . f)

    let n = netstrings $ _settings g

    let x = delimiter  $ _settings g

    let m = render x n (d . msg (l2b l) . f)

    FL.pushLogStr (_logger g) (FL.toLogStr m)

  where

    l2b :: Level -> ByteString

import Data.Text.Encoding (encodeUtf8)

import Data.Word

import qualified Data.Text.Lazy                      as T

import qualified Data.Text.Lazy.Encoding             as T

import qualified Data.ByteString                     as S

import qualified Data.ByteString.Lazy                as L

import qualified Data.ByteString.Lazy.Builder        as B

import qualified Data.ByteString.Lazy.Builder.Extras as B

import qualified Data.Text.Lazy                      as T

import qualified Data.Text.Lazy.Encoding             as T

-- | Convert some value to a 'Builder'.

class ToBytes a where

instance ToBytes Int16        where bytes = B.int16Dec

instance ToBytes Int32        where bytes = B.int32Dec

instance ToBytes Int64        where bytes = B.int64Dec

instance ToBytes Integer      where bytes = B.integerDec

instance ToBytes Word         where bytes = B.wordDec

instance ToBytes Word8        where bytes = B.word8Dec

instance ToBytes Word16       where bytes = B.word16Dec

    bytes False = val "False"

-- | Type representing log messages.

newtype Msg = Msg { builders :: [Builder] }

newtype Msg = Msg { elements :: [Element] }

data Element

    = Bytes L.ByteString

    | Field ByteString L.ByteString

-- | Turn some value into a 'Msg'.

msg :: ToBytes a => a -> Msg -> Msg

msg p (Msg m) = Msg (bytes p : m)

msg p (Msg m) = Msg $ Bytes (lbstr p) : m

-- | Render some field, i.e. a key-value pair delimited by \"=\".

field :: ToBytes a => ByteString -> a -> Msg -> Msg

field k v (Msg m) = Msg $ bytes k <> B.byteString "=" <> bytes v : m

field k v (Msg m) = Msg $ Field k (lbstr v) : m

-- | Alias of 'field'.

(.=) :: ToBytes a => ByteString -> a -> Msg -> Msg

-- | Intersperse parts of the log message with the given delimiter and

-- render the whole builder into a 'L.ByteString'.

render :: ByteString -> (Msg -> Msg) -> L.ByteString

render s f = finish

           . mconcat

           . intersperse (B.byteString s)

           . builders

           . f

           $ empty

--

-- If the second parameter is set to @True@, netstrings encoding is used for

-- the message elements. Cf. <http://cr.yp.to/proto/netstrings.txt> for

-- details.

render :: ByteString -> Bool -> (Msg -> Msg) -> L.ByteString

render _ True m = finish . mconcat . map enc . elements . m $ empty

  where

    finish = B.toLazyByteStringWith (B.untrimmedStrategy 128 256) "\n"

    enc (Bytes   e) = netstrLB e

    enc (Field k v) = netstrSB k <> eq <> netstrLB v

    eq              = val "1:=,"

render s False m = finish . mconcat . seps . map enc . elements . m $ empty

  where

    enc (Bytes   e) = bytes e

    enc (Field k v) = k +++ val "=" +++ v

    seps            = intersperse (bytes s)

finish :: Builder -> L.ByteString

finish = B.toLazyByteStringWith (B.untrimmedStrategy 256 256) "\n"

empty :: Msg

empty = Msg []

netstrSB :: ByteString -> Builder

netstrSB b = S.length b +++ val ":" +++ b +++ val ","

netstrLB :: L.ByteString -> Builder

netstrLB b = L.length b +++ val ":" +++ b +++ val ","

lbstr :: ToBytes a => a -> L.ByteString

lbstr = B.toLazyByteStringWith (B.untrimmedStrategy 64 64) L.empty . bytes

name:                 tinylog

version:              0.8

version:              0.9

synopsis:             Simplistic logging using fast-logger.

author:               Toralf Wittner

maintainer:           Toralf Wittner <tw@dtex.org>

copyright:            (c) 2014 Toralf Wittner

homepage:             https://github.com/twittner/tinylog/

bug-reports:          https://github.com/twittner/tinylog/issues

license:              OtherLicense

license-file:         LICENSE

category:             System

build-type:           Simple

cabal-version:        >= 1.10

extra-source-files:   CHANGELOG.md

description:

    Trivial logger on top of fast-logger.

        , text         >= 0.11   && < 1.2

        , transformers >= 0.3

        , unix-time    >= 0.1    && < 0.3

benchmark tinylog-bench

    type:             exitcode-stdio-1.0

    default-language: Haskell2010

    main-is:          Bench.hs

    hs-source-dirs:   bench

    ghc-options:      -Wall -O2 -fwarn-tabs

    build-depends:

          base       == 4.*

        , bytestring

        , criterion  == 0.8.*

        , tinylog