katip 0.5.2.0 → 0.5.3.0

raw patch · 5 files changed

+73/−5 lines, 5 filesdep +unliftio-coredep ~basePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: unliftio-core

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• changelog.md +5/−0
• katip.cabal +2/−1
• src/Katip.hs +3/−3
• src/Katip/Core.hs +5/−0
• src/Katip/Monadic.hs +58/−1

@@ -1,3 +1,8 @@+0.5.3.0+=======+* Add MonadUnliftIO instances.+* Add NoLoggingT+ 0.5.2.0 ======= * Allow newer versions of either by conditionally adding instances for the removed EitherT interface.

@@ -1,5 +1,5 @@ name:                katip-version:             0.5.2.0+version:             0.5.3.0 synopsis:            A structured logging framework. description:   Katip is a structured logging framework. See README.md for more details.@@ -78,6 +78,7 @@                , microlens >= 0.2.0.0 && < 0.5                , microlens-th >= 0.1.0.0 && < 0.5                , semigroups+               , unliftio-core >= 0.1 && < 0.2                , stm >= 2.4    hs-source-dirs:      src

@@ -52,7 +52,7 @@ --   getLogEnv = asks logEnv --   -- with lens: --   -- getLogEnv = view logEnv---   localLogEnv f (App m) = App (local (\s -> s { logEnv = f (logEnv s)}) m)+--   localLogEnv f (App m) = App (local (\\s -> s { logEnv = f (logEnv s)}) m) --   -- with lens: --   -- localLogEnv f (App m) = App (local (over logEnv f) m) --@@ -61,13 +61,13 @@ --   getKatipContext = asks logContext --   -- with lens: --   -- getKatipContext = view logContext---   localKatipContext f (App m) = App (local (\s -> s { logContext = f (logContext s)}) m)+--   localKatipContext f (App m) = App (local (\\s -> s { logContext = f (logContext s)}) m) --   -- with lens: --   -- localKatipContext f (App m) = App (local (over logContext f) m) --   getKatipNamespace = asks logNamespace --   -- with lens: --   -- getKatipNamespace = view logNamespace---   localKatipNamespace f (App m) = App (local (\s -> s { logNamespace = f (logNamespace s)}) m)+--   localKatipNamespace f (App m) = App (local (\\s -> s { logNamespace = f (logNamespace s)}) m) --   -- with lens: --   -- localKatipNamespace f (App m) = App (local (over logNamespace f) m) --

@@ -33,6 +33,7 @@ import           Control.Monad                         (unless, void) import           Control.Monad.Base import           Control.Monad.IO.Class+import           Control.Monad.IO.Unlift import           Control.Monad.Trans.Class import           Control.Monad.Trans.Control #if !MIN_VERSION_either(4, 5, 0)@@ -833,6 +834,10 @@   liftBaseWith = defaultLiftBaseWith   restoreM = defaultRestoreM +instance MonadUnliftIO m => MonadUnliftIO (KatipT m) where+  askUnliftIO = KatipT $+                withUnliftIO $ \u ->+                pure (UnliftIO (unliftIO u . unKatipT))  ------------------------------------------------------------------------------- -- | Execute 'KatipT' on a log env.

@@ -34,6 +34,7 @@     , katipAddNamespace     , katipAddContext     , KatipContextTState(..)+    , NoLoggingT     ) where  @@ -43,6 +44,7 @@ import           Control.Monad.Base import           Control.Monad.Error.Class import           Control.Monad.IO.Class+import           Control.Monad.IO.Unlift import           Control.Monad.Reader import           Control.Monad.State import           Control.Monad.Trans.Control@@ -137,7 +139,7 @@   localKatipContext :: (LogContexts -> LogContexts) -> m a -> m a   getKatipNamespace :: m Namespace   -- | Temporarily modify the current namespace for the duration of the-  -- supplied monad. Used in 'katipAddContext'+  -- supplied monad. Used in 'katipAddNamespace'   localKatipNamespace :: (Namespace -> Namespace) -> m a -> m a  instance (KatipContext m, Katip (IdentityT m)) => KatipContext (IdentityT m) where@@ -389,7 +391,12 @@   getKatipNamespace = KatipContextT $ ReaderT $ \lts -> return (ltsNamespace lts)   localKatipNamespace f (KatipContextT m) = KatipContextT $ local (\s -> s { ltsNamespace = f (ltsNamespace s)}) m +instance MonadUnliftIO m => MonadUnliftIO (KatipContextT m) where+  askUnliftIO = KatipContextT $+                withUnliftIO $ \u ->+                pure (UnliftIO (unliftIO u . unKatipContextT)) + ------------------------------------------------------------------------------- runKatipContextT :: (LogItem c) => LogEnv -> c -> Namespace -> KatipContextT m a -> m a runKatipContextT le ctx ns = flip runReaderT lts . unKatipContextT@@ -429,3 +436,53 @@     -> m a     -> m a katipAddContext i = localKatipContext (<> (liftPayload i))++newtype NoLoggingT m a = NoLoggingT {+      runNoLoggingT :: m a+    } deriving ( Functor+               , Applicative+               , Monad+               , MonadIO+               , MonadThrow+               , MonadCatch+               , MonadMask+               , MonadBase b+               , MonadState s+               , MonadWriter w+               , MonadError e+               , MonadPlus+               , Alternative+               , MonadFix+               )++instance MonadTrans NoLoggingT where+  lift = NoLoggingT++instance MonadTransControl NoLoggingT where+    type StT NoLoggingT a = a+    liftWith f = NoLoggingT $ f runNoLoggingT+    restoreT = NoLoggingT+    {-# INLINE liftWith #-}+    {-# INLINE restoreT #-}++instance MonadBaseControl b m => MonadBaseControl b (NoLoggingT m) where+     type StM (NoLoggingT m) a = StM m a+     liftBaseWith f = NoLoggingT $+         liftBaseWith $ \runInBase ->+             f $ runInBase . runNoLoggingT+     restoreM = NoLoggingT . restoreM++instance MonadUnliftIO m => MonadUnliftIO (NoLoggingT m) where+  askUnliftIO = NoLoggingT $+                withUnliftIO $ \u ->+                pure (UnliftIO (unliftIO u . runNoLoggingT))++instance MonadIO m => Katip (NoLoggingT m) where+  getLogEnv = liftIO (initLogEnv "NoLoggingT" "no-logging")+  localLogEnv = const id++instance MonadIO m => KatipContext (NoLoggingT m) where+  getKatipContext = pure mempty+  localKatipContext = const id+  getKatipNamespace = pure mempty+  localKatipNamespace = const id