{-# LANGUAGE TemplateHaskell, DeriveDataTypeable #-}
module Control.Exception.FileLocation
    ( thrwIO
    , thrwsIO
    , reThrow
    ) where

import Language.Haskell.TH.Syntax

import FileLocation.LocationString (locationToString)

import Control.Exception.Base hiding (throwIO)
import qualified Control.Exception.Lifted as E
import Control.Monad.IO.Class (MonadIO (liftIO))
import Data.Typeable (Typeable)

throwIO :: (Exception e, MonadIO m) => e -> m a
throwIO :: forall e (m :: * -> *) a. (Exception e, MonadIO m) => e -> m a
throwIO = IO a -> m a
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> (e -> IO a) -> e -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> IO a
forall (m :: * -> *) e a. (MonadBase IO m, Exception e) => e -> m a
E.throwIO

thrwIO :: Q Exp
thrwIO :: Q Exp
thrwIO = do
  Loc
loc <- Q Loc
forall (m :: * -> *). Quasi m => m Loc
qLocation
  let locStr :: String
locStr = Loc -> String
locationToString Loc
loc
  [|(\_mkEx -> throwIO (_mkEx locStr))|]

thrwsIO :: String -> Q Exp
thrwsIO :: String -> Q Exp
thrwsIO String
errMsg = do
  Loc
loc <- Q Loc
forall (m :: * -> *). Quasi m => m Loc
qLocation
  let locStr :: String
locStr = Loc -> String
locationToString Loc
loc
  [|(\_mkEx -> throwIO (_mkEx (locStr ++ " " ++ errMsg)))|]

data ReThrownException = ReThrownException String E.SomeException
  deriving Typeable

instance Show ReThrownException where
  show :: ReThrownException -> String
show (ReThrownException String
s SomeException
e) = String
"ReThrownException (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"): " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SomeException -> String
forall a. Show a => a -> String
show SomeException
e

instance Exception ReThrownException

reThrow :: Q Exp
reThrow :: Q Exp
reThrow = do
  Loc
loc <- Q Loc
forall (m :: * -> *). Quasi m => m Loc
qLocation
  let locStr :: String
locStr = Loc -> String
locationToString Loc
loc
  [|E.handle (E.throwIO . ReThrownException locStr)|]