module Dahdit.Internal where

import Data.Bits (Bits (..))
import Data.Int (Int16, Int32, Int64, Int8)
import Data.ShortWord (Int24, Word24)
import Data.Word (Word16, Word32, Word64, Word8)
import GHC.Float (castDoubleToWord64, castFloatToWord32, castWord32ToFloat, castWord64ToDouble)

newtype ViaFromIntegral x y = ViaFromIntegral {forall x y. ViaFromIntegral x y -> y
unViaFromIntegral :: y}
  deriving newtype (Integer -> ViaFromIntegral x y
ViaFromIntegral x y -> ViaFromIntegral x y
ViaFromIntegral x y -> ViaFromIntegral x y -> ViaFromIntegral x y
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
forall x y. Num y => Integer -> ViaFromIntegral x y
forall x y. Num y => ViaFromIntegral x y -> ViaFromIntegral x y
forall x y.
Num y =>
ViaFromIntegral x y -> ViaFromIntegral x y -> ViaFromIntegral x y
fromInteger :: Integer -> ViaFromIntegral x y
$cfromInteger :: forall x y. Num y => Integer -> ViaFromIntegral x y
signum :: ViaFromIntegral x y -> ViaFromIntegral x y
$csignum :: forall x y. Num y => ViaFromIntegral x y -> ViaFromIntegral x y
abs :: ViaFromIntegral x y -> ViaFromIntegral x y
$cabs :: forall x y. Num y => ViaFromIntegral x y -> ViaFromIntegral x y
negate :: ViaFromIntegral x y -> ViaFromIntegral x y
$cnegate :: forall x y. Num y => ViaFromIntegral x y -> ViaFromIntegral x y
* :: ViaFromIntegral x y -> ViaFromIntegral x y -> ViaFromIntegral x y
$c* :: forall x y.
Num y =>
ViaFromIntegral x y -> ViaFromIntegral x y -> ViaFromIntegral x y
- :: ViaFromIntegral x y -> ViaFromIntegral x y -> ViaFromIntegral x y
$c- :: forall x y.
Num y =>
ViaFromIntegral x y -> ViaFromIntegral x y -> ViaFromIntegral x y
+ :: ViaFromIntegral x y -> ViaFromIntegral x y -> ViaFromIntegral x y
$c+ :: forall x y.
Num y =>
ViaFromIntegral x y -> ViaFromIntegral x y -> ViaFromIntegral x y
Num)

-- Types that can swap endianness - swapEndian is its own inverse
class Num w => SwapEndian w where
  swapEndian :: w -> w

instance (SwapEndian x, Integral x, Integral y) => SwapEndian (ViaFromIntegral x y) where
  swapEndian :: ViaFromIntegral x y -> ViaFromIntegral x y
swapEndian = forall x y. y -> ViaFromIntegral x y
ViaFromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral @x @y forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall w. SwapEndian w => w -> w
swapEndian forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral @y @x forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x y. ViaFromIntegral x y -> y
unViaFromIntegral

instance SwapEndian Word8 where
  swapEndian :: Word8 -> Word8
swapEndian = forall a. a -> a
id

instance SwapEndian Int8 where
  swapEndian :: Int8 -> Int8
swapEndian = forall a. a -> a
id

instance SwapEndian Word16 where
  swapEndian :: Word16 -> Word16
swapEndian Word16
w =
    let (!Word8
b0, !Word8
b1) = Word16 -> (Word8, Word8)
unMkWord16LE Word16
w
    in  Word8 -> Word8 -> Word16
mkWord16LE Word8
b1 Word8
b0

deriving via (ViaFromIntegral Word16 Int16) instance SwapEndian Int16

instance SwapEndian Word24 where
  swapEndian :: Word24 -> Word24
swapEndian Word24
w =
    let (!Word8
b0, !Word8
b1, !Word8
b2) = Word24 -> (Word8, Word8, Word8)
unMkWord24LE Word24
w
    in  Word8 -> Word8 -> Word8 -> Word24
mkWord24LE Word8
b2 Word8
b1 Word8
b0

deriving via (ViaFromIntegral Word24 Int24) instance SwapEndian Int24

instance SwapEndian Word32 where
  swapEndian :: Word32 -> Word32
swapEndian Word32
w =
    let (!Word8
b0, !Word8
b1, !Word8
b2, !Word8
b3) = Word32 -> (Word8, Word8, Word8, Word8)
unMkWord32LE Word32
w
    in  Word8 -> Word8 -> Word8 -> Word8 -> Word32
mkWord32LE Word8
b3 Word8
b2 Word8
b1 Word8
b0

deriving via (ViaFromIntegral Word32 Int32) instance SwapEndian Int32

instance SwapEndian Word64 where
  swapEndian :: Word64 -> Word64
swapEndian Word64
w =
    let (!Word8
b0, !Word8
b1, !Word8
b2, !Word8
b3, !Word8
b4, !Word8
b5, !Word8
b6, !Word8
b7) = Word64 -> (Word8, Word8, Word8, Word8, Word8, Word8, Word8, Word8)
unMkWord64LE Word64
w
    in  Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word64
mkWord64LE Word8
b7 Word8
b6 Word8
b5 Word8
b4 Word8
b3 Word8
b2 Word8
b1 Word8
b0

deriving via (ViaFromIntegral Word64 Int64) instance SwapEndian Int64

instance SwapEndian Float where
  swapEndian :: Float -> Float
swapEndian Float
w =
    let (!Word8
b0, !Word8
b1, !Word8
b2, !Word8
b3) = Float -> (Word8, Word8, Word8, Word8)
unMkFloatLE Float
w
    in  Word8 -> Word8 -> Word8 -> Word8 -> Float
mkFloatLE Word8
b3 Word8
b2 Word8
b1 Word8
b0

instance SwapEndian Double where
  swapEndian :: Double -> Double
swapEndian Double
w =
    let (!Word8
b0, !Word8
b1, !Word8
b2, !Word8
b3, !Word8
b4, !Word8
b5, !Word8
b6, !Word8
b7) = Double -> (Word8, Word8, Word8, Word8, Word8, Word8, Word8, Word8)
unMkDoubleLE Double
w
    in  Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Double
mkDoubleLE Word8
b7 Word8
b6 Word8
b5 Word8
b4 Word8
b3 Word8
b2 Word8
b1 Word8
b0

mkWord16LE :: Word8 -> Word8 -> Word16
mkWord16LE :: Word8 -> Word8 -> Word16
mkWord16LE Word8
b0 Word8
b1 = (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b1 forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
8) forall a. Bits a => a -> a -> a
.|. forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b0

unMkWord16LE :: Word16 -> (Word8, Word8)
unMkWord16LE :: Word16 -> (Word8, Word8)
unMkWord16LE Word16
w =
  let b0 :: Word8
b0 = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
w
      b1 :: Word8
b1 = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16
w forall a. Bits a => a -> Int -> a
`shiftR` Int
8)
  in  (Word8
b0, Word8
b1)

mkWord24LE :: Word8 -> Word8 -> Word8 -> Word24
mkWord24LE :: Word8 -> Word8 -> Word8 -> Word24
mkWord24LE Word8
b0 Word8
b1 Word8
b2 = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word8 -> Word8 -> Word8 -> Word32
mkWord32LE Word8
b0 Word8
b1 Word8
b2 Word8
0)

unMkWord24LE :: Word24 -> (Word8, Word8, Word8)
unMkWord24LE :: Word24 -> (Word8, Word8, Word8)
unMkWord24LE Word24
w =
  let v :: Word32
v = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word24
w
      (!Word8
b0, !Word8
b1, !Word8
b2, Word8
_) = Word32 -> (Word8, Word8, Word8, Word8)
unMkWord32LE Word32
v
  in  (Word8
b0, Word8
b1, Word8
b2)

mkWord32LE :: Word8 -> Word8 -> Word8 -> Word8 -> Word32
mkWord32LE :: Word8 -> Word8 -> Word8 -> Word8 -> Word32
mkWord32LE Word8
b0 Word8
b1 Word8
b2 Word8
b3 =
  (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b3 forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
24)
    forall a. Bits a => a -> a -> a
.|. (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b2 forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
16)
    forall a. Bits a => a -> a -> a
.|. (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b1 forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
8)
    forall a. Bits a => a -> a -> a
.|. forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b0

unMkWord32LE :: Word32 -> (Word8, Word8, Word8, Word8)
unMkWord32LE :: Word32 -> (Word8, Word8, Word8, Word8)
unMkWord32LE Word32
w =
  let b0 :: Word8
b0 = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
w
      b1 :: Word8
b1 = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
w forall a. Bits a => a -> Int -> a
`shiftR` Int
8)
      b2 :: Word8
b2 = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
w forall a. Bits a => a -> Int -> a
`shiftR` Int
16)
      b3 :: Word8
b3 = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
w forall a. Bits a => a -> Int -> a
`shiftR` Int
24)
  in  (Word8
b0, Word8
b1, Word8
b2, Word8
b3)

mkWord64LE :: Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word64
mkWord64LE :: Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word64
mkWord64LE Word8
b0 Word8
b1 Word8
b2 Word8
b3 Word8
b4 Word8
b5 Word8
b6 Word8
b7 =
  (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b7 forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
56)
    forall a. Bits a => a -> a -> a
.|. (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b6 forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
48)
    forall a. Bits a => a -> a -> a
.|. (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b5 forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
40)
    forall a. Bits a => a -> a -> a
.|. (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b4 forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
32)
    forall a. Bits a => a -> a -> a
.|. (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b3 forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
24)
    forall a. Bits a => a -> a -> a
.|. (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b2 forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
16)
    forall a. Bits a => a -> a -> a
.|. (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b1 forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
8)
    forall a. Bits a => a -> a -> a
.|. forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b0

unMkWord64LE :: Word64 -> (Word8, Word8, Word8, Word8, Word8, Word8, Word8, Word8)
unMkWord64LE :: Word64 -> (Word8, Word8, Word8, Word8, Word8, Word8, Word8, Word8)
unMkWord64LE Word64
w =
  let b0 :: Word8
b0 = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
w
      b1 :: Word8
b1 = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
w forall a. Bits a => a -> Int -> a
`shiftR` Int
8)
      b2 :: Word8
b2 = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
w forall a. Bits a => a -> Int -> a
`shiftR` Int
16)
      b3 :: Word8
b3 = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
w forall a. Bits a => a -> Int -> a
`shiftR` Int
24)
      b4 :: Word8
b4 = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
w forall a. Bits a => a -> Int -> a
`shiftR` Int
32)
      b5 :: Word8
b5 = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
w forall a. Bits a => a -> Int -> a
`shiftR` Int
40)
      b6 :: Word8
b6 = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
w forall a. Bits a => a -> Int -> a
`shiftR` Int
48)
      b7 :: Word8
b7 = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
w forall a. Bits a => a -> Int -> a
`shiftR` Int
56)
  in  (Word8
b0, Word8
b1, Word8
b2, Word8
b3, Word8
b4, Word8
b5, Word8
b6, Word8
b7)

mkFloatLE :: Word8 -> Word8 -> Word8 -> Word8 -> Float
mkFloatLE :: Word8 -> Word8 -> Word8 -> Word8 -> Float
mkFloatLE Word8
b0 Word8
b1 Word8
b2 Word8
b3 = Word32 -> Float
castWord32ToFloat (Word8 -> Word8 -> Word8 -> Word8 -> Word32
mkWord32LE Word8
b0 Word8
b1 Word8
b2 Word8
b3)

unMkFloatLE :: Float -> (Word8, Word8, Word8, Word8)
unMkFloatLE :: Float -> (Word8, Word8, Word8, Word8)
unMkFloatLE Float
f = Word32 -> (Word8, Word8, Word8, Word8)
unMkWord32LE (Float -> Word32
castFloatToWord32 Float
f)

mkDoubleLE :: Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Double
mkDoubleLE :: Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Double
mkDoubleLE Word8
b0 Word8
b1 Word8
b2 Word8
b3 Word8
b4 Word8
b5 Word8
b6 Word8
b7 = Word64 -> Double
castWord64ToDouble (Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word64
mkWord64LE Word8
b0 Word8
b1 Word8
b2 Word8
b3 Word8
b4 Word8
b5 Word8
b6 Word8
b7)

unMkDoubleLE :: Double -> (Word8, Word8, Word8, Word8, Word8, Word8, Word8, Word8)
unMkDoubleLE :: Double -> (Word8, Word8, Word8, Word8, Word8, Word8, Word8, Word8)
unMkDoubleLE Double
f = Word64 -> (Word8, Word8, Word8, Word8, Word8, Word8, Word8, Word8)
unMkWord64LE (Double -> Word64
castDoubleToWord64 Double
f)

class (Num le, Num be) => EndianPair le be | le -> be, be -> le where
  toLittleEndian :: be -> le
  toBigEndian :: le -> be

newtype ViaEndianPair le be = ViaEndianPair {forall le be. ViaEndianPair le be -> be
unViaEndianPair :: be}

instance EndianPair Word8 Word8 where
  toLittleEndian :: Word8 -> Word8
toLittleEndian = forall a. a -> a
id
  toBigEndian :: Word8 -> Word8
toBigEndian = forall a. a -> a
id

instance EndianPair Int8 Int8 where
  toLittleEndian :: Int8 -> Int8
toLittleEndian = forall a. a -> a
id
  toBigEndian :: Int8 -> Int8
toBigEndian = forall a. a -> a
id