diff --git a/canteven-log.cabal b/canteven-log.cabal --- a/canteven-log.cabal +++ b/canteven-log.cabal @@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: canteven-log -version: 0.3.0.3 +version: 1.0.0.0 synopsis: A canteven way of setting up logging for your program. description: A library that uses @@ -25,7 +25,6 @@ library exposed-modules: - Canteven.Log, Canteven.Log.MonadLog other-modules: Canteven.Log.Types @@ -34,11 +33,9 @@ aeson, base >= 4 && < 5, bytestring, - canteven-config >= 1.0 && < 1.1, directory, fast-logger, filepath, - hslogger, monad-logger, template-haskell, text, diff --git a/src/Canteven/Log.hs b/src/Canteven/Log.hs deleted file mode 100644 --- a/src/Canteven/Log.hs +++ /dev/null @@ -1,60 +0,0 @@ -{-# LANGUAGE NamedFieldPuns, OverloadedStrings #-} -{- | - This module provides a way (not the best way, just *a* way) to easily set up - logging for your program without all the hassle. It uses a standard - configuration (obtained using the @canteven-config@ package) to set up the - @hslogger@ configuration. Maybe in the future we will use some kind of more - general logging monad, but for now, there are no monads here. --} -module Canteven.Log ( - setupLogging -) where - -import Canteven.Log.Types (LogPriority(LP), - LoggingConfig(LoggingConfig, logfile, level, loggers), - LoggerDetails(LoggerDetails, loggerName, loggerLevel)) -import Control.Applicative ((<$>)) -import System.Directory (createDirectoryIfMissing) -import System.FilePath (dropFileName) -import System.IO (stdout) -import System.Log (Priority(DEBUG)) -import System.Log.Formatter (simpleLogFormatter) -import System.Log.Handler (setFormatter) -import System.Log.Handler.Simple (fileHandler, streamHandler) -import System.Log.Logger (updateGlobalLogger, setHandlers, setLevel) -import qualified Canteven.Config as Config (canteven) - - -{- | - Read the program configuration, using the @canteven-config@, and set - up @hslogger@. --} -setupLogging :: IO () -setupLogging = - installConfig =<< Config.canteven - - -{- | - Do all of the things that it takes to get logging set up the way we - want it. --} -installConfig :: LoggingConfig -> IO () -installConfig LoggingConfig {logfile, level = LP level, loggers} = do - fileHandlers <- - case logfile of - Nothing -> return [] - Just filename -> do - createDirectoryIfMissing True (dropFileName filename) - file <- tweak <$> fileHandler filename DEBUG - return [file] - - console <- tweak <$> streamHandler stdout DEBUG - let handlers = console:fileHandlers - updateGlobalLogger "" (setLevel level . setHandlers handlers) - sequence_ [ - updateGlobalLogger loggerName (setLevel loggerLevel) | - LoggerDetails {loggerName = Just loggerName, loggerLevel = LP loggerLevel} <- loggers - ] - where - tweak h = setFormatter h (simpleLogFormatter logFormat) - logFormat = "[$time] $prio $loggername[$tid]: $msg" diff --git a/src/Canteven/Log/MonadLog.hs b/src/Canteven/Log/MonadLog.hs --- a/src/Canteven/Log/MonadLog.hs +++ b/src/Canteven/Log/MonadLog.hs @@ -2,26 +2,22 @@ {-# LANGUAGE OverloadedStrings #-} module Canteven.Log.MonadLog ( LoggerTImpl, - cantevenLogFormat, - getRunCantevenLoggingT, getCantevenOutput, - runCantevenLoggingDefaultT, + + {- Reexports -} + LoggingConfig(level, logfile, loggers), + LoggerDetails(loggerName, loggerPackage, loggerModule, loggerLevel) ) where -import Canteven.Config (canteven) import Canteven.Log.Types (LoggingConfig(LoggingConfig, logfile, level, loggers), LoggerDetails(LoggerDetails, loggerName, loggerPackage, - loggerModule, loggerLevel), - LogPriority(LP), - defaultLogging) + loggerModule, loggerLevel)) import Control.Applicative ((<$>)) import Control.Concurrent (ThreadId, myThreadId) import Control.Monad (when) import Control.Monad.IO.Class (MonadIO, liftIO) -import Control.Monad.Logger (LogSource, - LogLevel(LevelDebug, LevelInfo, LevelWarn, LevelError, LevelOther), - LoggingT(runLoggingT)) +import Control.Monad.Logger (LogSource, LogLevel(LevelOther)) import Data.Char (toUpper) import Data.List (dropWhileEnd, isPrefixOf, isSuffixOf) import Data.Maybe (fromMaybe, listToMaybe, mapMaybe) @@ -34,49 +30,22 @@ import System.FilePath (dropFileName) import System.IO (Handle, IOMode(AppendMode), openFile, stdout, hFlush) import System.Log.FastLogger (LogStr, fromLogStr, toLogStr) -import System.Log.Logger (Priority(DEBUG, INFO, NOTICE, WARNING, ERROR, - NOTICE, CRITICAL, ALERT, EMERGENCY)) import qualified Data.ByteString.Char8 as S8 import qualified Data.Text as T type LoggerTImpl = Loc -> LogSource -> LogLevel -> LogStr -> IO () -runCantevenLoggingT - :: (MonadIO io) - => LoggingConfig - -> LoggingT io a - -> io a -runCantevenLoggingT config action = do - handle <- liftIO $ setupHandle config - runLoggingT action (cantevenOutput config handle) - --- | Get the logging config using canteven, and produce a way to use that --- logging config to run a LoggingT. -getRunCantevenLoggingT - :: (Functor io1, MonadIO io1, MonadIO io2) - => io1 (LoggingT io2 a -> io2 a) -getRunCantevenLoggingT = - runCantevenLoggingT <$> liftIO canteven - getCantevenOutput :: (Functor io, MonadIO io) - => io LoggerTImpl -getCantevenOutput = + => LoggingConfig + -> io LoggerTImpl +getCantevenOutput config = uncurry cantevenOutput <$> liftIO setupLogger where setupLogger = do - config <- canteven handle <- setupHandle config return (config, handle) --- | Run a LoggingT, using the canteven logging format, with the default logging --- configuration. -runCantevenLoggingDefaultT - :: (MonadIO io) - => LoggingT io a - -> io a -runCantevenLoggingDefaultT = runCantevenLoggingT defaultLogging - cantevenOutput :: LoggingConfig -> Handle @@ -99,16 +68,16 @@ -- the answer given by the most specific one that matches. However, at present -- it just takes the first one. configPermits :: LoggingConfig -> Loc -> LogSource -> LogLevel -> Bool -configPermits LoggingConfig {level=LP defaultLP, loggers} = runFilters +configPermits LoggingConfig {level=defaultLP, loggers} = runFilters where predicates = map toPredicate loggers toPredicate LoggerDetails {loggerName, loggerPackage, - loggerModule, loggerLevel=LP loggerLevel} + loggerModule, loggerLevel=loggerLevel} loc src level = if matches (T.pack <$> loggerName) src && matches loggerPackage (loc_package loc) && matchesGlob loggerModule (loc_module loc) - then Just (toHSLogPriority level >= loggerLevel) + then Just (level >= loggerLevel) else Nothing -- It's considered a "match" if either the specification is absent (matches -- everything), or the specification is given and matches the target. @@ -121,27 +90,11 @@ | otherwise = pattern == candidate runFilters loc src level = -- default to the defaultLP - fromMaybe (toHSLogPriority level >= defaultLP) $ + fromMaybe (level >= defaultLP) $ -- take the first value listToMaybe $ -- of the predicates that returned Just something mapMaybe (\p -> p loc src level) predicates - - --- | Convert a monad-logger 'LogLevel' into an hslogger 'Priority'. This is --- necessary because LoggingConfig specify Priorities rather than LogLevels. -toHSLogPriority :: LogLevel -> Priority -toHSLogPriority LevelDebug = DEBUG -toHSLogPriority LevelInfo = INFO -toHSLogPriority LevelWarn = WARNING -toHSLogPriority LevelError = ERROR -toHSLogPriority (LevelOther other) = - fromMaybe EMERGENCY $ -- unknown log levels are most critical - lookup (T.toLower other) [ - ("notice", NOTICE), - ("critical", CRITICAL), - ("alert", ALERT) - ] -- | This is similar to the version defined in monad-logger (which we can't diff --git a/src/Canteven/Log/Types.hs b/src/Canteven/Log/Types.hs --- a/src/Canteven/Log/Types.hs +++ b/src/Canteven/Log/Types.hs @@ -1,22 +1,21 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} module Canteven.Log.Types ( - LogPriority(..), LoggerDetails(..), LoggingConfig(..), defaultLogging, ) where +import Control.Applicative ((<$>), (<*>)) +import Control.Monad.Logger (LogLevel(LevelDebug, LevelInfo, LevelWarn, + LevelError, LevelOther)) import Data.Aeson (Value(String, Object), (.:?), (.!=), (.:)) import Data.Maybe (catMaybes, listToMaybe) import Data.Yaml (FromJSON(parseJSON)) -import Control.Applicative ((<$>), (<*>)) -import System.Log (Priority(INFO)) -import qualified Data.Text as T data LoggingConfig = LoggingConfig { - level :: LogPriority, + level :: LogLevel, logfile :: Maybe FilePath, loggers :: [LoggerDetails] } @@ -27,7 +26,7 @@ case mLogging of Nothing -> return defaultLogging Just logging -> LoggingConfig - <$> logging .:? "level" .!= LP INFO + <$> (unLP <$> (logging .:? "level" .!= LP LevelInfo)) <*> logging .:? "logfile" <*> logging .:? "loggers" .!= [] @@ -41,22 +40,25 @@ -} defaultLogging :: LoggingConfig defaultLogging = LoggingConfig { - level = LP INFO, + level = LevelInfo, logfile = Nothing, loggers = [] } {- | - A wrapper for Priority, so we can avoid orphan instances + A wrapper for LogLevel, so we can avoid orphan instances -} -newtype LogPriority = LP Priority +newtype LogPriority = LP {unLP :: LogLevel} instance FromJSON LogPriority where - parseJSON (String s) = case reads (T.unpack s) of - [(priority, "")] -> return (LP priority) - _ -> fail $ "couldn't parse Priority from string " ++ show s - parseJSON value = fail $ "Couldn't parse Priority from value " ++ show value + parseJSON (String "DEBUG" ) = return (LP LevelDebug) + parseJSON (String "INFO" ) = return (LP LevelInfo) + parseJSON (String "WARN" ) = return (LP LevelWarn) + parseJSON (String "WARNING" ) = return (LP LevelWarn) + parseJSON (String "ERROR" ) = return (LP LevelError) + parseJSON (String s) = return (LP (LevelOther s)) + parseJSON value = fail $ "Couldn't parse LogLevel from value " ++ show value {- | @@ -77,7 +79,7 @@ loggerName :: Maybe String, loggerPackage :: Maybe String, loggerModule :: Maybe String, - loggerLevel :: LogPriority + loggerLevel :: LogLevel } instance FromJSON LoggerDetails where @@ -88,7 +90,7 @@ details .:? "source", details .:? "name"] return $ listToMaybe names - loggerLevel <- details .: "level" + loggerLevel <- unLP <$> details .: "level" loggerModule <- details .:? "module" loggerPackage <- details .:? "package" return LoggerDetails {loggerName, loggerPackage, loggerModule, loggerLevel}