{-# LINE 1 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
--------------------------------------------------------------------------------
{-# LINE 2 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
-- |
-- Module    : Sound.ALSA.Sequencer.Marshal.Event
-- Copyright : (c) Henning Thielemann, 2011-2012
--             (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.
--
-- We use Hsc for expanding C types to Haskell types like Word32.
-- However if a C type is translated to Word32
-- you should not assume that it is translated to Word32 on every platform.
-- On a 64bit machine it may well be Word64.
-- Thus you should use our wrapper types whereever possible.
--------------------------------------------------------------------------------

{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Sound.ALSA.Sequencer.Marshal.Event where


{-# LINE 27 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}

{-# LINE 28 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}

import qualified Sound.ALSA.Sequencer.Marshal.Connect as Connect
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 qualified Sound.ALSA.Sequencer.Marshal.Time as Time

import qualified Data.ByteString.Unsafe as BU
import qualified Data.ByteString as B

import qualified Foreign.Marshal.Alloc as MA
import qualified Foreign.C.Types as C
import qualified Data.Int as Int
import qualified Data.Word as Word
import Foreign.Storable
          (Storable, sizeOf, alignment, peek, poke, pokeByteOff, peekByteOff, )
import Foreign.Ptr (Ptr, castPtr, nullPtr, plusPtr, )
import Control.Monad (liftM2, )
import Data.Monoid (mappend, )
import qualified Data.FlagSet as FlagSet
import Data.Array (Ix, Array, (!), accumArray, )
import Data.Tuple.HT (mapFst, )


data Flag
type Flags     = FlagSet.T Word.Word8 Flag
{-# LINE 54 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
type FlagValue = FlagSet.MaskedValue Word.Word8 Flag
{-# LINE 55 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}

instance Time.Flag Flag where


eventLengthFixed, eventLengthVariable, eventLengthVarUser :: FlagValue
eventLengthFixed =
   FlagSet.MaskedValue
      12
{-# LINE 63 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
      0
{-# LINE 64 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
eventLengthVariable =
   FlagSet.MaskedValue
      12
{-# LINE 67 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
      4
{-# LINE 68 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
eventLengthVarUser =
   FlagSet.MaskedValue
      12
{-# LINE 71 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
      8
{-# LINE 72 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}


priorityHigh, priorityNormal :: FlagValue
priorityHigh =
   FlagSet.MaskedValue
      16
{-# LINE 78 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
      16
{-# LINE 79 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
priorityNormal =
   FlagSet.MaskedValue
      16
{-# LINE 82 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
      0
{-# LINE 83 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}



{- available in alsa-1.0.14, but gone in 1.0.22
#{newinttype "InstrCluster", snd_seq_instr_cluster_t}

#{newintfieldtype "StandardId", snd_seq_instr_t, std}
#{newintfieldtype "Bank",       snd_seq_instr_t, bank}
#{newintfieldtype "Program",    snd_seq_instr_t, prg}

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

instance Storable Instr where
  sizeOf _    = #{size snd_seq_instr_t}
  alignment _ = #{alignment snd_seq_instr_t}
  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 { instrCluster = cl
                                , instrStd     = st
                                , instrBank    = ba
                                , instrPrg     = pr
                                }
  poke p v    = #{poke snd_seq_instr_t, cluster} p (instrCluster v)
             >> #{poke snd_seq_instr_t, std}     p (instrStd v)
             >> #{poke snd_seq_instr_t, bank}    p (instrBank v)
             >> #{poke snd_seq_instr_t, prg}     p (instrPrg v)
-}


newtype Channel = Channel { unChannel :: Word.Word8 }
 deriving (Show, Eq, Ord, Ix, Storable)

{-# LINE 121 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
newtype Pitch = Pitch { unPitch :: Word.Word8 }
 deriving (Show, Eq, Ord, Ix, Storable)

{-# LINE 122 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
newtype Velocity = Velocity { unVelocity :: Word.Word8 }
 deriving (Show, Eq, Ord, Ix, Storable)

{-# LINE 123 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
newtype Duration = Duration { unDuration :: Word.Word32 }
 deriving (Show, Eq, Ord, Ix, Storable)

{-# LINE 124 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}

data Note = Note
   { noteChannel      :: !Channel
   , noteNote         :: !Pitch
   , noteVelocity     :: !Velocity
   , noteOffVelocity  :: !Velocity
   , noteDuration     :: !Duration
   } deriving (Show)


instance Storable Note where
  sizeOf _    = (8)
{-# LINE 136 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  alignment _ = (4)
{-# LINE 137 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  peek p      = do c  <- (\hsc_ptr -> peekByteOff hsc_ptr 0) p
{-# LINE 138 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
                   n  <- (\hsc_ptr -> peekByteOff hsc_ptr 1) p
{-# LINE 139 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
                   v  <- (\hsc_ptr -> peekByteOff hsc_ptr 2) p
{-# LINE 140 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
                   ov <- (\hsc_ptr -> peekByteOff hsc_ptr 3) p
{-# LINE 141 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
                   d  <- (\hsc_ptr -> peekByteOff hsc_ptr 4) p
{-# LINE 142 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
                   return Note { noteChannel = c
                               , noteNote = n
                               , noteVelocity = v
                               , noteOffVelocity = ov
                               , noteDuration = d
                               }
  poke p v    = (\hsc_ptr -> pokeByteOff hsc_ptr 0)      p (noteChannel v)
{-# LINE 149 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
             >> (\hsc_ptr -> pokeByteOff hsc_ptr 1)         p (noteNote v)
{-# LINE 150 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
             >> (\hsc_ptr -> pokeByteOff hsc_ptr 2)     p (noteVelocity v)
{-# LINE 151 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
             >> (\hsc_ptr -> pokeByteOff hsc_ptr 3) p (noteOffVelocity v)
{-# LINE 152 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
             >> (\hsc_ptr -> pokeByteOff hsc_ptr 4)     p (noteDuration v)
{-# LINE 153 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}


newtype Parameter = Parameter { unParameter :: Word.Word32 }
 deriving (Show, Eq, Ord, Ix, Storable)

{-# LINE 156 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
newtype Value = Value { unValue :: Int.Int32 }
 deriving (Show, Eq, Ord, Ix, Storable)

{-# LINE 157 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}

data Ctrl = Ctrl
   { ctrlChannel  :: !Channel
   , ctrlParam    :: !Parameter
   , ctrlValue    :: !Value
   } deriving (Show)

instance Storable Ctrl where
  sizeOf _    = (12)
{-# LINE 166 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  alignment _ = (4)
{-# LINE 167 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  peek p      = do ct <- (\hsc_ptr -> peekByteOff hsc_ptr 0) p
{-# LINE 168 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
                   pa <- (\hsc_ptr -> peekByteOff hsc_ptr 4) p
{-# LINE 169 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
                   va <- (\hsc_ptr -> peekByteOff hsc_ptr 8) p
{-# LINE 170 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
                   return Ctrl { ctrlChannel = ct
                               , ctrlParam   = pa
                               , ctrlValue   = va
                               }
  poke p v    = (\hsc_ptr -> pokeByteOff hsc_ptr 0) p (ctrlChannel v)
{-# LINE 175 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
             >> (\hsc_ptr -> pokeByteOff hsc_ptr 4)   p (ctrlParam v)
{-# LINE 176 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
             >> (\hsc_ptr -> pokeByteOff hsc_ptr 8)   p (ctrlValue v)
{-# LINE 177 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}


pokeQueue ::
  Ptr Data -> QueueEv -> Queue.T -> IO EType
pokeQueue p e q = do
  poke (castPtr p) q
  case e of
    QueueSetPosTick t -> (\hsc_ptr -> pokeByteOff hsc_ptr 4) p t
{-# LINE 185 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
    QueueSetPosTime t -> (\hsc_ptr -> pokeByteOff hsc_ptr 4) p t
{-# LINE 186 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
    QueueTempo      t -> (\hsc_ptr -> pokeByteOff hsc_ptr 4) p t
{-# LINE 187 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
    QueueSkew       s -> (\hsc_ptr -> pokeByteOff hsc_ptr 4) p s
{-# LINE 188 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
    QueueSyncPos    s -> (\hsc_ptr -> pokeByteOff hsc_ptr 4) p s
{-# LINE 189 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
    _ -> return ()
  return (expEv e)


{- available in alsa-1.0.14, but gone in 1.0.22
data Sample = Sample
   { sampleStd  :: !StandardId
   , sampleBank :: !Bank
   , samplePrg  :: !Program
   } deriving (Show)

instance Storable Sample where
  sizeOf _    = #{size snd_seq_ev_sample_t}
  alignment _ = #{alignment snd_seq_ev_sample_t}
  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 { sampleStd     = st
                                 , sampleBank    = ba
                                 , samplePrg     = 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)


#{newintfieldtype "Volume",  snd_seq_ev_volume_t, volume}
#{newintfieldtype "Balance", snd_seq_ev_volume_t, lr}

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

instance Storable VolumeControl where
  sizeOf _    = #{size snd_seq_ev_volume_t}
  alignment _ = #{alignment snd_seq_ev_volume_t}
  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 VolumeControl
                                 { volumeVolume  = v
                                 , volumeLR      = l
                                 , volumeFR      = f
                                 , volumeDU      = 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 :: ! Word.Word32
{-# LINE 254 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  } deriving (Show)

instance Storable Custom where
  sizeOf _    = (12)
{-# LINE 258 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  alignment _ = (4)
{-# LINE 259 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  peek p      = do d0 <- (\hsc_ptr -> peekByteOff hsc_ptr 0) p
{-# LINE 260 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
                   d1 <- (\hsc_ptr -> peekByteOff hsc_ptr 4) p
{-# LINE 261 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
                   d2 <- (\hsc_ptr -> peekByteOff hsc_ptr 8) p
{-# LINE 262 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
                   return Custom { custom0 = d0
                                 , custom1 = d1
                                 , custom2 = d2
                                 }
  poke p v    = (\hsc_ptr -> pokeByteOff hsc_ptr 0) p (custom0 v)
{-# LINE 267 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
             >> (\hsc_ptr -> pokeByteOff hsc_ptr 4) p (custom1 v)
{-# LINE 268 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
             >> (\hsc_ptr -> pokeByteOff hsc_ptr 8) p (custom2 v)
{-# LINE 269 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}


newtype Tag = Tag { unTag :: Word.Word8 }
 deriving (Show, Eq, Ord, Ix, Storable)

{-# LINE 272 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}

data T = Cons
   { highPriority   :: !Bool
   , tag            :: !Tag
   , queue          :: !Queue.T
   , time           :: !Time.T
   , source         :: !Addr.T
   , dest           :: !Addr.T
   , body           :: !Data
   } deriving Show

instance Storable T where
  sizeOf _    = (28)
{-# LINE 285 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  alignment _ = (4)
{-# LINE 286 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  peek p =
    do ty    <- (\hsc_ptr -> peekByteOff hsc_ptr 0) p
{-# LINE 288 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
       flags <- (\hsc_ptr -> peekByteOff hsc_ptr 1) p
{-# LINE 289 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
       tg    <- (\hsc_ptr -> peekByteOff hsc_ptr 2) p
{-# LINE 290 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
       q     <- (\hsc_ptr -> peekByteOff hsc_ptr 3) p
{-# LINE 291 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
       t     <- Time.peek flags ((\hsc_ptr -> hsc_ptr `plusPtr` 4) p)
{-# LINE 292 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
       src   <- (\hsc_ptr -> peekByteOff hsc_ptr 12) p
{-# LINE 293 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
       dst   <- (\hsc_ptr -> peekByteOff hsc_ptr 14) p
{-# LINE 294 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
       d     <- (peekData ! ty) ((\hsc_ptr -> hsc_ptr `plusPtr` 16) p)
{-# LINE 295 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
       return Cons
         { highPriority = not $ FlagSet.match flags priorityNormal
         , tag = tg
         , queue = q
         , time = t
         , source = src
         , dest = dst
         , body = d
         }
  poke p e =
    pokeHeader p e eventLengthFixed
      =<< pokeData ((\hsc_ptr -> hsc_ptr `plusPtr` 16) p) (body e)
{-# LINE 307 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}

withMaybe :: Maybe T -> (Ptr T -> IO a) -> IO a
withMaybe me f =
  maybe (f nullPtr) (flip with f) me

with :: T -> (Ptr T -> IO a) -> IO a
with ev f =
  MA.alloca $ \p ->
    case body ev of
      ExtEv e d -> do
        let lengthFlag =
              case e of
                SysEx -> eventLengthVariable
                Bounce -> eventLengthVariable
                _ -> eventLengthVarUser
        pokeHeader p ev lengthFlag (expEv e)
        BU.unsafeUseAsCString d $ \ptr -> do
          (\hsc_ptr -> pokeByteOff hsc_ptr 16) p (B.length d)
{-# LINE 325 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
          (\hsc_ptr -> pokeByteOff hsc_ptr 20) p ptr
{-# LINE 326 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
          f p
      b -> do
        pokeHeader p ev eventLengthFixed
          =<< pokeData ((\hsc_ptr -> hsc_ptr `plusPtr` 16) p) b
{-# LINE 330 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
        f p


pokeBody ::
  (Storable d, Type e) =>
  Ptr Data -> e -> d -> IO EType
pokeBody p e d =
  poke (castPtr p) d >> return (expEv e)

pokeData :: Ptr Data -> Data -> IO EType
pokeData p dt = case dt of
  NoteEv   e d -> pokeBody p e d
  CtrlEv   e d -> pokeBody p e d
  QueueEv  e d -> pokeQueue p e d
  AddrEv   e d -> pokeBody p e d
  ConnEv   e d -> pokeBody p e d
  CustomEv e d -> pokeBody p e d
  ExtEv    _ _ -> error "cannot simply poke ExtEv, because it needs allocation - use Event.with instead"
  EmptyEv  e   -> return (expEv e)

pokeHeader :: Ptr T -> T -> FlagValue -> EType -> IO ()
pokeHeader p e lengthFlag ty = do
  (\hsc_ptr -> pokeByteOff hsc_ptr 0) p ty
{-# LINE 353 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  (\hsc_ptr -> pokeByteOff hsc_ptr 2) p (tag e)
{-# LINE 354 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  (\hsc_ptr -> pokeByteOff hsc_ptr 3) p (queue e)
{-# LINE 355 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  real <- Time.poke ((\hsc_ptr -> hsc_ptr `plusPtr` 4) p) (time e)
{-# LINE 356 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  (\hsc_ptr -> pokeByteOff hsc_ptr 12) p (source e)
{-# LINE 357 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  (\hsc_ptr -> pokeByteOff hsc_ptr 14) p (dest e)
{-# LINE 358 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  let flags =
         (if highPriority e
            then priorityHigh
            else priorityNormal)
         `mappend` real
         `mappend` lengthFlag
  (\hsc_ptr -> pokeByteOff hsc_ptr 1) p (FlagSet.fromMaskedValue flags)
{-# LINE 365 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}


peekData :: Array EType (Ptr Data -> IO Data)
peekData =
  accumArray (const id) unknown (EType 0, EType 255) $
  map (mapFst EType) $
  [ -- result events (2)
    (0, unknown)
{-# LINE 373 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  , (1, unknown)
{-# LINE 374 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}

    -- note events (4)
  , (5,     peekNoteEv ANote)
{-# LINE 377 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  , (6,   peekNoteEv NoteOn)
{-# LINE 378 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  , (7,  peekNoteEv NoteOff)
{-# LINE 379 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  , (8, peekNoteEv KeyPress)
{-# LINE 380 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}

    -- control events (12)
  , (10,  peekCtrlEv Controller)
{-# LINE 383 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  , (11,   peekCtrlEv PgmChange)
{-# LINE 384 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  , (12,   peekCtrlEv ChanPress)
{-# LINE 385 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  , (13,   peekCtrlEv PitchBend)
{-# LINE 386 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  , (14,   peekCtrlEv Control14)
{-# LINE 387 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  , (15, peekCtrlEv NonRegParam)
{-# LINE 388 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  , (16,    peekCtrlEv RegParam)
{-# LINE 389 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  , (20,     peekCtrlEv SongPos)
{-# LINE 390 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  , (21,     peekCtrlEv SongSel)
{-# LINE 391 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  , (22,      peekCtrlEv QFrame)
{-# LINE 392 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  , (23,    peekCtrlEv TimeSign)
{-# LINE 393 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  , (24,     peekCtrlEv KeySign)
{-# LINE 394 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}

  -- queue control (10)
  , (30,       peekQueueEv  QueueStart)
{-# LINE 397 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  , (31,    peekQueueEv  QueueContinue)
{-# LINE 398 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  , (32,        peekQueueEv  QueueStop)
{-# LINE 399 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  , (33, peekQueueExt QueueSetPosTick (\hsc_ptr -> peekByteOff hsc_ptr 4 :: IO Word.Word32))
{-# LINE 400 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  , (34, peekQueueExt QueueSetPosTime (\hsc_ptr -> peekByteOff hsc_ptr 4))
{-# LINE 401 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  , (35,       peekQueueExt QueueTempo      (\hsc_ptr -> peekByteOff hsc_ptr 4))
{-# LINE 402 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  , (36,       peekQueueEv  QueueClock)
{-# LINE 403 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  , (37,        peekQueueEv  QueueTick)
{-# LINE 404 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  , (38,  peekQueueExt QueueSkew       (\hsc_ptr -> peekByteOff hsc_ptr 4))
{-# LINE 405 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  , (39,    peekQueueExt QueueSyncPos    (\hsc_ptr -> peekByteOff hsc_ptr 4))
{-# LINE 406 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}

  -- misc (3)
  , (40, peekEmptyEv TuneRequest)
{-# LINE 409 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  , (41,        peekEmptyEv Reset)
{-# LINE 410 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  , (42,      peekEmptyEv Sensing)
{-# LINE 411 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}

  , (50, peekCustomEv Echo)
{-# LINE 413 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  , (51,  peekCustomEv OSS)
{-# LINE 414 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}

  -- networking (8)
  , (60,  peekAddrEv ClientStart)
{-# LINE 417 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  , (61,   peekAddrEv ClientExit)
{-# LINE 418 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  , (62, peekAddrEv ClientChange)
{-# LINE 419 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  , (63,    peekAddrEv PortStart)
{-# LINE 420 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  , (64,     peekAddrEv PortExit)
{-# LINE 421 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  , (65,   peekAddrEv PortChange)
{-# LINE 422 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  , (66,   peekConnEv PortSubscribed)
{-# LINE 423 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  , (67, peekConnEv PortUnsubscribed)
{-# LINE 424 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}

{- available in alsa-1.0.14, but gone in 1.0.22
  , (#{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)
-}
  , (90, peekCustomEv User0)
{-# LINE 437 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  , (91, peekCustomEv User1)
{-# LINE 438 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  , (92, peekCustomEv User2)
{-# LINE 439 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  , (93, peekCustomEv User3)
{-# LINE 440 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  , (94, peekCustomEv User4)
{-# LINE 441 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  , (95, peekCustomEv User5)
{-# LINE 442 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  , (96, peekCustomEv User6)
{-# LINE 443 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  , (97, peekCustomEv User7)
{-# LINE 444 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  , (98, peekCustomEv User8)
{-# LINE 445 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  , (99, peekCustomEv User9)
{-# LINE 446 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}

{- available in alsa-1.0.14, but gone in 1.0.22
  , (#{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)
-}

  , (130,    peekExtEv SysEx   )
{-# LINE 470 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  , (131,   peekExtEv Bounce  )
{-# LINE 471 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  , (135, peekExtEv UserVar0)
{-# LINE 472 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  , (136, peekExtEv UserVar1)
{-# LINE 473 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  , (137, peekExtEv UserVar2)
{-# LINE 474 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  , (138, peekExtEv UserVar3)
{-# LINE 475 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  , (138, peekExtEv UserVar4)
{-# LINE 476 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}

  , (255, peekEmptyEv None)
{-# LINE 478 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  ]

  where unknown = peekEmptyEv Unknown


data NoteEv   = ANote | NoteOn | NoteOff | KeyPress
                deriving (Show, Eq, Ord, Enum, Bounded)

data CtrlEv   = Controller | PgmChange | ChanPress
              | PitchBend | Control14
              | NonRegParam | RegParam
              | SongPos | SongSel
              | QFrame
              | TimeSign | KeySign
                deriving (Show, Eq, Ord, Enum, Bounded)

newtype Tempo = Tempo { unTempo :: Int.Int32 }
 deriving (Show, Eq, Ord, Ix, Storable)

{-# LINE 495 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}

data QueueEv  = QueueStart
              | QueueContinue
              | QueueStop
              | QueueSetPosTick !Time.Tick
              | QueueSetPosTime !RealTime.T
              | QueueTempo      !Tempo
              | QueueClock
              | QueueTick
              | QueueSkew       !Queue.Skew
              | QueueSyncPos    !Queue.Position
                deriving (Show, Eq)

data EmptyEv  = TuneRequest | Reset | Sensing | None | Unknown
                deriving (Show, Eq, Ord, Enum, Bounded)

data CustomEv = Echo | OSS
              | User0 | User1 | User2 | User3 | User4
              | User5 | User6 | User7 | User8 | User9
                deriving (Show, Eq, Ord, Enum, Bounded)

data ExtEv    = SysEx | Bounce
              | UserVar0 | UserVar1 | UserVar2 | UserVar3 | UserVar4
                deriving (Show, Eq, Ord, Enum, Bounded)

data AddrEv   = ClientStart | ClientExit | ClientChange
              | PortStart | PortExit | PortChange
                deriving (Show, Eq, Ord, Enum, Bounded)

data ConnEv   = PortSubscribed | PortUnsubscribed
                deriving (Show, Eq, Ord, Enum, Bounded)


newtype EType = EType { unEType :: Word.Word8 }
 deriving (Show, Eq, Ord, Ix, Storable)

{-# LINE 529 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}

-- type EType = #{inttype snd_seq_event_type_t}


class Type e where
  expEv :: e -> EType

instance Type NoteEv where
 expEv e = EType $ case e of
  ANote    -> 5
{-# LINE 539 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  NoteOn   -> 6
{-# LINE 540 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  NoteOff  -> 7
{-# LINE 541 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  KeyPress -> 8
{-# LINE 542 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}

instance Type CtrlEv where
 expEv e = EType $ case e of
  Controller  -> 10
{-# LINE 546 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  PgmChange   -> 11
{-# LINE 547 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  ChanPress   -> 12
{-# LINE 548 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  PitchBend   -> 13
{-# LINE 549 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  Control14   -> 14
{-# LINE 550 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  NonRegParam -> 15
{-# LINE 551 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  RegParam    -> 16
{-# LINE 552 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  SongPos     -> 20
{-# LINE 553 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  SongSel     -> 21
{-# LINE 554 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  QFrame      -> 22
{-# LINE 555 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  TimeSign    -> 23
{-# LINE 556 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  KeySign     -> 24
{-# LINE 557 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}

instance Type QueueEv where
  expEv = fst . expQueueEv

-- setPosTick should be an error
expQueueEv :: QueueEv -> (EType, C.CInt)
expQueueEv e = mapFst EType $ case e of
  QueueStart        -> (30       , 0)
{-# LINE 565 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  QueueContinue     -> (31    , 0)
{-# LINE 566 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  QueueStop         -> (32        , 0)
{-# LINE 567 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  QueueSetPosTick _ -> (33 , error "expQueueEv.QueueSetPosTick: cannot represent position as int")
{-# LINE 568 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  QueueSetPosTime _ -> (34 , error "expQueueEv.QueueSetPosTime: cannot represent position as int")
{-# LINE 569 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  QueueTempo      x -> (35       , fromIntegral $ unTempo x)
{-# LINE 570 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  QueueClock        -> (36       , 0)
{-# LINE 571 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  QueueTick         -> (37        , 0)
{-# LINE 572 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  QueueSkew       _ -> (38  , error "expQueueEv.QueueSkew: cannot represent skew record as int")
{-# LINE 573 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  QueueSyncPos    x -> (39    , fromIntegral $ Queue.unPosition x)
{-# LINE 574 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}


instance Type EmptyEv where
 expEv e = EType $ case e of
  TuneRequest -> 40
{-# LINE 579 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  Reset       -> 41
{-# LINE 580 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  Sensing     -> 42
{-# LINE 581 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  None        -> 255
{-# LINE 582 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  Unknown     -> 255
{-# LINE 583 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}

instance Type CustomEv where
 expEv e = EType $ case e of
  Echo  -> 50
{-# LINE 587 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  OSS   -> 51
{-# LINE 588 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  User0 -> 90
{-# LINE 589 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  User1 -> 91
{-# LINE 590 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  User2 -> 92
{-# LINE 591 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  User3 -> 93
{-# LINE 592 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  User4 -> 94
{-# LINE 593 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  User5 -> 95
{-# LINE 594 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  User6 -> 96
{-# LINE 595 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  User7 -> 97
{-# LINE 596 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  User8 -> 98
{-# LINE 597 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  User9 -> 99
{-# LINE 598 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}

instance Type ExtEv where
 expEv e = EType $ case e of
  SysEx    -> 130
{-# LINE 602 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  Bounce   -> 131
{-# LINE 603 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  UserVar0 -> 135
{-# LINE 604 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  UserVar1 -> 136
{-# LINE 605 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  UserVar2 -> 137
{-# LINE 606 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  UserVar3 -> 138
{-# LINE 607 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  UserVar4 -> 139
{-# LINE 608 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}

instance Type AddrEv where
  expEv e = EType $ case e of
    ClientStart -> 60
{-# LINE 612 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
    ClientExit -> 61
{-# LINE 613 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
    ClientChange -> 62
{-# LINE 614 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
    PortStart -> 63
{-# LINE 615 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
    PortExit -> 64
{-# LINE 616 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
    PortChange -> 65
{-# LINE 617 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}

instance Type ConnEv where
 expEv e = EType $ case e of
  PortSubscribed   -> 66
{-# LINE 621 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  PortUnsubscribed -> 67
{-# LINE 622 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}


maxEventType :: EmptyEv
maxEventType = maxBound


peekBody ::
  (Storable d) =>
  (d -> Data) -> Ptr Data -> IO Data
peekBody makeBody p =
  fmap makeBody (peek (castPtr p))

peekNoteEv :: NoteEv -> Ptr Data -> IO Data
peekNoteEv e = peekBody (NoteEv e)

peekCtrlEv :: CtrlEv -> Ptr Data -> IO Data
peekCtrlEv e = peekBody (CtrlEv e)

peekQueueEv :: QueueEv -> Ptr Data -> IO Data
peekQueueEv e = peekBody (QueueEv e)

peekQueueExt :: (a -> QueueEv) -> (Ptr Data -> IO a) -> Ptr Data -> IO Data
peekQueueExt makeQ peekParam p =
  liftM2 (QueueEv . makeQ) (peekParam p) (peek (castPtr p))

peekAddrEv :: AddrEv -> Ptr Data -> IO Data
peekAddrEv e = peekBody (AddrEv e)

peekConnEv :: ConnEv -> Ptr Data -> IO Data
peekConnEv e = peekBody (ConnEv e)

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

peekCustomEv :: CustomEv -> Ptr Data -> IO Data
peekCustomEv e = peekBody (CustomEv e)

peekExtEv :: ExtEv -> Ptr Data -> IO Data
peekExtEv e p = do
  len <- (\hsc_ptr -> peekByteOff hsc_ptr 0 :: IO Word.Word32) p
{-# LINE 662 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  ptr <- (\hsc_ptr -> peekByteOff hsc_ptr 4) p
{-# LINE 663 "src/Sound/ALSA/Sequencer/Marshal/Event.hsc" #-}
  fmap (ExtEv e) $ B.packCStringLen (ptr, fromIntegral len)


data Data
  = NoteEv NoteEv Note
  | CtrlEv CtrlEv Ctrl
  | QueueEv QueueEv Queue.T
  | AddrEv AddrEv Addr.T
  | ConnEv ConnEv Connect.T
  | EmptyEv EmptyEv
  | CustomEv CustomEv Custom
  | ExtEv ExtEv B.ByteString
    deriving Show