-- |
-- Module      : Data.Memory.Endian
-- License     : BSD-style
-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
-- Stability   : stable
-- Portability : good
--
{-# LANGUAGE CPP #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Data.Memory.Endian
    ( Endianness(..)
    , getSystemEndianness
    , BE(..), LE(..)
    , fromBE, toBE
    , fromLE, toLE
    , ByteSwap
    ) where

import Data.Word (Word16, Word32, Word64)
import Foreign.Storable
#if !defined(ARCH_IS_LITTLE_ENDIAN) && !defined(ARCH_IS_BIG_ENDIAN)
import Data.Word (Word8)
import Data.Memory.Internal.Compat (unsafeDoIO)
import Foreign.Marshal.Alloc
import Foreign.Ptr
#endif

import Data.Memory.Internal.Compat (byteSwap64, byteSwap32, byteSwap16)

-- | represent the CPU endianness
--
-- Big endian system stores bytes with the MSB as the first byte.
-- Little endian system stores bytes with the LSB as the first byte.
--
-- middle endian is purposely avoided.
data Endianness = LittleEndian
                | BigEndian
                deriving (Int -> Endianness -> ShowS
[Endianness] -> ShowS
Endianness -> String
(Int -> Endianness -> ShowS)
-> (Endianness -> String)
-> ([Endianness] -> ShowS)
-> Show Endianness
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Endianness -> ShowS
showsPrec :: Int -> Endianness -> ShowS
$cshow :: Endianness -> String
show :: Endianness -> String
$cshowList :: [Endianness] -> ShowS
showList :: [Endianness] -> ShowS
Show,Endianness -> Endianness -> Bool
(Endianness -> Endianness -> Bool)
-> (Endianness -> Endianness -> Bool) -> Eq Endianness
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Endianness -> Endianness -> Bool
== :: Endianness -> Endianness -> Bool
$c/= :: Endianness -> Endianness -> Bool
/= :: Endianness -> Endianness -> Bool
Eq)

-- | Return the system endianness
getSystemEndianness :: Endianness
#ifdef ARCH_IS_LITTLE_ENDIAN
getSystemEndianness :: Endianness
getSystemEndianness = Endianness
LittleEndian
#elif ARCH_IS_BIG_ENDIAN
getSystemEndianness = BigEndian
#else
getSystemEndianness
    | isLittleEndian = LittleEndian
    | isBigEndian    = BigEndian
    | otherwise      = error "cannot determine endianness"
  where
        isLittleEndian = endianCheck == 2
        isBigEndian    = endianCheck == 1
        endianCheck    = unsafeDoIO $ alloca $ \p -> do
                            poke p (0x01000002 :: Word32)
                            peek (castPtr p :: Ptr Word8)
#endif

-- | Little Endian value
newtype LE a = LE { forall a. LE a -> a
unLE :: a }
    deriving (Int -> LE a -> ShowS
[LE a] -> ShowS
LE a -> String
(Int -> LE a -> ShowS)
-> (LE a -> String) -> ([LE a] -> ShowS) -> Show (LE a)
forall a. Show a => Int -> LE a -> ShowS
forall a. Show a => [LE a] -> ShowS
forall a. Show a => LE a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> LE a -> ShowS
showsPrec :: Int -> LE a -> ShowS
$cshow :: forall a. Show a => LE a -> String
show :: LE a -> String
$cshowList :: forall a. Show a => [LE a] -> ShowS
showList :: [LE a] -> ShowS
Show,LE a -> LE a -> Bool
(LE a -> LE a -> Bool) -> (LE a -> LE a -> Bool) -> Eq (LE a)
forall a. Eq a => LE a -> LE a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => LE a -> LE a -> Bool
== :: LE a -> LE a -> Bool
$c/= :: forall a. Eq a => LE a -> LE a -> Bool
/= :: LE a -> LE a -> Bool
Eq,Ptr (LE a) -> IO (LE a)
Ptr (LE a) -> Int -> IO (LE a)
Ptr (LE a) -> Int -> LE a -> IO ()
Ptr (LE a) -> LE a -> IO ()
LE a -> Int
(LE a -> Int)
-> (LE a -> Int)
-> (Ptr (LE a) -> Int -> IO (LE a))
-> (Ptr (LE a) -> Int -> LE a -> IO ())
-> (forall b. Ptr b -> Int -> IO (LE a))
-> (forall b. Ptr b -> Int -> LE a -> IO ())
-> (Ptr (LE a) -> IO (LE a))
-> (Ptr (LE a) -> LE a -> IO ())
-> Storable (LE a)
forall b. Ptr b -> Int -> IO (LE a)
forall b. Ptr b -> Int -> LE a -> IO ()
forall a. Storable a => Ptr (LE a) -> IO (LE a)
forall a. Storable a => Ptr (LE a) -> Int -> IO (LE a)
forall a. Storable a => Ptr (LE a) -> Int -> LE a -> IO ()
forall a. Storable a => Ptr (LE a) -> LE a -> IO ()
forall a. Storable a => LE a -> Int
forall a b. Storable a => Ptr b -> Int -> IO (LE a)
forall a b. Storable a => Ptr b -> Int -> LE a -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
$csizeOf :: forall a. Storable a => LE a -> Int
sizeOf :: LE a -> Int
$calignment :: forall a. Storable a => LE a -> Int
alignment :: LE a -> Int
$cpeekElemOff :: forall a. Storable a => Ptr (LE a) -> Int -> IO (LE a)
peekElemOff :: Ptr (LE a) -> Int -> IO (LE a)
$cpokeElemOff :: forall a. Storable a => Ptr (LE a) -> Int -> LE a -> IO ()
pokeElemOff :: Ptr (LE a) -> Int -> LE a -> IO ()
$cpeekByteOff :: forall a b. Storable a => Ptr b -> Int -> IO (LE a)
peekByteOff :: forall b. Ptr b -> Int -> IO (LE a)
$cpokeByteOff :: forall a b. Storable a => Ptr b -> Int -> LE a -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> LE a -> IO ()
$cpeek :: forall a. Storable a => Ptr (LE a) -> IO (LE a)
peek :: Ptr (LE a) -> IO (LE a)
$cpoke :: forall a. Storable a => Ptr (LE a) -> LE a -> IO ()
poke :: Ptr (LE a) -> LE a -> IO ()
Storable)

-- | Big Endian value
newtype BE a = BE { forall a. BE a -> a
unBE :: a }
    deriving (Int -> BE a -> ShowS
[BE a] -> ShowS
BE a -> String
(Int -> BE a -> ShowS)
-> (BE a -> String) -> ([BE a] -> ShowS) -> Show (BE a)
forall a. Show a => Int -> BE a -> ShowS
forall a. Show a => [BE a] -> ShowS
forall a. Show a => BE a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> BE a -> ShowS
showsPrec :: Int -> BE a -> ShowS
$cshow :: forall a. Show a => BE a -> String
show :: BE a -> String
$cshowList :: forall a. Show a => [BE a] -> ShowS
showList :: [BE a] -> ShowS
Show,BE a -> BE a -> Bool
(BE a -> BE a -> Bool) -> (BE a -> BE a -> Bool) -> Eq (BE a)
forall a. Eq a => BE a -> BE a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => BE a -> BE a -> Bool
== :: BE a -> BE a -> Bool
$c/= :: forall a. Eq a => BE a -> BE a -> Bool
/= :: BE a -> BE a -> Bool
Eq,Ptr (BE a) -> IO (BE a)
Ptr (BE a) -> Int -> IO (BE a)
Ptr (BE a) -> Int -> BE a -> IO ()
Ptr (BE a) -> BE a -> IO ()
BE a -> Int
(BE a -> Int)
-> (BE a -> Int)
-> (Ptr (BE a) -> Int -> IO (BE a))
-> (Ptr (BE a) -> Int -> BE a -> IO ())
-> (forall b. Ptr b -> Int -> IO (BE a))
-> (forall b. Ptr b -> Int -> BE a -> IO ())
-> (Ptr (BE a) -> IO (BE a))
-> (Ptr (BE a) -> BE a -> IO ())
-> Storable (BE a)
forall b. Ptr b -> Int -> IO (BE a)
forall b. Ptr b -> Int -> BE a -> IO ()
forall a. Storable a => Ptr (BE a) -> IO (BE a)
forall a. Storable a => Ptr (BE a) -> Int -> IO (BE a)
forall a. Storable a => Ptr (BE a) -> Int -> BE a -> IO ()
forall a. Storable a => Ptr (BE a) -> BE a -> IO ()
forall a. Storable a => BE a -> Int
forall a b. Storable a => Ptr b -> Int -> IO (BE a)
forall a b. Storable a => Ptr b -> Int -> BE a -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
$csizeOf :: forall a. Storable a => BE a -> Int
sizeOf :: BE a -> Int
$calignment :: forall a. Storable a => BE a -> Int
alignment :: BE a -> Int
$cpeekElemOff :: forall a. Storable a => Ptr (BE a) -> Int -> IO (BE a)
peekElemOff :: Ptr (BE a) -> Int -> IO (BE a)
$cpokeElemOff :: forall a. Storable a => Ptr (BE a) -> Int -> BE a -> IO ()
pokeElemOff :: Ptr (BE a) -> Int -> BE a -> IO ()
$cpeekByteOff :: forall a b. Storable a => Ptr b -> Int -> IO (BE a)
peekByteOff :: forall b. Ptr b -> Int -> IO (BE a)
$cpokeByteOff :: forall a b. Storable a => Ptr b -> Int -> BE a -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> BE a -> IO ()
$cpeek :: forall a. Storable a => Ptr (BE a) -> IO (BE a)
peek :: Ptr (BE a) -> IO (BE a)
$cpoke :: forall a. Storable a => Ptr (BE a) -> BE a -> IO ()
poke :: Ptr (BE a) -> BE a -> IO ()
Storable)

-- | Convert a value in cpu endianess to big endian
toBE :: ByteSwap a => a -> BE a
#ifdef ARCH_IS_LITTLE_ENDIAN
toBE :: forall a. ByteSwap a => a -> BE a
toBE = a -> BE a
forall a. a -> BE a
BE (a -> BE a) -> (a -> a) -> a -> BE a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
forall a. ByteSwap a => a -> a
byteSwap
#elif ARCH_IS_BIG_ENDIAN
toBE = BE
#else
toBE = BE . (if getSystemEndianness == LittleEndian then byteSwap else id)
#endif
{-# INLINE toBE #-}

-- | Convert from a big endian value to the cpu endianness
fromBE :: ByteSwap a => BE a -> a
#ifdef ARCH_IS_LITTLE_ENDIAN
fromBE :: forall a. ByteSwap a => BE a -> a
fromBE (BE a
a) = a -> a
forall a. ByteSwap a => a -> a
byteSwap a
a
#elif ARCH_IS_BIG_ENDIAN
fromBE (BE a) = a
#else
fromBE (BE a) = if getSystemEndianness == LittleEndian then byteSwap a else a
#endif
{-# INLINE fromBE #-}

-- | Convert a value in cpu endianess to little endian
toLE :: ByteSwap a => a -> LE a
#ifdef ARCH_IS_LITTLE_ENDIAN
toLE :: forall a. ByteSwap a => a -> LE a
toLE = a -> LE a
forall a. a -> LE a
LE
#elif ARCH_IS_BIG_ENDIAN
toLE = LE . byteSwap
#else
toLE = LE . (if getSystemEndianness == LittleEndian then id else byteSwap)
#endif
{-# INLINE toLE #-}

-- | Convert from a little endian value to the cpu endianness
fromLE :: ByteSwap a => LE a -> a
#ifdef ARCH_IS_LITTLE_ENDIAN
fromLE :: forall a. ByteSwap a => LE a -> a
fromLE (LE a
a) = a
a
#elif ARCH_IS_BIG_ENDIAN
fromLE (LE a) = byteSwap a
#else
fromLE (LE a) = if getSystemEndianness == LittleEndian then a else byteSwap a
#endif
{-# INLINE fromLE #-}

-- | Class of types that can be byte-swapped.
--
-- e.g. Word16, Word32, Word64
class Storable a => ByteSwap a where
    byteSwap :: a -> a
instance ByteSwap Word16 where
    byteSwap :: Word16 -> Word16
byteSwap = Word16 -> Word16
byteSwap16
instance ByteSwap Word32 where
    byteSwap :: Word32 -> Word32
byteSwap = Word32 -> Word32
byteSwap32
instance ByteSwap Word64 where
    byteSwap :: Word64 -> Word64
byteSwap = Word64 -> Word64
byteSwap64