Copyright | (c) Dong Han 2017-2019 |
---|---|
License | BSD |
Maintainer | winterland1989@gmail.com |
Stability | experimental |
Portability | non-portable |
Safe Haskell | None |
Language | Haskell2010 |
This module implements unaligned element access with ghc primitives (> 8.6), which can be used as a simple binary encoding / decoding method.
Synopsis
- class Unaligned a where
- unalignedSize :: a -> Int
- indexWord8ArrayAs# :: ByteArray# -> Int# -> a
- readWord8ArrayAs# :: MutableByteArray# s -> Int# -> State# s -> (#State# s, a#)
- writeWord8ArrayAs# :: MutableByteArray# s -> Int# -> a -> State# s -> State# s
- peekMBA :: MutableByteArray# RealWorld -> Int -> IO a
- pokeMBA :: MutableByteArray# RealWorld -> Int -> a -> IO ()
- indexBA :: ByteArray# -> Int -> a
- writeWord8ArrayAs :: (PrimMonad m, Unaligned a) => MutableByteArray (PrimState m) -> Int -> a -> m ()
- readWord8ArrayAs :: (PrimMonad m, Unaligned a) => MutableByteArray (PrimState m) -> Int -> m a
- indexWord8ArrayAs :: Unaligned a => ByteArray -> Int -> a
- writePrimWord8ArrayAs :: (PrimMonad m, Unaligned a) => MutablePrimArray (PrimState m) Word8 -> Int -> a -> m ()
- readPrimWord8ArrayAs :: (PrimMonad m, Unaligned a) => MutablePrimArray (PrimState m) Word8 -> Int -> m a
- indexPrimWord8ArrayAs :: Unaligned a => PrimArray Word8 -> Int -> a
- newtype LE a = LE {
- getLE :: a
- newtype BE a = BE {
- getBE :: a
Documentation
class Unaligned a where Source #
Primitive types which can be unaligned accessed
It can also be used as a lightweight method to peek/poke value from/to C structs
when you pass MutableByteArray#
to FFI as struct pointer, e.g.
-- | note the .hsc syntax peekSocketAddrMBA :: HasCallStack => MBA## SocketAddr -> IO SocketAddr peekSocketAddrMBA p = do family <- peekMBA p (#offset struct sockaddr, sa_family) case family :: CSaFamily of (#const AF_INET) -> do addr <- peekMBA p (#offset struct sockaddr_in, sin_addr) port <- peekMBA p (#offset struct sockaddr_in, sin_port) return (SocketAddrInet (PortNumber port) addr) ....
unalignedSize, indexWord8ArrayAs#, writeWord8ArrayAs#, readWord8ArrayAs# | unalignedSize, indexBA, peekMBA, pokeMBA
unalignedSize :: a -> Int Source #
byte size
indexWord8ArrayAs# :: ByteArray# -> Int# -> a Source #
index element off byte array with offset in bytes(maybe unaligned)
readWord8ArrayAs# :: MutableByteArray# s -> Int# -> State# s -> (#State# s, a#) Source #
read element from byte array with offset in bytes(maybe unaligned)
writeWord8ArrayAs# :: MutableByteArray# s -> Int# -> a -> State# s -> State# s Source #
write element to byte array with offset in bytes(maybe unaligned)
peekMBA :: MutableByteArray# RealWorld -> Int -> IO a Source #
IO version of writeWord8ArrayAs#
but more convenient to write manually.
pokeMBA :: MutableByteArray# RealWorld -> Int -> a -> IO () Source #
IO version of readWord8ArrayAs#
but more convenient to write manually.
indexBA :: ByteArray# -> Int -> a Source #
index element off byte array with offset in bytes(maybe unaligned)
Instances
writeWord8ArrayAs :: (PrimMonad m, Unaligned a) => MutableByteArray (PrimState m) -> Int -> a -> m () Source #
Lifted version of writeWord8ArrayAs#
readWord8ArrayAs :: (PrimMonad m, Unaligned a) => MutableByteArray (PrimState m) -> Int -> m a Source #
Lifted version of readWord8ArrayAs#
indexWord8ArrayAs :: Unaligned a => ByteArray -> Int -> a Source #
Lifted version of indexWord8ArrayAs#
writePrimWord8ArrayAs :: (PrimMonad m, Unaligned a) => MutablePrimArray (PrimState m) Word8 -> Int -> a -> m () Source #
Lifted version of writeWord8ArrayAs#
readPrimWord8ArrayAs :: (PrimMonad m, Unaligned a) => MutablePrimArray (PrimState m) Word8 -> Int -> m a Source #
Lifted version of readWord8ArrayAs#
indexPrimWord8ArrayAs :: Unaligned a => PrimArray Word8 -> Int -> a Source #
Lifted version of indexWord8ArrayAs#
little endianess wrapper
Instances
big endianess wrapper