{-# LINE 1 "src/Sound/ALSA/Sequencer/Marshal/Queue.hsc" #-}
--------------------------------------------------------------------------------
-- |
-- Module    : Sound.ALSA.Sequencer.Marshal.Queue
-- 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.
--
-- 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.Queue where




import qualified Sound.ALSA.Sequencer.Utility as U

import qualified Foreign.C.Types as C
import Foreign.Storable (Storable, sizeOf, alignment, peek, peekByteOff, poke, pokeByteOff, )

import Data.Array (Ix, )

import qualified Data.Word as Word




-- | The type of queue identifiers.
newtype T =
   Cons Word.Word8
{-# LINE 44 "src/Sound/ALSA/Sequencer/Marshal/Queue.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
"Queue" [forall a. Show a => a -> ShowS
U.showsField Word8
x]

imp :: C.CInt -> T
imp :: CInt -> T
imp CInt
x = Word8 -> T
Cons (forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
x)

exp :: T -> C.CInt
exp :: T -> CInt
exp (Cons Word8
x) = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
x

direct  :: T
direct :: T
direct  = Word8 -> T
Cons Word8
253

{-# LINE 59 "src/Sound/ALSA/Sequencer/Marshal/Queue.hsc" #-}


data Skew =
   Skew {
      Skew -> Word32
skewValue :: !(Word.Word32),
{-# LINE 64 "src/Sound/ALSA/Sequencer/Marshal/Queue.hsc" #-}
      skewBase  :: !(Word.Word32)
{-# LINE 65 "src/Sound/ALSA/Sequencer/Marshal/Queue.hsc" #-}
   } deriving (Show, Eq)

instance Storable Skew where
  sizeOf :: Skew -> Int
sizeOf Skew
_    = (Int
8)
{-# LINE 69 "src/Sound/ALSA/Sequencer/Marshal/Queue.hsc" #-}
  alignment _ = 4
{-# LINE 70 "src/Sound/ALSA/Sequencer/Marshal/Queue.hsc" #-}
  peek p      = do v <- (\hsc_ptr -> peekByteOff hsc_ptr 0) p
{-# LINE 71 "src/Sound/ALSA/Sequencer/Marshal/Queue.hsc" #-}
                   b <- (\hsc_ptr -> peekByteOff hsc_ptr 4)  p
{-# LINE 72 "src/Sound/ALSA/Sequencer/Marshal/Queue.hsc" #-}
                   return Skew { skewValue = v
                               , skewBase  = b
                               }
  poke :: Ptr Skew -> Skew -> IO ()
poke Ptr Skew
p Skew
v    = (\Ptr Skew
hsc_ptr -> forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Skew
hsc_ptr Int
0) Ptr Skew
p (Skew -> Word32
skewValue Skew
v)
{-# LINE 76 "src/Sound/ALSA/Sequencer/Marshal/Queue.hsc" #-}
             forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (\Ptr Skew
hsc_ptr -> forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Skew
hsc_ptr Int
4)  Ptr Skew
p (Skew -> Word32
skewBase  Skew
v)
{-# LINE 77 "src/Sound/ALSA/Sequencer/Marshal/Queue.hsc" #-}


newtype Position = Position { Position -> Word32
unPosition :: Word.Word32 }
 deriving (Int -> Position -> ShowS
[Position] -> ShowS
Position -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Position] -> ShowS
$cshowList :: [Position] -> ShowS
show :: Position -> String
$cshow :: Position -> String
showsPrec :: Int -> Position -> ShowS
$cshowsPrec :: Int -> Position -> ShowS
Show, Position -> Position -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Position -> Position -> Bool
$c/= :: Position -> Position -> Bool
== :: Position -> Position -> Bool
$c== :: Position -> Position -> Bool
Eq, Eq Position
Position -> Position -> Bool
Position -> Position -> Ordering
Position -> Position -> Position
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Position -> Position -> Position
$cmin :: Position -> Position -> Position
max :: Position -> Position -> Position
$cmax :: Position -> Position -> Position
>= :: Position -> Position -> Bool
$c>= :: Position -> Position -> Bool
> :: Position -> Position -> Bool
$c> :: Position -> Position -> Bool
<= :: Position -> Position -> Bool
$c<= :: Position -> Position -> Bool
< :: Position -> Position -> Bool
$c< :: Position -> Position -> Bool
compare :: Position -> Position -> Ordering
$ccompare :: Position -> Position -> Ordering
Ord, Ord Position
(Position, Position) -> Int
(Position, Position) -> [Position]
(Position, Position) -> Position -> Bool
(Position, Position) -> Position -> Int
forall a.
Ord a
-> ((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
unsafeRangeSize :: (Position, Position) -> Int
$cunsafeRangeSize :: (Position, Position) -> Int
rangeSize :: (Position, Position) -> Int
$crangeSize :: (Position, Position) -> Int
inRange :: (Position, Position) -> Position -> Bool
$cinRange :: (Position, Position) -> Position -> Bool
unsafeIndex :: (Position, Position) -> Position -> Int
$cunsafeIndex :: (Position, Position) -> Position -> Int
index :: (Position, Position) -> Position -> Int
$cindex :: (Position, Position) -> Position -> Int
range :: (Position, Position) -> [Position]
$crange :: (Position, Position) -> [Position]
Ix, Ptr Position -> IO Position
Ptr Position -> Int -> IO Position
Ptr Position -> Int -> Position -> IO ()
Ptr Position -> Position -> IO ()
Position -> Int
forall b. Ptr b -> Int -> IO Position
forall b. Ptr b -> Int -> Position -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr Position -> Position -> IO ()
$cpoke :: Ptr Position -> Position -> IO ()
peek :: Ptr Position -> IO Position
$cpeek :: Ptr Position -> IO Position
pokeByteOff :: forall b. Ptr b -> Int -> Position -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> Position -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO Position
$cpeekByteOff :: forall b. Ptr b -> Int -> IO Position
pokeElemOff :: Ptr Position -> Int -> Position -> IO ()
$cpokeElemOff :: Ptr Position -> Int -> Position -> IO ()
peekElemOff :: Ptr Position -> Int -> IO Position
$cpeekElemOff :: Ptr Position -> Int -> IO Position
alignment :: Position -> Int
$calignment :: Position -> Int
sizeOf :: Position -> Int
$csizeOf :: Position -> Int
Storable)

{-# LINE 80 "src/Sound/ALSA/Sequencer/Marshal/Queue.hsc" #-}