{-# LANGUAGE Trustworthy, ScopedTypeVariables #-}

-- | Read and write data in little-endian format.
module Data.MyEndianness (bigEndian,
-- * Little-endian versions of the Storable functions
poke, peek, pokeByteOff, peekByteOff) where

import System.IO.Unsafe
import Foreign.Marshal.Alloc
import qualified Foreign.Storable as S
import Data.Endian
import Control.Exception
import Foreign.Ptr
import Data.Bits
import Data.Word
import Data.Int

----------------------------------------------
-- Endianness

-- | Determine whether running on a big-endian system.
bigEndian :: IO Bool
bigEndian = do
	p <- malloc
	finally
		(do
		S.poke p (bit 24 :: Word32)
		n :: Word8 <- S.peek (castPtr p)
		return (n == 1))
		(free p)

{-# INLINE poke #-}
poke :: (S.Storable t, EndianSensitive t) => Ptr t -> t -> IO ()
poke p x = do
	b <- bigEndian
	S.poke p $ if b then swapEndian x else x

{-# INLINE peek #-}
peek :: (S.Storable t, EndianSensitive t) => Ptr t -> IO t
peek p = do
	b <- bigEndian
	x <- S.peek p
	return $ if b then swapEndian x else x

{-# INLINE pokeByteOff #-}
pokeByteOff p n x = poke (plusPtr p n) x

{-# INLINE peekByteOff #-}
peekByteOff p n = peek (plusPtr p n)

instance (EndianSensitive t, EndianSensitive u, EndianSensitive v, EndianSensitive w) => EndianSensitive (t, u, v, w) where
	swapEndian (a, b, c, d) = (swapEndian a, swapEndian b, swapEndian c, swapEndian d)

instance EndianSensitive Int8 where
	swapEndian = id

instance EndianSensitive Word8 where
	swapEndian = id

byteSwapped x = unsafePerformIO $ do
	p <- malloc
	finally
		(do
		S.poke p x
		b1 :: Word8 <- S.peekByteOff p 0
		b2 :: Word8 <- S.peekByteOff p 1
		b3 :: Word8 <- S.peekByteOff p 2
		b4 :: Word8 <- S.peekByteOff p 3
		S.pokeByteOff p 3 b1
		S.pokeByteOff p 2 b2
		S.pokeByteOff p 1 b3
		S.pokeByteOff p 0 b4
		S.peek p)
		(free p)

byteSwapped1 :: Double -> Double
byteSwapped1 x = unsafePerformIO $ do
	p <- malloc
	finally
		(do
		S.poke p x
		b1 :: Word8 <- S.peekByteOff p 0
		b2 :: Word8 <- S.peekByteOff p 1
		b3 :: Word8 <- S.peekByteOff p 2
		b4 :: Word8 <- S.peekByteOff p 3
		b5 :: Word8 <- S.peekByteOff p 4
		b6 :: Word8 <- S.peekByteOff p 5
		b7 :: Word8 <- S.peekByteOff p 6
		b8 :: Word8 <- S.peekByteOff p 7
		S.pokeByteOff p 7 b5
		S.pokeByteOff p 6 b6
		S.pokeByteOff p 5 b7
		S.pokeByteOff p 4 b8
		S.pokeByteOff p 3 b5
		S.pokeByteOff p 2 b6
		S.pokeByteOff p 1 b7
		S.pokeByteOff p 0 b8
		S.peek p)
		(free p)

instance EndianSensitive Float where
	swapEndian = byteSwapped

instance EndianSensitive Char where
	swapEndian = byteSwapped

instance EndianSensitive Double where
	swapEndian = byteSwapped1

-- Endianness doesn't matter for Bools. At most, you get a different
-- representation of True.
instance EndianSensitive Bool where
	swapEndian = id

instance (EndianSensitive t, EndianSensitive u) => EndianSensitive (t, u) where
	swapEndian (x, y) = (swapEndian x, swapEndian y)

instance (EndianSensitive t, EndianSensitive u) => EndianSensitive (Either t u) where
	swapEndian = either (Left . swapEndian) (Right . swapEndian)

instance EndianSensitive () where
	swapEndian () = ()