byte-order (empty) → 0.1.0.0
raw patch · 7 files changed
+452/−0 lines, 7 filesdep +basedep +byte-orderdep +primitivesetup-changed
Dependencies added: base, byte-order, primitive
Files
- CHANGELOG.md +5/−0
- LICENSE +30/−0
- Setup.hs +2/−0
- byte-order.cabal +40/−0
- src/System/ByteOrder.hs +174/−0
- src/System/ByteOrder/Class.hs +133/−0
- test/Unit.hs +68/−0
+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Revision history for byte-order++## 0.1.0.0 -- YYYY-mm-dd++* First version. Released on an unsuspecting world.
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ byte-order.cabal view
@@ -0,0 +1,40 @@+cabal-version: 2.2+name: byte-order+version: 0.1.0.0+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/andrewthad/byte-order+bug-reports: https://github.com/andrewthad/byte-order/issues+license: BSD-3-Clause+license-file: LICENSE+author: Andrew Martin+maintainer: andrew.thaddeus@gmail.com+copyright: 2019 Andrew Martin+category: Data+extra-source-files: CHANGELOG.md++library+ exposed-modules:+ System.ByteOrder+ System.ByteOrder.Class+ build-depends:+ , base >=4.11.1.0 && <5+ , primitive >=0.6.4 && <0.8+ 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+ ghc-options: -Wall -O2+ default-language: Haskell2010
+ src/System/ByteOrder.hs view
@@ -0,0 +1,174 @@+{-# language DataKinds #-}+{-# language GADTSyntax #-}+{-# language KindSignatures #-}+{-# language MagicHash #-}+{-# language RoleAnnotations #-}+{-# language ScopedTypeVariables #-}+{-# 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.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.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++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, 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.++-}
+ src/System/ByteOrder/Class.hs view
@@ -0,0 +1,133 @@+{-# language AllowAmbiguousTypes #-}+{-# language DataKinds #-}+{-# language GADTSyntax #-}+{-# language KindSignatures #-}+{-# language MagicHash #-}+{-# language RoleAnnotations #-}+{-# language ScopedTypeVariables #-}+{-# language TypeApplications #-}+{-# language UnboxedTuples #-}++module System.ByteOrder.Class+ ( FixedOrdering(..)+ , Bytes(..)+ ) where++import Data.Int (Int8,Int16,Int32,Int64)+import Data.Word (Word8,Word16,Word32,Word64)+import Data.Word (byteSwap16,byteSwap32,byteSwap64)+import GHC.ByteOrder (ByteOrder(..),targetByteOrder)+import GHC.ByteOrder (ByteOrder(BigEndian,LittleEndian))++-- | 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 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
+ test/Unit.hs view
@@ -0,0 +1,68 @@+{-# language BangPatterns #-}+{-# language DataKinds #-}+{-# language ScopedTypeVariables #-}+{-# language TypeApplications #-}++import Data.Primitive.ByteArray+import Data.Word+import GHC.Exts (RealWorld)+import System.ByteOrder++main :: IO ()+main = do+ putStrLn "Start"+ putStrLn "A"+ testA+ putStrLn "B"+ testB+ putStrLn "C"+ testC+ 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)+ let name = "testA"+ expectByte name marr 0 0x67+ expectByte name marr 1 0x45+ expectByte name marr 2 0x23+ expectByte name 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++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")+