-- | Dummy «transports» for debugging purposes.

module System.Log.Raven.Transport.Debug
    ( dumpRecord, briefRecord, catchRecord
    ) where

import Control.Concurrent.MVar (MVar, putMVar)

import System.Log.Raven.Types

-- | Dump all glory details.
dumpRecord :: SentrySettings -> SentryRecord -> IO ()
dumpRecord :: SentrySettings -> SentryRecord -> IO ()
dumpRecord SentrySettings
_ SentryRecord
rec = SentryRecord -> IO ()
forall a. Show a => a -> IO ()
print SentryRecord
rec

-- | Log-like output with very few data shown.
briefRecord :: SentrySettings -> SentryRecord -> IO ()
briefRecord :: SentrySettings -> SentryRecord -> IO ()
briefRecord SentrySettings
_ SentryRecord
rec = String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ UTCTime -> String
forall a. Show a => a -> String
show (UTCTime -> String) -> UTCTime -> String
forall a b. (a -> b) -> a -> b
$ SentryRecord -> UTCTime
srTimestamp SentryRecord
rec, String
" "
                                      , SentryLevel -> String
forall a. Show a => a -> String
show (SentryLevel -> String) -> SentryLevel -> String
forall a b. (a -> b) -> a -> b
$ SentryRecord -> SentryLevel
srLevel SentryRecord
rec, String
" "
                                      , SentryRecord -> String
srLogger SentryRecord
rec, String
": "
                                      , SentryRecord -> String
srMessage SentryRecord
rec
                                      ]

-- | Catch event record into an *empty* 'MVar'.
--   Make sure you take it's contents before next message!
catchRecord :: MVar SentryRecord -> SentrySettings -> SentryRecord -> IO ()
catchRecord :: MVar SentryRecord -> SentrySettings -> SentryRecord -> IO ()
catchRecord MVar SentryRecord
var SentrySettings
_ SentryRecord
rec = MVar SentryRecord -> SentryRecord -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar SentryRecord
var SentryRecord
rec