logsink 0.1.0 → 0.2.0

raw patch · 9 files changed

+201/−70 lines, 9 filesdep −logsinkdep ~hsyslognew-uploaderPVP ok

version bump matches the API change (PVP)

Dependencies removed: logsink

Dependency ranges changed: hsyslog

API changes (from Hackage documentation)

Files

• logsink.cabal +37/−17
• src/System/Logging/LogSink/Compat.hs +6/−0
• src/System/Logging/LogSink/Config.hs +12/−1
• src/System/Logging/LogSink/Core.hs +10/−1
• src/System/Logging/LogSink/Format.hs +19/−51
• src/System/Logging/LogSink/Internal.hs +56/−0
• test/System/Logging/LogSink/CoreSpec.hs +16/−0
• test/System/Logging/LogSink/FormatSpec.hs +23/−0
• test/System/Logging/LogSink/InternalSpec.hs +22/−0

@@ -1,7 +1,16 @@+-- This file has been generated from package.yaml by hpack version 0.17.0.+--+-- see: https://github.com/sol/hpack+ name:             logsink-version:          0.1.0+version:          0.2.0 synopsis:         A logging framework for Haskell-description:      A logging framework for Haskell+description:      @logsink@ is a logging framework for Haskell.  It is meant to be used in+                  conjunction with @logging-facade@ (<http://hackage.haskell.org/package/logging-facade>).+                  .+                  For more information and usage, consult the README: <https://github.com/sol/logsink#readme>+homepage:         https://github.com/sol/logsink#readme+bug-reports:      https://github.com/sol/logsink/issues license:          MIT license-file:     LICENSE copyright:        (c) Zalora South East Asia Pte. Ltd@@ -12,36 +21,47 @@  source-repository head   type: git-  location: https://github.com/zalora/logsink+  location: https://github.com/sol/logsink  library-  ghc-options:-      -Wall   hs-source-dirs:       src-  exposed-modules:-      System.Logging.LogSink.Config-      System.Logging.LogSink.Core-      System.Logging.LogSink.Format+  ghc-options: -Wall   build-depends:       base == 4.*     , logging-facade-    , hsyslog+    , hsyslog >= 5     , time+  exposed-modules:+      System.Logging.LogSink.Config+      System.Logging.LogSink.Core+      System.Logging.LogSink.Format+  other-modules:+      System.Logging.LogSink.Compat+      System.Logging.LogSink.Internal+      Paths_logsink   default-language: Haskell2010  test-suite spec-  type:-      exitcode-stdio-1.0-  ghc-options:-      -Wall+  type: exitcode-stdio-1.0+  main-is: Spec.hs   hs-source-dirs:+      src       test-  main-is:-      Spec.hs+  ghc-options: -Wall   build-depends:       base == 4.*-    , logsink     , logging-facade+    , hsyslog >= 5+    , time     , hspec == 2.*+  other-modules:+      System.Logging.LogSink.Compat+      System.Logging.LogSink.Config+      System.Logging.LogSink.Core+      System.Logging.LogSink.Format+      System.Logging.LogSink.Internal+      System.Logging.LogSink.CoreSpec+      System.Logging.LogSink.FormatSpec+      System.Logging.LogSink.InternalSpec   default-language: Haskell2010

@@ -0,0 +1,6 @@+module System.Logging.LogSink.Compat (+  module Prelude+, module Control.Applicative+) where++import           Control.Applicative

@@ -7,7 +7,9 @@ , setupLogging ) where -import           Control.Applicative+import           Prelude ()+import           System.Logging.LogSink.Compat+ import           System.Exit (exitFailure) import           System.IO import           System.Logging.Facade.Sink@@ -15,16 +17,22 @@  import           System.Logging.LogSink.Core import           System.Logging.LogSink.Format+import           System.Logging.LogSink.Internal  data LogTarget = StdErr | SysLog   deriving (Eq, Show)  data SinkConfig = SinkConfig {+  -- | Ignore all log records with a smaller log level than specified.   sinkConfigLevel :: LogLevel+  -- | Format string for formatting log records , sinkConfigFormat :: String+  -- | Target for log messages. , sinkConfigTarget :: LogTarget } deriving (Eq, Show) +-- | A sink configuration that logs all messages to `StdErr`. The used+-- format is the same as the one used by `defaultFormat`. defaultSinkConfig :: SinkConfig defaultSinkConfig = SinkConfig {   sinkConfigLevel = minBound@@ -32,12 +40,15 @@ , sinkConfigTarget = StdErr } +-- | Set up the global `LogSink` according to the given sink configurations. setupLogging :: [SinkConfig] -> IO () setupLogging sinks = either die (setLogSink . combine) (mapM toLogSink sinks)  die :: String -> IO a die err = hPutStrLn stderr err >> exitFailure +-- | Convert the given sink configuration to a `LogSink`. Return @Left@ if+-- the format string of the configuration is invalid. toLogSink :: SinkConfig -> Either String LogSink toLogSink sink = filterByLogLevel (sinkConfigLevel sink) . targetToSink sink <$> parseFormat_ (sinkConfigFormat sink)   where

@@ -7,6 +7,9 @@ , filterByLogLevel ) where +import           Prelude ()+import           System.Logging.LogSink.Compat+ import           Control.Concurrent.MVar import           Control.Monad import           System.IO@@ -16,7 +19,11 @@ import           System.Posix.Syslog  import           System.Logging.LogSink.Format+import           System.Logging.LogSink.Internal+import           Foreign.C.String +-- | Default format function that formats log records like so:+-- > {level}: {message} defaultFormat :: Format defaultFormat =   let Right format = parseFormat defaultFormatString@@ -32,7 +39,9 @@   modifyMVar_ stderrLock $ \ () -> hPutStrLn stderr s  sysLogSink :: Format -> LogSink-sysLogSink format record = format record >>= syslog (toPriority $ logRecordLevel record)+sysLogSink format record = do+  str <- format record+  withCStringLen str (syslog Nothing (toPriority $ logRecordLevel record))   where     toPriority :: LogLevel -> Priority     toPriority l = case l of

@@ -1,57 +1,25 @@ {-# LANGUAGE RecordWildCards #-}-module System.Logging.LogSink.Format where--import           Control.Applicative-import           Control.Concurrent-import           Data.Char-import           Data.Time.Clock-import           Data.Time.LocalTime ()-import           System.Logging.Facade.Types+module System.Logging.LogSink.Format (parseFormat) where -type Format = LogRecord -> IO String+import           Prelude ()+import           System.Logging.LogSink.Compat -defaultFormatString :: String-defaultFormatString = "{level}: {message}"+import           System.Logging.LogSink.Internal +-- | Parses a format string into a `Format` function.+--+-- It's possible to include information about the log record and the+-- context in which logging happened into the formatted message. The+-- following variables can be interpolated by enclosing them in curly braces:+--+-- [level] The `System.Logging.Facade.LogLevel` of the log record.+-- [message] The actual log message of the log record.+-- [timestamp] The time at which the log record is consumed.+-- [thread-id] The `Control.Concurrent.ThreadId` of the logging thread.+--+-- For example, @"{timestamp} {level}: {message}"@ would be a valid format+-- string.+--+-- When given an invalid format strings, @parseFormat@ returns @Left@. parseFormat :: String -> Either String Format parseFormat format = formatNodes <$> parseNodes format--data Node = Level | Message | Timestamp | ThreadId | Literal String-  deriving (Eq, Show)--formatNodes :: [Node] -> LogRecord -> IO String-formatNodes nodes LogRecord{..} = concat <$> mapM evalNode nodes-  where-    evalNode :: Node -> IO String-    evalNode node = case node of-      Level -> return (show logRecordLevel)-      Message -> return logRecordMessage-      Timestamp -> show <$> getCurrentTime-      ThreadId -> show <$> myThreadId-      Literal s -> return s--parseNodes :: String -> Either String [Node]-parseNodes = fmap (filter $ not . isEmpty) . go ""-  where-    isIdChar :: Char -> Bool-    isIdChar c = isAlphaNum c || (c `elem` "-_")--    lookupNode :: String -> Maybe Node-    lookupNode key = lookup key [("level", Level), ("message", Message), ("timestamp", Timestamp), ("thread-id", ThreadId)]--    go :: String -> String -> Either String [Node]-    go acc input = case input of-      ""  -> return [lit acc]-      '{':xs | (key,'}':ys) <- span isIdChar xs -> case lookupNode key of-        Nothing -> Left ("invalid format directive " ++ show key)-        Just node -> do-          nodes <- go "" ys-          return (lit acc : node : nodes)-      x:xs -> go (x:acc) xs--    lit :: String -> Node-    lit acc = (Literal . reverse) acc--    isEmpty :: Node -> Bool-    isEmpty (Literal "") = True-    isEmpty _ = False

@@ -0,0 +1,56 @@+{-# LANGUAGE RecordWildCards #-}+module System.Logging.LogSink.Internal where++import           Prelude ()+import           System.Logging.LogSink.Compat++import           Control.Concurrent+import           Data.Char+import           Data.Time.Clock+import           Data.Time.LocalTime ()+import           System.Logging.Facade.Types++type Format = LogRecord -> IO String++defaultFormatString :: String+defaultFormatString = "{level}: {message}"++data Node = Level | Message | Timestamp | ThreadId | Literal String+  deriving (Eq, Show)++formatNodes :: [Node] -> LogRecord -> IO String+formatNodes nodes LogRecord{..} = concat <$> mapM evalNode nodes+  where+    evalNode :: Node -> IO String+    evalNode node = case node of+      Level -> return (show logRecordLevel)+      Message -> return logRecordMessage+      Timestamp -> show <$> getCurrentTime+      ThreadId -> show <$> myThreadId+      Literal s -> return s++parseNodes :: String -> Either String [Node]+parseNodes = fmap (filter $ not . isEmpty) . go ""+  where+    isIdChar :: Char -> Bool+    isIdChar c = isAlphaNum c || (c `elem` "-_")++    lookupNode :: String -> Maybe Node+    lookupNode key = lookup key [("level", Level), ("message", Message), ("timestamp", Timestamp), ("thread-id", ThreadId)]++    go :: String -> String -> Either String [Node]+    go acc input = case input of+      ""  -> return [lit acc]+      '{':xs | (key,'}':ys) <- span isIdChar xs -> case lookupNode key of+        Nothing -> Left ("invalid format directive " ++ show key)+        Just node -> do+          nodes <- go "" ys+          return (lit acc : node : nodes)+      x:xs -> go (x:acc) xs++    lit :: String -> Node+    lit acc = (Literal . reverse) acc++    isEmpty :: Node -> Bool+    isEmpty (Literal "") = True+    isEmpty _ = False

@@ -0,0 +1,16 @@+module System.Logging.LogSink.CoreSpec (main, spec) where++import           Test.Hspec++import           System.Logging.Facade.Types+import           System.Logging.LogSink.Core++main :: IO ()+main = hspec spec++spec :: Spec+spec = do+  describe "defaultFormat" $ do+    it "converts a log record to a string" $ do+      let record = LogRecord ERROR Nothing "some message"+      defaultFormat record `shouldReturn` "ERROR: some message"

@@ -0,0 +1,23 @@+module System.Logging.LogSink.FormatSpec (main, spec) where++import           Test.Hspec++import           Control.Concurrent+import           System.Logging.Facade.Types+import           System.Logging.LogSink.Format++main :: IO ()+main = hspec spec++spec :: Spec+spec = do+  describe "parseFormat" $ do+    let record = LogRecord ERROR Nothing "some message"+    it "formats a log record" $ do+      let Right format = parseFormat "{level}: {message}"+      format record `shouldReturn` "ERROR: some message"++    it "interpolates thread-id" $ do+      threadId <- myThreadId+      let Right format = parseFormat "foo {thread-id} bar"+      format record `shouldReturn` "foo " ++ show threadId ++ " bar"

@@ -0,0 +1,22 @@+module System.Logging.LogSink.InternalSpec (main, spec) where++import           Test.Hspec++import           System.Logging.LogSink.Internal++main :: IO ()+main = hspec spec++spec :: Spec+spec = do+  describe "parseNodes" $ do+    it "parses format string" $ do+      parseNodes "{level}: {message}" `shouldBe` Right [Level, Literal ": ", Message]++    context "when given an unterminated format directive" $ do+      it "interprets it literal" $ do+        parseNodes "{level}: {.. {message}" `shouldBe` Right [Level, Literal ": {.. ", Message]++    context "when given an unknown format directive" $ do+      it "returns Left" $ do+        parseNodes "foo {bar} baz" `shouldBe` Left "invalid format directive \"bar\""