diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 index 0000000000000000000000000000000000000000..273be2ce55bd7e9e6839abdb4c0475007474ad72 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,7 @@ +0.9 +----------------------------------------------------------------------------- +- Add support for netstrings encoding. + +0.8 +----------------------------------------------------------------------------- +- Initial release. diff --git a/bench/Bench.hs b/bench/Bench.hs new file mode 100644 index 0000000000000000000000000000000000000000..1e659542cbad6f3f3bfe8f991d33496598d87fc0 --- /dev/null +++ b/bench/Bench.hs @@ -0,0 +1,52 @@ +-- 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") diff --git a/src/System/Logger.hs b/src/System/Logger.hs index 413c8d9700f59a437255f20789219117e35cdde8..29aadd11414ad141587dbbb1a161cfb5eeb5f746 100644 --- a/src/System/Logger.hs +++ b/src/System/Logger.hs @@ -65,11 +65,12 @@ data Logger = Logger } data Settings = Settings - { logLevel :: Level -- ^ messages below this log level will be suppressed - , output :: Output -- ^ log sink - , format :: DateFormat -- ^ the timestamp format (use \"\" to disable timestamps) - , delimiter :: ByteString -- ^ text to intersperse between fields of a log line - , bufSize :: BufSize -- ^ how many bytes to buffer before commiting to sink + { logLevel :: Level -- ^ messages below this log level will be suppressed + , 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 encoding (fixes delimiter to \",\") + , bufSize :: BufSize -- ^ how many bytes to buffer before commiting to sink } deriving (Eq, Ord, Show) data Output @@ -99,10 +100,12 @@ iso8601UTC = "%Y-%0m-%0dT%0H:%0M:%0SZ" -- -- * '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 @@ -175,7 +178,9 @@ level = logLevel . _settings 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 diff --git a/src/System/Logger/Message.hs b/src/System/Logger/Message.hs index 1e312cad93392dfc96729cc1c41ba710e8d9adee..8bb8e01c713401694d1bfa56affd0a71124c9d78 100644 --- a/src/System/Logger/Message.hs +++ b/src/System/Logger/Message.hs @@ -35,11 +35,12 @@ import Data.Text (Text) 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 @@ -54,6 +55,7 @@ instance ToBytes Int8 where bytes = B.int8Dec 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 @@ -70,15 +72,19 @@ instance ToBytes Bool where 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 @@ -103,14 +109,35 @@ val = bytes -- | 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. 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" - empty = Msg [] + 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 diff --git a/tinylog.cabal b/tinylog.cabal index 603db3f4c3f1143680418d33605ccf71f76cef42..7f702910b4793c7004a4930de6ae0b63b1d16aa3 100644 --- a/tinylog.cabal +++ b/tinylog.cabal @@ -1,14 +1,17 @@ name: tinylog -version: 0.8 +version: 0.9 synopsis: Simplistic logging using fast-logger. author: Toralf Wittner maintainer: Toralf Wittner 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. @@ -36,3 +39,15 @@ library , 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