{-# 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 Data.WideWord (Word128(Word128),Word256(Word256))
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 ->
        (Integral Word16, Num Int16) => Word16 -> Int16
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
. (Integral Int16, Num Word16) => Int16 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int16 @Word16
  toLittleEndian :: Int16 -> Int16
toLittleEndian = case ByteOrder
targetByteOrder of
    ByteOrder
BigEndian ->
        (Integral Word16, Num Int16) => Word16 -> Int16
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
. (Integral Int16, Num Word16) => Int16 -> Word16
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 ->
        (Integral Word32, Num Int32) => Word32 -> Int32
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
. (Integral Int32, Num Word32) => Int32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int32 @Word32
  toLittleEndian :: Int32 -> Int32
toLittleEndian = case ByteOrder
targetByteOrder of
    ByteOrder
BigEndian ->
        (Integral Word32, Num Int32) => Word32 -> Int32
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
. (Integral Int32, Num Word32) => Int32 -> Word32
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 ->
        (Integral Word64, Num Int64) => Word64 -> Int64
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
. (Integral Int64, Num Word64) => Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int64 @Word64
  toLittleEndian :: Int64 -> Int64
toLittleEndian = case ByteOrder
targetByteOrder of
    ByteOrder
BigEndian ->
        (Integral Word64, Num Int64) => Word64 -> Int64
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
. (Integral Int64, Num Word64) => Int64 -> Word64
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 :: a -> a
toFixedEndian = a -> a
forall a. Bytes a => a -> a
toLittleEndian

instance FixedOrdering 'BigEndian where
  toFixedEndian :: 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)