module Sound.MED.Raw.CmdPageData where

import Sound.MED.Basic.Amiga

data CmdPageData = CmdPageData
  { CmdPageData -> UBYTE
command    :: UBYTE
  , CmdPageData -> UBYTE
databyte   :: UBYTE
  }
  deriving (Int -> CmdPageData -> ShowS
[CmdPageData] -> ShowS
CmdPageData -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CmdPageData] -> ShowS
$cshowList :: [CmdPageData] -> ShowS
show :: CmdPageData -> String
$cshow :: CmdPageData -> String
showsPrec :: Int -> CmdPageData -> ShowS
$cshowsPrec :: Int -> CmdPageData -> ShowS
Show)

{-# SPECIALISE peek :: PTR -> StorableReader CmdPageData #-}
{-# SPECIALISE peek :: PTR -> ByteStringReader CmdPageData #-}
peek :: (Reader m) => PTR -> m CmdPageData
peek :: forall (m :: * -> *). Reader m => PTR -> m CmdPageData
peek PTR
p = do
  UBYTE
command'  <- forall (m :: * -> *). Reader m => Peek m UBYTE
peekUBYTE (PTR
p forall a. Num a => a -> a -> a
+ PTR
0)
  UBYTE
databyte' <- forall (m :: * -> *). Reader m => Peek m UBYTE
peekUBYTE (PTR
p forall a. Num a => a -> a -> a
+ PTR
1)
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ UBYTE -> UBYTE -> CmdPageData
CmdPageData
    UBYTE
command' UBYTE
databyte'