summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMichaelSnoyman <>2018-03-13 16:48:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2018-03-13 16:48:00 (GMT)
commit9148fadaf12011b630dc5518bacf2efef38eb12c (patch)
tree058065f7bf8679fd90076ad6c501e1c6e4c0ab06
parent35f1be48625ab7df8097cdcb293195eaa488e6dc (diff)
version 0.3.28.20.3.28.2
-rw-r--r--ChangeLog.md5
-rw-r--r--Control/Monad/Logger.hs104
-rw-r--r--monad-logger.cabal5
3 files changed, 63 insertions, 51 deletions
diff --git a/ChangeLog.md b/ChangeLog.md
index 87b9558..3416147 100644
--- a/ChangeLog.md
+++ b/ChangeLog.md
@@ -1,3 +1,8 @@
+## 0.3.28.2
+
+* Support for exceptions 0.9 and 0.10 [#158](https://github.com/kazu-yamamoto/logger/issues/158)
+* Drop blaze-builder dependency
+
## 0.3.28.1
* Fix support for GHC 7.8 [#154](https://github.com/kazu-yamamoto/logger/pull/154)
diff --git a/Control/Monad/Logger.hs b/Control/Monad/Logger.hs
index 7aec1f4..d97c961 100644
--- a/Control/Monad/Logger.hs
+++ b/Control/Monad/Logger.hs
@@ -1,4 +1,5 @@
{-# LANGUAGE CPP #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE DefaultSignatures #-}
#if WITH_CALLSTACK
{-# LANGUAGE ImplicitParams #-}
@@ -119,7 +120,11 @@ import qualified Control.Monad.Trans.Class as Trans
import Control.Monad.IO.Class (MonadIO (liftIO))
import Control.Monad.Trans.Resource (MonadResource (liftResourceT))
-import Control.Monad.Catch (MonadThrow (..), MonadCatch (..), MonadMask (..))
+import Control.Monad.Catch (MonadThrow (..), MonadCatch (..), MonadMask (..)
+#if MIN_VERSION_exceptions(0, 10, 0)
+ , ExitCase (..)
+#endif
+ )
import Control.Monad.Trans.Identity ( IdentityT)
import Control.Monad.Trans.List ( ListT )
@@ -354,57 +359,11 @@ logOtherS = [|\src level msg -> monadLoggerLog $(qLocation >>= liftLoc) src (Lev
--
-- @since 0.2.4
newtype NoLoggingT m a = NoLoggingT { runNoLoggingT :: m a }
+ deriving (Functor, Applicative, Monad, MonadIO, MonadThrow, MonadCatch, MonadMask, MonadActive, MonadResource, MonadBase b)
-#if __GLASGOW_HASKELL__ < 710
-instance Monad m => Functor (NoLoggingT m) where
- fmap = liftM
-
-instance Monad m => Applicative (NoLoggingT m) where
- pure = return
- (<*>) = ap
-#else
-instance Functor m => Functor (NoLoggingT m) where
- fmap f = NoLoggingT . fmap f . runNoLoggingT
- {-# INLINE fmap #-}
-
-instance Applicative m => Applicative (NoLoggingT m) where
- pure = NoLoggingT . pure
- {-# INLINE pure #-}
- f <*> a = NoLoggingT (runNoLoggingT f <*> runNoLoggingT a)
- {-# INLINE (<*>) #-}
-#endif
-
-instance Monad m => Monad (NoLoggingT m) where
- return = NoLoggingT . return
- NoLoggingT ma >>= f = NoLoggingT $ ma >>= runNoLoggingT . f
-
-instance MonadIO m => MonadIO (NoLoggingT m) where
- liftIO = Trans.lift . liftIO
-
-instance MonadThrow m => MonadThrow (NoLoggingT m) where
- throwM = Trans.lift . throwM
-
-instance MonadCatch m => MonadCatch (NoLoggingT m) where
- catch (NoLoggingT m) c =
- NoLoggingT $ m `catch` \e -> runNoLoggingT (c e)
-instance MonadMask m => MonadMask (NoLoggingT m) where
- mask a = NoLoggingT $ mask $ \u -> runNoLoggingT (a $ q u)
- where q u (NoLoggingT b) = NoLoggingT $ u b
- uninterruptibleMask a =
- NoLoggingT $ uninterruptibleMask $ \u -> runNoLoggingT (a $ q u)
- where q u (NoLoggingT b) = NoLoggingT $ u b
-
-instance MonadActive m => MonadActive (NoLoggingT m) where
- monadActive = Trans.lift monadActive
instance MonadActive m => MonadActive (LoggingT m) where
monadActive = Trans.lift monadActive
-instance MonadResource m => MonadResource (NoLoggingT m) where
- liftResourceT = Trans.lift . liftResourceT
-
-instance MonadBase b m => MonadBase b (NoLoggingT m) where
- liftBase = Trans.lift . liftBase
-
instance Trans.MonadTrans NoLoggingT where
lift = NoLoggingT
@@ -518,6 +477,41 @@ instance MonadMask m => MonadMask (WriterLoggingT m) where
uninterruptibleMask a = WriterLoggingT $ uninterruptibleMask $ \u -> unWriterLoggingT (a $ q u)
where q u b = WriterLoggingT $ u (unWriterLoggingT b)
+#if MIN_VERSION_exceptions(0, 10, 0)
+ generalBracket acquire release use = WriterLoggingT $ do
+ ((b, _w12), (c, w123)) <- generalBracket
+ (unWriterLoggingT acquire)
+ (\(resource, w1) exitCase -> case exitCase of
+ ExitCaseSuccess (b, w12) -> do
+ (c, w3) <- unWriterLoggingT (release resource (ExitCaseSuccess b))
+ return (c, appendDList w12 w3)
+ -- In the two other cases, the base monad overrides @use@'s state
+ -- changes and the state reverts to @w1@.
+ ExitCaseException e -> do
+ (c, w3) <- unWriterLoggingT (release resource (ExitCaseException e))
+ return (c, appendDList w1 w3)
+ ExitCaseAbort -> do
+ (c, w3) <- unWriterLoggingT (release resource ExitCaseAbort)
+ return (c, appendDList w1 w3))
+ (\(resource, w1) -> do
+ (a, w2) <- unWriterLoggingT (use resource)
+ return (a, appendDList w1 w2))
+ return ((b, c), w123)
+#elif MIN_VERSION_exceptions(0, 9, 0)
+ generalBracket acquire release releaseEx use =
+ WriterLoggingT $ generalBracket
+ (unWriterLoggingT acquire)
+ (\(x, w1) -> do
+ (y, w2) <- unWriterLoggingT (release x)
+ return (y, appendDList w1 w2))
+ (\(x, w1) ex -> do
+ (y, w2) <- unWriterLoggingT (releaseEx x ex)
+ return (y, appendDList w1 w2))
+ (\(x, w1) -> do
+ (y, w2) <- unWriterLoggingT (use x)
+ return (y, appendDList w1 w2))
+#endif
+
-- | Monad transformer that adds a new logging function.
--
-- @since 0.2.2
@@ -565,6 +559,20 @@ instance MonadMask m => MonadMask (LoggingT m) where
uninterruptibleMask a =
LoggingT $ \e -> uninterruptibleMask $ \u -> runLoggingT (a $ q u) e
where q u (LoggingT b) = LoggingT (u . b)
+#if MIN_VERSION_exceptions(0, 10, 0)
+ generalBracket acquire release use =
+ LoggingT $ \e -> generalBracket
+ (runLoggingT acquire e)
+ (\x ec -> runLoggingT (release x ec) e)
+ (\x -> runLoggingT (use x) e)
+#elif MIN_VERSION_exceptions(0, 9, 0)
+ generalBracket acquire release releaseEx use =
+ LoggingT $ \e -> generalBracket
+ (runLoggingT acquire e)
+ (\x -> runLoggingT (release x) e)
+ (\x y -> runLoggingT (releaseEx x y) e)
+ (\x -> runLoggingT (use x) e)
+#endif
instance MonadResource m => MonadResource (LoggingT m) where
liftResourceT = Trans.lift . liftResourceT
diff --git a/monad-logger.cabal b/monad-logger.cabal
index 6dd149a..c195ccf 100644
--- a/monad-logger.cabal
+++ b/monad-logger.cabal
@@ -1,5 +1,5 @@
name: monad-logger
-version: 0.3.28.1
+version: 0.3.28.2
synopsis: A class of monads which can log messages.
description: Hackage documentation generation is not reliable. For up to date documentation, please see: <http://www.stackage.org/package/monad-logger>.
homepage: https://github.com/kazu-yamamoto/logger
@@ -42,8 +42,7 @@ library
, monad-loops
, mtl
, bytestring >= 0.10.2
- , blaze-builder
- , exceptions >= 0.6
+ , exceptions >= 0.6 && < 0.11
, unliftio-core
if impl(ghc >= 8.0.1)