393ee82 · typeable/katip

git.iko.soy/typeable/katip

Bring back more limited LogT

This is different than the previous incarnation because: * It doesn't take monadic versions of the context/namespace getters and thus sheds a lot of tricky instances. * Does not do any sort of combining logic. * Does not have to be ordered with BlankLogT as some sort of weird type-level list of contexts. The main point of LogT now is for when you need to pull out your katip context at a point in time and rebuild a shorter transformer stack to run right over IO. A good example is if you're writing a library that has to do something in IO (such as another thread, in an Async, etc.) You want to pull out your log context and use it in IO without having to roll your own transformer with Katip/KatipContext. For *applications* it is still preferable to use a Reader-based approach where adding namespaces and contexts is as simple as a call to `local`.

commit393ee82d798f2fc0ad7dc110af4571d67ca7f749 authorMichael Xavier <michael@michaelxavier.net> dateTue 1 Mar 2016, 16:04 (11 years ago) parenta8f098b

2 files changed+83−6

compare with master

unifiedsplit

katip/src/Katip.hs+4 katip/src/Katip/Monadic.hs+79−6

katip/src/Katip.hs+4

@@ -66,6 +66,10 @@ module Katip

6666 -- * Included Scribes

6767 , mkHandleScribe

6868 , ColorStrategy (..)

69+

70+ -- * LogT - Utility transformer that provides Katip and KatipContext instances

71+ , LogT

72+ , runLogT

6973 ) where

7074

7175-------------------------------------------------------------------------------

katip/src/Katip/Monadic.hs+79−6

@@ -28,28 +28,36 @@ module Katip.Monadic

2828 , AnyLogContext

2929 , LogContexts

3030 , liftPayload

31+

32+ -- * LogT - Utility transformer that provides Katip and KatipContext instances

33+ , LogT(..)

34+ , runLogT

35+ , LogTState(..)

3136 ) where

3237

3338

3439-------------------------------------------------------------------------------

40+import Control.Applicative

41+import Control.Monad.Base

3542import Control.Monad.Catch

36−import Control.Monad.Trans.Class

43+import Control.Monad.Error.Class

44+import Control.Monad.IO.Class

45+import Control.Monad.Reader

46+import Control.Monad.State

3747import Control.Monad.Trans.Either (EitherT)

3848import Control.Monad.Trans.Except (ExceptT)

3949import Control.Monad.Trans.Identity (IdentityT)

4050import Control.Monad.Trans.List (ListT)

4151import Control.Monad.Trans.Maybe (MaybeT)

42−import Control.Monad.Trans.Reader (ReaderT)

4352import Control.Monad.Trans.Resource (ResourceT)

4453import Control.Monad.Trans.RWS (RWST)

4554import qualified Control.Monad.Trans.RWS.Strict as Strict (RWST)

46−import Control.Monad.Trans.State (StateT)

4755import qualified Control.Monad.Trans.State.Strict as Strict (StateT)

48−import Control.Monad.Trans.Writer (WriterT)

4956import qualified Control.Monad.Trans.Writer.Strict as Strict (WriterT)

57+import Control.Monad.Writer

5058import Data.Aeson

5159import qualified Data.HashMap.Strict as HM

52−import Data.Monoid

60+import Data.Monoid as M

5361import Data.Text (Text)

5462import Language.Haskell.TH

5563-------------------------------------------------------------------------------

@@ -179,4 +187,69 @@ logExceptionM

179187logExceptionM action sev = action `catchAll` \e -> f e >> throwM e

180188 where

181189 f e = logFM sev (msg e)

182− msg e = ls ("An exception has occured: " :: Text) <> showLS e

190+ msg e = ls ("An exception has occured: " :: Text) M.<> showLS e

191+

192+

193+-------------------------------------------------------------------------------

194+-- | Provides a simple transformer that defines a 'KatipContext'

195+-- instance for a fixed namespace and context. You will typically only

196+-- use this if you are forced to run in IO but still want to have your

197+-- log context. This is the slightly more powerful version of KatipT

198+-- in that it provides KatipContext instead of just Katip. For instance:

199+--

200+-- @

201+-- threadWithLogging = do

202+-- le <- getLogEnv

203+-- ctx <- getKatipContext

204+-- ns <- getKatipNamespace

205+-- forkIO $ runLogT le ctx ns $ do

206+-- $(logTM) InfoS "Look, I can log in IO and retain context!"

207+-- doOtherStuff

208+-- @

209+newtype LogT m a = LogT {

210+ unLogT :: ReaderT LogTState m a

211+ } deriving ( Functor

212+ , Applicative

213+ , Monad

214+ , MonadIO

215+ , MonadThrow

216+ , MonadCatch

217+ , MonadMask

218+ , MonadBase b

219+ , MonadState s

220+ , MonadWriter w

221+ , MonadError e

222+ , MonadPlus

223+ , Alternative

224+ , MonadFix

225+ , MonadTrans

226+ )

227+

228+

229+data LogTState = LogTState {

230+ ltsLogEnv :: !LogEnv

231+ , ltsContext :: !LogContexts

232+ , ltsNamespace :: !Namespace

233+ }

234+

235+-- Reader is a passthrough. We don't expose our internal reader so as not to conflict

236+instance (MonadReader r m) => MonadReader r (LogT m) where

237+ ask = lift ask

238+ local f (LogT (ReaderT m)) = LogT $ ReaderT $ \r ->

239+ local f (m r)

240+

241+

242+instance (MonadIO m) => Katip (LogT m) where

243+ getLogEnv = LogT $ ReaderT $ \lts -> return (ltsLogEnv lts)

244+

245+

246+instance (MonadIO m) => KatipContext (LogT m) where

247+ getKatipContext = LogT $ ReaderT $ \lts -> return (ltsContext lts)

248+ getKatipNamespace = LogT $ ReaderT $ \lts -> return (ltsNamespace lts)

249+

250+

251+-------------------------------------------------------------------------------

252+runLogT :: (LogItem c) => LogEnv -> c -> Namespace -> LogT m a -> m a

253+runLogT le ctx ns = flip runReaderT lts . unLogT

254+ where

255+ lts = LogTState le (liftPayload ctx) ns