log4hs 0.3.1.0 → 0.4.0.0

raw patch · 9 files changed

+529/−53 lines, 9 filesdep +bytestringdep +yamlPVP ok

version bump matches the API change (PVP)

Dependencies added: bytestring, yaml

API changes (from Hackage documentation)

Files

• bench/Main.hs +7/−3
• log4hs.cabal +12/−3
• src/Logging.hs +6/−8
• src/Logging/Aeson.hs +1/−1
• src/Logging/Config/Json.hs +120/−0
• src/Logging/Config/Type.hs +144/−0
• src/Logging/Config/Yaml.hs +81/−0
• src/Logging/Deprecated.hs +0/−38
• test/Logging/ConfigSpec.hs +158/−0

@@ -11,11 +11,15 @@ #else import           Data.Aeson.QQ        (aesonQQ) #endif+import           Data.ByteString      (pack)+import           Data.ByteString.Lazy (unpack) import           Data.Maybe-import           Logging import           System.IO.Unsafe +import           Logging+import           Logging.Config.Json + main :: IO () main = run manager $ defaultMain $   [ bgroup "stderr" [ bench "simple" $ nfIO $ $(debug) "Stderr.Simple" msg100@@ -35,11 +39,11 @@  manager :: Manager {-# NOINLINE manager #-}-manager = unsafePerformIO $ fromJust $ decode $ encode $+manager = unsafePerformIO $ getManager $ pack $ unpack $ encode $   [aesonQQ|{     "disabled": false,     "catchUncaughtException": true,-    "loggers": {+    "sinks": {       "Stderr.Simple": {         "handlers": ["stderr.simple"],         "propagate": false

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 90b0b17510bc8c4fc178da4193122aee38d748d65201c114cd6c51476b45cb3e+-- hash: e7973c763207cddf6697fcd36825081d9f793242e5dc25a07c6b80d710174aa8  name:           log4hs-version:        0.3.1.0+version:        0.4.0.0 synopsis:       A python logging style log library description:    Please see the http://hackage.haskell.org/package/log4hs category:       logging@@ -24,10 +24,12 @@   exposed-modules:       Logging       Logging.Aeson+      Logging.Config.Json+      Logging.Config.Type+      Logging.Config.Yaml       Logging.Types       Logging.Utils   other-modules:-      Logging.Deprecated       Logging.Internal       Logging.TH       Logging.Types.Class@@ -50,6 +52,7 @@   build-depends:       aeson >=1.2 && <2.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@@ -60,6 +63,7 @@     , text >=1.2 && <2.0     , time >=1.4 && <2.0     , vformat >=0.9.1 && <1.0+    , yaml >=0.9 && <1.0   default-language: Haskell2010  test-suite log4hs-test@@ -67,6 +71,7 @@   main-is: Spec.hs   other-modules:       Logging.AesonSpec+      Logging.ConfigSpec       Logging.TypesSpec       LoggingSpec       Paths_log4hs@@ -78,6 +83,7 @@     , aeson >=1.2 && <2.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@@ -92,6 +98,7 @@     , text >=1.2 && <2.0     , time >=1.4 && <2.0     , vformat >=0.9.1 && <1.0+    , yaml >=0.9 && <1.0   default-language: Haskell2010  benchmark log4hs-bench@@ -106,6 +113,7 @@       aeson >=1.2 && <2.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@@ -118,4 +126,5 @@     , text >=1.2 && <2.0     , time >=1.4 && <2.0     , vformat >=0.9.1 && <1.0+    , yaml >=0.9 && <1.0   default-language: Haskell2010

@@ -19,10 +19,11 @@   import           Data.Aeson   import           Data.Maybe   import           Logging+  import           Logging.Config.Json   import           Prelude    hiding (error)    main :: IO ()-  main = fromJust (decode \"{}\") >>= flip run app+  main = getManager "{}" >>= flip run app    myLogger = \"MyLogger.Main\" @@ -36,20 +37,17 @@     $(logv) myLogger \"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 -__See "Logging.Aeson" to lean more about decoding json into 'Manager'__ -} module Logging-  ( module Logging.Aeson-  , module Logging.Types-  , module Logging.Deprecated+  ( module Logging.Types   , module Logging.Internal   -- ** Logging THs   , module Logging.TH   ) where -import           Logging.Aeson-import           Logging.Deprecated-import           Logging.Internal   hiding (log)+import           Logging.Internal hiding (log) import           Logging.TH import           Logging.Types

@@ -6,7 +6,7 @@ {-# LANGUAGE ScopedTypeVariables   #-} {-# LANGUAGE TypeApplications      #-} -module Logging.Aeson+module Logging.Aeson {-# DEPRECATED "Use Logging.Config.Json instead" #-}   (   -- * Aeson Instances   --

@@ -0,0 +1,120 @@+{-| 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) '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.++Here is a json string template:++@+  {+    \"sinks\":+    {+      \"root\":+      {+        \"handlers\": [\"console\", \"file\"]+      },+      \"App.Json\":+      {+        \"handlers\": [\"file\"],+        \"propagate\": false+      },+      \"App.Yaml\":+      {+        \"handlers\": [\"rotate\"],+        \"propagate\": false+      }+    },+    \"handlers\":+    {+      \"console\":+      {+        \"type\": \"StreamHandler\",+        \"level\": \"DEBUG\",+        \"formatter\": \"simple\",+        \"stream\": \"stderr\"+      },+      \"file\":+      {+        \"type\": \"FileHandler\",+        \"level\": \"Level 100\",+        \"filterer\": [\"App.Json\"],+        \"formatter\": \"standard\",+        \"file\": \"/etc\/my\/json.log\",+        \"encoding\": \"utf8\"+      },+      \"rotate\":+      {+        \"type\": \"RotatingFileHandler\",+        \"level\": \"INFO\",+        \"filterer\": [\"App.Yaml\"],+        \"formatter\": \"standard\",+        \"file\": \"/etc\/my\/yaml.log\",+        \"encoding\": \"utf8\",+        \"maxBytes\": 1048576,+        \"backupCount\": 10+      }+    },+    \"formatters\":+    {+      \"simple\": \"{message}\",+      \"standard\": \"{asctime:%Y-%m-%dT%H:%M:%S%6Q%z} - {level} - {logger}] {message}\"+    },+    \"disabled\": false,+    \"catchUncaughtException\": true+  }+@++-}++module Logging.Config.Json (getManager, getManagerFile) where+++import           Control.Exception+import           Data.Aeson+import           Data.ByteString+import           Prelude             hiding (readFile)++import           Logging.Config.Type+import           Logging.Types       (Manager)+++-- | decode a 'Manager' from strict 'ByteString'+--+-- @since 0.4.0+getManager :: ByteString -> IO Manager+getManager bs =+  case eitherDecodeStrict bs of+    Left msg     -> throw $ ConfigException msg+    Right config -> createManager config+++-- | decode a 'Manager' from a file+--+-- @since 0.4.0+getManagerFile :: FilePath -> IO Manager+getManagerFile path = getManager =<< catch (readFile path) reThrow+  where+    reThrow :: SomeException -> IO a+    reThrow e = throw $ ConfigException $ displayException e

@@ -0,0 +1,144 @@+{-# LANGUAGE DeriveGeneric         #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE OverloadedStrings     #-}+{-# LANGUAGE RecordWildCards       #-}++module Logging.Config.Type+  ( Handler(..)+  , Sink(..)+  , Config(..)+  , ConfigException(..)+  , createManager+  ) where+++import           Control.Exception (Exception)+import           Data.Aeson+import           Data.Default+import           Data.IORef+import           Data.Map.Lazy+import           Data.Maybe+import           Data.String+import           GHC.Generics+import           System.IO++import           Prelude           hiding (map)+import qualified Prelude           as P+import           Text.Format++import           Logging.Internal+import qualified Logging.Types     as T+import           Logging.Utils+++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+                           }+             | RotatingFileHandler { level       :: Maybe String+                                   , filterer    :: Maybe [String]+                                   , formatter   :: Maybe String+                                   , file        :: FilePath+                                   , encoding    :: Maybe String+                                   , maxBytes    :: Maybe Int+                                   , backupCount :: Maybe Int+                                   }+              deriving (Generic, Show)++instance FromJSON Handler where+  parseJSON = genericParseJSON option+    where+      sumEncoding = defaultTaggedObject { tagFieldName = "type" }+      option = defaultOptions { sumEncoding = sumEncoding }+++data Sink = Sink { level     :: Maybe String+                 , filterer  :: Maybe [String]+                 , handlers  :: Maybe [String]+                 , propagate :: Maybe Bool+                 , disabled  :: Maybe Bool+                 } deriving (Generic, Show)++instance FromJSON Sink+++data Config = Config { sinks                  :: Maybe (Map String Sink)+                     , handlers               :: Maybe (Map String Handler)+                     , formatters             :: Maybe (Map String String)+                     , disabled               :: Maybe Bool+                     , catchUncaughtException :: Maybe Bool+                     } deriving (Generic, Show)++instance FromJSON Config+++newtype ConfigException = ConfigException { message :: String }++instance Show ConfigException where+  show e = "Logging Config Exception: " ++ (message e)++instance Exception ConfigException+++createManager :: Config -> IO T.Manager+createManager Config{..} = do+    handlers <- mapM (createHandler formatters') $ fromMaybe empty handlers+    sinks <- sequence $ mapWithKey (createSink handlers) $ fromMaybe empty sinks++    let root = findWithDefault defaultRoot "root" sinks+        sinks' = delete "root" sinks+        disabled' = fromMaybe False disabled+        catchUncaughtException' = fromMaybe False catchUncaughtException+    return $ T.Manager root sinks' disabled' catchUncaughtException'+  where+    formatters' :: Map String Format1+    formatters' = maybe (singleton "" "{message}") (map fromString) formatters++    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)"++    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'+    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+      stream <- newIORef undefined+      return $ T.toHandler $+        T.FileHandler level' filterer' formatter' file encoding' stream+    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+      stream <- newIORef undefined+      return $ T.toHandler $+        T.RotatingFileHandler level' filterer' formatter' file encoding'+                              maxBytes' backupCount' stream

@@ -0,0 +1,81 @@+{-| This module provides a convenient way to decode a 'Manager' from yaml string+++Here is a yaml string template:++@+  sinks:+    root:+      handlers:+      - console+      - file+    App.Json:+      handlers:+      - file+      propagate: false+    App.Yaml:+      handlers:+      - rotate+      propagate: false++  handlers:+    console:+      type: StreamHandler+      level: DEBUG+      formatter: simple+      stream: stderr+    file:+      type: FileHandler+      level: "Level 100"+      formatter: standard+      file: /etc/my/json.log+      encoding: utf8+    rotate:+      type: RotatingFileHandler+      level: INFO+      formatter: standard+      file: /etc/my/json.log+      encoding: utf8+      maxBytes: 1048576+      backupCount: 10++  formatters:+    simple: "{message}"+    standard: "{asctime:%Y-%m-%dT%H:%M:%S%6Q%z} - {level} - {logger}] {message}"++  disabled: false++  catchUncaughtException: true+@++-}+module Logging.Config.Yaml (getManager, getManagerFile) where+++import           Control.Exception+import           Data.ByteString+import           Data.Yaml++import           Logging.Config.Type+import           Logging.Types       (Manager)+++-- | decode a 'Manager' from strict 'ByteString'+--+-- @since 0.4.0+getManager :: ByteString -> IO Manager+getManager bs =+  case decodeEither' bs of+    Left e       -> throw $ ConfigException $ prettyPrintParseException e+    Right config -> createManager config+++-- | decode a 'Manager' from a file+--+-- @since 0.4.0+getManagerFile :: FilePath -> IO Manager+getManagerFile path = do+  res <- decodeFileEither path+  case res of+    Left e       -> throw $ ConfigException $ prettyPrintParseException e+    Right config -> createManager config

@@ -1,38 +0,0 @@-module Logging.Deprecated-  ( runJson-  , jsonToManager-  ) where---import           Data.Aeson--import           Logging.Aeson-import           Logging.Internal-import           Logging.Types---- |Run a logging environment from JSON 'Value'.------ A combinator of 'run' and 'fromJSON'------ A combinator of 'jsonToManager' and 'run'------ See 'Logging.Aeson'-{-# DEPRECATED runJson "will be removed in 1.0.0" #-}-runJson :: Value -> IO a -> IO a-runJson v io = sequence (fromJSON v) >>= \result ->-  case result of-    Error _     -> error "Logging.Aeson: no parse (manager)"-    Success mgr -> run mgr io----- |Make a 'Manager' from JSON 'Value'------ Decode 'Aeson.Value' into 'Manager'------ See 'Logging.Aeson'-{-# DEPRECATED jsonToManager "will be removed in 1.0.0" #-}-jsonToManager :: Value -> IO Manager-jsonToManager v = sequence (fromJSON v) >>= \result ->-  case result of-    Error _     -> error "Logging.Aeson: no parse (manager)"-    Success mgr -> return mgr

@@ -0,0 +1,158 @@+{-# LANGUAGE CPP               #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes       #-}+{-# LANGUAGE RecordWildCards   #-}++module Logging.ConfigSpec ( spec ) where+++import           Data.Aeson            as Json+#if MIN_VERSION_aeson(1, 4, 3)+import           Data.Aeson.QQ.Simple  (aesonQQ)+#else+import           Data.Aeson.QQ         (aesonQQ)+#endif+import           Data.ByteString       (ByteString, pack, writeFile)+import           Data.ByteString.Lazy  (unpack)+import qualified Data.Map              as M+import           Data.Yaml             as Yaml+import           Data.Yaml.TH+import           Prelude               hiding (writeFile)+import           System.Directory+import           Test.Hspec+import           Test.Hspec.QuickCheck++import           Logging+import           Logging.Config.Json   as Json+import           Logging.Config.Yaml   as Yaml+++spec :: Spec+spec = beforeAll_ prepare $+  describe "Config & Manager" $ modifyMaxSize (const 1000) $ do+    it "json" $ do+      Manager{..} <- Json.getManager jsonRaw+      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)++      logger `shouldBe` ""+      level `shouldBe` "DEBUG"+      disabled `shouldBe` False+      propagate `shouldBe` False+      length filterer `shouldBe` 0+      length handlers `shouldBe` 1++    it "sinks" $ do+      Sink{..} <- (flip (M.!) "MyLogger" . sinks) <$> (Json.getManager jsonRaw)++      logger `shouldBe` "MyLogger"+      level `shouldBe` "INFO"+      propagate `shouldBe` False+      disabled `shouldBe` False+      length filterer `shouldBe` 1+      filterer == ["MyLogger.Main"] `shouldBe` True+      length handlers `shouldBe` 2+++prepare :: IO ()+prepare = do+  createDirectoryIfMissing False "/tmp/log4hs"+  writeFile "/tmp/log4hs/config.json" jsonRaw+  writeFile "/tmp/log4hs/config.yaml" yamlRaw+++jsonRaw :: ByteString+jsonRaw = pack $ unpack $ Json.encode+  [aesonQQ|{+    "sinks": {+      "root": {+        "level": "DEBUG",+        "handlers": ["console"],+        "propagate": false+      },+      "MyLogger": {+        "level": "INFO",+        "filterer": ["MyLogger.Main"],+        "handlers": ["console", "file"],+        "propagate": false+      }+    },+    "handlers": {+      "console": {+        "type": "StreamHandler",+        "stream": "stderr",+        "level": "DEBUG",+        "formatter": "default"+      },+      "file": {+        "type": "FileHandler",+        "level": "INFO",+        "formatter": "default",+        "file": "./default.log"+      }+    },+    "formatters": {+      "default": "{asctime} - {level} - {logger}:{lineno}] {message}"+    },+    "catchUncaughtException": true+  }|]+++yamlRaw :: ByteString+yamlRaw = Yaml.encode+  [yamlQQ|+    sinks:+      root:+        level: DEBUG+        handlers:+        - console+        propagate: false+      MyLogger:+        level: INFO+        filterer:+        - MyLogger.Main+        handlers:+        - console+        - file+        propagate: false+    handlers:+      console:+        type: StreamHandler+        stream: stderr+        level: DEBUG+        formatter: default+      file:+        type: FileHandler+        level: INFO+        formatter: default+        file: "./default.log"+    formatters:+      default: "{asctime} - {level} - {logger}:{lineno}] {message}"+    catchUncaughtException: true+  |]