{-# LANGUAGE ForeignFunctionInterface #-}
module Sound.ALSA.Sequencer.Poll
  ( descriptors
  ) where

import qualified Sound.ALSA.Sequencer.Marshal.Sequencer as Seq
import qualified System.Posix.Poll as Poll

import qualified Foreign.C.Types as C
import Foreign.Marshal.Array (peekArray, allocaArray, )
import Foreign.Ptr (Ptr, )

-- expose EnumSet.Cons for foreign call
import qualified Data.EnumBitSet as EnumSet

_dummyEnumSet :: EnumSet.T Int Bool
_dummyEnumSet :: T Int Bool
_dummyEnumSet = forall a. HasCallStack => a
undefined


descriptors :: Seq.T mode -> Poll.Events -> IO [Poll.Fd]
descriptors :: forall mode. T mode -> Events -> IO [Fd]
descriptors (Seq.Cons Ptr Core
h) Events
e = do
  CInt
n <- Ptr Core -> Events -> IO CInt
snd_seq_poll_descriptors_count Ptr Core
h Events
e
  forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray (forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
n) forall a b. (a -> b) -> a -> b
$ \Ptr Fd
p ->
    forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Ptr Fd
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr Core -> Ptr Fd -> CInt -> Events -> IO CInt
snd_seq_poll_descriptors Ptr Core
h Ptr Fd
p CInt
n Events
e

foreign import ccall unsafe "alsa/asoundlib.h snd_seq_poll_descriptors_count"
  snd_seq_poll_descriptors_count :: Ptr Seq.Core -> Poll.Events -> IO C.CInt

foreign import ccall unsafe "alsa/asoundlib.h snd_seq_poll_descriptors"
  snd_seq_poll_descriptors :: Ptr Seq.Core -> Ptr Poll.Fd -> C.CInt -> Poll.Events -> IO C.CInt