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
            -- add katip context as raven extras
            , 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