-- | Some useful functions if you want to wrap the 'ServerPartT' monad transformer around the 'ErrorT' monad transformer. e.g., @'ServerPartT' ('ErrorT' e m) a@. This allows you to use 'throwError' and 'catchError' inside your monad.  
module Happstack.Server.Error where

import Control.Monad.Error              (Error, ErrorT(runErrorT))
import Happstack.Server.Monads          (ServerPartT)
import Happstack.Server.Internal.Monads (WebT, UnWebT, withRequest, mkWebT, runServerPartT, ununWebT)
import Happstack.Server.Response        (ok, toResponse)
import Happstack.Server.Types           (Request, Response)

--------------------------------------------------------------
-- Error Handling
--------------------------------------------------------------

-- | Flatten @'ServerPartT' ('ErrorT' e m) a@ into a @'ServerPartT' m
-- a@ so that it can be use with 'simpleHTTP'.  Used with
-- 'mapServerPartT'', e.g.,
--
-- > simpleHTTP conf $ mapServerPartT' (spUnWrapErrorT simpleErrorHandler)  $ myPart `catchError` errorPart
--
-- Note that in this example, @simpleErrorHandler@ will only be run if @errorPart@ throws an error. You can replace @simpleErrorHandler@ with your own custom error handler.
--
-- see also: 'simpleErrorHandler'
spUnwrapErrorT:: Monad m => (e -> ServerPartT m a)
              -> Request
              -> UnWebT (ErrorT e m) a
              -> UnWebT m a
spUnwrapErrorT :: (e -> ServerPartT m a)
-> Request -> UnWebT (ErrorT e m) a -> UnWebT m a
spUnwrapErrorT e -> ServerPartT m a
handler Request
rq = \UnWebT (ErrorT e m) a
x -> do
    Either e (Maybe (Either Response a, FilterFun Response))
err <- UnWebT (ErrorT e m) a
-> m (Either e (Maybe (Either Response a, FilterFun Response)))
forall e (m :: * -> *) a. ErrorT e m a -> m (Either e a)
runErrorT UnWebT (ErrorT e m) a
x
    case Either e (Maybe (Either Response a, FilterFun Response))
err of
        Left e
e -> WebT m a -> UnWebT m a
forall (m :: * -> *) a. WebT m a -> UnWebT m a
ununWebT (WebT m a -> UnWebT m a) -> WebT m a -> UnWebT m a
forall a b. (a -> b) -> a -> b
$ ServerPartT m a -> Request -> WebT m a
forall (m :: * -> *) a. ServerPartT m a -> Request -> WebT m a
runServerPartT (e -> ServerPartT m a
handler e
e) Request
rq
        Right Maybe (Either Response a, FilterFun Response)
a -> Maybe (Either Response a, FilterFun Response) -> UnWebT m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Either Response a, FilterFun Response)
a

-- | A simple error handler which can be used with 'spUnwrapErrorT'.
-- 
-- It returns the error message as a plain text message to the
-- browser. More sophisticated behaviour can be achieved by calling
-- your own custom error handler instead.
--
-- see also: 'spUnwrapErrorT'
simpleErrorHandler :: (Monad m) => String -> ServerPartT m Response
simpleErrorHandler :: String -> ServerPartT m Response
simpleErrorHandler String
err = Response -> ServerPartT m Response
forall (m :: * -> *) a. FilterMonad Response m => a -> m a
ok (Response -> ServerPartT m Response)
-> Response -> ServerPartT m Response
forall a b. (a -> b) -> a -> b
$ String -> Response
forall a. ToMessage a => a -> Response
toResponse (String -> Response) -> String -> Response
forall a b. (a -> b) -> a -> b
$ (String
"An error occured: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err)

-- | This 'ServerPart' modifier enables the use of 'throwError' and
-- 'catchError' inside the 'WebT' actions, by adding the 'ErrorT'
-- monad transformer to the stack.
--
-- You can wrap the complete second argument to 'simpleHTTP' in this
-- function.
--
-- DEPRECATED: use 'spUnwrapErrorT' instead.
errorHandlerSP :: (Monad m, Error e) => (Request -> e -> WebT m a) -> ServerPartT (ErrorT e m) a -> ServerPartT m a
errorHandlerSP :: (Request -> e -> WebT m a)
-> ServerPartT (ErrorT e m) a -> ServerPartT m a
errorHandlerSP Request -> e -> WebT m a
handler ServerPartT (ErrorT e m) a
sps = (Request -> WebT m a) -> ServerPartT m a
forall (m :: * -> *) a. (Request -> WebT m a) -> ServerPartT m a
withRequest ((Request -> WebT m a) -> ServerPartT m a)
-> (Request -> WebT m a) -> ServerPartT m a
forall a b. (a -> b) -> a -> b
$ \Request
req -> UnWebT m a -> WebT m a
forall (m :: * -> *) a. UnWebT m a -> WebT m a
mkWebT (UnWebT m a -> WebT m a) -> UnWebT m a -> WebT m a
forall a b. (a -> b) -> a -> b
$ do
                        Either e (Maybe (Either Response a, FilterFun Response))
eer <- ErrorT e m (Maybe (Either Response a, FilterFun Response))
-> m (Either e (Maybe (Either Response a, FilterFun Response)))
forall e (m :: * -> *) a. ErrorT e m a -> m (Either e a)
runErrorT (ErrorT e m (Maybe (Either Response a, FilterFun Response))
 -> m (Either e (Maybe (Either Response a, FilterFun Response))))
-> ErrorT e m (Maybe (Either Response a, FilterFun Response))
-> m (Either e (Maybe (Either Response a, FilterFun Response)))
forall a b. (a -> b) -> a -> b
$ WebT (ErrorT e m) a
-> ErrorT e m (Maybe (Either Response a, FilterFun Response))
forall (m :: * -> *) a. WebT m a -> UnWebT m a
ununWebT (WebT (ErrorT e m) a
 -> ErrorT e m (Maybe (Either Response a, FilterFun Response)))
-> WebT (ErrorT e m) a
-> ErrorT e m (Maybe (Either Response a, FilterFun Response))
forall a b. (a -> b) -> a -> b
$ ServerPartT (ErrorT e m) a -> Request -> WebT (ErrorT e m) a
forall (m :: * -> *) a. ServerPartT m a -> Request -> WebT m a
runServerPartT ServerPartT (ErrorT e m) a
sps Request
req
                        case Either e (Maybe (Either Response a, FilterFun Response))
eer of
                                Left e
err -> WebT m a -> UnWebT m a
forall (m :: * -> *) a. WebT m a -> UnWebT m a
ununWebT (Request -> e -> WebT m a
handler Request
req e
err)
                                Right Maybe (Either Response a, FilterFun Response)
res -> Maybe (Either Response a, FilterFun Response) -> UnWebT m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Either Response a, FilterFun Response)
res
{-# DEPRECATED errorHandlerSP "Use spUnwrapErrorT" #-}