MyEndianness.hs

{-# LANGUAGE Trustworthy, ScopedTypeVariables #-}

-- | Read and write data in little-endian format.
module Data.Columbia.MyEndianness (bigEndian, swapEndian') 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)

{-# NOINLINE _bigEndian #-}
_bigEndian :: Bool
_bigEndian = unsafePerformIO bigEndian

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)

instance EndianSensitive Float where
	swapEndian = byteSwapped

instance EndianSensitive Char where
	swapEndian = byteSwapped

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 () = ()

swapEndian' :: (EndianSensitive e) => e->e
swapEndian' = if _bigEndian then swapEndian else id