From 3191144c570533f8357e2820141e90d9be4faa8d Mon Sep 17 00:00:00 2001 From: Toralf Wittner Date: Wed, 2 Jul 2014 21:30:35 +0200 Subject: [PATCH] Optimise message rendering. --- bench/Bench.hs | 4 +- src/System/Logger/Message.hs | 118 +++++++++++++++++++++-------------- tinylog.cabal | 15 ++--- 3 files changed, 80 insertions(+), 57 deletions(-) diff --git a/bench/Bench.hs b/bench/Bench.hs index 1e65954..34ceb50 100644 --- a/bench/Bench.hs +++ b/bench/Bench.hs @@ -42,11 +42,11 @@ f b n = L.length . render ", " b . foldr1 (.) . replicate n - $ msg (val "hello world") + $ msg (val "hello world" +++ (10000 :: Int) +++ (-42 :: Int64)) g :: Bool -> Int -> Int64 g b n = L.length . render ", " b . foldr1 (.) . replicate n - $ field "key" (val "value") + $ "key" .= (val "hello world" +++ (10000 :: Int) +++ (-42 :: Int64)) diff --git a/src/System/Logger/Message.hs b/src/System/Logger/Message.hs index 8bb8e01..f95e478 100644 --- a/src/System/Logger/Message.hs +++ b/src/System/Logger/Message.hs @@ -2,8 +2,9 @@ -- 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 FlexibleInstances #-} +{-# LANGUAGE BangPatterns #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE FlexibleInstances #-} -- | 'Msg' and 'ToBytes' assist in constructing log messages. -- For example: @@ -27,64 +28,78 @@ module System.Logger.Message ) where import Data.ByteString (ByteString) -import Data.ByteString.Lazy.Builder (Builder) +import Data.Double.Conversion.Text import Data.Int -import Data.List (intersperse) import Data.Monoid import Data.Text (Text) import Data.Text.Encoding (encodeUtf8) import Data.Word +import GHC.Float 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 +import qualified Data.Text as T +import qualified Data.Text.Lazy as TL +import qualified Data.Text.Lazy.Encoding as TL + +data Builder = Builder !Int B.Builder + +instance Monoid Builder where + mempty = Builder 0 mempty + (Builder x a) `mappend` (Builder y b) = Builder (x + y) (a <> b) -- | Convert some value to a 'Builder'. class ToBytes a where bytes :: a -> Builder -instance ToBytes Builder where bytes = id -instance ToBytes L.ByteString where bytes = B.lazyByteString -instance ToBytes ByteString where bytes = B.byteString -instance ToBytes Char where bytes = B.charUtf8 -instance ToBytes Int where bytes = B.intDec -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 -instance ToBytes Word32 where bytes = B.word32Dec -instance ToBytes Word64 where bytes = B.word64Dec -instance ToBytes Float where bytes = B.floatDec -instance ToBytes Double where bytes = B.doubleDec -instance ToBytes Text where bytes = B.byteString . encodeUtf8 -instance ToBytes T.Text where bytes = B.lazyByteString . T.encodeUtf8 -instance ToBytes [Char] where bytes = B.stringUtf8 +instance ToBytes Builder where bytes x = x +instance ToBytes L.ByteString where bytes x = Builder (fromIntegral $ L.length x) (B.lazyByteString x) +instance ToBytes ByteString where bytes x = Builder (S.length x) (B.byteString x) +instance ToBytes Int where bytes x = Builder (len10 x) (B.intDec x) +instance ToBytes Int8 where bytes x = Builder (len10 x) (B.int8Dec x) +instance ToBytes Int16 where bytes x = Builder (len10 x) (B.int16Dec x) +instance ToBytes Int32 where bytes x = Builder (len10 x) (B.int32Dec x) +instance ToBytes Int64 where bytes x = Builder (len10 x) (B.int64Dec x) +instance ToBytes Integer where bytes x = Builder (len10 x) (B.integerDec x) +instance ToBytes Word where bytes x = Builder (len10 x) (B.wordDec x) +instance ToBytes Word8 where bytes x = Builder (len10 x) (B.word8Dec x) +instance ToBytes Word16 where bytes x = Builder (len10 x) (B.word16Dec x) +instance ToBytes Word32 where bytes x = Builder (len10 x) (B.word32Dec x) +instance ToBytes Word64 where bytes x = Builder (len10 x) (B.word64Dec x) +instance ToBytes Float where bytes x = bytes (toShortest $ float2Double x) +instance ToBytes Double where bytes x = bytes (toShortest x) +instance ToBytes Text where bytes x = bytes (encodeUtf8 x) +instance ToBytes TL.Text where bytes x = bytes (TL.encodeUtf8 x) +instance ToBytes Char where bytes x = bytes (T.singleton x) +instance ToBytes [Char] where bytes x = bytes (TL.pack x) instance ToBytes Bool where - bytes True = val "True" - bytes False = val "False" + bytes True = Builder 4 (B.byteString "True") + bytes False = Builder 5 (B.byteString "False") + +{-# INLINE len10 #-} +len10 :: Integral a => a -> Int +len10 !n = if n > 0 then go n 0 else 1 + go (-n) 0 + where + go 0 !a = a + go !x !a = go (x `div` 10) (a + 1) -- | Type representing log messages. newtype Msg = Msg { elements :: [Element] } data Element - = Bytes L.ByteString - | Field ByteString L.ByteString + = Bytes Builder + | Field Builder Builder -- | Turn some value into a 'Msg'. msg :: ToBytes a => a -> Msg -> Msg -msg p (Msg m) = Msg $ Bytes (lbstr p) : m +msg p (Msg m) = Msg $ Bytes (bytes 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 $ Field k (lbstr v) : m +field k v (Msg m) = Msg $ Field (bytes k) (bytes v) : m -- | Alias of 'field'. (.=) :: ToBytes a => ByteString -> a -> Msg -> Msg @@ -114,30 +129,37 @@ val = bytes -- the message elements. Cf. for -- details. render :: ByteString -> Bool -> (Msg -> Msg) -> L.ByteString -render _ True m = finish . mconcat . map enc . elements . m $ empty +render _ True m = finish . encAll mempty . elements . m $ empty where - enc (Bytes e) = netstrLB e - enc (Field k v) = netstrSB k <> eq <> netstrLB v - eq = val "1:=," + encAll !acc [] = acc + encAll !acc (b:bb) = encAll (acc <> encOne b) bb -render s False m = finish . mconcat . seps . map enc . elements . m $ empty + encOne (Bytes e) = netstr e + encOne (Field k v) = netstr k <> eq <> netstr v + + eq = B.byteString "1:=," + +render s False m = finish . encAll mempty . elements . m $ empty where - enc (Bytes e) = bytes e - enc (Field k v) = k +++ val "=" +++ v - seps = intersperse (bytes s) + encAll !acc [] = acc + encAll !acc (b:[]) = acc <> encOne b + encAll !acc (b:bb) = encAll (acc <> encOne b <> sep) bb + + encOne (Bytes (Builder _ b)) = b + encOne (Field (Builder _ k) (Builder _ v)) = k <> eq <> v -finish :: Builder -> L.ByteString + eq = B.char8 '=' + sep = B.byteString s + +finish :: B.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 +netstr :: Builder -> B.Builder +netstr (Builder !n b) = B.intDec n <> colon <> b <> comma +colon, comma :: B.Builder +colon = B.char8 ':' +comma = B.char8 ',' diff --git a/tinylog.cabal b/tinylog.cabal index 7f70291..995fe66 100644 --- a/tinylog.cabal +++ b/tinylog.cabal @@ -32,13 +32,14 @@ library System.Logger.Message build-depends: - base == 4.* - , bytestring >= 0.10.4 && < 0.11 - , date-cache >= 0.3 && < 0.4 - , fast-logger >= 2.1.4 && < 2.2 - , text >= 0.11 && < 1.2 - , transformers >= 0.3 - , unix-time >= 0.1 && < 0.3 + base == 4.* + , bytestring >= 0.10.4 && < 0.11 + , date-cache >= 0.3 && < 0.4 + , double-conversion == 0.2.* + , fast-logger >= 2.1.4 && < 2.2 + , text >= 0.11 && < 1.2 + , transformers >= 0.3 + , unix-time >= 0.1 && < 0.3 benchmark tinylog-bench type: exitcode-stdio-1.0 -- GitLab