{-# LANGUAGE PatternSynonyms #-}
-- | A module that contains exception-safe equivalents of @inline-c@ QuasiQuoters.

{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE QuasiQuotes #-}

module Language.C.Inline.Cpp.Unsafe
  ( throwBlock
  , tryBlock
  , catchBlock
  , toSomeException
  ) where

import           Control.Exception.Safe
import qualified Language.C.Inline.Unsafe as Unsafe
import           Language.Haskell.TH.Quote
import           Language.C.Inline.Cpp.Exception (tryBlockQuoteExp)
import           Language.C.Inline.Cpp.Exception (tryBlockQuoteExp,toSomeException)

-- | Like 'tryBlock', but will throw unwrapped 'CppHaskellException's or other 'CppException's rather than returning
-- them in an 'Either'
throwBlock :: QuasiQuoter
throwBlock :: QuasiQuoter
throwBlock = QuasiQuoter
  { quoteExp :: String -> Q Exp
quoteExp = \String
blockStr -> do
      [e| either (throwIO . toSomeException) return =<< $(QuasiQuoter -> String -> Q Exp
tryBlockQuoteExp QuasiQuoter
Unsafe.block String
blockStr) |]
  , quotePat :: String -> Q Pat
quotePat = String -> Q Pat
forall {m :: * -> *} {p} {a}. MonadFail m => p -> m a
unsupported
  , quoteType :: String -> Q Type
quoteType = String -> Q Type
forall {m :: * -> *} {p} {a}. MonadFail m => p -> m a
unsupported
  , quoteDec :: String -> Q [Dec]
quoteDec = String -> Q [Dec]
forall {m :: * -> *} {p} {a}. MonadFail m => p -> m a
unsupported
  } where
      unsupported :: p -> m a
unsupported p
_ = String -> m a
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unsupported quasiquotation."

-- | Variant of 'throwBlock' for blocks which return 'void'.
catchBlock :: QuasiQuoter
catchBlock :: QuasiQuoter
catchBlock = QuasiQuoter
  { quoteExp :: String -> Q Exp
quoteExp = \String
blockStr -> QuasiQuoter -> String -> Q Exp
quoteExp QuasiQuoter
throwBlock (String
"void {" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
blockStr String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"}")
  , quotePat :: String -> Q Pat
quotePat = String -> Q Pat
forall {m :: * -> *} {p} {a}. MonadFail m => p -> m a
unsupported
  , quoteType :: String -> Q Type
quoteType = String -> Q Type
forall {m :: * -> *} {p} {a}. MonadFail m => p -> m a
unsupported
  , quoteDec :: String -> Q [Dec]
quoteDec = String -> Q [Dec]
forall {m :: * -> *} {p} {a}. MonadFail m => p -> m a
unsupported
  } where
      unsupported :: p -> m a
unsupported p
_ = String -> m a
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unsupported quasiquotation."

-- | Similar to `C.block`, but C++ exceptions will be caught and the result is (Either CppException value). The return type must be void or constructible with @{}@.
-- Using this will automatically include @exception@, @cstring@ and @cstdlib@.
tryBlock :: QuasiQuoter
tryBlock :: QuasiQuoter
tryBlock = QuasiQuoter
  { quoteExp :: String -> Q Exp
quoteExp = QuasiQuoter -> String -> Q Exp
tryBlockQuoteExp QuasiQuoter
Unsafe.block
  , quotePat :: String -> Q Pat
quotePat = String -> Q Pat
forall {m :: * -> *} {p} {a}. MonadFail m => p -> m a
unsupported
  , quoteType :: String -> Q Type
quoteType = String -> Q Type
forall {m :: * -> *} {p} {a}. MonadFail m => p -> m a
unsupported
  , quoteDec :: String -> Q [Dec]
quoteDec = String -> Q [Dec]
forall {m :: * -> *} {p} {a}. MonadFail m => p -> m a
unsupported
  } where
      unsupported :: p -> m a
unsupported p
_ = String -> m a
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unsupported quasiquotation."