...
 
Commits (21)
image: haskell:8
variables:
STACK_ROOT: "${CI_PROJECT_DIR}/.stack"
cache:
key: "$CI_JOB_NAME"
paths:
- .stack
- .stack-work
- target
before_script:
- apt -qq update
- apt -qq install xz-utils make libstdc++-4.9-dev g++
- stack upgrade && hash -d stack && stack --version
- stack clean --full
- apt-get update
- apt-get install -y libstdc++-6-dev g++ pkg-config xz-utils make
test:8.6:
script:
- stack --no-terminal --resolver lts-13 --install-ghc test
test:8.4:
image: haskell:8.2
script:
- stack -j 1 test --fast
- stack --no-terminal --resolver lts-12 --install-ghc test
test:8.2:
image: haskell:8.2
script:
- stack -j 1 --resolver lts-11.1 test --fast
- stack --no-terminal --resolver lts-11 --install-ghc test
test:8.0:
image: haskell:8.0
script:
- stack -j 1 --resolver lts-9.21 test --fast
- stack --no-terminal --resolver lts-9 --install-ghc test
0.15
-----------------------------------------------------------------------------
- Allow full control over the output format (merge requests #2, #3). To do
so, a type `Renderer` has been added which can be configured via
`setRenderer`. The setting `netstring` has been removed, instead the
complete renderer can be requested via `renderer`.
- A setting `setReadEnvironment` has been added which allows one to ignore
process environment variables (see merge request #7).
0.14.1
-----------------------------------------------------------------------------
- Maintenance release to enable compatibility with GHC 8.4.
......
......@@ -2,6 +2,7 @@
-- 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 BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
module Main (main) where
......@@ -9,44 +10,70 @@ module Main (main) where
import Criterion
import Criterion.Main
import Data.Int
import System.Logger.Message
import System.Logger
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.Builder as B
import qualified Data.ByteString.Lazy as L
main :: IO ()
main = defaultMain
[ bgroup "direct"
[ bench "msg/8" (whnf (f False) 8)
, bench "msg/16" (whnf (f False) 16)
, bench "msg/32" (whnf (f False) 32)
[ bench "msg/8" (whnf (f $ \s _ _ -> renderDefault s) 8)
, bench "msg/16" (whnf (f $ \s _ _ -> renderDefault s) 16)
, bench "msg/32" (whnf (f $ \s _ _ -> renderDefault s) 32)
]
, bgroup "netstr"
[ bench "msg/8" (whnf (f True) 8)
, bench "msg/16" (whnf (f True) 16)
, bench "msg/32" (whnf (f True) 32)
[ bench "msg/8" (whnf (f $ \_ _ _ -> renderNetstr) 8)
, bench "msg/16" (whnf (f $ \_ _ _ -> renderNetstr) 16)
, bench "msg/32" (whnf (f $ \_ _ _ -> renderNetstr) 32)
]
, bgroup "custom"
[ bench "msg/8" (whnf (f renderCustom) 8)
, bench "msg/16" (whnf (f renderCustom) 16)
, bench "msg/32" (whnf (f renderCustom) 32)
]
, bgroup "direct"
[ bench "field/8" (whnf (g False) 8)
, bench "field/16" (whnf (g False) 16)
, bench "field/32" (whnf (g False) 32)
[ bench "field/8" (whnf (g $ \s _ _ -> renderDefault s) 8)
, bench "field/16" (whnf (g $ \s _ _ -> renderDefault s) 16)
, bench "field/32" (whnf (g $ \s _ _ -> renderDefault s) 32)
]
, bgroup "netstr"
[ bench "field/8" (whnf (g True) 8)
, bench "field/16" (whnf (g True) 16)
, bench "field/32" (whnf (g True) 32)
[ bench "field/8" (whnf (g $ \_ _ _ -> renderNetstr) 8)
, bench "field/16" (whnf (g $ \_ _ _ -> renderNetstr) 16)
, bench "field/32" (whnf (g $ \_ _ _ -> renderNetstr) 32)
]
, bgroup "custom"
[ bench "field/8" (whnf (g renderCustom) 8)
, bench "field/16" (whnf (g renderCustom) 16)
, bench "field/32" (whnf (g renderCustom) 32)
]
]
f :: Bool -> Int -> Int64
f b n = L.length
. render ", " b
f :: Renderer -> Int -> Int64
f r n = L.length
. render (r ", " iso8601UTC Trace)
. foldr1 (.)
. replicate n
$ msg (val "hello world" +++ (10000 :: Int) +++ (-42 :: Int64))
g :: Bool -> Int -> Int64
g b n = L.length
. render ", " b
g :: Renderer -> Int -> Int64
g r n = L.length
. render (r ", " iso8601UTC Trace)
. foldr1 (.)
. replicate n
$ "key" .= (val "hello world" +++ (10000 :: Int) +++ (-42 :: Int64))
renderCustom :: Renderer
renderCustom s _ _ = encAll mempty
where
encAll !acc [] = acc
encAll !acc (b:[]) = acc <> encOne b
encAll !acc (b:bb) = encAll (acc <> encOne b <> sep) bb
encOne (Bytes b) = builderBytes b
encOne (Field k v) = builderBytes k <> eq <> quo <> builderBytes v <> quo
eq = B.char8 '='
quo = B.char8 '"'
sep = B.byteString s
......@@ -20,19 +20,25 @@ module System.Logger
, format
, setFormat
, delimiter
, readEnvironment
, setDelimiter
, netstrings
, setNetStrings
, setReadEnvironment
, setRendererNetstr
, setRendererDefault
, bufSize
, setBufSize
, name
, setName
, setRenderer
, renderer
-- * Type definitions
, Logger
, Level (..)
, Output (..)
, DateFormat (..)
, Renderer
, iso8601UTC
-- * Core API
......@@ -59,6 +65,7 @@ module System.Logger
import Control.Applicative
import Control.Monad
import Control.Monad.IO.Class
import Data.Bool (bool)
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import Data.UnixTime
......@@ -80,12 +87,16 @@ data Logger = Logger
-- Please note that the 'logLevel' can be dynamically adjusted by setting
-- the environment variable @[email protected] accordingly. Likewise the buffer
-- size can be dynamically set via @[email protected] and netstrings encoding
-- can be enabled with @[email protected]
-- can be enabled with @[email protected] **NOTE: If you do this any custom
-- renderers you may have passed with the settings will be overwritten!**
--
-- Since version 0.11 one can also use @[email protected] to specify log
-- levels per (named) logger. The syntax uses standard haskell syntax for
-- association lists of type @[(Text, Level)]@. For example:
--
-- If you want to ignore environment variables, call @setReadEnvironment [email protected] on the
-- 'Settings'.
--
-- @
-- $ LOG_LEVEL=Info LOG_LEVEL_MAP='[("foo", Warn), ("bar", Trace)]' cabal repl
-- > g1 <- new defSettings
......@@ -103,18 +114,24 @@ data Logger = Logger
-- @
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"
!m <- fromMaybe "[]" <$> lookupEnv "LOG_LEVEL_MAP"
!n <- fmap (readNote "Invalid LOG_BUFFER") <$> maybeLookupEnv "LOG_BUFFER"
!l <- fmap (readNote "Invalid LOG_LEVEL") <$> maybeLookupEnv "LOG_LEVEL"
!e <- fmap (readNote "Invalid LOG_NETSTR") <$> maybeLookupEnv "LOG_NETSTR"
!m <- fromMaybe "[]" <$> maybeLookupEnv "LOG_LEVEL_MAP"
let !k = logLevelMap s `mergeWith` m
let !s' = setLogLevel (fromMaybe (logLevel s) l)
. setNetStrings (fromMaybe (netstrings s) e)
. maybe id (bool id setRendererNetstr) e
. setLogLevelMap k
$ s
g <- fn (output s) (fromMaybe (bufSize s) n)
Logger g s' <$> mkGetDate (format s)
where
maybeLookupEnv :: String -> IO (Maybe String)
maybeLookupEnv key =
if readEnvironment s
then lookupEnv key
else pure Nothing
fn StdOut = FL.newStdoutLoggerSet
fn StdErr = FL.newStderrLoggerSet
fn (Path p) = flip FL.newFileLoggerSet p
......@@ -136,7 +153,7 @@ readNote m s = case reads s of
-- | Logs a message with the given level if greater or equal to the
-- logger's threshold.
log :: MonadIO m => Logger -> Level -> (Msg -> Msg) -> m ()
log g l m = unless (level g > l) . liftIO $ putMsg g l m
log g l m = unless (level g > l) $ putMsg g l m
{-# INLINE log #-}
-- | Abbreviation of 'log' using the corresponding log level.
......@@ -182,10 +199,12 @@ level = logLevel . settings
putMsg :: MonadIO m => Logger -> Level -> (Msg -> Msg) -> m ()
putMsg g l f = liftIO $ do
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)
let r = renderer $ settings g
let x = delimiter $ settings g
let s = nameMsg $ settings g
let df = fromMaybe iso8601UTC . format $ settings g
let ll = logLevel $ settings g
let m = render (r x df ll) (d . lmsg l . s . f)
FL.pushLogStr (logger g) (FL.toLogStr m)
lmsg :: Level -> (Msg -> Msg)
......
......@@ -7,6 +7,7 @@
-- | The 'MonadLogger' type-class and associated functions.
module System.Logger.Class
( L.Settings
, L.Renderer
, L.defSettings
, L.logLevel
, L.setLogLevel
......@@ -16,12 +17,13 @@ module System.Logger.Class
, L.setFormat
, L.delimiter
, L.setDelimiter
, L.netstrings
, L.setNetStrings
, L.bufSize
, L.setBufSize
, L.name
, L.setName
, L.setRenderer
, L.renderer
, L.Level (..)
, L.Output (..)
......
......@@ -20,6 +20,7 @@ module System.Logger.Message
( ToBytes (..)
, Msg
, Builder
, Element (..)
, msg
, field
, (.=)
......@@ -27,7 +28,11 @@ module System.Logger.Message
, (~~)
, val
, eval
, builderSize
, builderBytes
, render
, renderDefault
, renderNetstr
) where
#if MIN_VERSION_base(4,9,0)
......@@ -81,6 +86,12 @@ instance Monoid Builder where
eval :: Builder -> L.ByteString
eval (Builder n b) = B.toLazyByteStringWith (B.safeStrategy n 256) L.empty b
builderSize :: Builder -> Int
builderSize (Builder n _) = n
builderBytes :: Builder -> B.Builder
builderBytes (Builder _ b) = b
-- | Convert some value to a 'Builder'.
class ToBytes a where
bytes :: a -> Builder
......@@ -153,24 +164,15 @@ infixr 6 +++
val :: ByteString -> Builder
val = bytes
-- | Intersperse parts of the log message with the given delimiter and
-- render the whole builder into a 'L.ByteString'.
--
-- If the second parameter is set to @[email protected], 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
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:=,"
-- | Construct elements, call a renderer, and run the whole builder
-- into a 'L.ByteString'.
render :: ([Element] -> B.Builder) -> (Msg -> Msg) -> L.ByteString
render f m = finish . f . elements . m $ empty
render s False m = finish . encAll mempty . elements . m $ empty
-- | Simple 'Renderer' with '=' between field names and values and a custom
-- separator.
renderDefault :: ByteString -> [Element] -> B.Builder
renderDefault s = encAll mempty
where
encAll !acc [] = acc
encAll !acc (b:[]) = acc <> encOne b
......@@ -182,6 +184,19 @@ render s False m = finish . encAll mempty . elements . m $ empty
eq = B.char8 '='
sep = B.byteString s
-- | 'Renderer' that uses <http://cr.yp.to/proto/netstrings.txt netstring>
-- encoding for log lines.
renderNetstr :: [Element] -> B.Builder
renderNetstr = encAll mempty
where
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:=,"
finish :: B.Builder -> L.ByteString
finish = B.toLazyByteStringWith (B.untrimmedStrategy 256 256) "\n"
......
......@@ -9,6 +9,7 @@ module System.Logger.Settings
, Level (..)
, Output (..)
, DateFormat (..)
, Renderer
, defSettings
, output
......@@ -19,8 +20,9 @@ module System.Logger.Settings
, setBufSize
, delimiter
, setDelimiter
, netstrings
, setNetStrings
, setRendererNetstr
, setRendererDefault
, logLevel
, logLevelMap
, logLevelOf
......@@ -30,6 +32,10 @@ module System.Logger.Settings
, name
, setName
, nameMsg
, renderer
, setRenderer
, readEnvironment
, setReadEnvironment
, iso8601UTC
) where
......@@ -42,16 +48,19 @@ import Data.UnixTime
import System.Log.FastLogger (defaultBufSize)
import System.Logger.Message
import qualified Data.ByteString.Lazy.Builder as B
data Settings = Settings
{ _logLevel :: !Level -- ^ messages below this log level will be suppressed
, _levelMap :: !(Map Text Level) -- ^ log level per named logger
, _output :: !Output -- ^ log sink
, _format :: !(Maybe DateFormat) -- ^ the timestamp format (use 'Nothing' 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 :: !(Maybe Text) -- ^ logger name
, _nameMsg :: !(Msg -> Msg)
{ _logLevel :: !Level -- ^ messages below this log level will be suppressed
, _levelMap :: !(Map Text Level) -- ^ log level per named logger
, _output :: !Output -- ^ log sink
, _format :: !(Maybe DateFormat) -- ^ the timestamp format (use 'Nothing' to disable timestamps)
, _delimiter :: !ByteString -- ^ text to intersperse between fields of a log line
, _bufSize :: !Int -- ^ how many bytes to buffer before commiting to sink
, _name :: !(Maybe Text) -- ^ logger name
, _nameMsg :: !(Msg -> Msg)
, _renderer :: !Renderer
, _readEnvironment :: !Bool -- ^ should 'new' check @LOG_*@ process environment settings?
}
output :: Settings -> Output
......@@ -82,11 +91,22 @@ setDelimiter x s = s { _delimiter = x }
-- | Whether to use <http://cr.yp.to/proto/netstrings.txt netstring>
-- encoding for log lines.
netstrings :: Settings -> Bool
netstrings = _netstrings
--
-- {#- DEPRECATED setNetStrings "Use setRendererNetstr or setRendererDefault instead" #-}
setNetStrings :: Bool -> Settings -> Settings
setNetStrings x s = s { _netstrings = x }
setNetStrings True = setRenderer $ \_ _ _ -> renderNetstr
setNetStrings False = setRenderer $ \s _ _ -> renderDefault s
-- | Shortcut for calling 'setRenderer' with 'renderNetstr'.
setRendererNetstr :: Settings -> Settings
setRendererNetstr = setRenderer $ \_ _ _ -> renderNetstr
-- | Default rendering of log lines.
--
-- Uses the value of `delimiter` as a separator of fields and '=' between
-- field names and values.
setRendererDefault :: Settings -> Settings
setRendererDefault = setRenderer $ \s _ _ -> renderDefault s
logLevel :: Settings -> Level
logLevel = _logLevel
......@@ -120,6 +140,22 @@ setName (Just xs) s = s { _name = Just xs, _nameMsg = "logger" .= xs }
nameMsg :: Settings -> (Msg -> Msg)
nameMsg = _nameMsg
-- | Output format
renderer :: Settings -> Renderer
renderer = _renderer
-- | Set a custom renderer.
--
-- See 'setRendererDefault' and 'setRendererNetstr' for two common special cases.
setRenderer :: Renderer -> Settings -> Settings
setRenderer f s = s { _renderer = f }
readEnvironment :: Settings -> Bool
readEnvironment = _readEnvironment
setReadEnvironment :: Bool -> Settings -> Settings
setReadEnvironment f s = s { _readEnvironment = f }
data Level
= Trace
| Debug
......@@ -146,21 +182,27 @@ instance IsString DateFormat where
iso8601UTC :: DateFormat
iso8601UTC = "%Y-%0m-%0dT%0H:%0M:%0SZ"
-- | Take a custom separator, date format, log level of the event, and render
-- a list of log fields or messages into a builder.
type Renderer = ByteString -> DateFormat -> Level -> [Element] -> B.Builder
-- | Default settings:
--
-- * 'logLevel' = 'Debug'
-- * 'logLevel' = 'Debug'
--
-- * 'output' = 'StdOut'
--
-- * 'output' = 'StdOut'
-- * 'format' = 'iso8601UTC'
--
-- * 'format' = 'iso8601UTC'
-- * 'delimiter' = \", \"
--
-- * 'delimiter' = \", \"
-- * 'netstrings' = False
--
-- * 'netstrings' = False
-- * 'bufSize' = 'FL.defaultBufSize'
--
-- * 'bufSize' = 'FL.defaultBufSize'
-- * 'name' = Nothing
--
-- * 'name' = Nothing
-- * 'readEnvironment' = True
--
defSettings :: Settings
defSettings = Settings
......@@ -169,7 +211,8 @@ defSettings = Settings
StdOut
(Just iso8601UTC)
", "
False
defaultBufSize
Nothing
id
(\s _ _ -> renderDefault s)
True
resolver: nightly-2018-03-24
resolver: lts-13.7
packages:
- .
extra-deps: []
flags: {}
extra-package-dbs: []
name: tinylog
version: 0.14.1
version: 0.15.0
synopsis: Simplistic logging using fast-logger.
author: Toralf Wittner
maintainer: Toralf Wittner <[email protected]>
......