{-# 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 <svenpanne@gmail.com>
-- 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
/= :: Error -> Error -> Bool
$c/= :: Error -> Error -> Bool
== :: Error -> Error -> Bool
$c== :: 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
min :: Error -> Error -> Error
$cmin :: Error -> Error -> Error
max :: Error -> Error -> Error
$cmax :: Error -> Error -> Error
>= :: Error -> Error -> Bool
$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
compare :: Error -> Error -> Ordering
$ccompare :: Error -> Error -> Ordering
$cp1Ord :: Eq 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
showList :: [Error] -> ShowS
$cshowList :: [Error] -> ShowS
show :: Error -> String
$cshow :: Error -> String
showsPrec :: Int -> Error -> ShowS
$cshowsPrec :: Int -> 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
/= :: ErrorCategory -> ErrorCategory -> Bool
$c/= :: ErrorCategory -> ErrorCategory -> Bool
== :: ErrorCategory -> ErrorCategory -> Bool
$c== :: 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
min :: ErrorCategory -> ErrorCategory -> ErrorCategory
$cmin :: ErrorCategory -> ErrorCategory -> ErrorCategory
max :: ErrorCategory -> ErrorCategory -> ErrorCategory
$cmax :: ErrorCategory -> ErrorCategory -> ErrorCategory
>= :: ErrorCategory -> ErrorCategory -> Bool
$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
compare :: ErrorCategory -> ErrorCategory -> Ordering
$ccompare :: ErrorCategory -> ErrorCategory -> Ordering
$cp1Ord :: Eq 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
showList :: [ErrorCategory] -> ShowS
$cshowList :: [ErrorCategory] -> ShowS
show :: ErrorCategory -> String
$cshow :: ErrorCategory -> String
showsPrec :: Int -> ErrorCategory -> ShowS
$cshowsPrec :: Int -> ErrorCategory -> ShowS
Show )

makeError :: GLenum -> Error
makeError :: GLenum -> Error
makeError c :: 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 "context lost"
   | GLenum
c GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_INVALID_ENUM =
       ErrorCategory -> String -> Error
Error ErrorCategory
InvalidEnum "invalid enumerant"
   | GLenum
c GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_INVALID_VALUE =
       ErrorCategory -> String -> Error
Error ErrorCategory
InvalidValue  "invalid value"
   | GLenum
c GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_INVALID_OPERATION =
       ErrorCategory -> String -> Error
Error ErrorCategory
InvalidOperation "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 "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 "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 "stack overflow"
   | GLenum
c GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_STACK_UNDERFLOW =
       ErrorCategory -> String -> Error
Error ErrorCategory
StackUnderflow "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 "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 "invalid enumerant"
   | GLenum
c GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GLU_INVALID_VALUE =
       ErrorCategory -> String -> Error
Error ErrorCategory
InvalidValue  "invalid value"
   | GLenum
c GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GLU_INVALID_OPERATION =
       ErrorCategory -> String -> Error
Error ErrorCategory
InvalidOperation "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 "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 "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 "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 "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 "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 "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 "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 "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 "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 "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 "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 "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 "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 "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 "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 "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 "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 "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 "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 "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 "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 "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 "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 "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 "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 "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 "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 "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 "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 "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 "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 "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 "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 "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 "invalid property"
   | GLenum
c GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GLU_NURBS_ERROR27 =
       ErrorCategory -> String -> Error
Error ErrorCategory
NURBSError "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 "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 "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 "UNUSED"
   | GLenum
c GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GLU_NURBS_ERROR31 =
       ErrorCategory -> String -> Error
Error ErrorCategory
NURBSError "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 "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 "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 "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 "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 "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 "duplicate point on piecewise linear trimming curve"
   -- Something went terribly wrong...
   | Bool
otherwise = String -> Error
forall a. HasCallStack => String -> a
error "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 acc :: [GLenum]
acc = do
            GLenum
errorCode <- m GLenum
forall (m :: * -> *). MonadIO m => m GLenum
glGetError
            if GLenum -> Bool
isError GLenum
errorCode
               then [GLenum] -> m [GLenum]
getGLErrorsAux (GLenum
errorCode GLenum -> [GLenum] -> [GLenum]
forall a. a -> [a] -> [a]
: [GLenum]
acc)
               else [GLenum] -> m [GLenum]
forall (m :: * -> *) a. Monad m => a -> m a
return ([GLenum] -> m [GLenum]) -> [GLenum] -> m [GLenum]
forall a b. (a -> b) -> a -> b
$ [GLenum] -> [GLenum]
forall a. [a] -> [a]
reverse [GLenum]
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 (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 e :: GLenum
e = do
   -- We don't need the return value because this calls setRecordedErrors
   [GLenum]
_ <- ([GLenum] -> ([GLenum], Bool)) -> IO [GLenum]
getErrorCodesAux (\es :: [GLenum]
es -> (if [GLenum] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GLenum]
es then [GLenum
e] else [], Bool
False))
   () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
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 f :: [GLenum] -> ([GLenum], Bool)
f = do
   (recordedErrors :: [GLenum]
recordedErrors, useGLErrors :: Bool
useGLErrors) <- IO ([GLenum], Bool)
getRecordedErrors
   [GLenum]
glErrors <- IO [GLenum]
getGLErrors
   let es :: [GLenum]
es = if Bool
useGLErrors then [GLenum]
recordedErrors [GLenum] -> [GLenum] -> [GLenum]
forall a. [a] -> [a] -> [a]
++ [GLenum]
glErrors else [GLenum]
recordedErrors
   ([GLenum], Bool) -> IO ()
setRecordedErrors ([GLenum] -> ([GLenum], Bool)
f [GLenum]
es)
   [GLenum] -> IO [GLenum]
forall (m :: * -> *) a. Monad m => a -> m a
return [GLenum]
es