{-# 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
class Bytes a where
toBigEndian :: a -> a
toLittleEndian :: a -> a
instance Bytes Word8 where
{-# INLINE toBigEndian #-}
{-# INLINE toLittleEndian #-}
toBigEndian :: Word8 -> Word8
toBigEndian = Word8 -> Word8
forall a. a -> a
id
toLittleEndian :: Word8 -> Word8
toLittleEndian = Word8 -> Word8
forall a. a -> a
id
instance Bytes Word16 where
{-# INLINE toBigEndian #-}
{-# INLINE toLittleEndian #-}
toBigEndian :: Word16 -> Word16
toBigEndian = case ByteOrder
targetByteOrder of
ByteOrder
BigEndian -> Word16 -> Word16
forall a. a -> a
id
ByteOrder
LittleEndian -> Word16 -> Word16
byteSwap16
toLittleEndian :: Word16 -> Word16
toLittleEndian = case ByteOrder
targetByteOrder of
ByteOrder
BigEndian -> Word16 -> Word16
byteSwap16
ByteOrder
LittleEndian -> Word16 -> Word16
forall a. a -> a
id
instance Bytes Word32 where
{-# INLINE toBigEndian #-}
{-# INLINE toLittleEndian #-}
toBigEndian :: Word32 -> Word32
toBigEndian = case ByteOrder
targetByteOrder of
ByteOrder
BigEndian -> Word32 -> Word32
forall a. a -> a
id
ByteOrder
LittleEndian -> Word32 -> Word32
byteSwap32
toLittleEndian :: Word32 -> Word32
toLittleEndian = case ByteOrder
targetByteOrder of
ByteOrder
BigEndian -> Word32 -> Word32
byteSwap32
ByteOrder
LittleEndian -> Word32 -> Word32
forall a. a -> a
id
instance Bytes Word64 where
{-# INLINE toBigEndian #-}
{-# INLINE toLittleEndian #-}
toBigEndian :: Word64 -> Word64
toBigEndian = case ByteOrder
targetByteOrder of
ByteOrder
BigEndian -> Word64 -> Word64
forall a. a -> a
id
ByteOrder
LittleEndian -> Word64 -> Word64
byteSwap64
toLittleEndian :: Word64 -> Word64
toLittleEndian = case ByteOrder
targetByteOrder of
ByteOrder
BigEndian -> Word64 -> Word64
byteSwap64
ByteOrder
LittleEndian -> Word64 -> Word64
forall a. a -> a
id
instance Bytes Word128 where
{-# INLINE toBigEndian #-}
{-# INLINE toLittleEndian #-}
toBigEndian :: Word128 -> Word128
toBigEndian = case ByteOrder
targetByteOrder of
ByteOrder
BigEndian -> Word128 -> Word128
forall a. a -> a
id
ByteOrder
LittleEndian -> (\(Word128 Word64
hi Word64
lo) -> Word64 -> Word64 -> Word128
Word128 (Word64 -> Word64
byteSwap64 Word64
lo) (Word64 -> Word64
byteSwap64 Word64
hi))
toLittleEndian :: Word128 -> Word128
toLittleEndian = case ByteOrder
targetByteOrder of
ByteOrder
BigEndian -> (\(Word128 Word64
hi Word64
lo) -> Word64 -> Word64 -> Word128
Word128 (Word64 -> Word64
byteSwap64 Word64
lo) (Word64 -> Word64
byteSwap64 Word64
hi))
ByteOrder
LittleEndian -> Word128 -> Word128
forall a. a -> a
id
instance Bytes Word256 where
{-# INLINE toBigEndian #-}
{-# INLINE toLittleEndian #-}
toBigEndian :: Word256 -> Word256
toBigEndian = case ByteOrder
targetByteOrder of
ByteOrder
BigEndian -> Word256 -> Word256
forall a. a -> a
id
ByteOrder
LittleEndian -> (\(Word256 Word64
a Word64
b Word64
c Word64
d) -> Word64 -> Word64 -> Word64 -> Word64 -> Word256
Word256 (Word64 -> Word64
byteSwap64 Word64
d) (Word64 -> Word64
byteSwap64 Word64
c) (Word64 -> Word64
byteSwap64 Word64
b) (Word64 -> Word64
byteSwap64 Word64
a))
toLittleEndian :: Word256 -> Word256
toLittleEndian = case ByteOrder
targetByteOrder of
ByteOrder
BigEndian -> (\(Word256 Word64
a Word64
b Word64
c Word64
d) -> Word64 -> Word64 -> Word64 -> Word64 -> Word256
Word256 (Word64 -> Word64
byteSwap64 Word64
d) (Word64 -> Word64
byteSwap64 Word64
c) (Word64 -> Word64
byteSwap64 Word64
b) (Word64 -> Word64
byteSwap64 Word64
a))
ByteOrder
LittleEndian -> Word256 -> Word256
forall a. a -> a
id
instance Bytes Word where
{-# INLINE toBigEndian #-}
{-# INLINE toLittleEndian #-}
toBigEndian :: Word -> Word
toBigEndian = case ByteOrder
targetByteOrder of
ByteOrder
BigEndian -> Word -> Word
forall a. a -> a
id
ByteOrder
LittleEndian -> Word -> Word
byteSwap
toLittleEndian :: Word -> Word
toLittleEndian = case ByteOrder
targetByteOrder of
ByteOrder
BigEndian -> Word -> Word
byteSwap
ByteOrder
LittleEndian -> Word -> Word
forall a. a -> a
id
instance Bytes Int8 where
{-# INLINE toBigEndian #-}
{-# INLINE toLittleEndian #-}
toBigEndian :: Int8 -> Int8
toBigEndian = Int8 -> Int8
forall a. a -> a
id
toLittleEndian :: Int8 -> Int8
toLittleEndian = Int8 -> Int8
forall a. a -> a
id
instance Bytes Int16 where
{-# INLINE toBigEndian #-}
{-# INLINE toLittleEndian #-}
toBigEndian :: Int16 -> Int16
toBigEndian = case ByteOrder
targetByteOrder of
ByteOrder
BigEndian -> Int16 -> Int16
forall a. a -> a
id
ByteOrder
LittleEndian ->
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word16 @Int16
(Word16 -> Int16) -> (Int16 -> Word16) -> Int16 -> Int16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Word16
byteSwap16
(Word16 -> Word16) -> (Int16 -> Word16) -> Int16 -> Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int16 @Word16
toLittleEndian :: Int16 -> Int16
toLittleEndian = case ByteOrder
targetByteOrder of
ByteOrder
BigEndian ->
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word16 @Int16
(Word16 -> Int16) -> (Int16 -> Word16) -> Int16 -> Int16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Word16
byteSwap16
(Word16 -> Word16) -> (Int16 -> Word16) -> Int16 -> Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int16 @Word16
ByteOrder
LittleEndian -> Int16 -> Int16
forall a. a -> a
id
instance Bytes Int32 where
{-# INLINE toBigEndian #-}
{-# INLINE toLittleEndian #-}
toBigEndian :: Int32 -> Int32
toBigEndian = case ByteOrder
targetByteOrder of
ByteOrder
BigEndian -> Int32 -> Int32
forall a. a -> a
id
ByteOrder
LittleEndian ->
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word32 @Int32
(Word32 -> Int32) -> (Int32 -> Word32) -> Int32 -> Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Word32
byteSwap32
(Word32 -> Word32) -> (Int32 -> Word32) -> Int32 -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int32 @Word32
toLittleEndian :: Int32 -> Int32
toLittleEndian = case ByteOrder
targetByteOrder of
ByteOrder
BigEndian ->
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word32 @Int32
(Word32 -> Int32) -> (Int32 -> Word32) -> Int32 -> Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Word32
byteSwap32
(Word32 -> Word32) -> (Int32 -> Word32) -> Int32 -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int32 @Word32
ByteOrder
LittleEndian -> Int32 -> Int32
forall a. a -> a
id
instance Bytes Int64 where
{-# INLINE toBigEndian #-}
{-# INLINE toLittleEndian #-}
toBigEndian :: Int64 -> Int64
toBigEndian = case ByteOrder
targetByteOrder of
ByteOrder
BigEndian -> Int64 -> Int64
forall a. a -> a
id
ByteOrder
LittleEndian ->
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word64 @Int64
(Word64 -> Int64) -> (Int64 -> Word64) -> Int64 -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Word64
byteSwap64
(Word64 -> Word64) -> (Int64 -> Word64) -> Int64 -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int64 @Word64
toLittleEndian :: Int64 -> Int64
toLittleEndian = case ByteOrder
targetByteOrder of
ByteOrder
BigEndian ->
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word64 @Int64
(Word64 -> Int64) -> (Int64 -> Word64) -> Int64 -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Word64
byteSwap64
(Word64 -> Word64) -> (Int64 -> Word64) -> Int64 -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int64 @Word64
ByteOrder
LittleEndian -> Int64 -> Int64
forall a. a -> a
id
class FixedOrdering (b :: ByteOrder) where
toFixedEndian :: (Bytes a) => a -> a
instance FixedOrdering 'LittleEndian where
toFixedEndian :: forall a. Bytes a => a -> a
toFixedEndian = a -> a
forall a. Bytes a => a -> a
toLittleEndian
instance FixedOrdering 'BigEndian where
toFixedEndian :: forall a. Bytes a => a -> a
toFixedEndian = a -> a
forall a. Bytes a => a -> a
toBigEndian
byteSwap :: Word -> Word
{-# INLINE byteSwap #-}
byteSwap :: Word -> Word
byteSwap (W# Word#
w) = Word# -> Word
W# (Word# -> Word#
Exts.byteSwap# Word#
w)