diff --git a/examples/Playground.hs b/examples/Playground.hs --- a/examples/Playground.hs +++ b/examples/Playground.hs @@ -2,16 +2,26 @@ module Main where -import Control.Exception (bracket_) +import Universum -import Data.Monoid ((<>)) -import qualified Data.Text as T (pack) +import Data.Monoid ((<>)) +import Data.Yaml.Pretty (defConfig, encodePretty) -import System.Wlog (CanLog, buildAndSetupYamlLogging, dispatchEvents, - logDebug, logError, logInfo, logNotice, logWarning, - modifyLoggerName, prefixB, productionB, - releaseAllHandlers, runPureLog, usingLoggerName) +import System.Wlog (CanLog, buildAndSetupYamlLogging, dispatchEvents, + logDebug, logError, logInfo, logNotice, logWarning, + modifyLoggerName, parseLoggerConfig, prefixB, + productionB, releaseAllHandlers, runPureLog, + usingLoggerName) +testLoggerConfigPath :: FilePath +testLoggerConfigPath = "logger-config-example.yaml" + +testToJsonConfigOutput :: MonadIO m => m () +testToJsonConfigOutput = do + cfg <- parseLoggerConfig testLoggerConfigPath + let builtConfig = cfg <> productionB <> prefixB "logs" + putStrLn $ encodePretty defConfig builtConfig + testLogging :: (CanLog m) => m () testLogging = usingLoggerName "node" $ do logDebug "skovoroda" @@ -28,13 +38,15 @@ showPureLog :: IO () showPureLog = do (res, pureLog) <- runPureLog testLogging - putStrLn "Pure log:" + putText "Pure log:" usingLoggerName "naked" $ do - logWarning $ "Pure log for result = " <> (T.pack $ show res) <> ":" + logWarning $ "Pure log for result = " <> show res <> ":" dispatchEvents pureLog main :: IO () -main = bracket_ - (buildAndSetupYamlLogging (productionB <> prefixB "logs") "logger-config-example.yaml") - releaseAllHandlers - (testLogging >> showPureLog) +main = do + testToJsonConfigOutput + bracket_ + (buildAndSetupYamlLogging (productionB <> prefixB "logs") testLoggerConfigPath) + releaseAllHandlers + (testLogging >> showPureLog) diff --git a/log-warper.cabal b/log-warper.cabal --- a/log-warper.cabal +++ b/log-warper.cabal @@ -1,22 +1,18 @@ name: log-warper -version: 1.0.4 +version: 1.1.0 synopsis: Flexible, configurable, monadic and pretty logging homepage: https://github.com/serokell/log-warper license: MIT license-file: LICENSE author: Serokell maintainer: Serokell -copyright: 2016-2016 Serokell +copyright: 2016-2017 Serokell category: Interfaces stability: experimental build-type: Simple cabal-version: >=1.18 description: - This package contains nice wrapper around hslogger library. - -Flag PatakDebugSkovorodaBARDAQ - default: False - description: Enable debug support + This package implements nice and featureful wrapper around hslogger library. library exposed-modules: System.Wlog @@ -24,6 +20,7 @@ System.Wlog.FileUtils System.Wlog.Formatter System.Wlog.Handler + System.Wlog.Handler.Roller System.Wlog.Handler.Simple System.Wlog.Handler.Syslog System.Wlog.Launcher @@ -31,7 +28,6 @@ System.Wlog.LoggerConfig System.Wlog.LoggerName System.Wlog.LoggerNameBox - System.Wlog.Roller System.Wlog.Severity System.Wlog.Wrapper @@ -41,7 +37,6 @@ build-depends: aeson >= 0.11.2.1 , ansi-terminal >= 0.6.2.3 , base >= 4.7 && < 5 - , bytestring >= 0.10.8.1 , containers >= 0.5.7.0 , directory >= 1.2.6.2 , dlist >= 0.8.0.2 @@ -76,13 +71,11 @@ default-extensions: GeneralizedNewtypeDeriving DeriveDataTypeable DeriveGeneric + NoImplicitPrelude OverloadedStrings TypeApplications RecordWildCards - if flag(PatakDebugSkovorodaBARDAQ) - cpp-options: -DPatakDebugSkovorodaBARDAQ - executable play-log main-is: Playground.hs @@ -90,6 +83,8 @@ , exceptions >= 0.8.2.1 , log-warper , text >= 1.2.2.1 + , universum >= 0.3 + , yaml >= 0.8.20 hs-source-dirs: examples default-language: Haskell2010 @@ -98,6 +93,7 @@ default-extensions: GeneralizedNewtypeDeriving DeriveDataTypeable DeriveGeneric + NoImplicitPrelude OverloadedStrings TypeApplications RecordWildCards diff --git a/src/System/Wlog.hs b/src/System/Wlog.hs --- a/src/System/Wlog.hs +++ b/src/System/Wlog.hs @@ -14,23 +14,27 @@ 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.Launcher , module System.Wlog.Logger , module System.Wlog.LoggerConfig , module System.Wlog.LoggerName , module System.Wlog.LoggerNameBox - , module System.Wlog.Roller , module System.Wlog.Severity , module System.Wlog.Wrapper ) 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.Launcher import System.Wlog.Logger import System.Wlog.LoggerConfig import System.Wlog.LoggerName import System.Wlog.LoggerNameBox -import System.Wlog.Roller import System.Wlog.Severity import System.Wlog.Wrapper diff --git a/src/System/Wlog/CanLog.hs b/src/System/Wlog/CanLog.hs --- a/src/System/Wlog/CanLog.hs +++ b/src/System/Wlog/CanLog.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE BangPatterns #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE FlexibleInstances #-} @@ -17,8 +16,6 @@ module System.Wlog.CanLog ( CanLog (..) , WithLogger - , memoryLogs - , readMemoryLogs -- * Pure logging manipulation , PureLogger (..) @@ -40,7 +37,6 @@ , logMessage ) where -import Control.Concurrent (modifyMVar_) import Control.Monad.Base (MonadBase) import Control.Monad.Except (ExceptT, MonadError) import Control.Monad.Morph (MFunctor (..)) @@ -49,20 +45,14 @@ import qualified Control.Monad.State.Strict as StateStrict import Control.Monad.Trans (MonadTrans (lift)) import Control.Monad.Writer (MonadWriter (tell), WriterT (runWriterT)) - import qualified Data.DList as DL (DList) import Data.SafeCopy (base, deriveSafeCopySimple) -import Data.Time (getCurrentTime) -import System.IO.Unsafe (unsafePerformIO) import Universum -import System.Wlog.Formatter (formatLogMessageColors, getRoundedTime) import System.Wlog.Logger (logM) import System.Wlog.LoggerName (LoggerName (..)) import System.Wlog.LoggerNameBox (HasLoggerName (..), LoggerNameBox (..), usingLoggerName) -import System.Wlog.MemoryQueue (MemoryQueue) -import qualified System.Wlog.MemoryQueue as MQ import System.Wlog.Severity (Severity (..)) @@ -84,19 +74,6 @@ -> t n () dispatchMessage name sev t = lift $ dispatchMessage name sev t -type LogMemoryQueue = MemoryQueue Text - --- TODO: dirty hack to have in-memory logs. Maybe will be refactored --- later. Maybe not. -memoryLogs :: MVar (Maybe (LogMemoryQueue,Maybe Int)) -memoryLogs = unsafePerformIO $ newMVar Nothing -{-# NOINLINE memoryLogs #-} - --- | Retrieves memory logs in reversed order (newest are head). -readMemoryLogs :: (MonadIO m) => m [Text] -readMemoryLogs = do - liftIO (readMVar memoryLogs) <&> maybe (pure []) (MQ.toList . fst) - instance CanLog IO where dispatchMessage (loggerName -> name) prior msg = logM name prior msg @@ -211,13 +188,3 @@ logMessage severity t = do name <- getLoggerName dispatchMessage name severity t - !() <- pure $ unsafePerformIO $ do - let formatted r = do - curTime <- maybe getCurrentTime getRoundedTime r - pure $ formatLogMessageColors name severity curTime t - let modif _ Nothing = pure Nothing - modif x (Just s) = Just <$> x s - modifyMVar_ memoryLogs $ modif $ \(q,rv) -> do - f <- formatted rv - pure $ (MQ.pushFront f q, rv) - pure () diff --git a/src/System/Wlog/Handler.hs b/src/System/Wlog/Handler.hs --- a/src/System/Wlog/Handler.hs +++ b/src/System/Wlog/Handler.hs @@ -22,18 +22,26 @@ -} module System.Wlog.Handler ( -- * Basic Types - LogHandler(..) + LogHandlerTag(..) + , LogHandler(..) ) where import System.Wlog.Formatter (LogFormatter, nullFormatter) import System.Wlog.Severity (LogRecord, Severity) +import Universum +-- | 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 identication. - getTag :: a -> String + -- | Tag of handler. Is arbitrary. Made for identification. + getTag :: a -> LogHandlerTag -- | Sets the log level. 'handle' will drop items beneath this -- level. @@ -51,14 +59,18 @@ -- given by the most recent call to 'setLevel'. handle :: a -> LogRecord -> String -> IO () handle h (pri, msg) logname = - if pri >= (getLevel h) - then do formattedMsg <- (getFormatter h) h (pri,msg) logname - emit h (pri, formattedMsg) logname - else return () + when (pri >= (getLevel h)) $ do + formattedMsg <- (getFormatter h) h (pri,msg) logname + emit h (pri, formattedMsg) logname -- | Forces an event to be logged regardless of -- the configured level. emit :: a -> LogRecord -> String -> 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. diff --git a/src/System/Wlog/Handler/Roller.hs b/src/System/Wlog/Handler/Roller.hs new file mode 100644 --- /dev/null +++ b/src/System/Wlog/Handler/Roller.hs @@ -0,0 +1,119 @@ +-- | 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 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 (_, msg) _ = rhWriteAction rh (error "Handler is used internally") msg + 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 + , .. + } diff --git a/src/System/Wlog/Handler/Simple.hs b/src/System/Wlog/Handler/Simple.hs --- a/src/System/Wlog/Handler/Simple.hs +++ b/src/System/Wlog/Handler/Simple.hs @@ -23,35 +23,39 @@ , verboseStreamHandler ) where -import Control.Concurrent (withMVar) -import Control.Exception (SomeException) -import Data.Maybe (fromMaybe) -import qualified Data.Text.IO as TIO -import Data.Typeable (Typeable) -import System.IO (hClose, hFlush) +import Control.Concurrent (withMVar) +import Control.Exception (SomeException) +import qualified Data.Text.IO as TIO +import Data.Typeable (Typeable) +import System.IO (Handle, IOMode (ReadWriteMode), + SeekMode (SeekFromEnd), hClose, hFlush, hSeek) import Universum -import System.Wlog.Formatter (LogFormatter, nullFormatter, simpleLogFormatter) -import System.Wlog.Handler (LogHandler (..)) -import System.Wlog.Severity (Severity (..)) +import System.Wlog.Formatter (LogFormatter, nullFormatter, simpleLogFormatter) +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 () - , ghTag :: Maybe String + { severity :: !Severity + , formatter :: !(LogFormatter (GenericHandler a)) + , privData :: !a + , writeFunc :: !(a -> Text -> IO ()) + , closeFunc :: !(a -> IO ()) + , readBackBuffer :: !(MemoryQueue Text) + , ghTag :: !LogHandlerTag } deriving Typeable instance Typeable a => LogHandler (GenericHandler a) where - getTag = fromMaybe "GenericHandler" . ghTag + 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 = pure $ take i . reverse $ MQ.toList $ readBackBuffer sh emit sh (_,msg) _ = (writeFunc sh) (privData sh) msg close sh = (closeFunc sh) (privData sh) @@ -71,7 +75,8 @@ , privData = h , writeFunc = mywritefunc , closeFunc = const $ pure () - , ghTag = Just "streamHandler" + , readBackBuffer = MQ.newMemoryQueue $ 2 * 1024 * 1024 -- 2 MB + , ghTag = HandlerOther "GenericHandler/StreamHandler" } where writeToHandle hdl msg = @@ -88,9 +93,12 @@ -- Append mode. Calling 'close' on the handler will close the file. fileHandler :: FilePath -> Severity -> IO (GenericHandler Handle) fileHandler fp sev = do - h <- openFile fp AppendMode + h <- openFile fp ReadWriteMode + hSeek h SeekFromEnd 0 sh <- streamHandler h sev - return (sh {closeFunc = hClose, ghTag = Just ("fileHandler:" ++ fp)}) + pure $ sh { closeFunc = hClose + , ghTag = HandlerFilelike fp + } -- | Like 'streamHandler', but note the priority and logger name along -- with each message. diff --git a/src/System/Wlog/Handler/Syslog.hs b/src/System/Wlog/Handler/Syslog.hs --- a/src/System/Wlog/Handler/Syslog.hs +++ b/src/System/Wlog/Handler/Syslog.hs @@ -65,7 +65,7 @@ import Universum hiding (Option, identity) import System.Wlog.Formatter (LogFormatter, varFormatter) -import System.Wlog.Handler (LogHandler (..)) +import System.Wlog.Handler (LogHandler (..), LogHandlerTag (HandlerOther)) import System.Wlog.Severity (Severity (..)) @@ -263,11 +263,12 @@ instance LogHandler SyslogHandler where - getTag = const "SyslogHandlerTag" + 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 (prio, msg) _ = do when (elem PERROR (options sh)) (TIO.hPutStrLn stderr msg) pidPart <- getPidPart diff --git a/src/System/Wlog/Launcher.hs b/src/System/Wlog/Launcher.hs --- a/src/System/Wlog/Launcher.hs +++ b/src/System/Wlog/Launcher.hs @@ -32,30 +32,23 @@ , setupLogging ) where -#if PatakDebugSkovorodaBARDAQ -import qualified Data.ByteString.Char8 as BS (putStrLn) -import Data.Yaml.Pretty (defConfig, encodePretty) -#endif -import Control.Concurrent (modifyMVar_) import Control.Error.Util ((?:)) import Control.Exception (throwIO) import qualified Data.HashMap.Strict as HM hiding (HashMap) -import Data.List (isSuffixOf) import qualified Data.Text as T import Data.Yaml (decodeFileEither) import System.Directory (createDirectoryIfMissing) import System.FilePath (()) import Universum -import System.Wlog.CanLog (memoryLogs) import System.Wlog.Formatter (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, updateGlobalLogger) -import System.Wlog.LoggerConfig (LoggerConfig (..), LoggerTree (..)) +import System.Wlog.Logger (addHandler, setPrefix, updateGlobalLogger) +import System.Wlog.LoggerConfig (HandlerWrap (..), LoggerConfig (..), + LoggerTree (..)) import System.Wlog.LoggerName (LoggerName (..)) -import System.Wlog.MemoryQueue (newMemoryQueue) -import System.Wlog.Roller (rotationFileHandler) import System.Wlog.Wrapper (Severity (Debug), initTerminalLogging, setSeverityMaybe) @@ -69,11 +62,7 @@ setupLogging LoggerConfig{..} = do liftIO $ createDirectoryIfMissing True handlerPrefix when consoleOutput $ initTerminalLogging isShowTime _lcTermSeverity - -- TODO: use lifted version here - whenJust _lcMemModeLimit $ \limit -> do - putText "Initializing logs" - let cpj = const . pure . Just -- just for lulz - liftIO $ modifyMVar_ memoryLogs $ cpj $ (newMemoryQueue limit, _lcRoundVal) + liftIO $ setPrefix _lcFilePrefix processLoggers mempty _lcTree where handlerPrefix = _lcFilePrefix ?: "." @@ -92,17 +81,15 @@ unless (parent == mempty && not consoleOutput) $ setSeverityMaybe parent _ltSeverity - forM_ _ltFiles $ \fileName -> liftIO $ do + forM_ _ltFiles $ \HandlerWrap{..} -> liftIO $ do let fileSeverity = _ltSeverity ?: Debug - let handlerPath = handlerPrefix fileName + let handlerPath = handlerPrefix _hwFilePath case handlerFabric of HandlerFabric fabric -> do let handlerCreator = fabric handlerPath fileSeverity let defFmt = (`setFormatter` stdoutFormatter isShowTime) let roundFmt r = (`setFormatter` stdoutFormatterTimeRounded r) - let fmt = maybe defFmt (\r -> if ".pub" `isSuffixOf` fileName - then roundFmt r - else defFmt) _lcRoundVal + let fmt = maybe defFmt roundFmt _hwRounding thisLoggerHandler <- fmt <$> handlerCreator updateGlobalLogger (loggerName parent) $ addHandler thisLoggerHandler @@ -121,11 +108,6 @@ buildAndSetupYamlLogging configBuilder loggerConfigPath = do cfg@LoggerConfig{..} <- parseLoggerConfig loggerConfigPath let builtConfig = cfg <> configBuilder - -#if PatakDebugSkovorodaBARDAQ - liftIO $ BS.putStrLn $ encodePretty defConfig builtConfig -#endif - setupLogging builtConfig -- | Initialize logger hierarchy from configuration file. diff --git a/src/System/Wlog/Logger.hs b/src/System/Wlog/Logger.hs --- a/src/System/Wlog/Logger.hs +++ b/src/System/Wlog/Logger.hs @@ -1,5 +1,8 @@ {-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TupleSections #-} {- | Module : System.Log.Logger @@ -47,19 +50,27 @@ -- ** Saving Your Changes , saveGlobalLogger , updateGlobalLogger + , setPrefix + , retrieveLogContent ) where -import Control.Concurrent.MVar (modifyMVar, modifyMVar_) +import Control.Concurrent.MVar (modifyMVar, modifyMVar_, withMVar) +import Control.Lens (makeLenses) import Data.List (isPrefixOf) -import qualified Data.Map as Map +import qualified Data.Map as M import Data.Maybe (fromJust) ---import System.IO +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), close) +import Universum + +import System.Wlog.Handler (LogHandler (getTag), + LogHandlerTag (HandlerFilelike), close, + readBack) import qualified System.Wlog.Handler (handle) import System.Wlog.Handler.Simple (streamHandler) import System.Wlog.Severity (LogRecord, Severity (..)) -import Universum --------------------------------------------------------------------------- @@ -69,13 +80,20 @@ data HandlerT = forall a. LogHandler a => HandlerT a data Logger = Logger - { level :: Maybe Severity - , handlers :: [HandlerT] - , name :: String - } + { _lLevel :: Maybe Severity + , _lHandlers :: [HandlerT] + , _lName :: String + } deriving (Generic) -type LogTree = Map.Map String Logger +makeLenses ''Logger +type LogTree = Map String Logger + +data LogInternalState = LogInternalState + { liTree :: Map String Logger + , liPrefix :: Maybe FilePath + } deriving (Generic) + --------------------------------------------------------------------------- -- Utilities --------------------------------------------------------------------------- @@ -89,17 +107,18 @@ -- Logger Tree Storage --------------------------------------------------------------------------- --- | The log tree. Initialize it with a default root logger --- and (FIXME) a logger for MissingH itself. -{-# NOINLINE logTree #-} -logTree :: MVar LogTree +-- | The log tree. Initialize it with a default root logger. +{-# NOINLINE logInternalState #-} +logInternalState :: MVar LogInternalState -- note: only kick up tree if handled locally -logTree = unsafePerformIO $ do +logInternalState = unsafePerformIO $ do h <- streamHandler stderr Debug - newMVar $ - Map.singleton rootLoggerName $ - Logger {level = Just Warning, name = "", handlers = [HandlerT h]} - + let liTree = M.singleton rootLoggerName $ + Logger { _lLevel = Just Warning + , _lName = "" + , _lHandlers = [HandlerT h]} + liPrefix = Nothing + newMVar $ LogInternalState {..} {- | Given a name, return all components of it, starting from the root. Example return value: @@ -109,12 +128,13 @@ -} componentsOfName :: String -> [String] componentsOfName name = - let joinComp [] _ = [] - joinComp (x:xs) [] = x : joinComp xs x - joinComp (x:xs) accum = - let newlevel = accum ++ "." ++ x - in newlevel : joinComp xs newlevel - in rootLoggerName : joinComp (split "." name) [] + rootLoggerName : joinComp (split "." 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 @@ -123,13 +143,13 @@ -- | Log a message using the given logger at a given priority. logM :: String -- ^ Name of the logger to use -> Severity -- ^ Severity of this message - -> Text -- ^ The log text itself + -> Text -- ^ The log text itself -> IO () logM logname pri msg = do l <- getLogger logname logL l pri msg -logMCond :: String -> Severity -> Text -> (String -> Bool) -> IO () +logMCond :: String -> Severity -> Text -> (LogHandlerTag -> Bool) -> IO () logMCond logname sev msg cond = do l <- getLogger logname logLCond l sev msg cond @@ -162,7 +182,7 @@ -> IO () warningM s = logM s Warning -{- | Log a message at 'ERROR' priority -} +{- | Log a message at 'Error' priority -} errorM :: String -- ^ Logger name -> Text -- ^ Log message -> IO () @@ -176,22 +196,23 @@ -- exists, creates new loggers and any necessary parent loggers, with -- no connected handlers. getLogger :: String -> IO Logger -getLogger lname = modifyMVar logTree $ \lt -> case Map.lookup lname lt 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) lt - let result = fromJust $ Map.lookup lname newlt - return (newlt, result) +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 :: [String] -> LogTree -> LogTree createLoggers [] lt = lt -- No names to add; return tree unmodified createLoggers (x:xs) lt = -- Add logger to tree - if Map.member x lt - then createLoggers xs lt - else createLoggers xs - (Map.insert x (defaultLogger {name=x}) lt) - defaultLogger = Logger Nothing [] undefined -- ???!??! + 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 @@ -202,19 +223,19 @@ logL l pri msg = handle l (pri, msg) (const True) -- | Logs a message with condition. -logLCond :: Logger -> Severity -> Text -> (String -> Bool) -> IO () +logLCond :: Logger -> Severity -> Text -> (LogHandlerTag -> Bool) -> IO () logLCond l pri msg = handle l (pri, msg) -- | Handle a log request. -handle :: Logger -> LogRecord -> (String -> Bool) -> IO () +handle :: Logger -> LogRecord -> (LogHandlerTag -> Bool) -> IO () handle l lrecord@(sev, _) handlerFilter = do lp <- getLoggerSeverity nm if sev >= lp then do - ph <- concatMap handlers <$> parentLoggers nm + ph <- concatMap (view lHandlers) <$> parentLoggers nm forM_ ph $ callHandler lrecord nm else return () where - nm = name l + nm = view lName l parentLoggers :: String -> IO [Logger] parentLoggers = mapM getLogger . componentsOfName -- Get the severity we should use. Find the first logger in the @@ -223,7 +244,7 @@ getLoggerSeverity :: String -> IO Severity getLoggerSeverity name = do pl <- parentLoggers name - case catMaybes . map level $ (l : pl) of + case catMaybes . map (view lLevel) $ (l : pl) of [] -> pure Debug (x:_) -> pure x callHandler :: LogRecord -> String -> HandlerT -> IO () @@ -231,10 +252,13 @@ 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 l= l{handlers = (HandlerT h) : (handlers l)} +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' @@ -250,34 +274,34 @@ -- -- > updateGlobalLogger rootLoggerName removeHandler removeHandler :: Logger -> Logger -removeHandler l = l { handlers = drop 1 $ handlers l } +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 l = - l{handlers = map (\h -> HandlerT h) hl} +setHandlers hl = lHandlers .~ map HandlerT hl -- | Returns the "level" of the logger. Items beneath this -- level will be ignored. getLevel :: Logger -> Maybe Severity -getLevel = level +getLevel = _lLevel -- | Sets the "level" of the 'Logger'. Returns a new -- 'Logger' object with the new level. setLevel :: Severity -> Logger -> Logger -setLevel p l = l {level = Just p} +setLevel p = lLevel .~ Just p -- | Clears the "level" of the 'Logger'. It will now inherit the level of -- | its parent. clearLevel :: Logger -> Logger -clearLevel l = l {level = Nothing} +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_ logTree - (\lt -> return $ Map.insert (name l) l lt) +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 @@ -296,10 +320,11 @@ -- | Allow graceful shutdown. Release all opened files/handlers/etc. removeAllHandlers :: IO () removeAllHandlers = - modifyMVar_ logTree $ \lt -> do - let allHandlers = Map.fold (\l r -> concat [r, handlers l]) [] lt + modifyMVar_ logInternalState $ \LogInternalState{..} -> do + let allHandlers = M.fold (\l r -> concat [r, view lHandlers l]) [] liTree mapM_ (\(HandlerT h) -> close h) allHandlers - return $ Map.map (\l -> l {handlers = []}) lt + let newTree = map (lHandlers .~ []) liTree + return $ LogInternalState newTree liPrefix -- | Traps exceptions that may occur, logging them, then passing them on. -- @@ -320,6 +345,38 @@ 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." + +---------------------------------------------------------------------------- +-- List util functions +---------------------------------------------------------------------------- -- | This function pulled in from MissingH to avoid a dep on it split :: Eq a => [a] -> [a] -> [[a]] diff --git a/src/System/Wlog/LoggerConfig.hs b/src/System/Wlog/LoggerConfig.hs --- a/src/System/Wlog/LoggerConfig.hs +++ b/src/System/Wlog/LoggerConfig.hs @@ -21,6 +21,9 @@ , isValidRotation -- * Hierarchical tree of loggers (with lenses) + , HandlerWrap (..) + , hwFilePath + , hwRounding , LoggerTree (..) , ltFiles , ltSeverity @@ -33,18 +36,15 @@ , lcConsoleOutput , lcFilePrefix , lcMapper - , lcMemModeLimit , lcRotation , lcShowTime , lcTermSeverity , lcTree - , lcRoundVal , zoomLogger -- ** Builders for 'LoggerConfig' , consoleOutB , mapperB - , memoryB , prefixB , productionB , showTimeB @@ -85,21 +85,32 @@ -- LoggerTree ---------------------------------------------------------------------------- +-- | Wrapper over file handler with additional rounding option. +data HandlerWrap = HandlerWrap + { _hwFilePath :: !FilePath + -- ^ Path to the file to be handled. + , _hwRounding :: !(Maybe Int) + -- ^ Amount of seconds to round time on (if set). + } deriving (Generic,Show) + +makeLenses ''HandlerWrap + type LoggerMap = HashMap Text LoggerTree -- | Stores configuration for hierarchical loggers. data LoggerTree = LoggerTree { _ltSubloggers :: !LoggerMap - , _ltFiles :: ![FilePath] + , _ltFiles :: ![HandlerWrap] , _ltSeverity :: !(Maybe Severity) } deriving (Generic, Show) makeLenses ''LoggerTree + -- TODO: QuickCheck tests on monoid laws instance Monoid LoggerTree where mempty = LoggerTree - { _ltFiles = [] + { _ltFiles = [] , _ltSeverity = Nothing , _ltSubloggers = mempty } @@ -110,15 +121,26 @@ , _ltSubloggers = _ltSubloggers lt1 <> _ltSubloggers lt2 } +instance ToJSON HandlerWrap +instance FromJSON HandlerWrap where + parseJSON = withObject "handler wrap" $ \o -> do + (_hwFilePath :: FilePath) <- o .: "file" + (_hwRounding :: Maybe Int) <- o .:? "round" + pure HandlerWrap{..} + nonLoggers :: [Text] -nonLoggers = ["file", "files", "severity"] +nonLoggers = ["file", "files", "severity", "rounding", "handlers"] instance ToJSON LoggerTree instance FromJSON LoggerTree where parseJSON = withObject "loggers tree" $ \o -> do (singleFile :: Maybe FilePath) <- o .:? "file" (manyFiles :: [FilePath]) <- o .:? "files" .!= [] - let _ltFiles = maybe [] (:[]) singleFile ++ manyFiles + handlers <- o .:? "handlers" .!= [] + let fileHandlers = + map (\fp -> HandlerWrap fp Nothing) $ + maybe [] (:[]) singleFile ++ manyFiles + let _ltFiles = fileHandlers <> handlers _ltSeverity <- o .:? "severity" _ltSubloggers <- for (filterObject nonLoggers o) parseJSON return LoggerTree{..} @@ -179,14 +201,8 @@ -- | Path prefix to add for each logger file , _lcFilePrefix :: Maybe FilePath - -- | Limit for queue in memory mode. - , _lcMemModeLimit :: Maybe Word64 - -- | Hierarchical tree of loggers. , _lcTree :: LoggerTree - - -- | If rounding is enabled, to how many secs to round. - , _lcRoundVal :: Maybe Int } makeLenses ''LoggerConfig @@ -200,9 +216,7 @@ , _lcConsoleOutput = mempty , _lcMapper = mempty , _lcFilePrefix = mempty - , _lcMemModeLimit = Nothing , _lcTree = mempty - , _lcRoundVal = Nothing } lc1 `mappend` lc2 = LoggerConfig @@ -212,14 +226,12 @@ , _lcConsoleOutput = _lcConsoleOutput lc1 <> _lcConsoleOutput lc2 , _lcMapper = _lcMapper lc1 <> _lcMapper lc2 , _lcFilePrefix = _lcFilePrefix lc1 <|> _lcFilePrefix lc2 - , _lcMemModeLimit = _lcMemModeLimit lc1 <|> _lcMemModeLimit lc2 , _lcTree = _lcTree lc1 <> _lcTree lc2 - , _lcRoundVal = _lcRoundVal lc1 `max` _lcRoundVal lc2 } topLevelParams :: [Text] topLevelParams = - ["rotation", "showTime", "printOutput", "filePrefix", "memModeLimit", "roundTime"] + ["rotation", "showTime", "printOutput", "filePrefix" ] instance FromJSON LoggerConfig where parseJSON = withObject "rotation params" $ \o -> do @@ -228,9 +240,7 @@ _lcShowTime <- Any <$> o .:? "showTime" .!= False _lcConsoleOutput <- Any <$> o .:? "printOutput" .!= False _lcFilePrefix <- o .:? "filePrefix" - _lcMemModeLimit <- o .:? "memModeLimit" _lcTree <- parseJSON $ Object $ filterObject topLevelParams o - _lcRoundVal <- o .:? "roundTime" let _lcMapper = mempty return LoggerConfig{..} @@ -243,7 +253,6 @@ , "showTime" .= getAny _lcShowTime , "printOutput" .= getAny _lcConsoleOutput , "filePrefix" .= _lcFilePrefix - , "memModeLimit" .= _lcMemModeLimit , ("logTree", toJSON _lcTree) ] @@ -268,7 +277,3 @@ -- | Setup 'lcFilePrefix' inside 'LoggerConfig'. prefixB :: FilePath -> LoggerConfig prefixB filePrefix = mempty { _lcFilePrefix = Just filePrefix } - --- | Setup memory logger with certain limit -memoryB :: Word64 -> LoggerConfig -memoryB limit = mempty { _lcMemModeLimit = Just limit } diff --git a/src/System/Wlog/LoggerName.hs b/src/System/Wlog/LoggerName.hs --- a/src/System/Wlog/LoggerName.hs +++ b/src/System/Wlog/LoggerName.hs @@ -15,6 +15,7 @@ import Data.Text.Buildable (Buildable) import qualified Data.Text.Buildable as Buildable import Formatting (Format, bprint, build, string) +import Universum -- | Logger name to keep in context. diff --git a/src/System/Wlog/LoggerNameBox.hs b/src/System/Wlog/LoggerNameBox.hs --- a/src/System/Wlog/LoggerNameBox.hs +++ b/src/System/Wlog/LoggerNameBox.hs @@ -28,6 +28,7 @@ import Control.Monad.Trans.Cont (ContT, mapContT) import Control.Monad.Trans.Control (MonadBaseControl (..)) import Control.Monad.Writer (WriterT (..), mapWriterT) +import Universum import System.Wlog.LoggerName (LoggerName) diff --git a/src/System/Wlog/MemoryQueue.hs b/src/System/Wlog/MemoryQueue.hs --- a/src/System/Wlog/MemoryQueue.hs +++ b/src/System/Wlog/MemoryQueue.hs @@ -1,5 +1,4 @@ -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TemplateHaskell #-} -- | Queue for in-memory logs. Rolls out old logging if size of queue -- is bigger than predefined limit. @@ -32,7 +31,6 @@ instance Sized Text where getSize = fromIntegral . length - -- | Data structure similar to queue but pops out elements after -- 'pushFront' if 'mqMemSize' > 'mqLimit'. data MemoryQueue a = MemoryQueue @@ -56,7 +54,7 @@ in (Just popped, MemoryQueue{ _mqMemSize = newMemSize, _mqQueue = rest, .. }) -- | Add new element at the beginning removing elements from the end --- untill size become not greater than limit. +-- until size become not greater than limit. pushFront :: (Sized a) => a -> MemoryQueue a -> MemoryQueue a pushFront msg mq = executingState mq $ do mqMemSize += getSize msg diff --git a/src/System/Wlog/Roller.hs b/src/System/Wlog/Roller.hs deleted file mode 100644 --- a/src/System/Wlog/Roller.hs +++ /dev/null @@ -1,106 +0,0 @@ -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE NoImplicitPrelude #-} - --- | Custom implementation of 'LogHandler' with log rotation support. - -module System.Wlog.Roller - ( InvalidRotation (..) - , RollerHandler (..) - , logIndex - , rotationFileHandler - ) where - -import Universum - -import Control.Concurrent (modifyMVar_, withMVar) -import Formatting (sformat, shown, (%)) -import qualified Prelude (show) - -import System.Directory (removeFile, renameFile) -import System.FilePath ((<.>)) -import System.IO (Handle, IOMode (AppendMode), hClose, - hFileSize) -import System.Wlog.FileUtils (whenExist) -import System.Wlog.Formatter (LogFormatter, nullFormatter) -import System.Wlog.Handler (LogHandler (..)) -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 = "rollerHandler:" <> rhFileName rh - setLevel rh p = rh { rhSeverity = p } - setFormatter rh f = rh { rhFormatter = f } - getLevel = rhSeverity - getFormatter = rhFormatter - - emit rh (_, msg) _ = rhWriteAction rh (error "Handler is used internally") msg - close RollerHandler{..} = withMVar rhFileHandle rhCloseAction - -data InvalidRotation = InvalidRotation !Text - deriving (Show, Eq) - -instance Exception InvalidRotation - -logIndex :: FilePath -> Int -> FilePath -logIndex handlerPath i = handlerPath <.> Prelude.show i - --- 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 - openFile handlerPath AppendMode - --- | 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 - , .. - } diff --git a/src/System/Wlog/Wrapper.hs b/src/System/Wlog/Wrapper.hs --- a/src/System/Wlog/Wrapper.hs +++ b/src/System/Wlog/Wrapper.hs @@ -39,15 +39,10 @@ -- (it should be filled before this function call). streamHandlerWithLock :: MVar () -> Handle -> Severity -> IO (GenericHandler Handle) streamHandlerWithLock lock h sev = do - GenericHandler{..} <- streamHandler h sev - return GenericHandler - { severity = severity - , formatter = formatter - , privData = privData - , writeFunc = \a s -> withMVar lock $ const $ writeFunc a s - , closeFunc = closeFunc - , ghTag = ghTag - } + GenericHandler {..} <- streamHandler h sev + pure + GenericHandler + {writeFunc = \a s -> withMVar lock $ const $ writeFunc a s, ..} -- | This function initializes global logging system for terminal output. -- At high level, it sets severity which will be used by all loggers by default, diff --git a/test/Test/Wlog/RollingSpec.hs b/test/Test/Wlog/RollingSpec.hs --- a/test/Test/Wlog/RollingSpec.hs +++ b/test/Test/Wlog/RollingSpec.hs @@ -19,13 +19,14 @@ import Test.QuickCheck (Arbitrary (..), Property, choose, (==>)) import Test.QuickCheck.Monadic (PropertyM, monadicIO, run) -import System.Wlog (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, + releaseAllHandlers, rotationFileHandler, + setupLogging, usingLoggerName, whenExist, + zoomLogger) spec :: Spec spec = do @@ -73,7 +74,7 @@ zoom lcTree $ do ltSeverity ?= Debug zoomLogger "test" $ - ltFiles .= [testLogFile] + ltFiles .= [HandlerWrap testLogFile Nothing] logThreadsNum :: Word logThreadsNum = 4