{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module Language.SpirV.Shaderc.Exception.Internal where

import Control.Exception
import Control.Exception.Hierarchy

import qualified Data.ByteString as BS

import Language.SpirV.Shaderc.Exception.Enum

import qualified Shaderc.CompilationResult.Core as CompilationResult

data E = E CompilationStatus BS.ByteString deriving Int -> E -> ShowS
[E] -> ShowS
E -> String
(Int -> E -> ShowS) -> (E -> String) -> ([E] -> ShowS) -> Show E
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> E -> ShowS
showsPrec :: Int -> E -> ShowS
$cshow :: E -> String
show :: E -> String
$cshowList :: [E] -> ShowS
showList :: [E] -> ShowS
Show

exceptionHierarchy Nothing (ExType ''E)

throwUnlessSuccess :: CompilationResult.T -> IO ()
throwUnlessSuccess :: T -> IO ()
throwUnlessSuccess T
rslt = do
	stt <- T -> IO CompilationStatus
CompilationResult.getCompilationStatus T
rslt
	case stt of
		CompilationStatus
CompilationStatusSuccess -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
		CompilationStatus
_ -> do	cmsg <- T -> IO CString
CompilationResult.getErrorMessage T
rslt
			msg <- BS.packCString cmsg
			throw $ E stt msg