diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,11 @@ # Changelog for log4hs +## V0.9.0 +- Fix log `UserInterrupt` issue +- Improve config datatypes +- Improve document and deprecate `Logging` module +- Replace lens with macrolens and remove `data-default` + ## V0.8.0 - Add `IsMessage` class - Deprecate `catchUncaughtException` diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,13 +1,38 @@ # A python logging style log library. - ## Documentation -See [hackage](http://hackage.haskell.org/package/log4hs) +Please See http://hackage.haskell.org/package/log4hs +## Example +```haskell +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +module Main ( main ) where + +import Logging.Config.Json (getManager) +import Logging.Global (run) +import Logging.Global.TH (debug, error, fatal, info, logv, warn) +import Prelude hiding (error) + +main :: IO () +main = getManager "{}" >>= flip run app + +logger = "Main" + +app :: IO () +app = do + $(debug) logger "this is a test message" + $(info) logger "this is a test message" + $(warn) logger "this is a test message" + $(error) logger "this is a test message" + $(fatal) logger "this is a test message" + $(logv) logger "LEVEL 100" "this is a test message" +``` + ## Contributing The source code will be opened to public after version 1.0.0 released. So, please wait. @@ -16,7 +41,7 @@ ## Issue Reporting -Please send email to log4hs@version.cloud for now. +Please send email to jorah@version.cloud for now. diff --git a/bench/Main.hs b/bench/Main.hs --- a/bench/Main.hs +++ b/bench/Main.hs @@ -16,8 +16,9 @@ import Data.Maybe import System.IO.Unsafe -import Logging import Logging.Config.Json +import Logging.Global +import Logging.Manager main :: IO () diff --git a/log4hs.cabal b/log4hs.cabal --- a/log4hs.cabal +++ b/log4hs.cabal @@ -4,14 +4,23 @@ -- -- see: https://github.com/sol/hpack -- --- hash: 8762d58dd571f8027cd0efeab16d060754fa1b0c76d87bd50f61fac31e7f116a +-- hash: 54029a04d065d8d1436594a85e50470a60c6e1632498264c0264328308d53be7 name: log4hs -version: 0.8.0.0 +version: 0.9.0.0 synopsis: A python logging style log library -description: Please see the http://hackage.haskell.org/package/log4hs -category: logging -maintainer: Jorah Gao +description: @log4hs@ aims at providing a rich featured logging library for Haskell, + just like @logging@ for Python and @log4j@ for Java. + . + . + To get started, see the sample example in @README.md@ and document in + hackage. + . + . + It's still under development, so be carefull when using it in production + environment. +category: logging, log, library +maintainer: Jorah Gao copyright: (c) 2019 Version Cloud license: BSD3 license-file: LICENSE @@ -44,9 +53,6 @@ Logging.Prelude Logging.Record Logging.Sink - Logging.TH - Logging.Types - Logging.Utils other-modules: Logging.Class.Filterable Logging.Class.Handler @@ -58,14 +64,14 @@ src build-depends: aeson >=1.2 && <2.0 + , aeson-default >=0.9 && <1.0 , base >=4.7 && <5 , bytestring >=0.10 && <1.0 , containers >=0.5.10 && <1.0 - , data-default >=0.5 && <1.0 , directory >=1.2 && <1.4 , filepath >=1.3 && <1.5 , generic-lens >=0.5 && <2.0 - , lens >=4.15 && <5.0 + , microlens >=0.4 && <1.0 , mtl >=2.2 && <3.0 , template-haskell >=2.0 && <3.0 , text >=1.2 && <2.0 @@ -91,18 +97,18 @@ build-depends: QuickCheck >=2.0 && <3.0 , aeson >=1.2 && <2.0 + , aeson-default >=0.9 && <1.0 , aeson-qq >=0.8 && <1.0 , base >=4.7 && <5 , bytestring >=0.10 && <1.0 , containers >=0.5.10 && <1.0 - , data-default >=0.5 && <1.0 , directory >=1.2 && <1.4 , filepath >=1.3 && <1.5 , generic-lens >=0.5 && <2.0 , hspec >=2.1 && <3.0 , hspec-core >=2.1 && <3.0 - , lens >=4.15 && <5.0 , log4hs + , microlens >=0.4 && <1.0 , mtl >=2.2 && <3.0 , process >=1.2 && <2.0 , template-haskell >=2.0 && <3.0 @@ -124,17 +130,17 @@ ghc-options: -threaded -rtsopts -with-rtsopts=-N build-depends: aeson >=1.2 && <2.0 + , aeson-default >=0.9 && <1.0 , aeson-qq >=0.8 && <1.0 , base >=4.7 && <5 , bytestring >=0.10 && <1.0 , containers >=0.5.10 && <1.0 , criterion >=1.0 && <2.0 - , data-default >=0.5 && <1.0 , directory >=1.2 && <1.4 , filepath >=1.3 && <1.5 , generic-lens >=0.5 && <2.0 - , lens >=4.15 && <5.0 , log4hs + , microlens >=0.4 && <1.0 , mtl >=2.2 && <3.0 , template-haskell >=2.0 && <3.0 , text >=1.2 && <2.0 diff --git a/src/Logging.hs b/src/Logging.hs --- a/src/Logging.hs +++ b/src/Logging.hs @@ -2,49 +2,12 @@ Module : Logging Copyright : (c) 2019 Version Cloud License : BSD3 -Maintainer : Jorah Gao +Maintainer : Jorah Gao Stability : experimental Portability : portable - -= A python logging style log library. - -=== A simple example: - -@ - \{\-\# LANGUAGE OverloadedStrings \#\-\} - \{\-\# LANGUAGE TemplateHaskell \#\-\} - - module Main ( main ) where - - import Logging.Config.Json (getManager) - import Logging.Global (run) - import Logging.Global.TH (debug, error, fatal, info, logv, warn) - import Prelude hiding (error) - - main :: IO () - main = getManager "{}" >>= flip run app - - logger = \"Main\" - - app :: IO () - app = do - $(debug) logger \"this is a test message\" - $(info) logger \"this is a test message\" - $(warn) logger \"this is a test message\" - $(error) logger \"this is a test message\" - $(fatal) logger \"this is a test message\" - $(logv) logger \"LEVEL 100\" \"this is a test message\" -@ - -See "Logging.Config.Json" and "Logging.Config.Yaml" to lean more about -decoding 'Manager' from json or yaml -} -module Logging - ( module Logging.Types - , module Logging.TH - , module Logging.Global +module Logging {-# Deprecated "Use submodules directly" #-} + ( module Logging.Global ) where import Logging.Global -import Logging.TH -import Logging.Types diff --git a/src/Logging/Class/Handler.hs b/src/Logging/Class/Handler.hs --- a/src/Logging/Class/Handler.hs +++ b/src/Logging/Class/Handler.hs @@ -7,10 +7,11 @@ module Logging.Class.Handler ( SomeHandler(..), Handler(..) ) where import Control.Exception (SomeException, catch) -import Control.Lens (set, view) import Control.Monad (when) import Data.Generics.Product.Typed import Data.Typeable +import Lens.Micro (set) +import Lens.Micro.Extras (view) import Prelude hiding (filter) import Text.Format diff --git a/src/Logging/Config/Json.hs b/src/Logging/Config/Json.hs --- a/src/Logging/Config/Json.hs +++ b/src/Logging/Config/Json.hs @@ -1,32 +1,9 @@ -{-| This module provides a convenient way to decode a 'Manager' from json string - -There is a 'Config' type in "Logging.Config.Type" module, it is an instance -of 'FromJSON', 1) decode 'Config' from json string, 2) construct an 'Manager' -from 'Config'. - - -All 'Maybe' fileds can be omitted, the default value will be used, e.g. - -1) 'List' type field will use '[]' as default - -2) 'Purelude.Bool' type filed will use False as default - -3) if the field is an instance of 'Data.Default.Default', use 'def' - -4) an appropriate value as default for other fields - - -In fact, you can decode 'Config' from an empty json (object) string, - -@ - manager <- getManager "{}" -- enable the 'OverloadedStrings' extension -@ - -it will create a manager with a root sink (i.e. 'Logging.defaultRoot'), -the 'Logging.defaultRoot' will be used when the root sink is omitted. +{-|This module provides a convenient way to decode a 'Manager' from json string -Here is a json string template: +Note: You are recommend to use "Logging.Config.Yaml", because of yaml is easier +to read and write. +=== Template @ { \"sinks\": @@ -61,7 +38,7 @@ \"level\": \"Level 100\", \"filterer\": [\"App.Json\"], \"formatter\": \"standard\", - \"file\": \"/etc\/my\/json.log\", + \"file\": \"\/var\/log\/my\/json.log", \"encoding\": \"utf8\" }, \"rotate\": @@ -70,7 +47,7 @@ \"level\": \"INFO\", \"filterer\": [\"App.Yaml\"], \"formatter\": \"standard\", - \"file\": \"/etc\/my\/yaml.log\", + \"file\": \"\/var\/log\/my\/json.log", \"encoding\": \"utf8\", \"maxBytes\": 1048576, \"backupCount\": 10 @@ -81,13 +58,10 @@ \"simple\": \"{message}\", \"standard\": \"{asctime:%Y-%m-%dT%H:%M:%S%6Q%z} - {level} - {logger}] {message}\" }, - \"disabled\": false, - \"catchUncaughtException\": true + \"disabled\": false } @ - -} - module Logging.Config.Json (getManager, getManagerFile) where @@ -100,7 +74,8 @@ import Logging.Manager --- | decode a 'Manager' from strict 'ByteString' +-- | decode a 'Manager' from strict 'ByteString', it +-- 1) decodes 'Config' from json string, 2) constructs an 'Manager' -- -- @since 0.4.0 getManager :: ByteString -> IO Manager @@ -110,7 +85,8 @@ Right config -> createManager config --- | decode a 'Manager' from a file +-- | decode a 'Manager' from a file, it +-- 1) reads json string from file, 2) calls getManager to construct an 'Manager' -- -- @since 0.4.0 getManagerFile :: FilePath -> IO Manager diff --git a/src/Logging/Config/Type.hs b/src/Logging/Config/Type.hs --- a/src/Logging/Config/Type.hs +++ b/src/Logging/Config/Type.hs @@ -1,5 +1,7 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} @@ -8,6 +10,9 @@ , Sink(..) , Config(..) , ConfigException(..) + , HandlerH(..) + , SinkH(..) + , ConfigH(..) , createManager ) where @@ -15,7 +20,10 @@ import Control.Concurrent.MVar import Control.Exception (Exception) import Data.Aeson -import Data.Default +import Data.Aeson.Default +import Data.Aeson.Default.HKD +import Data.Aeson.Default.Map.Strict +import Data.Functor.Identity import Data.IORef import Data.Map.Lazy import Data.Maybe @@ -23,92 +31,154 @@ import Data.Time.Clock import Data.Time.LocalTime import GHC.Generics -import System.IO - import Prelude hiding (map) import qualified Prelude as P +import System.IO import Text.Format hiding (defaultOptions) import qualified Logging.Class as T +import qualified Logging.Filter as T import qualified Logging.Handler.FileHandler as T import qualified Logging.Handler.RotatingFileHandler as T import qualified Logging.Handler.StreamHandler as T import qualified Logging.Handler.TimeRotatingFileHandler as T +import qualified Logging.Level as T import qualified Logging.Manager as T import Logging.Prelude import qualified Logging.Sink as T -data Handler = StreamHandler { level :: Maybe String - , filterer :: Maybe [String] - , formatter :: Maybe String - , stream :: Maybe String - } - | FileHandler { level :: Maybe String - , filterer :: Maybe [String] - , formatter :: Maybe String - , file :: FilePath - , encoding :: Maybe String - -- ^ See 'System.IO.mkTextEncoding', - -- default is utf8. - } - | RotatingFileHandler { level :: Maybe String - , filterer :: Maybe [String] - , formatter :: Maybe String - , file :: FilePath - , encoding :: Maybe String - -- ^ See 'System.IO.mkTextEncoding', - -- default is utf8. - , maxBytes :: Maybe Int - -- ^ Default is 100 MB. - , backupCount :: Maybe Int - -- ^ Default is 10. - } - | TimeRotatingFileHandler { level :: Maybe String - , filterer :: Maybe [String] - , formatter :: Maybe String - , file :: FilePath - , encoding :: Maybe String - , timezone :: Maybe String - -- ^ If not set, same as 'Manager''s - -- timezone. - , rotateTime :: Maybe String - -- ^ Indicates when to rotate file, - -- e.g. @D3@ means every 3 days, - -- @W4@ means at 0 clock of 'Thursday', - -- try showing 'RotateTime'. - , backupCount :: Maybe Int - } - -- ^ @since 0.7.0 - deriving (Generic, Show) +{-| A datatype used to decode json or yaml into 'Handler' datatypes. -instance FromJSON Handler where +All 'HKD' wrapped and 'Maybe' fields are optional fields, they can be omitted. + +There are tow config file templates in "Logging.Config.Json" and +"Logging.Config.Yaml". + +Note: When decoding from json or yaml, use 'type' field to specify handler type. +-} +data HandlerH f = StreamHandler { level :: HKD T.Level f + -- ^ Default is @NOTSET@. + , filterer :: HKD T.Filterer f + -- ^ Default is []. + , formatter :: HKD String f + -- ^ It represents key of 'ConfigH''s + -- formatters. + , stream :: HKD String f + -- ^ Only support 'stderr' and 'stdout', + -- default is 'stderr'. + } + + | FileHandler { level :: HKD T.Level f + -- ^ Default is @NOTSET@. + , filterer :: HKD T.Filterer f + -- ^ Default is []. + , formatter :: HKD String f + -- ^ It represents key of 'ConfigH''s + -- formatters. + , file :: FilePath + , encoding :: HKD String f + -- ^ See 'System.IO.mkTextEncoding', + -- default is utf8. + } + | RotatingFileHandler { level :: HKD T.Level f + -- ^ Default is @NOTSET@. + , filterer :: HKD T.Filterer f + -- ^ Default is []. + , formatter :: HKD String f + -- ^ It represents key of 'ConfigH''s + -- formatters. + , file :: FilePath + , encoding :: HKD String f + -- ^ See 'System.IO.mkTextEncoding', + -- default is utf8. + , maxBytes :: HKD Int f + -- ^ Default is 100 MB. + , backupCount :: HKD Int f + -- ^ Default is 10. + } + | TimeRotatingFileHandler { level :: HKD T.Level f + -- ^ Default is @NOTSET@. + , filterer :: HKD T.Filterer f + -- ^ Default is []. + , formatter :: HKD String f + -- ^ It represents key of 'ConfigH''s + -- formatters. + , file :: FilePath + , encoding :: HKD String f + , timezone :: Maybe String + -- ^ If not set, same as 'Manager''s + -- timezone. + , rotateTime :: HKD T.RotateTime f + -- ^ Indicates when to rotate file, + -- e.g. @D3@ means every 3 days, + -- @W4@ means at 0 clock of 'Thursday', + -- try reading and showing + -- 'RotateTime'. + , backupCount :: HKD Int f + } + -- ^ @since 0.7.0 + deriving Generic + +instance FromJSON (HandlerH Maybe) where parseJSON = genericParseJSON option where sumEncoding = defaultTaggedObject { tagFieldName = "type" } option = defaultOptions { sumEncoding = sumEncoding } +instance Default HandlerH where + constrDef constr + | constr == "StreamHandler" = StreamHandler{..} + | constr == "FileHandler" = FileHandler{..} + | constr == "RotatingFileHandler" = RotatingFileHandler{..} + | constr == "TimeRotatingFileHandler" = TimeRotatingFileHandler{..} + where + (level, filterer, formatter) = ("NOTSET", [], "{message}") + (stream, file, encoding) = ("stderr", "./logging.log", "UTF-8") + (maxBytes, backupCount) = (104857600, 10) + (timezone, rotateTime) = (Nothing, T.Day 1) -data Sink = Sink { level :: Maybe String - , filterer :: Maybe [String] - , handlers :: Maybe [String] - , propagate :: Maybe Bool - , disabled :: Maybe Bool - } deriving (Generic, Show) +type Handler = HandlerH Identity -instance FromJSON Sink +-------------------------------------------------------------------------------- +data SinkH f = Sink { level :: HKD T.Level f + -- Default is "NOTSET" + , filterer :: HKD T.Filterer f + -- Default is [] + , handlers :: HKD [String] f + -- ^ A list of key of 'ConfigH''s handlers + , propagate :: HKD Bool f + , disabled :: HKD Bool f + } deriving Generic -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 (SinkH Maybe) -instance FromJSON Config +instance Default SinkH where + constrDef _ = Sink "NOTSET" [] [] True False +type Sink = SinkH Identity + +-------------------------------------------------------------------------------- +data ConfigH f = Config { sinks :: HKD (MapH String SinkH f) f + , handlers :: HKD (MapH String HandlerH f) f + , formatters :: HKD (Map String String) f + -- See "Format1" to learn how to write format string. + , timezone :: Maybe String -- ^ @since 0.7.0 + -- Default is the result of 'getCurrentTimeZone'. + , disabled :: HKD Bool f + } deriving Generic + +instance FromJSON (ConfigH Maybe) + +instance Default ConfigH where + constrDef _ = Config mempty mempty mempty Nothing False + +type Config = ConfigH Identity + + +-------------------------------------------------------------------------------- newtype ConfigException = ConfigException { message :: String } instance Show ConfigException where @@ -117,80 +187,53 @@ instance Exception ConfigException +-------------------------------------------------------------------------------- +{-| Create "Logging.Manager.Manager" from 'Config'. + +This function is only used by "Logging.Config.Json" and "Logging.Config.Yaml", +use functions provided in these two modules directly. +-} createManager :: Config -> IO T.Manager createManager Config{..} = do - handlers <- mapM (createHandler formatters') $ fromMaybe empty handlers - sinks <- sequence $ mapWithKey (createSink handlers) $ fromMaybe empty sinks - defaultTimezone <- getCurrentTimeZone - - let root = findWithDefault defaultRoot "root" sinks - sinks' = delete "root" sinks - timezone' = maybe defaultTimezone read timezone - disabled' = fromMaybe False disabled - return $ T.Manager root sinks' timezone' disabled' False + hs <- mapM (createHandler $ map fromString formatters) $ unMapH handlers + ss <- sequence $ mapWithKey (createSink hs) $ unMapH sinks + timezone <- maybe getCurrentTimeZone (pure . read) timezone + let root = findWithDefault defaultRoot "root" ss + sinks = delete "root" ss + catchUncaughtException = False -- TODO remove + return $ T.Manager{..} where - formatters' :: Map String Format1 - formatters' = maybe (singleton "" "{message}") (map fromString) formatters - stderrHandler :: T.SomeHandler - stderrHandler = T.toHandler $ T.StreamHandler def [] "{message}" stderr + stderrHandler = T.toHandler $ T.StreamHandler "NOTSET" [] "{message}" stderr defaultRoot :: T.Sink defaultRoot = T.Sink "" "DEBUG" [] [stderrHandler] False False createSink :: Map String T.SomeHandler -> String -> Sink -> IO T.Sink createSink hs logger Sink{..} = do - let logger' = if logger == "root" then "" else logger - level' = maybe def read level - filterer' = maybe [] (P.map fromString) filterer - handlers' = [hs ! h | h <- fromMaybe [] handlers] - disabled' = fromMaybe False disabled - propagate' = fromMaybe False propagate - return $ T.Sink logger' level' filterer' handlers' disabled' propagate' - - getStream :: String -> Handle - getStream "stderr" = stderr - getStream "stdout" = stdout - getStream _ = error "Logging.Config: no parse (stream)" + logger <- pure $ if logger == "root" then "" else logger + handlers <- pure [hs ! h | h <- handlers] + return $ T.Sink{..} createHandler :: Map String Format1 -> Handler -> IO T.SomeHandler createHandler fs StreamHandler{..} = do - let level' = maybe def read level - filterer' = maybe [] (P.map fromString) filterer - formatter' = maybe "{message}" ((!) fs) formatter - stream' = getStream $ fromMaybe "stderr" stream - return $ T.toHandler $ T.StreamHandler level' filterer' formatter' stream' + formatter <- pure $ fs ! formatter + stream <- pure $ mkStdHandle stream + return $ T.toHandler $ T.StreamHandler{..} createHandler fs FileHandler{..} = do - let level' = maybe def read level - filterer' = maybe [] (P.map fromString) filterer - formatter' = maybe "{message}" ((!) fs) formatter - encoding' <- mkTextEncoding $ fromMaybe "utf8" encoding + formatter <- pure $ fs ! formatter + encoding <- mkTextEncoding encoding stream <- newIORef undefined - return $ T.toHandler $ - T.FileHandler level' filterer' formatter' file encoding' stream + return $ T.toHandler $ T.FileHandler{..} createHandler fs RotatingFileHandler{..} = do - let level' = maybe def read level - filterer' = maybe [] (P.map fromString) filterer - formatter' = maybe "{message}" ((!) fs) formatter - maxBytes' = fromMaybe 104857600 maxBytes - backupCount' = fromMaybe 10 backupCount - encoding' <- mkTextEncoding $ fromMaybe "utf8" encoding + formatter <- return $ fs ! formatter + encoding <- mkTextEncoding encoding stream <- newEmptyMVar - return $ T.toHandler $ - T.RotatingFileHandler level' filterer' formatter' file encoding' - maxBytes' backupCount' stream + return $ T.toHandler $ T.RotatingFileHandler{..} createHandler fs TimeRotatingFileHandler{timezone=tz, ..} = do - let level' = maybe def read level - filterer' = maybe [] (P.map fromString) filterer - formatter' = maybe "{message}" ((!) fs) formatter - tz' = mappend tz timezone - rotateTime' = maybe (T.Day 1) read rotateTime - backupCount' = fromMaybe 10 backupCount - encoding' <- mkTextEncoding $ fromMaybe "utf8" encoding - timezone' <- maybe getCurrentTimeZone (return . read) tz' + formatter <- pure $ fs ! formatter + timezone <- maybe getCurrentTimeZone (pure . read) $ mappend tz timezone + encoding <- mkTextEncoding encoding rotateAt <- newIORef =<< getCurrentTime stream <- newEmptyMVar - return $ T.toHandler $ - T.TimeRotatingFileHandler level' filterer' formatter' file encoding' - timezone' rotateTime' backupCount' rotateAt - stream + return $ T.toHandler $ T.TimeRotatingFileHandler{..} diff --git a/src/Logging/Config/Yaml.hs b/src/Logging/Config/Yaml.hs --- a/src/Logging/Config/Yaml.hs +++ b/src/Logging/Config/Yaml.hs @@ -1,7 +1,6 @@ -{-| This module provides a convenient way to decode a 'Manager' from yaml string - +{-|This module provides a convenient way to decode a 'Manager' from yaml string -Here is a yaml string template: +=== Template @ sinks: @@ -28,13 +27,13 @@ type: FileHandler level: "Level 100" formatter: standard - file: /etc/my/json.log + file: \/var\/log\/my\/yaml.log encoding: utf8 rotate: type: RotatingFileHandler level: INFO formatter: standard - file: /etc/my/json.log + file: \/var\/log\/my\/yaml.log encoding: utf8 maxBytes: 1048576 backupCount: 10 @@ -44,10 +43,7 @@ standard: "{asctime:%Y-%m-%dT%H:%M:%S%6Q%z} - {level} - {logger}] {message}" disabled: false - - catchUncaughtException: true @ - -} module Logging.Config.Yaml (getManager, getManagerFile) where @@ -60,9 +56,11 @@ import Logging.Manager --- | decode a 'Manager' from strict 'ByteString' --- --- @since 0.4.0 +{-| decode a 'Manager' from strict 'ByteString', it +1) decodes 'Config' from json string, 2) constructs an 'Manager' + + @since 0.4.0 +-} getManager :: ByteString -> IO Manager getManager bs = case decodeEither' bs of @@ -70,9 +68,11 @@ Right config -> createManager config --- | decode a 'Manager' from a file --- --- @since 0.4.0 +{- | decode a 'Manager' from a file, it +1) reads json string from file, 2) calls 'getManager' to construct an 'Manager' + +@since 0.4.0 +-} getManagerFile :: FilePath -> IO Manager getManagerFile path = do res <- decodeFileEither path diff --git a/src/Logging/Filter.hs b/src/Logging/Filter.hs --- a/src/Logging/Filter.hs +++ b/src/Logging/Filter.hs @@ -3,6 +3,7 @@ module Logging.Filter ( Filter(..), Filterer ) where +import Data.Aeson import Data.List (stripPrefix) import Data.String import Prelude hiding (filter) @@ -49,6 +50,9 @@ Just ('.':_) -> True _ -> False filter (Filter _ (Just f)) rcd = f rcd + +instance FromJSON Filter where + parseJSON = (fmap read) . parseJSON -- |List of Filter diff --git a/src/Logging/Global.hs b/src/Logging/Global.hs --- a/src/Logging/Global.hs +++ b/src/Logging/Global.hs @@ -1,11 +1,14 @@ -{-| Run logging globally. +{-| +Copyright : (c) 2019 Version Cloud +License : BSD3 +Maintainer : Jorah Gao +Stability : experimental +Portability : portable +Run logging globally. + The 'run' function will properly "initialize" and "terminate" the global "Manager". - -If the "Manager"\'s 'catchUncaughtException' is True, the 'run' function will -set an uncaught exception handler that will log all uncaught exceptions, - and set the handler to the original one before 'run' is complete. -} module Logging.Global diff --git a/src/Logging/Global/Internal.hs b/src/Logging/Global/Internal.hs --- a/src/Logging/Global/Internal.hs +++ b/src/Logging/Global/Internal.hs @@ -77,4 +77,5 @@ unknownLoc = ("unknown file", "unknown package", "unknown module", 0) logThrow :: SomeException -> IO a + logThrow e | Just UserInterrupt <- fromException e = throw e logThrow e = log "" "ERROR" e Null unknownLoc >> throw e diff --git a/src/Logging/Handler/TimeRotatingFileHandler.hs b/src/Logging/Handler/TimeRotatingFileHandler.hs --- a/src/Logging/Handler/TimeRotatingFileHandler.hs +++ b/src/Logging/Handler/TimeRotatingFileHandler.hs @@ -10,6 +10,7 @@ import Control.Concurrent.MVar import Control.Monad +import Data.Aeson import Data.Char import Data.IORef import Data.List @@ -144,6 +145,9 @@ show (Hour n) = 'H' : (show n) show (WeekDay n) = 'W' : (show $ fromEnum n) show (Day n) = 'D' : (show n) + +instance FromJSON RotateTime where + parseJSON = (fmap read) . parseJSON interval :: RotateTime -> NominalDiffTime diff --git a/src/Logging/Level.hs b/src/Logging/Level.hs --- a/src/Logging/Level.hs +++ b/src/Logging/Level.hs @@ -2,8 +2,8 @@ module Logging.Level ( Level(..) ) where -import Data.Default -import Data.List (stripPrefix) +import Data.Aeson +import Data.List (stripPrefix) import Data.String import Text.Format @@ -53,8 +53,8 @@ toEnum = Level fromEnum (Level v) = v -instance Default Level where - def = "NOTSET" - instance FormatArg Level where formatArg = formatArg . show + +instance FromJSON Level where + parseJSON = (fmap read) . parseJSON diff --git a/src/Logging/Monad.hs b/src/Logging/Monad.hs --- a/src/Logging/Monad.hs +++ b/src/Logging/Monad.hs @@ -1,10 +1,14 @@ -{-| Run logging in a 'Reader' monad. +{-| +Copyright : (c) 2019 Version Cloud +License : BSD3 +Maintainer : Jorah Gao +Stability : experimental +Portability : portable +Run logging in a 'Reader' monad. + You should 'initialize' the 'Manager' before using it in the 'Reader' monad, and 'terminate' it when it is no longer needed. - -If you want to log uncaught exceptions, -see "GHC.Conc.setUncaughtExceptionHandler". -} diff --git a/src/Logging/Monad/Internal.hs b/src/Logging/Monad/Internal.hs --- a/src/Logging/Monad/Internal.hs +++ b/src/Logging/Monad/Internal.hs @@ -14,12 +14,10 @@ import Control.Concurrent import Control.Exception (SomeException, bracket_) -import Control.Lens (view) 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 import Data.List (dropWhileEnd, group) @@ -28,6 +26,7 @@ import Data.Time.Clock.POSIX import Data.Time.LocalTime import GHC.Conc (setUncaughtExceptionHandler) +import Lens.Micro.Extras (view) import Prelude hiding (filter, log) import System.FilePath import System.IO (stderr, stdout) diff --git a/src/Logging/Prelude.hs b/src/Logging/Prelude.hs --- a/src/Logging/Prelude.hs +++ b/src/Logging/Prelude.hs @@ -16,6 +16,7 @@ , lastModifyTime , modifyBaseName , appendBaseName + , mkStdHandle ) where import Control.Concurrent @@ -97,3 +98,9 @@ appendBaseName :: FilePath -> String -> FilePath appendBaseName file suffix = modifyBaseName file (++ suffix) + + +mkStdHandle :: String -> Handle +mkStdHandle "stderr" = stderr +mkStdHandle "stdout" = stdout +mkStdHandle _ = error "unknown std handle name" diff --git a/src/Logging/TH.hs b/src/Logging/TH.hs deleted file mode 100644 --- a/src/Logging/TH.hs +++ /dev/null @@ -1,5 +0,0 @@ -module Logging.TH {-# DEPRECATED "Renamed as Logging.Global.TH" #-} - ( module Logging.Global.TH - ) where - -import Logging.Global.TH diff --git a/src/Logging/Types.hs b/src/Logging/Types.hs deleted file mode 100644 --- a/src/Logging/Types.hs +++ /dev/null @@ -1,23 +0,0 @@ -module Logging.Types {-# DEPRECATED "This module has been flattened, use relevant modules directly" #-} - ( module Logging.Logger - , module Logging.Level - , module Logging.Filter - , module Logging.Record - , module Logging.Handler.FileHandler - , module Logging.Handler.RotatingFileHandler - , module Logging.Handler.StreamHandler - , module Logging.Sink - , module Logging.Manager - , module Logging.Class - ) where - -import Logging.Class -import Logging.Filter -import Logging.Handler.FileHandler -import Logging.Handler.RotatingFileHandler -import Logging.Handler.StreamHandler -import Logging.Level -import Logging.Logger -import Logging.Manager -import Logging.Record -import Logging.Sink diff --git a/src/Logging/Utils.hs b/src/Logging/Utils.hs deleted file mode 100644 --- a/src/Logging/Utils.hs +++ /dev/null @@ -1,6 +0,0 @@ -module Logging.Utils {-# DEPRECATED "Renamed as Logging.Prelude" #-} - ( module Logging.Prelude - ) where - - -import Logging.Prelude diff --git a/test/LoggingTest/TypesSpec.hs b/test/LoggingTest/TypesSpec.hs --- a/test/LoggingTest/TypesSpec.hs +++ b/test/LoggingTest/TypesSpec.hs @@ -5,9 +5,7 @@ module LoggingTest.TypesSpec ( spec ) where import Control.Concurrent.MVar -import Control.Lens hiding (Level (..)) import Control.Monad -import Data.Default (def) import Data.Generics.Product.Typed import Data.IORef import Data.List (isPrefixOf) @@ -15,6 +13,7 @@ import Data.Time.Clock import Data.Time.Clock.POSIX import Data.Time.LocalTime +import Lens.Micro import Prelude hiding (filter) import System.Directory import System.FilePath @@ -76,15 +75,15 @@ timeRotateRef <- runIO $ newIORef undefined timeFileMVar <- runIO newEmptyMVar runIO $ hSetEncoding read utf8 >> hSetEncoding write utf8 - let handler = toHandler $ StreamHandler def [] "{message}" write + let handler = toHandler $ StreamHandler "NOTSET" [] "{message}" write fileHandler = toHandler $ - FileHandler def [] "{message}" "/tmp/log4hs/file.log" utf8 fileRef + FileHandler "NOTSET" [] "{message}" "/tmp/log4hs/file.log" utf8 fileRef rotateHandler = toHandler $ - RotatingFileHandler def [] "{message}" "/tmp/log4hs/rotate.log" utf8 - 1000 5 rotateFileMVar + RotatingFileHandler "NOTSET" [] "{message}" "/tmp/log4hs/rotate.log" + utf8 1000 5 rotateFileMVar timeHandler = toHandler $ - TimeRotatingFileHandler def [] "{message}" "/tmp/log4hs/time.log" utf8 - utc (Minute 5) 5 timeRotateRef timeFileMVar + TimeRotatingFileHandler "NOTSET" [] "{message}" "/tmp/log4hs/time.log" + utf8 utc (Minute 5) 5 timeRotateRef timeFileMVar runIO $ open handler >> open fileHandler >> open rotateHandler prop "filter" $ \(rcd@LogRecord{..}) -> monadicIO $ do