log4hs 0.7.1.0 → 0.8.0.0

raw patch · 15 files changed

+229/−41 lines, 15 filesdep +vformat-aesondep ~vformatPVP ok

version bump matches the API change (PVP)

Dependencies added: vformat-aeson

Dependency ranges changed: vformat

API changes (from Hackage documentation)

Files

• ChangeLog.md +5/−0
• log4hs.cabal +11/−5
• src/Logging/Class.hs +2/−0
• src/Logging/Class/Message.hs +46/−0
• src/Logging/Config/Type.hs +6/−8
• src/Logging/Global/Internal.hs +13/−12
• src/Logging/Global/TH.hs +6/−3
• src/Logging/Global/TH/Context.hs +52/−0
• src/Logging/Manager.hs +5/−0
• src/Logging/Monad/Internal.hs +6/−3
• src/Logging/Monad/TH.hs +7/−6
• src/Logging/Monad/TH/Context.hs +64/−0
• src/Logging/Record.hs +4/−0
• test/LoggingTest/ConfigSpec.hs +0/−4
• test/LoggingTest/Prelude.hs +2/−0

@@ -1,5 +1,10 @@ # Changelog for log4hs +## V0.8.0+- Add `IsMessage` class+- Deprecate `catchUncaughtException`+- Add support for contextual logging+ ## V0.7.1 - Fix error handling issue 

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 40bf737c00b6bef41f168df6d0a764776ea87f6bd584dc12b6e12ce2764770b6+-- hash: 8762d58dd571f8027cd0efeab16d060754fa1b0c76d87bd50f61fac31e7f116a  name:           log4hs-version:        0.7.1.0+version:        0.8.0.0 synopsis:       A python logging style log library description:    Please see the http://hackage.haskell.org/package/log4hs category:       logging@@ -30,6 +30,7 @@       Logging.Filter       Logging.Global       Logging.Global.TH+      Logging.Global.TH.Context       Logging.Handler.FileHandler       Logging.Handler.RotatingFileHandler       Logging.Handler.StreamHandler@@ -39,6 +40,7 @@       Logging.Manager       Logging.Monad       Logging.Monad.TH+      Logging.Monad.TH.Context       Logging.Prelude       Logging.Record       Logging.Sink@@ -48,6 +50,7 @@   other-modules:       Logging.Class.Filterable       Logging.Class.Handler+      Logging.Class.Message       Logging.Global.Internal       Logging.Monad.Internal       Paths_log4hs@@ -67,7 +70,8 @@     , template-haskell >=2.0 && <3.0     , text >=1.2 && <2.0     , time >=1.4 && <2.0-    , vformat >=0.13 && <1.0+    , vformat >=0.14.1 && <1.0+    , vformat-aeson >=0.1 && <1.0     , vformat-time >=0.1 && <1.0     , yaml >=0.9 && <1.0   default-language: Haskell2010@@ -104,7 +108,8 @@     , template-haskell >=2.0 && <3.0     , text >=1.2 && <2.0     , time >=1.4 && <2.0-    , vformat >=0.13 && <1.0+    , vformat >=0.14.1 && <1.0+    , vformat-aeson >=0.1 && <1.0     , vformat-time >=0.1 && <1.0     , yaml >=0.9 && <1.0   default-language: Haskell2010@@ -134,7 +139,8 @@     , template-haskell >=2.0 && <3.0     , text >=1.2 && <2.0     , time >=1.4 && <2.0-    , vformat >=0.13 && <1.0+    , vformat >=0.14.1 && <1.0+    , vformat-aeson >=0.1 && <1.0     , vformat-time >=0.1 && <1.0     , yaml >=0.9 && <1.0   default-language: Haskell2010

@@ -1,8 +1,10 @@ module Logging.Class   ( module Logging.Class.Filterable   , module Logging.Class.Handler+  , module Logging.Class.Message   ) where   import           Logging.Class.Filterable import           Logging.Class.Handler+import           Logging.Class.Message

@@ -0,0 +1,46 @@+module Logging.Class.Message ( IsMessage(..) ) where++import           Control.Exception+import           Data.Aeson+import qualified Data.ByteString.Char8      as B8+import qualified Data.ByteString.Lazy.Char8 as LB8+import           Data.List                  (intercalate)+import qualified Data.Text                  as T+import qualified Data.Text.Lazy             as LT++{-| A class for datatypes that can be converted to log message.++@since 0.8.0+-}+class IsMessage a where+  toMessage :: a -> String++  toMessageList :: [a] -> String+  toMessageList [] = ""+  toMessageList xs = "[" ++ (intercalate "," $ map toMessage xs) ++ "]"++instance IsMessage Char where+  toMessage = (: "")+  toMessageList = id++instance IsMessage B8.ByteString where+  toMessage = B8.unpack++instance IsMessage LB8.ByteString where+  toMessage = LB8.unpack++instance IsMessage T.Text where+  toMessage = T.unpack++instance IsMessage LT.Text where+  toMessage = LT.unpack++instance IsMessage Value where+  toMessage = toMessage . encode++instance IsMessage SomeException where+  toMessage = show++instance IsMessage a => IsMessage [a] where+  {-# SPECIALIZE instance IsMessage [Char] #-}+  toMessage = toMessageList

@@ -99,12 +99,11 @@ instance FromJSON Sink  -data Config = Config { sinks                  :: Maybe (Map String Sink)-                     , handlers               :: Maybe (Map String Handler)-                     , formatters             :: Maybe (Map String String)-                     , timezone               :: Maybe String -- ^ @since 0.7.0-                     , disabled               :: Maybe Bool-                     , catchUncaughtException :: Maybe Bool+data Config = Config { sinks      :: Maybe (Map String Sink)+                     , handlers   :: Maybe (Map String Handler)+                     , formatters :: Maybe (Map String String)+                     , timezone   :: Maybe String -- ^ @since 0.7.0+                     , disabled   :: Maybe Bool                      } deriving (Generic, Show)  instance FromJSON Config@@ -128,8 +127,7 @@         sinks' = delete "root" sinks         timezone' = maybe defaultTimezone read timezone         disabled' = fromMaybe False disabled-        catchUncaughtException' = fromMaybe False catchUncaughtException-    return $ T.Manager root sinks' timezone' disabled' catchUncaughtException'+    return $ T.Manager root sinks' timezone' disabled' False   where     formatters' :: Map String Format1     formatters' = maybe (singleton "" "{message}") (map fromString) formatters

@@ -10,10 +10,12 @@ import           Control.Exception import           Control.Monad import           Control.Monad.IO.Class+import           Data.Aeson import           Data.IORef import           Prelude                hiding (log) import           System.IO.Unsafe +import           Logging.Class import           Logging.Level import           Logging.Logger import           Logging.Manager@@ -25,16 +27,15 @@   error "Global logging manager is not set, see Logging.Global.run"  -log :: MonadIO m-     => Logger -> Level -> String -> (String, String, String, Int)-     -> m ()-log logger level message location = liftIO $ do+log :: (MonadIO m, IsMessage s, ToJSON c)+    => Logger -> Level -> s -> c -> (String, String, String, Int) -> m ()+log logger level msg ctx location = liftIO $ do   manager <- readIORef ref-  M.runLoggingT (M.log logger level message location) manager+  M.runLoggingT (M.log logger level msg ctx location) manager  {-| Run the global logging environment. -You should always run you application in the global logging environment.+Run you application in the global logging environment.    @     main :: IO ()@@ -63,17 +64,17 @@       forkIO app2       ...   @++Note: If there is an unhandled 'Exception' in your application, it will be+logged into the __root__ 'Sink', and then rethrown. -} run :: Manager -> IO a -> IO a run manager@Manager{..} io = do     bracket_ (initialize manager >> atomicWriteIORef ref manager)              (terminate manager)-             (runInner catchUncaughtException io)+             (catch io logThrow)   where     unknownLoc = ("unknown file", "unknown package", "unknown module", 0) -    runInner :: Bool -> IO a -> IO a-    runInner False io = io-    runInner True io  = catch io $ \e -> do-      log "" "ERROR" (show (e :: SomeException)) unknownLoc-      runInner True io+    logThrow :: SomeException -> IO a+    logThrow e = log "" "ERROR" e Null unknownLoc >> throw e

@@ -15,9 +15,11 @@   ) where  import           Control.Monad.IO.Class  (MonadIO)+import           Data.Aeson import           Language.Haskell.TH import           Prelude                 hiding (error, log) +import           Logging.Class import           Logging.Global.Internal import           Logging.Level import           Logging.Logger@@ -25,7 +27,7 @@ -- | Log "message" with the severity "level". -- -- The missing type signature:--- 'MonadIO' m => 'Logger' -> 'Level' -> 'String' -> m ()+-- ('MonadIO' m, 'IsMessage' s) => 'Logger' -> 'Level' -> s -> m () logv :: ExpQ logv = do   loc <- location@@ -34,11 +36,12 @@       modulename = loc_module loc       lineno = fst $ loc_start loc       location = (filename, packagename, modulename, lineno)-  [| \logger level msg -> log logger level msg location |]+  [| \logger level msg -> log logger level msg Null location |]  -- | Log "message" with a specific severity. ----- The missing type signature: 'MonadIO' m => 'Logger' -> 'String' -> m ()+-- The missing type signature:+-- ('MonadIO' m, 'IsMessage' s) => 'Logger' -> s -> m () debug, info, warn, error, fatal :: ExpQ debug = [| \logger -> $(logv) logger $ read "DEBUG" |] info  = [| \logger -> $(logv) logger $ read "INFO" |]

@@ -0,0 +1,52 @@+{-# LANGUAGE QuasiQuotes     #-}+{-# LANGUAGE TemplateHaskell #-}++{-| A contextual version of "Logging.Global.TH".++@since 0.8.0+-}++module Logging.Global.TH.Context+  ( logv+  , debug+  , info+  , warn+  , error+  , fatal+  ) where++import           Control.Monad.IO.Class  (MonadIO)+import           Data.Aeson+import           Language.Haskell.TH+import           Prelude                 hiding (error, log)++import           Logging.Class+import           Logging.Global.Internal+import           Logging.Level+import           Logging.Logger++-- | Log "message" with the severity "level".+--+-- The missing type signature:+-- ('MonadIO' m, 'IsMessage' s, 'ToJSON' c) => 'Logger' -> 'Level' -> s -> c+-- -> m ()+logv :: ExpQ+logv = do+  loc <- location+  let filename = loc_filename loc+      packagename = loc_package loc+      modulename = loc_module loc+      lineno = fst $ loc_start loc+      location = (filename, packagename, modulename, lineno)+  [| \logger level msg ctx -> log logger level msg ctx location |]++-- | Log "message" with a specific severity.+--+-- The missing type signature:+-- ('MonadIO' m, 'IsMessage' s, 'ToJSON' c) => 'Logger' -> s -> c -> m ()+debug, info, warn, error, fatal :: ExpQ+debug = [| \logger -> $(logv) logger $ read "DEBUG" |]+info  = [| \logger -> $(logv) logger $ read "INFO" |]+warn  = [| \logger -> $(logv) logger $ read "WARN" |]+error = [| \logger -> $(logv) logger $ read "ERROR" |]+fatal = [| \logger -> $(logv) logger $ read "FATAL" |]

@@ -22,7 +22,12 @@                        , timezone               :: TimeZone -- ^ @since 0.7.0                        , disabled               :: Bool                        , catchUncaughtException :: Bool+                         -- ^ Since 0.8.0, unhandled+                         -- 'Exception's are logged only in the global+                         -- logging environment.                        }++{-# DEPRECATED catchUncaughtException "Will be removed" #-}   -- | Initialize a 'Manager', open all its handlers.

@@ -18,6 +18,7 @@ import           Control.Monad import           Control.Monad.IO.Class      (MonadIO (..)) import           Control.Monad.Reader+import           Data.Aeson import           Data.Default import           Data.Generics.Product.Typed import           Data.IORef@@ -52,10 +53,10 @@ runIO = lift . liftIO  -log :: MonadIO m-    => Logger -> Level -> String -> (String, String, String, Int)+log :: (MonadIO m, IsMessage s, ToJSON c)+    => Logger -> Level -> s -> c -> (String, String, String, Int)     -> LoggingT m ()-log logger level message location = do+log logger level msg ctx location = do     manager@Manager{..} <- ask     utctime <- runIO getCurrentTime     thread <- runIO myThreadId@@ -66,6 +67,8 @@         diffTime = utcTimeToPOSIXSeconds utctime         created = timestamp diffTime         msecs = milliseconds diffTime - (seconds diffTime * 1000)+        message = toMessage msg+        context = toJSON ctx      when (not disabled) $ runIO $ process logger manager LogRecord{..}   where

@@ -1,6 +1,5 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE QuasiQuotes       #-}-{-# LANGUAGE TemplateHaskell   #-}+{-# LANGUAGE QuasiQuotes     #-}+{-# LANGUAGE TemplateHaskell #-}  {-| This module provides a series of log routines that create a 'LogRecord'  and then emit a log event.@@ -23,9 +22,11 @@   ) where  import           Control.Monad.IO.Class (MonadIO)+import           Data.Aeson import           Language.Haskell.TH import           Prelude                hiding (error, log) +import           Logging.Class import           Logging.Level import           Logging.Logger import           Logging.Monad.Internal@@ -33,7 +34,7 @@ -- | Log "message" with the severity "level". -- -- The missing type signature:--- 'MonadIO' m => 'Logger' -> 'Level' -> 'String' -> 'LoggingT' m ()+-- ('MonadIO' m, 'IsMessage' s) => 'Logger' -> 'Level' -> s -> 'LoggingT' m () logv :: ExpQ logv = do   loc <- location@@ -42,12 +43,12 @@       modulename = loc_module loc       lineno = fst $ loc_start loc       location = (filename, packagename, modulename, lineno)-  [| \logger level msg -> log logger level msg location |]+  [| \logger level msg -> log logger level msg Null location |]  -- | Log "message" with a specific severity. -- -- The missing type signature:--- 'MonadIO' m => 'Logger' -> 'String' -> 'LoggingT' m ()+-- ('MonadIO' m, 'IsMessage' s) => 'Logger' -> s -> 'LoggingT' m () debug, info, warn, error, fatal :: ExpQ debug = [| \logger -> $(logv) logger $ read "DEBUG" |] info  = [| \logger -> $(logv) logger $ read "INFO" |]

@@ -0,0 +1,64 @@+{-# LANGUAGE QuasiQuotes     #-}+{-# LANGUAGE TemplateHaskell #-}++{-| A contextual version of "Logging.Monad.TH".++Logging with context is very usefull for tracking issues through log records+or analyzing log records through other tools. It also provides a solution to+custom record fields other than 'LogRecord''s fileds.++For example, by using the following 'Format1', a line of json string will be+written to a file or printed to the stderr.++@+"{{\\\"logger\\\": \\\"{logger}\\\", \\\"context\\\": {context}}}"+@++@since 0.8.0+-}++module Logging.Monad.TH.Context+  ( logv+  , debug+  , info+  , warn+  , error+  , fatal+  ) where++import           Control.Monad.IO.Class (MonadIO)+import           Data.Aeson+import           Language.Haskell.TH+import           Prelude                hiding (error, log)++import           Logging.Class+import           Logging.Level+import           Logging.Logger+import           Logging.Monad.Internal++-- | Log "message" with the severity "level".+--+-- The missing type signature:+-- ('MonadIO' m, 'IsMessage' s, 'ToJSON' c) => 'Logger' -> 'Level' -> s -> c+-- -> 'LoggingT' m ()+logv :: ExpQ+logv = do+  loc <- location+  let filename = loc_filename loc+      packagename = loc_package loc+      modulename = loc_module loc+      lineno = fst $ loc_start loc+      location = (filename, packagename, modulename, lineno)+  [| \logger level msg ctx -> log logger level msg ctx location |]++-- | Log "message" with a specific severity.+--+-- The missing type signature:+-- ('MonadIO' m, 'IsMessage' s, 'ToJSON' c) => 'Logger' -> s -> c+-- -> 'LoggingT' m ()+debug, info, warn, error, fatal :: ExpQ+debug = [| \logger -> $(logv) logger $ read "DEBUG" |]+info  = [| \logger -> $(logv) logger $ read "INFO" |]+warn  = [| \logger -> $(logv) logger $ read "WARN" |]+error = [| \logger -> $(logv) logger $ read "ERROR" |]+fatal = [| \logger -> $(logv) logger $ read "FATAL" |]

@@ -4,10 +4,12 @@ module Logging.Record ( LogRecord(..) ) where  import           Control.Concurrent+import           Data.Aeson import           Data.Time.Clock import           Data.Time.LocalTime import           GHC.Generics import           Text.Format+import           Text.Format.Aeson import           Text.Format.Time  import           Logging.Level@@ -70,6 +72,8 @@                            -- ^ Use @{utctime:%3q}@ instead.                            -- See "Text.Format.Time" and "Data.Time.Format".                            , thread     :: ThreadId+                           , context    :: Value+                           -- ^ See "vformat-aeson" package                            } deriving (Generic, Show)  instance FormatArg LogRecord

@@ -36,28 +36,24 @@       length sinks `shouldBe` 1       M.member "MyLogger" sinks `shouldBe` True       disabled `shouldBe` False-      catchUncaughtException `shouldBe` True      it "yaml" $ do       Manager{..} <- Yaml.getManager yamlRaw       length sinks `shouldBe` 1       M.member "MyLogger" sinks `shouldBe` True       disabled `shouldBe` False-      catchUncaughtException `shouldBe` True      it "json file" $ do       Manager{..} <- Json.getManagerFile "/tmp/log4hs/config.json"       length sinks `shouldBe` 1       M.member "MyLogger" sinks `shouldBe` True       disabled `shouldBe` False-      catchUncaughtException `shouldBe` True      it "yaml file" $ do       Manager{..} <- Yaml.getManagerFile "/tmp/log4hs/config.yaml"       length sinks `shouldBe` 1       M.member "MyLogger" sinks `shouldBe` True       disabled `shouldBe` False-      catchUncaughtException `shouldBe` True      it "root sink" $ do       Sink{..} <- root <$> (Json.getManager jsonRaw)

@@ -13,6 +13,7 @@   import           Control.Monad+import           Data.Aeson import           Data.List           (dropWhileEnd, intersperse) import           Data.String import           Data.Time.LocalTime@@ -72,6 +73,7 @@         created = timestamp difftime         msecs   = milliseconds difftime         thread = undefined+        context = Null     return $ LogRecord{..}