45b9512 · typeable/katip

git.iko.soy/typeable/katip

on master help sign in

Renames

45b9512Michael Xavier12 years ago

katip/bench/Main.hs+1−1

compare with master

unifiedsplit

@@ -60,7 +60,7 @@ data ExPayload = ExPayload

60instance ToJSON ExPayload where

61 toJSON _ = Object mempty

63−instance LogContext ExPayload where

63+instance LogItem ExPayload where

64 payloadKeys _ _ = AllKeys

katip/examples/Main.hs+12−12

@@ -21,9 +21,9 @@ import Katip.Scribes.Handle

22main :: IO ()

23main = runKatipT _ioLogEnv $ do

24− logm "example" InfoS "Easy to emit from IO directly!"

24+ logMsg "example" InfoS "Easy to emit from IO directly!"

25− logf myContext "example" InfoS "Here's a more stateful item."

25+ logF myContext "example" InfoS "Here's a more stateful item."

26− $(logt) myContext "example" InfoS "Here's one with code location."

26+ $(logT) myContext "example" InfoS "Here's one with code location."

27 runHandler handler

@@ -41,7 +41,7 @@ instance ToJSON MyContext where

42instance ToObject MyContext

44−instance LogContext MyContext where

44+instance LogItem MyContext where

45 payloadKeys _ _ = AllKeys

47-------------------------------------------------------------------------------

@@ -59,13 +59,13 @@ withDB f = f $ ConnInfo "1234" "exampledb" ()

60handler :: Handler ()

61handler = do

62− $(logtM) InfoS "got request"

62+ $(logTM) InfoS "got request"

63 withDB $ \ci -> do

64 let dbctx = DBLog (ciConnId ci)

65 let ns = Namespace ["db", ciConnDB ci]

66− runContextualLogT (return dbctx) (return ns) $ do

66+ runLogT (return dbctx) (return ns) $ do

67 liftIO $ putStrLn "DB things!"

68− $(logtM) InfoS "calling db"

68+ $(logTM) InfoS "calling db"

70-------------------------------------------------------------------------------

71data Request = Request {

@@ -82,7 +82,7 @@ instance ToJSON Request where

83instance ToObject Request

85−instance LogContext Request where

85+instance LogItem Request where

86 payloadKeys V3 _ = AllKeys

87 payloadKeys _ _ = SomeKeys ["method", "path"]

@@ -97,9 +97,9 @@ newtype WebT m a = WebT {

97 , Katip

98 )

100−instance Monad m => ContextualLog (WebT m) where

100+instance Katip m => KatipContext (WebT m) where

101− getLogContexts = liftM liftPayload ask

101+ getKatipContext = liftM liftPayload ask

102− getNamespace = return $ Namespace ["myApp"]

102+ getKatipNamespace = return $ Namespace ["myApp"]

103

104

105-------------------------------------------------------------------------------

@@ -118,5 +118,5 @@ instance ToJSON DBLog where

118

119instance ToObject DBLog

120

121−instance LogContext DBLog where

121+instance LogItem DBLog where

122 payloadKeys _ _ = AllKeys

katip/src/Katip.hs+11−11

@@ -9,11 +9,11 @@ module Katip

9 , Severity (..), renderSeverity

10 , Verbosity (..)

11 , ToObject (..)

12− , LogContext (..)

12+ , LogItem (..)

13 , PayloadSelection (..)

14 , Scribe (..)

15 , LogEnv (..)

16− , ContextualLog(..)

16+ , KatipContext(..)

17 , AnyLogContext

18 , LogContexts, liftPayload

@@ -30,19 +30,19 @@ module Katip

30 , LogStr (..)

31 , logStr, ls, showLS

33− , logf

33+ , logF

34− , logm

34+ , logMsg

35− , logt

35+ , logT

36 , logItem

37− , logfM

37+ , logFM

38− , logtM

38+ , logTM

39 , logItemM

41 -- * Transformer for appending to a log context

42− , ContextualLogT

42+ , LogT

43− , runContextualLogT

43+ , runLogT

44− , BlankLogContextT

44+ , BlankLogT

45− , runBlankLogContextT

45+ , runBlankLogT

47 -- * Included Scribes

48 , mkHandleScribe

katip/src/Katip/Core.hs+17−17

@@ -129,7 +129,7 @@ logStr t = LogStr (B.fromText $ toS t)

129

130

131-------------------------------------------------------------------------------

132−-- | Shorthand for 'logm'

132+-- | Shorthand for 'logMsg'

133ls :: StringConv a Text => a -> LogStr

134ls = logStr

135

@@ -224,19 +224,19 @@ instance ToObject A.Object

224-- keys for higher levels of verbosity. Each level of verbosity

225-- automatically and recursively contains all keys from the level

226-- before it.

227−class ToObject a => LogContext a where

227+class ToObject a => LogItem a where

228

229 -- | List of keys in the JSON object that should be included in message.

230 payloadKeys :: Verbosity -> a -> PayloadSelection

231

232

233−instance LogContext () where payloadKeys _ _ = SomeKeys []

233+instance LogItem () where payloadKeys _ _ = SomeKeys []

234

235

236-------------------------------------------------------------------------------

237-- | Constrain payload based on verbosity. Backends should use this to

238-- automatically bubble higher verbosity levels to lower ones.

239−payloadObject :: LogContext a => Verbosity -> a -> A.Object

239+payloadObject :: LogItem a => Verbosity -> a -> A.Object

240payloadObject verb a = case foldMap (flip payloadKeys a) [(V0)..verb] of

241 AllKeys -> toObject a

242 SomeKeys ks -> HM.filterWithKey (\ k _ -> k `elem` ks) $ toObject a

@@ -246,7 +246,7 @@ payloadObject verb a = case foldMap (flip payloadKeys a) [(V0)..verb] of

246-- | Convert log item to its JSON representation while trimming its

247-- payload based on the desired verbosity. Backends that push JSON

248-- messages should use this to obtain their payload.

249−itemJson :: LogContext a => Verbosity -> Item a -> A.Value

249+itemJson :: LogItem a => Verbosity -> Item a -> A.Value

250itemJson verb a = toJSON $ a & itemPayload %~ payloadObject verb

251

252

@@ -254,7 +254,7 @@ itemJson verb a = toJSON $ a & itemPayload %~ payloadObject verb

254-- | Scribes are handlers of incoming items. Each registered scribe

255-- knows how to push a log item somewhere.

256data Scribe = Scribe {

257− lhPush :: forall a. LogContext a => Item a -> IO ()

257+ lhPush :: forall a. LogItem a => Item a -> IO ()

258 }

259

260

@@ -357,9 +357,9 @@ runKatipT le (KatipT f) = runReaderT f le

357

358-------------------------------------------------------------------------------

359-- | Log with everything, including a source code location. This is

360−-- very low level and you typically can use 'logt' in its place.

360+-- very low level and you typically can use 'logT' in its place.

361logItem

362− :: (Applicative m, LogContext a, Katip m)

362+ :: (Applicative m, LogItem a, Katip m)

363 => a

364 -> Namespace

365 -> Maybe Loc

@@ -385,8 +385,8 @@ logItem a ns loc sev msg = do

385

386-------------------------------------------------------------------------------

387-- | Log with full context, but without any code location.

388−logf

388+logF

389− :: (Applicative m, LogContext a, Katip m)

389+ :: (Applicative m, LogItem a, Katip m)

390 => a

391 -- ^ Contextual payload for the log

392 -> Namespace

@@ -396,18 +396,18 @@ logf

396 -> LogStr

397 -- ^ The log message

398 -> m ()

399−logf a ns sev msg = logItem a ns Nothing sev msg

399+logF a ns sev msg = logItem a ns Nothing sev msg

400

401

402-------------------------------------------------------------------------------

403-- | Log a message without any payload/context or code location.

404−logm

404+logMsg

405 :: (Applicative m, Katip m)

406 => Namespace

407 -> Severity

408 -> LogStr

409 -> m ()

410−logm ns sev msg = logf () ns sev msg

410+logMsg ns sev msg = logF () ns sev msg

411

412

413instance TH.Lift Namespace where

@@ -447,7 +447,7 @@ liftLoc (Loc a b c (d1, d2) (e1, e2)) = [|Loc

447

448-------------------------------------------------------------------------------

449-- | For use when you want to include location in your logs. This will

450−-- fill the 'Maybe Loc' gap in 'logf' of this module.

450+-- fill the 'Maybe Loc' gap in 'logF' of this module.

451getLoc :: Q Exp

452getLoc = [| $(location >>= liftLoc) |]

453

@@ -455,9 +455,9 @@ getLoc = [| $(location >>= liftLoc) |]

455-------------------------------------------------------------------------------

456-- | 'Loc'-tagged logging when using template-haskell is OK.

457--

458−-- @$(logt) obj mempty InfoS "Hello world"@

458+-- @$(logT) obj mempty InfoS "Hello world"@

459−logt :: ExpQ

459+logT :: ExpQ

460−logt = [| \ a ns sev msg -> logItem a ns (Just $(getLoc)) sev msg |]

460+logT = [| \ a ns sev msg -> logItem a ns (Just $(getLoc)) sev msg |]

461

462

463-- taken from the file-location package

katip/src/Katip/Monadic.hs+77−77

@@ -10,30 +10,30 @@

11-- | Provides support for treating payloads and namespaces as

12-- composable contexts. The common pattern would be to provide a

13−-- 'ContextualLog' instance for your base monad. When your program

13+-- 'KatipContext' instance for your base monad. When your program

14-- changes to a more detailed context, say to the database, you can

15−-- use 'ContextualLogT' to tack on a typed context and a namespace

15+-- use 'LogT' to tack on a typed context and a namespace

16-- which will be merged into the enclosing monad's context and

17-- namespace.

18module Katip.Monadic

19 (

20 -- * Monadic variants of logging functions from "Katip.Core"

21− logfM

21+ logFM

22− , logtM

22+ , logTM

23 , logItemM

25 -- * Machinery for merging typed log payloads/contexts

26− , ContextualLog(..)

26+ , KatipContext(..)

27 , AnyLogContext

28 , LogContexts

29 , liftPayload

31 -- * Transformer for appending to a log context

32− , ContextualLogT'

32+ , LogT'

33− , ContextualLogT

33+ , LogT

34− , runContextualLogT

34+ , runLogT

35− , BlankLogContextT

35+ , BlankLogT

36− , runBlankLogContextT

36+ , runBlankLogT

37 ) where

@@ -71,7 +71,7 @@ import Katip.Core

71-- | A wrapper around a log context that erases type information so

72-- that contexts from multiple layers can be combined intelligently.

73data AnyLogContext where

74− AnyLogContext :: (LogContext a) => a -> AnyLogContext

74+ AnyLogContext :: (LogItem a) => a -> AnyLogContext

77-------------------------------------------------------------------------------

@@ -85,7 +85,7 @@ instance ToJSON LogContexts where

86instance ToObject LogContexts

88−instance LogContext LogContexts where

88+instance LogItem LogContexts where

89 payloadKeys verb (LogContexts vs) = mconcat $ map payloadKeys' vs

90 where

91 -- To ensure AllKeys doesn't leak keys from other values when

@@ -98,28 +98,28 @@ instance LogContext LogContexts where

99-------------------------------------------------------------------------------

100-- | Lift a log context into the generic wrapper

101−liftPayload :: (LogContext a) => a -> LogContexts

101+liftPayload :: (LogItem a) => a -> LogContexts

102liftPayload = LogContexts . (:[]) . AnyLogContext

103

104

105-------------------------------------------------------------------------------

106-- | A monadic context that has an inherant way to get logging

107-- context and namespace. Examples include a web application monad or

108−-- database monad. Combine with 'ContextualLogT' to nest.

108+-- database monad. Combine with 'LogT' to nest.

109−class ContextualLog m where

109+class Katip m => KatipContext m where

110− getLogContexts :: m LogContexts

110+ getKatipContext :: m LogContexts

111− getNamespace :: m Namespace

111+ getKatipNamespace :: m Namespace

112

113--TODO: is this INLINABLE?

114#define TRANS(T) \

115− instance (ContextualLog m, Monad m) => ContextualLog (T m) where \

115+ instance (KatipContext m, Katip (T m)) => KatipContext (T m) where \

116− getLogContexts = lift getLogContexts; \

116+ getKatipContext = lift getKatipContext; \

117− getNamespace = lift getNamespace

117+ getKatipNamespace = lift getKatipNamespace

118

119#define TRANS_CTX(CTX, T) \

120− instance (CTX, ContextualLog m, Monad m) => ContextualLog (T m) where \

120+ instance (CTX, KatipContext m, Katip (T m)) => KatipContext (T m) where \

121− getLogContexts = lift getLogContexts; \

121+ getKatipContext = lift getKatipContext; \

122− getNamespace = lift getNamespace

122+ getKatipNamespace = lift getKatipNamespace

123

124TRANS(IdentityT)

125TRANS(MaybeT)

@@ -134,21 +134,21 @@ TRANS_CTX(Monoid w, WriterT w)

134TRANS_CTX(Monoid w, Strict.RWST r w s)

135TRANS_CTX(Monoid w, RWST r w s)

136

137−deriving instance (Monad m, ContextualLog m) => ContextualLog (KatipT m)

137+deriving instance (Monad m, KatipContext m) => KatipContext (KatipT m)

138

139-------------------------------------------------------------------------------

140-- | Log with everything, including a source code location. This is

141−-- very low level and you typically can use 'logtM' in its

141+-- very low level and you typically can use 'logTM' in its

142-- place. Automaticallysupplies payload and namespace.

143logItemM

144− :: (Applicative m, ContextualLog m, Katip m)

144+ :: (Applicative m, KatipContext m, Katip m)

145 => Maybe Loc

146 -> Severity

147 -> LogStr

148 -> m ()

149logItemM loc sev msg = do

150− ctx <- getLogContexts

150+ ctx <- getKatipContext

151− ns <- getNamespace

151+ ns <- getKatipNamespace

152 logItem ctx ns loc sev msg

153

154

@@ -156,39 +156,39 @@ logItemM loc sev msg = do

156-------------------------------------------------------------------------------

157-- | Log with full context, but without any code

158-- location. Automatically supplies payload and namespace.

159−logfM

159+logFM

160− :: (Applicative m, ContextualLog m, Katip m)

160+ :: (Applicative m, KatipContext m, Katip m)

161 => Severity

162 -- ^ Severity of the message

163 -> LogStr

164 -- ^ The log message

165 -> m ()

166−logfM sev msg = do

166+logFM sev msg = do

167− ctx <- getLogContexts

167+ ctx <- getKatipContext

168− ns <- getNamespace

168+ ns <- getKatipNamespace

169− logf ctx ns sev msg

169+ logF ctx ns sev msg

170

171

172-------------------------------------------------------------------------------

173-- | 'Loc'-tagged logging when using template-haskell is OK. Automatically supplies payload and namespace.

174--

175-- @$(logt) InfoS "Hello world"@

176−logtM :: ExpQ

176+logTM :: ExpQ

177−logtM = [| logItemM (Just $(getLoc)) |]

177+logTM = [| logItemM (Just $(getLoc)) |]

178

179

180-------------------------------------------------------------------------------

181-- | Wrapper over 'ReaderT' that provides a passthrough instance for

182-- 'MonadReader' so your stack will not be affected. Also provides a

183−-- 'ContextualLog' instance which combines with the inner monad's

183+-- 'KatipContext' instance which combines with the inner monad's

184-- instance.

185--

186-- @

187−-- instance ContextualLog m WebMonad where

187+-- instance KatipContext m WebMonad where

188−-- getLogContexts = ...

188+-- getKatipContext = ...

189−-- getNamespace = Namespace ["web"]

189+-- getKatipNamespace = Namespace ["web"]

190--

191−-- dbCallInWeb = runContextualLogT getDBContext (Namespace ["db"]) $ do

191+-- dbCallInWeb = runLogT getDBContext (Namespace ["db"]) $ do

192-- someStuff

193-- @

194--

@@ -196,10 +196,10 @@ logtM = [| logItemM (Just $(getLoc)) |]

196-- the (optionally) monadic log context for the db, combine it with

197-- the web server's and will use the namespace @Namespace ["web","db"]@.

198--

199−-- 'ContextualLogT' is exported which fixes @n ~ m@. The two type

199+-- 'LogT' is exported which fixes @n ~ m@. The two type

200-- variables must be present for defining a 'MonadTransControl' instance.

201−newtype ContextualLogT' n m a = ContextualLogT {

201+newtype LogT' n m a = LogT {

202− unContextualLogT :: ReaderT (n LogContexts, n Namespace) m a

202+ unLogT :: ReaderT (n LogContexts, n Namespace) m a

203 } deriving ( Functor

204 , Applicative

205 , Monad

@@ -216,53 +216,53 @@ newtype ContextualLogT' n m a = ContextualLogT {

216 , Katip

217 )

218

219−type ContextualLogT m a = ContextualLogT' m m a

219+type LogT m a = LogT' m m a

220

221−instance MonadTrans (ContextualLogT' n) where

221+instance MonadTrans (LogT' n) where

222− lift = ContextualLogT . lift

222+ lift = LogT . lift

223

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

225−instance (MonadReader r m) => MonadReader r (ContextualLogT' n m) where

225+instance (MonadReader r m) => MonadReader r (LogT' n m) where

226 ask = lift ask

227− local f (ContextualLogT (ReaderT m)) = ContextualLogT $ ReaderT $ \r ->

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

228 local f (m r)

229

230−instance MonadTransControl (ContextualLogT' n) where

230+instance MonadTransControl (LogT' n) where

231− type StT (ContextualLogT' n) a = StT (ReaderT (n LogContexts)) a

231+ type StT (LogT' n) a = StT (ReaderT (n LogContexts)) a

232− liftWith = defaultLiftWith ContextualLogT unContextualLogT

232+ liftWith = defaultLiftWith LogT unLogT

233− restoreT = defaultRestoreT ContextualLogT

233+ restoreT = defaultRestoreT LogT

234 {-# INLINE liftWith #-}

235 {-# INLINE restoreT #-}

236

237−instance (MonadBaseControl b m) => MonadBaseControl b (ContextualLogT' n m) where

237+instance (MonadBaseControl b m) => MonadBaseControl b (LogT' n m) where

238− type StM ((ContextualLogT' n) m) a = ComposeSt (ContextualLogT' n) m a

238+ type StM ((LogT' n) m) a = ComposeSt (LogT' n) m a

239 liftBaseWith = defaultLiftBaseWith

240 restoreM = defaultRestoreM

241

242−instance (ContextualLog m, Monad m) => ContextualLog (ContextualLogT' m m) where

242+instance (KatipContext m, Monad m) => KatipContext (LogT' m m) where

243− getLogContexts = ContextualLogT $ ReaderT $ \(gctxs, _) -> do

243+ getKatipContext = LogT $ ReaderT $ \(gctxs, _) -> do

244 ctxs <- gctxs

245− ctxs' <- getLogContexts

245+ ctxs' <- getKatipContext

246 return $ ctxs <> ctxs'

247− getNamespace = ContextualLogT $ ReaderT $ \(_, getNsInner) -> do

247+ getKatipNamespace = LogT $ ReaderT $ \(_, getNsInner) -> do

248− nsOuter <- getNamespace

248+ nsOuter <- getKatipNamespace

249 nsInner <- getNsInner

250 return $ nsOuter <> nsInner

251

252−runContextualLogT

252+runLogT

253− :: (Functor m, LogContext a)

253+ :: (Functor m, LogItem a)

254 => m a

255 -> m Namespace

256− -> ContextualLogT m b

256+ -> LogT m b

257 -> m b

258−runContextualLogT lgtr nsgtr m = runReaderT (unContextualLogT m) (liftPayload <$> lgtr, nsgtr)

258+runLogT lgtr nsgtr m = runReaderT (unLogT m) (liftPayload <$> lgtr, nsgtr)

259

260

261-------------------------------------------------------------------------------

262-- | Type analogous to IdentityT that provides an empty log

263-- context. Use this if your root monad doesn't have a LogContext instance.

264−newtype BlankLogContextT m a = BlankLogContextT {

264+newtype BlankLogT m a = BlankLogT {

265− runBlankLogContextT :: m a

265+ runBlankLogT :: m a

266 } deriving ( Functor

267 , Applicative

268 , Monad

@@ -280,21 +280,21 @@ newtype BlankLogContextT m a = BlankLogContextT {

280 , Katip

281 )

282

283−instance Monad m => ContextualLog (BlankLogContextT m) where

283+instance Katip m => KatipContext (BlankLogT m) where

284− getLogContexts = return mempty

284+ getKatipContext = return mempty

285− getNamespace = return mempty

285+ getKatipNamespace = return mempty

286

287−instance MonadTrans BlankLogContextT where

287+instance MonadTrans BlankLogT where

288− lift = BlankLogContextT

288+ lift = BlankLogT

289

290−instance MonadTransControl BlankLogContextT where

290+instance MonadTransControl BlankLogT where

291− type StT BlankLogContextT a = a

291+ type StT BlankLogT a = a

292− liftWith f = BlankLogContextT $ f runBlankLogContextT

292+ liftWith f = BlankLogT $ f runBlankLogT

293− restoreT = BlankLogContextT

293+ restoreT = BlankLogT

294 {-# INLINABLE liftWith #-}

295 {-# INLINABLE restoreT #-}

296

297−instance (MonadBaseControl b m) => MonadBaseControl b (BlankLogContextT m) where

297+instance (MonadBaseControl b m) => MonadBaseControl b (BlankLogT m) where

298− type StM (BlankLogContextT m) a = ComposeSt BlankLogContextT m a

298+ type StM (BlankLogT m) a = ComposeSt BlankLogT m a

299 liftBaseWith = defaultLiftBaseWith

300 restoreM = defaultRestoreM

katip/src/Katip/Scribes/Handle.hs+2−2

@@ -25,7 +25,7 @@ brackets m = fromText "[" <> m <> fromText "]"

27-------------------------------------------------------------------------------

28−getKeys :: LogContext s => Verbosity -> s -> [Builder]

28+getKeys :: LogItem s => Verbosity -> s -> [Builder]

29getKeys verb a = payloadObject verb a ^..

30 to HM.toList . traverse . to rendPair

31 where

@@ -61,7 +61,7 @@ mkHandleScribe cs h sev verb = do

63-------------------------------------------------------------------------------

64−formatItem :: LogContext a => Bool -> Verbosity -> Item a -> Builder

64+formatItem :: LogItem a => Bool -> Verbosity -> Item a -> Builder

65formatItem withColor verb Item{..} =

66 brackets nowStr <>

67 brackets (mconcat $ map fromText $ intercalateNs _itemNamespace) <>