    -- |
    -- Module      : Basement.Endianness
    -- License     : BSD-style
    -- Maintainer  : Haskell Foundation
    -- Stability   : experimental
    -- Portability : portable
    --
    -- Set endianness tag to a given primitive. This will help for serialising
    -- data for protocols (such as the network protocols).
    --

    {-# LANGUAGE CPP #-}
    {-# LANGUAGE GeneralizedNewtypeDeriving #-}

    module Basement.Endianness
        (
          ByteSwap
          -- * Big Endian
        , BE(..), toBE, fromBE
          -- * Little Endian
        , LE(..), toLE, fromLE
          -- * System Endianness
        , Endianness(..)
        , endianness
        ) where

    import Basement.Compat.Base
    import Data.Word (byteSwap16, byteSwap32, byteSwap64)

    #if defined(ARCH_IS_LITTLE_ENDIAN) || defined(ARCH_IS_BIG_ENDIAN)
    #else
    import Foreign.Marshal.Alloc (alloca)
    import Foreign.Ptr (castPtr)
    import Foreign.Storable (poke, peek)
    import Data.Word (Word8, Word32)
    import System.IO.Unsafe (unsafePerformIO)
    #endif

    import Data.Bits

    -- #if !defined(ARCH_IS_LITTLE_ENDIAN) && !defined(ARCH_IS_BIG_ENDIAN)
    -- import Foundation.System.Info (endianness, Endianness(..))
    -- #endif

    data Endianness =
          LittleEndian
        | BigEndian
        deriving (Endianness -> Endianness -> Bool
    (Endianness -> Endianness -> Bool)
    -> (Endianness -> Endianness -> Bool) -> Eq Endianness
    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, 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
    showList :: [Endianness] -> ShowS
    $cshowList :: [Endianness] -> ShowS
    show :: Endianness -> String
    $cshow :: Endianness -> String
    showsPrec :: Int -> Endianness -> ShowS
    $cshowsPrec :: Int -> Endianness -> ShowS
    Show)

    -- | Little Endian value
    newtype LE a = LE { 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
    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
    (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
    /= :: 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, Typeable, Eq (LE a)
    LE a
    Eq (LE a) =>
    (LE a -> LE a -> LE a)
    -> (LE a -> LE a -> LE a)
    -> (LE a -> LE a -> LE a)
    -> (LE a -> LE a)
    -> (LE a -> Int -> LE a)
    -> (LE a -> Int -> LE a)
    -> LE a
    -> (Int -> LE a)
    -> (LE a -> Int -> LE a)
    -> (LE a -> Int -> LE a)
    -> (LE a -> Int -> LE a)
    -> (LE a -> Int -> Bool)
    -> (LE a -> Maybe Int)
    -> (LE a -> Int)
    -> (LE a -> Bool)
    -> (LE a -> Int -> LE a)
    -> (LE a -> Int -> LE a)
    -> (LE a -> Int -> LE a)
    -> (LE a -> Int -> LE a)
    -> (LE a -> Int -> LE a)
    -> (LE a -> Int -> LE a)
    -> (LE a -> Int)
    -> Bits (LE a)
    Int -> LE a
    LE a -> Bool
    LE a -> Int
    LE a -> Maybe Int
    LE a -> LE a
    LE a -> Int -> Bool
    LE a -> Int -> LE a
    LE a -> LE a -> LE a
    forall a.
    Eq a =>
    (a -> a -> a)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> (a -> a)
    -> (a -> Int -> a)
    -> (a -> Int -> a)
    -> a
    -> (Int -> a)
    -> (a -> Int -> a)
    -> (a -> Int -> a)
    -> (a -> Int -> a)
    -> (a -> Int -> Bool)
    -> (a -> Maybe Int)
    -> (a -> Int)
    -> (a -> Bool)
    -> (a -> Int -> a)
    -> (a -> Int -> a)
    -> (a -> Int -> a)
    -> (a -> Int -> a)
    -> (a -> Int -> a)
    -> (a -> Int -> a)
    -> (a -> Int)
    -> Bits a
    forall a. Bits a => Eq (LE a)
    forall a. Bits a => LE a
    forall a. Bits a => Int -> LE a
    forall a. Bits a => LE a -> Bool
    forall a. Bits a => LE a -> Int
    forall a. Bits a => LE a -> Maybe Int
    forall a. Bits a => LE a -> LE a
    forall a. Bits a => LE a -> Int -> Bool
    forall a. Bits a => LE a -> Int -> LE a
    forall a. Bits a => LE a -> LE a -> LE a
    popCount :: LE a -> Int
    $cpopCount :: forall a. Bits a => LE a -> Int
    rotateR :: LE a -> Int -> LE a
    $crotateR :: forall a. Bits a => LE a -> Int -> LE a
    rotateL :: LE a -> Int -> LE a
    $crotateL :: forall a. Bits a => LE a -> Int -> LE a
    unsafeShiftR :: LE a -> Int -> LE a
    $cunsafeShiftR :: forall a. Bits a => LE a -> Int -> LE a
    shiftR :: LE a -> Int -> LE a
    $cshiftR :: forall a. Bits a => LE a -> Int -> LE a
    unsafeShiftL :: LE a -> Int -> LE a
    $cunsafeShiftL :: forall a. Bits a => LE a -> Int -> LE a
    shiftL :: LE a -> Int -> LE a
    $cshiftL :: forall a. Bits a => LE a -> Int -> LE a
    isSigned :: LE a -> Bool
    $cisSigned :: forall a. Bits a => LE a -> Bool
    bitSize :: LE a -> Int
    $cbitSize :: forall a. Bits a => LE a -> Int
    bitSizeMaybe :: LE a -> Maybe Int
    $cbitSizeMaybe :: forall a. Bits a => LE a -> Maybe Int
    testBit :: LE a -> Int -> Bool
    $ctestBit :: forall a. Bits a => LE a -> Int -> Bool
    complementBit :: LE a -> Int -> LE a
    $ccomplementBit :: forall a. Bits a => LE a -> Int -> LE a
    clearBit :: LE a -> Int -> LE a
    $cclearBit :: forall a. Bits a => LE a -> Int -> LE a
    setBit :: LE a -> Int -> LE a
    $csetBit :: forall a. Bits a => LE a -> Int -> LE a
    bit :: Int -> LE a
    $cbit :: forall a. Bits a => Int -> LE a
    zeroBits :: LE a
    $czeroBits :: forall a. Bits a => LE a
    rotate :: LE a -> Int -> LE a
    $crotate :: forall a. Bits a => LE a -> Int -> LE a
    shift :: LE a -> Int -> LE a
    $cshift :: forall a. Bits a => LE a -> Int -> LE a
    complement :: LE a -> LE a
    $ccomplement :: forall a. Bits a => LE a -> LE a
    xor :: LE a -> LE a -> LE a
    $cxor :: forall a. Bits a => LE a -> LE a -> LE a
    .|. :: LE a -> LE a -> LE a
    $c.|. :: forall a. Bits a => LE a -> LE a -> LE a
    .&. :: LE a -> LE a -> LE a
    $c.&. :: forall a. Bits a => LE a -> LE a -> LE a
    $cp1Bits :: forall a. Bits a => Eq (LE a)
    Bits)
    instance (ByteSwap a, Ord a) => Ord (LE a) where
        compare :: LE a -> LE a -> Ordering
    compare e1 :: LE a
    e1 e2 :: LE a
    e2 = a -> a -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare (LE a -> a
    forall a. ByteSwap a => LE a -> a
    fromLE LE a
    e1) (LE a -> a
    forall a. ByteSwap a => LE a -> a
    fromLE LE a
    e2)

    -- | Big Endian value
    newtype BE a = BE { 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
    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
    (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
    /= :: 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, Typeable, Eq (BE a)
    BE a
    Eq (BE a) =>
    (BE a -> BE a -> BE a)
    -> (BE a -> BE a -> BE a)
    -> (BE a -> BE a -> BE a)
    -> (BE a -> BE a)
    -> (BE a -> Int -> BE a)
    -> (BE a -> Int -> BE a)
    -> BE a
    -> (Int -> BE a)
    -> (BE a -> Int -> BE a)
    -> (BE a -> Int -> BE a)
    -> (BE a -> Int -> BE a)
    -> (BE a -> Int -> Bool)
    -> (BE a -> Maybe Int)
    -> (BE a -> Int)
    -> (BE a -> Bool)
    -> (BE a -> Int -> BE a)
    -> (BE a -> Int -> BE a)
    -> (BE a -> Int -> BE a)
    -> (BE a -> Int -> BE a)
    -> (BE a -> Int -> BE a)
    -> (BE a -> Int -> BE a)
    -> (BE a -> Int)
    -> Bits (BE a)
    Int -> BE a
    BE a -> Bool
    BE a -> Int
    BE a -> Maybe Int
    BE a -> BE a
    BE a -> Int -> Bool
    BE a -> Int -> BE a
    BE a -> BE a -> BE a
    forall a.
    Eq a =>
    (a -> a -> a)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> (a -> a)
    -> (a -> Int -> a)
    -> (a -> Int -> a)
    -> a
    -> (Int -> a)
    -> (a -> Int -> a)
    -> (a -> Int -> a)
    -> (a -> Int -> a)
    -> (a -> Int -> Bool)
    -> (a -> Maybe Int)
    -> (a -> Int)
    -> (a -> Bool)
    -> (a -> Int -> a)
    -> (a -> Int -> a)
    -> (a -> Int -> a)
    -> (a -> Int -> a)
    -> (a -> Int -> a)
    -> (a -> Int -> a)
    -> (a -> Int)
    -> Bits a
    forall a. Bits a => Eq (BE a)
    forall a. Bits a => BE a
    forall a. Bits a => Int -> BE a
    forall a. Bits a => BE a -> Bool
    forall a. Bits a => BE a -> Int
    forall a. Bits a => BE a -> Maybe Int
    forall a. Bits a => BE a -> BE a
    forall a. Bits a => BE a -> Int -> Bool
    forall a. Bits a => BE a -> Int -> BE a
    forall a. Bits a => BE a -> BE a -> BE a
    popCount :: BE a -> Int
    $cpopCount :: forall a. Bits a => BE a -> Int
    rotateR :: BE a -> Int -> BE a
    $crotateR :: forall a. Bits a => BE a -> Int -> BE a
    rotateL :: BE a -> Int -> BE a
    $crotateL :: forall a. Bits a => BE a -> Int -> BE a
    unsafeShiftR :: BE a -> Int -> BE a
    $cunsafeShiftR :: forall a. Bits a => BE a -> Int -> BE a
    shiftR :: BE a -> Int -> BE a
    $cshiftR :: forall a. Bits a => BE a -> Int -> BE a
    unsafeShiftL :: BE a -> Int -> BE a
    $cunsafeShiftL :: forall a. Bits a => BE a -> Int -> BE a
    shiftL :: BE a -> Int -> BE a
    $cshiftL :: forall a. Bits a => BE a -> Int -> BE a
    isSigned :: BE a -> Bool
    $cisSigned :: forall a. Bits a => BE a -> Bool
    bitSize :: BE a -> Int
    $cbitSize :: forall a. Bits a => BE a -> Int
    bitSizeMaybe :: BE a -> Maybe Int
    $cbitSizeMaybe :: forall a. Bits a => BE a -> Maybe Int
    testBit :: BE a -> Int -> Bool
    $ctestBit :: forall a. Bits a => BE a -> Int -> Bool
    complementBit :: BE a -> Int -> BE a
    $ccomplementBit :: forall a. Bits a => BE a -> Int -> BE a
    clearBit :: BE a -> Int -> BE a
    $cclearBit :: forall a. Bits a => BE a -> Int -> BE a
    setBit :: BE a -> Int -> BE a
    $csetBit :: forall a. Bits a => BE a -> Int -> BE a
    bit :: Int -> BE a
    $cbit :: forall a. Bits a => Int -> BE a
    zeroBits :: BE a
    $czeroBits :: forall a. Bits a => BE a
    rotate :: BE a -> Int -> BE a
    $crotate :: forall a. Bits a => BE a -> Int -> BE a
    shift :: BE a -> Int -> BE a
    $cshift :: forall a. Bits a => BE a -> Int -> BE a
    complement :: BE a -> BE a
    $ccomplement :: forall a. Bits a => BE a -> BE a
    xor :: BE a -> BE a -> BE a
    $cxor :: forall a. Bits a => BE a -> BE a -> BE a
    .|. :: BE a -> BE a -> BE a
    $c.|. :: forall a. Bits a => BE a -> BE a -> BE a
    .&. :: BE a -> BE a -> BE a
    $c.&. :: forall a. Bits a => BE a -> BE a -> BE a
    $cp1Bits :: forall a. Bits a => Eq (BE a)
    Bits)
    instance (ByteSwap a, Ord a) => Ord (BE a) where
        compare :: BE a -> BE a -> Ordering
    compare e1 :: BE a
    e1 e2 :: BE a
    e2 = a -> a -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare (BE a -> a
    forall a. ByteSwap a => BE a -> a
    fromBE BE a
    e1) (BE a -> a
    forall a. ByteSwap a => BE a -> a
    fromBE BE a
    e2)

    -- | Convert a value in cpu endianess to big endian
    toBE :: ByteSwap a => a -> BE a
    #ifdef ARCH_IS_LITTLE_ENDIAN
    toBE :: a -> BE a
    toBE = a -> BE a
    forall a. a -> BE a
    BE (a -> BE a) -> (a -> a) -> a -> BE a
    forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    . a -> a
    forall a. ByteSwap a => a -> a
    byteSwap
    #elif ARCH_IS_BIG_ENDIAN
    toBE = BE
    #else
    toBE = BE . (if endianness == 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 :: BE a -> a
    fromBE (BE a :: 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 endianness == 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 :: 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 endianness == 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 :: LE a -> a
    fromLE (LE a :: a
    a) = a
    a
    #elif ARCH_IS_BIG_ENDIAN
    fromLE (LE a) = byteSwap a
    #else
    fromLE (LE a) = if endianness == LittleEndian then a else byteSwap a
    #endif
    {-# INLINE fromLE #-}

    -- | endianness of the current architecture
    endianness :: Endianness
    #ifdef ARCH_IS_LITTLE_ENDIAN
    endianness :: Endianness
    endianness = Endianness
    LittleEndian
    #elif ARCH_IS_BIG_ENDIAN
    endianness = BigEndian
    #else
    -- ! ARCH_IS_UNKNOWN_ENDIAN
    endianness = unsafePerformIO $ bytesToEndianness <$> word32ToByte input
      where
        input :: Word32
        input = 0x01020304
    {-# NOINLINE endianness #-}

    word32ToByte :: Word32 -> IO Word8
    word32ToByte word = alloca $ \wordPtr -> do
             poke wordPtr word
             peek (castPtr wordPtr)

    bytesToEndianness :: Word8 -> Endianness
    bytesToEndianness 1 = BigEndian
    bytesToEndianness _ = LittleEndian
    #endif

    -- | Class of types that can be byte-swapped.
    --
    -- e.g. Word16, Word32, Word64
    class 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