module System.Log.Raven
(
initRaven, disabledRaven
, register
, stderrFallback, errorFallback, silentFallback
, culprit, tags, extra
, record, recordLBS
) where
import Data.Aeson (encode)
import Data.ByteString.Lazy (ByteString)
import Data.UUID (UUID)
import System.Random (randomIO)
import Data.Time.Clock (getCurrentTime)
import Data.Time.Format (formatTime, defaultTimeLocale)
import System.IO (stderr, hPutStrLn)
import qualified Control.Exception as E
import qualified Data.HashMap.Strict as HM
import System.Log.Raven.Types
initRaven :: String
-> (SentryRecord -> SentryRecord)
-> (SentrySettings -> SentryRecord -> IO ())
-> (SentryRecord -> IO ())
-> IO SentryService
initRaven dsn d t fb = return
SentryService { serviceSettings = fromDSN dsn
, serviceDefaults = d
, serviceTransport = t
, serviceFallback = fb
}
disabledRaven :: IO SentryService
disabledRaven = initRaven "" id undefined undefined
register :: SentryService
-> String
-> SentryLevel
-> String
-> (SentryRecord -> SentryRecord)
-> IO ()
register s loggerName level message upd = do
rec <- record loggerName level message (upd . serviceDefaults s)
let transport = serviceTransport s
case serviceSettings s of
SentryDisabled -> return ()
settings -> E.catch (transport settings rec)
(\(E.SomeException _) -> serviceFallback s $ rec)
stderrFallback :: SentryRecord -> IO ()
stderrFallback rec =
hPutStrLn stderr $ concat
[ srTimestamp rec, " "
, show $ srLevel rec, " "
, srLogger rec, ": "
, srMessage rec
]
errorFallback :: SentryRecord -> IO ()
errorFallback rec = error $ "Error sending record: " ++ show rec
silentFallback :: SentryRecord -> IO ()
silentFallback _ = return ()
record :: String
-> SentryLevel
-> String
-> (SentryRecord -> SentryRecord)
-> IO SentryRecord
record logger lvl msg upd = do
eid <- (filter (/= '-') . show) `fmap` (randomIO :: IO UUID)
ts <- formatTime defaultTimeLocale "%Y-%m-%dT%H:%M:%S%Q" `fmap` getCurrentTime
return $! upd (newRecord eid msg ts lvl logger)
recordLBS :: SentryRecord -> ByteString
recordLBS = encode
culprit :: String -> SentryRecord -> SentryRecord
culprit c r = r { srCulprit = Just c }
tags :: [(String, String)] -> SentryRecord -> SentryRecord
tags ts r = r { srTags = HM.fromList ts `HM.union` srTags r }
extra :: [(String, String)] -> SentryRecord -> SentryRecord
extra ts r = r { srExtra = HM.fromList ts `HM.union` srExtra r }