gpu-vulkan-middle-0.1.0.54: src/Gpu/Vulkan/Exception/Middle/Internal.hsc

{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs -fno-warn-orphans #-}

module Gpu.Vulkan.Exception.Middle.Internal where

import Control.Exception
import Control.Exception.Hierarchy
import Data.List.NonEmpty (NonEmpty, nonEmpty)

import Gpu.Vulkan.Exception.Enum

data MultiResult = MultiResult (NonEmpty (Int, Result)) deriving Show

exceptionHierarchy Nothing $ ExNode "E" [
	ExType ''Result,
	ExType ''MultiResult ]

throwUnlessSuccess :: Result -> IO ()
throwUnlessSuccess = throwUnless [Success]

throwUnless :: [Result] -> Result -> IO ()
throwUnless sccs r | r `elem` sccs = pure () | otherwise = throw r

throwUnlessSuccesses :: [Result] -> IO ()
throwUnlessSuccesses = throwUnlesses [Success]

throwUnlesses :: [Result] -> [Result] -> IO ()
throwUnlesses sccs rs = do
	let	irs = zip [0 ..] rs
		irs' = filter ((`notElem` sccs) . snd) irs
	case nonEmpty irs' of
		Nothing -> pure ()
		Just r -> throw $ MultiResult r