module System.Hardware.MercuryApi.Records where
import Control.Applicative ( Applicative((<*>)), (<$>) )
import Control.Exception ( Exception, throwIO )
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import Data.Maybe ( mapMaybe, fromMaybe )
import Data.Monoid ( (<>) )
import Data.Text (Text)
import qualified Data.Text as T ( pack )
import qualified Data.Text.Encoding as T
( encodeUtf8, decodeUtf8With )
import qualified Data.Text.Encoding.Error as T ( lenientDecode )
import Data.Typeable ( Typeable )
import Data.Word ( Word8, Word16, Word32, Word64 )
import Foreign
( Int32,
Ptr,
nullPtr,
plusPtr,
Storable(alignment, peek, peekByteOff, poke, pokeByteOff, sizeOf),
Bits((.&.), (.|.), shiftL),
castPtr,
with,
toBool,
fromBool,
withArrayLen,
pokeArray,
peekArray,
copyArray,
allocaArray )
import Foreign.C ( CString )
import System.Hardware.MercuryApi.Enums
type PinNumber = Word8
type AntennaPort = Word8
type GEN2_Password = Word32
type MillisecondsSinceEpoch = Word64
apiVersion :: Text
apiVersion = "1.29.3.34"
type CBool = Word8
newtype ReaderEtc = ReaderEtc ()
cFalse, cTrue :: CBool
cFalse = 0
cTrue = 1
toBool' :: CBool -> Bool
toBool' = toBool
fromBool' :: Bool -> CBool
fromBool' = fromBool
sizeofReaderEtc :: Int
sizeofReaderEtc = (2368)
uriPtr :: Ptr ReaderEtc -> CString
uriPtr = (\hsc_ptr -> hsc_ptr `plusPtr` 2361)
textFromBS :: ByteString -> Text
textFromBS = T.decodeUtf8With T.lenientDecode
textToBS :: Text -> ByteString
textToBS = T.encodeUtf8
textFromCString :: CString -> IO Text
textFromCString cs = textFromBS <$> B.packCString cs
data ReadWrite = Read !Int
| Write ![Word16]
deriving (Eq, Ord, Show, Read)
fromReadWrite :: ReadWrite -> (Word8, [Word16])
fromReadWrite (Read n) = (0, replicate n 0)
fromReadWrite (Write ws) = (1, ws)
toReadWrite :: (Word8, [Word16]) -> ReadWrite
toReadWrite (0, ws) = Read $ length ws
toReadWrite (1, ws) = Write ws
toReadWrite (x, _) = error $ "didn't expect ReadWrite to be " ++ show x
data ParamException = ParamException StatusType Status Text
deriving (Eq, Ord, Show, Read, Typeable)
instance Exception ParamException
castLen' :: Integral a => a -> Text -> Int -> IO a
castLen' bound description x = do
let tShow = T.pack . show
maxLen = fromIntegral bound
if x > maxLen
then throwIO ( ParamException ERROR_TYPE_MISC ERROR_TOO_BIG $
description <> " had length " <> tShow x <>
" but maximum is " <> tShow maxLen )
else return $ fromIntegral x
castLen :: (Integral a, Bounded a) => Text -> Int -> IO a
castLen = castLen' maxBound
data ReadPlan =
SimpleReadPlan
{ rpWeight :: !Word32
, rpEnableAutonomousRead :: !Bool
, rpAntennas :: ![AntennaPort]
, rpProtocol :: !TagProtocol
, rpFilter :: !(Maybe TagFilter)
, rpTagop :: !(Maybe TagOp)
, rpUseFastSearch :: !Bool
, rpStopOnCount :: !(Maybe Word32)
, rpTriggerRead :: !(Maybe [Word8])
} deriving (Eq, Ord, Show, Read)
antennasInfo :: Ptr ReadPlan -> (Ptr List16, Word16, Ptr Word8, Text)
antennasInfo rp =
( (\hsc_ptr -> hsc_ptr `plusPtr` 16) rp
, 32
, (\hsc_ptr -> hsc_ptr `plusPtr` 96) rp
, "rpAntennas"
)
gpiListInfo :: Ptr ReadPlan -> (Ptr List16, Word16, Ptr Word8, Text)
gpiListInfo rp =
( (\hsc_ptr -> hsc_ptr `plusPtr` 80) rp
, 16
, (\hsc_ptr -> hsc_ptr `plusPtr` 128) rp
, "rpTriggerRead"
)
readPlanTypeSimple :: Word32
readPlanTypeSimple = 1
instance Storable ReadPlan where
sizeOf _ = (744)
alignment _ = 8
poke p x = do
(\hsc_ptr -> pokeByteOff hsc_ptr 0) p readPlanTypeSimple
(\hsc_ptr -> pokeByteOff hsc_ptr 4) p (rpWeight x)
(\hsc_ptr -> pokeByteOff hsc_ptr 8) p
(fromBool' $ rpEnableAutonomousRead x)
pokeList16 (antennasInfo p) (rpAntennas x)
(\hsc_ptr -> pokeByteOff hsc_ptr 32) p
(fromTagProtocol $ rpProtocol x)
case rpFilter x of
Nothing -> (\hsc_ptr -> pokeByteOff hsc_ptr 40) p nullPtr
Just f -> do
(\hsc_ptr -> pokeByteOff hsc_ptr 144) p f
(\hsc_ptr -> pokeByteOff hsc_ptr 40) p ((\hsc_ptr -> hsc_ptr `plusPtr` 144) p)
case rpTagop x of
Nothing -> (\hsc_ptr -> pokeByteOff hsc_ptr 48) p nullPtr
Just op -> do
(\hsc_ptr -> pokeByteOff hsc_ptr 360) p op
(\hsc_ptr -> pokeByteOff hsc_ptr 48) p ((\hsc_ptr -> hsc_ptr `plusPtr` 360) p)
(\hsc_ptr -> pokeByteOff hsc_ptr 56) p
(fromBool' $ rpUseFastSearch x)
let (stop, nTags) = case rpStopOnCount x of
Nothing -> (cFalse, 0)
Just n -> (cTrue, n)
(\hsc_ptr -> pokeByteOff hsc_ptr 60) p stop
(\hsc_ptr -> pokeByteOff hsc_ptr 64) p nTags
let (enable, ports) = case rpTriggerRead x of
Nothing -> (cFalse, [])
Just ps -> (cTrue, ps)
(\hsc_ptr -> pokeByteOff hsc_ptr 72) p enable
pokeList16 (gpiListInfo p) ports
peek p = do
weight <- (\hsc_ptr -> peekByteOff hsc_ptr 4) p
enableAutonomousRead <- (\hsc_ptr -> peekByteOff hsc_ptr 8) p
antennas <- peekList16 (antennasInfo p)
protocol <- (\hsc_ptr -> peekByteOff hsc_ptr 32) p
fPtr <- (\hsc_ptr -> peekByteOff hsc_ptr 40) p
filt <- if fPtr == nullPtr
then return Nothing
else Just <$> peek fPtr
opPtr <- (\hsc_ptr -> peekByteOff hsc_ptr 48) p
op <- if opPtr == nullPtr
then return Nothing
else Just <$> peek opPtr
useFastSearch <- (\hsc_ptr -> peekByteOff hsc_ptr 56) p
stop <- (\hsc_ptr -> peekByteOff hsc_ptr 60) p
stopOnCount <- if toBool' stop
then Just <$> (\hsc_ptr -> peekByteOff hsc_ptr 64) p
else return Nothing
enable <- (\hsc_ptr -> peekByteOff hsc_ptr 72) p
triggerRead <- if toBool' enable
then Just <$> peekList16 (gpiListInfo p)
else return Nothing
return $ SimpleReadPlan
{ rpWeight = weight
, rpEnableAutonomousRead = toBool' enableAutonomousRead
, rpAntennas = antennas
, rpProtocol = toTagProtocol protocol
, rpFilter = filt
, rpTagop = op
, rpUseFastSearch = toBool' useFastSearch
, rpStopOnCount = stopOnCount
, rpTriggerRead = triggerRead
}
data FilterOn = FilterOnBank GEN2_Bank
| FilterOnEpcLength
deriving (Eq, Ord, Show, Read)
instance Storable FilterOn where
sizeOf _ = (4)
alignment _ = 8
poke p FilterOnEpcLength = do
let p' = castPtr p :: Ptr RawBank
poke p' 6
poke p (FilterOnBank bank) = do
let p' = castPtr p :: Ptr RawBank
poke p' (fromBank bank)
peek p = do
x <- peek (castPtr p)
if x == 6
then return FilterOnEpcLength
else return $ FilterOnBank $ toBank x
data TagFilter = TagFilterEPC TagData
| TagFilterGen2
{ tfInvert :: !Bool
, tfFilterOn :: !FilterOn
, tfBitPointer :: !Word32
, tfMaskBitLength :: !Word16
, tfMask :: !ByteString
}
deriving (Eq, Ord, Show, Read)
instance Storable TagFilter where
sizeOf _ = (216)
alignment _ = 8
poke p (TagFilterEPC td) = do
(\hsc_ptr -> pokeByteOff hsc_ptr 0) p
(0 :: Word32)
(\hsc_ptr -> pokeByteOff hsc_ptr 8) p td
poke p tf@(TagFilterGen2 {}) = do
(\hsc_ptr -> pokeByteOff hsc_ptr 0) p
(1 :: Word32)
(\hsc_ptr -> pokeByteOff hsc_ptr 8) p (fromBool' $ tfInvert tf)
(\hsc_ptr -> pokeByteOff hsc_ptr 12) p (tfFilterOn tf)
(\hsc_ptr -> pokeByteOff hsc_ptr 16) p (tfBitPointer tf)
(\hsc_ptr -> pokeByteOff hsc_ptr 20) p (tfMaskBitLength tf)
let maskLenBytes = fromIntegral $ (tfMaskBitLength tf + 7) `div` 8
origLen = B.length (tfMask tf)
bs = if origLen < maskLenBytes
then tfMask tf <> B.pack (replicate (maskLenBytes origLen) 0)
else tfMask tf
B.useAsCStringLen bs $ \(cs, len) -> do
len' <- castLen' 128 "tfMask" len
copyArray ((\hsc_ptr -> hsc_ptr `plusPtr` 88) p) cs (fromIntegral len')
(\hsc_ptr -> pokeByteOff hsc_ptr 24) p ((\hsc_ptr -> hsc_ptr `plusPtr` 88) p)
peek p = do
ft <- (\hsc_ptr -> peekByteOff hsc_ptr 0) p :: IO Word32
case ft of
0 ->
TagFilterEPC <$> (\hsc_ptr -> peekByteOff hsc_ptr 8) p
1 -> do
bitLength <- (\hsc_ptr -> peekByteOff hsc_ptr 20) p
TagFilterGen2
<$> (toBool' <$> (\hsc_ptr -> peekByteOff hsc_ptr 8) p)
<*> (\hsc_ptr -> peekByteOff hsc_ptr 12) p
<*> (\hsc_ptr -> peekByteOff hsc_ptr 16) p
<*> return bitLength
<*> peekMask p bitLength
peekMask :: Ptr TagFilter -> Word16 -> IO ByteString
peekMask p bitLength = do
let len = fromIntegral $ (bitLength + 7) `div` 8
maskPtr <- (\hsc_ptr -> peekByteOff hsc_ptr 24) p
B.packCStringLen (maskPtr, len)
packBits :: Num b => (a -> b) -> [a] -> b
packBits from flags = sum $ map from flags
unpackBits :: (Bounded a, Enum a, Num b, Bits b) => (a -> b) -> b -> [a]
unpackBits from x = mapMaybe f [minBound..maxBound]
where f flag = if (x .&. from flag) == 0
then Nothing
else Just flag
packFlags :: [MetadataFlag] -> RawMetadataFlag
packFlags = packBits fromMetadataFlag
unpackFlags :: RawMetadataFlag -> [MetadataFlag]
unpackFlags = unpackBits fromMetadataFlag
packFlags16 :: [MetadataFlag] -> Word16
packFlags16 = fromIntegral . packFlags
unpackFlags16 :: Word16 -> [MetadataFlag]
unpackFlags16 = unpackFlags . fromIntegral
packExtraBanks :: [GEN2_Bank] -> RawBank
packExtraBanks = packBits fromExtraBank
unpackExtraBanks :: RawBank -> [GEN2_Bank]
unpackExtraBanks = unpackBits fromExtraBank
packLockBits :: [GEN2_LockBits] -> RawLockBits
packLockBits = packBits fromLockBits
unpackLockBits :: RawLockBits -> [GEN2_LockBits]
unpackLockBits = unpackBits fromLockBits
packLockBits16 :: [GEN2_LockBits] -> Word16
packLockBits16 = fromIntegral . packLockBits
unpackLockBits16 :: Word16 -> [GEN2_LockBits]
unpackLockBits16 = unpackLockBits . fromIntegral
peekArrayAsByteString :: Ptr Word8 -> Ptr Word8 -> IO ByteString
peekArrayAsByteString arrayPtr lenPtr = do
len <- peek lenPtr
B.packCStringLen (castPtr arrayPtr, fromIntegral len)
pokeArrayAsByteString :: Text
-> Word8
-> Ptr Word8
-> Ptr Word8
-> ByteString
-> IO ()
pokeArrayAsByteString desc maxLen arrayPtr lenPtr bs = do
B.useAsCStringLen bs $ \(cs, len) -> do
len' <- castLen' maxLen desc len
copyArray arrayPtr (castPtr cs) (fromIntegral len')
poke lenPtr len'
peekListAsByteString :: Ptr List16 -> IO ByteString
peekListAsByteString listPtr = do
lst <- peek listPtr
B.packCStringLen (castPtr $ l16_list lst, fromIntegral $ l16_len lst)
peekArrayAsList :: Storable a => Ptr a -> Ptr Word8 -> IO [a]
peekArrayAsList arrayPtr lenPtr = do
len <- peek lenPtr
peekArray (fromIntegral len) arrayPtr
peekListAsList :: Storable a => Ptr List16 -> Ptr a -> IO [a]
peekListAsList listPtr _ = do
lst <- peek listPtr
peekArray (fromIntegral $ l16_len lst) (castPtr $ l16_list lst)
pokeListAsList :: Storable a
=> Text
-> Word16
-> Ptr List16
-> Ptr a
-> [a]
-> IO ()
pokeListAsList desc maxLen listPtr storage xs = do
withArrayLen xs $ \len tmpPtr -> do
len' <- castLen' maxLen desc len
copyArray storage tmpPtr len
let lst = List16
{ l16_list = castPtr storage
, l16_max = maxLen
, l16_len = len'
}
poke listPtr lst
peekMaybe :: (Storable a, Storable b)
=> (Ptr a -> IO a)
-> (b -> Bool)
-> Ptr a
-> Ptr b
-> IO (Maybe a)
peekMaybe oldPeek cond justP condP = do
c <- peek condP
if cond c
then Just <$> oldPeek justP
else return Nothing
pokeGen2TagData :: Ptr GEN2_TagData
-> Ptr RawTagProtocol
-> Maybe GEN2_TagData
-> IO ()
pokeGen2TagData pGen2 _ mGen2 = do
let gen2 = fromMaybe (GEN2_TagData B.empty) mGen2
poke pGen2 gen2
peekSplit64 :: Ptr Word32 -> Ptr Word32 -> IO Word64
peekSplit64 pLow pHigh = do
lo <- fromIntegral <$> peek pLow
hi <- fromIntegral <$> peek pHigh
return $ lo .|. (hi `shiftL` 32)
peekPtr :: Storable a => Ptr (Ptr a) -> Ptr a -> IO a
peekPtr pp _ = do
p <- peek pp
peek p
pokePtr :: Storable a => Ptr (Ptr a) -> Ptr a -> a -> IO ()
pokePtr pp p x = do
poke p x
poke pp p
pokeOr :: (Storable a, Bits a) => Ptr a -> a -> IO ()
pokeOr p x = do
old <- peek p
poke p (x .|. old)
data List16 =
List16
{ l16_list :: !(Ptr ())
, l16_max :: !(Word16)
, l16_len :: !(Word16)
}
instance Storable List16 where
sizeOf _ = (16)
alignment _ = 8
peek p = List16
<$> (\hsc_ptr -> peekByteOff hsc_ptr 0) p
<*> (\hsc_ptr -> peekByteOff hsc_ptr 8) p
<*> (\hsc_ptr -> peekByteOff hsc_ptr 10) p
poke p x = do
(\hsc_ptr -> pokeByteOff hsc_ptr 0) p (l16_list x)
(\hsc_ptr -> pokeByteOff hsc_ptr 8) p (l16_max x)
(\hsc_ptr -> pokeByteOff hsc_ptr 10) p (l16_len x)
getList16 :: Storable a => (Ptr () -> IO ()) -> IO [a]
getList16 f = do
let maxLen = maxBound :: Word16
allocaArray (fromIntegral maxLen) $ \storage -> do
let lst = List16
{ l16_list = castPtr storage
, l16_max = maxLen
, l16_len = 0
}
with lst $ \p -> do
f (castPtr p)
lst' <- peek p
peekArray (fromIntegral (l16_len lst')) storage
setList16 :: Storable a => Text -> [a] -> (Ptr () -> IO ()) -> IO ()
setList16 t x f = do
withArrayLen x $ \len storage -> do
len' <- castLen t len
let lst = List16
{ l16_list = castPtr storage
, l16_max = len'
, l16_len = len'
}
with lst $ \p -> f (castPtr p)
pokeList16 :: Storable a => (Ptr List16, Word16, Ptr a, Text) -> [a] -> IO ()
pokeList16 (lp, maxLen, storage, name) ws = do
len <- castLen' maxLen name (length ws)
poke lp $ List16
{ l16_list = castPtr storage
, l16_max = maxLen
, l16_len = len
}
pokeArray storage ws
peekList16 :: Storable a => (Ptr List16, Word16, Ptr a, Text) -> IO [a]
peekList16 (lp, _, _, _) = do
lst <- peek lp
peekArray (fromIntegral $ l16_len lst) (castPtr $ l16_list lst)
data List8 =
List8
{ l8_list :: !(Ptr ())
, l8_max :: !(Word8)
, l8_len :: !(Word8)
}
instance Storable List8 where
sizeOf _ = (16)
alignment _ = 8
peek p = List8
<$> (\hsc_ptr -> peekByteOff hsc_ptr 0) p
<*> (\hsc_ptr -> peekByteOff hsc_ptr 8) p
<*> (\hsc_ptr -> peekByteOff hsc_ptr 9) p
poke p x = do
(\hsc_ptr -> pokeByteOff hsc_ptr 0) p (l8_list x)
(\hsc_ptr -> pokeByteOff hsc_ptr 8) p (l8_max x)
(\hsc_ptr -> pokeByteOff hsc_ptr 9) p (l8_len x)
getList8 :: Storable a => (Ptr () -> IO ()) -> IO [a]
getList8 f = do
let maxLen = maxBound :: Word8
allocaArray (fromIntegral maxLen) $ \storage -> do
let lst = List8
{ l8_list = castPtr storage
, l8_max = maxLen
, l8_len = 0
}
with lst $ \p -> do
f (castPtr p)
lst' <- peek p
peekArray (fromIntegral (l8_len lst')) storage
setList8 :: Storable a => Text -> [a] -> (Ptr () -> IO ()) -> IO ()
setList8 t x f = do
withArrayLen x $ \len storage -> do
len' <- castLen t len
let lst = List8
{ l8_list = castPtr storage
, l8_max = len'
, l8_len = len'
}
with lst $ \p -> f (castPtr p)
pokeList8 :: Storable a => (Ptr List8, Word8, Ptr a, Text) -> [a] -> IO ()
pokeList8 (lp, maxLen, storage, name) ws = do
len <- castLen' maxLen name (length ws)
poke lp $ List8
{ l8_list = castPtr storage
, l8_max = maxLen
, l8_len = len
}
pokeArray storage ws
peekList8 :: Storable a => (Ptr List8, Word8, Ptr a, Text) -> IO [a]
peekList8 (lp, _, _, _) = do
lst <- peek lp
peekArray (fromIntegral $ l8_len lst) (castPtr $ l8_list lst)
newtype GEN2_TagData =
GEN2_TagData
{ g2Pc :: ByteString
} deriving (Eq, Ord, Show, Read)
instance Storable GEN2_TagData where
sizeOf _ = (7)
alignment _ = 8
peek p =
GEN2_TagData
<$> peekArrayAsByteString ((\hsc_ptr -> hsc_ptr `plusPtr` 1) p) ((\hsc_ptr -> hsc_ptr `plusPtr` 0) p)
poke p x = do
pokeArrayAsByteString "pc" 6 ((\hsc_ptr -> hsc_ptr `plusPtr` 1) p) ((\hsc_ptr -> hsc_ptr `plusPtr` 0) p) (g2Pc x)
data TagData =
TagData
{ tdEpc :: !ByteString
, tdProtocol :: !TagProtocol
, tdCrc :: !Word16
, tdGen2 :: !(Maybe (GEN2_TagData))
} deriving (Eq, Ord, Show, Read)
instance Storable TagData where
sizeOf _ = (80)
alignment _ = 8
peek p =
TagData
<$> peekArrayAsByteString ((\hsc_ptr -> hsc_ptr `plusPtr` 0) p) ((\hsc_ptr -> hsc_ptr `plusPtr` 68) p)
<*> (toTagProtocol <$> (\hsc_ptr -> peekByteOff hsc_ptr 64) p)
<*> (\hsc_ptr -> peekByteOff hsc_ptr 70) p
<*> peekMaybe (peek) (== (5 :: RawTagProtocol)) ((\hsc_ptr -> hsc_ptr `plusPtr` 72) p) ((\hsc_ptr -> hsc_ptr `plusPtr` 64) p)
poke p x = do
pokeArrayAsByteString "epc" 62 ((\hsc_ptr -> hsc_ptr `plusPtr` 0) p) ((\hsc_ptr -> hsc_ptr `plusPtr` 68) p) (tdEpc x)
(\hsc_ptr -> pokeByteOff hsc_ptr 64) p (fromTagProtocol $ tdProtocol x)
(\hsc_ptr -> pokeByteOff hsc_ptr 70) p (tdCrc x)
pokeGen2TagData ((\hsc_ptr -> hsc_ptr `plusPtr` 72) p) ((\hsc_ptr -> hsc_ptr `plusPtr` 64) p) (tdGen2 x)
data GpioPin =
GpioPin
{ gpId :: !PinNumber
, gpHigh :: !Bool
, gpOutput :: !Bool
} deriving (Eq, Ord, Show, Read)
instance Storable GpioPin where
sizeOf _ = (3)
alignment _ = 8
peek p =
GpioPin
<$> (\hsc_ptr -> peekByteOff hsc_ptr 0) p
<*> (toBool' <$> (\hsc_ptr -> peekByteOff hsc_ptr 1) p)
<*> (toBool' <$> (\hsc_ptr -> peekByteOff hsc_ptr 2) p)
poke p x = do
(\hsc_ptr -> pokeByteOff hsc_ptr 0) p (gpId x)
(\hsc_ptr -> pokeByteOff hsc_ptr 1) p (fromBool' $ gpHigh x)
(\hsc_ptr -> pokeByteOff hsc_ptr 2) p (fromBool' $ gpOutput x)
data TagReadData =
TagReadData
{ trTag :: !TagData
, trMetadataFlags :: ![MetadataFlag]
, trPhase :: !Word16
, trAntenna :: !AntennaPort
, trGpio :: ![GpioPin]
, trReadCount :: !Word32
, trRssi :: !Int32
, trFrequency :: !Word32
, trTimestamp :: !MillisecondsSinceEpoch
, trData :: !ByteString
, trEpcMemData :: !ByteString
, trTidMemData :: !ByteString
, trUserMemData :: !ByteString
, trReservedMemData :: !ByteString
} deriving (Eq, Ord, Show, Read)
instance Storable TagReadData where
sizeOf _ = (896)
alignment _ = 8
peek p =
TagReadData
<$> (\hsc_ptr -> peekByteOff hsc_ptr 0) p
<*> (unpackFlags16 <$> (\hsc_ptr -> peekByteOff hsc_ptr 80) p)
<*> (\hsc_ptr -> peekByteOff hsc_ptr 82) p
<*> (\hsc_ptr -> peekByteOff hsc_ptr 84) p
<*> peekArrayAsList ((\hsc_ptr -> hsc_ptr `plusPtr` 85) p) ((\hsc_ptr -> hsc_ptr `plusPtr` 133) p)
<*> (\hsc_ptr -> peekByteOff hsc_ptr 136) p
<*> (\hsc_ptr -> peekByteOff hsc_ptr 140) p
<*> (\hsc_ptr -> peekByteOff hsc_ptr 144) p
<*> peekSplit64 ((\hsc_ptr -> hsc_ptr `plusPtr` 148) p) ((\hsc_ptr -> hsc_ptr `plusPtr` 152) p)
<*> peekListAsByteString ((\hsc_ptr -> hsc_ptr `plusPtr` 160) p)
<*> peekListAsByteString ((\hsc_ptr -> hsc_ptr `plusPtr` 176) p)
<*> peekListAsByteString ((\hsc_ptr -> hsc_ptr `plusPtr` 192) p)
<*> peekListAsByteString ((\hsc_ptr -> hsc_ptr `plusPtr` 208) p)
<*> peekListAsByteString ((\hsc_ptr -> hsc_ptr `plusPtr` 224) p)
poke p x = error "poke not implemented for TagReadData"
data TagOp =
TagOp_GEN2_ReadData
{ opBank :: !GEN2_Bank
, opExtraBanks :: ![GEN2_Bank]
, opWordAddress :: !Word32
, opLen :: !Word8
}
| TagOp_GEN2_WriteTag
{ opEpc :: !TagData
}
| TagOp_GEN2_WriteData
{ opBank :: !GEN2_Bank
, opWordAddress :: !Word32
, opData :: ![Word16]
}
| TagOp_GEN2_Lock
{ opMask :: ![GEN2_LockBits]
, opAction :: ![GEN2_LockBits]
, opAccessPassword :: !GEN2_Password
}
| TagOp_GEN2_Kill
{ opPassword :: !GEN2_Password
}
| TagOp_GEN2_BlockWrite
{ opBank :: !GEN2_Bank
, opWordPtr :: !Word32
, opData :: ![Word16]
}
| TagOp_GEN2_BlockErase
{ opBank :: !GEN2_Bank
, opWordPtr :: !Word32
, opWordCount :: !Word8
}
| TagOp_GEN2_BlockPermaLock
{ opBank :: !GEN2_Bank
, opBlockPtr :: !Word32
, opReadWrite :: !ReadWrite
}
deriving (Eq, Ord, Show, Read)
instance Storable TagOp where
sizeOf _ = (384)
alignment _ = 8
peek p = do
x <- (\hsc_ptr -> peekByteOff hsc_ptr 0) p :: IO Word32
case x of
1 -> do
TagOp_GEN2_ReadData
<$> ((toBank . (.&. 3)) <$> (\hsc_ptr -> peekByteOff hsc_ptr 8) p)
<*> (unpackExtraBanks <$> (\hsc_ptr -> peekByteOff hsc_ptr 8) p)
<*> (\hsc_ptr -> peekByteOff hsc_ptr 12) p
<*> (\hsc_ptr -> peekByteOff hsc_ptr 16) p
0 -> do
TagOp_GEN2_WriteTag
<$> peekPtr ((\hsc_ptr -> hsc_ptr `plusPtr` 8) p) ((\hsc_ptr -> hsc_ptr `plusPtr` 128) p)
2 -> do
TagOp_GEN2_WriteData
<$> ((toBank . (.&. 3)) <$> (\hsc_ptr -> peekByteOff hsc_ptr 8) p)
<*> (\hsc_ptr -> peekByteOff hsc_ptr 12) p
<*> peekListAsList ((\hsc_ptr -> hsc_ptr `plusPtr` 16) p) ((\hsc_ptr -> hsc_ptr `plusPtr` 128) p)
3 -> do
TagOp_GEN2_Lock
<$> (unpackLockBits16 <$> (\hsc_ptr -> peekByteOff hsc_ptr 8) p)
<*> (unpackLockBits16 <$> (\hsc_ptr -> peekByteOff hsc_ptr 10) p)
<*> (\hsc_ptr -> peekByteOff hsc_ptr 12) p
4 -> do
TagOp_GEN2_Kill
<$> (\hsc_ptr -> peekByteOff hsc_ptr 8) p
5 -> do
TagOp_GEN2_BlockWrite
<$> ((toBank . (.&. 3)) <$> (\hsc_ptr -> peekByteOff hsc_ptr 8) p)
<*> (\hsc_ptr -> peekByteOff hsc_ptr 12) p
<*> peekListAsList ((\hsc_ptr -> hsc_ptr `plusPtr` 16) p) ((\hsc_ptr -> hsc_ptr `plusPtr` 128) p)
7 -> do
TagOp_GEN2_BlockErase
<$> ((toBank . (.&. 3)) <$> (\hsc_ptr -> peekByteOff hsc_ptr 8) p)
<*> (\hsc_ptr -> peekByteOff hsc_ptr 12) p
<*> (\hsc_ptr -> peekByteOff hsc_ptr 16) p
6 -> do
rw <- (\hsc_ptr -> peekByteOff hsc_ptr 8) p
ws <- peekListAsList ((\hsc_ptr -> hsc_ptr `plusPtr` 24) p) ((\hsc_ptr -> hsc_ptr `plusPtr` 128) p)
TagOp_GEN2_BlockPermaLock
<$> ((toBank . (.&. 3)) <$> (\hsc_ptr -> peekByteOff hsc_ptr 12) p)
<*> (\hsc_ptr -> peekByteOff hsc_ptr 16) p
<*> (return $ toReadWrite (rw, ws))
poke p x@(TagOp_GEN2_ReadData {}) = do
(\hsc_ptr -> pokeByteOff hsc_ptr 0) p (1 :: Word32)
(\hsc_ptr -> pokeByteOff hsc_ptr 8) p (fromBank $ opBank x)
pokeOr ((\hsc_ptr -> hsc_ptr `plusPtr` 8) p) (packExtraBanks $ opExtraBanks x)
(\hsc_ptr -> pokeByteOff hsc_ptr 12) p (opWordAddress x)
(\hsc_ptr -> pokeByteOff hsc_ptr 16) p (opLen x)
poke p x@(TagOp_GEN2_WriteTag {}) = do
(\hsc_ptr -> pokeByteOff hsc_ptr 0) p (0 :: Word32)
pokePtr ((\hsc_ptr -> hsc_ptr `plusPtr` 8) p) ((\hsc_ptr -> hsc_ptr `plusPtr` 128) p) (opEpc x)
poke p x@(TagOp_GEN2_WriteData {}) = do
(\hsc_ptr -> pokeByteOff hsc_ptr 0) p (2 :: Word32)
(\hsc_ptr -> pokeByteOff hsc_ptr 8) p (fromBank $ opBank x)
(\hsc_ptr -> pokeByteOff hsc_ptr 12) p (opWordAddress x)
pokeListAsList "data" 128 ((\hsc_ptr -> hsc_ptr `plusPtr` 16) p) ((\hsc_ptr -> hsc_ptr `plusPtr` 128) p) (opData x)
poke p x@(TagOp_GEN2_Lock {}) = do
(\hsc_ptr -> pokeByteOff hsc_ptr 0) p (3 :: Word32)
(\hsc_ptr -> pokeByteOff hsc_ptr 8) p (packLockBits16 $ opMask x)
(\hsc_ptr -> pokeByteOff hsc_ptr 10) p (packLockBits16 $ opAction x)
(\hsc_ptr -> pokeByteOff hsc_ptr 12) p (opAccessPassword x)
poke p x@(TagOp_GEN2_Kill {}) = do
(\hsc_ptr -> pokeByteOff hsc_ptr 0) p (4 :: Word32)
(\hsc_ptr -> pokeByteOff hsc_ptr 8) p (opPassword x)
poke p x@(TagOp_GEN2_BlockWrite {}) = do
(\hsc_ptr -> pokeByteOff hsc_ptr 0) p (5 :: Word32)
(\hsc_ptr -> pokeByteOff hsc_ptr 8) p (fromBank $ opBank x)
(\hsc_ptr -> pokeByteOff hsc_ptr 12) p (opWordPtr x)
pokeListAsList "data" 128 ((\hsc_ptr -> hsc_ptr `plusPtr` 16) p) ((\hsc_ptr -> hsc_ptr `plusPtr` 128) p) (opData x)
poke p x@(TagOp_GEN2_BlockErase {}) = do
(\hsc_ptr -> pokeByteOff hsc_ptr 0) p (7 :: Word32)
(\hsc_ptr -> pokeByteOff hsc_ptr 8) p (fromBank $ opBank x)
(\hsc_ptr -> pokeByteOff hsc_ptr 12) p (opWordPtr x)
(\hsc_ptr -> pokeByteOff hsc_ptr 16) p (opWordCount x)
poke p x@(TagOp_GEN2_BlockPermaLock {}) = do
let (rw, ws) = fromReadWrite $ opReadWrite x
(\hsc_ptr -> pokeByteOff hsc_ptr 0) p (6 :: Word32)
(\hsc_ptr -> pokeByteOff hsc_ptr 8) p rw
(\hsc_ptr -> pokeByteOff hsc_ptr 12) p (fromBank $ opBank x)
(\hsc_ptr -> pokeByteOff hsc_ptr 16) p (opBlockPtr x)
pokeListAsList "mask" 128 ((\hsc_ptr -> hsc_ptr `plusPtr` 24) p) ((\hsc_ptr -> hsc_ptr `plusPtr` 128) p) ws
tagOpName :: TagOp -> Text
tagOpName TagOp_GEN2_ReadData {} = "TagOp_GEN2_ReadData"
tagOpName TagOp_GEN2_WriteTag {} = "TagOp_GEN2_WriteTag"
tagOpName TagOp_GEN2_WriteData {} = "TagOp_GEN2_WriteData"
tagOpName TagOp_GEN2_Lock {} = "TagOp_GEN2_Lock"
tagOpName TagOp_GEN2_Kill {} = "TagOp_GEN2_Kill"
tagOpName TagOp_GEN2_BlockWrite {} = "TagOp_GEN2_BlockWrite"
tagOpName TagOp_GEN2_BlockErase {} = "TagOp_GEN2_BlockErase"
tagOpName TagOp_GEN2_BlockPermaLock {} = "TagOp_GEN2_BlockPermaLock"