--------------------------------------------------------------------------------
-- |
-- Module      :  Graphics.UI.GLUT.Debugging
-- Copyright   :  (c) Sven Panne 2002-2018
-- License     :  BSD3
--
-- Maintainer  :  Sven Panne <svenpanne@gmail.com>
-- Stability   :  stable
-- Portability :  portable
--
-- This module contains a simple utility routine to report any pending GL
-- errors.
--
--------------------------------------------------------------------------------

module Graphics.UI.GLUT.Debugging (
   reportErrors
) where

import Control.Monad.IO.Class ( MonadIO(..) )
import Data.StateVar ( get )
import Graphics.Rendering.OpenGL ( Error(..), errors )
import System.Environment ( getProgName )
import System.IO ( hPutStrLn, stderr )

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

-- | Report any pending GL errors to stderr (which is typically the console).
-- If there are no pending errors, this routine does nothing. Note that the
-- error flags are reset after this action, i.e. there are no pending errors
-- left afterwards.

reportErrors :: MonadIO m => m ()
reportErrors :: m ()
reportErrors = GettableStateVar [Error] -> m [Error]
forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
get GettableStateVar [Error]
errors m [Error] -> ([Error] -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Error -> m ()) -> [Error] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Error -> m ()
forall (m :: * -> *). MonadIO m => Error -> m ()
reportError

reportError :: MonadIO m => Error -> m ()
reportError :: Error -> m ()
reportError (Error ErrorCategory
_ String
msg) = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
   String
pn <- IO String
getProgName
   Handle -> String -> IO ()
hPutStrLn Handle
stderr (String
"GLUT: Warning in " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
pn String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": GL error: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
msg)