    {-# LANGUAGE ForeignFunctionInterface #-}
    {-# LANGUAGE DeriveDataTypeable #-}
    {- |
    ALSA does not distinguish between programming errors and runtime exceptions,
    which is sad, but we have to cope with it.
    -}
    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 :: forall a. Integral a => 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 a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    r

    checkResult_ :: Integral a => String -> a -> IO ()
    checkResult_ :: forall a. Integral a => 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 a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    checkResultMaybe :: String -> (C.CInt -> a) -> (C.CInt -> Maybe a) -> C.CInt -> IO a
    checkResultMaybe :: forall a.
    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 a. 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 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 :: forall a. String -> Errno -> IO a
    throw String
    fun Errno
    err = do
       d <- Errno -> IO String
    strerror Errno
    err
       Exc.throw Cons
         { location = fun
         , description = d
         , code = err
         }

    catch :: IO a -> (T -> IO a) -> IO a
    catch :: forall a. 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 -- ^ Action
       -> IO a -- ^ Handler
       -> IO a
    catchErrno :: forall a. 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. (HasCallStack, Exception e) => e -> a
    Exc.throw T
    ex)

    catchXRun ::
          IO a -- ^ Action
       -> IO a -- ^ Handler
       -> IO a
    catchXRun :: forall a. 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
    ")"

    -- | Converts any 'AlsaException.T' into an 'IOError'.
    -- This produces better a error message than letting an uncaught
    -- 'AlsaException.T' propagate to the top.
    rethrow :: IO a -> IO a
    rethrow :: forall a. 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)

    -- | Returns the message for an error code.
    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