    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Graphics.Rendering.OpenGL.GL.Shaders.Shaders
    -- Copyright   :
    -- License     :  BSD3
    --
    -- Maintainer  :  Sven Panne <sven.panne@aedion.de>
    -- Stability   :
    -- Portability :
    --
    -- This module correspons with section 2.20.1 (Shader Objects) of the OpenGL
    -- 3.1 spec.
    --
    -----------------------------------------------------------------------------

    module Graphics.Rendering.OpenGL.GL.Shaders.Shaders (

       Shader(..), VertexShader(..), FragmentShader(..), shaderDeleteStatus, shaderSource,
       compileShader, compileStatus, shaderInfoLog,

       -- * internals
       shaderTypeEnum

    ) where

    import Control.Monad
    import Control.Monad.Fix
    import Data.List
    import Foreign.Marshal.Alloc
    import Foreign.Marshal.Array
    import Foreign.Marshal.Utils
    import Graphics.Rendering.OpenGL.GL.ObjectName
    import Graphics.Rendering.OpenGL.GL.StateVar
    import Graphics.Rendering.OpenGL.GL.GLboolean
    import Graphics.Rendering.OpenGL.GL.GLstring
    import Graphics.Rendering.OpenGL.GL.PeekPoke
    import Graphics.Rendering.OpenGL.Raw.Core31

    newtype VertexShader = VertexShader { vertexShaderID :: GLuint }
       deriving ( Eq, Ord, Show )

    newtype FragmentShader = FragmentShader { fragmentShaderID :: GLuint }
       deriving ( Eq, Ord, Show )

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

    class (Eq s, Ord s, Show s, ObjectName s) => Shader s where
       shaderID :: s -> GLuint
       makeShader :: GLuint -> s
       shaderType :: s -> GLenum

    instance Shader VertexShader where
       makeShader = VertexShader
       shaderID = vertexShaderID
       shaderType = const gl_VERTEX_SHADER

    instance Shader FragmentShader where
       makeShader = FragmentShader
       shaderID = fragmentShaderID
       shaderType = const gl_FRAGMENT_SHADER

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

    instance ObjectName VertexShader where
       genObjectNames = genShaderNames
       deleteObjectNames = deleteShaderNames
       isObjectName = isShaderName

    instance ObjectName FragmentShader where
       genObjectNames = genShaderNames
       deleteObjectNames = deleteShaderNames
       isObjectName = isShaderName

    genShaderNames :: Shader s => Int -> IO [s]
    genShaderNames n = replicateM n createShader

    createShader :: Shader s => IO s
    createShader = mfix (fmap makeShader . glCreateShader . shaderType)

    deleteShaderNames :: Shader s => [s] -> IO ()
    deleteShaderNames = mapM_ (glDeleteShader . shaderID)

    isShaderName :: Shader s => s -> IO Bool
    isShaderName = fmap unmarshalGLboolean . glIsShader . shaderID

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

    compileShader :: Shader s => s -> IO ()
    compileShader = glCompileShader . shaderID

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

    shaderSource :: Shader s => s -> StateVar [String]
    shaderSource shader =
       makeStateVar (getShaderSource shader) (setShaderSource shader)

    setShaderSource :: Shader s => s -> [String] -> IO ()
    setShaderSource shader srcs = do
       let len = genericLength srcs
       withMany withGLStringLen srcs $ \charBufsAndLengths -> do
          let (charBufs, lengths) = unzip charBufsAndLengths
          withArray charBufs $ \charBufsBuf ->
             withArray (map fromIntegral lengths) $ \lengthsBuf ->
                glShaderSource (shaderID shader) len charBufsBuf lengthsBuf

    getShaderSource :: Shader s => s -> IO [String]
    getShaderSource shader = do
       src <- get (stringQuery (shaderSourceLength shader)
                               (glGetShaderSource (shaderID shader)))
       return [src]

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

    shaderInfoLog :: Shader s => s -> GettableStateVar String
    shaderInfoLog shader =
       stringQuery (shaderInfoLogLength shader) (glGetShaderInfoLog (shaderID shader))

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

    shaderDeleteStatus :: Shader s => s -> GettableStateVar Bool
    shaderDeleteStatus = shaderVar unmarshalGLboolean ShaderDeleteStatus

    compileStatus :: Shader s => s -> GettableStateVar Bool
    compileStatus = shaderVar unmarshalGLboolean CompileStatus

    shaderInfoLogLength :: Shader s => s -> GettableStateVar GLsizei
    shaderInfoLogLength = shaderVar fromIntegral ShaderInfoLogLength

    shaderSourceLength :: Shader s => s -> GettableStateVar GLsizei
    shaderSourceLength = shaderVar fromIntegral ShaderSourceLength

    shaderTypeEnum :: Shader s => s -> GettableStateVar GLenum
    shaderTypeEnum = shaderVar fromIntegral ShaderType

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

    data GetShaderPName =
         ShaderDeleteStatus
       | CompileStatus
       | ShaderInfoLogLength
       | ShaderSourceLength
       | ShaderType

    marshalGetShaderPName :: GetShaderPName -> GLenum
    marshalGetShaderPName x = case x of
       ShaderDeleteStatus -> gl_DELETE_STATUS
       CompileStatus -> gl_COMPILE_STATUS
       ShaderInfoLogLength -> gl_INFO_LOG_LENGTH
       ShaderSourceLength -> gl_SHADER_SOURCE_LENGTH
       ShaderType -> gl_SHADER_TYPE

    shaderVar :: Shader s => (GLint -> a) -> GetShaderPName -> s -> GettableStateVar a
    shaderVar f p shader =
       makeGettableStateVar $
          alloca $ \buf -> do
             glGetShaderiv (shaderID shader) (marshalGetShaderPName p) buf
             peek1 f buf