@@ -3,6 +3,7 @@
33{-# LANGUAGE NamedFieldPuns #-}
44{-# LANGUAGE OverloadedStrings #-}
55{-# LANGUAGE PackageImports #-}
6+{-# LANGUAGE RankNTypes #-}
67{-# LANGUAGE ScopedTypeVariables #-}
78{-# LANGUAGE TypeOperators #-}
89
@@ -12,10 +13,10 @@ module Katip.Scribes.Rollbar
1213
1314import Prelude hiding (error)
1415
15−import "base" Control.Monad (replicateM, when)
16−import "base" Data.Foldable (for_)
17−import "base" Data.Functor (void)
18−import "base" GHC.Conc (atomically)
16+import "base" Control.Monad (replicateM, when)
17+import "base" Data.Foldable (for_)
18+import "base" Data.Functor (void)
19+import "base" GHC.Conc (atomically)
1920
2021import "async" Control.Concurrent.Async (async, waitCatch)
2122import "stm-chans" Control.Concurrent.STM.TBMQueue
@@ -31,8 +32,8 @@ import "text" Data.Text.Lazy.Builder (toLazyText)
3132import "time" Data.Time.Clock (UTCTime)
3233import "katip" Katip
3334 ( LogItem
34− , Scribe(Scribe, liPush, scribeFinalizer)
35− , Severity(DebugS, ErrorS, InfoS, NoticeS, WarningS)
35+ , Scribe(..)
36+ , Severity(..)
3637 , Verbosity
3738 , getEnvironment
3839 , itemJson
@@ -44,6 +45,7 @@ import "katip" Katip
4445 , _itemSeverity
4546 , _itemTime
4647 )
48+import "katip" Katip.Core (PermitFunc)
4749import "hostname" Network.HostName (HostName)
4850import "http-client" Network.HTTP.Client (Manager)
4951import "rollbar-hs" Rollbar.AccessToken (AccessToken)
@@ -83,19 +85,19 @@ mkRollbarScribe
8385 -> Maybe Branch
8486 -> Maybe CodeVersion
8587 -> Manager -- ^ Must support TLS
86− -> Severity
88+ -> PermitFunc
8789 -> Verbosity
8890 -> IO Scribe
89−mkRollbarScribe proxy accessToken branch codeVersion manager severity verbosity = do
91+mkRollbarScribe proxy accessToken branch codeVersion manager scribePermitItem verbosity = do
9092 queue <- newTBMQueueIO queueSize
9193 workers <- replicateM workerSize (async $ mkWorker proxy manager queue)
92− let liPush item = when (permitItem severity item) $
94+ let liPush item =
9395 atomically (writeTBMQueue queue $ rollbarItem' item)
9496 rollbarItem' item = rollbarItem proxy accessToken branch codeVersion verbosity item
9597 scribeFinalizer = do
9698 atomically (closeTBMQueue queue)
9799 for_ workers waitCatch
98− pure Scribe { liPush, scribeFinalizer }
100+ pure Scribe { liPush, scribeFinalizer, scribePermitItem }
99101
100102rollbarItem ::
101103 (LogItem a, RemoveHeaders headers) =>