log-warper 1.5.3 → 1.6.0
raw patch · 24 files changed
+1236/−1259 lines, 24 files
Files
- CHANGES.md +16/−0
- examples/Playground.hs +8/−9
- log-warper.cabal +7/−7
- src/System/Wlog.hs +10/−10
- src/System/Wlog/CanLog.hs +13/−13
- src/System/Wlog/FileUtils.hs +2/−4
- src/System/Wlog/Formatter.hs +18/−18
- src/System/Wlog/Handler.hs +0/−82
- src/System/Wlog/Handler/Roller.hs +0/−120
- src/System/Wlog/Handler/Simple.hs +0/−131
- src/System/Wlog/Handler/Syslog.hs +0/−306
- src/System/Wlog/IOLogger.hs +330/−0
- src/System/Wlog/Launcher.hs +23/−25
- src/System/Wlog/LogHandler.hs +86/−0
- src/System/Wlog/LogHandler/Roller.hs +120/−0
- src/System/Wlog/LogHandler/Simple.hs +131/−0
- src/System/Wlog/LogHandler/Syslog.hs +304/−0
- src/System/Wlog/Logger.hs +0/−373
- src/System/Wlog/LoggerConfig.hs +18/−19
- src/System/Wlog/PureLogging.hs +11/−11
- src/System/Wlog/Severity.hs +49/−4
- src/System/Wlog/Terminal.hs +72/−0
- src/System/Wlog/Wrapper.hs +0/−106
- test/Test/Wlog/RollingSpec.hs +18/−21
CHANGES.md view
@@ -1,3 +1,19 @@+1.6.0+=====++* `Error` is now printed only to `stderr`, all other messages to `stdout`.+* `Logger` severity is now `Set Severity`.+* Interface changes: functions which worked with `Severity` now work with `Set Severity`.+* Remove `releaseAllHandlers`, `streamHandlerWithLock`,+ `trapLogging`, `debugM`, `errorM`, `infoM`, `noticeM`, `warningM`.+* Rename `Wrapper` module to `Terminal`.+* Rename `Handler` module to `LogHandler`.+* Rename `Logger` module to `IOLogger`.+* Move `setSeverity` and `setSeverityMaybe` to `IOLogger`.+* Lift all functions inside `IOLogger` module to `MonadIO`.+* `handle` from `LogHandler` module is renamed to `logHandlerMessage`+ and moved out of type class `LogHandler`.+ 1.5.3 =====
examples/Playground.hs view
@@ -2,16 +2,15 @@ module Main where -import Universum+import Universum -import Data.Monoid ((<>))-import Data.Yaml.Pretty (defConfig, encodePretty)+import Data.Monoid ((<>))+import Data.Yaml.Pretty (defConfig, encodePretty) -import System.Wlog (CanLog, Severity (Debug), buildAndSetupYamlLogging,- dispatchEvents, logDebug, logError, logInfo, logNotice,- logWarning, modifyLoggerName, parseLoggerConfig,- prefixB, productionB, releaseAllHandlers, runPureLog,- termSeverityB, usingLoggerName)+import System.Wlog (CanLog, Severity (Debug), buildAndSetupYamlLogging, dispatchEvents, logDebug,+ logError, logInfo, logNotice, logWarning, modifyLoggerName, parseLoggerConfig,+ prefixB, productionB, removeAllHandlers, runPureLog, termSeverityB,+ usingLoggerName) testLoggerConfigPath :: FilePath testLoggerConfigPath = "logger-config-example.yaml"@@ -49,5 +48,5 @@ let config = (productionB <> prefixB "logs" <> termSeverityB Debug) bracket_ (buildAndSetupYamlLogging config testLoggerConfigPath)- releaseAllHandlers+ removeAllHandlers (testLogging >> showPureLog)
log-warper.cabal view
@@ -1,5 +1,5 @@ name: log-warper-version: 1.5.3+version: 1.6.0 synopsis: Flexible, configurable, monadic and pretty logging homepage: https://github.com/serokell/log-warper license: MIT@@ -20,19 +20,19 @@ System.Wlog.CanLog System.Wlog.FileUtils System.Wlog.Formatter- System.Wlog.Handler- System.Wlog.Handler.Roller- System.Wlog.Handler.Simple- System.Wlog.Handler.Syslog System.Wlog.HasLoggerName+ System.Wlog.IOLogger System.Wlog.Launcher- System.Wlog.Logger System.Wlog.LoggerConfig System.Wlog.LoggerName System.Wlog.LoggerNameBox+ System.Wlog.LogHandler+ System.Wlog.LogHandler.Roller+ System.Wlog.LogHandler.Simple+ System.Wlog.LogHandler.Syslog System.Wlog.PureLogging System.Wlog.Severity- System.Wlog.Wrapper+ System.Wlog.Terminal other-modules: System.Wlog.Color System.Wlog.MemoryQueue
src/System/Wlog.hs view
@@ -14,31 +14,31 @@ module System.Wlog ( module System.Wlog.CanLog , module System.Wlog.FileUtils- , module System.Wlog.Handler.Roller- , module System.Wlog.Handler.Simple- , module System.Wlog.Handler.Syslog , module System.Wlog.HasLoggerName+ , module System.Wlog.IOLogger , module System.Wlog.Launcher- , module System.Wlog.Logger , module System.Wlog.LoggerConfig , module System.Wlog.LoggerName , module System.Wlog.LoggerNameBox+ , module System.Wlog.LogHandler.Roller+ , module System.Wlog.LogHandler.Simple+ , module System.Wlog.LogHandler.Syslog , module System.Wlog.PureLogging , module System.Wlog.Severity- , module System.Wlog.Wrapper+ , module System.Wlog.Terminal ) where import System.Wlog.CanLog import System.Wlog.FileUtils-import System.Wlog.Handler.Roller-import System.Wlog.Handler.Simple-import System.Wlog.Handler.Syslog import System.Wlog.HasLoggerName+import System.Wlog.IOLogger import System.Wlog.Launcher-import System.Wlog.Logger import System.Wlog.LoggerConfig import System.Wlog.LoggerName import System.Wlog.LoggerNameBox+import System.Wlog.LogHandler.Roller+import System.Wlog.LogHandler.Simple+import System.Wlog.LogHandler.Syslog import System.Wlog.PureLogging import System.Wlog.Severity-import System.Wlog.Wrapper+import System.Wlog.Terminal
src/System/Wlog/CanLog.hs view
@@ -2,7 +2,6 @@ {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedLists #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE TypeFamilies #-}@@ -22,21 +21,22 @@ , logMessage ) where -import Universum+import Universum -import Control.Monad.Except (ExceptT)-import qualified Control.Monad.RWS as RWSLazy-import qualified Control.Monad.RWS.Strict as RWSStrict-import qualified Control.Monad.State.Lazy as StateLazy-import Control.Monad.Trans (MonadTrans (lift))+import Control.Monad.Except (ExceptT)+import Control.Monad.Trans (MonadTrans (lift)) -import System.Wlog.HasLoggerName (HasLoggerName (..))-import System.Wlog.Logger (logM)-import System.Wlog.LoggerName (LoggerName (..))-import System.Wlog.LoggerNameBox (LoggerNameBox (..))-import System.Wlog.Severity (Severity (..))+import System.Wlog.HasLoggerName (HasLoggerName (..))+import System.Wlog.IOLogger (logM)+import System.Wlog.LoggerName (LoggerName (..))+import System.Wlog.LoggerNameBox (LoggerNameBox (..))+import System.Wlog.Severity (Severity (..)) +import qualified Control.Monad.RWS as RWSLazy+import qualified Control.Monad.RWS.Strict as RWSStrict+import qualified Control.Monad.State.Lazy as StateLazy + -- | Type alias for constraints 'CanLog' and 'HasLoggerName'. -- We need two different type classes to support more flexible interface -- but in practice we usually use them both.@@ -56,7 +56,7 @@ dispatchMessage name sev t = lift $ dispatchMessage name sev t instance CanLog IO where- dispatchMessage name prior msg = logM name prior msg+ dispatchMessage = logM instance CanLog m => CanLog (LoggerNameBox m) instance CanLog m => CanLog (ReaderT r m)
src/System/Wlog/FileUtils.hs view
@@ -1,14 +1,12 @@-{-# LANGUAGE NoImplicitPrelude #-}- -- | Some helpers and utilites to work with files module System.Wlog.FileUtils ( whenExist ) where -import Universum+import Universum -import System.Directory (doesFileExist)+import System.Directory (doesFileExist) -- | Performs given action on file if file exists. whenExist :: MonadIO m => FilePath -> (FilePath -> m ()) -> m ()
src/System/Wlog/Formatter.hs view
@@ -1,6 +1,5 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE ViewPatterns #-} -- | -- Module : System.Wlog.Formatter@@ -29,29 +28,30 @@ , varFormatter ) where -import Universum+import Universum -import Control.Concurrent (myThreadId)-import Data.Monoid (mconcat)-import qualified Data.Text as T-import Data.Text.Lazy.Builder as B-import Data.Time (formatTime, getCurrentTime, getZonedTime)-import Data.Time.Clock (UTCTime (..))-import Data.Time.Format (FormatTime)-import Fmt (fmt, padRightF, (+|), (|+), (|++|))-import Fmt.Time (dateDashF, hmsF, subsecondF, tzNameF)+import Control.Concurrent (myThreadId)+import Data.Monoid (mconcat)+import Data.Text.Lazy.Builder as B+import Data.Time (formatTime, getCurrentTime, getZonedTime)+import Data.Time.Clock (UTCTime (..))+import Data.Time.Format (FormatTime)+import Fmt (fmt, padRightF, (+|), (|+), (|++|))+import Fmt.Time (dateDashF, hmsF, subsecondF, tzNameF) #ifndef mingw32_HOST_OS-import System.Posix.Process (getProcessID)+import System.Posix.Process (getProcessID) #endif #if MIN_VERSION_time(1,5,0)-import Data.Time.Format (defaultTimeLocale)+import Data.Time.Format (defaultTimeLocale) #else-import System.Locale (defaultTimeLocale)+import System.Locale (defaultTimeLocale) #endif -import System.Wlog.Color (colorizer)-import System.Wlog.Severity (LogRecord (..), Severity (..))+import System.Wlog.Color (colorizer)+import System.Wlog.Severity (LogRecord (..), Severity (..))++import qualified Data.Text as T ---------------------------------------------------------------------------- -- Basic formatting functionality (initially taken from hslogger)
− src/System/Wlog/Handler.hs
@@ -1,82 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE TypeFamilies #-}--{- |- Module : System.Log.Handler- Copyright : Copyright (C) 2004-2011 John Goerzen- License : BSD3-- Maintainer : John Goerzen <jgoerzen@complete.org>- Stability : provisional- Portability: portable--Definition of log handler support--For some handlers, check out "System.WLog.Handler.Simple" and-"System.WLog.Handler.Syslog".--Please see "System.WLog.Logger" for extensive documentation on the-logging system.--Written by John Goerzen, jgoerzen\@complete.org--}-module System.Wlog.Handler- ( -- * Basic Types- LogHandlerTag(..)- , LogHandler(..)- ) where--import Universum--import Data.Text.Lazy.Builder as B--import System.Wlog.Formatter (LogFormatter, nullFormatter)-import System.Wlog.LoggerName (LoggerName (..))-import System.Wlog.Severity (LogRecord (..), Severity)---- | Tag identifying handlers.-data LogHandlerTag- = HandlerFilelike FilePath- | HandlerOther String- deriving (Show, Eq)---- | This is the base class for the various log handlers. They should--- all adhere to this class.-class LogHandler a where- -- TODO it should be data/type family like in 'System.Exception'- -- | Tag of handler. Is arbitrary. Made for identification.- getTag :: a -> LogHandlerTag-- -- | Sets the log level. 'handle' will drop items beneath this- -- level.- setLevel :: a -> Severity -> a-- -- | Gets the current level.- getLevel :: a -> Severity-- -- | Set a log formatter to customize the log format for this Handler- setFormatter :: a -> LogFormatter a -> a- getFormatter :: a -> LogFormatter a- getFormatter _h = nullFormatter-- -- | Logs an event if it meets the requirements- -- given by the most recent call to 'setLevel'.- handle :: a -> LogRecord -> LoggerName -> IO ()- handle h lr@(LR pri _) logname =- when (pri >= (getLevel h)) $ do- let lName = getLoggerName logname- formattedMsg <- (getFormatter h) h lr lName- emit h formattedMsg lName-- -- | Forces an event to be logged regardless of- -- the configured level.- emit :: a -> B.Builder -> Text -> IO ()-- -- | Read back from logger (e.g. file), newest first. You specify- -- the number of (newest) logging entries. Logger can return @pure- -- []@ if this behaviour can't be emulated or store buffer.- readBack :: a -> Int -> IO [Text]-- -- | Closes the logging system, causing it to close- -- any open files, etc.- close :: a -> IO ()
− src/System/Wlog/Handler/Roller.hs
@@ -1,120 +0,0 @@--- | Custom implementation of 'LogHandler' with log rotation support.--module System.Wlog.Handler.Roller- ( InvalidRotation (..)- , RollerHandler (..)- , logIndex- , rotationFileHandler- ) where--import Control.Concurrent (modifyMVar, modifyMVar_, withMVar)-import qualified Data.Text as T-import qualified Data.Text.IO as TIO-import Data.Text.Lazy.Builder as B-import Formatting (sformat, shown, (%))-import Universum--import System.Directory (removeFile, renameFile)-import System.FilePath ((<.>))-import System.IO (Handle, IOMode (ReadWriteMode),- SeekMode (AbsoluteSeek, SeekFromEnd), hClose,- hFileSize, hFlush, hSeek)-import System.Wlog.FileUtils (whenExist)-import System.Wlog.Formatter (LogFormatter, nullFormatter)-import System.Wlog.Handler (LogHandler (..),- LogHandlerTag (HandlerFilelike))-import System.Wlog.Handler.Simple (GenericHandler (..), fileHandler)-import System.Wlog.LoggerConfig (RotationParameters (..), isValidRotation)-import System.Wlog.Severity (Severity (..))---- | Similar to 'GenericHandler'. But holds file 'Handle' inside--- mutable variable ('MVar') to be able to rotate loggers.-data RollerHandler = RollerHandler- { rhSeverity :: !Severity- , rhFormatter :: !(LogFormatter RollerHandler)- , rhFileHandle :: !(MVar Handle)- , rhWriteAction :: !(Handle -> Text -> IO ())- , rhCloseAction :: !(Handle -> IO ())- , rhFileName :: !FilePath- }--instance LogHandler RollerHandler where- getTag rh = HandlerFilelike $ rhFileName rh- setLevel rh p = rh { rhSeverity = p }- setFormatter rh f = rh { rhFormatter = f }- getLevel = rhSeverity- getFormatter = rhFormatter- readBack = rollerReadback-- emit rh bldr _ = rhWriteAction rh (error "Handler is used internally") (toText . B.toLazyText $ bldr)- close RollerHandler{..} = withMVar rhFileHandle rhCloseAction--data InvalidRotation = InvalidRotation !Text- deriving (Show, Eq)--instance Exception InvalidRotation--logIndex :: FilePath -> Int -> FilePath-logIndex handlerPath i = handlerPath <.> show i--rollerReadback :: RollerHandler -> Int -> IO [Text]-rollerReadback RollerHandler{..} logsNum = do- modifyMVar rhFileHandle $ \h -> do- hFlush h- hSeek h AbsoluteSeek 0- contents <- T.lines <$> TIO.hGetContents h- hClose h- h' <- openFile rhFileName ReadWriteMode- hSeek h' SeekFromEnd 0- pure (h', take logsNum $ reverse contents)---- TODO: correct exceptions handling here is too smart for me-rollerWriting- :: RotationParameters- -> FilePath- -> (Handle -> Text -> IO ())- -> MVar Handle- -> Handle- -> Text- -> IO ()-rollerWriting RotationParameters{..} handlerPath loggingAction varHandle _ msg =- modifyMVar_ varHandle $ \landle -> do- loggingAction landle msg- logFileSize <- fromIntegral <$> hFileSize landle- if logFileSize < rpLogLimit- then return landle- -- otherwise should rename all files and create new handle putting in MVar- else do- hClose landle- let lastIndex = fromIntegral $ rpKeepFiles - 1- for_ [lastIndex - 1,lastIndex - 2 .. 0] $ \i -> do- let oldLogFile = logIndex handlerPath i- let newLogFile = logIndex handlerPath (i + 1)- whenExist oldLogFile $ (`renameFile` newLogFile)- let zeroIndex = logIndex handlerPath 0- renameFile handlerPath zeroIndex- let lastLogFile = logIndex handlerPath lastIndex- whenExist lastLogFile removeFile- h <- openFile handlerPath ReadWriteMode- hSeek h SeekFromEnd 0- pure h---- | Create rotation logging handler.-rotationFileHandler- :: MonadIO m- => RotationParameters- -> FilePath- -> Severity- -> m RollerHandler-rotationFileHandler rp@RotationParameters{..} _ _- | not $ isValidRotation rp = liftIO $ throwM $ InvalidRotation $- sformat ("Rotation parameters must be positive: "%shown) rp-rotationFileHandler rp@RotationParameters{..} handlerPath rhSeverity = liftIO $ do- GenericHandler{..} <- fileHandler handlerPath rhSeverity- rhFileHandle <- newMVar privData- let rhWriteAction = rollerWriting rp handlerPath writeFunc rhFileHandle- pure RollerHandler { rhFormatter = nullFormatter- , rhCloseAction = closeFunc- , rhFileName = handlerPath- , ..- }
− src/System/Wlog/Handler/Simple.hs
@@ -1,131 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE TypeFamilies #-}--{- |- Module : System.Log.Handler.Simple- Copyright : Copyright (C) 2004-2011 John Goerzen- License : BSD3-- Maintainer : John Goerzen <jgoerzen@complete.org>- Stability : provisional- Portability: portable--Simple log handlers--Written by John Goerzen, jgoerzen\@complete.org--}--module System.Wlog.Handler.Simple- ( GenericHandler(..)- , defaultHandleAction-- -- * Custom handlers- , fileHandler- , streamHandler- ) where--import Control.Concurrent (modifyMVar_, withMVar)-import Control.Exception (SomeException)-import qualified Data.Text.IO as TIO-import Data.Text.Lazy.Builder as B-import Data.Typeable (Typeable)-import System.Directory (createDirectoryIfMissing)-import System.FilePath (takeDirectory)-import System.IO (Handle, IOMode (ReadWriteMode),- SeekMode (SeekFromEnd), hClose, hFlush, hSeek)-import Universum--import System.Wlog.Formatter (LogFormatter, nullFormatter)-import System.Wlog.Handler (LogHandler (..), LogHandlerTag (..))-import System.Wlog.MemoryQueue (MemoryQueue)-import System.Wlog.MemoryQueue as MQ-import System.Wlog.Severity (Severity (..))---- | A helper data type.-data GenericHandler a = GenericHandler- { severity :: !Severity- , formatter :: !(LogFormatter (GenericHandler a))- , privData :: !a- , writeFunc :: !(a -> Text -> IO ())- , closeFunc :: !(a -> IO ())- , readBackBuffer :: !(MVar (MemoryQueue Text))- , ghTag :: !LogHandlerTag- } deriving Typeable--instance Typeable a => LogHandler (GenericHandler a) where- getTag = ghTag- setLevel sh s = sh {severity = s}- getLevel sh = severity sh- setFormatter sh f = sh{formatter = f}- getFormatter sh = formatter sh- readBack sh i = withMVar (readBackBuffer sh) $ \mq' -> pure $! take i . MQ.toList $ mq'- emit sh bldr _ = (writeFunc sh) (privData sh) (toText . B.toLazyText $ bldr)- close sh = (closeFunc sh) (privData sh)---- | Default action which just prints to handle using given message.-defaultHandleAction :: Handle -> Text -> IO ()-defaultHandleAction h message =- TIO.hPutStrLn h message `catch` handleWriteException- where- handleWriteException :: SomeException -> IO ()- handleWriteException e = do- let errorMessage = "Error writing log message: "- <> show e <> " (original message: " <> message <> ")"- TIO.hPutStrLn h errorMessage---- | Creates custom write action and memory queue where write action--- updates memory queue as well.-createWriteFuncWrapper- :: (Handle -> Text -> IO ())- -> MVar ()- -> IO ( Handle -> Text -> IO ()- , MVar (MemoryQueue Text)- )-createWriteFuncWrapper action lock = do- memoryQueue <- newMVar $ MQ.newMemoryQueue $ 2 * 1024 * 1024 -- 2 MB-- let customWriteFunc :: Handle -> Text -> IO ()- customWriteFunc hdl msg = withMVar lock $ const $ do- action hdl msg-- -- Important to force the queue here, else a massive closure will- -- be retained until the queue is actually used.- modifyMVar_ memoryQueue $ \mq -> pure $! pushFront msg mq-- hFlush hdl-- return (customWriteFunc, memoryQueue)---- | Create a stream log handler. Log messages sent to this handler--- will be sent to the stream used initially. Note that the 'close'--- method will have no effect on stream handlers; it does not actually--- close the underlying stream.-streamHandler :: Handle- -> (Handle -> Text -> IO ())- -> MVar ()- -> Severity- -> IO (GenericHandler Handle)-streamHandler privData writeAction lock severity = do- (writeFunc, readBackBuffer) <- createWriteFuncWrapper writeAction lock- return GenericHandler- { formatter = nullFormatter- , closeFunc = const $ pure ()- , ghTag = HandlerOther "GenericHandler/StreamHandler"- , ..- }---- | Create a file log handler. Log messages sent to this handler--- will be sent to the filename specified, which will be opened in--- Append mode. Calling 'close' on the handler will close the file.-fileHandler :: FilePath -> Severity -> IO (GenericHandler Handle)-fileHandler fp sev = do- createDirectoryIfMissing True (takeDirectory fp)- h <- openFile fp ReadWriteMode- hSeek h SeekFromEnd 0-- lock <- newMVar ()- sh <- streamHandler h defaultHandleAction lock sev- pure $ sh { closeFunc = hClose- , ghTag = HandlerFilelike fp- }
− src/System/Wlog/Handler/Syslog.hs
@@ -1,306 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE TypeFamilies #-}--{- |- Module : System.Log.Handler.Syslog- Copyright : Copyright (C) 2004-2011 John Goerzen- License : BSD3-- Maintainer : John Goerzen <jgoerzen@complete.org>- Stability : provisional- Portability: portable--Syslog handler for the Haskell Logging Framework--Written by John Goerzen, jgoerzen\@complete.org--This module implements an interface to the Syslog service commonly-found in Unix\/Linux systems. This interface is primarily of interest to-developers of servers, as Syslog does not typically display messages in-an interactive fashion.--This module is written in pure Haskell and is capable of logging to a local-or remote machine using the Syslog protocol.--You can create a new Syslog 'LogHandler' by calling 'openlog'.--More information on the Haskell Logging Framework can be found at-"System.Log.Logger". This module can also be used outside-of the rest of that framework for those interested in that.--}--module System.Wlog.Handler.Syslog- ( SyslogHandler -- No constructors.- -- * Handler Initialization- , openlog- -- * Advanced handler initialization-#ifndef mingw32_HOST_OS- , openlog_local-#endif- , openlog_remote- , openlog_generic- -- * Data Types- , Facility(..)- , Option(..)- ) where--import qualified Control.Exception as E-import Control.Monad (void, when)-import Data.Bits (shiftL, (.|.))-import qualified Data.Text as T-import qualified Data.Text.Encoding as TE-import Data.Text.Lazy.Builder as B-import Network.BSD (getHostByName, hostAddresses)-import Network.Socket (Family, Family (..), HostName,- PortNumber, SockAddr (..), Socket,- SocketType (Datagram, Stream),- connect, socket)-import qualified Network.Socket as S-import qualified Network.Socket.ByteString as NBS-#ifndef mingw32_HOST_OS-import System.Posix.Process (getProcessID)-#endif-import qualified Data.Text.Lazy.IO as TIO-import System.IO ()-import Universum hiding (Option, identity)--import System.Wlog.Formatter (LogFormatter, varFormatter)-import System.Wlog.Handler (LogHandler (..),- LogHandlerTag (HandlerOther))-import System.Wlog.Severity (Severity (..))----code_of_pri :: Severity -> Int-code_of_pri p =- case p of- Error -> 3- Warning -> 4- Notice -> 5- Info -> 6- Debug -> 7--{- | Facilities are used by the system to determine where messages-are sent. -}--data Facility- = KERN -- ^ Kernel messages; you should likely never use this in your programs- | USER -- ^ General userland messages. Use this if nothing else is appropriate- | MAIL -- ^ E-Mail system- | DAEMON -- ^ Daemon (server process) messages- | AUTH -- ^ Authentication or security messages- | SYSLOG -- ^ Internal syslog messages; you should likely never use this in your programs- | LPR -- ^ Printer messages- | NEWS -- ^ Usenet news- | UUCP -- ^ UUCP messages- | CRON -- ^ Cron messages- | AUTHPRIV -- ^ Private authentication messages- | FTP -- ^ FTP messages- | LOCAL0 -- ^ LOCAL0 through LOCAL7 are reserved for you to customize as you wish- | LOCAL1- | LOCAL2- | LOCAL3- | LOCAL4- | LOCAL5- | LOCAL6- | LOCAL7- deriving (Eq, Show, Read)--code_of_fac :: Facility -> Int-code_of_fac f = case f of- KERN -> 0- USER -> 1- MAIL -> 2- DAEMON -> 3- AUTH -> 4- SYSLOG -> 5- LPR -> 6- NEWS -> 7- UUCP -> 8- CRON -> 9- AUTHPRIV -> 10- FTP -> 11- LOCAL0 -> 16- LOCAL1 -> 17- LOCAL2 -> 18- LOCAL3 -> 19- LOCAL4 -> 20- LOCAL5 -> 21- LOCAL6 -> 22- LOCAL7 -> 23--makeCode :: Facility -> Severity -> Int-makeCode fac pri =- let faccode = code_of_fac fac- pricode = code_of_pri pri- in (faccode `shiftL` 3) .|. pricode---- | Options for 'openlog'.-data Option- = PID -- ^ Automatically log process ID (PID) with each message- | PERROR -- ^ Send a copy of each message to stderr- deriving (Eq, Show, Read)--data SyslogHandler = SyslogHandler- { options :: [Option]- , facility :: Facility- , identity :: String- , logsocket :: Socket- , address :: SockAddr- , sock_type :: SocketType- , priority :: Severity- , formatter :: LogFormatter SyslogHandler- }--{- | Initialize the Syslog system using the local system's default interface,-\/dev\/log. Will return a new 'System.Log.Handler.LogHandler'.--On Windows, instead of using \/dev\/log, this will attempt to send-UDP messages to something listening on the syslog port (514) on localhost.--Use 'openlog_remote' if you need more control.--}--openlog :: String -- ^ The name of this program -- will be- -- prepended to every log message- -> [Option] -- ^ A list of 'Option's. The list [] is- -- perfectly valid. ['PID'] is probably- -- most common here.- -> Facility -- ^ The 'Facility' value to pass to the- -- syslog system for every message logged- -> Severity -- ^ Messages logged below this priority- -- will be ignored. To include every- -- message, set this to 'DEBUG'.- -> IO SyslogHandler -- ^ Returns the new handler-#ifdef mingw32_HOST_OS-openlog = openlog_remote AF_INET "localhost" 514-#elif darwin_HOST_OS-openlog = openlog_local "/var/run/syslog"-#else-openlog = openlog_local "/dev/log"-#endif--{- | Initialize the Syslog system using an arbitrary Unix socket (FIFO).--Not supported under Windows.--}--#ifndef mingw32_HOST_OS-openlog_local :: String -- ^ Path to FIFO- -> String -- ^ Program name- -> [Option] -- ^ 'Option's- -> Facility -- ^ Facility value- -> Severity -- ^ Severity limit- -> IO SyslogHandler-openlog_local fifopath ident options fac pri =- do (s, t) <- do -- "/dev/log" is usually Datagram,- -- but most of syslog loggers allow it to be- -- of Stream type. glibc's" openlog()"- -- does roughly the similar thing:- -- http://www.gnu.org/software/libc/manual/html_node/openlog.html-- s <- socket AF_UNIX Stream 0- tryStream s `E.catch` (onIOException (fallbackToDgram s))- openlog_generic s (SockAddrUnix fifopath) t ident options fac pri-- where onIOException :: IO a -> E.IOException -> IO a- onIOException a _ = a-- tryStream :: Socket -> IO (Socket, SocketType)- tryStream s =- do connect s (SockAddrUnix fifopath)- return (s, Stream)-- fallbackToDgram :: Socket -> IO (Socket, SocketType)- fallbackToDgram s =- do S.close s -- close Stream variant- d <- socket AF_UNIX Datagram 0- return (d, Datagram)-#endif--{- | Log to a remote server via UDP. -}-openlog_remote- :: Family -- ^ Usually AF_INET or AF_INET6; see Network.Socket- -> HostName -- ^ Remote hostname. Some use @localhost@- -> PortNumber -- ^ 514 is the default for syslog- -> String -- ^ Program name- -> [Option] -- ^ 'Option's- -> Facility -- ^ Facility value- -> Severity -- ^ Severity limit- -> IO SyslogHandler-openlog_remote fam hostname port ident options fac pri =- do- he <- getHostByName hostname- s <- socket fam Datagram 0- let addr = SockAddrInet port (fromMaybe (error "head in openlog_remote") $- head (hostAddresses he))- openlog_generic s addr Datagram ident options fac pri--{- | The most powerful initialization mechanism. Takes an open datagram-socket. -}-openlog_generic :: Socket -- ^ A datagram socket- -> SockAddr -- ^ Address for transmissions- -> SocketType -- ^ socket connection mode (stream / datagram)- -> String -- ^ Program name- -> [Option] -- ^ 'Option's- -> Facility -- ^ Facility value- -> Severity -- ^ Severity limit- -> IO SyslogHandler-openlog_generic sock addr sock_t ident opt fac pri =- return (SyslogHandler {options = opt,- facility = fac,- identity = ident,- logsocket = sock,- address = addr,- sock_type = sock_t,- priority = pri,- formatter = syslogFormatter- })--syslogFormatter :: LogFormatter SyslogHandler-syslogFormatter sh lr logname =- let format = "[$loggername/$prio] $msg"- in varFormatter [] format sh lr logname---instance LogHandler SyslogHandler where- getTag = const $ HandlerOther "SyslogHandlerTag"- setLevel sh p = sh{priority = p}- getLevel sh = priority sh- setFormatter sh f = sh{formatter = f}- getFormatter sh = formatter sh- readBack _ _ = pure []- emit sh bldr _ = do- when (elem PERROR (options sh)) (TIO.hPutStrLn stderr (B.toLazyText bldr))- pidPart <- getPidPart- void $ sendstr (toSyslogFormat (toText $ B.toLazyText bldr) pidPart)- where- prio = getLevel sh- sendstr :: Text -> IO ()- sendstr t | T.null t = pass- sendstr omsg = do- let omsg' = TE.encodeUtf8 omsg- sent <- case sock_type sh of- Datagram -> NBS.sendTo (logsocket sh) omsg' (address sh)- Stream -> NBS.send (logsocket sh) omsg'- sck ->- error $ "sysloghandler: unsupported socket type " <> show sck <>- " only datagram/stream sockets are supported"- sendstr $ T.drop (fromIntegral sent) omsg- toSyslogFormat m pidPart =- "<" <> code <> ">" <> T.pack identity' <> T.pack pidPart <> ": " <> m <> "\0"- code = show $ makeCode (facility sh) prio- identity' = identity sh- getPidPart = if elem PID (options sh)- then getPid >>= \pid -> return ("[" ++ pid ++ "]")- else return ""- getPid :: IO String- getPid =-#ifndef mingw32_HOST_OS- getProcessID >>= return . show-#else- return "windows"-#endif-- close sh = S.close (logsocket sh)
+ src/System/Wlog/IOLogger.hs view
@@ -0,0 +1,330 @@+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TupleSections #-}++{- |+ Module : System.Log.Logger+ Copyright : Copyright (C) 2004-2011 John Goerzen+ License : BSD3++ Maintainer : John Goerzen <jgoerzen@complete.org>+ Stability : provisional+ Portability: portable++Haskell Logging Framework, Primary Interface++Written by John Goerzen, jgoerzen\@complete.org++This module is a modification of "System.Log.Logger" of 'hslogger'+library. Unless proper description is written here, please use the+original documentation available on hackage/hslogger.+-}++module System.Wlog.IOLogger+ (+ -- * Basic Types+ Logger+ -- ** Re-Exported from System.Wlog+ , Severity(..)++ -- * Logging Messages+ -- ** Basic+ , logM+ , logMCond+ -- ** Utility Functions+ , removeAllHandlers++ -- * Logger Manipulation+ -- ** Finding ∨ Creating Loggers+ , getLogger, getRootLogger, rootLoggerName+ -- ** Modifying Loggers+ , addHandler, removeHandler, setHandlers+ , getLevel, setLevel, clearLevel+ -- ** Severity settings+ , setSeverities, setSeveritiesMaybe+ -- ** Saving Your Changes+ , saveGlobalLogger+ , updateGlobalLogger+ , setPrefix+ , retrieveLogContent+ ) where++import Universum++import Control.Concurrent.MVar (modifyMVar, modifyMVar_, withMVar)+import Control.Lens (makeLenses)+import Data.Maybe (fromJust)+import System.FilePath ((</>))+import System.IO.Unsafe (unsafePerformIO)++import System.Wlog.LoggerName (LoggerName (..))+import System.Wlog.LogHandler (LogHandler (getTag), LogHandlerTag (HandlerFilelike), close,+ readBack)+import System.Wlog.Severity (LogRecord (..), Severities, Severity (..), debugPlus, warningPlus)+++import qualified Data.Map as M+import qualified Data.Set as Set+import qualified Data.Text as T+import qualified Data.Text.IO as TIO++import qualified System.Wlog.LogHandler (logHandlerMessage)++---------------------------------------------------------------------------+-- Basic logger types+---------------------------------------------------------------------------++data HandlerT = forall a. LogHandler a => HandlerT a++data Logger = Logger+ { _lLevel :: Maybe Severities+ , _lHandlers :: [HandlerT]+ , _lName :: LoggerName+ } deriving (Generic)++makeLenses ''Logger++type LogTree = Map LoggerName Logger++data LogInternalState = LogInternalState+ { liTree :: LogTree+ , liPrefix :: Maybe FilePath+ } deriving (Generic)++---------------------------------------------------------------------------+-- Utilities+---------------------------------------------------------------------------++-- | The name of the root logger, which is always defined and present+-- on the system.+rootLoggerName :: LoggerName+rootLoggerName = mempty++---------------------------------------------------------------------------+-- Logger Tree Storage+---------------------------------------------------------------------------++-- | The log tree. Initialize it with a default root logger.+{-# NOINLINE logInternalState #-}+logInternalState :: MVar LogInternalState+-- note: only kick up tree if handled locally+logInternalState = unsafePerformIO $ do+ let liTree = M.singleton rootLoggerName $+ Logger { _lLevel = Just warningPlus+ , _lName = ""+ , _lHandlers = []}+ liPrefix = Nothing+ newMVar $ LogInternalState {..}++{- | Given a name, return all components of it, starting from the root.+Example return value:++>["", "MissingH", "System.Cmd.Utils", "System.Cmd.Utils.pOpen"]++-}+componentsOfName :: LoggerName -> [LoggerName]+componentsOfName (LoggerName name) =+ rootLoggerName : (LoggerName <$> (joinComp (T.splitOn "." name) ""))+ where+ joinComp [] _ = []+ joinComp (x:xs) "" = x : joinComp xs x+ joinComp (x:xs) accum =+ let newlevel = accum <> "." <> x+ in newlevel : joinComp xs newlevel++---------------------------------------------------------------------------+-- Logging With Location+---------------------------------------------------------------------------++-- | Log a message using the given logger at a given priority.+logM :: MonadIO m+ => LoggerName -- ^ Name of the logger to use+ -> Severity -- ^ Severity of this message+ -> Text -- ^ The log text itself+ -> m ()+logM logname sev msg = do+ l <- getLogger logname+ handle l (LR sev msg) (const True)++logMCond :: MonadIO m => LoggerName -> Severity -> Text -> (LogHandlerTag -> Bool) -> m ()+logMCond logname sev msg cond = do+ l <- getLogger logname+ handle l (LR sev msg) cond++---------------------------------------------------------------------------+-- Public Logger Interaction Support+---------------------------------------------------------------------------++-- | Returns the logger for the given name. If no logger with that name+-- exists, creates new loggers and any necessary parent loggers, with+-- no connected handlers.+getLogger :: MonadIO m => LoggerName -> m Logger+getLogger lname = liftIO $ modifyMVar logInternalState $ \lt@LogInternalState{..} ->+ case M.lookup lname liTree of+ Just x -> return (lt, x) -- A logger exists; return it and leave tree+ Nothing -> do+ -- Add logger(s). Then call myself to retrieve it.+ let newlt = createLoggers (componentsOfName lname) liTree+ let result = fromJust $ M.lookup lname newlt+ return (LogInternalState newlt liPrefix, result)+ where+ createLoggers :: [LoggerName] -> LogTree -> LogTree+ createLoggers [] lt = lt -- No names to add; return tree unmodified+ createLoggers (x:xs) lt = -- Add logger to tree+ createLoggers xs $+ if M.member x lt+ then lt+ else M.insert x (defaultLogger & lName .~ x) lt++ defaultLogger :: Logger+ defaultLogger = Logger Nothing [] (error "log-warper has some strange code") -- ???!??!++-- | Returns the root logger.+getRootLogger :: MonadIO m => m Logger+getRootLogger = getLogger rootLoggerName++-- | Handle a log request.+handle :: MonadIO m => Logger -> LogRecord -> (LogHandlerTag -> Bool) -> m ()+handle l lrecord@(LR sev _) handlerFilter = do+ lp <- getLoggerSeverities nm+ when (sev `Set.member` lp) $ do+ ph <- concatMap (view lHandlers) <$> parentLoggers nm+ forM_ ph $ callHandler lrecord nm+ where+ nm :: LoggerName+ nm = view lName l++ parentLoggers :: MonadIO m => LoggerName -> m [Logger]+ parentLoggers = mapM getLogger . componentsOfName++ -- Get the severity we should use. Find the first logger in the+ -- tree, starting here, with a set severity. If even root doesn't+ -- have one, assume "Debug".+ getLoggerSeverities :: MonadIO m => LoggerName -> m Severities+ getLoggerSeverities name = do+ pl <- parentLoggers name+ case catMaybes . map (view lLevel) $ (l : pl) of+ [] -> pure debugPlus+ (x:_) -> pure x++ callHandler :: MonadIO m => LogRecord -> LoggerName -> HandlerT -> m ()+ callHandler lr loggername (HandlerT x) =+ when (handlerFilter $ getTag x) $+ System.Wlog.LogHandler.logHandlerMessage x lr loggername++-- | Sets file prefix to 'LogInternalState'.+setPrefix :: MonadIO m => Maybe FilePath -> m ()+setPrefix p = liftIO+ $ modifyMVar_ logInternalState+ $ \li -> pure $ li { liPrefix = p }++-- | Add handler to 'Logger'. Returns a new 'Logger'.+addHandler :: LogHandler a => a -> Logger -> Logger+addHandler h = lHandlers %~ (HandlerT h:)++-- | Remove a handler from the 'Logger'. Handlers are removed in the reverse+-- order they were added, so the following property holds for any 'LogHandler'+-- @h@:+--+-- > removeHandler . addHandler h = id+--+-- If no handlers are associated with the 'Logger', it is returned unchanged.+--+-- The root logger's default handler that writes every message to stderr can+-- be removed by using this function before any handlers have been added+-- to the root logger:+--+-- > updateGlobalLogger rootLoggerName removeHandler+removeHandler :: Logger -> Logger+removeHandler = lHandlers %~ drop 1++-- | Set the 'Logger'\'s list of handlers to the list supplied.+-- All existing handlers are removed first.+setHandlers :: LogHandler a => [a] -> Logger -> Logger+setHandlers hl = lHandlers .~ map HandlerT hl++-- | Returns the "level" of the logger. Items beneath this+-- level will be ignored.+getLevel :: Logger -> Maybe Severities+getLevel = _lLevel++-- | Sets the "level" of the 'Logger'. Returns a new+-- 'Logger' object with the new level.+setLevel :: Severities -> Logger -> Logger+setLevel p = lLevel .~ Just p++-- | Clears the "level" of the 'Logger'. It will now inherit the level of+-- | its parent.+clearLevel :: Logger -> Logger+clearLevel = lLevel .~ Nothing++-- | Set severities for given logger. By default parent's severities are used.+setSeverities :: MonadIO m => LoggerName -> Severities -> m ()+setSeverities name = updateGlobalLogger name . setLevel++-- | Set or clear severities.+setSeveritiesMaybe+ :: MonadIO m+ => LoggerName -> Maybe Severities -> m ()+setSeveritiesMaybe name Nothing = updateGlobalLogger name clearLevel+setSeveritiesMaybe n (Just x) = setSeverities n x++-- | Updates the global record for the given logger to take into+-- account any changes you may have made.+saveGlobalLogger :: MonadIO m => Logger -> m ()+saveGlobalLogger l = liftIO $+ modifyMVar_ logInternalState $ \LogInternalState{..} ->+ pure $ LogInternalState (M.insert (view lName l) l liTree) liPrefix++-- | Helps you make changes on the given logger. Takes a function+-- that makes changes and writes those changes back to the global+-- database. Here's an example from above (\"s\" is a 'LogHandler'):+--+-- > updateGlobalLogger "MyApp.BuggyComponent"+-- > (setLevel DEBUG . setHandlers [s])+updateGlobalLogger+ :: MonadIO m+ => LoggerName -- ^ Logger name+ -> (Logger -> Logger) -- ^ Function to call+ -> m ()+updateGlobalLogger ln func = do+ l <- getLogger ln+ saveGlobalLogger (func l)++-- | Allow graceful shutdown. Release all opened files/handlers/etc.+removeAllHandlers :: MonadIO m => m ()+removeAllHandlers = liftIO $+ modifyMVar_ logInternalState $ \LogInternalState{..} -> do+ let allHandlers = M.foldr (\l r -> concat [r, view lHandlers l]) [] liTree+ mapM_ (\(HandlerT h) -> close h) allHandlers+ let newTree = map (lHandlers .~ []) liTree+ return $ LogInternalState newTree liPrefix++----------------------------------------------------------------------------+-- Retrieving logs ad-hoc+----------------------------------------------------------------------------++-- | Retrieves content of log file(s) given path (w/o '_lcFilePrefix',+-- as specified in your config). Example: there's @component.log@ in+-- config, but this function will return @[component.log.122,+-- component.log.123]@ if you want to. Content is file lines newest+-- first.+--+-- FYI: this function is implemented to avoid the following problem:+-- log-warper holds open handles to files, so trying to open log file+-- for read would result in 'IOException'.+retrieveLogContent :: (MonadIO m) => FilePath -> Maybe Int -> m [Text]+retrieveLogContent filePath linesNum =+ liftIO $ withMVar logInternalState $ \LogInternalState{..} -> do+ let filePathFull = fromMaybe "" liPrefix </> filePath+ let appropriateHandlers =+ filter (\(HandlerT h) -> getTag h == HandlerFilelike filePathFull) $+ concatMap _lHandlers $+ M.elems liTree+ let takeMaybe = maybe identity take linesNum+ case appropriateHandlers of+ [HandlerT h] -> liftIO $ readBack h 12345 -- all of them+ [] -> takeMaybe . reverse . T.lines <$> TIO.readFile filePathFull+ xs -> error $ "Found more than one (" <> show (length xs) <>+ "handle with the same filePath tag, impossible."
src/System/Wlog/Launcher.hs view
@@ -1,6 +1,5 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE ExistentialQuantification #-}-{-# LANGUAGE NoImplicitPrelude #-} -- | -- Module : System.Wlog.Parser@@ -32,30 +31,29 @@ , setupLogging ) where -import Universum+import Universum -import Control.Error.Util ((?:))-import Control.Exception (throwIO)-import qualified Data.HashMap.Strict as HM hiding (HashMap)-import Data.Time (UTCTime)-import Data.Yaml (decodeFileEither)-import System.Directory (createDirectoryIfMissing)-import System.FilePath ((</>))+import Control.Error.Util ((?:))+import Control.Exception (throwIO)+import Data.Time (UTCTime)+import Data.Yaml (decodeFileEither)+import System.Directory (createDirectoryIfMissing)+import System.FilePath ((</>)) -import System.Wlog.Formatter (centiUtcTimeF, stdoutFormatter,- stdoutFormatterTimeRounded)-import System.Wlog.Handler (LogHandler (setFormatter))-import System.Wlog.Handler.Roller (rotationFileHandler)-import System.Wlog.Handler.Simple (fileHandler)-import System.Wlog.Logger (addHandler, setPrefix, updateGlobalLogger)-import System.Wlog.LoggerConfig (HandlerWrap (..), LoggerConfig (..),- LoggerTree (..))-import System.Wlog.LoggerName (LoggerName (..))-import System.Wlog.Wrapper (Severity (Debug), initTerminalLogging,- setSeverityMaybe)+import System.Wlog.Formatter (centiUtcTimeF, stdoutFormatter, stdoutFormatterTimeRounded)+import System.Wlog.IOLogger (addHandler, setPrefix, setSeveritiesMaybe, updateGlobalLogger)+import System.Wlog.LoggerConfig (HandlerWrap (..), LoggerConfig (..), LoggerTree (..))+import System.Wlog.LoggerName (LoggerName (..))+import System.Wlog.LogHandler (LogHandler (setFormatter))+import System.Wlog.LogHandler.Roller (rotationFileHandler)+import System.Wlog.LogHandler.Simple (fileHandler)+import System.Wlog.Severity (Severities, debugPlus, severityPlus)+import System.Wlog.Terminal (initTerminalLogging) +import qualified Data.HashMap.Strict as HM hiding (HashMap)+ data HandlerFabric- = forall h . LogHandler h => HandlerFabric (FilePath -> Severity -> IO h)+ = forall h . LogHandler h => HandlerFabric (FilePath -> Severities -> IO h) -- | This function traverses 'LoggerConfig' initializing all subloggers -- with 'Severity' and redirecting output in file handlers.@@ -69,7 +67,7 @@ customTerminalAction isShowTime isShowTid- _lcTermSeverity+ (severityPlus <$> _lcTermSeverity) liftIO $ setPrefix _lcFilePrefix processLoggers mempty _lcTree@@ -90,14 +88,14 @@ processLoggers parent LoggerTree{..} = do -- This prevents logger output to appear in terminal unless (parent == mempty && isNothing consoleAction) $- setSeverityMaybe parent _ltSeverity+ setSeveritiesMaybe parent (severityPlus <$> _ltSeverity) forM_ _ltFiles $ \HandlerWrap{..} -> liftIO $ do- let fileSeverity = _ltSeverity ?: Debug+ let fileSeverities = (severityPlus <$> _ltSeverity) ?: debugPlus let handlerPath = handlerPrefix </> _hwFilePath case handlerFabric of HandlerFabric fabric -> do- let handlerCreator = fabric handlerPath fileSeverity+ let handlerCreator = fabric handlerPath fileSeverities let defFmt = (`setFormatter` stdoutFormatter timeF isShowTime isShowTid) let roundFmt r = (`setFormatter` stdoutFormatterTimeRounded timeF r) let fmt = maybe defFmt roundFmt _hwRounding
+ src/System/Wlog/LogHandler.hs view
@@ -0,0 +1,86 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}++{- |+ Module : System.Log.LogHandler+ Copyright : Copyright (C) 2004-2011 John Goerzen+ License : BSD3++ Maintainer : John Goerzen <jgoerzen@complete.org>+ Stability : provisional+ Portability: portable++Definition of log handler support++For some handlers, check out "System.WLog.Handler.Simple" and+"System.WLog.Handler.Syslog".++Please see "System.WLog.Logger" for extensive documentation on the+logging system.++Written by John Goerzen, jgoerzen\@complete.org+-}+module System.Wlog.LogHandler+ ( -- * Basic Types+ LogHandlerTag(..)+ , LogHandler(..)+ , logHandlerMessage+ ) where++import Universum++import Data.Text.Lazy.Builder as B++import System.Wlog.Formatter (LogFormatter, nullFormatter)+import System.Wlog.LoggerName (LoggerName (..))+import System.Wlog.Severity (LogRecord (..), Severities)++import qualified Data.Set as Set+++-- | Logs an event if it meets the requirements+-- given by the most recent call to 'setLevel'.+logHandlerMessage :: (MonadIO m, LogHandler a) => a -> LogRecord -> LoggerName -> m ()+logHandlerMessage h lr@(LR pri _) logname =+ when (pri `Set.member` (getLevel h)) $ do+ let lName = getLoggerName logname+ formattedMsg <- liftIO $ (getFormatter h) h lr lName+ emit h formattedMsg lName++-- | Tag identifying handlers.+data LogHandlerTag+ = HandlerFilelike FilePath+ | HandlerOther String+ deriving (Show, Eq)++-- | This is the base class for the various log handlers. They should+-- all adhere to this class.+class LogHandler a where+ -- TODO it should be data/type family like in 'System.Exception'+ -- | Tag of handler. Is arbitrary. Made for identification.+ getTag :: a -> LogHandlerTag++ -- | Sets the log level. 'handle' will drop items beneath this+ -- level.+ setLevel :: a -> Severities -> a++ -- | Gets the current level.+ getLevel :: a -> Severities++ -- | Set a log formatter to customize the log format for this Handler+ setFormatter :: a -> LogFormatter a -> a+ getFormatter :: a -> LogFormatter a+ getFormatter _h = nullFormatter++ -- | Forces an event to be logged regardless of+ -- the configured level.+ emit :: MonadIO m => a -> B.Builder -> Text -> m ()++ -- | Read back from logger (e.g. file), newest first. You specify+ -- the number of (newest) logging entries. Logger can return @pure+ -- []@ if this behaviour can't be emulated or store buffer.+ readBack :: MonadIO m => a -> Int -> m [Text]++ -- | Closes the logging system, causing it to close+ -- any open files, etc.+ close :: MonadIO m => a -> m ()
+ src/System/Wlog/LogHandler/Roller.hs view
@@ -0,0 +1,120 @@+-- | Custom implementation of 'LogHandler' with log rotation support.++module System.Wlog.LogHandler.Roller+ ( InvalidRotation (..)+ , RollerHandler (..)+ , logIndex+ , rotationFileHandler+ ) where++import Universum++import Control.Concurrent (modifyMVar, modifyMVar_, withMVar)+import Data.Text.Lazy.Builder as B+import Formatting (sformat, shown, (%))++import System.Directory (removeFile, renameFile)+import System.FilePath ((<.>))+import System.IO (Handle, IOMode (ReadWriteMode), SeekMode (AbsoluteSeek, SeekFromEnd), hClose,+ hFileSize, hFlush, hSeek)+import System.Wlog.FileUtils (whenExist)+import System.Wlog.Formatter (LogFormatter, nullFormatter)+import System.Wlog.LoggerConfig (RotationParameters (..), isValidRotation)+import System.Wlog.LogHandler (LogHandler (..), LogHandlerTag (HandlerFilelike))+import System.Wlog.LogHandler.Simple (GenericHandler (..), fileHandler)+import System.Wlog.Severity (Severities)++import qualified Data.Text as T+import qualified Data.Text.IO as TIO++-- | Similar to 'GenericHandler'. But holds file 'Handle' inside+-- mutable variable ('MVar') to be able to rotate loggers.+data RollerHandler = RollerHandler+ { rhSeverities :: !Severities+ , rhFormatter :: !(LogFormatter RollerHandler)+ , rhFileHandle :: !(MVar Handle)+ , rhWriteAction :: !(Handle -> Text -> IO ())+ , rhCloseAction :: !(Handle -> IO ())+ , rhFileName :: !FilePath+ }++instance LogHandler RollerHandler where+ getTag rh = HandlerFilelike $ rhFileName rh+ setLevel rh p = rh { rhSeverities = p }+ setFormatter rh f = rh { rhFormatter = f }+ getLevel = rhSeverities+ getFormatter = rhFormatter+ readBack = rollerReadback++ emit rh bldr _ = liftIO $ rhWriteAction rh (error "Handler is used internally") (toText . B.toLazyText $ bldr)+ close RollerHandler{..} = liftIO $ withMVar rhFileHandle rhCloseAction++data InvalidRotation = InvalidRotation !Text+ deriving (Show, Eq)++instance Exception InvalidRotation++logIndex :: FilePath -> Int -> FilePath+logIndex handlerPath i = handlerPath <.> show i++rollerReadback :: MonadIO m => RollerHandler -> Int -> m [Text]+rollerReadback RollerHandler{..} logsNum = liftIO $ do+ modifyMVar rhFileHandle $ \h -> do+ hFlush h+ hSeek h AbsoluteSeek 0+ contents <- T.lines <$> TIO.hGetContents h+ hClose h+ h' <- openFile rhFileName ReadWriteMode+ hSeek h' SeekFromEnd 0+ pure (h', take logsNum $ reverse contents)++-- TODO: correct exceptions handling here is too smart for me+rollerWriting+ :: RotationParameters+ -> FilePath+ -> (Handle -> Text -> IO ())+ -> MVar Handle+ -> Handle+ -> Text+ -> IO ()+rollerWriting RotationParameters{..} handlerPath loggingAction varHandle _ msg =+ modifyMVar_ varHandle $ \landle -> do+ loggingAction landle msg+ logFileSize <- fromIntegral <$> hFileSize landle+ if logFileSize < rpLogLimit+ then return landle+ -- otherwise should rename all files and create new handle putting in MVar+ else do+ hClose landle+ let lastIndex = fromIntegral $ rpKeepFiles - 1+ for_ [lastIndex - 1,lastIndex - 2 .. 0] $ \i -> do+ let oldLogFile = logIndex handlerPath i+ let newLogFile = logIndex handlerPath (i + 1)+ whenExist oldLogFile $ (`renameFile` newLogFile)+ let zeroIndex = logIndex handlerPath 0+ renameFile handlerPath zeroIndex+ let lastLogFile = logIndex handlerPath lastIndex+ whenExist lastLogFile removeFile+ h <- openFile handlerPath ReadWriteMode+ hSeek h SeekFromEnd 0+ pure h++-- | Create rotation logging handler.+rotationFileHandler+ :: MonadIO m+ => RotationParameters+ -> FilePath+ -> Severities+ -> m RollerHandler+rotationFileHandler rp@RotationParameters{..} _ _+ | not $ isValidRotation rp = liftIO $ throwM $ InvalidRotation $+ sformat ("Rotation parameters must be positive: "%shown) rp+rotationFileHandler rp@RotationParameters{..} handlerPath rhSeverities = liftIO $ do+ GenericHandler{..} <- fileHandler handlerPath rhSeverities+ rhFileHandle <- newMVar privData+ let rhWriteAction = rollerWriting rp handlerPath writeFunc rhFileHandle+ pure RollerHandler { rhFormatter = nullFormatter+ , rhCloseAction = closeFunc+ , rhFileName = handlerPath+ , ..+ }
+ src/System/Wlog/LogHandler/Simple.hs view
@@ -0,0 +1,131 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE TypeFamilies #-}++{- |+ Module : System.Log.Handler.Simple+ Copyright : Copyright (C) 2004-2011 John Goerzen+ License : BSD3++ Maintainer : John Goerzen <jgoerzen@complete.org>+ Stability : provisional+ Portability: portable++Simple log handlers++Written by John Goerzen, jgoerzen\@complete.org+-}++module System.Wlog.LogHandler.Simple+ ( GenericHandler(..)+ , defaultHandleAction++ -- * Custom handlers+ , fileHandler+ , streamHandler+ ) where++import Universum++import Control.Concurrent (modifyMVar_, withMVar)+import Control.Exception (SomeException)+import Data.Text.Lazy.Builder as B+import Data.Typeable (Typeable)+import System.Directory (createDirectoryIfMissing)+import System.FilePath (takeDirectory)+import System.IO (Handle, IOMode (ReadWriteMode), SeekMode (SeekFromEnd), hClose, hFlush, hSeek)++import System.Wlog.Formatter (LogFormatter, nullFormatter)+import System.Wlog.LogHandler (LogHandler (..), LogHandlerTag (..))+import System.Wlog.MemoryQueue (MemoryQueue)+import System.Wlog.MemoryQueue as MQ+import System.Wlog.Severity (Severities)++import qualified Data.Text.IO as TIO++-- | A helper data type.+data GenericHandler a = GenericHandler+ { severities :: !Severities+ , formatter :: !(LogFormatter (GenericHandler a))+ , privData :: !a+ , writeFunc :: !(a -> Text -> IO ())+ , closeFunc :: !(a -> IO ())+ , readBackBuffer :: !(MVar (MemoryQueue Text))+ , ghTag :: !LogHandlerTag+ } deriving Typeable++instance Typeable a => LogHandler (GenericHandler a) where+ getTag = ghTag+ setLevel sh s = sh {severities = s}+ getLevel sh = severities sh+ setFormatter sh f = sh{formatter = f}+ getFormatter sh = formatter sh+ readBack sh i = liftIO $ withMVar (readBackBuffer sh) $ \mq' -> pure $! take i . MQ.toList $ mq'+ emit sh bldr _ = liftIO $ (writeFunc sh) (privData sh) (toText . B.toLazyText $ bldr)+ close sh = liftIO $ (closeFunc sh) (privData sh)++-- | Default action which just prints to handle using given message.+defaultHandleAction :: Handle -> Text -> IO ()+defaultHandleAction h message =+ TIO.hPutStrLn h message `catch` handleWriteException+ where+ handleWriteException :: SomeException -> IO ()+ handleWriteException e = do+ let errorMessage = "Error writing log message: "+ <> show e <> " (original message: " <> message <> ")"+ TIO.hPutStrLn h errorMessage++-- | Creates custom write action and memory queue where write action+-- updates memory queue as well.+createWriteFuncWrapper+ :: (Handle -> Text -> IO ())+ -> MVar ()+ -> IO ( Handle -> Text -> IO ()+ , MVar (MemoryQueue Text)+ )+createWriteFuncWrapper action lock = do+ memoryQueue <- newMVar $ MQ.newMemoryQueue $ 2 * 1024 * 1024 -- 2 MB++ let customWriteFunc :: Handle -> Text -> IO ()+ customWriteFunc hdl msg = withMVar lock $ const $ do+ action hdl msg++ -- Important to force the queue here, else a massive closure will+ -- be retained until the queue is actually used.+ modifyMVar_ memoryQueue $ \mq -> pure $! pushFront msg mq++ hFlush hdl++ return (customWriteFunc, memoryQueue)++-- | Create a stream log handler. Log messages sent to this handler+-- will be sent to the stream used initially. Note that the 'close'+-- method will have no effect on stream handlers; it does not actually+-- close the underlying stream.+streamHandler :: Handle+ -> (Handle -> Text -> IO ())+ -> MVar ()+ -> Severities+ -> IO (GenericHandler Handle)+streamHandler privData writeAction lock severities = do+ (writeFunc, readBackBuffer) <- createWriteFuncWrapper writeAction lock+ return GenericHandler+ { formatter = nullFormatter+ , closeFunc = const $ pure ()+ , ghTag = HandlerOther "GenericHandler/StreamHandler"+ , ..+ }++-- | Create a file log handler. Log messages sent to this handler+-- will be sent to the filename specified, which will be opened in+-- Append mode. Calling 'close' on the handler will close the file.+fileHandler :: FilePath -> Severities -> IO (GenericHandler Handle)+fileHandler fp sev = do+ createDirectoryIfMissing True (takeDirectory fp)+ h <- openFile fp ReadWriteMode+ hSeek h SeekFromEnd 0++ lock <- newMVar ()+ sh <- streamHandler h defaultHandleAction lock sev+ pure $ sh { closeFunc = hClose+ , ghTag = HandlerFilelike fp+ }
+ src/System/Wlog/LogHandler/Syslog.hs view
@@ -0,0 +1,304 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE TypeFamilies #-}++{- |+ Module : System.Log.LogHandler.Syslog+ Copyright : Copyright (C) 2004-2011 John Goerzen+ License : BSD3++ Maintainer : John Goerzen <jgoerzen@complete.org>+ Stability : provisional+ Portability: portable++Syslog handler for the Haskell Logging Framework++Written by John Goerzen, jgoerzen\@complete.org++This module implements an interface to the Syslog service commonly+found in Unix\/Linux systems. This interface is primarily of interest to+developers of servers, as Syslog does not typically display messages in+an interactive fashion.++This module is written in pure Haskell and is capable of logging to a local+or remote machine using the Syslog protocol.++You can create a new Syslog 'LogHandler' by calling 'openlog'.++More information on the Haskell Logging Framework can be found at+"System.Log.Logger". This module can also be used outside+of the rest of that framework for those interested in that.+-}++module System.Wlog.LogHandler.Syslog+ ( SyslogHandler -- No constructors.+ -- * Handler Initialization+ , openlog+ -- * Advanced handler initialization+#ifndef mingw32_HOST_OS+ , openlog_local+#endif+ , openlog_remote+ , openlog_generic+ -- * Data Types+ , Facility(..)+ , Option(..)+ ) where++import Universum hiding (Option, identity)++import Control.Monad (void, when)+import Data.Bits (shiftL, (.|.))+import Data.Text.Lazy.Builder as B+import Network.BSD (getHostByName, hostAddresses)+import Network.Socket (Family, Family (..), HostName, PortNumber, SockAddr (..), Socket,+ SocketType (Datagram, Stream), connect, socket)+#ifndef mingw32_HOST_OS+import System.Posix.Process (getProcessID)+#endif+import System.IO ()++import System.Wlog.Formatter (LogFormatter, varFormatter)+import System.Wlog.LogHandler (LogHandler (..), LogHandlerTag (HandlerOther))+import System.Wlog.Severity (Severities, Severity (..))+++import qualified Control.Exception as E+import qualified Data.Set as Set+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE+import qualified Data.Text.Lazy.IO as TIO+import qualified Network.Socket as S+import qualified Network.Socket.ByteString as NBS++code_of_sev :: Severities -> Int+code_of_sev sevs =+ case fromMaybe Debug (Set.lookupMin sevs) of+ Error -> 3+ Warning -> 4+ Notice -> 5+ Info -> 6+ Debug -> 7++{- | Facilities are used by the system to determine where messages+are sent. -}++data Facility+ = KERN -- ^ Kernel messages; you should likely never use this in your programs+ | USER -- ^ General userland messages. Use this if nothing else is appropriate+ | MAIL -- ^ E-Mail system+ | DAEMON -- ^ Daemon (server process) messages+ | AUTH -- ^ Authentication or security messages+ | SYSLOG -- ^ Internal syslog messages; you should likely never use this in your programs+ | LPR -- ^ Printer messages+ | NEWS -- ^ Usenet news+ | UUCP -- ^ UUCP messages+ | CRON -- ^ Cron messages+ | AUTHPRIV -- ^ Private authentication messages+ | FTP -- ^ FTP messages+ | LOCAL0 -- ^ LOCAL0 through LOCAL7 are reserved for you to customize as you wish+ | LOCAL1+ | LOCAL2+ | LOCAL3+ | LOCAL4+ | LOCAL5+ | LOCAL6+ | LOCAL7+ deriving (Eq, Show, Read)++code_of_fac :: Facility -> Int+code_of_fac f = case f of+ KERN -> 0+ USER -> 1+ MAIL -> 2+ DAEMON -> 3+ AUTH -> 4+ SYSLOG -> 5+ LPR -> 6+ NEWS -> 7+ UUCP -> 8+ CRON -> 9+ AUTHPRIV -> 10+ FTP -> 11+ LOCAL0 -> 16+ LOCAL1 -> 17+ LOCAL2 -> 18+ LOCAL3 -> 19+ LOCAL4 -> 20+ LOCAL5 -> 21+ LOCAL6 -> 22+ LOCAL7 -> 23++makeCode :: Facility -> Set Severity -> Int+makeCode fac sevs =+ let faccode = code_of_fac fac+ pricode = code_of_sev sevs+ in (faccode `shiftL` 3) .|. pricode++-- | Options for 'openlog'.+data Option+ = PID -- ^ Automatically log process ID (PID) with each message+ | PERROR -- ^ Send a copy of each message to stderr+ deriving (Eq, Show, Read)++data SyslogHandler = SyslogHandler+ { options :: [Option]+ , facility :: Facility+ , identity :: String+ , logsocket :: Socket+ , address :: SockAddr+ , sock_type :: SocketType+ , severities :: Set Severity+ , formatter :: LogFormatter SyslogHandler+ }++{- | Initialize the Syslog system using the local system's default interface,+\/dev\/log. Will return a new 'System.Log.Handler.LogHandler'.++On Windows, instead of using \/dev\/log, this will attempt to send+UDP messages to something listening on the syslog port (514) on localhost.++Use 'openlog_remote' if you need more control.+-}++openlog :: String -- ^ The name of this program -- will be+ -- prepended to every log message+ -> [Option] -- ^ A list of 'Option's. The list [] is+ -- perfectly valid. ['PID'] is probably+ -- most common here.+ -> Facility -- ^ The 'Facility' value to pass to the+ -- syslog system for every message logged+ -> Severities -- ^ Messages logged below this priority+ -- will be ignored. To include every+ -- message, set this to 'DEBUG'.+ -> IO SyslogHandler -- ^ Returns the new handler+#ifdef mingw32_HOST_OS+openlog = openlog_remote AF_INET "localhost" 514+#elif darwin_HOST_OS+openlog = openlog_local "/var/run/syslog"+#else+openlog = openlog_local "/dev/log"+#endif++{- | Initialize the Syslog system using an arbitrary Unix socket (FIFO).++Not supported under Windows.+-}++#ifndef mingw32_HOST_OS+openlog_local :: String -- ^ Path to FIFO+ -> String -- ^ Program name+ -> [Option] -- ^ 'Option's+ -> Facility -- ^ Facility value+ -> Severities -- ^ Severities+ -> IO SyslogHandler+openlog_local fifopath ident options fac sevs =+ do (s, t) <- do -- "/dev/log" is usually Datagram,+ -- but most of syslog loggers allow it to be+ -- of Stream type. glibc's" openlog()"+ -- does roughly the similar thing:+ -- http://www.gnu.org/software/libc/manual/html_node/openlog.html++ s <- socket AF_UNIX Stream 0+ tryStream s `E.catch` (onIOException (fallbackToDgram s))+ openlog_generic s (SockAddrUnix fifopath) t ident options fac sevs++ where onIOException :: IO a -> E.IOException -> IO a+ onIOException a _ = a++ tryStream :: Socket -> IO (Socket, SocketType)+ tryStream s =+ do connect s (SockAddrUnix fifopath)+ return (s, Stream)++ fallbackToDgram :: Socket -> IO (Socket, SocketType)+ fallbackToDgram s =+ do S.close s -- close Stream variant+ d <- socket AF_UNIX Datagram 0+ return (d, Datagram)+#endif++{- | Log to a remote server via UDP. -}+openlog_remote+ :: Family -- ^ Usually AF_INET or AF_INET6; see Network.Socket+ -> HostName -- ^ Remote hostname. Some use @localhost@+ -> PortNumber -- ^ 514 is the default for syslog+ -> String -- ^ Program name+ -> [Option] -- ^ 'Option's+ -> Facility -- ^ Facility value+ -> Severities -- ^ Severity limit+ -> IO SyslogHandler+openlog_remote fam hostname port ident options fac sevs =+ do+ he <- getHostByName hostname+ s <- socket fam Datagram 0+ let addr = SockAddrInet port (fromMaybe (error "head in openlog_remote") $+ head (hostAddresses he))+ openlog_generic s addr Datagram ident options fac sevs++{- | The most powerful initialization mechanism. Takes an open datagram+socket. -}+openlog_generic :: Socket -- ^ A datagram socket+ -> SockAddr -- ^ Address for transmissions+ -> SocketType -- ^ socket connection mode (stream / datagram)+ -> String -- ^ Program name+ -> [Option] -- ^ 'Option's+ -> Facility -- ^ Facility value+ -> Severities -- ^ Severity limit+ -> IO SyslogHandler+openlog_generic sock addr sock_t ident opt fac sevs =+ return (SyslogHandler { options = opt,+ facility = fac,+ identity = ident,+ logsocket = sock,+ address = addr,+ sock_type = sock_t,+ severities = sevs,+ formatter = syslogFormatter+ })++syslogFormatter :: LogFormatter SyslogHandler+syslogFormatter sh lr logname =+ let format = "[$loggername/$prio] $msg"+ in varFormatter [] format sh lr logname+++instance LogHandler SyslogHandler where+ getTag = const $ HandlerOther "SyslogHandlerTag"+ setLevel sh s = sh{severities = s}+ getLevel sh = severities sh+ setFormatter sh f = sh{formatter = f}+ getFormatter sh = formatter sh+ readBack _ _ = pure []+ emit sh bldr _ = liftIO $ do+ when (elem PERROR (options sh)) (TIO.hPutStrLn stderr (B.toLazyText bldr))+ pidPart <- getPidPart+ void $ sendstr (toSyslogFormat (toText $ B.toLazyText bldr) pidPart)+ where+ prio = getLevel sh+ sendstr :: Text -> IO ()+ sendstr t | T.null t = pass+ sendstr omsg = do+ let omsg' = TE.encodeUtf8 omsg+ sent <- case sock_type sh of+ Datagram -> NBS.sendTo (logsocket sh) omsg' (address sh)+ Stream -> NBS.send (logsocket sh) omsg'+ sck ->+ error $ "sysloghandler: unsupported socket type " <> show sck <>+ " only datagram/stream sockets are supported"+ sendstr $ T.drop (fromIntegral sent) omsg+ toSyslogFormat m pidPart =+ "<" <> code <> ">" <> T.pack identity' <> T.pack pidPart <> ": " <> m <> "\0"+ code = show $ makeCode (facility sh) prio+ identity' = identity sh+ getPidPart = if elem PID (options sh)+ then getPid >>= \pid -> return ("[" ++ pid ++ "]")+ else return ""+ getPid :: IO String+ getPid =+#ifndef mingw32_HOST_OS+ getProcessID >>= return . show+#else+ return "windows"+#endif++ close = liftIO . S.close . logsocket
− src/System/Wlog/Logger.hs
@@ -1,373 +0,0 @@-{-# LANGUAGE ExistentialQuantification #-}-{-# LANGUAGE MultiWayIf #-}-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TupleSections #-}--{- |- Module : System.Log.Logger- Copyright : Copyright (C) 2004-2011 John Goerzen- License : BSD3-- Maintainer : John Goerzen <jgoerzen@complete.org>- Stability : provisional- Portability: portable--Haskell Logging Framework, Primary Interface--Written by John Goerzen, jgoerzen\@complete.org--This module is a modification of "System.Log.Logger" of 'hslogger'-library. Unless proper description is written here, please use the-original documentation available on hackage/hslogger.--}--module System.Wlog.Logger- (- -- * Basic Types- Logger- -- ** Re-Exported from System.Wlog- , Severity(..)-- -- * Logging Messages- -- ** Basic- , logM- , logMCond- -- ** Utility Functions- , debugM, infoM, noticeM, warningM, errorM- , removeAllHandlers- , traplogging- -- ** Logging to a particular Logger by object- , logL- , logLCond-- -- * Logger Manipulation- -- ** Finding ∨ Creating Loggers- , getLogger, getRootLogger, rootLoggerName- -- ** Modifying Loggers- , addHandler, removeHandler, setHandlers- , getLevel, setLevel, clearLevel- -- ** Saving Your Changes- , saveGlobalLogger- , updateGlobalLogger- , setPrefix- , retrieveLogContent- ) where--import Universum--import Control.Concurrent.MVar (modifyMVar, modifyMVar_, withMVar)-import Control.Lens (makeLenses)-import qualified Data.Map as M-import Data.Maybe (fromJust)-import qualified Data.Text as T-import qualified Data.Text.IO as TIO-import System.FilePath ((</>))-import System.IO.Unsafe (unsafePerformIO)--import System.Wlog.Handler (LogHandler (getTag),- LogHandlerTag (HandlerFilelike), close,- readBack)-import qualified System.Wlog.Handler (handle)-import System.Wlog.LoggerName (LoggerName (..))-import System.Wlog.Severity (LogRecord (..), Severity (..))--------------------------------------------------------------------------------- Basic logger types------------------------------------------------------------------------------data HandlerT = forall a. LogHandler a => HandlerT a--data Logger = Logger- { _lLevel :: Maybe Severity- , _lHandlers :: [HandlerT]- , _lName :: LoggerName- } deriving (Generic)--makeLenses ''Logger--type LogTree = Map LoggerName Logger--data LogInternalState = LogInternalState- { liTree :: LogTree- , liPrefix :: Maybe FilePath- } deriving (Generic)-------------------------------------------------------------------------------- Utilities-------------------------------------------------------------------------------- | The name of the root logger, which is always defined and present--- on the system.-rootLoggerName :: LoggerName-rootLoggerName = mempty-------------------------------------------------------------------------------- Logger Tree Storage-------------------------------------------------------------------------------- | The log tree. Initialize it with a default root logger.-{-# NOINLINE logInternalState #-}-logInternalState :: MVar LogInternalState--- note: only kick up tree if handled locally-logInternalState = unsafePerformIO $ do- let liTree = M.singleton rootLoggerName $- Logger { _lLevel = Just Warning- , _lName = ""- , _lHandlers = []}- liPrefix = Nothing- newMVar $ LogInternalState {..}--{- | Given a name, return all components of it, starting from the root.-Example return value:-->["", "MissingH", "System.Cmd.Utils", "System.Cmd.Utils.pOpen"]---}-componentsOfName :: LoggerName -> [LoggerName]-componentsOfName (LoggerName name) =- rootLoggerName : (LoggerName <$> (joinComp (T.splitOn "." name) ""))- where- joinComp [] _ = []- joinComp (x:xs) "" = x : joinComp xs x- joinComp (x:xs) accum =- let newlevel = accum <> "." <> x- in newlevel : joinComp xs newlevel-------------------------------------------------------------------------------- Logging With Location-------------------------------------------------------------------------------- | Log a message using the given logger at a given priority.-logM :: LoggerName -- ^ Name of the logger to use- -> Severity -- ^ Severity of this message- -> Text -- ^ The log text itself- -> IO ()-logM logname pri msg = do- l <- getLogger logname- logL l pri msg--logMCond :: LoggerName -> Severity -> Text -> (LogHandlerTag -> Bool) -> IO ()-logMCond logname sev msg cond = do- l <- getLogger logname- logLCond l sev msg cond-------------------------------------------------------------------------------- Utility functions------------------------------------------------------------------------------{- | Log a message at 'Debug' priority -}-debugM :: LoggerName -- ^ Logger name- -> Text -- ^ Log message- -> IO ()-debugM s = logM s Debug--{- | Log a message at 'Info' priority -}-infoM :: LoggerName -- ^ Logger name- -> Text -- ^ Log message- -> IO ()-infoM s = logM s Info--{- | Log a message at 'Notice' priority -}-noticeM :: LoggerName -- ^ Logger name- -> Text -- ^ Log message- -> IO ()-noticeM s = logM s Notice--{- | Log a message at 'Warning' priority -}-warningM :: LoggerName -- ^ Logger name- -> Text -- ^ Log message- -> IO ()-warningM s = logM s Warning--{- | Log a message at 'Error' priority -}-errorM :: LoggerName -- ^ Logger name- -> Text -- ^ Log message- -> IO ()-errorM s = logM s Error-------------------------------------------------------------------------------- Public Logger Interaction Support-------------------------------------------------------------------------------- | Returns the logger for the given name. If no logger with that name--- exists, creates new loggers and any necessary parent loggers, with--- no connected handlers.-getLogger :: LoggerName -> IO Logger-getLogger lname = modifyMVar logInternalState $ \lt@LogInternalState{..} ->- case M.lookup lname liTree of- Just x -> return (lt, x) -- A logger exists; return it and leave tree- Nothing -> do- -- Add logger(s). Then call myself to retrieve it.- let newlt = createLoggers (componentsOfName lname) liTree- let result = fromJust $ M.lookup lname newlt- return (LogInternalState newlt liPrefix, result)- where- createLoggers :: [LoggerName] -> LogTree -> LogTree- createLoggers [] lt = lt -- No names to add; return tree unmodified- createLoggers (x:xs) lt = -- Add logger to tree- createLoggers xs $- if M.member x lt- then lt- else M.insert x (defaultLogger & lName .~ x) lt- defaultLogger = Logger Nothing [] (error "log-warper has some strange code") -- ???!??!---- | Returns the root logger.-getRootLogger :: IO Logger-getRootLogger = getLogger rootLoggerName---- | Log a message, assuming the current logger's level permits it.-logL :: Logger -> Severity -> Text -> IO ()-logL l pri msg = handle l (LR pri msg) (const True)---- | Logs a message with condition.-logLCond :: Logger -> Severity -> Text -> (LogHandlerTag -> Bool) -> IO ()-logLCond l pri msg = handle l (LR pri msg)---- | Handle a log request.-handle :: Logger -> LogRecord -> (LogHandlerTag -> Bool) -> IO ()-handle l lrecord@(LR sev _) handlerFilter = do- lp <- getLoggerSeverity nm- when (sev >= lp) $ do- ph <- concatMap (view lHandlers) <$> parentLoggers nm- forM_ ph $ callHandler lrecord nm- where- nm = view lName l- parentLoggers :: LoggerName -> IO [Logger]- parentLoggers = mapM getLogger . componentsOfName- -- Get the severity we should use. Find the first logger in the- -- tree, starting here, with a set severity. If even root doesn't- -- have one, assume "Debug".- getLoggerSeverity :: LoggerName -> IO Severity- getLoggerSeverity name = do- pl <- parentLoggers name- case catMaybes . map (view lLevel) $ (l : pl) of- [] -> pure Debug- (x:_) -> pure x- callHandler :: LogRecord -> LoggerName -> HandlerT -> IO ()- callHandler lr loggername (HandlerT x) =- when (handlerFilter $ getTag x) $- System.Wlog.Handler.handle x lr loggername---- | Sets file prefix to 'LogInternalState'.-setPrefix :: Maybe FilePath -> IO ()-setPrefix p = modifyMVar_ logInternalState $ \li -> pure $ li { liPrefix = p }---- | Add handler to 'Logger'. Returns a new 'Logger'.-addHandler :: LogHandler a => a -> Logger -> Logger-addHandler h = lHandlers %~ (HandlerT h:)---- | Remove a handler from the 'Logger'. Handlers are removed in the reverse--- order they were added, so the following property holds for any 'LogHandler'--- @h@:------ > removeHandler . addHandler h = id------ If no handlers are associated with the 'Logger', it is returned unchanged.------ The root logger's default handler that writes every message to stderr can--- be removed by using this function before any handlers have been added--- to the root logger:------ > updateGlobalLogger rootLoggerName removeHandler-removeHandler :: Logger -> Logger-removeHandler = lHandlers %~ drop 1---- | Set the 'Logger'\'s list of handlers to the list supplied.--- All existing handlers are removed first.-setHandlers :: LogHandler a => [a] -> Logger -> Logger-setHandlers hl = lHandlers .~ map HandlerT hl---- | Returns the "level" of the logger. Items beneath this--- level will be ignored.-getLevel :: Logger -> Maybe Severity-getLevel = _lLevel---- | Sets the "level" of the 'Logger'. Returns a new--- 'Logger' object with the new level.-setLevel :: Severity -> Logger -> Logger-setLevel p = lLevel .~ Just p---- | Clears the "level" of the 'Logger'. It will now inherit the level of--- | its parent.-clearLevel :: Logger -> Logger-clearLevel = lLevel .~ Nothing---- | Updates the global record for the given logger to take into--- account any changes you may have made.-saveGlobalLogger :: Logger -> IO ()-saveGlobalLogger l =- modifyMVar_ logInternalState $ \LogInternalState{..} ->- pure $ LogInternalState (M.insert (view lName l) l liTree) liPrefix---- | Helps you make changes on the given logger. Takes a function--- that makes changes and writes those changes back to the global--- database. Here's an example from above (\"s\" is a 'LogHandler'):------ > updateGlobalLogger "MyApp.BuggyComponent"--- > (setLevel DEBUG . setHandlers [s])-updateGlobalLogger- :: LoggerName -- ^ Logger name- -> (Logger -> Logger) -- ^ Function to call- -> IO ()-updateGlobalLogger ln func =- do l <- getLogger ln- saveGlobalLogger (func l)---- | Allow graceful shutdown. Release all opened files/handlers/etc.-removeAllHandlers :: IO ()-removeAllHandlers =- modifyMVar_ logInternalState $ \LogInternalState{..} -> do- let allHandlers = M.foldr (\l r -> concat [r, view lHandlers l]) [] liTree- mapM_ (\(HandlerT h) -> close h) allHandlers- let newTree = map (lHandlers .~ []) liTree- return $ LogInternalState newTree liPrefix---- | Traps exceptions that may occur, logging them, then passing them on.------ Takes a logger name, priority, leading description text (you can set it to--- @\"\"@ if you don't want any), and action to run.-traplogging :: LoggerName -- ^ Logger name- -> Severity -- ^ Logging priority- -> Text -- ^ Descriptive text to prepend to logged messages- -> IO a -- ^ Action to run- -> IO a -- ^ Return value-traplogging logger priority desc action = action `catch` handler- where- realdesc =- case desc of- "" -> ""- x -> x <> ": "- handler :: SomeException -> IO a- handler e = do- logM logger priority (realdesc <> show e)- throwM e -- Re-raise it--------------------------------------------------------------------------------- Retrieving logs ad-hoc--------------------------------------------------------------------------------- | Retrieves content of log file(s) given path (w/o '_lcFilePrefix',--- as specified in your config). Example: there's @component.log@ in--- config, but this function will return @[component.log.122,--- component.log.123]@ if you want to. Content is file lines newest--- first.------ FYI: this function is implemented to avoid the following problem:--- log-warper holds open handles to files, so trying to open log file--- for read would result in 'IOException'.-retrieveLogContent :: (MonadIO m) => FilePath -> Maybe Int -> m [Text]-retrieveLogContent filePath linesNum =- liftIO $ withMVar logInternalState $ \LogInternalState{..} -> do- let filePathFull = fromMaybe "" liPrefix </> filePath- let appropriateHandlers =- filter (\(HandlerT h) -> getTag h == HandlerFilelike filePathFull) $- concatMap _lHandlers $- M.elems liTree- let takeMaybe = maybe identity take linesNum- case appropriateHandlers of- [HandlerT h] -> liftIO $ readBack h 12345 -- all of them- [] -> takeMaybe . reverse . T.lines <$> TIO.readFile filePathFull- xs -> error $ "Found more than one (" <> show (length xs) <>- "handle with the same filePath tag, impossible."
src/System/Wlog/LoggerConfig.hs view
@@ -1,5 +1,4 @@ {-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-}@@ -55,26 +54,26 @@ , termSeverityB ) where -import Universum+import Universum -import Control.Lens (at, makeLenses, zoom, _Just)-import Control.Monad.State (put)-import Data.Aeson (withObject)-import qualified Data.HashMap.Strict as HM hiding (HashMap)-import Data.Monoid (Any (..))-import Data.Text (Text)-import qualified Data.Text.Buildable as Buildable-import Data.Traversable (for)-import Data.Word (Word64)-import Data.Yaml (FromJSON (..), ToJSON (..), Value (Object),- object, (.!=), (.:), (.:?), (.=))-import Formatting (bprint, shown)-import GHC.Generics (Generic)-import System.FilePath (normalise)+import Control.Lens (at, makeLenses, zoom, _Just)+import Control.Monad.State (put)+import Data.Aeson (withObject)+import Data.Monoid (Any (..))+import Data.Text (Text)+import Data.Traversable (for)+import Data.Word (Word64)+import Data.Yaml (FromJSON (..), ToJSON (..), Value (Object), object, (.!=), (.:), (.:?), (.=))+import Formatting (bprint, shown)+import GHC.Generics (Generic)+import System.FilePath (normalise) -import System.Wlog.Handler.Simple (defaultHandleAction)-import System.Wlog.LoggerName (LoggerName)-import System.Wlog.Severity (Severity)+import System.Wlog.LoggerName (LoggerName)+import System.Wlog.LogHandler.Simple (defaultHandleAction)+import System.Wlog.Severity (Severity)++import qualified Data.HashMap.Strict as HM hiding (HashMap)+import qualified Data.Text.Buildable as Buildable ---------------------------------------------------------------------------- -- Utilites & helpers
src/System/Wlog/PureLogging.hs view
@@ -1,7 +1,6 @@ {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedLists #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE TypeFamilies #-}@@ -25,18 +24,19 @@ , logPureAction ) where -import Universum+import Universum -import Control.Monad.Morph (MFunctor (..))-import Control.Monad.State.Strict (modify')-import Control.Monad.Trans (MonadTrans (lift))-import qualified Data.DList as DL (DList, snoc)+import Control.Monad.Morph (MFunctor (..))+import Control.Monad.State.Strict (modify')+import Control.Monad.Trans (MonadTrans (lift)) -import System.Wlog.CanLog (CanLog (..), WithLogger)-import System.Wlog.HasLoggerName (HasLoggerName (..))-import System.Wlog.LoggerName (LoggerName (..))-import System.Wlog.LoggerNameBox (LoggerNameBox (..), usingLoggerName)-import System.Wlog.Severity (Severity (..))+import System.Wlog.CanLog (CanLog (..), WithLogger)+import System.Wlog.HasLoggerName (HasLoggerName (..))+import System.Wlog.LoggerName (LoggerName (..))+import System.Wlog.LoggerNameBox (LoggerNameBox (..), usingLoggerName)+import System.Wlog.Severity (Severity (..))++import qualified Data.DList as DL (DList, snoc) -- | Holds all required information for 'dispatchLoggerName' function. data LogEvent = LogEvent
src/System/Wlog/Severity.hs view
@@ -2,15 +2,25 @@ module System.Wlog.Severity ( Severity (..)+ , Severities , LogRecord(..)+ -- * Severity utilities+ , allSeverities+ , severityPlus+ , debugPlus, infoPlus+ , noticePlus+ , warningPlus, errorPlus+ , excludeError ) where -import Universum+import Universum -import Data.Typeable (Typeable)-import Data.Yaml (FromJSON, ToJSON)-import GHC.Generics (Generic)+import Data.Typeable (Typeable)+import Data.Yaml (FromJSON, ToJSON)+import GHC.Generics (Generic) +import qualified Data.Set as Set+ -- | Severity is level of log message importance. It uniquely -- determines which messages to print. data Severity@@ -24,5 +34,40 @@ instance FromJSON Severity instance ToJSON Severity +-- | Set of 'Severity'.+type Severities = Set Severity+ -- | Internal type of log records. data LogRecord = LR !Severity !Text deriving Show++-- | 'Set' of all 'Severity's.+allSeverities :: Set Severity+allSeverities = Set.fromAscList [minBound .. maxBound]++-- | Returns the 'Set' of 'Severity's of elements greater or equal to the given value.+severityPlus :: Severity -> Set Severity+severityPlus s = Set.fromAscList [s .. maxBound]++-- | Returns 'Set' of 'Severity's not less than 'Debug'.+debugPlus :: Set Severity+debugPlus = severityPlus Debug++-- | Returns 'Set' of 'Severity's not less than 'Info'.+infoPlus :: Set Severity+infoPlus = severityPlus Info++-- | Returns 'Set' of 'Severity's not less than 'Notice'.+noticePlus :: Set Severity+noticePlus = severityPlus Notice++-- | Returns 'Set' of 'Severity's not less than 'Warning'.+warningPlus :: Set Severity+warningPlus = severityPlus Warning++-- | Returns 'Set' of 'Severity's not less than 'Error'.+errorPlus :: Set Severity+errorPlus = Set.singleton Error++-- | Excludes 'Error' from the 'Set' of 'Severity's.+excludeError :: Set Severity -> Set Severity+excludeError = Set.delete Error
+ src/System/Wlog/Terminal.hs view
@@ -0,0 +1,72 @@+{-# LANGUAGE ViewPatterns #-}++-- |+-- Module : System.Wlog.Terminal+-- Copyright : (c) Serokell, 2016+-- License : GPL-3 (see the file LICENSE)+-- Maintainer : Serokell <hi@serokell.io>+-- Stability : experimental+-- Portability : POSIX, GHC+--+-- Logging functionality. This module is wrapper over+-- <http://hackage.haskell.org/package/hslogger hslogger>,+-- which allows to keep logger name in monadic context.++module System.Wlog.Terminal+ ( initTerminalLogging+ ) where++import Universum++import Data.Time (UTCTime)+import System.IO (Handle, stderr, stdout)++import System.Wlog.Formatter (stderrFormatter, stdoutFormatter)+import System.Wlog.IOLogger (rootLoggerName, setHandlers, setLevel, updateGlobalLogger)+import System.Wlog.LogHandler (LogHandler (setFormatter))+import System.Wlog.LogHandler.Simple (streamHandler)+import System.Wlog.Severity (Severities, errorPlus, excludeError, warningPlus)+++-- | This function initializes global logging system for terminal output.+-- At high level, it sets severity which will be used by all loggers by default,+-- sets default formatters and sets custom severity for given loggers (if any).+--+-- NOTE: you probably don't want to use this function.+-- Consider 'System.Wlog.Launcher.setupLogging'.+--+-- On a lower level it does the following:+-- 1. Removes default handler from root logger, sets two handlers such that:+-- 1.1. All messages are printed to /stdout/.+-- 1.2. Moreover messages with at least `Error` severity are+-- printed to /stderr/.+-- 2. Sets given Severity to root logger, so that it will be used by+-- descendant loggers by default.+-- 3. Applies `setSeverity` to given loggers. It can be done later using+-- `setSeverity` directly.+initTerminalLogging :: MonadIO m+ => (UTCTime -> Text)+ -> (Handle -> Text -> IO ())+ -> Bool -- ^ Show time?+ -> Bool -- ^ Show ThreadId?+ -> Maybe Severities+ -> m ()+initTerminalLogging+ timeF+ customConsoleAction+ isShowTime+ isShowTid+ (fromMaybe (warningPlus) -> defaultSeverity)+ = liftIO $ do+ lock <- liftIO $ newMVar ()+ stdoutHandler <- setStdoutFormatter <$>+ streamHandler stdout customConsoleAction lock (excludeError defaultSeverity)+ stderrHandler <- setStderrFormatter <$>+ streamHandler stderr customConsoleAction lock errorPlus+ updateGlobalLogger rootLoggerName $+ setHandlers [stderrHandler, stdoutHandler]+ updateGlobalLogger rootLoggerName $+ setLevel defaultSeverity+ where+ setStdoutFormatter = (`setFormatter` stdoutFormatter timeF isShowTime isShowTid)+ setStderrFormatter = (`setFormatter` stderrFormatter timeF isShowTid)
− src/System/Wlog/Wrapper.hs
@@ -1,106 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE ViewPatterns #-}---- |--- Module : System.Wlog.Wrapper--- Copyright : (c) Serokell, 2016--- License : GPL-3 (see the file LICENSE)--- Maintainer : Serokell <hi@serokell.io>--- Stability : experimental--- Portability : POSIX, GHC------ Logging functionality. This module is wrapper over--- <http://hackage.haskell.org/package/hslogger hslogger>,--- which allows to keep logger name in monadic context.--module System.Wlog.Wrapper- ( Severity (..)- , initTerminalLogging- , releaseAllHandlers- , setSeverity- , setSeverityMaybe- ) where--import Universum--import Data.Time (UTCTime)-import System.IO (Handle, stderr, stdout)--import System.Wlog.Formatter (stderrFormatter, stdoutFormatter)-import System.Wlog.Handler (LogHandler (setFormatter))-import System.Wlog.Handler.Simple (GenericHandler (..), streamHandler)-import System.Wlog.Logger (clearLevel, removeAllHandlers,- rootLoggerName, setHandlers, setLevel,- updateGlobalLogger)-import System.Wlog.LoggerName (LoggerName (..))-import System.Wlog.Severity (Severity (..))---- | Like `streamHandler`, but syncronized using given `MVar` as lock--- (it should be filled before this function call).-streamHandlerWithLock :: (Handle -> Text -> IO ())- -> MVar ()- -> Handle- -> Severity- -> IO (GenericHandler Handle)-streamHandlerWithLock customTerminalAction lock handle severity =- streamHandler handle customTerminalAction lock severity---- | This function initializes global logging system for terminal output.--- At high level, it sets severity which will be used by all loggers by default,--- sets default formatters and sets custom severity for given loggers (if any).------ NOTE: you probably don't want to use this function.--- Consider 'System.Wlog.Launcher.setupLogging'.------ On a lower level it does the following:--- 1. Removes default handler from root logger, sets two handlers such that:--- 1.1. All messages are printed to /stdout/.--- 1.2. Moreover messages with at least `Error` severity are--- printed to /stderr/.--- 2. Sets given Severity to root logger, so that it will be used by--- descendant loggers by default.--- 3. Applies `setSeverity` to given loggers. It can be done later using--- `setSeverity` directly.-initTerminalLogging :: MonadIO m- => (UTCTime -> Text)- -> (Handle -> Text -> IO ())- -> Bool -- ^ Show time?- -> Bool -- ^ Show ThreadId?- -> Maybe Severity- -> m ()-initTerminalLogging- timeF- customConsoleAction- isShowTime- isShowTid- (fromMaybe Warning -> defaultSeverity)- = liftIO $ do- lock <- liftIO $ newMVar ()- stdoutHandler <- setStdoutFormatter <$>- streamHandlerWithLock customConsoleAction lock stdout defaultSeverity- stderrHandler <- setStderrFormatter <$>- streamHandlerWithLock customConsoleAction lock stderr Error- updateGlobalLogger rootLoggerName $- setHandlers [stderrHandler, stdoutHandler]- updateGlobalLogger rootLoggerName $- setLevel defaultSeverity- where- setStdoutFormatter = (`setFormatter` stdoutFormatter timeF isShowTime isShowTid)- setStderrFormatter = (`setFormatter` stderrFormatter timeF isShowTid)---- | Set severity for given logger. By default parent's severity is used.-setSeverity :: MonadIO m => LoggerName -> Severity -> m ()-setSeverity name =- liftIO . updateGlobalLogger name . setLevel---- | Set or clear severity.-setSeverityMaybe- :: MonadIO m- => LoggerName -> Maybe Severity -> m ()-setSeverityMaybe name Nothing =- liftIO $ updateGlobalLogger name clearLevel-setSeverityMaybe n (Just x) = setSeverity n x---- | Lifted alias to 'removeAllHandlers'.-releaseAllHandlers :: MonadIO m => m ()-releaseAllHandlers = liftIO removeAllHandlers
test/Test/Wlog/RollingSpec.hs view
@@ -4,29 +4,26 @@ ( spec ) where -import Universum+import Universum -import Control.Concurrent.Async (mapConcurrently)-import Control.Lens (zoom, (.=), (?=))-import qualified Prelude (read)-import System.Directory (doesFileExist, removeFile)-import System.FilePath (takeExtension)-import System.IO (hFileSize)+import Control.Concurrent.Async (mapConcurrently)+import Control.Lens (zoom, (.=), (?=))+import qualified Prelude (read)+import System.Directory (doesFileExist, removeFile)+import System.FilePath (takeExtension)+import System.IO (hFileSize) -import Test.Hspec (Spec, describe, it, shouldThrow)-import Test.Hspec.QuickCheck (modifyMaxSuccess, prop)-import Test.HUnit.Base (assert)-import Test.QuickCheck (Arbitrary (..), Property, choose, (==>))-import Test.QuickCheck.Monadic (PropertyM, monadicIO, run)+import Test.Hspec (Spec, describe, it, shouldThrow)+import Test.Hspec.QuickCheck (modifyMaxSuccess, prop)+import Test.HUnit.Base (assert)+import Test.QuickCheck (Arbitrary (..), Property, choose, (==>))+import Test.QuickCheck.Monadic (PropertyM, monadicIO, run) -import System.Wlog (HandlerWrap (..), InvalidRotation (..),- LoggerConfig (..), RotationParameters (..),- Severity (..), fromScratch, isValidRotation,- lcFilePrefix, lcRotation, lcTree, logDebug,- logIndex, ltFiles, ltSeverity,- releaseAllHandlers, rotationFileHandler,- setupLogging, usingLoggerName, whenExist,- zoomLogger)+import System.Wlog (HandlerWrap (..), InvalidRotation (..), LoggerConfig (..),+ RotationParameters (..), Severity (..), fromScratch, isValidRotation,+ lcFilePrefix, lcRotation, lcTree, logDebug, logIndex, ltFiles, ltSeverity,+ removeAllHandlers, rotationFileHandler, setupLogging, usingLoggerName,+ whenExist, zoomLogger) spec :: Spec spec = do@@ -84,7 +81,7 @@ writeConcurrentLogs rp@RotationParameters{..} (getNumberOfLinesToLog -> linesNum) = bracket_ (setupLogging Nothing $ testLoggerConfig rp)- releaseAllHandlers+ removeAllHandlers concurrentWriting where LoggerConfig{..} = testLoggerConfig rp