diff --git a/src/System/Logger.hs b/src/System/Logger.hs index 488dbc4869629ca766777494262b9dc2958a1477..be1adafd38960f8324fded01ec49e587b1c806f4 100644 --- a/src/System/Logger.hs +++ b/src/System/Logger.hs @@ -123,15 +123,15 @@ readNote m s = case reads s of [(a, "")] -> a _ -> error m -log :: MonadIO m => Logger -> Level -> Builder -> m () +log :: MonadIO m => Logger -> Level -> (Msg -> Msg) -> m () log g l m = unless (level g > l) . liftIO $ putMsg g l m {-# INLINE log #-} -logM :: MonadIO m => Logger -> Level -> m Builder -> m () +logM :: MonadIO m => Logger -> Level -> m (Msg -> Msg) -> m () logM g l m = unless (level g > l) $ m >>= putMsg g l {-# INLINE logM #-} -trace, debug, info, warn, err, fatal :: MonadIO m => Logger -> Builder -> m () +trace, debug, info, warn, err, fatal :: MonadIO m => Logger -> (Msg -> Msg) -> m () trace g = log g Trace debug g = log g Debug info g = log g Info @@ -145,7 +145,7 @@ fatal g = log g Fatal {-# INLINE err #-} {-# INLINE fatal #-} -traceM, debugM, infoM, warnM, errM, fatalM :: MonadIO m => Logger -> m Builder -> m () +traceM, debugM, infoM, warnM, errM, fatalM :: MonadIO m => Logger -> m (Msg -> Msg) -> m () traceM g = logM g Trace debugM g = logM g Debug infoM g = logM g Info @@ -171,7 +171,7 @@ level :: Logger -> Level level = logLevel . _settings {-# INLINE level #-} -putMsg :: MonadIO m => Logger -> Level -> Builder -> m () +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) diff --git a/src/System/Logger/Message.hs b/src/System/Logger/Message.hs index 544adc4f5c6d866337d88c2a062026a7be16ef00..fae0adcec264f6c3ab9382180844a76fdf8fbaf4 100644 --- a/src/System/Logger/Message.hs +++ b/src/System/Logger/Message.hs @@ -2,38 +2,76 @@ -- 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 OverloadedStrings #-} module System.Logger.Message - ( Builder + ( ToBytes (..) , Msg , msg , field , (=:) + , (+++) + , val , render ) where import Data.ByteString (ByteString) +import Data.ByteString.Lazy.Builder (Builder) +import Data.Int import Data.List (intersperse) import Data.Monoid +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.Lazy as L import qualified Data.ByteString.Lazy.Builder as B +import qualified Data.ByteString.Lazy.Builder.ASCII as B import qualified Data.ByteString.Lazy.Builder.Extras as B -type Builder = Msg -> Msg -newtype Msg = Msg { builders :: [B.Builder] } +class ToBytes a where + bytes :: a -> Builder -msg :: ByteString -> Builder -msg p (Msg m) = Msg (B.byteString p : m) +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 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 Text where bytes = B.byteString . encodeUtf8 +instance ToBytes T.Text where bytes = B.lazyByteString . T.encodeUtf8 +instance ToBytes [Char] where bytes = B.stringUtf8 -field, (=:) :: ByteString -> ByteString -> Builder -field k v (Msg m) = Msg $ - B.byteString k <> B.byteString "=" <> B.byteString v : m +newtype Msg = Msg { builders :: [Builder] } +msg :: ToBytes a => a -> Msg -> Msg +msg p (Msg m) = Msg (bytes p : m) + +field, (=:) :: ToBytes a => ByteString -> a -> Msg -> Msg +field k v (Msg m) = Msg $ bytes k <> B.byteString "=" <> bytes v : m + +infixr 5 =: (=:) = field -render :: ByteString -> Builder -> L.ByteString +infixr 5 +++ +(+++) :: (ToBytes a, ToBytes b) => a -> b -> Builder +a +++ b = bytes a <> bytes b + +val :: ByteString -> Builder +val = bytes + +render :: ByteString -> (Msg -> Msg) -> L.ByteString render s f = finish . mconcat . intersperse (B.byteString s) diff --git a/src/System/LoggerT.hs b/src/System/LoggerT.hs index db311a5c0f4d40adf48eef3a0d49fdd8e3242d33..ba350a398833d16198a088307e158e267746c8c4 100644 --- a/src/System/LoggerT.hs +++ b/src/System/LoggerT.hs @@ -48,22 +48,22 @@ newtype LoggerT m a = LoggerT class MonadIO m => MonadLogger m where logger :: m Logger - prefix :: m Builder + prefix :: m (Msg -> Msg) prefix = return id - log :: Level -> Builder -> m () + log :: Level -> (Msg -> Msg) -> m () log l m = do g <- logger p <- prefix L.log g l (p . m) - logM :: Level -> m Builder -> m () + logM :: Level -> m (Msg -> Msg) -> m () logM l m = do g <- logger p <- prefix L.logM g l ((p .) `liftM` m) - trace, debug, info, warn, err, fatal :: Builder -> m () + trace, debug, info, warn, err, fatal :: (Msg -> Msg) -> m () trace = log Trace debug = log Debug info = log Info @@ -71,7 +71,7 @@ class MonadIO m => MonadLogger m where err = log Error fatal = log Fatal - traceM, debugM, infoM, warnM, errM, fatalM :: m Builder -> m () + traceM, debugM, infoM, warnM, errM, fatalM :: m (Msg -> Msg) -> m () traceM = logM Trace debugM = logM Debug infoM = logM Info diff --git a/tinylog.cabal b/tinylog.cabal index 7182ccc7ded156920ac69d3ef08dd104614840d3..b71a46797f7d108daa74bc97621d3127c6ba5a59 100644 --- a/tinylog.cabal +++ b/tinylog.cabal @@ -1,5 +1,5 @@ name: tinylog -version: 0.5 +version: 0.6 synopsis: Simplistic logging using fast-logger. author: Toralf Wittner maintainer: Toralf Wittner @@ -35,5 +35,6 @@ library , exceptions >= 0.3 , fast-logger >= 2.1.4 && < 2.2 , mtl >= 2.1 + , text >= 0.11 && < 1.2 , transformers >= 0.3 , unix-time >= 0.1