heavy-logger (empty) → 0.1.0.0
raw patch · 10 files changed
+571/−0 lines, 10 filesdep +attoparsecdep +basedep +bytestringsetup-changed
Dependencies added: attoparsec, base, bytestring, fast-logger, hsyslog, monad-control, monad-logger, mtl, template-haskell, text, text-format-heavy, transformers-base
Files
- ChangeLog.md +5/−0
- LICENSE +30/−0
- README.md +26/−0
- Setup.hs +2/−0
- heavy-logger.cabal +45/−0
- src/System/Log/Heavy.hs +49/−0
- src/System/Log/Heavy/Backends.hs +167/−0
- src/System/Log/Heavy/Format.hs +66/−0
- src/System/Log/Heavy/Shortcuts.hs +55/−0
- src/System/Log/Heavy/Types.hs +126/−0
+ ChangeLog.md view
@@ -0,0 +1,5 @@+# Revision history for heavy-logger++## 0.1.0.0 -- YYYY-mm-dd++* First version. Released on an unsuspecting world.
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2017, Ilya Portnov++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Ilya Portnov nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,26 @@+heavy-logger README+===================++This is Haskell logging library, which prefers functionality and extendability over light weight and simplicity.+It can use [fast-logger][1] as backend and is compatible with [monad-logger][2] interface, so it can be used in [WAI][3] projects.+heavy-logger is integrated with [text-format-heavy][4] string formatting library.++Most notable features of heavy-logger are:++* Several backends and possibility to write your own backends. The provided backends are:+ * Fast-logger backend. It allows to write messages to stdout, stderr or arbitrary file.+ * Syslog backend.+ * Chan backend. Writes messages to a Chan, so they can be read from the other side.+* Possibility to define log message format in the output file. For example, do you want to+ see event severity level first, and then time, or vice versa?+* Possibility to easily set up message filtering based on message source and severity level.+ For example, you may want to write only Info messages, but also Debug messages from one module.+* Text formatting library integration. Formatting of messages by `text-format-heavy` is done lazily;+ so, you can issue a lot of debug messages, that include data that take time to present as a string;+ the formatting will be executed only in the case when debug output for this module is actually enabled+ by the filter.++[1]: https://hackage.haskell.org/package/fast-logger+[2]: https://hackage.haskell.org/package/monad-logger+[3]: https://hackage.haskell.org/package/wai+[4]: https://hackage.haskell.org/package/text-format-heavy
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ heavy-logger.cabal view
@@ -0,0 +1,45 @@+name: heavy-logger+version: 0.1.0.0+synopsis: Full-weight logging based on fast-logger+description: This is Haskell logging library, which prefers functionality and extendability+ over light weight and simplicity. It can use fast-logger as backend, and is compatible + with monad-logger interface, so it can be used in WAI projects.+ heavy-logger is also integrated with text-format-heavy string formatting library.+license: BSD3+license-file: LICENSE+author: Ilya Portnov+maintainer: portnov84@rambler.ru+-- copyright: +category: System+build-type: Simple+extra-source-files: ChangeLog.md+extra-doc-files: README.md+cabal-version: >=1.18++library+ exposed-modules: System.Log.Heavy+ System.Log.Heavy.Types+ System.Log.Heavy.Format+ System.Log.Heavy.Backends+ System.Log.Heavy.Shortcuts+ -- other-modules: + -- other-extensions: + build-depends: base >=4.8 && <5.0,+ mtl >= 2.2.1,+ transformers-base >= 0.4.4,+ monad-control >= 1.0.1.0,+ template-haskell >= 2.10.0,+ bytestring >= 0.10.6,+ text >= 1.2.2.1,+ attoparsec >= 0.13.1.0,+ fast-logger >= 2.4.10,+ monad-logger >= 0.3.22,+ hsyslog >= 5,+ text-format-heavy >= 0.1.2.0+ hs-source-dirs: src+ default-language: Haskell2010++Source-repository head+ type: git+ location: https://github.com/portnov/heavy-logger.git+
+ src/System/Log/Heavy.hs view
@@ -0,0 +1,49 @@+{-# LANGUAGE OverloadedStrings, TypeSynonymInstances, FlexibleInstances, ExistentialQuantification, TypeFamilies, GeneralizedNewtypeDeriving, StandaloneDeriving, MultiParamTypeClasses, UndecidableInstances #-}++-- | This is the main module of @heavy-logger@ package. You usually need to import only this module.+-- All generally required modules are re-exported.+--+-- For simple usage cases, you may also want to import System.Log.Heavy.Shortcuts module.+--+-- Example of usage is:+--+-- @+-- import System.Log.Heavy+-- import Data.Text.Format.Heavy+-- ...+--+-- withLogging backend id $ do liftIO $ putStr "Your name? "+-- liftIO $ hFlush stdout+-- name <- liftIO $ getLine+-- logMessage $ infoMessage "name was {}" (Single name)+-- liftIO $ putStrLn $ "Hello, " ++ name+-- @+--+-- See also @Test.hs@.+--+module System.Log.Heavy+ (+ -- * Reexports+ module System.Log.Heavy.Types,+ module System.Log.Heavy.Backends,+ withLogging+ ) where++import Control.Monad.Trans+import Control.Monad.Logger (LogLevel (..))+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Format.Heavy as F++import System.Log.Heavy.Types+import System.Log.Heavy.Backends++-- | Run LoggingT monad within some kind of IO monad.+withLogging :: MonadIO m+ => LogBackend -- ^ Logging backend settings+ -> (m a -> IO a) -- ^ Runner to run @m@ within @IO@. + -- For example this may be @runReader@ or @evalState@.+ -- Use @id@ for case when @m@ is @IO@.+ -> LoggingT m a -- ^ Actions within @LoggingT@ monad.+ -> m a+withLogging (LogBackend b) = withLoggingB b+
+ src/System/Log/Heavy/Backends.hs view
@@ -0,0 +1,167 @@+{-# LANGUAGE OverloadedStrings, TypeSynonymInstances, FlexibleInstances, ExistentialQuantification, TypeFamilies, GeneralizedNewtypeDeriving, StandaloneDeriving, MultiParamTypeClasses, UndecidableInstances #-}++module System.Log.Heavy.Backends+ (+ -- $description+ -- * Backends+ FastLoggerSettings (..),+ SyslogSettings (..),+ -- * Default settings+ defStdoutSettings,+ defStderrSettings,+ defFileSettings,+ defaultSyslogSettings,+ defaultSyslogFormat,+ -- * Utilities for other backends implementation+ checkLogLevel+ ) where++import Control.Monad+import Control.Monad.Trans (liftIO)+import Control.Monad.Reader+import Control.Monad.Logger (MonadLogger (..), LogLevel (..))+import Control.Concurrent+import Data.List (isPrefixOf)+import qualified Data.Text as T+import qualified Data.ByteString.Unsafe as BSU+import qualified Data.Text.Format.Heavy as F+import qualified System.Posix.Syslog as Syslog+import System.Log.FastLogger as FL++import System.Log.Heavy.Types+import System.Log.Heavy.Format++-- $description+--+-- This module contains several implementation of logging backend.+-- A backend is some kind of target, where your messages will go.+-- Each backend has its own specific settings.+--+-- Backends provided are:+--+-- * Fast-logger backend. It allows to write messages to stdout, stderr or arbitrary file.+--+-- * Syslog backend.+--+-- * Chan backend.+--++-- | Settings of fast-logger backend. This mostly reflects settings of fast-logger itself.+data FastLoggerSettings = FastLoggerSettings {+ lsFilter :: LogFilter -- ^ Log messages filter+ , lsFormat :: F.Format -- ^ Log message format+ , lsType :: FL.LogType -- ^ Fast-logger target settings+ }++-- | Default settings for fast-logger stdout output+defStdoutSettings :: FastLoggerSettings+defStdoutSettings = FastLoggerSettings defaultLogFilter defaultLogFormat (FL.LogStdout FL.defaultBufSize)++-- | Default settings for fast-logger stderr output+defStderrSettings :: FastLoggerSettings+defStderrSettings = FastLoggerSettings defaultLogFilter defaultLogFormat (FL.LogStderr FL.defaultBufSize)++-- | Default settings for fast-logger file output.+-- This implies log rotation when log file size reaches 10Mb.+defFileSettings :: FilePath -> FastLoggerSettings+defFileSettings path = FastLoggerSettings defaultLogFilter defaultLogFormat (FL.LogFile spec FL.defaultBufSize)+ where spec = FL.FileLogSpec path (10*1024*1024) 3++instance IsLogBackend FastLoggerSettings where+ -- withLogging :: (MonadIO m) => FastLoggerSettings -> (m a -> IO a) -> LoggingT m a -> m a+ withLoggingB settings runner (LoggingT actions) = do+ liftIO $ do+ tcache <- newTimeCache simpleTimeFormat'+ withTimedFastLogger tcache (lsType settings) $ \logger ->+ runner $ runReaderT actions $ mkLogger logger settings+ where+ mkLogger :: TimedFastLogger -> FastLoggerSettings -> Logger+ mkLogger logger s m = do+ let fltr = lsFilter s+ let format = lsFormat s+ when (checkLogLevel fltr m) $ do+ logger $ formatLogMessage format m++-- | Settings for syslog backend. This mostly reflects syslog API.+data SyslogSettings = SyslogSettings {+ ssFilter :: LogFilter -- ^ Log messages filter+ , ssFormat :: F.Format -- ^ Log message format. Usually you do not want to put time here,+ -- because syslog writes time to log by itself by default.+ , ssIdent :: String -- ^ Syslog source identifier. Usually the name of your program.+ , ssOptions :: [Syslog.Option] -- ^ Syslog options+ , ssFacility :: Syslog.Facility -- ^ Syslog facility. It is usally User, if you are writing user-space+ -- program.+ }++-- | Default settings for syslog backend+defaultSyslogSettings :: SyslogSettings+defaultSyslogSettings = SyslogSettings defaultLogFilter defaultSyslogFormat "application" [] Syslog.User++-- | Default log message format fof syslog backend:+-- @[{level}] {source}: {message}@+defaultSyslogFormat :: F.Format+defaultSyslogFormat = "[{level}] {source}: {message}"++instance IsLogBackend SyslogSettings where+ withLoggingB settings runner (LoggingT actions) = do+ liftIO $ do+ tcache <- newTimeCache simpleTimeFormat'+ Syslog.withSyslog (ssIdent settings) (ssOptions settings) (ssFacility settings) $ do+ let logger = mkSyslogLogger tcache settings+ runner $ runReaderT actions logger+ where+ mkSyslogLogger :: IO FormattedTime -> SyslogSettings -> Logger+ mkSyslogLogger tcache s m = do+ let fltr = ssFilter s+ format = ssFormat s+ facility = ssFacility s+ when (checkLogLevel fltr m) $ do+ time <- tcache+ let str = formatLogMessage format m time+ BSU.unsafeUseAsCStringLen (fromLogStr str) $+ Syslog.syslog (Just facility) (levelToPriority $ lmLevel m)++ levelToPriority :: LogLevel -> Syslog.Priority+ levelToPriority LevelDebug = Syslog.Debug+ levelToPriority LevelInfo = Syslog.Info+ levelToPriority LevelWarn = Syslog.Warning+ levelToPriority LevelError = Syslog.Error+ levelToPriority (LevelOther level) =+ case level of+ "Emergency" -> Syslog.Emergency+ "Alert" -> Syslog.Alert+ "Critical" -> Syslog.Critical+ "Notice" -> Syslog.Notice+ _ -> error $ "unknown log level: " ++ T.unpack level++-- | Logging backend which writes all messages to the @Chan@+data ChanLoggerSettings = ChanLoggerSettings {+ clFilter :: LogFilter -- ^ Log messages filter+ , clChan :: Chan LogMessage -- ^ @Chan@ where write messages to+ }++instance IsLogBackend ChanLoggerSettings where+ withLoggingB settings runner (LoggingT actions) = do+ runReaderT actions logger+ where+ logger m = do+ let fltr = clFilter settings+ when (checkLogLevel fltr m) $ do+ liftIO $ writeChan (clChan settings) m++-- | Check if message level matches given filter.+checkLogLevel :: LogFilter -> LogMessage -> Bool+checkLogLevel fltr m =+ case lookup (bestMatch (lmSource m) (map fst fltr)) fltr of+ Nothing -> False+ Just level -> lmLevel m >= level+ where+ bestMatch :: LogSource -> [LogSource] -> LogSource+ bestMatch src list = go [] src list++ go best src [] = best+ go best src (x:xs)+ | src == x = x+ | x `isPrefixOf` src && length x > length best = go x src xs+ | otherwise = go best src xs+
+ src/System/Log/Heavy/Format.hs view
@@ -0,0 +1,66 @@+{-# LANGUAGE OverloadedStrings, TypeSynonymInstances, FlexibleInstances, ExistentialQuantification, TypeFamilies, GeneralizedNewtypeDeriving, StandaloneDeriving, MultiParamTypeClasses, UndecidableInstances, RecordWildCards #-}++-- | This module contains definitions for formatting log message to write it to output.+--+-- Log message format is defined by using @text-format-heavy@ syntax. Variables available are:+--+-- * level - message severity level+--+-- * source - message source (module name)+--+-- * location - location from where message was logged (line in source file)+--+-- * time - message time+--+-- * message - message string itself+--+module System.Log.Heavy.Format+ ( defaultLogFormat,+ formatLogMessage+ ) where++import Control.Applicative+import Control.Monad+import Control.Monad.Logger (MonadLogger (..), LogLevel (..))+import Data.List (intersperse, intercalate)+import Data.String+import Data.Char+import Data.Maybe+import qualified Data.Text as T+import qualified Data.Text.Lazy as TL+import qualified Data.ByteString as B+-- import Data.Attoparsec.ByteString+import System.Log.FastLogger+import qualified Data.Text.Format.Heavy as F+import qualified Data.Text.Format.Heavy.Parse as PF+import Prelude hiding (takeWhile)++import System.Log.Heavy.Types++-- | Default log message format.+-- Corresponds to: @{time} [{level}] {source}: {message}\\n@+defaultLogFormat :: F.Format+defaultLogFormat = PF.parseFormat' "{time} [{level}] {source}: {message}\n"++-- | Format log message for output.+formatLogMessage :: F.Format -> LogMessage -> FormattedTime -> LogStr+formatLogMessage fmt (LogMessage {..}) ftime =+ toLogStr $ F.format fmt variables+ where+ variables :: [(TL.Text, F.Variable)]+ variables = [("level", F.Variable $ showLevel lmLevel),+ ("source", F.Variable $ intercalate "." lmSource),+ ("location", F.Variable $ show lmLocation),+ ("time", F.Variable ftime),+ ("message", F.Variable formattedMessage)]++ formattedMessage =+ let fmt = PF.parseFormat' lmFormatString+ in F.format fmt lmFormatVars++ showLevel LevelDebug = "debug"+ showLevel LevelInfo = "info"+ showLevel LevelWarn = "warning"+ showLevel LevelError = "error"+ showLevel (LevelOther x) = T.unpack x+
+ src/System/Log/Heavy/Shortcuts.hs view
@@ -0,0 +1,55 @@+{-# LANGUAGE OverloadedStrings, TypeSynonymInstances, FlexibleInstances, ExistentialQuantification, TypeFamilies, GeneralizedNewtypeDeriving, StandaloneDeriving, MultiParamTypeClasses, UndecidableInstances #-}++-- | This module contains some shortcut functions that can be of use in simple usage cases.+module System.Log.Heavy.Shortcuts+ (+ -- * Log a message+ reportError, warning, info, debug,+ -- * Creating a message+ errorMessage, warnMessage, infoMessage, debugMessage+ ) where++import Control.Monad.Trans+import Control.Monad.Logger (LogLevel (..))+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Format.Heavy as F++import System.Log.Heavy.Types+import System.Log.Heavy.Backends++-- | Message stub with Info severity.+infoMessage :: F.VarContainer vars => TL.Text -> vars -> LogMessage+infoMessage fmt vars = LogMessage LevelInfo [] undefined fmt vars++-- | Message stub with Debug severity.+debugMessage :: F.VarContainer vars => TL.Text -> vars -> LogMessage+debugMessage fmt vars = LogMessage LevelDebug [] undefined fmt vars++-- | Message stub with Error severity.+errorMessage :: F.VarContainer vars => TL.Text -> vars -> LogMessage+errorMessage fmt vars = LogMessage LevelError [] undefined fmt vars++-- | Message stub with Warning severity.+warnMessage :: F.VarContainer vars => TL.Text -> vars -> LogMessage+warnMessage fmt vars = LogMessage LevelWarn [] undefined fmt vars++-- | Log debug message.+-- Note: this message will not contain source information.+debug :: (F.VarContainer vars, MonadIO m) => TL.Text -> vars -> LoggingT m ()+debug fmt vars = logMessage $ debugMessage fmt vars++-- | Log info message.+-- Note: this message will not contain source information.+info :: (F.VarContainer vars, MonadIO m) => TL.Text -> vars -> LoggingT m ()+info fmt vars = logMessage $ infoMessage fmt vars++-- | Log error message.+-- Note: this message will not contain source information.+reportError :: (F.VarContainer vars, MonadIO m) => TL.Text -> vars -> LoggingT m ()+reportError fmt vars = logMessage $ errorMessage fmt vars++-- | Log warning message.+-- Note: this message will not contain source information.+warning :: (F.VarContainer vars, MonadIO m) => TL.Text -> vars -> LoggingT m ()+warning fmt vars = logMessage $ warnMessage fmt vars+
+ src/System/Log/Heavy/Types.hs view
@@ -0,0 +1,126 @@+{-# LANGUAGE OverloadedStrings, TypeSynonymInstances, FlexibleInstances, ExistentialQuantification, TypeFamilies, GeneralizedNewtypeDeriving, StandaloneDeriving, MultiParamTypeClasses, UndecidableInstances #-}++-- | This module contains generic types definition, along with some utilities.+module System.Log.Heavy.Types+ (+ LogSource, LogMessage (..), LogFilter,+ IsLogBackend (..), LogBackend (..), Logger,+ LoggingT (LoggingT), runLoggingT,+ defaultLogFilter,+ splitString, splitDots,+ logMessage+ ) where++import Control.Monad.Reader+import Control.Monad.Logger (MonadLogger (..), LogLevel (..))+import Control.Monad.Base+import Control.Monad.Trans.Control+import Data.String+import Language.Haskell.TH+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE+import qualified Data.Text.Lazy as TL+import System.Log.FastLogger+import qualified Data.Text.Format.Heavy as F++-- | Log message source. This is usually a list of program module names,+-- for example @[\"System\", \"Log\", \"Heavy\", \"Types\"]@.+type LogSource = [String]++-- | Log message structure+data LogMessage = forall vars. F.VarContainer vars => LogMessage {+ lmLevel :: LogLevel -- ^ Log message level+ , lmSource :: LogSource -- ^ Log message source (module)+ , lmLocation :: Loc -- ^ Log message source (exact location). You usually+ -- will want to use TH quotes to fill this.+ , lmFormatString :: TL.Text -- ^ Log message string format (in @Data.Text.Format.Heavy@ syntax)+ , lmFormatVars :: vars -- ^ Log message substitution variables. Use @()@ if you do not have variables.+ }++-- | Log messages filter by source and level.+--+-- Semantics under this is that @(source, severity)@ pair allows to write+-- messages from @source@ of @severity@ (and all more important messages) to log.+type LogFilter = [(LogSource, LogLevel)]++-- | Default log messages filter. This says pass all messages+-- of level Info or higher.+defaultLogFilter :: LogFilter+defaultLogFilter = [([], LevelInfo)]++-- | Logging backend class.+class IsLogBackend b where+ -- | Run LoggingT within some kind of IO monad+ withLoggingB :: (MonadIO m)+ => b -- ^ Backend settings+ -> (m a -> IO a) -- ^ Runner that allows to run this @m@ within @IO@+ -> LoggingT m a -- ^ Actions within @LoggingT@ monad+ -> m a++-- | A container for arbitrary logging backend.+-- You usually will use this similar to:+--+-- @+-- getLoggingSettings :: String -> LogBackend+-- getLoggingSettings "syslog" = LogBackend defaultsyslogsettings+-- @+data LogBackend = forall b. IsLogBackend b => LogBackend b++-- | Logging monad transformer.+newtype LoggingT m a = LoggingT {+ runLoggingT_ :: ReaderT Logger m a+ }+ deriving (Functor, Applicative, Monad, MonadReader Logger, MonadTrans)++deriving instance MonadIO m => MonadIO (LoggingT m)++instance MonadIO m => MonadBase IO (LoggingT m) where+ liftBase = liftIO++instance MonadTransControl LoggingT where+ type StT LoggingT a = StT (ReaderT Logger) a+ liftWith = defaultLiftWith LoggingT runLoggingT_+ restoreT = defaultRestoreT LoggingT++instance (MonadBaseControl IO m, MonadIO m) => MonadBaseControl IO (LoggingT m) where+ type StM (LoggingT m) a = ComposeSt LoggingT m a+ liftBaseWith = defaultLiftBaseWith+ restoreM = defaultRestoreM++-- | Run logging monad+runLoggingT :: LoggingT m a -> Logger -> m a+runLoggingT actions logger = runReaderT (runLoggingT_ actions) logger++-- | Logging function+type Logger = LogMessage -> IO ()++textFromLogStr :: ToLogStr str => str -> TL.Text+textFromLogStr str = TL.fromStrict $ TE.decodeUtf8 $ fromLogStr $ toLogStr str++instance MonadIO m => MonadLogger (LoggingT m) where+ monadLoggerLog loc src level msg =+ logMessage $ LogMessage level src' loc (textFromLogStr msg) ()+ where+ src' = splitDots $ T.unpack src++instance F.Formatable LogStr where+ formatVar fmt str = F.formatVar fmt $ fromLogStr str++-- | Simple implementation of splitting string by character.+splitString :: Char -> String -> [String]+splitString _ "" = []+splitString c s = let (l, s') = break (== c) s+ in l : case s' of+ [] -> []+ (_:s'') -> splitString c s''++-- | Split string by dots+splitDots :: String -> [String]+splitDots = splitString '.'++-- | Log a message+logMessage :: (MonadIO m) => LogMessage -> LoggingT m ()+logMessage m = do+ logger <- ask+ liftIO $ logger m+