{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE DeriveDataTypeable #-}
module Sound.ALSA.Exception where
import qualified Control.Exception.Extensible as Exc
import Control.Exception.Extensible (Exception, )
import Data.Typeable (Typeable, )
import Foreign.C.Error (Errno(Errno), ePIPE, errnoToIOError, )
import Foreign.C.String (CString, peekCString, )
import qualified Foreign.C.Types as C
import Prelude hiding (catch, show, )
import qualified Prelude as P
data T = Cons {
T -> String
location :: String,
T -> String
description :: String,
T -> Errno
code :: Errno
} deriving (Typeable)
instance Show T where
showsPrec :: Int -> T -> ShowS
showsPrec Int
p (Cons String
l String
d (Errno CInt
c)) =
Bool -> ShowS -> ShowS
showParen (Int
pInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
10)
(String -> ShowS
showString String
"AlsaException.Cons " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
String -> ShowS
forall a. Show a => a -> ShowS
shows String
l ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
String -> ShowS
forall a. Show a => a -> ShowS
shows String
d ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Bool -> ShowS -> ShowS
showParen Bool
True (String -> ShowS
showString String
"Errno " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> ShowS
forall a. Show a => a -> ShowS
shows CInt
c))
instance Exception T where
checkResult :: Integral a => String -> a -> IO a
checkResult :: String -> a -> IO a
checkResult String
f a
r =
if a
r a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0
then String -> Errno -> IO a
forall a. String -> Errno -> IO a
throw String
f (CInt -> Errno
Errno (CInt -> CInt
forall a. Num a => a -> a
negate (a -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
r)))
else a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r
checkResult_ :: Integral a => String -> a -> IO ()
checkResult_ :: String -> a -> IO ()
checkResult_ String
f a
r = String -> a -> IO a
forall a. Integral a => String -> a -> IO a
checkResult String
f a
r IO a -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
checkResultMaybe :: String -> (C.CInt -> a) -> (C.CInt -> Maybe a) -> C.CInt -> IO a
checkResultMaybe :: String -> (CInt -> a) -> (CInt -> Maybe a) -> CInt -> IO a
checkResultMaybe String
f CInt -> a
ok CInt -> Maybe a
err CInt
x =
if CInt
x CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
>= CInt
0
then a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> a
ok CInt
x)
else case CInt -> Maybe a
err CInt
x of
Just a
a -> a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
Maybe a
_ -> String -> Errno -> IO a
forall a. String -> Errno -> IO a
throw String
f (CInt -> Errno
Errno CInt
x)
throw :: String -> Errno -> IO a
throw :: String -> Errno -> IO a
throw String
fun Errno
err = do
String
d <- Errno -> IO String
strerror Errno
err
T -> IO a
forall a e. Exception e => e -> a
Exc.throw Cons :: String -> String -> Errno -> T
Cons
{ location :: String
location = String
fun
, description :: String
description = String
d
, code :: Errno
code = Errno
err
}
catch :: IO a -> (T -> IO a) -> IO a
catch :: IO a -> (T -> IO a) -> IO a
catch = IO a -> (T -> IO a) -> IO a
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
Exc.catch
catchErrno ::
Errno
-> IO a
-> IO a
-> IO a
catchErrno :: Errno -> IO a -> IO a -> IO a
catchErrno Errno
e IO a
x IO a
h =
IO a -> (T -> IO a) -> IO a
forall a. IO a -> (T -> IO a) -> IO a
catch IO a
x (\T
ex -> if T -> Errno
code T
ex Errno -> Errno -> Bool
forall a. Eq a => a -> a -> Bool
== Errno
e then IO a
h else T -> IO a
forall a e. Exception e => e -> a
Exc.throw T
ex)
catchXRun ::
IO a
-> IO a
-> IO a
catchXRun :: IO a -> IO a -> IO a
catchXRun = Errno -> IO a -> IO a -> IO a
forall a. Errno -> IO a -> IO a -> IO a
catchErrno Errno
ePIPE
showErrno :: Errno -> String
showErrno :: Errno -> String
showErrno (Errno CInt
n) = CInt -> String
forall a. Show a => a -> String
P.show CInt
n
show :: T -> String
show :: T -> String
show T
e =
T -> String
location T
e String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++
T -> String
description T
e String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Errno -> String
showErrno (T -> Errno
code T
e) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
rethrow :: IO a -> IO a
rethrow :: IO a -> IO a
rethrow IO a
x =
IO a -> (T -> IO a) -> IO a
forall a. IO a -> (T -> IO a) -> IO a
catch IO a
x ((T -> IO a) -> IO a) -> (T -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \T
e ->
IOError -> IO a
forall a. IOError -> IO a
ioError (String -> Errno -> Maybe Handle -> Maybe String -> IOError
errnoToIOError (T -> String
location T
e)
(T -> Errno
code T
e) Maybe Handle
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing)
strerror :: Errno -> IO String
strerror :: Errno -> IO String
strerror Errno
x = CString -> IO String
peekCString (CString -> IO String) -> IO CString -> IO String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Errno -> IO CString
snd_strerror Errno
x
foreign import ccall "alsa/asoundlib.h snd_strerror"
snd_strerror :: Errno -> IO CString