{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -fno-cse #-}
{-# OPTIONS_HADDOCK hide #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  Graphics.Rendering.OpenGL.GLU.ErrorsInternal
-- Copyright   :  (c) Sven Panne 2002-2019
-- License     :  BSD3
--
-- Maintainer  :  Sven Panne <[email protected]>
-- Stability   :  stable
-- Portability :  portable
--
-- This is a purely internal module corresponding to some parts of section 2.5
-- (GL Errors) of the OpenGL 2.1 specs and chapter 8 (Errors) of the GLU specs.
--
--------------------------------------------------------------------------------

module Graphics.Rendering.OpenGL.GLU.ErrorsInternal (
   Error(..), ErrorCategory(..), getErrors,
   recordErrorCode, recordInvalidEnum, recordInvalidValue, recordOutOfMemory
) where

import Data.IORef ( IORef, newIORef, readIORef, writeIORef )
import Graphics.GLU
import Graphics.GL
import System.IO.Unsafe ( unsafePerformIO )

--------------------------------------------------------------------------------

-- | GL\/GLU errors consist of a general error category and a description of
-- what went wrong.

data Error = Error ErrorCategory String
   deriving ( Error -> Error -> Bool
(Error -> Error -> Bool) -> (Error -> Error -> Bool) -> Eq Error
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Error -> Error -> Bool
== :: Error -> Error -> Bool
$c/= :: Error -> Error -> Bool
/= :: Error -> Error -> Bool
Eq, Eq Error
Eq Error =>
(Error -> Error -> Ordering)
-> (Error -> Error -> Bool)
-> (Error -> Error -> Bool)
-> (Error -> Error -> Bool)
-> (Error -> Error -> Bool)
-> (Error -> Error -> Error)
-> (Error -> Error -> Error)
-> Ord Error
Error -> Error -> Bool
Error -> Error -> Ordering
Error -> Error -> Error
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Error -> Error -> Ordering
compare :: Error -> Error -> Ordering
$c< :: Error -> Error -> Bool
< :: Error -> Error -> Bool
$c<= :: Error -> Error -> Bool
<= :: Error -> Error -> Bool
$c> :: Error -> Error -> Bool
> :: Error -> Error -> Bool
$c>= :: Error -> Error -> Bool
>= :: Error -> Error -> Bool
$cmax :: Error -> Error -> Error
max :: Error -> Error -> Error
$cmin :: Error -> Error -> Error
min :: Error -> Error -> Error
Ord, Int -> Error -> ShowS
[Error] -> ShowS
Error -> String
(Int -> Error -> ShowS)
-> (Error -> String) -> ([Error] -> ShowS) -> Show Error
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Error -> ShowS
showsPrec :: Int -> Error -> ShowS
$cshow :: Error -> String
show :: Error -> String
$cshowList :: [Error] -> ShowS
showList :: [Error] -> ShowS
Show )

-- | General GL\/GLU error categories

data ErrorCategory
   = ContextLost
   | InvalidEnum
   | InvalidValue
   | InvalidOperation
   | InvalidFramebufferOperation
   | OutOfMemory
   | StackOverflow
   | StackUnderflow
   | TableTooLarge
   | TesselatorError
   | NURBSError
   deriving ( ErrorCategory -> ErrorCategory -> Bool
(ErrorCategory -> ErrorCategory -> Bool)
-> (ErrorCategory -> ErrorCategory -> Bool) -> Eq ErrorCategory
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ErrorCategory -> ErrorCategory -> Bool
== :: ErrorCategory -> ErrorCategory -> Bool
$c/= :: ErrorCategory -> ErrorCategory -> Bool
/= :: ErrorCategory -> ErrorCategory -> Bool
Eq, Eq ErrorCategory
Eq ErrorCategory =>
(ErrorCategory -> ErrorCategory -> Ordering)
-> (ErrorCategory -> ErrorCategory -> Bool)
-> (ErrorCategory -> ErrorCategory -> Bool)
-> (ErrorCategory -> ErrorCategory -> Bool)
-> (ErrorCategory -> ErrorCategory -> Bool)
-> (ErrorCategory -> ErrorCategory -> ErrorCategory)
-> (ErrorCategory -> ErrorCategory -> ErrorCategory)
-> Ord ErrorCategory
ErrorCategory -> ErrorCategory -> Bool
ErrorCategory -> ErrorCategory -> Ordering
ErrorCategory -> ErrorCategory -> ErrorCategory
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ErrorCategory -> ErrorCategory -> Ordering
compare :: ErrorCategory -> ErrorCategory -> Ordering
$c< :: ErrorCategory -> ErrorCategory -> Bool
< :: ErrorCategory -> ErrorCategory -> Bool
$c<= :: ErrorCategory -> ErrorCategory -> Bool
<= :: ErrorCategory -> ErrorCategory -> Bool
$c> :: ErrorCategory -> ErrorCategory -> Bool
> :: ErrorCategory -> ErrorCategory -> Bool
$c>= :: ErrorCategory -> ErrorCategory -> Bool
>= :: ErrorCategory -> ErrorCategory -> Bool
$cmax :: ErrorCategory -> ErrorCategory -> ErrorCategory
max :: ErrorCategory -> ErrorCategory -> ErrorCategory
$cmin :: ErrorCategory -> ErrorCategory -> ErrorCategory
min :: ErrorCategory -> ErrorCategory -> ErrorCategory
Ord, Int -> ErrorCategory -> ShowS
[ErrorCategory] -> ShowS
ErrorCategory -> String
(Int -> ErrorCategory -> ShowS)
-> (ErrorCategory -> String)
-> ([ErrorCategory] -> ShowS)
-> Show ErrorCategory
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ErrorCategory -> ShowS
showsPrec :: Int -> ErrorCategory -> ShowS
$cshow :: ErrorCategory -> String
show :: ErrorCategory -> String
$cshowList :: [ErrorCategory] -> ShowS
showList :: [ErrorCategory] -> ShowS
Show )

makeError :: GLenum -> Error
makeError :: GLenum -> Error
makeError GLenum
c
   -- GL errors
   | GLenum
c GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_CONTEXT_LOST =
       ErrorCategory -> String -> Error
Error ErrorCategory
ContextLost String
"context lost"
   | GLenum
c GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_INVALID_ENUM =
       ErrorCategory -> String -> Error
Error ErrorCategory
InvalidEnum String
"invalid enumerant"
   | GLenum
c GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_INVALID_VALUE =
       ErrorCategory -> String -> Error
Error ErrorCategory
InvalidValue  String
"invalid value"
   | GLenum
c GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_INVALID_OPERATION =
       ErrorCategory -> String -> Error
Error ErrorCategory
InvalidOperation String
"invalid operation"
   | GLenum
c GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_INVALID_FRAMEBUFFER_OPERATION =
       ErrorCategory -> String -> Error
Error ErrorCategory
InvalidFramebufferOperation String
"invalid framebuffer operation"
   | GLenum
c GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_OUT_OF_MEMORY
       = ErrorCategory -> String -> Error
Error ErrorCategory
OutOfMemory String
"out of memory"
   | GLenum
c GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_STACK_OVERFLOW =
       ErrorCategory -> String -> Error
Error ErrorCategory
StackOverflow String
"stack overflow"
   | GLenum
c GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_STACK_UNDERFLOW =
       ErrorCategory -> String -> Error
Error ErrorCategory
StackUnderflow String
"stack underflow"
   | GLenum
c GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_TABLE_TOO_LARGE =
       ErrorCategory -> String -> Error
Error ErrorCategory
TableTooLarge String
"table too large"
   -- GLU errors
   | GLenum
c GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GLU_INVALID_ENUM =
       ErrorCategory -> String -> Error
Error ErrorCategory
InvalidEnum String
"invalid enumerant"
   | GLenum
c GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GLU_INVALID_VALUE =
       ErrorCategory -> String -> Error
Error ErrorCategory
InvalidValue  String
"invalid value"
   | GLenum
c GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GLU_INVALID_OPERATION =
       ErrorCategory -> String -> Error
Error ErrorCategory
InvalidOperation String
"invalid operation"
   | GLenum
c GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GLU_OUT_OF_MEMORY
       = ErrorCategory -> String -> Error
Error ErrorCategory
OutOfMemory String
"out of memory"
   -- GLU tesselator error
   | GLenum
c GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GLU_TESS_ERROR1 =
       ErrorCategory -> String -> Error
Error ErrorCategory
TesselatorError String
"gluTessBeginPolygon() must precede a gluTessEndPolygon()"
   | GLenum
c GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GLU_TESS_ERROR2 =
       ErrorCategory -> String -> Error
Error ErrorCategory
TesselatorError String
"gluTessBeginContour() must precede a gluTessEndContour()"
   | GLenum
c GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GLU_TESS_ERROR3 =
       ErrorCategory -> String -> Error
Error ErrorCategory
TesselatorError String
"gluTessEndPolygon() must follow a gluTessBeginPolygon()"
   | GLenum
c GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GLU_TESS_ERROR4 =
       ErrorCategory -> String -> Error
Error ErrorCategory
TesselatorError String
"gluTessEndContour() must follow a gluTessBeginContour()"
   | GLenum
c GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GLU_TESS_ERROR5 =
       ErrorCategory -> String -> Error
Error ErrorCategory
TesselatorError String
"a coordinate is too large"
   | GLenum
c GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GLU_TESS_ERROR6 =
       ErrorCategory -> String -> Error
Error ErrorCategory
TesselatorError String
"need combine callback"
   | GLenum
c GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GLU_TESS_ERROR7 =
       ErrorCategory -> String -> Error
Error ErrorCategory
TesselatorError String
"tesselation error 7"
   | GLenum
c GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GLU_TESS_ERROR8 =
       ErrorCategory -> String -> Error
Error ErrorCategory
TesselatorError String
"tesselation error 8"
   -- GLU NUBRS errors
   | GLenum
c GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GLU_NURBS_ERROR1 =
       ErrorCategory -> String -> Error
Error ErrorCategory
NURBSError String
"spline order un-supported"
   | GLenum
c GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GLU_NURBS_ERROR2 =
       ErrorCategory -> String -> Error
Error ErrorCategory
NURBSError String
"too few knots"
   | GLenum
c GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GLU_NURBS_ERROR3 =
       ErrorCategory -> String -> Error
Error ErrorCategory
NURBSError String
"valid knot range is empty"
   | GLenum
c GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GLU_NURBS_ERROR4 =
       ErrorCategory -> String -> Error
Error ErrorCategory
NURBSError String
"decreasing knot sequence knot"
   | GLenum
c GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GLU_NURBS_ERROR5 =
       ErrorCategory -> String -> Error
Error ErrorCategory
NURBSError String
"knot multiplicity greater than order of spline"
   | GLenum
c GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GLU_NURBS_ERROR6 =
       ErrorCategory -> String -> Error
Error ErrorCategory
NURBSError String
"gluEndCurve() must follow gluBeginCurve()"
   | GLenum
c GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GLU_NURBS_ERROR7 =
       ErrorCategory -> String -> Error
Error ErrorCategory
NURBSError String
"gluBeginCurve() must precede gluEndCurve()"
   | GLenum
c GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GLU_NURBS_ERROR8 =
       ErrorCategory -> String -> Error
Error ErrorCategory
NURBSError String
"missing or extra geometric data"
   | GLenum
c GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GLU_NURBS_ERROR9 =
       ErrorCategory -> String -> Error
Error ErrorCategory
NURBSError String
"can't draw piecewise linear trimming curves"
   | GLenum
c GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GLU_NURBS_ERROR10 =
       ErrorCategory -> String -> Error
Error ErrorCategory
NURBSError String
"missing or extra domain data"
   | GLenum
c GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GLU_NURBS_ERROR11 =
       ErrorCategory -> String -> Error
Error ErrorCategory
NURBSError String
"missing or extra domain data"
   | GLenum
c GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GLU_NURBS_ERROR12 =
       ErrorCategory -> String -> Error
Error ErrorCategory
NURBSError String
"gluEndTrim() must precede gluEndSurface()"
   | GLenum
c GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GLU_NURBS_ERROR13 =
       ErrorCategory -> String -> Error
Error ErrorCategory
NURBSError String
"gluBeginSurface() must precede gluEndSurface()"
   | GLenum
c GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GLU_NURBS_ERROR14 =
       ErrorCategory -> String -> Error
Error ErrorCategory
NURBSError String
"curve of improper type passed as trim curve"
   | GLenum
c GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GLU_NURBS_ERROR15 =
       ErrorCategory -> String -> Error
Error ErrorCategory
NURBSError String
"gluBeginSurface() must precede gluBeginTrim()"
   | GLenum
c GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GLU_NURBS_ERROR16 =
       ErrorCategory -> String -> Error
Error ErrorCategory
NURBSError String
"gluEndTrim() must follow gluBeginTrim()"
   | GLenum
c GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GLU_NURBS_ERROR17 =
       ErrorCategory -> String -> Error
Error ErrorCategory
NURBSError String
"gluBeginTrim() must precede gluEndTrim()"
   | GLenum
c GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GLU_NURBS_ERROR18 =
       ErrorCategory -> String -> Error
Error ErrorCategory
NURBSError String
"invalid or missing trim curve"
   | GLenum
c GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GLU_NURBS_ERROR19 =
       ErrorCategory -> String -> Error
Error ErrorCategory
NURBSError String
"gluBeginTrim() must precede gluPwlCurve()"
   | GLenum
c GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GLU_NURBS_ERROR20 =
       ErrorCategory -> String -> Error
Error ErrorCategory
NURBSError String
"piecewise linear trimming curve referenced twice"
   | GLenum
c GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GLU_NURBS_ERROR21 =
       ErrorCategory -> String -> Error
Error ErrorCategory
NURBSError String
"piecewise linear trimming curve and nurbs curve mixed"
   | GLenum
c GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GLU_NURBS_ERROR22 =
       ErrorCategory -> String -> Error
Error ErrorCategory
NURBSError String
"improper usage of trim data type"
   | GLenum
c GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GLU_NURBS_ERROR23 =
       ErrorCategory -> String -> Error
Error ErrorCategory
NURBSError String
"nurbs curve referenced twice"
   | GLenum
c GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GLU_NURBS_ERROR24 =
       ErrorCategory -> String -> Error
Error ErrorCategory
NURBSError String
"nurbs curve and piecewise linear trimming curve mixed"
   | GLenum
c GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GLU_NURBS_ERROR25 =
       ErrorCategory -> String -> Error
Error ErrorCategory
NURBSError String
"nurbs surface referenced twice"
   | GLenum
c GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GLU_NURBS_ERROR26 =
       ErrorCategory -> String -> Error
Error ErrorCategory
NURBSError String
"invalid property"
   | GLenum
c GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GLU_NURBS_ERROR27 =
       ErrorCategory -> String -> Error
Error ErrorCategory
NURBSError String
"gluEndSurface() must follow gluBeginSurface()"
   | GLenum
c GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GLU_NURBS_ERROR28 =
       ErrorCategory -> String -> Error
Error ErrorCategory
NURBSError String
"intersecting or misoriented trim curves"
   | GLenum
c GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GLU_NURBS_ERROR29 =
       ErrorCategory -> String -> Error
Error ErrorCategory
NURBSError String
"intersecting trim curves"
   | GLenum
c GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GLU_NURBS_ERROR30 =
       ErrorCategory -> String -> Error
Error ErrorCategory
NURBSError String
"UNUSED"
   | GLenum
c GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GLU_NURBS_ERROR31 =
       ErrorCategory -> String -> Error
Error ErrorCategory
NURBSError String
"unconnected trim curves"
   | GLenum
c GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GLU_NURBS_ERROR32 =
       ErrorCategory -> String -> Error
Error ErrorCategory
NURBSError String
"unknown knot error"
   | GLenum
c GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GLU_NURBS_ERROR33 =
       ErrorCategory -> String -> Error
Error ErrorCategory
NURBSError String
"negative vertex count encountered"
   | GLenum
c GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GLU_NURBS_ERROR34 =
       ErrorCategory -> String -> Error
Error ErrorCategory
NURBSError String
"negative byte-stride encounteed"
   | GLenum
c GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GLU_NURBS_ERROR35 =
       ErrorCategory -> String -> Error
Error ErrorCategory
NURBSError String
"unknown type descriptor"
   | GLenum
c GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GLU_NURBS_ERROR36 =
       ErrorCategory -> String -> Error
Error ErrorCategory
NURBSError String
"null control point reference"
   | GLenum
c GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GLU_NURBS_ERROR37 =
       ErrorCategory -> String -> Error
Error ErrorCategory
NURBSError String
"duplicate point on piecewise linear trimming curve"
   -- Something went terribly wrong...
   | Bool
otherwise = String -> Error
forall a. HasCallStack => String -> a
error String
"makeError"

--------------------------------------------------------------------------------

-- This seems to be a common Haskell hack nowadays: A plain old global variable
-- with an associated getter and mutator. Perhaps some language/library support
-- is needed?

{-# NOINLINE theRecordedErrors #-}
theRecordedErrors :: IORef ([GLenum],Bool)
theRecordedErrors :: IORef ([GLenum], Bool)
theRecordedErrors = IO (IORef ([GLenum], Bool)) -> IORef ([GLenum], Bool)
forall a. IO a -> a
unsafePerformIO (([GLenum], Bool) -> IO (IORef ([GLenum], Bool))
forall a. a -> IO (IORef a)
newIORef ([], Bool
True))

getRecordedErrors :: IO ([GLenum],Bool)
getRecordedErrors :: IO ([GLenum], Bool)
getRecordedErrors =  IORef ([GLenum], Bool) -> IO ([GLenum], Bool)
forall a. IORef a -> IO a
readIORef IORef ([GLenum], Bool)
theRecordedErrors

setRecordedErrors :: ([GLenum],Bool) -> IO ()
setRecordedErrors :: ([GLenum], Bool) -> IO ()
setRecordedErrors = IORef ([GLenum], Bool) -> ([GLenum], Bool) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef ([GLenum], Bool)
theRecordedErrors

--------------------------------------------------------------------------------

getGLErrors :: IO [GLenum]
getGLErrors :: IO [GLenum]
getGLErrors = [GLenum] -> IO [GLenum]
forall {m :: * -> *}. MonadIO m => [GLenum] -> m [GLenum]
getGLErrorsAux []
   where getGLErrorsAux :: [GLenum] -> m [GLenum]
getGLErrorsAux [GLenum]
acc = do
            errorCode <- m GLenum
forall (m :: * -> *). MonadIO m => m GLenum
glGetError
            if isError errorCode
               then getGLErrorsAux (errorCode : acc)
               else return $ reverse acc

isError :: GLenum -> Bool
isError :: GLenum -> Bool
isError = (GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
/= GLenum
GL_NO_ERROR)

--------------------------------------------------------------------------------

getErrors :: IO [Error]
getErrors :: IO [Error]
getErrors = (GLenum -> Error) -> [GLenum] -> [Error]
forall a b. (a -> b) -> [a] -> [b]
map GLenum -> Error
makeError ([GLenum] -> [Error]) -> IO [GLenum] -> IO [Error]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` ([GLenum] -> ([GLenum], Bool)) -> IO [GLenum]
getErrorCodesAux (([GLenum], Bool) -> [GLenum] -> ([GLenum], Bool)
forall a b. a -> b -> a
const ([], Bool
True))

recordErrorCode :: GLenum -> IO ()
recordErrorCode :: GLenum -> IO ()
recordErrorCode GLenum
e = do
   -- We don't need the return value because this calls setRecordedErrors
   _ <- ([GLenum] -> ([GLenum], Bool)) -> IO [GLenum]
getErrorCodesAux (\[GLenum]
es -> (if [GLenum] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GLenum]
es then [GLenum
e] else [], Bool
False))
   return ()

recordInvalidEnum :: IO ()
recordInvalidEnum :: IO ()
recordInvalidEnum = GLenum -> IO ()
recordErrorCode GLenum
GL_INVALID_ENUM

recordInvalidValue :: IO ()
recordInvalidValue :: IO ()
recordInvalidValue = GLenum -> IO ()
recordErrorCode GLenum
GL_INVALID_VALUE

recordOutOfMemory :: IO ()
recordOutOfMemory :: IO ()
recordOutOfMemory = GLenum -> IO ()
recordErrorCode GLenum
GL_OUT_OF_MEMORY

-- ToDo: Make this thread-safe
getErrorCodesAux :: ([GLenum] -> ([GLenum],Bool)) -> IO [GLenum]
getErrorCodesAux :: ([GLenum] -> ([GLenum], Bool)) -> IO [GLenum]
getErrorCodesAux [GLenum] -> ([GLenum], Bool)
f = do
   (recordedErrors, useGLErrors) <- IO ([GLenum], Bool)
getRecordedErrors
   glErrors <- getGLErrors
   let es = if Bool
useGLErrors then [GLenum]
recordedErrors [GLenum] -> [GLenum] -> [GLenum]
forall a. [a] -> [a] -> [a]
++ [GLenum]
glErrors else [GLenum]
recordedErrors
   setRecordedErrors (f es)
   return es