{-# LINE 1 "src/Sound/ALSA/Sequencer/Marshal/Client.hsc" #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Sound.ALSA.Sequencer.Marshal.Client where
import qualified Sound.ALSA.Sequencer.Utility as U
import qualified Foreign.C.Types as C
import qualified Data.Word as Word
import Foreign.Storable (Storable, )
newtype T =
Cons Word.Word8
{-# LINE 38 "src/Sound/ALSA/Sequencer/Marshal/Client.hsc" #-}
deriving (Eq, Ord, Storable)
instance Show T where
showsPrec :: Int -> T -> ShowS
showsPrec Int
prec (Cons Word8
x) =
Int -> String -> [ShowS] -> ShowS
U.showsRecord Int
prec String
"Client" [forall a. Show a => a -> ShowS
U.showsField Word8
x]
system :: T
system :: T
system = Word8 -> T
Cons Word8
0
subscribers :: T
subscribers :: T
subscribers = Word8 -> T
Cons Word8
254
broadcast :: T
broadcast :: T
broadcast = Word8 -> T
Cons Word8
255
unknown :: T
unknown :: T
unknown = Word8 -> T
Cons Word8
253
{-# LINE 51 "src/Sound/ALSA/Sequencer/Marshal/Client.hsc" #-}
exp :: T -> C.CInt
exp :: T -> CInt
exp (Cons Word8
c) = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
c
imp :: C.CInt -> T
imp :: CInt -> T
imp CInt
p = Word8 -> T
Cons (forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
p)
data Type = User | Kernel
impType :: C.CInt -> Type
impType :: CInt -> Type
impType CInt
x =
if CInt
x forall a. Eq a => a -> a -> Bool
== CInt
1
{-# LINE 66 "src/Sound/ALSA/Sequencer/Marshal/Client.hsc" #-}
then Type
User
else Type
Kernel