{-# LINE 1 "src/Sound/ALSA/Sequencer/Marshal/Sequencer.hsc" #-}
--------------------------------------------------------------------------------
{-# LINE 2 "src/Sound/ALSA/Sequencer/Marshal/Sequencer.hsc" #-}
-- |
-- Module    : Sound.ALSA.Sequencer.Marshal.Sequencer
-- Copyright : (c) Henning Thielemann, 2010
--             (c) Iavor S. Diatchki, 2007
-- License   : BSD3
--
-- Maintainer: Henning Thielemann
-- Stability : provisional
--
-- PRIVATE MODULE.
--
-- Here we have the various types used by the library,
-- and how they are imported\/exported to C.
--
-- NOTE: In the translations bellow we make the following assumptions
-- about the sizes of C types.
-- CChar  = 8 bits
-- CShort = 16 bit
-- CInt   = 32 bits
--------------------------------------------------------------------------------

module Sound.ALSA.Sequencer.Marshal.Sequencer where


{-# LINE 26 "src/Sound/ALSA/Sequencer/Marshal/Sequencer.hsc" #-}
import Foreign.C.Types (CInt, )
import Foreign.Ptr (Ptr, )


-- | Read\/Write permissions for the sequencer device.
-- This way we prevent the ALSA exception 22 "Invalid argument"
-- when calling @event_output@ on an input-only sequencer.
class OpenMode mode where expOpenMode :: mode -> CInt

class OpenMode mode => AllowInput  mode where
class OpenMode mode => AllowOutput mode where

data OutputMode = OutputMode deriving (Show)
data InputMode  = InputMode  deriving (Show)
data DuplexMode = DuplexMode deriving (Show)

instance OpenMode OutputMode where expOpenMode _ = 1
{-# LINE 43 "src/Sound/ALSA/Sequencer/Marshal/Sequencer.hsc" #-}
instance OpenMode InputMode  where expOpenMode _ = 2
{-# LINE 44 "src/Sound/ALSA/Sequencer/Marshal/Sequencer.hsc" #-}
instance OpenMode DuplexMode where expOpenMode _ = 3
{-# LINE 45 "src/Sound/ALSA/Sequencer/Marshal/Sequencer.hsc" #-}

instance AllowOutput OutputMode where
instance AllowOutput DuplexMode where
instance AllowInput  InputMode  where
instance AllowInput  DuplexMode where


-- | Blocking behavior of the sequencer device.
data BlockMode      = Block     -- ^ Operations may block.
                    | Nonblock  -- ^ Throw exceptions instead of blocking.
                      deriving (Show,Eq)

expBlockMode      :: BlockMode -> CInt
expBlockMode x     = case x of
  Block     -> 0
  Nonblock  -> 1
{-# LINE 61 "src/Sound/ALSA/Sequencer/Marshal/Sequencer.hsc" #-}


-- | The type of sequencer handles.
newtype T mode = Cons (Ptr Core) deriving Eq
data Core