Hello community,
here is the log from the commit of package ghc-logging-facade for
openSUSE:Factory checked in at 2017-08-31 20:48:19
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/ghc-logging-facade (Old)
and /work/SRC/openSUSE:Factory/.ghc-logging-facade.new (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-logging-facade"
Thu Aug 31 20:48:19 2017 rev:3 rq:513426 version:0.3.0
Changes:
--------
--- /work/SRC/openSUSE:Factory/ghc-logging-facade/ghc-logging-facade.changes
2016-12-06 14:25:03.000000000 +0100
+++
/work/SRC/openSUSE:Factory/.ghc-logging-facade.new/ghc-logging-facade.changes
2017-08-31 20:48:20.431861240 +0200
@@ -1,0 +2,5 @@
+Thu Jul 27 14:05:34 UTC 2017 - [email protected]
+
+- Update to version 0.3.0.
+
+-------------------------------------------------------------------
Old:
----
logging-facade-0.1.1.tar.gz
logging-facade.cabal
New:
----
logging-facade-0.3.0.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ ghc-logging-facade.spec ++++++
--- /var/tmp/diff_new_pack.afI0dZ/_old 2017-08-31 20:48:21.291740541 +0200
+++ /var/tmp/diff_new_pack.afI0dZ/_new 2017-08-31 20:48:21.299739419 +0200
@@ -1,7 +1,7 @@
#
# spec file for package ghc-logging-facade
#
-# Copyright (c) 2016 SUSE LINUX GmbH, Nuernberg, Germany.
+# Copyright (c) 2017 SUSE LINUX GmbH, Nuernberg, Germany.
#
# All modifications and additions to the file contributed by third parties
# remain the property of their copyright owners, unless otherwise agreed
@@ -19,17 +19,16 @@
%global pkg_name logging-facade
%bcond_with tests
Name: ghc-%{pkg_name}
-Version: 0.1.1
+Version: 0.3.0
Release: 0
Summary: Simple logging abstraction that allows multiple back-ends
License: MIT
Group: Development/Languages/Other
Url: https://hackage.haskell.org/package/%{pkg_name}
Source0:
https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{version}.tar.gz
-Source1:
https://hackage.haskell.org/package/%{pkg_name}-%{version}/revision/1.cabal#/%{pkg_name}.cabal
BuildRequires: ghc-Cabal-devel
+BuildRequires: ghc-call-stack-devel
BuildRequires: ghc-rpm-macros
-BuildRequires: ghc-template-haskell-devel
BuildRequires: ghc-transformers-devel
BuildRoot: %{_tmppath}/%{name}-%{version}-build
%if %{with tests}
@@ -52,7 +51,6 @@
%prep
%setup -q -n %{pkg_name}-%{version}
-cp -p %{SOURCE1} %{pkg_name}.cabal
%build
%ghc_lib_build
++++++ logging-facade-0.1.1.tar.gz -> logging-facade-0.3.0.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/logging-facade-0.1.1/LICENSE
new/logging-facade-0.3.0/LICENSE
--- old/logging-facade-0.1.1/LICENSE 2016-02-21 05:05:49.000000000 +0100
+++ new/logging-facade-0.3.0/LICENSE 2017-06-01 15:24:19.000000000 +0200
@@ -1,4 +1,4 @@
-Copyright (c) 2014 Simon Hengel <[email protected]>
+Copyright (c) 2014-2017 Simon Hengel <[email protected]>
Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to deal
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/logging-facade-0.1.1/logging-facade.cabal
new/logging-facade-0.3.0/logging-facade.cabal
--- old/logging-facade-0.1.1/logging-facade.cabal 2016-02-21
05:05:49.000000000 +0100
+++ new/logging-facade-0.3.0/logging-facade.cabal 2017-06-01
15:24:19.000000000 +0200
@@ -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.3.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 <[email protected]>
maintainer: Simon Hengel <[email protected]>
build-type: Simple
@@ -17,24 +23,30 @@
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.*
+ , call-stack
, 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.*
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/logging-facade-0.1.1/src/System/Logging/Facade/Sink.hs
new/logging-facade-0.3.0/src/System/Logging/Facade/Sink.hs
--- old/logging-facade-0.1.1/src/System/Logging/Facade/Sink.hs 2016-02-21
05:05:49.000000000 +0100
+++ new/logging-facade-0.3.0/src/System/Logging/Facade/Sink.hs 2017-06-01
15:24:19.000000000 +0200
@@ -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
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/logging-facade-0.1.1/src/System/Logging/Facade/Types.hs
new/logging-facade-0.3.0/src/System/Logging/Facade/Types.hs
--- old/logging-facade-0.1.1/src/System/Logging/Facade/Types.hs 2016-02-21
05:05:49.000000000 +0100
+++ new/logging-facade-0.3.0/src/System/Logging/Facade/Types.hs 2017-06-01
15:24:19.000000000 +0200
@@ -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
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/logging-facade-0.1.1/src/System/Logging/Facade.hs
new/logging-facade-0.3.0/src/System/Logging/Facade.hs
--- old/logging-facade-0.1.1/src/System/Logging/Facade.hs 2016-02-21
05:05:49.000000000 +0100
+++ new/logging-facade-0.3.0/src/System/Logging/Facade.hs 2017-06-01
15:24:19.000000000 +0200
@@ -1,8 +1,5 @@
-{-# LANGUAGE CPP #-}
-#if MIN_VERSION_base(4,8,1)
-#define HAS_SOURCE_LOCATIONS
-{-# LANGUAGE ImplicitParams #-}
-#endif
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE ConstraintKinds #-}
-- |
-- This module is intended to be imported qualified:
--
@@ -22,49 +19,36 @@
) where
import Prelude hiding (log, error)
+import Data.CallStack
import System.Logging.Facade.Types
import System.Logging.Facade.Class
-#ifdef HAS_SOURCE_LOCATIONS
-#if ! MIN_VERSION_base(4,9,0)
-import GHC.SrcLoc
-#endif
-import GHC.Stack
-#define with_loc (?loc :: CallStack) =>
-#else
-#define with_loc
-#endif
-
-- | Produce a log message with specified log level.
-log :: with_loc Logging m => LogLevel -> String -> m ()
+log :: (HasCallStack, Logging m) => LogLevel -> String -> m ()
log level message = consumeLogRecord (LogRecord level location message)
- where
- location :: Maybe Location
-#ifdef HAS_SOURCE_LOCATIONS
- location = case reverse (getCallStack ?loc) of
- (_, loc) : _ -> Just $ Location (srcLocPackage loc) (srcLocModule loc)
(srcLocFile loc) (srcLocStartLine loc) (srcLocStartCol loc)
- _ -> Nothing
-#else
- location = Nothing
-#endif
+
+location :: HasCallStack => Maybe Location
+location = case reverse callStack of
+ (_, loc) : _ -> Just $ Location (srcLocPackage loc) (srcLocModule loc)
(srcLocFile loc) (srcLocStartLine loc) (srcLocStartCol loc)
+ _ -> Nothing
-- | Produce a log message with log level `TRACE`.
-trace :: with_loc Logging m => String -> m ()
+trace :: (HasCallStack, Logging m) => String -> m ()
trace = log TRACE
-- | Produce a log message with log level `DEBUG`.
-debug :: with_loc Logging m => String -> m ()
+debug :: (HasCallStack, Logging m) => String -> m ()
debug = log DEBUG
-- | Produce a log message with log level `INFO`.
-info :: with_loc Logging m => String -> m ()
+info :: (HasCallStack, Logging m) => String -> m ()
info = log INFO
-- | Produce a log message with log level `WARN`.
-warn :: with_loc Logging m => String -> m ()
+warn :: (HasCallStack, Logging m) => String -> m ()
warn = log WARN
-- | Produce a log message with log level `ERROR`.
-error :: with_loc Logging m => String -> m ()
+error :: (HasCallStack, Logging m) => String -> m ()
error = log ERROR
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/logging-facade-0.1.1/test/Helper.hs
new/logging-facade-0.3.0/test/Helper.hs
--- old/logging-facade-0.1.1/test/Helper.hs 1970-01-01 01:00:00.000000000
+0100
+++ new/logging-facade-0.3.0/test/Helper.hs 2017-06-01 15:24:19.000000000
+0200
@@ -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)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/logging-facade-0.1.1/test/System/Logging/Facade/SinkSpec.hs
new/logging-facade-0.3.0/test/System/Logging/Facade/SinkSpec.hs
--- old/logging-facade-0.1.1/test/System/Logging/Facade/SinkSpec.hs
1970-01-01 01:00:00.000000000 +0100
+++ new/logging-facade-0.3.0/test/System/Logging/Facade/SinkSpec.hs
2017-06-01 15:24:19.000000000 +0200
@@ -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"]
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/logging-facade-0.1.1/test/System/Logging/FacadeSpec.hs
new/logging-facade-0.3.0/test/System/Logging/FacadeSpec.hs
--- old/logging-facade-0.1.1/test/System/Logging/FacadeSpec.hs 2016-02-21
05:05:49.000000000 +0100
+++ new/logging-facade-0.3.0/test/System/Logging/FacadeSpec.hs 2017-06-01
15:24:19.000000000 +0200
@@ -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"]
