Errors.hs

{-# LANGUAGE ForeignFunctionInterface #-}
--------------------------------------------------------------------------------
-- |
-- Module    : Sound.Alsa.Sequencer.Errors
-- Copyright : (c) Iavor S. Diatchki, 2007
-- License   : BSD3
--
-- Maintainer: Iavor S. Diatchki
-- Stability : provisional
--
-- Working with errors. TODO: Unify with the rest of the ALSA library.
--------------------------------------------------------------------------------

module Sound.Alsa.Sequencer.Errors where

import Foreign.C.Types (CInt, )
import Foreign.C.String (CString, peekCString, )
import Control.Exception.Extensible (Exception, throw, catch, )
import Data.Word (Word, )
import Data.Typeable (Typeable(typeOf), mkTyCon, mkTyConApp, )
import Prelude hiding (catch, )


data AlsaException = AlsaException
  { exception_code :: !Word           -- ^ the (positive) error code
  , exception_description :: !String  -- ^ a text description of the problem
  } deriving Show

instance Eq AlsaException where
  x == y = exception_code x == exception_code y

instance Ord AlsaException where
  compare x y = compare (exception_code x) (exception_code y)

instance Typeable AlsaException where
  typeOf _ = mkTyConApp (mkTyCon "Sound.Alsa.Sequencer.AlsaException") []

instance Exception AlsaException where


-- | Returns the message for an error code.
strerror :: CInt -> IO String
strerror x = peekCString =<< snd_strerror x

foreign import ccall "alsa/asoundlib.h snd_strerror"
  snd_strerror :: CInt -> IO CString

-- | Catch an exception generated by the binding.
alsa_catch :: IO a -> (AlsaException -> IO a) -> IO a
alsa_catch = catch

check_error :: CInt -> IO Word
check_error = check_error' fromIntegral (const Nothing)

check_error' :: (CInt -> a) -> (CInt -> Maybe a) -> CInt -> IO a
check_error' ok err x
  | x >= 0    = return (ok x)
  | otherwise = case err x of
                  Just a -> return a
                  _ -> do msg <- strerror x
                          throw AlsaException
                            { exception_code        = fromIntegral (negate x)
                            , exception_description = msg
                            }



check_error_ :: CInt -> IO ()
check_error_ x = check_error x >> return ()