{-# 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