{-# 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 :: 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

{- | 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 :: 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)