tinylog 0.8 → 0.10.2
raw patch · 7 files changed
+426/−145 lines, 7 filesdep +criteriondep +double-conversiondep +tinylogdep ~bytestringdep ~fast-loggerdep ~unix-time
Dependencies added: criterion, double-conversion, tinylog
Dependency ranges changed: bytestring, fast-logger, unix-time
Files
- CHANGELOG.md +11/−0
- bench/Bench.hs +52/−0
- src/System/Logger.hs +62/−82
- src/System/Logger/Class.hs +34/−13
- src/System/Logger/Message.hs +97/−39
- src/System/Logger/Settings.hs +140/−0
- tinylog.cabal +30/−11
+ CHANGELOG.md view
@@ -0,0 +1,11 @@+0.10+-----------------------------------------------------------------------------+- Introduce `Settings` module.++0.9+-----------------------------------------------------------------------------+- Add support for netstrings encoding.++0.8+-----------------------------------------------------------------------------+- Initial release.
+ bench/Bench.hs view
@@ -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" +++ (10000 :: Int) +++ (-42 :: Int64))++g :: Bool -> Int -> Int64+g b n = L.length+ . render ", " b+ . foldr1 (.)+ . replicate n+ $ "key" .= (val "hello world" +++ (10000 :: Int) +++ (-42 :: Int64))
src/System/Logger.hs view
@@ -7,18 +7,37 @@ -- | Small layer on top of @fast-logger@ which adds log-levels and -- timestamp support (using @date-cache@) and not much more. module System.Logger- ( Level (..)+ ( Settings+ , defSettings+ , logLevel+ , setLogLevel+ , output+ , setOutput+ , format+ , setFormat+ , delimiter+ , setDelimiter+ , netstrings+ , setNetStrings+ , bufSize+ , setBufSize+ , name+ , setName++ , Level (..) , Output (..)- , Settings (..)- , Logger+ , DateFormat+ , iso8601UTC + , Logger , new , create- , defSettings , level , flush , close+ , clone+ , settings , log , trace@@ -28,95 +47,47 @@ , err , fatal - , iso8601UTC , module M- )-where+ ) where import Prelude hiding (log) import Control.Applicative import Control.Monad import Control.Monad.IO.Class import Data.ByteString (ByteString)-import Data.ByteString.Char8 (pack) import Data.Maybe (fromMaybe)-import Data.String+import Data.Text (Text) import Data.UnixTime import System.Date.Cache import System.Environment (lookupEnv)-import System.Log.FastLogger (BufSize) import System.Logger.Message as M+import System.Logger.Settings import qualified System.Log.FastLogger as FL -data Level- = Trace- | Debug- | Info- | Warn- | Error- | Fatal- deriving (Eq, Ord, Read, Show)- data Logger = Logger- { _logger :: FL.LoggerSet- , _settings :: Settings- , _getDate :: Maybe DateCacheGetter- , _closeDate :: Maybe DateCacheCloser+ { logger :: FL.LoggerSet+ , settings :: Settings+ , getDate :: IO (Msg -> Msg)+ , closeDate :: Maybe DateCacheCloser } -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- } deriving (Eq, Ord, Show)--data Output- = StdOut- | StdErr- | Path FilePath- deriving (Eq, Ord, Show)--newtype DateFormat = DateFormat- { template :: ByteString- } deriving (Eq, Ord, Show)--instance IsString DateFormat where- fromString = DateFormat . pack---- | ISO 8601 date-time format.-iso8601UTC :: DateFormat-iso8601UTC = "%Y-%0m-%0dT%0H:%0M:%0SZ"---- | Default settings for use with 'new':------ * 'logLevel' = 'Debug'------ * 'output' = 'StdOut'------ * 'format' = 'iso8601UTC'------ * 'delimiter' = \", \"------ * 'bufSize' = 'FL.defaultBufSize'----defSettings :: Settings-defSettings = Settings Debug StdOut iso8601UTC ", " FL.defaultBufSize- -- | Create a new 'Logger' with the given 'Settings'. -- Please note that the 'logLevel' can be dynamically adjusted by setting -- the environment variable @LOG_LEVEL@ accordingly. Likewise the buffer--- size can be dynamically set via @LOG_BUFFER@.+-- size can be dynamically set via @LOG_BUFFER@ and netstrings encoding+-- can be enabled with @LOG_NETSTR=True@ new :: MonadIO m => Settings -> m Logger new s = liftIO $ do n <- fmap (readNote "Invalid LOG_BUFFER") <$> lookupEnv "LOG_BUFFER" l <- fmap (readNote "Invalid LOG_LEVEL") <$> lookupEnv "LOG_LEVEL"+ e <- fmap (readNote "Invalid LOG_NETSTR") <$> lookupEnv "LOG_NETSTR" g <- fn (output s) (fromMaybe (bufSize s) n) c <- clockCache (format s)- let s' = s { logLevel = fromMaybe (logLevel s) l }- return $ Logger g s' (fst <$> c) (snd <$> c)+ let s' = setLogLevel (fromMaybe (logLevel s) l)+ . setNetStrings (fromMaybe (netstrings s) e)+ $ s+ return $ Logger g s' (maybe (return id) (liftM msg) (fst <$> c)) (snd <$> c) where fn StdOut = FL.newStdoutLoggerSet fn StdErr = FL.newStderrLoggerSet@@ -130,7 +101,7 @@ -- | Invokes 'new' with default settings and the given output as log sink. create :: MonadIO m => Output -> m Logger-create p = new defSettings { output = p }+create o = new $ setOutput o defSettings readNote :: Read a => String -> String -> a readNote m s = case reads s of@@ -158,32 +129,41 @@ {-# INLINE err #-} {-# INLINE fatal #-} +-- | Clone the given logger and optionally give it a name+-- (use @(Just \"\")@ to clear).+clone :: Maybe Text -> Logger -> Logger+clone (Just n) g = g { settings = setName n (settings g) }+clone Nothing g = g+ -- | Force buffered bytes to output sink. flush :: MonadIO m => Logger -> m ()-flush = liftIO . FL.flushLogStr . _logger+flush = liftIO . FL.flushLogStr . logger -- | Closes the logger. close :: MonadIO m => Logger -> m () close g = liftIO $ do- fromMaybe (return ()) (_closeDate g)- FL.rmLoggerSet (_logger g)+ fromMaybe (return ()) (closeDate g)+ FL.rmLoggerSet (logger g) -- | Inspect this logger's threshold. level :: Logger -> Level-level = logLevel . _settings+level = logLevel . settings {-# INLINE level #-} 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)- FL.pushLogStr (_logger g) (FL.toLogStr m)- where- l2b :: Level -> ByteString- l2b Trace = "T"- l2b Debug = "D"- l2b Info = "I"- l2b Warn = "W"- l2b Error = "E"- l2b Fatal = "F"+ d <- getDate g+ let n = netstrings $ settings g+ let x = delimiter $ settings g+ let s = nameMsg $ settings g+ let m = render x n (d . lmsg l . s . f)+ FL.pushLogStr (logger g) (FL.toLogStr m) +lmsg :: Level -> (Msg -> Msg)+lmsg Trace = msg (val "T")+lmsg Debug = msg (val "D")+lmsg Info = msg (val "I")+lmsg Warn = msg (val "W")+lmsg Error = msg (val "E")+lmsg Fatal = msg (val "F")+{-# INLINE lmsg #-}
src/System/Logger/Class.hs view
@@ -4,29 +4,50 @@ {-# LANGUAGE FlexibleContexts #-} +-- | The 'MonadLogger' type-class and associated functions. module System.Logger.Class- ( MonadLogger (..)- , trace- , debug- , info- , warn- , err- , fatal+ ( L.Settings+ , L.defSettings+ , L.logLevel+ , L.setLogLevel+ , L.output+ , L.setOutput+ , L.format+ , L.setFormat+ , L.delimiter+ , L.setDelimiter+ , L.netstrings+ , L.setNetStrings+ , L.bufSize+ , L.setBufSize+ , L.name+ , L.setName , L.Level (..) , L.Output (..)- , L.Settings (..)- , L.Logger+ , L.DateFormat+ , L.iso8601UTC + , L.Logger , L.new , L.create- , L.defSettings- , L.iso8601UTC+ , L.level+ , L.flush+ , L.close+ , L.clone+ , L.settings + , MonadLogger (..)+ , trace+ , debug+ , info+ , warn+ , err+ , fatal+ , module M- )-where+ ) where import System.Logger (Level (..)) import System.Logger.Message as M
src/System/Logger/Message.hs view
@@ -2,14 +2,15 @@ -- 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: -- -- @--- > g <- new defSettings { bufSize = 1, output = StdOut }+-- > g <- new (setBufSize 1 . setOutput StdOut $ defSettings) -- > info g $ msg "some text" ~~ "key" .= "value" ~~ "okay" .= True -- 2014-04-28T21:18:20Z, I, some text, key=value, okay=True -- >@@ -17,68 +18,97 @@ module System.Logger.Message ( ToBytes (..) , Msg+ , Builder , msg , field , (.=) , (+++) , (~~) , val+ , eval , render ) 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.String import Data.Text (Text) import Data.Text.Encoding (encodeUtf8) import Data.Word+import GHC.Float -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 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)++instance IsString Builder where+ fromString = bytes++eval :: Builder -> L.ByteString+eval (Builder n b) = B.toLazyByteStringWith (B.safeStrategy n 256) L.empty 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 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 { builders :: [Builder] }+newtype Msg = Msg { elements :: [Element] } +data Element+ = Bytes Builder+ | Field Builder Builder+ -- | 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 (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 $ bytes k <> B.byteString "=" <> bytes v : m+field k v (Msg m) = Msg $ Field (bytes k) (bytes v) : m -- | Alias of 'field'. (.=) :: ToBytes a => ByteString -> a -> Msg -> Msg@@ -103,14 +133,42 @@ -- | 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 . encAll mempty . elements . m $ empty where- finish = B.toLazyByteStringWith (B.untrimmedStrategy 128 256) "\n"- empty = Msg []+ encAll !acc [] = acc+ encAll !acc (b:bb) = encAll (acc <> encOne b) bb + 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+ 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++ eq = B.char8 '='+ sep = B.byteString s++finish :: B.Builder -> L.ByteString+finish = B.toLazyByteStringWith (B.untrimmedStrategy 256 256) "\n"++empty :: Msg+empty = Msg []++netstr :: Builder -> B.Builder+netstr (Builder !n b) = B.intDec n <> colon <> b <> comma++colon, comma :: B.Builder+colon = B.char8 ':'+comma = B.char8 ','
+ src/System/Logger/Settings.hs view
@@ -0,0 +1,140 @@+-- 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 System.Logger.Settings+ ( Settings+ , Level (..)+ , Output (..)+ , DateFormat (..)++ , defSettings+ , output+ , setOutput+ , format+ , setFormat+ , bufSize+ , setBufSize+ , delimiter+ , setDelimiter+ , netstrings+ , setNetStrings+ , logLevel+ , setLogLevel+ , name+ , setName+ , nameMsg+ , iso8601UTC+ ) where++import Data.String+import Data.ByteString (ByteString)+import Data.ByteString.Char8 (pack)+import Data.Text (Text)+import System.Log.FastLogger (defaultBufSize)+import System.Logger.Message++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+ , _netstrings :: !Bool -- ^ use <http://cr.yp.to/proto/netstrings.txt netstrings> encoding (fixes delimiter to \",\")+ , _bufSize :: !Int -- ^ how many bytes to buffer before commiting to sink+ , _name :: !Text -- ^ logger name+ , _nameMsg :: Msg -> Msg+ }++output :: Settings -> Output+output = _output++setOutput :: Output -> Settings -> Settings+setOutput x s = s { _output = x }++format :: Settings -> DateFormat+format = _format++setFormat :: DateFormat -> Settings -> Settings+setFormat x s = s { _format = x }++bufSize :: Settings -> Int+bufSize = _bufSize++setBufSize :: Int -> Settings -> Settings+setBufSize x s = s { _bufSize = max 1 x }++delimiter :: Settings -> ByteString+delimiter = _delimiter++setDelimiter :: ByteString -> Settings -> Settings+setDelimiter x s = s { _delimiter = x }++netstrings :: Settings -> Bool+netstrings = _netstrings++setNetStrings :: Bool -> Settings -> Settings+setNetStrings x s = s { _netstrings = x }++logLevel :: Settings -> Level+logLevel = _logLevel++setLogLevel :: Level -> Settings -> Settings+setLogLevel x s = s { _logLevel = x }++name :: Settings -> Text+name = _name++setName :: Text -> Settings -> Settings+setName "" s = s { _name = "", _nameMsg = id }+setName xs s = s { _name = xs, _nameMsg = "logger" .= xs }++nameMsg :: Settings -> (Msg -> Msg)+nameMsg = _nameMsg++data Level+ = Trace+ | Debug+ | Info+ | Warn+ | Error+ | Fatal+ deriving (Eq, Ord, Read, Show)++data Output+ = StdOut+ | StdErr+ | Path FilePath+ deriving (Eq, Ord, Show)++newtype DateFormat = DateFormat+ { template :: ByteString+ } deriving (Eq, Ord, Show)++instance IsString DateFormat where+ fromString = DateFormat . pack++-- | ISO 8601 date-time format.+iso8601UTC :: DateFormat+iso8601UTC = "%Y-%0m-%0dT%0H:%0M:%0SZ"++-- | Default settings:+--+-- * 'logLevel' = 'Debug'+--+-- * 'output' = 'StdOut'+--+-- * 'format' = 'iso8601UTC'+--+-- * 'delimiter' = \", \"+--+-- * 'netstrings' = False+--+-- * 'bufSize' = 'FL.defaultBufSize'+--+-- * 'name' = \"\"+--+defSettings :: Settings+defSettings = Settings Debug StdOut iso8601UTC ", " False defaultBufSize "" id+
tinylog.cabal view
@@ -1,14 +1,17 @@ name: tinylog-version: 0.8+version: 0.10.2 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.@@ -24,15 +27,31 @@ ghc-prof-options: -prof -auto-all exposed-modules:- System.Logger- , System.Logger.Class- , System.Logger.Message+ System.Logger+ System.Logger.Class+ System.Logger.Message + other-modules:+ System.Logger.Settings+ 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.*+ , double-conversion == 0.2.*+ , fast-logger >= 2.1.4 && < 2.3+ , text >= 0.11 && < 1.2+ , transformers >= 0.3+ , unix-time >= 0.1 && < 0.4++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