-- | Stolen from rack: catches all exceptions raised from the app it wraps.

module Hack.Contrib.Middleware.ShowExceptions (show_exceptions) where


import Data.Default
import Data.Maybe
import Hack
import Hack.Contrib.Middleware.Hub
import Hack.Contrib.Utils
import MPS.Light
import Prelude hiding ((.), (^), (>), (-), log)
import System.IO  
import System.IO.Error
import qualified Data.ByteString.Lazy.Char8 as B

program :: String
program = "ShowExceptions"

show_exceptions :: Maybe (String -> IO ()) -> Middleware
show_exceptions stream app = \env -> do
  let my_stream = stream.fromMaybe (env.hack_errors)
  let log = simple_logger my_stream program
  
  app env `catch` (handler log)

  where
    handler :: Logger -> IOError -> IO Response
    handler log e = do
      let message = e.show
      Error. log message
      return - def { status = 500, body = B.pack message }