Safe Haskell | None |
---|---|
Language | Haskell2010 |
This module offers an interface to portably work with byte arrays whose contents are known to be of a fixed endianness. There are two ways to use this module:
- Untyped Conversions: The functions
toBigEndian
,toLittleEndian
,fromBigEndian
, andfromLittleEndian
convert between native-endian words and big/little-endian words. The word resulting fromto(Big|Little)Endian
should be written to a primitive byte array or a pointer afterwards. (There is no other purpose of such a conversion.) Similarly, the argument tofrom(Big|Little)Endian
should be a word that was read from a primitive byte array or a pointer. This interface is useful when serializing or deserializing a data structure with fields of varying sizes. - Typed Conversions: The type
Fixed
provides a convenient type-directed interface to working with arrays of homogenous words. This interface is easier to use and should be preferred when possible.
Suppose there is a protocol for aggregating numbers that uses stream sockets for communication. The protocol interprets all numbers as unsigned. It is described as follows:
- The client sends the server a little-endian 16-bit number
N
. This is the count of numbers that will follow. - The client sends the server
N
little-endian 64-bit numbers. - The server responds with two 64-bit numbers: the sum and the product.
Assume the existence of a send
and receive
that block until
the total number of requested bytes have been handled. Additionally,
assume a typed
and untyped
function that convert between
PrimArray
and ByteArray
by changing out the data constructor.
send :: Socket -> ByteArray -> IO () receive :: Socket -> Int -> IO ByteArray typed :: ByteArray -> PrimArray a untyped :: PrimArray a -> ByteArray
For simplicity, all error-handling is omitted. With the type-directed interface, the server is implemented as:
server :: Socket -> IO a server sckt = forever $ do totalByteArray <- receive sckt 2 let totalPrimArray = typed totalByteArray :: PrimArray (Fixed 'LittleEndian Word16) let Fixed total = indexPrimArray totalPrimArray 0 numberByteArray <- receive sckt (8 * fromIntegral @Word16 @Int total) let (sum,prod) = foldlPrimArray' (\(!sumN,!prodN) (Fixed n) -> (sumN + n, prodN * n)) (0,1) (typed numberByteArray :: PrimArray (Fixed 'LittleEndian Word64)) reply :: MutablePrimArray RealWorld (Fixed 'LittleEndian Word64) <- newPrimArray 2 writePrimArray reply 0 (Fixed sum) writePrimArray reply 1 (Fixed prod) send sckt . untyped =<< unsafeFreezePrimArray reply
Not all of the explicit type annotations are needed, but they have been
provided for additional clarity. As long as the user ensures that the
typed primitive arrays use Fixed
in their element types, the endianness
conversions are guaranteed to be correct.
Synopsis
- data ByteOrder
- newtype Fixed :: ByteOrder -> Type -> Type where
- targetByteOrder :: ByteOrder
- class Bytes a
- class FixedOrdering (b :: ByteOrder)
- toBigEndian :: Bytes a => a -> a
- toLittleEndian :: Bytes a => a -> a
- fromBigEndian :: Bytes a => a -> a
- fromLittleEndian :: Bytes a => a -> a
Types
Byte ordering.
BigEndian | most-significant-byte occurs in lowest address. |
LittleEndian | least-significant-byte occurs in lowest address. |
Instances
Bounded ByteOrder | Since: base-4.11.0.0 |
Enum ByteOrder | Since: base-4.11.0.0 |
Defined in GHC.ByteOrder succ :: ByteOrder -> ByteOrder # pred :: ByteOrder -> ByteOrder # fromEnum :: ByteOrder -> Int # enumFrom :: ByteOrder -> [ByteOrder] # enumFromThen :: ByteOrder -> ByteOrder -> [ByteOrder] # enumFromTo :: ByteOrder -> ByteOrder -> [ByteOrder] # enumFromThenTo :: ByteOrder -> ByteOrder -> ByteOrder -> [ByteOrder] # | |
Eq ByteOrder | Since: base-4.11.0.0 |
Ord ByteOrder | Since: base-4.11.0.0 |
Defined in GHC.ByteOrder | |
Read ByteOrder | Since: base-4.11.0.0 |
Show ByteOrder | Since: base-4.11.0.0 |
newtype Fixed :: ByteOrder -> Type -> Type where Source #
A word whose byte order is specified (not platform dependent)
when working with Prim
and Storable
.
Instances
(FixedOrdering b, Prim a, Bytes a) => Prim (Fixed b a) Source # | |
Defined in System.ByteOrder.Unsafe sizeOf# :: Fixed b a -> Int# # alignment# :: Fixed b a -> Int# # indexByteArray# :: ByteArray# -> Int# -> Fixed b a # readByteArray# :: MutableByteArray# s -> Int# -> State# s -> (#State# s, Fixed b a#) # writeByteArray# :: MutableByteArray# s -> Int# -> Fixed b a -> State# s -> State# s # setByteArray# :: MutableByteArray# s -> Int# -> Int# -> Fixed b a -> State# s -> State# s # indexOffAddr# :: Addr# -> Int# -> Fixed b a # readOffAddr# :: Addr# -> Int# -> State# s -> (#State# s, Fixed b a#) # writeOffAddr# :: Addr# -> Int# -> Fixed b a -> State# s -> State# s # setOffAddr# :: Addr# -> Int# -> Int# -> Fixed b a -> State# s -> State# s # |
System Byte Order
targetByteOrder :: ByteOrder #
The byte ordering of the target machine.
Classes
Types that are represented as a fixed-sized word. For these types, the bytes can be swapped. The instances of this class use byteswapping primitives and compile-time knowledge of native endianness to provide portable endianness conversion functions.
Instances
class FixedOrdering (b :: ByteOrder) Source #
A byte order that can be interpreted as a conversion function.
This class is effectively closed. The only instances are for
BigEndian
and LittleEndian
. It is not possible to write more
instances since there are no other inhabitants of ByteOrder
.
Instances
FixedOrdering LittleEndian Source # | |
Defined in System.ByteOrder.Unsafe toFixedEndian :: Bytes a => a -> a Source # | |
FixedOrdering BigEndian Source # | |
Defined in System.ByteOrder.Unsafe toFixedEndian :: Bytes a => a -> a Source # |
Convert
toBigEndian :: Bytes a => a -> a Source #
Convert from a native-endian word to a big-endian word.
toLittleEndian :: Bytes a => a -> a Source #
Convert from a native-endian word to a little-endian word.
fromBigEndian :: Bytes a => a -> a Source #
Convert from a big-endian word to a native-endian word.
fromLittleEndian :: Bytes a => a -> a Source #
Convert from a little-endian word to a native-endian word.