canteven-log 0.3.0.3 → 1.0.0.0

raw patch · 4 files changed

+31/−139 lines, 4 filesdep −canteven-configdep −hsloggerPVP ok

version bump matches the API change (PVP)

Dependencies removed: canteven-config, hslogger

API changes (from Hackage documentation)

Files

• canteven-log.cabal +1/−4
• src/Canteven/Log.hs +0/−60
• src/Canteven/Log/MonadLog.hs +13/−60
• src/Canteven/Log/Types.hs +17/−15

@@ -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 <https://hackage.haskell.org/package/canteven-config canteven-config>@@ -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,

@@ -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"

@@ -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

@@ -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}