module Sound.ALSA.Sequencer.Utility where

import qualified Sound.ALSA.Exception as Exc

import qualified Foreign.C.Types as C
import Foreign.C.Error (Errno(Errno), eNOENT, )

import Data.Maybe.HT (toMaybe, )


showsField :: Show a => a -> ShowS
showsField :: forall a. Show a => a -> ShowS
showsField = forall a. Show a => Int -> a -> ShowS
showsPrec Int
11

showsRecord :: Int -> String -> [ShowS] -> ShowS
showsRecord :: Int -> String -> [ShowS] -> ShowS
showsRecord Int
prec String
name [ShowS]
fields =
   Bool -> ShowS -> ShowS
showParen (Int
prec forall a. Ord a => a -> a -> Bool
>= Int
10) forall a b. (a -> b) -> a -> b
$
   String -> ShowS
showString String
name forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
".Cons" forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) forall a. a -> a
id (forall a b. (a -> b) -> [a] -> [b]
map (\ShowS
f -> Char -> ShowS
showChar Char
' ' forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
f) [ShowS]
fields)

-- might be moved to Sound.ALSA.Exception
checkResultQuery :: String -> C.CInt -> IO Bool
checkResultQuery :: String -> CInt -> IO Bool
checkResultQuery String
name =
   forall a.
String -> (CInt -> a) -> (CInt -> Maybe a) -> CInt -> IO a
Exc.checkResultMaybe String
name
      (forall a b. a -> b -> a
const Bool
True)
      (\CInt
e -> forall a. Bool -> a -> Maybe a
toMaybe (CInt -> Errno
Errno (forall a. Num a => a -> a
negate CInt
e) forall a. Eq a => a -> a -> Bool
== Errno
eNOENT) Bool
False)