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 - psimons@suse.com + +- 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 <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 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 <sol@typeful.net> maintainer: Simon Hengel <sol@typeful.net> 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"]