module Katip.Scribes.Raven
( mkRavenScribe
) where
import qualified Data.Aeson as Aeson
import Data.String.Conv (toS)
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Builder as Builder
import qualified Data.HashMap.Strict as HM
import qualified Katip
import qualified Katip.Core
import qualified System.Log.Raven as Raven
import qualified System.Log.Raven.Types as Raven
import Data.Aeson.KeyMap (fromHashMapText, toHashMapText)
mkRavenScribe :: Raven.SentryService -> Katip.PermitFunc -> Katip.Verbosity -> IO Katip.Scribe
mkRavenScribe :: SentryService -> PermitFunc -> Verbosity -> IO Scribe
mkRavenScribe SentryService
sentryService PermitFunc
permitItem Verbosity
verbosity = Scribe -> IO Scribe
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Scribe -> IO Scribe) -> Scribe -> IO Scribe
forall a b. (a -> b) -> a -> b
$
Katip.Scribe
{ liPush :: forall a. LogItem a => Item a -> IO ()
Katip.liPush = Item a -> IO ()
forall a. LogItem a => Item a -> IO ()
push
, scribeFinalizer :: IO ()
Katip.scribeFinalizer = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
, scribePermitItem :: PermitFunc
Katip.scribePermitItem = Item a -> IO Bool
PermitFunc
permitItem
}
where
push :: Katip.LogItem a => Katip.Item a -> IO ()
push :: forall a. LogItem a => Item a -> IO ()
push Item a
item = SentryService
-> String
-> SentryLevel
-> String
-> (SentryRecord -> SentryRecord)
-> IO ()
Raven.register SentryService
sentryService (Text -> String
forall a b. StringConv a b => a -> b
toS Text
name) SentryLevel
level String
msg SentryRecord -> SentryRecord
updateRecord
where
name :: Text
name = Namespace -> Text
sentryName (Namespace -> Text) -> Namespace -> Text
forall a b. (a -> b) -> a -> b
$ Item a -> Namespace
forall a. Item a -> Namespace
Katip._itemNamespace Item a
item
level :: SentryLevel
level = Severity -> SentryLevel
sentryLevel (Severity -> SentryLevel) -> Severity -> SentryLevel
forall a b. (a -> b) -> a -> b
$ Item a -> Severity
forall a. Item a -> Severity
Katip._itemSeverity Item a
item
msg :: String
msg = Text -> String
TL.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Builder -> Text
Builder.toLazyText (Builder -> Text) -> Builder -> Text
forall a b. (a -> b) -> a -> b
$ LogStr -> Builder
Katip.Core.unLogStr (LogStr -> Builder) -> LogStr -> Builder
forall a b. (a -> b) -> a -> b
$ Item a -> LogStr
forall a. Item a -> LogStr
Katip._itemMessage Item a
item
katipAttrs :: HashMap Text Value
katipAttrs =
(Loc -> HashMap Text Value) -> Maybe Loc -> HashMap Text Value
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\Loc
loc -> Text -> Value -> HashMap Text Value
forall k v. Hashable k => k -> v -> HashMap k v
HM.singleton Text
"loc" (Value -> HashMap Text Value) -> Value -> HashMap Text Value
forall a b. (a -> b) -> a -> b
$ LocJs -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON (LocJs -> Value) -> LocJs -> Value
forall a b. (a -> b) -> a -> b
$ Loc -> LocJs
Katip.Core.LocJs Loc
loc) (Item a -> Maybe Loc
forall a. Item a -> Maybe Loc
Katip._itemLoc Item a
item)
updateRecord :: SentryRecord -> SentryRecord
updateRecord SentryRecord
record = SentryRecord
record
{ Raven.srEnvironment = Just $ toS $ Katip.getEnvironment $ Katip._itemEnv item
, Raven.srTimestamp = Katip._itemTime item
, Raven.srExtra = convertExtra $ toHashMapText $ Katip.payloadObject verbosity (Katip._itemPayload item) <> fromHashMapText katipAttrs
}
convertExtra :: HM.HashMap T.Text Aeson.Value -> HM.HashMap String Aeson.Value
convertExtra :: HashMap Text Value -> HashMap String Value
convertExtra = [(String, Value)] -> HashMap String Value
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList ([(String, Value)] -> HashMap String Value)
-> (HashMap Text Value -> [(String, Value)])
-> HashMap Text Value
-> HashMap String Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Value) -> (String, Value))
-> [(Text, Value)] -> [(String, Value)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Text
k,Value
v) -> (Text -> String
T.unpack Text
k, Value
v)) ([(Text, Value)] -> [(String, Value)])
-> (HashMap Text Value -> [(Text, Value)])
-> HashMap Text Value
-> [(String, Value)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap Text Value -> [(Text, Value)]
forall k v. HashMap k v -> [(k, v)]
HM.toList
sentryLevel :: Katip.Severity -> Raven.SentryLevel
sentryLevel :: Severity -> SentryLevel
sentryLevel Severity
Katip.DebugS = SentryLevel
Raven.Debug
sentryLevel Severity
Katip.InfoS = SentryLevel
Raven.Info
sentryLevel Severity
Katip.NoticeS = String -> SentryLevel
Raven.Custom String
"Notice"
sentryLevel Severity
Katip.WarningS = SentryLevel
Raven.Warning
sentryLevel Severity
Katip.ErrorS = SentryLevel
Raven.Error
sentryLevel Severity
Katip.CriticalS = SentryLevel
Raven.Fatal
sentryLevel Severity
Katip.AlertS = SentryLevel
Raven.Fatal
sentryLevel Severity
Katip.EmergencyS = SentryLevel
Raven.Fatal
sentryName :: Katip.Namespace -> T.Text
sentryName :: Namespace -> Text
sentryName (Katip.Namespace [Text]
xs) = Text -> [Text] -> Text
T.intercalate Text
"." [Text]
xs