@@ -31,6 +31,7 @@ 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
3435#if MIN_VERSION_base(4, 9, 0)
3536import qualified Control.Monad.Fail as MF
3637#endif
@@ -44,8 +45,7 @@ import Control.Monad.Trans.Either
4445import Control.Monad.Trans.Except
4546import Control.Monad.Trans.Maybe
4647import Control.Monad.Trans.Reader
47−import Control.Monad.Trans.Resource (MonadResource, ResourceT,
48− transResourceT)
48+import Control.Monad.Trans.Resource (ResourceT, 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,6 +56,7 @@ 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
5960import Data.Foldable as FT
6061import qualified Data.HashMap.Strict as HM
6162import Data.List
@@ -66,7 +67,6 @@ import Data.String
6667import Data.String.Conv
6768import Data.Text (Text)
6869import 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,13 +200,15 @@ instance FromJSON Verbosity where
200200 _ -> fail $ "Invalid Verbosity " ++ toS s
201201
202202
203+
204+
203205-------------------------------------------------------------------------------
204206-- | Log message with Builder underneath; use '<>' to concat in O(1).
205207newtype LogStr = LogStr { unLogStr :: B.Builder }
206− deriving (Generic, Show, Eq)
208+ deriving (Generic)
207209
208210instance IsString LogStr where
209− fromString = LogStr . B.fromString
211+ fromString = LogStr . logStrText . T.pack
210212
211213
212214instance Semigroup LogStr where
@@ -218,18 +220,20 @@ instance Monoid LogStr where
218220 mempty = LogStr mempty
219221
220222
221−instance FromJSON LogStr where
222− parseJSON = A.withText "LogStr" parseLogStr
223− where
224− parseLogStr = return . LogStr . B.fromText
223+-- instance FromJSON LogStr where
224+-- parseJSON = A.withText "LogStr" parseLogStr
225+-- where
226+-- parseLogStr = return . LogStr . B.fromText
225227
226228-------------------------------------------------------------------------------
227229-- | Pack any string-like thing into a 'LogStr'. This will
228230-- automatically work on 'String', 'ByteString', 'Text' and any of the
229231-- lazy variants.
230232logStr :: StringConv a Text => a -> LogStr
231−logStr t = LogStr (B.fromText $ toS t)
233+logStr t = logStrText . toS
232234
235+logStrText :: Text -> LogStr
236+logStrText = LogStr . B.byteString . T.encodeUtf8
233237
234238-------------------------------------------------------------------------------
235239-- | Shorthand for 'logStr'
@@ -665,7 +669,7 @@ makeLenses ''LogEnv
665669
666670
667671-------------------------------------------------------------------------------
668−-- | Create a reasonable default InitLogEnv. Uses an 'AutoUpdate' which
672+-- | Create a reasonable default InitLogEnv. Uses an 'AutoUdate' which
669673-- updates the timer every 1ms. If you need even more timestamp
670674-- precision at the cost of performance, consider setting
671675-- '_logEnvTimer' with 'getCurrentTime'.
@@ -880,8 +884,7 @@ instance (Katip m) => Katip (ResourceT m) where
880884-- opposed to implementing 'Katip' for your monad.
881885newtype KatipT m a = KatipT { unKatipT :: ReaderT LogEnv m a }
882886 deriving ( Functor, Applicative, Monad, MonadIO
883− , MonadMask, MonadCatch, MonadThrow, MonadResource, MonadTrans
884− , MonadBase b)
887+ , MonadMask, MonadCatch, MonadThrow, MonadTrans, MonadBase b)
885888
886889
887890instance MonadIO m => Katip (KatipT m) where
@@ -903,14 +906,9 @@ instance (MonadBaseControl b m) => MonadBaseControl b (KatipT m) where
903906 restoreM = defaultRestoreM
904907
905908instance 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
910909 askUnliftIO = KatipT $
911− withUnliftIO $ \u ->
912− pure (UnliftIO (unliftIO u . unKatipT))
913−#endif
910+ withUnliftIO $ \u ->
911+ pure (UnliftIO (unliftIO u . unKatipT))
914912
915913#if MIN_VERSION_base(4, 9, 0)
916914instance MF.MonadFail m => MF.MonadFail (KatipT m) where
@@ -948,29 +946,19 @@ logItem
948946 -> m ()
949947logItem a ns loc sev msg = do
950948 LogEnv{..} <- getLogEnv
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 $
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
974962 FT.forM_ (M.elems _logEnvScribes) $ \ ScribeHandle {..} -> do
975963 whenM (scribePermitItem shScribe item) $
976964 void $ atomically (tryWriteTBQueue shChan (NewItem item))
@@ -1019,7 +1007,7 @@ logException
10191007logException a ns sev action = action `catchAny` \e -> f e >> throwM e
10201008 where
10211009 f e = logF a ns sev (msg e)
1022− msg e = ls (T.pack "An exception has occurred: ") <> showLS e
1010+ msg e = ls (T.pack "An exception has occured: ") <> showLS e
10231011
10241012
10251013-------------------------------------------------------------------------------