log-warper 1.7.3 → 1.7.4
raw patch · 6 files changed
+28/−59 lines, 6 files
Files
- CHANGES.md +6/−0
- log-warper.cabal +1/−1
- src/System/Wlog/IOLogger.hs +8/−20
- src/System/Wlog/Launcher.hs +10/−16
- src/System/Wlog/LoggerConfig.hs +0/−18
- test/Test/Wlog/RollingSpec.hs +3/−4
CHANGES.md view
@@ -1,3 +1,9 @@+1.7.4+=====++* [#55](https://github.com/serokell/log-warper/issues/55):+ Remove `lcFilePrefix` field from `LoggerConfig`.+ 1.7.3 =====
log-warper.cabal view
@@ -1,5 +1,5 @@ name: log-warper-version: 1.7.3+version: 1.7.4 synopsis: Flexible, configurable, monadic and pretty logging homepage: https://github.com/serokell/log-warper license: MIT
src/System/Wlog/IOLogger.hs view
@@ -46,7 +46,6 @@ -- ** Saving Your Changes , saveGlobalLogger , updateGlobalLogger- , setPrefix , retrieveLogContent ) where @@ -55,7 +54,6 @@ 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 (..))@@ -87,9 +85,8 @@ type LogTree = Map LoggerName Logger -data LogInternalState = LogInternalState+newtype LogInternalState = LogInternalState { liTree :: LogTree- , liPrefix :: Maybe FilePath } deriving (Generic) ---------------------------------------------------------------------------@@ -114,7 +111,6 @@ Logger { _lLevel = Just warningPlus , _lName = "" , _lHandlers = []}- liPrefix = Nothing newMVar $ LogInternalState {..} {- | Given a name, return all components of it, starting from the root.@@ -167,7 +163,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 liPrefix, result)+ return (LogInternalState newlt, result) where createLoggers :: [LoggerName] -> LogTree -> LogTree createLoggers [] lt = lt -- No names to add; return tree unmodified@@ -213,12 +209,6 @@ 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:)@@ -275,7 +265,7 @@ saveGlobalLogger :: MonadIO m => Logger -> m () saveGlobalLogger l = liftIO $ modifyMVar_ logInternalState $ \LogInternalState{..} ->- pure $ LogInternalState (M.insert (view lName l) l liTree) liPrefix+ pure $ LogInternalState (M.insert (view lName l) l liTree) -- | Helps you make changes on the given logger. Takes a function -- that makes changes and writes those changes back to the global@@ -299,15 +289,14 @@ 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+ return $ LogInternalState newTree ---------------------------------------------------------------------------- -- 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,+-- | Retrieves content of log file(s) given path. 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. --@@ -317,14 +306,13 @@ 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) $+ filter (\(HandlerT h) -> getTag h == HandlerFilelike filePath) $ 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+ [] -> takeMaybe . reverse . T.lines <$> TIO.readFile filePath xs -> error $ "Found more than one (" <> show (length xs) <> "handle with the same filePath tag, impossible."
src/System/Wlog/Launcher.hs view
@@ -42,12 +42,9 @@ 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, setPrefix, setSeveritiesMaybe,- updateGlobalLogger)+import System.Wlog.IOLogger (addHandler, removeAllHandlers, setSeveritiesMaybe, updateGlobalLogger) import System.Wlog.LoggerConfig (HandlerWrap (..), LoggerConfig (..), LoggerTree (..), fromScratch, lcConsoleAction, lcShowTime, lcTree, ltSeverity, productionB, zoomLogger)@@ -69,8 +66,6 @@ -- 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@@ -79,10 +74,8 @@ _lcTermSeverityOut _lcTermSeverityErr - liftIO $ setPrefix _lcFilePrefix processLoggers mempty _lcTree where- handlerPrefix = _lcFilePrefix ?: "." logMapper = appEndo _lcMapper timeF = fromMaybe centiUtcTimeF mTimeFunction isShowTime = getAny _lcShowTime@@ -102,7 +95,7 @@ forM_ _ltFiles $ \HandlerWrap{..} -> liftIO $ do let fileSeverities = (_ltSeverity) ?: debugPlus- let handlerPath = handlerPrefix </> _hwFilePath+ let handlerPath = _hwFilePath case handlerFabric of HandlerFabric fabric -> do let handlerCreator = fabric handlerPath fileSeverities@@ -176,7 +169,6 @@ - Error _ltFiles: [] termSeveritiesOut: null-filePrefix: null termSeveritiesErr: null @ @@ -195,15 +187,17 @@ ==== __/Example/__ Here we can see very simple working example of logging: ->>> :{->>> launchSimpleLogging "app" $ do->>> logDebug "Debug message"->>> putStrLn "Usual printing"->>> logInfo "Job's done!"->>> :}+@+ghci> __:{__+ghci| __launchSimpleLogging "app" $ do__+ghci| __logDebug "Debug message"__+ghci| __putStrLn "Usual printing"__+ghci| __logInfo "Job's done!"__+ghci| __:}__ [app:DEBUG] [2017-12-07 11:25:06.47 UTC] Debug message Usual printing [app:INFO] [2017-12-07 11:25:06.47 UTC] Job's done!+@ -} launchSimpleLogging :: (MonadIO m, MonadMask m)
src/System/Wlog/LoggerConfig.hs view
@@ -33,7 +33,6 @@ -- ** Lenses , lcConsoleAction- , lcFilePrefix , lcMapper , lcRotation , lcShowTime@@ -47,8 +46,6 @@ , consoleActionB , customConsoleActionB , mapperB- , maybePrefixB- , prefixB , productionB , showTidB , showTimeB@@ -238,9 +235,6 @@ -- | Defines how to transform logger names in config. , _lcMapper :: Endo LoggerName - -- | Path prefix to add for each logger file- , _lcFilePrefix :: Maybe FilePath- -- | Hierarchical tree of loggers. , _lcTree :: LoggerTree }@@ -257,7 +251,6 @@ , _lcShowTid = mempty , _lcConsoleAction = mempty , _lcMapper = mempty- , _lcFilePrefix = Nothing , _lcTree = mempty } @@ -269,7 +262,6 @@ , _lcShowTid = andCombiner _lcShowTid , _lcConsoleAction = andCombiner _lcConsoleAction , _lcMapper = andCombiner _lcMapper- , _lcFilePrefix = orCombiner _lcFilePrefix , _lcTree = andCombiner _lcTree } where@@ -283,7 +275,6 @@ _lcTermSeverityErr <- parseSeverities o "termSeveritiesErr" _lcShowTime <- Any <$> o .:? "showTime" .!= False _lcShowTid <- Any <$> o .:? "showTid" .!= False- _lcFilePrefix <- o .:? "filePrefix" _lcTree <- o .:? "loggerTree" .!= mempty printConsoleFlag <- o .:? "printOutput" .!= False@@ -301,7 +292,6 @@ , "showTime" .= getAny _lcShowTime , "showTid" .= getAny _lcShowTid , "printOutput" .= maybe False (const True) (getLast _lcConsoleAction)- , "filePrefix" .= _lcFilePrefix , ("logTree", toJSON _lcTree) ] ----------------------------------------------------------------------------@@ -338,11 +328,3 @@ -- | Setup 'lcMapper' inside 'LoggerConfig'. mapperB :: (LoggerName -> LoggerName) -> LoggerConfig mapperB loggerNameMapper = mempty { _lcMapper = Endo loggerNameMapper }---- | Setup 'lcFilePrefix' inside 'LoggerConfig' to optional prefix.-maybePrefixB :: Maybe FilePath -> LoggerConfig-maybePrefixB prefix = mempty { _lcFilePrefix = prefix }---- | Setup 'lcFilePrefix' inside 'LoggerConfig' to specific prefix.-prefixB :: FilePath -> LoggerConfig-prefixB = maybePrefixB . Just
test/Test/Wlog/RollingSpec.hs view
@@ -20,8 +20,8 @@ import Test.QuickCheck.Monadic (PropertyM, monadicIO, run) import System.Wlog (HandlerWrap (..), InvalidRotation (..), LoggerConfig (..),- RotationParameters (..), debugPlus, fromScratch, isValidRotation, lcFilePrefix,- lcRotation, lcTree, logDebug, logIndex, ltFiles, ltSeverity, removeAllHandlers,+ RotationParameters (..), debugPlus, fromScratch, isValidRotation, lcRotation,+ lcTree, logDebug, logIndex, ltFiles, ltSeverity, removeAllHandlers, rotationFileHandler, setupLogging, usingLoggerName, whenExist, zoomLogger) spec :: Spec@@ -61,12 +61,11 @@ arbitrary = LinesToLog <$> choose (1, 500) testLogFile :: FilePath-testLogFile = "patak.log"+testLogFile = "logs/patak.log" testLoggerConfig :: RotationParameters -> LoggerConfig testLoggerConfig rotParam = fromScratch $ do lcRotation ?= rotParam- lcFilePrefix ?= "logs" zoom lcTree $ do ltSeverity ?= debugPlus zoomLogger "test" $