{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
module Rollbar.Yesod
( rollbarYesodMiddleware
, rollbarYesodMiddlewareWith
) where
import qualified Network.Wai as W
import Control.Exception (Exception(..), SomeException)
import Control.Monad (unless, void)
import Rollbar.Client
import Rollbar.Wai (rollbarOnExceptionWith)
import UnliftIO.Exception (catch, throwIO)
import Yesod.Core
import Yesod.Core.Types (HandlerContents)
rollbarYesodMiddleware
:: (HasSettings m, MonadHandler m, MonadUnliftIO m)
=> m a
-> m a
rollbarYesodMiddleware :: m a -> m a
rollbarYesodMiddleware = (Settings -> Request -> SomeException -> m ()) -> m a -> m a
forall (m :: * -> *) a.
(HasSettings m, MonadHandler m, MonadUnliftIO m) =>
(Settings -> Request -> SomeException -> m ()) -> m a -> m a
rollbarYesodMiddlewareWith ((Settings -> Request -> SomeException -> m ()) -> m a -> m a)
-> (Settings -> Request -> SomeException -> m ()) -> m a -> m a
forall a b. (a -> b) -> a -> b
$ \Settings
settings Request
request SomeException
ex ->
(Item -> Rollbar ())
-> Settings -> Maybe Request -> SomeException -> m ()
forall (m :: * -> *).
MonadIO m =>
(Item -> Rollbar ())
-> Settings -> Maybe Request -> SomeException -> m ()
rollbarOnExceptionWith Item -> Rollbar ()
forall (f :: * -> *). (HasSettings f, MonadHttp f) => Item -> f ()
handler Settings
settings (Request -> Maybe Request
forall a. a -> Maybe a
Just Request
request) SomeException
ex
where
handler :: Item -> f ()
handler Item
item = f ItemId -> f ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (f ItemId -> f ()) -> f ItemId -> f ()
forall a b. (a -> b) -> a -> b
$ Item -> f ItemId
forall (m :: * -> *).
(HasSettings m, MonadHttp m) =>
Item -> m ItemId
createItem Item
item { itemFramework :: Maybe Text
itemFramework = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"yesod" }
rollbarYesodMiddlewareWith
:: (HasSettings m, MonadHandler m, MonadUnliftIO m)
=> (Settings -> W.Request -> SomeException -> m ())
-> m a
-> m a
rollbarYesodMiddlewareWith :: (Settings -> Request -> SomeException -> m ()) -> m a -> m a
rollbarYesodMiddlewareWith Settings -> Request -> SomeException -> m ()
f m a
handler = m a
handler m a -> (SomeException -> m a) -> m a
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \SomeException
ex -> do
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (SomeException -> Bool
isHandlerContents SomeException
ex) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Settings
settings <- m Settings
forall (m :: * -> *). HasSettings m => m Settings
getSettings
Request
wrequest <- m Request
forall (m :: * -> *). MonadHandler m => m Request
waiRequest
Settings -> Request -> SomeException -> m ()
f Settings
settings Request
wrequest SomeException
ex
SomeException -> m a
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO SomeException
ex
isHandlerContents :: SomeException -> Bool
isHandlerContents :: SomeException -> Bool
isHandlerContents = Bool -> (HandlerContents -> Bool) -> Maybe HandlerContents -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False HandlerContents -> Bool
handlerContents (Maybe HandlerContents -> Bool)
-> (SomeException -> Maybe HandlerContents)
-> SomeException
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> Maybe HandlerContents
forall e. Exception e => SomeException -> Maybe e
fromException
where
handlerContents :: HandlerContents -> Bool
handlerContents :: HandlerContents -> Bool
handlerContents = Bool -> HandlerContents -> Bool
forall a b. a -> b -> a
const Bool
True