hslogger-reader (empty) → 1.0.0
raw patch · 7 files changed
+536/−0 lines, 7 filesdep +attoparsecdep +basedep +hsloggersetup-changed
Dependencies added: attoparsec, base, hslogger, hslogger-reader, old-locale, optparse-applicative, text, text-icu, time
Files
- LICENSE +28/−0
- Setup.hs +2/−0
- hslogger-reader.cabal +71/−0
- src-exe/filter-logs/Arguments.hs +107/−0
- src-exe/filter-logs/Main.hs +103/−0
- src-exe/profiling/Main.hs +55/−0
- src/System/Log/Reader.hs +170/−0
+ LICENSE view
@@ -0,0 +1,28 @@+Copyright (c) 2015, Alex Bates+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++* Redistributions of source code must retain the above copyright notice, this+ list of conditions and the following disclaimer.++* Redistributions in binary form must reproduce the above copyright notice,+ this list of conditions and the following disclaimer in the documentation+ and/or other materials provided with the distribution.++* Neither the name of hslogger-reader nor the names of its+ contributors may be used to endorse or promote products derived from+ this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ hslogger-reader.cabal view
@@ -0,0 +1,71 @@+name: hslogger-reader+version: 1.0.0+synopsis: Parsing hslogger-produced logs.+description: ++ hslogger-reader provides a function to generate a parser for+ <http://hackage.haskell.org/package/hslogger hslogger>-produced logs+ from a hslogger format string (see "System.Log.Formatter"). The+ accompanying /profiling/ executable demonstrates parsing and computing+ with a log file in constant memory.++ Also bundled is the /filter-logs/ executable, a command-line tool to+ filter a hslogger-syle log file.++license: BSD3+license-file: LICENSE+author: Alex Bates+maintainer: ard.bates@gmail.com+build-type: Simple+homepage: http://github.com/prophet-on-that/hslogger-reader+bug-reports: http://github.com/prophet-on-that/hslogger-reader/issues+cabal-version: >=1.10+category: Interfaces, Parsing++library + exposed-modules:+ System.Log.Reader+ hs-source-dirs: + src+ default-language: + Haskell2010+ build-depends: + base >= 4.7 && < 5+ , attoparsec == 0.12.*+ , text == 1.2.*+ , hslogger == 1.2.*+ , time == 1.4.*+ , old-locale + ghc-options: -W++executable profiling+ hs-source-dirs: src-exe/profiling+ main-is: + Main.hs+ default-language: Haskell2010+ build-depends:+ base+ , hslogger-reader+ , text+ , attoparsec+ ghc-options: -W++executable filter-logs+ hs-source-dirs: src-exe/filter-logs+ main-is: + Main.hs+ other-modules:+ Arguments+ default-language: Haskell2010+ build-depends:+ base+ , hslogger-reader+ , text+ , attoparsec+ , hslogger+ , time+ , text-icu == 0.7.*+ , optparse-applicative == 0.11.*+ , old-locale+ ghc-options: -W+
+ src-exe/filter-logs/Arguments.hs view
@@ -0,0 +1,107 @@+module Arguments+ ( Arguments (..)+ , opts+ ) where++import Options.Applicative+import Data.Time+import System.Log.Logger+import qualified Data.Text as T+import System.Locale (defaultTimeLocale)+import Data.Maybe++data Arguments = Arguments+ { lowerTime :: Maybe UTCTime+ , upperTime :: Maybe UTCTime+ , lowerPrio :: Priority+ , upperPrio :: Priority+ , insensitive :: Bool+ , pattern :: Maybe T.Text+ , format :: T.Text+ , pid :: Maybe Int+ , tid :: Maybe Int+ , logFile :: FilePath+ }++parseArgs :: Parser Arguments+parseArgs+ = Arguments+ <$> ( optional . fmap parseUTCTime . strOption $+ ( short 'l'+ <> long "lower-time"+ <> metavar "UTCTIME"+ <> help "Ignore messages logged before this time."+ )+ )+ <*> ( optional . fmap parseUTCTime . strOption $+ ( short 'u'+ <> long "upper-time"+ <> metavar "UTCTIME"+ <> help "Ignore messages logged after this time."+ )+ )+ <*> ( option auto $+ ( short 'm'+ <> long "min-priority"+ <> value DEBUG+ <> showDefault+ <> metavar "PRIO"+ <> help "Assert a minimum message priority."+ )+ )+ <*> ( option auto $+ ( short 'n'+ <> long "max-priority"+ <> value EMERGENCY+ <> showDefault+ <> metavar "PRIO"+ <> help "Assert a maximum message priority."+ )+ )+ <*> ( switch $+ ( short 'i'+ <> long "insensitive"+ <> help "Ignore case when matching message pattern."+ )+ )+ <*> ( optional . fmap T.pack . strOption $+ ( short 'p'+ <> long "pattern"+ <> metavar "REGEXP"+ <> help "Assert a pattern the logger name must satisfy."+ )+ )+ <*> ( fmap T.pack . strOption $+ ( short 'f'+ <> long "format"+ <> value "[$utcTime $loggername $prio] $msg"+ <> showDefault+ <> metavar "FORMAT"+ <> help "Specify hslogger-style format of log files."+ )+ )+ <*> ( optional . option auto $+ ( long "process-id"+ <> metavar "PID"+ <> help "Assert logging process."+ )+ )+ <*> ( optional . option auto $+ ( long "thread-id"+ <> metavar "TID"+ <> help "Assert logging thread."+ )+ )+ <*> ( strArgument $ metavar "FILE"+ )++opts+ = info (helper <*> parseArgs)+ ( header "Filter hslogger-produced log files."+ <> fullDesc+ <> footer "Limitations: logs must use hslogger's default time format `yyyy-mm-ddThh:mm:ssZ' and logger names must not include whitespace."+ )++parseUTCTime :: String -> UTCTime+parseUTCTime+ = fromMaybe (error "Cannot parse date (expected format `yyyy-mm-ddThh:mm:ssZ'") . parseTime defaultTimeLocale "%FT%TZ"
+ src-exe/filter-logs/Main.hs view
@@ -0,0 +1,103 @@+-- | Filter hslogger-produced logs and print to standard+-- output. Requires logs to use default hslogger time format and for+-- logger names to not include whitespace.++{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveDataTypeable #-}++module Main where++import Arguments++import Options.Applicative (execParser)+import Prelude hiding (takeWhile)+import System.Log.Reader+import System.Log.Logger+import qualified Data.Text.Lazy as L+import qualified Data.Text.Lazy.IO as L+import Data.Attoparsec.Text.Lazy+import Data.Maybe+import Control.Applicative+import Data.Time+import Data.Text.ICU hiding (pattern)+import Control.Exception+import Control.Monad+import Data.Typeable+import Data.Monoid++main = do+ arguments <- execParser opts++ regex'' <- case pattern arguments of+ Nothing ->+ return Nothing+ Just pattern' -> do+ let+ regexOptions+ = if insensitive arguments+ then+ [CaseInsensitive]+ else+ []+ either (throwIO . RegexError) (return . return) $ regex' regexOptions pattern'+ messageParser <- either (throwIO . ParserError) return $ logMessageParser (format arguments) loggerNameParser++ lts <- fmap L.lines . L.readFile . logFile $ arguments+ forM lts $ \lt -> do+ lm <- either (const $ throwIO (MessageParseError lt)) return . eitherResult . parse messageParser $ lt+ let+ pred+ = filterLogMessage+ (lowerPrio arguments)+ (upperPrio arguments)+ (lowerTime arguments)+ (upperTime arguments)+ (pid arguments)+ (tid arguments)+ regex''+ + when (pred lm) $ L.putStrLn lt+ where+ loggerNameParser+ = takeTill isHorizontalSpace++filterLogMessage+ :: Priority -- ^ Lower priority+ -> Priority -- ^ Upper priority+ -> Maybe UTCTime -- ^ Lower bound on date+ -> Maybe UTCTime -- ^ Upper bound on date+ -> Maybe Int -- ^ Process ID+ -> Maybe Int -- ^ Thread ID+ -> Maybe Regex+ -> LogMessage+ -> Bool+filterLogMessage lowerPrio upperPrio lTime uTime pid tid reg lm+ = and . catMaybes $+ [ (>= lowerPrio) <$> priority lm+ , (<= upperPrio) <$> priority lm+ , liftA2 (<=) lTime $ zonedTimeToUTC <$> timestamp lm+ , liftA2 (>=) uTime $ zonedTimeToUTC <$> timestamp lm+ , liftA2 (==) pid $ processId lm+ , liftA2 (==) tid $ threadId lm+ , do+ reg' <- reg+ name <- loggerName lm+ return . fromMaybe False $ find reg' name >> return True+ ]++data Errors+ = MessageParseError L.Text+ | RegexError ParseError+ | ParserError String+ deriving (Typeable)++instance Show Errors where+ show (MessageParseError lt)+ = L.unpack $ "Format of following message does not match expected: " <> lt+ show (RegexError err)+ = "Failure parsing regular expression: " <> show err+ show (ParserError str)+ = "Failure parsing log format spec: " <> str+ +instance Exception Errors+
+ src-exe/profiling/Main.hs view
@@ -0,0 +1,55 @@+-- | Compute number of lines and maximum message length for given log+-- file and format.++{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE BangPatterns #-}++module Main where++import Prelude hiding (takeWhile)+import System.Log.Reader+import qualified Data.Text as T+import qualified Data.Text.Lazy as L+import qualified Data.Text.Lazy.IO as L+import Data.Attoparsec.Text.Lazy+import Data.Foldable+import Data.Maybe+import System.Exit+import System.Environment++main = do+ (fileName, format) <- handleArgs+ lts <- fmap L.lines $ L.readFile fileName+ let+ result = do+ parser <- logMessageParser format loggerNameParser+ let+ f (!lineCount, !maxMsgLength) lt = do+ lm <- eitherResult . parse parser $ lt+ let+ newMaxLength+ = fromMaybe maxMsgLength $ do+ msg <- message lm+ return $ max maxMsgLength (T.length msg)+ return (lineCount + 1, newMaxLength)+ foldlM f (0, 0) lts+ case result of+ Left err ->+ putStrLn err+ Right (lineCount, maxMsgLength) -> + putStrLn $ "Lines: " ++ show lineCount ++ "\tMaximum message length: " ++ show maxMsgLength+ where+ loggerNameParser+ = takeTill isHorizontalSpace++ handleArgs :: IO (FilePath, T.Text)+ handleArgs = do+ args <- getArgs+ case args of+ [fileName, format] ->+ return (fileName, T.pack format)+ _ -> do+ name <- getProgName+ putStrLn $ "Usage: " ++ name ++ " format_string path/to/log/file"+ exitFailure+
+ src/System/Log/Reader.hs view
@@ -0,0 +1,170 @@+-- | Generate a parser for logs produced by the+-- <http://hackage.haskell.org/package/hslogger hslogger> package,+-- supporting arbitrary formatting strings (see+-- "System.Log.Formatter"). Currently, this package does provide+-- support for custom-defined formatters.+--+-- 'logMessageParser' will generate a parser for a 'LogMessage' given+-- a format string (such @ "[$utcTime $loggername $prio] $msg" @) and+-- a parser for your logger names. This can then be used to read logs+-- line-by-line, potentially in constant memory, from disk. See the+-- accompanying executable for an example of this.++{-# LANGUAGE OverloadedStrings #-}++module System.Log.Reader+ ( LogMessage (..)+ , FormatString+ , logMessageParser+ , tfLogMessageParser+ -- * Extras+ , zonedTimeParser+ ) where++import Prelude hiding (takeWhile)+import Data.Attoparsec.Text.Lazy +import qualified Data.Text as T+import Control.Applicative+import Data.Foldable+import System.Log+import Data.Time+import Data.Char (isAlpha)+import Data.Monoid+import System.Locale (defaultTimeLocale)++type FormatString = T.Text++data LogMessage = LogMessage+ { message :: Maybe T.Text+ , loggerName :: Maybe T.Text+ , priority :: Maybe Priority+ , threadId :: Maybe Int+ , processId :: Maybe Int+ , timestamp :: Maybe ZonedTime+ } deriving (Show)++data Instruction+ = Noise T.Text+ | Message+ | LoggerName+ | Priority+ | ThreadId+ | ProcessId+ | Time+ | TimeUTC+ deriving (Show)++formatStringParser :: Parser [Instruction]+formatStringParser+ = handleEOI <|> do+ instr <- handleNoise <|> do+ char '$'+ instr <- takeWhile isAlpha+ case instr of+ "msg" -> return Message+ "loggername" -> return LoggerName+ "prio" -> return Priority+ "tid" -> return ThreadId+ "pid" -> return ProcessId+ "time" -> return Time+ "utcTime" -> return TimeUTC+ str -> fail $ "Formatter `" ++ T.unpack str ++ "' is unsupported, use one of $msg, $loggername, $prio, $tid, $pid, $time, $utcTime"+ (instr :) <$> formatStringParser+ where+ handleEOI :: Parser [Instruction]+ handleEOI = do+ endOfInput+ return []++ handleNoise = do+ noise <- takeWhile1 (/= '$')+ return $ Noise noise++buildParser+ :: Parser T.Text -- ^ LoggerName parser+ -> Parser ZonedTime+ -> [Instruction]+ -> Parser LogMessage+buildParser loggerNameParser zonedTimeParser+ = foldlM helper $ LogMessage Nothing Nothing Nothing Nothing Nothing Nothing + where+ helper :: LogMessage -> Instruction -> Parser LogMessage+ helper lm (Noise noise) = do+ _ <- string noise+ return lm+ helper lm Message = do+ msg <- takeTill isEndOfLine+ return $ lm { message = Just msg }+ helper lm LoggerName = do+ name <- loggerNameParser+ return $ lm { loggerName = Just name }+ helper lm Priority = do+ prio <- parsePriority+ return $ lm { priority = Just prio }+ where+ parsePriority :: Parser Priority+ parsePriority+ = ("DEBUG" >> return DEBUG) <|>+ ("INFO" >> return INFO) <|>+ ("NOTICE" >> return NOTICE) <|> + ("WARNING" >> return WARNING) <|> + ("ERROR" >> return ERROR) <|> + ("CRITICAL" >> return CRITICAL) <|> + ("ALERT" >> return ALERT) <|> + ("EMERGENCY" >> return EMERGENCY) <|>+ (fail "Priority not recognised")+ helper lm ThreadId = do+ tid <- decimal+ return $ lm { threadId = Just tid }+ helper lm ProcessId = do+ pid <- decimal+ return $ lm { processId = Just pid }+ helper lm Time = do+ time' <- zonedTimeParser+ return $ lm { timestamp = Just time' }+ helper lm TimeUTC = do+ time' <- zonedTimeParser+ return $ lm { timestamp = Just time' }++-- | Build a parser for a 'LogMessage' from a format string, as+-- described by the hslogger package.+logMessageParser+ :: FormatString+ -> Parser T.Text -- ^ LoggerName parser+ -> Either String (Parser LogMessage)+logMessageParser format loggerNameParser+ = tfLogMessageParser format loggerNameParser zonedTimeParser++-- | As 'logMessageParser', but provide a custom time format for+-- parsing @ "$time" @ and @ "$utcTime" @ formatters. Compatible with+-- hslogger's /tfLogFormatter/ function.+tfLogMessageParser+ :: FormatString+ -> Parser T.Text -- ^ LoggerName parser+ -> Parser ZonedTime -- ^ Time parser+ -> Either String (Parser LogMessage)+tfLogMessageParser format loggerNameParser zonedTimeParser = do+ instrs <- parseOnly (formatStringParser <* endOfInput) format+ return $ buildParser loggerNameParser zonedTimeParser instrs++-- | Parse time format string @ "%F %X %Z" @ with 'defaultTimeLocale'.+zonedTimeParser :: Parser ZonedTime+zonedTimeParser = do+ date <- takeWhile (inClass "-0-9")+ skipSpace+ time <- takeWhile (inClass ":0-9")+ skipSpace+ tzName <- takeWhile isAlpha+ let+ str+ = date `space` time `space` tzName+ + case parseTime defaultTimeLocale "%F %X %Z" (T.unpack str) of+ Nothing ->+ fail "zonedTimeParse: failed to parse ZonedTime"+ Just zt ->+ return zt+ where+ space a b+ = a <> " " <> b+