-- #hide
--------------------------------------------------------------------------------
-- |
-- Module      :  Sound.ALUT.Errors
-- Copyright   :  (c) Sven Panne 2005
-- License     :  BSD-style (see the file libraries/ALUT/LICENSE)
-- 
-- Maintainer  :  sven.panne@aedion.de
-- Stability   :  provisional
-- Portability :  portable
--
--------------------------------------------------------------------------------

module Sound.ALUT.Errors (
   throwIfALfalse, throwIfNullPtr, makeBuffer
)  where

import Control.Monad ( when )
import Data.Maybe ( fromJust, isNothing )
import Foreign.C.String ( CString, peekCString )
import Foreign.Ptr ( Ptr, nullPtr )
import Sound.OpenAL.AL.ALboolean ( unmarshalALboolean )
import Sound.OpenAL.AL.BasicTypes ( ALboolean, ALenum, ALuint )
import Sound.OpenAL.AL.Buffer ( Buffer )
import Sound.OpenAL.AL.BufferInternal ( unmarshalBuffer )

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

throwIf ::  (a -> Bool) -> String -> IO a -> IO a
throwIf failurePredicate name action = do
   returnValue <- action
   when (failurePredicate returnValue) $ do
      description <- peekCString =<< alutGetErrorString =<< alutGetError
      ioError (userError (name ++ ": " ++ description))
   return returnValue

foreign import CALLCONV unsafe "alutGetError"
   alutGetError :: IO ALenum

foreign import CALLCONV unsafe "alutGetErrorString"
   alutGetErrorString :: ALenum -> IO CString

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

throwIfALfalse :: String -> IO ALboolean -> IO ()
throwIfALfalse name action = do
   throwIf (not . unmarshalALboolean) name action
   return ()

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

throwIfNullPtr :: String -> IO (Ptr a) -> IO (Ptr a)
throwIfNullPtr = throwIf (== nullPtr)

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

makeBuffer :: String -> IO ALuint -> IO Buffer
makeBuffer name =
   fmap fromJust . throwIf isNothing name . fmap unmarshalBuffer
