@@ -31,7 +31,6 @@ import qualified Control.Concurrent.STM.TBQueue as BQ
3131import Control.Exception.Safe
3232import Control.Monad (unless, void, when)
3333import Control.Monad.Base
34−import Data.Text.Encoding as T
3534#if MIN_VERSION_base(4, 9, 0)
3635import qualified Control.Monad.Fail as MF
3736#endif
@@ -45,7 +44,8 @@ import Control.Monad.Trans.Either
4544import Control.Monad.Trans.Except
4645import Control.Monad.Trans.Maybe
4746import Control.Monad.Trans.Reader
48−import Control.Monad.Trans.Resource (ResourceT, transResourceT)
47+import Control.Monad.Trans.Resource (MonadResource, ResourceT,
48+ transResourceT)
4949import Control.Monad.Trans.RWS.Lazy (RWST, mapRWST)
5050import qualified Control.Monad.Trans.RWS.Strict as Strict (RWST, mapRWST)
5151import Control.Monad.Trans.State.Lazy (StateT, mapStateT)
@@ -56,7 +56,6 @@ import qualified Control.Monad.Trans.Writer.Strict as Strict (WriterT,
5656import Data.Aeson (FromJSON (..), ToJSON (..),
5757 object)
5858import qualified Data.Aeson as A
59−import qualified Data.ByteString.Builder as B
6059import Data.Foldable as FT
6160import qualified Data.HashMap.Strict as HM
6261import Data.List
@@ -67,6 +66,7 @@ import Data.String
6766import Data.String.Conv
6867import Data.Text (Text)
6968import qualified Data.Text as T
69+import qualified Data.Text.Lazy.Builder as B
7070import Data.Time
7171import GHC.Generics hiding (to)
7272#if MIN_VERSION_base(4, 8, 0)
@@ -200,15 +200,13 @@ instance FromJSON Verbosity where
200200 _ -> fail $ "Invalid Verbosity " ++ toS s
201201
202202
203−
204−
205203-------------------------------------------------------------------------------
206204-- | Log message with Builder underneath; use '<>' to concat in O(1).
207205newtype LogStr = LogStr { unLogStr :: B.Builder }
208− deriving (Generic)
206+ deriving (Generic, Show, Eq)
209207
210208instance IsString LogStr where
211− fromString = LogStr . logStrText . T.pack
209+ fromString = LogStr . B.fromString
212210
213211
214212instance Semigroup LogStr where
@@ -220,20 +218,18 @@ instance Monoid LogStr where
220218 mempty = LogStr mempty
221219
222220
223−-- instance FromJSON LogStr where
224−-- parseJSON = A.withText "LogStr" parseLogStr
225−-- where
226−-- parseLogStr = return . LogStr . B.fromText
221+instance FromJSON LogStr where
222+ parseJSON = A.withText "LogStr" parseLogStr
223+ where
224+ parseLogStr = return . LogStr . B.fromText
227225
228226-------------------------------------------------------------------------------
229227-- | Pack any string-like thing into a 'LogStr'. This will
230228-- automatically work on 'String', 'ByteString', 'Text' and any of the
231229-- lazy variants.
232230logStr :: StringConv a Text => a -> LogStr
233−logStr t = logStrText . toS
231+logStr t = LogStr (B.fromText $ toS t)
234232
235−logStrText :: Text -> LogStr
236−logStrText = LogStr . B.byteString . T.encodeUtf8
237233
238234-------------------------------------------------------------------------------
239235-- | Shorthand for 'logStr'
@@ -669,7 +665,7 @@ makeLenses ''LogEnv
669665
670666
671667-------------------------------------------------------------------------------
672−-- | Create a reasonable default InitLogEnv. Uses an 'AutoUdate' which
668+-- | Create a reasonable default InitLogEnv. Uses an 'AutoUpdate' which
673669-- updates the timer every 1ms. If you need even more timestamp
674670-- precision at the cost of performance, consider setting
675671-- '_logEnvTimer' with 'getCurrentTime'.
@@ -884,7 +880,8 @@ instance (Katip m) => Katip (ResourceT m) where
884880-- opposed to implementing 'Katip' for your monad.
885881newtype KatipT m a = KatipT { unKatipT :: ReaderT LogEnv m a }
886882 deriving ( Functor, Applicative, Monad, MonadIO
887− , MonadMask, MonadCatch, MonadThrow, MonadTrans, MonadBase b)
883+ , MonadMask, MonadCatch, MonadThrow, MonadResource, MonadTrans
884+ , MonadBase b)
888885
889886
890887instance MonadIO m => Katip (KatipT m) where
@@ -906,9 +903,14 @@ instance (MonadBaseControl b m) => MonadBaseControl b (KatipT m) where
906903 restoreM = defaultRestoreM
907904
908905instance 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
909910 askUnliftIO = KatipT $
910− withUnliftIO $ \u ->
911− pure (UnliftIO (unliftIO u . unKatipT))
911+ withUnliftIO $ \u ->
912+ pure (UnliftIO (unliftIO u . unKatipT))
913+#endif
912914
913915#if MIN_VERSION_base(4, 9, 0)
914916instance MF.MonadFail m => MF.MonadFail (KatipT m) where
@@ -946,19 +948,29 @@ logItem
946948 -> m ()
947949logItem a ns loc sev msg = do
948950 LogEnv{..} <- getLogEnv
949− liftIO $ do
950− item <- Item
951− <$> pure _logEnvApp
952− <*> pure _logEnvEnv
953− <*> pure sev
954− <*> (mkThreadIdText <$> myThreadId)
955− <*> pure _logEnvHost
956− <*> pure _logEnvPid
957− <*> pure a
958− <*> pure msg
959− <*> _logEnvTimer
960− <*> pure (_logEnvApp <> ns)
961− <*> 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 $
962974 FT.forM_ (M.elems _logEnvScribes) $ \ ScribeHandle {..} -> do
963975 whenM (scribePermitItem shScribe item) $
964976 void $ atomically (tryWriteTBQueue shChan (NewItem item))
@@ -1007,7 +1019,7 @@ logException
10071019logException a ns sev action = action `catchAny` \e -> f e >> throwM e
10081020 where
10091021 f e = logF a ns sev (msg e)
1010− msg e = ls (T.pack "An exception has occured: ") <> showLS e
1022+ msg e = ls (T.pack "An exception has occurred: ") <> showLS e
10111023
10121024
10131025-------------------------------------------------------------------------------