Optimise message rendering.

      . 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))

-- 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:

    ) 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

-- 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

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 ','

          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