Event.hsc

--------------------------------------------------------------------------------
-- |
-- Module    : Sound.ALSA.Sequencer.Marshal.Event
-- 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.Event where

#include <alsa/asoundlib.h>

import qualified Sound.ALSA.Sequencer.Marshal.Address as Addr
import qualified Sound.ALSA.Sequencer.Marshal.Queue as Queue
import qualified Sound.ALSA.Sequencer.Marshal.RealTime as RealTime

import Foreign.C.Types (CUInt, )
import Foreign.Storable
          (Storable, sizeOf, alignment, peek, poke, pokeByteOff, peekByteOff, )
import Foreign.Ptr (Ptr, castPtr, nullPtr, plusPtr, )
import Foreign.Marshal.Alloc (alloca, )
import Data.Bits ((.|.), (.&.), )
import Data.Int (Int16, Int32, )
import Data.Word (Word8, Word16, Word32, )
import Data.Array (Array, (!), accumArray, )


data Connect = Connect
   { connSource :: !Addr.T
   , connDest   :: !Addr.T
   } deriving (Show,Eq,Ord)

instance Storable Connect where
  sizeOf _    = #size snd_seq_connect_t
  alignment _ = 4 -- XXX
  peek p      = do s <- #{peek snd_seq_connect_t, sender} p
                   d <- #{peek snd_seq_connect_t, dest} p
                   return Connect { connSource = s, connDest = d }
  poke p v    = #{poke snd_seq_connect_t, sender} p (connSource v)
             >> #{poke snd_seq_connect_t, dest}   p (connDest v)


data TimeStamp      = TickTime !Word32
                    | RealTime !RealTime.T
                      deriving Show

peekTimestamp :: Word8 -> Ptr TimeStamp -> IO TimeStamp
peekTimestamp flags p =
  case flags .&. #{const SND_SEQ_TIME_STAMP_MASK} of
    { #{const SND_SEQ_TIME_STAMP_TICK} -> TickTime `fmap` peek (castPtr p)
    ; _                                -> RealTime `fmap` peek (castPtr p)
    }

pokeTimestamp :: Ptr TimeStamp -> TimeStamp -> IO Word8
pokeTimestamp p ts = case ts of
  TickTime t -> poke (castPtr p) t >> return #{const SND_SEQ_TIME_STAMP_TICK}
  RealTime t -> poke (castPtr p) t >> return #{const SND_SEQ_TIME_STAMP_REAL}



newtype InstrCluster = InstrCluster CUInt
  deriving (Show,Eq,Ord,Num,Enum,Storable)

data Instr = Instr
   { instrCluster :: !InstrCluster
    -- XXX: perhaps use Sample?
   , instrStd     :: !Word32
   , instrBank    :: !Word16
   , instrPrg     :: !Word16
   } deriving (Show)

{-
instance Storable Instr where
  sizeOf _    = #{size snd_seq_instr_t}
  alignment _ = 4 -- XXX
  peek p      = do cl <- #{peek snd_seq_instr_t, cluster} p
                   st <- #{peek snd_seq_instr_t, std} p
                   ba <- #{peek snd_seq_instr_t, bank} p
                   pr <- #{peek snd_seq_instr_t, prg} p
                   return Instr { instr_cluster = cl
                                , instr_std     = st
                                , instr_bank    = ba
                                , instr_prg     = pr
                                }
  poke p v    = #{poke snd_seq_instr_t, cluster} p (instr_cluster v)
             >> #{poke snd_seq_instr_t, std}     p (instr_std v)
             >> #{poke snd_seq_instr_t, bank}    p (instr_bank v)
             >> #{poke snd_seq_instr_t, prg}     p (instr_prg v)
-}


data Note = Note
   { noteChannel      :: !Word8
   , noteNote         :: !Word8
   , noteVelocity     :: !Word8
   , noteOffVelocity  :: !Word8
   , noteDuration     :: !Word32
   } deriving (Show)


instance Storable Note where
  sizeOf _    = #{size snd_seq_ev_note_t}
  alignment _ = 4 -- XXX
  peek p      = do c  <- #{peek snd_seq_ev_note_t, channel} p
                   n  <- #{peek snd_seq_ev_note_t, note} p
                   v  <- #{peek snd_seq_ev_note_t, velocity} p
                   ov <- #{peek snd_seq_ev_note_t, off_velocity} p
                   d  <- #{peek snd_seq_ev_note_t, duration} p
                   return Note { noteChannel = c
                               , noteNote = n
                               , noteVelocity = v
                               , noteOffVelocity = ov
                               , noteDuration = d
                               }
  poke p v    = #{poke snd_seq_ev_note_t, channel}      p (noteChannel v)
             >> #{poke snd_seq_ev_note_t, note}         p (noteNote v)
             >> #{poke snd_seq_ev_note_t, velocity}     p (noteVelocity v)
             >> #{poke snd_seq_ev_note_t, off_velocity} p (noteOffVelocity v)
             >> #{poke snd_seq_ev_note_t, duration}     p (noteDuration v)


data Ctrl = Ctrl
   { ctrlChannel  :: !Word8
   , ctrlParam    :: !Word32
   , ctrlValue    :: !Int32
   } deriving (Show)

instance Storable Ctrl where
  sizeOf _    = #{size snd_seq_ev_ctrl_t}
  alignment _ = 4 -- XXX
  peek p      = do ct <- #{peek snd_seq_ev_ctrl_t, channel} p
                   pa <- #{peek snd_seq_ev_ctrl_t, param} p
                   va <- #{peek snd_seq_ev_ctrl_t, value} p
                   return Ctrl { ctrlChannel = ct
                               , ctrlParam   = pa
                               , ctrlValue   = va
                               }
  poke p v    = #{poke snd_seq_ev_ctrl_t, channel} p (ctrlChannel v)
             >> #{poke snd_seq_ev_ctrl_t, param}   p (ctrlParam v)
             >> #{poke snd_seq_ev_ctrl_t, value}   p (ctrlValue v)



data Sample = Sample
   { sampleStd  :: !Word32
   , sampleBank :: !Word16
   , samplePrg  :: !Word16
   } deriving (Show)

{-
instance Storable Sample where
  sizeOf _    = #{size snd_seq_ev_sample_t}
  alignment _ = 4 -- XXX
  peek p      = do st <- #{peek snd_seq_ev_sample_t, std} p
                   ba <- #{peek snd_seq_ev_sample_t, bank} p
                   pr <- #{peek snd_seq_ev_sample_t, prg} p
                   return Sample { sample_std     = st
                                 , sample_bank    = ba
                                 , sample_prg     = pr
                                 }
  poke p v    = #{poke snd_seq_ev_sample_t, std}     p (sampleStd v)
             >> #{poke snd_seq_ev_sample_t, bank}    p (sampleBank v)
             >> #{poke snd_seq_ev_sample_t, prg}     p (samplePrg v)
-}


newtype Cluster = Cluster
   { clusterCluster :: InstrCluster
   } deriving (Show, Eq, Storable)


-- | These are all 14 bit values.
data Volume = Volume
   { volumeVolume  :: !Int16
   , volumeLR      :: !Int16
   , volumeFR      :: !Int16
   , volumeDU      :: !Int16
   } deriving (Show)

{-
instance Storable Volume where
  sizeOf _    = #{size snd_seq_ev_volume_t}
  alignment _ = 4 -- XXX
  peek p      = do v <- #{peek snd_seq_ev_volume_t, volume} p
                   l <- #{peek snd_seq_ev_volume_t, lr} p
                   f <- #{peek snd_seq_ev_volume_t, fr} p
                   d <- #{peek snd_seq_ev_volume_t, du} p
                   return Volume { volume_volume  = v
                                 , volume_lr      = l
                                 , volume_fr      = f
                                 , volume_du      = d
                                 }
  poke p v    = #{poke snd_seq_ev_volume_t, volume} p (volumeVolume v)
             >> #{poke snd_seq_ev_volume_t, lr}     p (volumeLR v)
             >> #{poke snd_seq_ev_volume_t, fr}     p (volumeFR v)
             >> #{poke snd_seq_ev_volume_t, du}     p (volumeDU v)
-}


data Custom = Custom { custom0, custom1, custom2 :: !Word32 }
                      deriving (Show)

instance Storable Custom where
  sizeOf _    = #{size snd_seq_ev_raw32_t}
  alignment _ = 4 -- XXX
  peek p      = do d0 <- #{peek snd_seq_ev_raw32_t, d[0]} p
                   d1 <- #{peek snd_seq_ev_raw32_t, d[1]} p
                   d2 <- #{peek snd_seq_ev_raw32_t, d[2]} p
                   return Custom { custom0 = d0
                                 , custom1 = d1
                                 , custom2 = d2
                                 }
  poke p v    = #{poke snd_seq_ev_raw32_t, d[0]} p (custom0 v)
             >> #{poke snd_seq_ev_raw32_t, d[1]} p (custom1 v)
             >> #{poke snd_seq_ev_raw32_t, d[2]} p (custom2 v)



data T = Cons
   { highPriority   :: !Bool
   , tag            :: !Word8
   , queue          :: !Queue.T
   , timestamp      :: !TimeStamp
   , source         :: !Addr.T
   , dest           :: !Addr.T
   , body           :: !Data
   } deriving Show

instance Storable T where
  sizeOf _    = #{size snd_seq_event_t}
  alignment _ = 4 -- XXX
  peek p =
    do ty    <- #{peek snd_seq_event_t, type} p
       flags <- #{peek snd_seq_event_t, flags} p
       tg    <- #{peek snd_seq_event_t, tag} p
       q     <- #{peek snd_seq_event_t, queue} p
       time  <- peekTimestamp flags (#{ptr snd_seq_event_t, time} p)
       src   <- #{peek snd_seq_event_t, source} p
       dst   <- #{peek snd_seq_event_t, dest} p
       d     <- (peekData ! ty) (#{ptr snd_seq_event_t, data} p)
       return Cons
         { highPriority = (flags .&. #{const SND_SEQ_PRIORITY_MASK}) /= 0
         , tag = tg
         , queue = q
         , timestamp = time
         , source = src
         , dest = dst
         , body = d
         }
  poke p e = do
    { ty <- pokeData (#{ptr snd_seq_event_t, data} p) (body e)
    ; #{poke snd_seq_event_t, type} p ty
    ; #{poke snd_seq_event_t, tag} p (tag e)
    ; #{poke snd_seq_event_t, queue} p (queue e)
    ; real <- pokeTimestamp (#{ptr snd_seq_event_t, time} p) (timestamp e)
    ; #{poke snd_seq_event_t, source} p (source e)
    ; #{poke snd_seq_event_t, dest} p (dest e)
    ; let flags = (if highPriority e
                     then #{const SND_SEQ_PRIORITY_HIGH}
                     else #{const SND_SEQ_PRIORITY_NORMAL})
               .|. real
               .|. #{const SND_SEQ_EVENT_LENGTH_FIXED}  -- XXX
    ; #{poke snd_seq_event_t, flags} p flags
    }

allocaEv :: T -> (Ptr T -> IO a) -> IO a
allocaEv e h = alloca (\p -> poke p e >> h p)

allocaMaybeEv :: Maybe T -> (Ptr T -> IO a) -> IO a
allocaMaybeEv me h =
  maybe (h nullPtr) (\e -> allocaEv e h) me

pokeData :: Ptr Data -> Data -> IO Word8
pokeData p dt = case dt of
  NoteEv e d  -> poke (castPtr p) d >> return (expNoteEv e)
  CtrlEv e d  -> poke (castPtr p) d >> return (expCtrlEv e)
  AddrEv e d  -> poke (castPtr p) d >> return (expAddrEv e)
  ConnEv e d  -> poke (castPtr p) d >> return (expConnEv e)
  CustomEv e d -> poke (castPtr p) d >> return (expCustomEv e)
  EmptyEv e   -> return (expEmptyEv e)


peekData :: Array Word8 (Ptr Data -> IO Data)
peekData = accumArray (const id) unknown (0,255)
  [ -- result events (2)
    (#{const SND_SEQ_EVENT_SYSTEM}, unknown)
  , (#{const SND_SEQ_EVENT_RESULT}, unknown)

    -- note events (4)
  , (#{const SND_SEQ_EVENT_NOTE},     peekNoteEv ANote)
  , (#{const SND_SEQ_EVENT_NOTEON},   peekNoteEv NoteOn)
  , (#{const SND_SEQ_EVENT_NOTEOFF},  peekNoteEv NoteOff)
  , (#{const SND_SEQ_EVENT_KEYPRESS}, peekNoteEv KeyPress)

    -- control events (12)
  , (#{const SND_SEQ_EVENT_CONTROLLER},  peekCtrlEv Controller)
  , (#{const SND_SEQ_EVENT_PGMCHANGE},   peekCtrlEv PgmChange)
  , (#{const SND_SEQ_EVENT_CHANPRESS},   peekCtrlEv ChanPress)
  , (#{const SND_SEQ_EVENT_PITCHBEND},   peekCtrlEv PitchBend)
  , (#{const SND_SEQ_EVENT_CONTROL14},   peekCtrlEv Control14)
  , (#{const SND_SEQ_EVENT_NONREGPARAM}, peekCtrlEv NonRegParam)
  , (#{const SND_SEQ_EVENT_REGPARAM},    peekCtrlEv RegParam)
  , (#{const SND_SEQ_EVENT_SONGPOS},     peekCtrlEv SongPos)
  , (#{const SND_SEQ_EVENT_SONGSEL},     peekCtrlEv SongSel)
  , (#{const SND_SEQ_EVENT_QFRAME},      peekCtrlEv QFrame)
  , (#{const SND_SEQ_EVENT_TIMESIGN},    peekCtrlEv TimeSign)
  , (#{const SND_SEQ_EVENT_KEYSIGN},     peekCtrlEv KeySign)

  -- queue control (10)
  , (#{const SND_SEQ_EVENT_START}, unknown)
  , (#{const SND_SEQ_EVENT_CONTINUE}, unknown)
  , (#{const SND_SEQ_EVENT_STOP}, unknown)
  , (#{const SND_SEQ_EVENT_SETPOS_TICK}, unknown)
  , (#{const SND_SEQ_EVENT_SETPOS_TIME}, unknown)
  , (#{const SND_SEQ_EVENT_TEMPO}, unknown)
  , (#{const SND_SEQ_EVENT_CLOCK}, unknown)
  , (#{const SND_SEQ_EVENT_TICK}, unknown)
  , (#{const SND_SEQ_EVENT_QUEUE_SKEW}, unknown)
  , (#{const SND_SEQ_EVENT_SYNC_POS}, unknown)

  -- misc (3)
  , (#{const SND_SEQ_EVENT_TUNE_REQUEST}, peekEmptyEv TuneRequest)
  , (#{const SND_SEQ_EVENT_RESET},        peekEmptyEv Reset)
  , (#{const SND_SEQ_EVENT_SENSING},      peekEmptyEv Sensing)

  , (#{const SND_SEQ_EVENT_ECHO}, peekCustomEv Echo)
  , (#{const SND_SEQ_EVENT_OSS},  peekCustomEv OSS)

  -- networking (8)
  , (#{const SND_SEQ_EVENT_CLIENT_START},  peekAddrEv ClientStart)
  , (#{const SND_SEQ_EVENT_CLIENT_EXIT},   peekAddrEv ClientExit)
  , (#{const SND_SEQ_EVENT_CLIENT_CHANGE}, peekAddrEv ClientChange)
  , (#{const SND_SEQ_EVENT_PORT_START},    peekAddrEv PortStart)
  , (#{const SND_SEQ_EVENT_PORT_EXIT},     peekAddrEv PortExit)
  , (#{const SND_SEQ_EVENT_PORT_CHANGE},   peekAddrEv PortChange)
  , (#{const SND_SEQ_EVENT_PORT_SUBSCRIBED},   peekConnEv PortSubscribed)
  , (#{const SND_SEQ_EVENT_PORT_UNSUBSCRIBED}, peekConnEv PortUnsubscribed)

{-
  , (#{const SND_SEQ_EVENT_SAMPLE}, unknown)
  , (#{const SND_SEQ_EVENT_SAMPLE_CLUSTER}, unknown)
  , (#{const SND_SEQ_EVENT_SAMPLE_START}, unknown)
  , (#{const SND_SEQ_EVENT_SAMPLE_STOP}, unknown)
  , (#{const SND_SEQ_EVENT_SAMPLE_FREQ}, unknown)
  , (#{const SND_SEQ_EVENT_SAMPLE_VOLUME}, unknown)
  , (#{const SND_SEQ_EVENT_SAMPLE_LOOP}, unknown)
  , (#{const SND_SEQ_EVENT_SAMPLE_POSITION}, unknown)
  , (#{const SND_SEQ_EVENT_SAMPLE_PRIVATE1}, unknown)
-}
  , (#{const SND_SEQ_EVENT_USR0}, peekCustomEv User0)
  , (#{const SND_SEQ_EVENT_USR1}, peekCustomEv User1)
  , (#{const SND_SEQ_EVENT_USR2}, peekCustomEv User2)
  , (#{const SND_SEQ_EVENT_USR3}, peekCustomEv User3)
  , (#{const SND_SEQ_EVENT_USR4}, peekCustomEv User4)
  , (#{const SND_SEQ_EVENT_USR5}, peekCustomEv User5)
  , (#{const SND_SEQ_EVENT_USR6}, peekCustomEv User6)
  , (#{const SND_SEQ_EVENT_USR7}, peekCustomEv User7)
  , (#{const SND_SEQ_EVENT_USR8}, peekCustomEv User8)
  , (#{const SND_SEQ_EVENT_USR9}, peekCustomEv User9)

{-
  , (#{const SND_SEQ_EVENT_INSTR_BEGIN}, unknown)
  , (#{const SND_SEQ_EVENT_INSTR_END}, unknown)
  , (#{const SND_SEQ_EVENT_INSTR_INFO}, unknown)
  , (#{const SND_SEQ_EVENT_INSTR_INFO_RESULT}, unknown)
  , (#{const SND_SEQ_EVENT_INSTR_FINFO}, unknown)
  , (#{const SND_SEQ_EVENT_INSTR_FINFO_RESULT}, unknown)
  , (#{const SND_SEQ_EVENT_INSTR_RESET}, unknown)
  , (#{const SND_SEQ_EVENT_INSTR_STATUS}, unknown)
  , (#{const SND_SEQ_EVENT_INSTR_STATUS_RESULT}, unknown)
  , (#{const SND_SEQ_EVENT_INSTR_PUT}, unknown)
  , (#{const SND_SEQ_EVENT_INSTR_GET}, unknown)
  , (#{const SND_SEQ_EVENT_INSTR_GET_RESULT}, unknown)
  , (#{const SND_SEQ_EVENT_INSTR_FREE}, unknown)
  , (#{const SND_SEQ_EVENT_INSTR_LIST}, unknown)
  , (#{const SND_SEQ_EVENT_INSTR_LIST_RESULT}, unknown)
  , (#{const SND_SEQ_EVENT_INSTR_CLUSTER}, unknown)
  , (#{const SND_SEQ_EVENT_INSTR_CLUSTER_GET}, unknown)
  , (#{const SND_SEQ_EVENT_INSTR_CLUSTER_RESULT}, unknown)
  , (#{const SND_SEQ_EVENT_INSTR_CHANGE}, unknown)
-}

  , (#{const SND_SEQ_EVENT_SYSEX}, unknown)
  , (#{const SND_SEQ_EVENT_BOUNCE}, unknown)

  , (#{const SND_SEQ_EVENT_USR_VAR0}, unknown)
  , (#{const SND_SEQ_EVENT_USR_VAR1}, unknown)
  , (#{const SND_SEQ_EVENT_USR_VAR2}, unknown)
  , (#{const SND_SEQ_EVENT_USR_VAR3}, unknown)
  , (#{const SND_SEQ_EVENT_USR_VAR3}, unknown)

  , (#{const SND_SEQ_EVENT_NONE}, peekEmptyEv None)
  ]

  where unknown = peekEmptyEv Unknown


data NoteEv   = ANote | NoteOn | NoteOff | KeyPress
                deriving Show

data CtrlEv   = Controller | PgmChange | ChanPress
              | PitchBend | Control14
              | NonRegParam | RegParam
              | SongPos | SongSel
              | QFrame
              | TimeSign | KeySign
                deriving Show

data QueueEv  = QueueStart
              | QueueContinue
              | QueueStop
              | QueueSetPosTick
              | QueueSetPosTime
              | QueueTempo
              | QueueClock
              | QueueTick
              | QueueSkew
              | QueueSyncPos
                deriving Show

data EmptyEv  = TuneRequest | Reset | Sensing | None | Unknown
                deriving Show

data CustomEv = Echo | OSS
              | User0 | User1 | User2 | User3 | User4
              | User5 | User6 | User7 | User8 | User9
                deriving Show

data AddrEv   = ClientStart | ClientExit | ClientChange
              | PortStart | PortExit | PortChange
                deriving Show

data ConnEv   = PortSubscribed | PortUnsubscribed
                deriving Show


expNoteEv :: NoteEv -> Word8
expNoteEv e = case e of
  ANote    -> #{const SND_SEQ_EVENT_NOTE}
  NoteOn   -> #{const SND_SEQ_EVENT_NOTEON}
  NoteOff  -> #{const SND_SEQ_EVENT_NOTEOFF}
  KeyPress -> #{const SND_SEQ_EVENT_KEYPRESS}

expCtrlEv :: CtrlEv -> Word8
expCtrlEv e = case e of
  Controller  -> #{const SND_SEQ_EVENT_CONTROLLER}
  PgmChange   -> #{const SND_SEQ_EVENT_PGMCHANGE}
  ChanPress   -> #{const SND_SEQ_EVENT_CHANPRESS}
  PitchBend   -> #{const SND_SEQ_EVENT_PITCHBEND}
  Control14   -> #{const SND_SEQ_EVENT_CONTROL14}
  NonRegParam -> #{const SND_SEQ_EVENT_NONREGPARAM}
  RegParam    -> #{const SND_SEQ_EVENT_REGPARAM}
  SongPos     -> #{const SND_SEQ_EVENT_SONGPOS}
  SongSel     -> #{const SND_SEQ_EVENT_SONGSEL}
  QFrame      -> #{const SND_SEQ_EVENT_QFRAME}
  TimeSign    -> #{const SND_SEQ_EVENT_TIMESIGN}
  KeySign     -> #{const SND_SEQ_EVENT_KEYSIGN}

expQueueEv :: QueueEv -> Word8
expQueueEv e = case e of
  QueueStart      -> #{const SND_SEQ_EVENT_START}
  QueueContinue   -> #{const SND_SEQ_EVENT_CONTINUE}
  QueueStop       -> #{const SND_SEQ_EVENT_STOP}
  QueueSetPosTick -> #{const SND_SEQ_EVENT_SETPOS_TICK}
  QueueSetPosTime -> #{const SND_SEQ_EVENT_SETPOS_TIME}
  QueueTempo      -> #{const SND_SEQ_EVENT_TEMPO}
  QueueClock      -> #{const SND_SEQ_EVENT_CLOCK}
  QueueTick       -> #{const SND_SEQ_EVENT_TICK}
  QueueSkew       -> #{const SND_SEQ_EVENT_QUEUE_SKEW}
  QueueSyncPos    -> #{const SND_SEQ_EVENT_SYNC_POS}

expEmptyEv :: EmptyEv -> Word8
expEmptyEv e = case e of
  TuneRequest -> #{const SND_SEQ_EVENT_TUNE_REQUEST}
  Reset       -> #{const SND_SEQ_EVENT_RESET}
  Sensing     -> #{const SND_SEQ_EVENT_SENSING}
  None        -> #{const SND_SEQ_EVENT_NONE}
  Unknown     -> #{const SND_SEQ_EVENT_NONE}

expCustomEv :: CustomEv -> Word8
expCustomEv e = case e of
  Echo  -> #{const SND_SEQ_EVENT_ECHO}
  OSS   -> #{const SND_SEQ_EVENT_OSS}
  User0 -> #{const SND_SEQ_EVENT_USR0}
  User1 -> #{const SND_SEQ_EVENT_USR1}
  User2 -> #{const SND_SEQ_EVENT_USR2}
  User3 -> #{const SND_SEQ_EVENT_USR3}
  User4 -> #{const SND_SEQ_EVENT_USR4}
  User5 -> #{const SND_SEQ_EVENT_USR5}
  User6 -> #{const SND_SEQ_EVENT_USR6}
  User7 -> #{const SND_SEQ_EVENT_USR7}
  User8 -> #{const SND_SEQ_EVENT_USR8}
  User9 -> #{const SND_SEQ_EVENT_USR9}

expAddrEv :: AddrEv -> Word8
expAddrEv e = case e of
    ClientStart -> #{const SND_SEQ_EVENT_CLIENT_START}
    ClientExit -> #{const SND_SEQ_EVENT_CLIENT_EXIT}
    ClientChange -> #{const SND_SEQ_EVENT_CLIENT_CHANGE}
    PortStart -> #{const SND_SEQ_EVENT_PORT_START}
    PortExit -> #{const SND_SEQ_EVENT_PORT_EXIT}
    PortChange -> #{const SND_SEQ_EVENT_PORT_CHANGE}

expConnEv :: ConnEv -> Word8
expConnEv e = case e of
  PortSubscribed   -> #{const SND_SEQ_EVENT_PORT_SUBSCRIBED}
  PortUnsubscribed -> #{const SND_SEQ_EVENT_PORT_UNSUBSCRIBED}


peekNoteEv :: NoteEv -> Ptr Data -> IO Data
peekNoteEv e p = NoteEv e `fmap` peek (castPtr p)

peekCtrlEv :: CtrlEv -> Ptr Data -> IO Data
peekCtrlEv e p = CtrlEv e `fmap` peek (castPtr p)

peekAddrEv :: AddrEv -> Ptr Data -> IO Data
peekAddrEv e p = AddrEv e `fmap` peek (castPtr p)

peekConnEv :: ConnEv -> Ptr Data -> IO Data
peekConnEv e p = ConnEv e `fmap` peek (castPtr p)

peekEmptyEv :: EmptyEv -> Ptr Data -> IO Data
peekEmptyEv e _ = return (EmptyEv e)

peekCustomEv :: CustomEv -> Ptr Data -> IO Data
peekCustomEv e p = CustomEv e `fmap` peek (castPtr p)


data Data
  = NoteEv NoteEv Note
  | CtrlEv CtrlEv Ctrl
  | AddrEv AddrEv Addr.T
  | ConnEv ConnEv Connect
  | EmptyEv EmptyEv
  | CustomEv CustomEv Custom
    deriving Show