module Dahdit.Internal where

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

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 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

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)

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)