-- |
-- 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Endianness] -> ShowS
$cshowList :: [Endianness] -> ShowS
show :: Endianness -> String
$cshow :: Endianness -> String
showsPrec :: Int -> Endianness -> ShowS
$cshowsPrec :: Int -> Endianness -> ShowS
Show,Endianness -> Endianness -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Endianness -> Endianness -> Bool
$c/= :: Endianness -> Endianness -> Bool
== :: Endianness -> Endianness -> Bool
$c== :: Endianness -> Endianness -> Bool
Eq)

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

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

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

-- | Convert a value in cpu endianess to big endian
toBE :: ByteSwap a => a -> BE a
#ifdef ARCH_IS_LITTLE_ENDIAN
toBE = BE . byteSwap
#elif ARCH_IS_BIG_ENDIAN
toBE = BE
#else
toBE :: forall a. ByteSwap a => a -> BE a
toBE = forall a. a -> BE a
BE forall b c a. (b -> c) -> (a -> b) -> a -> c
. (if Endianness
getSystemEndianness forall a. Eq a => a -> a -> Bool
== Endianness
LittleEndian then forall a. ByteSwap a => a -> a
byteSwap else forall a. a -> a
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 (BE a) = byteSwap a
#elif ARCH_IS_BIG_ENDIAN
fromBE (BE a) = a
#else
fromBE :: forall a. ByteSwap a => BE a -> a
fromBE (BE a
a) = if Endianness
getSystemEndianness forall a. Eq a => a -> a -> Bool
== Endianness
LittleEndian then forall a. ByteSwap a => a -> a
byteSwap a
a else a
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 = LE
#elif ARCH_IS_BIG_ENDIAN
toLE = LE . byteSwap
#else
toLE :: forall a. ByteSwap a => a -> LE a
toLE = forall a. a -> LE a
LE forall b c a. (b -> c) -> (a -> b) -> a -> c
. (if Endianness
getSystemEndianness forall a. Eq a => a -> a -> Bool
== Endianness
LittleEndian then forall a. a -> a
id else forall a. ByteSwap a => a -> a
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 (LE a) = a
#elif ARCH_IS_BIG_ENDIAN
fromLE (LE a) = byteSwap a
#else
fromLE :: forall a. ByteSwap a => LE a -> a
fromLE (LE a
a) = if Endianness
getSystemEndianness forall a. Eq a => a -> a -> Bool
== Endianness
LittleEndian then a
a else forall a. ByteSwap a => a -> a
byteSwap a
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