@@ -44,7 +44,8 @@ import Control.Monad.Trans.Either
4444import Control.Monad.Trans.Except
4545import Control.Monad.Trans.Maybe
4646import Control.Monad.Trans.Reader
47−import Control.Monad.Trans.Resource (ResourceT, transResourceT)
47+import Control.Monad.Trans.Resource (MonadResource, ResourceT,
48+ transResourceT)
4849import Control.Monad.Trans.RWS.Lazy (RWST, mapRWST)
4950import qualified Control.Monad.Trans.RWS.Strict as Strict (RWST, mapRWST)
5051import Control.Monad.Trans.State.Lazy (StateT, mapStateT)
@@ -664,7 +665,7 @@ makeLenses ''LogEnv
664665
665666
666667-------------------------------------------------------------------------------
667−-- | Create a reasonable default InitLogEnv. Uses an 'AutoUdate' which
668+-- | Create a reasonable default InitLogEnv. Uses an 'AutoUpdate' which
668669-- updates the timer every 1ms. If you need even more timestamp
669670-- precision at the cost of performance, consider setting
670671-- '_logEnvTimer' with 'getCurrentTime'.
@@ -879,7 +880,8 @@ instance (Katip m) => Katip (ResourceT m) where
879880-- opposed to implementing 'Katip' for your monad.
880881newtype KatipT m a = KatipT { unKatipT :: ReaderT LogEnv m a }
881882 deriving ( Functor, Applicative, Monad, MonadIO
882− , MonadMask, MonadCatch, MonadThrow, MonadTrans, MonadBase b)
883+ , MonadMask, MonadCatch, MonadThrow, MonadResource, MonadTrans
884+ , MonadBase b)
883885
884886
885887instance MonadIO m => Katip (KatipT m) where
@@ -901,9 +903,14 @@ instance (MonadBaseControl b m) => MonadBaseControl b (KatipT m) where
901903 restoreM = defaultRestoreM
902904
903905instance MonadUnliftIO m => MonadUnliftIO (KatipT m) where
906+#if MIN_VERSION_unliftio_core(0, 2, 0)
907+ withRunInIO inner = KatipT $ ReaderT $ \le -> withRunInIO $ \run ->
908+ inner (run . runKatipT le)
909+#else
904910 askUnliftIO = KatipT $
905− withUnliftIO $ \u ->
906− pure (UnliftIO (unliftIO u . unKatipT))
911+ withUnliftIO $ \u ->
912+ pure (UnliftIO (unliftIO u . unKatipT))
913+#endif
907914
908915#if MIN_VERSION_base(4, 9, 0)
909916instance MF.MonadFail m => MF.MonadFail (KatipT m) where
@@ -941,19 +948,29 @@ logItem
941948 -> m ()
942949logItem a ns loc sev msg = do
943950 LogEnv{..} <- getLogEnv
944− liftIO $ do
945− item <- Item
946− <$> pure _logEnvApp
947− <*> pure _logEnvEnv
948− <*> pure sev
949− <*> (mkThreadIdText <$> myThreadId)
950− <*> pure _logEnvHost
951− <*> pure _logEnvPid
952− <*> pure a
953− <*> pure msg
954− <*> _logEnvTimer
955− <*> pure (_logEnvApp <> ns)
956− <*> pure loc
951+ logKatipItem =<< liftIO
952+ (Item <$> pure _logEnvApp
953+ <*> pure _logEnvEnv
954+ <*> pure sev
955+ <*> (mkThreadIdText <$> myThreadId)
956+ <*> pure _logEnvHost
957+ <*> pure _logEnvPid
958+ <*> pure a
959+ <*> pure msg
960+ <*> _logEnvTimer
961+ <*> pure (_logEnvApp <> ns)
962+ <*> pure loc)
963+
964+-- | Log already constructed 'Item'. This is the lowest level function that other log*
965+-- functions use.
966+-- It can be useful when implementing centralised logging services.
967+logKatipItem
968+ :: (A.Applicative m, LogItem a, Katip m)
969+ => Item a
970+ -> m ()
971+logKatipItem item = do
972+ LogEnv{..} <- getLogEnv
973+ liftIO $
957974 FT.forM_ (M.elems _logEnvScribes) $ \ ScribeHandle {..} -> do
958975 whenM (scribePermitItem shScribe item) $
959976 void $ atomically (tryWriteTBQueue shChan (NewItem item))
@@ -1002,7 +1019,7 @@ logException
10021019logException a ns sev action = action `catchAny` \e -> f e >> throwM e
10031020 where
10041021 f e = logF a ns sev (msg e)
1005− msg e = ls (T.pack "An exception has occured: ") <> showLS e
1022+ msg e = ls (T.pack "An exception has occurred: ") <> showLS e
10061023
10071024
10081025-------------------------------------------------------------------------------