{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}

-- |
-- Module: Rollbar.Yesod
-- Copyright: (c) 2020 Stack Builders Inc.
-- License: MIT
-- Maintainer: Sebastián Estrella <sestrella@stackbuilders.com>
--
-- For a fully working example check the following link:
--
-- <https://github.com/stackbuilders/rollbar-haskell/blob/master/rollbar-yesod/example/Main.hs>
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)

-- | Captures non 'HandlerContents' exceptions and send them to Rollbar via the
-- API. Under the hood, this function uses 'createItem' function from
-- rollbar-client.
--
-- __Example__
--
-- > instance Yesod App where
-- >   yesodMiddleware = rollbarYesodMiddleware . defaultYesodMiddleware
--
-- @since 0.1.0
rollbarYesodMiddleware
  :: (HasSettings m, MonadHandler m, MonadUnliftIO m)
  => m a
  -> m a
rollbarYesodMiddleware :: forall (m :: * -> *) a.
(HasSettings m, MonadHandler m, MonadUnliftIO m) =>
m a -> m a
rollbarYesodMiddleware = forall (m :: * -> *) a.
(HasSettings m, MonadHandler m, MonadUnliftIO m) =>
(Settings -> Request -> SomeException -> m ()) -> m a -> m a
rollbarYesodMiddlewareWith forall a b. (a -> b) -> a -> b
$ \Settings
settings Request
request SomeException
ex ->
  forall (m :: * -> *).
MonadIO m =>
(Item -> Rollbar ())
-> Settings -> Maybe Request -> SomeException -> m ()
rollbarOnExceptionWith forall {f :: * -> *}. (HasSettings f, MonadHttp f) => Item -> f ()
handler Settings
settings (forall a. a -> Maybe a
Just Request
request) SomeException
ex
  where
    handler :: Item -> f ()
handler Item
item = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
(HasSettings m, MonadHttp m) =>
Item -> m ItemId
createItem Item
item { itemFramework :: Maybe Text
itemFramework = forall a. a -> Maybe a
Just Text
"yesod" }

-- | Similar to 'rollbarYesodMiddleware', but it allows customize the function
-- used to send the 'SomeException' captured from a handler to Rollbar.
--
-- @since 0.1.0
rollbarYesodMiddlewareWith
  :: (HasSettings m, MonadHandler m, MonadUnliftIO m)
  => (Settings -> W.Request -> SomeException -> m ())
  -> m a
  -> m a
rollbarYesodMiddlewareWith :: forall (m :: * -> *) a.
(HasSettings m, MonadHandler m, MonadUnliftIO m) =>
(Settings -> Request -> SomeException -> m ()) -> m a -> m a
rollbarYesodMiddlewareWith Settings -> Request -> SomeException -> m ()
f m a
handler = m a
handler forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \SomeException
ex -> do
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (SomeException -> Bool
isHandlerContents SomeException
ex) forall a b. (a -> b) -> a -> b
$ do
    Settings
settings <- forall (m :: * -> *). HasSettings m => m Settings
getSettings
    Request
wrequest <- forall (m :: * -> *). MonadHandler m => m Request
waiRequest
    Settings -> Request -> SomeException -> m ()
f Settings
settings Request
wrequest SomeException
ex

  forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO SomeException
ex

isHandlerContents :: SomeException -> Bool
isHandlerContents :: SomeException -> Bool
isHandlerContents = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False HandlerContents -> Bool
handlerContents forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. Exception e => SomeException -> Maybe e
fromException
  where
    handlerContents :: HandlerContents -> Bool
    handlerContents :: HandlerContents -> Bool
handlerContents = forall a b. a -> b -> a
const Bool
True