log-warper 1.7.6 → 1.8.0
raw patch · 6 files changed
+64/−16 lines, 6 files
Files
- CHANGES.md +6/−0
- log-warper.cabal +1/−1
- src/System/Wlog/IOLogger.hs +20/−8
- src/System/Wlog/Launcher.hs +10/−2
- src/System/Wlog/LoggerConfig.hs +20/−0
- test/Test/Wlog/RollingSpec.hs +7/−5
CHANGES.md view
@@ -1,3 +1,9 @@+1.8.0+=====++* [#55](https://github.com/serokell/log-warper/issues/55):+ Return back `lcFilePrefix` field in `LoggerConfig`, rename to `lcLogsDirectory`.+ 1.7.6 =====
log-warper.cabal view
@@ -1,5 +1,5 @@ name: log-warper-version: 1.7.6+version: 1.8.0 synopsis: Flexible, configurable, monadic and pretty logging homepage: https://github.com/serokell/log-warper license: MIT
src/System/Wlog/IOLogger.hs view
@@ -46,6 +46,7 @@ -- ** Saving Your Changes , saveGlobalLogger , updateGlobalLogger+ , setPrefix , retrieveLogContent ) where @@ -54,6 +55,7 @@ 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 (..))@@ -85,8 +87,9 @@ type LogTree = Map LoggerName Logger -newtype LogInternalState = LogInternalState+data LogInternalState = LogInternalState { liTree :: LogTree+ , liPrefix :: Maybe FilePath } deriving (Generic) ---------------------------------------------------------------------------@@ -111,6 +114,7 @@ Logger { _lLevel = Just warningPlus , _lName = "" , _lHandlers = []}+ liPrefix = Nothing newMVar $ LogInternalState {..} {- | Given a name, return all components of it, starting from the root.@@ -163,7 +167,7 @@ -- 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, result)+ return (LogInternalState newlt liPrefix, result) where createLoggers :: [LoggerName] -> LogTree -> LogTree createLoggers [] lt = lt -- No names to add; return tree unmodified@@ -209,6 +213,12 @@ 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:)@@ -265,7 +275,7 @@ saveGlobalLogger :: MonadIO m => Logger -> m () saveGlobalLogger l = liftIO $ modifyMVar_ logInternalState $ \LogInternalState{..} ->- pure $ LogInternalState (M.insert (view lName l) l liTree)+ 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@@ -289,14 +299,15 @@ 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+ return $ LogInternalState newTree liPrefix ---------------------------------------------------------------------------- -- Retrieving logs ad-hoc ---------------------------------------------------------------------------- --- | Retrieves content of log file(s) given path. Example: there's @component.log@--- in config, but this function will return @[component.log.122,+-- | 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. --@@ -306,13 +317,14 @@ 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 filePath) $+ 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 filePath+ [] -> 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
@@ -42,9 +42,12 @@ import Control.Lens (zoom, (.=), (?=)) 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.IOLogger (addHandler, removeAllHandlers, setSeveritiesMaybe, updateGlobalLogger)+import System.Wlog.IOLogger (addHandler, removeAllHandlers, setPrefix, setSeveritiesMaybe,+ updateGlobalLogger) import System.Wlog.LoggerConfig (HandlerWrap (..), LoggerConfig (..), LoggerTree (..), fromScratch, lcConsoleAction, lcShowTime, lcTree, ltSeverity, productionB, zoomLogger)@@ -66,6 +69,8 @@ -- See 'LoggerConfig' for more details. setupLogging :: MonadIO m => Maybe (UTCTime -> Text) -> LoggerConfig -> m () setupLogging mTimeFunction LoggerConfig{..} = do+ liftIO $ createDirectoryIfMissing True handlerPrefix+ whenJust consoleAction $ \customTerminalAction -> initTerminalLogging timeF customTerminalAction@@ -74,8 +79,10 @@ _lcTermSeverityOut _lcTermSeverityErr + liftIO $ setPrefix _lcLogsDirectory processLoggers mempty _lcTree where+ handlerPrefix = _lcLogsDirectory ?: "." logMapper = appEndo _lcMapper timeF = fromMaybe centiUtcTimeF mTimeFunction isShowTime = getAny _lcShowTime@@ -95,7 +102,7 @@ forM_ _ltFiles $ \HandlerWrap{..} -> liftIO $ do let fileSeverities = (_ltSeverity) ?: debugPlus- let handlerPath = _hwFilePath+ let handlerPath = handlerPrefix </> _hwFilePath case handlerFabric of HandlerFabric fabric -> do let handlerCreator = fabric handlerPath fileSeverities@@ -169,6 +176,7 @@ - Error _ltFiles: [] termSeveritiesOut: null+filePrefix: null termSeveritiesErr: null @
src/System/Wlog/LoggerConfig.hs view
@@ -33,6 +33,7 @@ -- ** Lenses , lcConsoleAction+ , lcLogsDirectory , lcMapper , lcRotation , lcShowTime@@ -46,6 +47,8 @@ , consoleActionB , customConsoleActionB , mapperB+ , maybeLogsDirB+ , logsDirB , productionB , showTidB , showTimeB@@ -241,6 +244,11 @@ -- | Defines how to transform logger names in config. , _lcMapper :: Endo LoggerName + -- | Specifies directory for log files. This can be useful to avoid+ -- prefixes if you have a lot of loggers. Another use case: different logger+ -- directories on different platforms.+ , _lcLogsDirectory :: Maybe FilePath+ -- | Hierarchical tree of loggers. , _lcTree :: LoggerTree }@@ -256,6 +264,7 @@ , _lcShowTid = andCombiner _lcShowTid , _lcConsoleAction = andCombiner _lcConsoleAction , _lcMapper = andCombiner _lcMapper+ , _lcLogsDirectory = orCombiner _lcLogsDirectory , _lcTree = andCombiner _lcTree } where@@ -273,6 +282,7 @@ , _lcShowTid = mempty , _lcConsoleAction = mempty , _lcMapper = mempty+ , _lcLogsDirectory = Nothing , _lcTree = mempty } @@ -285,6 +295,7 @@ _lcTermSeverityErr <- parseSeverities o "termSeveritiesErr" _lcShowTime <- Any <$> o .:? "showTime" .!= False _lcShowTid <- Any <$> o .:? "showTid" .!= False+ _lcLogsDirectory <- o .:? "filePrefix" -- TODO: this field should be named "logsDirectory" but we keep previous name for backwards compatibility _lcTree <- o .:? "loggerTree" .!= mempty printConsoleFlag <- o .:? "printOutput" .!= False@@ -302,6 +313,7 @@ , "showTime" .= getAny _lcShowTime , "showTid" .= getAny _lcShowTid , "printOutput" .= maybe False (const True) (getLast _lcConsoleAction)+ , "filePrefix" .= _lcLogsDirectory , ("logTree", toJSON _lcTree) ] ----------------------------------------------------------------------------@@ -338,3 +350,11 @@ -- | Setup 'lcMapper' inside 'LoggerConfig'. mapperB :: (LoggerName -> LoggerName) -> LoggerConfig mapperB loggerNameMapper = mempty { _lcMapper = Endo loggerNameMapper }++-- | Setup 'lcLogsDirectory' inside 'LoggerConfig' to optional prefix.+maybeLogsDirB :: Maybe FilePath -> LoggerConfig+maybeLogsDirB prefix = mempty { _lcLogsDirectory = prefix }++-- | Setup 'lcLogsDirectory' inside 'LoggerConfig' to specific prefix.+logsDirB :: FilePath -> LoggerConfig+logsDirB = maybeLogsDirB . Just
test/Test/Wlog/RollingSpec.hs view
@@ -20,9 +20,10 @@ import Test.QuickCheck.Monadic (PropertyM, monadicIO, run) import System.Wlog (HandlerWrap (..), InvalidRotation (..), LoggerConfig (..),- RotationParameters (..), debugPlus, fromScratch, isValidRotation, lcRotation,- lcTree, logDebug, logIndex, ltFiles, ltSeverity, removeAllHandlers,- rotationFileHandler, setupLogging, usingLoggerName, whenExist, zoomLogger)+ RotationParameters (..), debugPlus, fromScratch, isValidRotation,+ lcLogsDirectory, lcRotation, lcTree, logDebug, logIndex, ltFiles, ltSeverity,+ removeAllHandlers, rotationFileHandler, setupLogging, usingLoggerName,+ whenExist, zoomLogger) spec :: Spec spec = do@@ -61,11 +62,12 @@ arbitrary = LinesToLog <$> choose (1, 500) testLogFile :: FilePath-testLogFile = "logs/patak.log"+testLogFile = "patak.log" testLoggerConfig :: RotationParameters -> LoggerConfig testLoggerConfig rotParam = fromScratch $ do- lcRotation ?= rotParam+ lcRotation ?= rotParam+ lcLogsDirectory ?= "logs" zoom lcTree $ do ltSeverity ?= debugPlus zoomLogger "test" $