logging-facade 0.1.1 → 0.2.0

raw patch · 7 files changed

+95/−21 lines, 7 filesdep −template-haskelldep ~basePVP ok

version bump matches the API change (PVP)

Dependencies removed: template-haskell

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• LICENSE +1/−1
• logging-facade.cabal +17/−6
• src/System/Logging/Facade/Sink.hs +30/−5
• src/System/Logging/Facade/Types.hs +1/−1
• test/Helper.hs +17/−0
• test/System/Logging/Facade/SinkSpec.hs +25/−0
• test/System/Logging/FacadeSpec.hs +4/−8

@@ -1,4 +1,4 @@-Copyright (c) 2014 Simon Hengel <sol@typeful.net>+Copyright (c) 2014-2017 Simon Hengel <sol@typeful.net>  Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal

@@ -1,10 +1,16 @@+-- This file has been generated from package.yaml by hpack version 0.17.0.+--+-- see: https://github.com/sol/hpack+ name:             logging-facade-version:          0.1.1+version:          0.2.0 synopsis:         Simple logging abstraction that allows multiple back-ends description:      Simple logging abstraction that allows multiple back-ends+homepage:         https://github.com/sol/logging-facade#readme+bug-reports:      https://github.com/sol/logging-facade/issues license:          MIT license-file:     LICENSE-copyright:        (c) 2014 Simon Hengel+copyright:        (c) 2014-2017 Simon Hengel author:           Simon Hengel <sol@typeful.net> maintainer:       Simon Hengel <sol@typeful.net> build-type:       Simple@@ -17,24 +23,29 @@  library   ghc-options: -Wall-  hs-source-dirs: src+  hs-source-dirs:+      src   exposed-modules:       System.Logging.Facade-      System.Logging.Facade.Sink       System.Logging.Facade.Class+      System.Logging.Facade.Sink       System.Logging.Facade.Types+  other-modules:+      Paths_logging_facade   build-depends:       base == 4.*     , transformers-    , template-haskell   default-language: Haskell2010  test-suite spec   type: exitcode-stdio-1.0   ghc-options: -Wall-  hs-source-dirs: test+  hs-source-dirs:+      test   main-is: Spec.hs   other-modules:+      Helper+      System.Logging.Facade.SinkSpec       System.Logging.FacadeSpec   build-depends:       base == 4.*

@@ -1,13 +1,18 @@+{-# LANGUAGE CPP #-} module System.Logging.Facade.Sink (   LogSink , defaultLogSink-, setLogSink , getLogSink+, setLogSink+, swapLogSink+, withLogSink ) where +import           Control.Concurrent import           Data.IORef import           System.IO import           System.IO.Unsafe (unsafePerformIO)+import           Control.Exception  import           System.Logging.Facade.Types @@ -16,7 +21,7 @@  -- use the unsafePerformIO hack to share one sink across a process logSink :: IORef LogSink-logSink = unsafePerformIO (newIORef defaultLogSink)+logSink = unsafePerformIO (defaultLogSink >>= newIORef) {-# NOINLINE logSink #-}  -- | Return the global log sink.@@ -27,9 +32,22 @@ setLogSink :: LogSink -> IO () setLogSink = atomicWriteIORef logSink --- | A log sink that writes log messages to `stderr`-defaultLogSink :: LogSink-defaultLogSink record = hPutStrLn stderr output+-- | Return the global log sink and set it to a new value in one atomic+-- operation.+swapLogSink :: LogSink -> IO LogSink+swapLogSink new = atomicModifyIORef logSink $ \old -> (new, old)++-- | Set the global log sink to a specified value, run given action, and+-- finally restore the global log sink to its previous value.+withLogSink :: LogSink -> IO () -> IO ()+withLogSink sink action = bracket (swapLogSink sink) setLogSink (const action)++-- | A thread-safe log sink that writes log messages to `stderr`+defaultLogSink :: IO LogSink+defaultLogSink = defaultLogSink_ `fmap` newMVar ()++defaultLogSink_ :: MVar () -> LogSink+defaultLogSink_ mvar record = withMVar mvar (\() -> hPutStrLn stderr output)   where     level = logRecordLevel record     mLocation = logRecordLocation record@@ -40,3 +58,10 @@ formatLocation :: Location -> ShowS formatLocation loc = showString (locationFile loc) . colon . shows (locationLine loc) . colon . shows (locationColumn loc)   where colon = showString ":"++#if !MIN_VERSION_base(4,6,0)+atomicWriteIORef :: IORef a -> a -> IO ()+atomicWriteIORef ref a = do+    x <- atomicModifyIORef ref (\_ -> (a, ()))+    x `seq` return ()+#endif

@@ -1,7 +1,7 @@ module System.Logging.Facade.Types where  data LogLevel = TRACE | DEBUG | INFO | WARN | ERROR-  deriving (Eq, Show, Ord, Bounded, Enum)+  deriving (Eq, Show, Read, Ord, Bounded, Enum)  data Location = Location {   locationPackage :: String

@@ -0,0 +1,17 @@+module Helper (+  module Test.Hspec+, logSinkSpy+) where++import           Test.Hspec+import           Data.IORef++import           System.Logging.Facade.Types+import           System.Logging.Facade.Sink++logSinkSpy :: IO (IO [LogRecord], LogSink)+logSinkSpy = do+  ref <- newIORef []+  let spy :: LogSink+      spy record = modifyIORef ref (record {logRecordLocation = Nothing} :)+  return (readIORef ref, spy)

@@ -0,0 +1,25 @@+module System.Logging.Facade.SinkSpec (main, spec) where++import           Helper++import           System.Logging.Facade+import           System.Logging.Facade.Types+import           System.Logging.Facade.Sink++main :: IO ()+main = hspec spec++spec :: Spec+spec = do+  describe "withLogSink" $ do+    it "sets the global log sink to specified value before running specified action" $ do+      (logRecords, spy) <- logSinkSpy+      withLogSink spy (info "some log message")+      logRecords `shouldReturn` [LogRecord INFO Nothing "some log message"]++    it "restores the original log sink when done" $ do+      (logRecords, spy) <- logSinkSpy+      setLogSink spy+      withLogSink (\_ -> return ()) (return ())+      info "some log message"+      logRecords `shouldReturn` [LogRecord INFO Nothing "some log message"]

@@ -1,7 +1,6 @@ module System.Logging.FacadeSpec (main, spec) where -import           Test.Hspec-import           Data.IORef+import           Helper  import           System.Logging.Facade.Types import           System.Logging.Facade.Sink@@ -14,9 +13,6 @@ spec = do   describe "info" $ do     it "writes a log message with log level INFO" $ do-      ref <- newIORef []-      let captureLogMessage :: LogSink-          captureLogMessage record = modifyIORef ref (record {logRecordLocation = Nothing} :)-      setLogSink captureLogMessage-      info "some log message"-      readIORef ref `shouldReturn` [LogRecord INFO Nothing "some log message"]+      (logRecords, spy) <- logSinkSpy+      withLogSink spy (info "some log message")+      logRecords `shouldReturn` [LogRecord INFO Nothing "some log message"]