on master help sign in
Added MonadFail instance for KatipT and KatipContextT
commit6ba17564e4133299ccc3ffc9bb92954b7e07ebef authorKoray Al <admin@koray.al> dateWed 27 Mar 2019, 22:54 (8 years ago) parent6af8474
2 files changed+17
katip/src/Katip/Core.hs+9 katip/src/Katip/Monadic.hs+8
katip/src/Katip/Core.hs+9
@@ -31,6 +31,9 @@ import qualified Control.Concurrent.STM.TBQueue as BQ
3131import Control.Exception.Safe
3232import Control.Monad (unless, void, when)
3333import Control.Monad.Base
34+#if MIN_VERSION_base(4, 9, 0)
35+import qualified Control.Monad.Fail as MF
36+#endif
3437import Control.Monad.IO.Class
3538import Control.Monad.IO.Unlift
3639import Control.Monad.Trans.Class
@@ -902,6 +905,12 @@ instance MonadUnliftIO m => MonadUnliftIO (KatipT m) where
902905 withUnliftIO $ \u ->
903906 pure (UnliftIO (unliftIO u . unKatipT))
904907
908+#if MIN_VERSION_base(4, 9, 0)
909+instance MF.MonadFail m => MF.MonadFail (KatipT m) where
910+ fail msg = lift (MF.fail msg)
911+ {-# INLINE fail #-}
912+#endif
913+
905914-------------------------------------------------------------------------------
906915-- | Execute 'KatipT' on a log env.
907916runKatipT :: LogEnv -> KatipT m a -> m a
katip/src/Katip/Monadic.hs+8
@@ -44,6 +44,9 @@ import Control.Applicative
4444import Control.Exception.Safe
4545import Control.Monad.Base
4646import Control.Monad.Error.Class
47+#if MIN_VERSION_base(4, 9, 0)
48+import qualified Control.Monad.Fail as MF
49+#endif
4750import Control.Monad.IO.Class
4851import Control.Monad.IO.Unlift
4952import Control.Monad.Reader
@@ -396,6 +399,11 @@ instance MonadUnliftIO m => MonadUnliftIO (KatipContextT m) where
396399 withUnliftIO $ \u ->
397400 pure (UnliftIO (unliftIO u . unKatipContextT))
398401
402+#if MIN_VERSION_base(4, 9, 0)
403+instance MF.MonadFail m => MF.MonadFail (KatipContextT m) where
404+ fail msg = lift (MF.fail msg)
405+ {-# INLINE fail #-}
406+#endif
399407
400408-------------------------------------------------------------------------------
401409runKatipContextT :: (LogItem c) => LogEnv -> c -> Namespace -> KatipContextT m a -> m a