byte-order-0.1.3.1/0000755000000000000000000000000007346545000012117 5ustar0000000000000000byte-order-0.1.3.1/CHANGELOG.md0000644000000000000000000000112407346545000013726 0ustar0000000000000000# Revision history for byte-order ## 0.1.3.1 -- 2024-02-01 * Update package metadata. ## 0.1.3.0 -- 2021-02-22 * Add a module for big-endian access to pointers. * Add `Bytes` instances for `Word128` and `Word256`. ## 0.1.2.0 -- 2020-01-06 * Add a `Bytes` instance for `Word`. ## 0.1.1.0 -- YYYY-mm-dd * Add `PrimUnaligned` instance for `Fixed`. * Add modules for more convenient interface to reading and writing fixed-endianness elements to byte arrays: `Data.Primitive.ByteArray.LittleEndian` and `Data.Primitive.ByteArray.BigEndian`. ## 0.1.0.0 -- 2019-05-29 * Initial release. byte-order-0.1.3.1/LICENSE0000644000000000000000000000276407346545000013135 0ustar0000000000000000Copyright (c) 2019, Andrew Martin All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Andrew Martin nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. byte-order-0.1.3.1/byte-order.cabal0000644000000000000000000000300207346545000015152 0ustar0000000000000000cabal-version: 2.2 name: byte-order version: 0.1.3.1 synopsis: Portable big-endian and little-endian conversions description: This library provides 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. See the `System.ByteOrder` module for more documentation. homepage: https://github.com/byteverse/byte-order bug-reports: https://github.com/byteverse/byte-order/issues license: BSD-3-Clause license-file: LICENSE author: Andrew Martin maintainer: amartin@layer3com.com copyright: 2019 Andrew Martin category: Data extra-doc-files: CHANGELOG.md library exposed-modules: Data.Primitive.ByteArray.BigEndian Data.Primitive.ByteArray.LittleEndian Data.Primitive.Ptr.BigEndian System.ByteOrder System.ByteOrder.Class build-depends: , base >=4.11.1.0 && <5 , primitive >=0.6.4 && <0.10 , primitive-unaligned >=0.1.1 && <0.2 , wide-word >=0.1.1 && <0.2 hs-source-dirs: src default-language: Haskell2010 ghc-options: -O2 -Wall test-suite unit type: exitcode-stdio-1.0 hs-source-dirs: test main-is: Unit.hs build-depends: , base , byte-order , primitive , wide-word ghc-options: -Wall -O2 default-language: Haskell2010 source-repository head type: git location: git://github.com/byteverse/byte-order.git byte-order-0.1.3.1/src/Data/Primitive/ByteArray/0000755000000000000000000000000007346545000017431 5ustar0000000000000000byte-order-0.1.3.1/src/Data/Primitive/ByteArray/BigEndian.hs0000644000000000000000000000561107346545000021610 0ustar0000000000000000{- | This is drop-in replacement for the read, write, and index functions present in @Data.Primitive.ByteArray@ and @Data.Primitive.ByteArray.Unaligned@. While the functions from those modules use native byte order, the functions in this one use big-endian byte order (most significant byte first). -} module Data.Primitive.ByteArray.BigEndian ( -- * Aligned writeByteArray , readByteArray , indexByteArray -- * Unaligned , writeUnalignedByteArray , readUnalignedByteArray , indexUnalignedByteArray ) where import Control.Monad.Primitive (PrimMonad, PrimState) import Data.Primitive (ByteArray, MutableByteArray, Prim) import qualified Data.Primitive as PM import Data.Primitive.ByteArray.Unaligned (PrimUnaligned) import qualified Data.Primitive.ByteArray.Unaligned as PMU import System.ByteOrder (Bytes, fromBigEndian, toBigEndian) {- | Write a primitive value to the byte array. The offset is given in elements of type @a@ rather than in bytes. The most significant byte in the value comes first. -} writeByteArray :: (PrimMonad m, Prim a, Bytes a) => MutableByteArray (PrimState m) -> Int -> a -> m () writeByteArray arr ix v = PM.writeByteArray arr ix (toBigEndian v) {- | Read a primitive value from the byte array, interpreting the first byte as the most significant one. The offset is given in elements of type @a@ rather than in bytes. -} readByteArray :: (PrimMonad m, Prim a, Bytes a) => MutableByteArray (PrimState m) -> Int -> m a readByteArray arr ix = fromBigEndian <$> PM.readByteArray arr ix {- | Read a primitive value from the byte array, interpreting the first byte as the most significant one. The offset is given in elements of type @a@ rather than in bytes. -} indexByteArray :: (Prim a, Bytes a) => ByteArray -> Int -> a indexByteArray arr ix = fromBigEndian (PM.indexByteArray arr ix) {- | Write a primitive value to the byte array. The offset is given in bytes rather than in elements of type @a@. The most significant byte in the value comes first. -} writeUnalignedByteArray :: (PrimMonad m, PrimUnaligned a, Bytes a) => MutableByteArray (PrimState m) -> Int -> a -> m () writeUnalignedByteArray arr ix v = PMU.writeUnalignedByteArray arr ix (toBigEndian v) {- | Read a primitive value from the byte array, interpreting the first byte as the most significant one. The offset is given in bytes rather than in elements of type @a@. -} readUnalignedByteArray :: (PrimMonad m, PrimUnaligned a, Bytes a) => MutableByteArray (PrimState m) -> Int -> m a readUnalignedByteArray arr ix = fromBigEndian <$> PMU.readUnalignedByteArray arr ix {- | Read a primitive value from the byte array, interpreting the first byte as the most significant one. The offset is given in bytes rather than in elements of type @a@. -} indexUnalignedByteArray :: (PrimUnaligned a, Bytes a) => ByteArray -> Int -> a indexUnalignedByteArray arr ix = fromBigEndian (PMU.indexUnalignedByteArray arr ix) byte-order-0.1.3.1/src/Data/Primitive/ByteArray/LittleEndian.hs0000644000000000000000000000570007346545000022343 0ustar0000000000000000{- | This is drop-in replacement for the read, write, and index functions present in @Data.Primitive.ByteArray@ and @Data.Primitive.ByteArray.Unaligned@. While the functions from those modules use native byte order, the functions in this one use little-endian byte order (least significant byte first). -} module Data.Primitive.ByteArray.LittleEndian ( -- * Aligned writeByteArray , readByteArray , indexByteArray -- * Unaligned , writeUnalignedByteArray , readUnalignedByteArray , indexUnalignedByteArray ) where import Control.Monad.Primitive (PrimMonad, PrimState) import Data.Primitive (ByteArray, MutableByteArray, Prim) import qualified Data.Primitive as PM import Data.Primitive.ByteArray.Unaligned (PrimUnaligned) import qualified Data.Primitive.ByteArray.Unaligned as PMU import System.ByteOrder (Bytes, fromLittleEndian, toLittleEndian) {- | Write a primitive value to the byte array. The offset is given in elements of type @a@ rather than in bytes. The least significant byte in the value comes first. -} writeByteArray :: (PrimMonad m, Prim a, Bytes a) => MutableByteArray (PrimState m) -> Int -> a -> m () writeByteArray arr ix v = PM.writeByteArray arr ix (toLittleEndian v) {- | Read a primitive value from the byte array, interpreting the first byte as the least significant one. The offset is given in elements of type @a@ rather than in bytes. -} readByteArray :: (PrimMonad m, Prim a, Bytes a) => MutableByteArray (PrimState m) -> Int -> m a readByteArray arr ix = fromLittleEndian <$> PM.readByteArray arr ix {- | Read a primitive value from the byte array, interpreting the first byte as the least significant one. The offset is given in elements of type @a@ rather than in bytes. -} indexByteArray :: (Prim a, Bytes a) => ByteArray -> Int -> a indexByteArray arr ix = fromLittleEndian (PM.indexByteArray arr ix) {- | Write a primitive value to the byte array. The offset is given in bytes rather than in elements of type @a@. The least significant byte in the value comes first. -} writeUnalignedByteArray :: (PrimMonad m, PrimUnaligned a, Bytes a) => MutableByteArray (PrimState m) -> Int -> a -> m () writeUnalignedByteArray arr ix v = PMU.writeUnalignedByteArray arr ix (toLittleEndian v) {- | Read a primitive value from the byte array, interpreting the first byte as the least significant one. The offset is given in bytes rather than in elements of type @a@. -} readUnalignedByteArray :: (PrimMonad m, PrimUnaligned a, Bytes a) => MutableByteArray (PrimState m) -> Int -> m a readUnalignedByteArray arr ix = fromLittleEndian <$> PMU.readUnalignedByteArray arr ix {- | Read a primitive value from the byte array, interpreting the first byte as the least significant one. The offset is given in bytes rather than in elements of type @a@. -} indexUnalignedByteArray :: (PrimUnaligned a, Bytes a) => ByteArray -> Int -> a indexUnalignedByteArray arr ix = fromLittleEndian (PMU.indexUnalignedByteArray arr ix) byte-order-0.1.3.1/src/Data/Primitive/Ptr/0000755000000000000000000000000007346545000016274 5ustar0000000000000000byte-order-0.1.3.1/src/Data/Primitive/Ptr/BigEndian.hs0000644000000000000000000000266507346545000020461 0ustar0000000000000000{- | This is drop-in replacement for the read, write, and index functions present in @Data.Primitive.Ptr@. While the functions from those modules use native byte order, the functions in this one use big-endian byte order (most significant byte first). -} module Data.Primitive.Ptr.BigEndian ( -- * Aligned writeOffPtr , readOffPtr , indexOffPtr ) where import Control.Monad.Primitive (PrimMonad) import Data.Primitive (Prim) import Data.Primitive.Ptr (Ptr) import qualified Data.Primitive.Ptr as PM import System.ByteOrder (Bytes, fromBigEndian, toBigEndian) {- | Write a primitive value to the pointer. The offset is given in elements of type @a@ rather than in bytes. The most significant byte in the value comes first. -} writeOffPtr :: (PrimMonad m, Prim a, Bytes a) => Ptr a -> Int -> a -> m () writeOffPtr arr ix v = PM.writeOffPtr arr ix (toBigEndian v) {- | Read a primitive value from the pointer, interpreting the first byte as the most significant one. The offset is given in elements of type @a@ rather than in bytes. -} readOffPtr :: (PrimMonad m, Prim a, Bytes a) => Ptr a -> Int -> m a readOffPtr arr ix = fromBigEndian <$> PM.readOffPtr arr ix {- | Read a primitive value from the pointer, interpreting the first byte as the most significant one. The offset is given in elements of type @a@ rather than in bytes. -} indexOffPtr :: (Prim a, Bytes a) => Ptr a -> Int -> a indexOffPtr arr ix = fromBigEndian (PM.indexOffPtr arr ix) byte-order-0.1.3.1/src/System/0000755000000000000000000000000007346545000014172 5ustar0000000000000000byte-order-0.1.3.1/src/System/ByteOrder.hs0000644000000000000000000001761307346545000016435 0ustar0000000000000000{-# LANGUAGE DataKinds #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE GADTSyntax #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE RoleAnnotations #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE UnboxedTuples #-} {- | 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', and 'fromLittleEndian' convert between native-endian words and big/little-endian words. The word resulting from @to(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 to @from(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. The example at the bottom of this page demonstrates how to use the type-directed interface. -} module System.ByteOrder ( -- * Types ByteOrder (..) , Fixed (..) -- * Classes , Bytes , FixedOrdering -- * Conversion , toBigEndian , toLittleEndian , fromBigEndian , fromLittleEndian -- * System Byte Order , targetByteOrder -- * Example -- $example ) where import Data.Kind (Type) import Data.Primitive.ByteArray.Unaligned (PrimUnaligned) import Data.Primitive.Types (Prim) import Foreign.Ptr (Ptr, castPtr) import Foreign.Storable (Storable) import GHC.ByteOrder (ByteOrder (..), targetByteOrder) import System.ByteOrder.Class (Bytes (..), FixedOrdering, toFixedEndian) import qualified Data.Primitive.ByteArray.Unaligned as PMU import qualified Data.Primitive.Types as PM import qualified Foreign.Storable as FS -- | Convert from a big-endian word to a native-endian word. fromBigEndian :: (Bytes a) => a -> a fromBigEndian = toBigEndian -- | Convert from a little-endian word to a native-endian word. fromLittleEndian :: (Bytes a) => a -> a fromLittleEndian = toLittleEndian {- | A word whose byte order is specified (not platform dependent) when working with 'Prim', 'Storable', and @PrimUnaligned@ (this last instance is provided alongside the typeclass itself in the @primitive-unaligned@ library). -} newtype Fixed :: ByteOrder -> Type -> Type where Fixed :: forall (b :: ByteOrder) (a :: Type). {getFixed :: a} -> Fixed b a type role Fixed phantom representational deriving newtype instance (Num a) => Num (Fixed b a) deriving newtype instance (Real a) => Real (Fixed b a) deriving newtype instance (Integral a) => Integral (Fixed b a) deriving newtype instance (Ord a) => Ord (Fixed b a) deriving newtype instance (Enum a) => Enum (Fixed b a) deriving newtype instance (Eq a) => Eq (Fixed b a) instance (FixedOrdering b, Prim a, Bytes a) => Prim (Fixed b a) where {-# INLINE sizeOf# #-} {-# INLINE alignment# #-} {-# INLINE indexByteArray# #-} {-# INLINE readByteArray# #-} {-# INLINE writeByteArray# #-} {-# INLINE setByteArray# #-} {-# INLINE indexOffAddr# #-} {-# INLINE readOffAddr# #-} {-# INLINE writeOffAddr# #-} {-# INLINE setOffAddr# #-} sizeOf# _ = PM.sizeOf# (undefined :: a) alignment# _ = PM.alignment# (undefined :: a) indexByteArray# a i = Fixed (toFixedEndian @b (PM.indexByteArray# a i)) readByteArray# a i s0 = case PM.readByteArray# a i s0 of (# s1, x #) -> (# s1, Fixed (toFixedEndian @b x) #) writeByteArray# a i (Fixed x) = PM.writeByteArray# a i (toFixedEndian @b x) setByteArray# a i n (Fixed x) = PM.setByteArray# a i n (toFixedEndian @b x) indexOffAddr# a i = Fixed (toFixedEndian @b (PM.indexOffAddr# a i)) readOffAddr# a i s0 = case PM.readOffAddr# a i s0 of (# s1, x #) -> (# s1, Fixed (toFixedEndian @b x) #) writeOffAddr# a i (Fixed x) = PM.writeOffAddr# a i (toFixedEndian @b x) setOffAddr# a i n (Fixed x) = PM.setOffAddr# a i n (toFixedEndian @b x) instance (FixedOrdering b, PrimUnaligned a, Bytes a) => PrimUnaligned (Fixed b a) where {-# INLINE indexUnalignedByteArray# #-} {-# INLINE readUnalignedByteArray# #-} {-# INLINE writeUnalignedByteArray# #-} indexUnalignedByteArray# a i = Fixed (toFixedEndian @b (PMU.indexUnalignedByteArray# a i)) readUnalignedByteArray# a i s0 = case PMU.readUnalignedByteArray# a i s0 of (# s1, x #) -> (# s1, Fixed (toFixedEndian @b x) #) writeUnalignedByteArray# a i (Fixed x) = PMU.writeUnalignedByteArray# a i (toFixedEndian @b x) instance (FixedOrdering b, Storable a, Bytes a) => Storable (Fixed b a) where {-# INLINE sizeOf #-} {-# INLINE alignment #-} {-# INLINE peekElemOff #-} {-# INLINE pokeElemOff #-} {-# INLINE peekByteOff #-} {-# INLINE pokeByteOff #-} {-# INLINE peek #-} {-# INLINE poke #-} sizeOf _ = FS.sizeOf (undefined :: a) alignment _ = FS.alignment (undefined :: a) peekElemOff p i = fmap (Fixed . toFixedEndian @b) (FS.peekElemOff (fromFixedPtr p) i) pokeElemOff p i (Fixed x) = FS.pokeElemOff (fromFixedPtr p) i (toFixedEndian @b x) peekByteOff p i = fmap (Fixed . toFixedEndian @b) (FS.peekByteOff p i) pokeByteOff p i (Fixed x) = FS.pokeByteOff p i (toFixedEndian @b x) peek p = fmap (Fixed . toFixedEndian @b) (FS.peek (fromFixedPtr p)) poke p (Fixed x) = FS.poke (fromFixedPtr p) (toFixedEndian @b x) fromFixedPtr :: Ptr (Fixed b a) -> Ptr a {-# INLINE fromFixedPtr #-} fromFixedPtr = castPtr {- $example 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: 1. The client sends the server a little-endian 16-bit number @N@. This is how many numbers will follow. 2. The client sends @N@ little-endian 64-bit numbers to the server. 3. The server responds with two little-endian 64-bit numbers: the sum and the product of the @N@ numbers it received. Assume the existence of a @send@ and @receive@ that block until the total number of requested bytes have been handled. They both work on their argument arrays starting at index zero, which ensures that any 2-byte, 4-byte, or 8-byte types will be aligned properly. (GHC always machine-word aligns the payload of a byte array.) Additionally, assume the @typed@ and @untyped@ functions 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: > import Data.Primitive.ByteArray > import Data.Primitive.PrimArray > import System.ByteOrder > > 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 every explicit type annotation above is needed. Some are provided for the reader's benefit. 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. -} byte-order-0.1.3.1/src/System/ByteOrder/0000755000000000000000000000000007346545000016071 5ustar0000000000000000byte-order-0.1.3.1/src/System/ByteOrder/Class.hs0000644000000000000000000001210307346545000017467 0ustar0000000000000000{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE GADTSyntax #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE RoleAnnotations #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} module System.ByteOrder.Class ( FixedOrdering (..) , Bytes (..) ) where import Data.Int (Int16, Int32, Int64, Int8) import Data.WideWord (Word128 (Word128), Word256 (Word256)) import Data.Word (Word16, Word32, Word64, Word8, byteSwap16, byteSwap32, byteSwap64) import GHC.ByteOrder (ByteOrder (BigEndian, LittleEndian), targetByteOrder) import GHC.Word (Word (W#)) import qualified GHC.Exts as Exts {- | 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. -} class Bytes a where -- | Convert from a native-endian word to a big-endian word. toBigEndian :: a -> a -- | Convert from a native-endian word to a little-endian word. toLittleEndian :: a -> a instance Bytes Word8 where {-# INLINE toBigEndian #-} {-# INLINE toLittleEndian #-} toBigEndian = id toLittleEndian = id instance Bytes Word16 where {-# INLINE toBigEndian #-} {-# INLINE toLittleEndian #-} toBigEndian = case targetByteOrder of BigEndian -> id LittleEndian -> byteSwap16 toLittleEndian = case targetByteOrder of BigEndian -> byteSwap16 LittleEndian -> id instance Bytes Word32 where {-# INLINE toBigEndian #-} {-# INLINE toLittleEndian #-} toBigEndian = case targetByteOrder of BigEndian -> id LittleEndian -> byteSwap32 toLittleEndian = case targetByteOrder of BigEndian -> byteSwap32 LittleEndian -> id instance Bytes Word64 where {-# INLINE toBigEndian #-} {-# INLINE toLittleEndian #-} toBigEndian = case targetByteOrder of BigEndian -> id LittleEndian -> byteSwap64 toLittleEndian = case targetByteOrder of BigEndian -> byteSwap64 LittleEndian -> id instance Bytes Word128 where {-# INLINE toBigEndian #-} {-# INLINE toLittleEndian #-} toBigEndian = case targetByteOrder of BigEndian -> id LittleEndian -> (\(Word128 hi lo) -> Word128 (byteSwap64 lo) (byteSwap64 hi)) toLittleEndian = case targetByteOrder of BigEndian -> (\(Word128 hi lo) -> Word128 (byteSwap64 lo) (byteSwap64 hi)) LittleEndian -> id instance Bytes Word256 where {-# INLINE toBigEndian #-} {-# INLINE toLittleEndian #-} toBigEndian = case targetByteOrder of BigEndian -> id LittleEndian -> (\(Word256 a b c d) -> Word256 (byteSwap64 d) (byteSwap64 c) (byteSwap64 b) (byteSwap64 a)) toLittleEndian = case targetByteOrder of BigEndian -> (\(Word256 a b c d) -> Word256 (byteSwap64 d) (byteSwap64 c) (byteSwap64 b) (byteSwap64 a)) LittleEndian -> id instance Bytes Word where {-# INLINE toBigEndian #-} {-# INLINE toLittleEndian #-} toBigEndian = case targetByteOrder of BigEndian -> id LittleEndian -> byteSwap toLittleEndian = case targetByteOrder of BigEndian -> byteSwap LittleEndian -> id instance Bytes Int8 where {-# INLINE toBigEndian #-} {-# INLINE toLittleEndian #-} toBigEndian = id toLittleEndian = id instance Bytes Int16 where {-# INLINE toBigEndian #-} {-# INLINE toLittleEndian #-} toBigEndian = case targetByteOrder of BigEndian -> id LittleEndian -> fromIntegral @Word16 @Int16 . byteSwap16 . fromIntegral @Int16 @Word16 toLittleEndian = case targetByteOrder of BigEndian -> fromIntegral @Word16 @Int16 . byteSwap16 . fromIntegral @Int16 @Word16 LittleEndian -> id instance Bytes Int32 where {-# INLINE toBigEndian #-} {-# INLINE toLittleEndian #-} toBigEndian = case targetByteOrder of BigEndian -> id LittleEndian -> fromIntegral @Word32 @Int32 . byteSwap32 . fromIntegral @Int32 @Word32 toLittleEndian = case targetByteOrder of BigEndian -> fromIntegral @Word32 @Int32 . byteSwap32 . fromIntegral @Int32 @Word32 LittleEndian -> id instance Bytes Int64 where {-# INLINE toBigEndian #-} {-# INLINE toLittleEndian #-} toBigEndian = case targetByteOrder of BigEndian -> id LittleEndian -> fromIntegral @Word64 @Int64 . byteSwap64 . fromIntegral @Int64 @Word64 toLittleEndian = case targetByteOrder of BigEndian -> fromIntegral @Word64 @Int64 . byteSwap64 . fromIntegral @Int64 @Word64 LittleEndian -> id {- | 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'. -} class FixedOrdering (b :: ByteOrder) where toFixedEndian :: (Bytes a) => a -> a instance FixedOrdering 'LittleEndian where toFixedEndian = toLittleEndian instance FixedOrdering 'BigEndian where toFixedEndian = toBigEndian byteSwap :: Word -> Word {-# INLINE byteSwap #-} byteSwap (W# w) = W# (Exts.byteSwap# w) byte-order-0.1.3.1/test/0000755000000000000000000000000007346545000013076 5ustar0000000000000000byte-order-0.1.3.1/test/Unit.hs0000644000000000000000000000702407346545000014354 0ustar0000000000000000{-# LANGUAGE DataKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} import Control.Monad (when) import Data.Primitive.ByteArray import Data.WideWord (Word128) import Data.Word import GHC.Exts (RealWorld) import System.ByteOrder import qualified Data.Primitive.ByteArray.BigEndian as BE main :: IO () main = do putStrLn "Start" putStrLn "A" testA putStrLn "B" testB putStrLn "C" testC putStrLn "D" testD putStrLn "E" testE putStrLn "F" testF putStrLn "Finished" testA :: IO () testA = do let payload = 0x01234567 :: Word32 marr <- newByteArray 4 setByteArray marr 0 4 (0x00 :: Word8) writeByteArray marr 0 (Fixed @'LittleEndian payload) expectByte "testA, byte 0" marr 0 0x67 expectByte "testA, byte 1" marr 1 0x45 expectByte "testA, byte 2" marr 2 0x23 expectByte "testA, byte 3" marr 3 0x01 testB :: IO () testB = do let payload = 0x01234567 :: Word32 marr <- newByteArray 4 setByteArray marr 0 4 (0x00 :: Word8) writeByteArray marr 0 (Fixed @'BigEndian payload) let name = "testB" expectByte name marr 0 0x01 expectByte name marr 1 0x23 expectByte name marr 2 0x45 expectByte name marr 3 0x67 testC :: IO () testC = do let payload = 0x0123456789ABCDEF :: Word64 marr <- newByteArray 8 setByteArray marr 0 8 (0x00 :: Word8) writeByteArray marr 0 (Fixed @'BigEndian payload) let name = "testC" expectByte name marr 0 0x01 expectByte name marr 1 0x23 expectByte name marr 2 0x45 expectByte name marr 3 0x67 expectByte name marr 4 0x89 expectByte name marr 5 0xAB expectByte name marr 6 0xCD expectByte name marr 7 0xEF testD :: IO () testD = do let payload = 0x01234567 :: Word marr <- newByteArray 20 setByteArray marr 0 20 (0x00 :: Word8) writeByteArray marr 0 (Fixed @'LittleEndian payload) let name = "testD" expectByte name marr 0 0x67 expectByte name marr 1 0x45 expectByte name marr 2 0x23 expectByte name marr 3 0x01 expectByte name marr 4 0x00 testE :: IO () testE = do marr <- newByteArray 8 writeByteArray marr 0 (0xFF :: Word8) writeByteArray marr 1 (0xFF :: Word8) writeByteArray marr 2 (0xFF :: Word8) writeByteArray marr 3 (0xFF :: Word8) writeByteArray marr 4 (0x00 :: Word8) writeByteArray marr 5 (0x06 :: Word8) writeByteArray marr 6 (0x96 :: Word8) writeByteArray marr 7 (0x9c :: Word8) r <- BE.readByteArray marr 1 let expected = 0x0006969c :: Word32 when (r /= expected) (fail "testE failed") testF :: IO () testF = do marr <- newByteArray 32 writeByteArray marr 16 (0x00 :: Word8) writeByteArray marr 17 (0x01 :: Word8) writeByteArray marr 18 (0x02 :: Word8) writeByteArray marr 19 (0x03 :: Word8) writeByteArray marr 20 (0x04 :: Word8) writeByteArray marr 21 (0x05 :: Word8) writeByteArray marr 22 (0x06 :: Word8) writeByteArray marr 23 (0x07 :: Word8) writeByteArray marr 24 (0x08 :: Word8) writeByteArray marr 25 (0x09 :: Word8) writeByteArray marr 26 (0x0A :: Word8) writeByteArray marr 27 (0x0B :: Word8) writeByteArray marr 28 (0x0C :: Word8) writeByteArray marr 29 (0x0D :: Word8) writeByteArray marr 30 (0x0E :: Word8) writeByteArray marr 31 (0x0F :: Word8) r <- BE.readByteArray marr 1 let expected = 0x000102030405060708090A0B0C0D0E0F :: Word128 when (r /= expected) (fail "testF failed") expectByte :: String -> MutableByteArray RealWorld -> Int -> Word8 -> IO () expectByte name marr ix w = do v <- readByteArray marr ix if v == w then pure () else fail (name ++ ": byte " ++ show ix ++ " was wrong, expected " ++ show w ++ " but got " ++ show v)