{-# LANGUAGE CPP         #-}
{-# LANGUAGE Haskell2010 #-}

-- |
-- Copyright: © 2019-2020  Herbert Valerio Riedel
-- SPDX-License-Identifier: GPL-2.0-or-later
--
module Endianness
    ( Word8, Word16, Word32, Word64
    , ByteOrder(LittleEndian,BigEndian), targetByteOrder

    , byteSwap16
    , byteSwap32
    , byteSwap64

    , pokeWord16be
    , pokeWord32be
    , pokeWord64be
    , peekWord16be
    , peekWord32be
    , peekWord64be

    ) where

import           Data.Word        (Word16, Word32, Word64, Word8)
import           Foreign.Ptr
import           Foreign.Storable
import           GHC.ByteOrder    (ByteOrder (..), targetByteOrder)

#if MIN_VERSION_base(4,7,0)
import           Data.Word        (byteSwap16, byteSwap32, byteSwap64)
#else
import           Data.Bits

-- supply missing byteSwap operations

byteSwap16 :: Word16 -> Word16
byteSwap16 = (`rotateL` 8)

byteSwap32 :: Word32 -> Word32
byteSwap32 x
  = (x                  `shiftR` 24)  .|.
    ((x .&. 0x00ff0000) `shiftR`  8)  .|.
    ((x .&. 0x0000ff00) `shiftL`  8)  .|.
    (x                  `shiftL` 24)

byteSwap64 :: Word64 -> Word64
byteSwap64 x = xh .|. (xl `shiftL` 32)
  where
    xl = fromIntegral (byteSwap32 (fromIntegral x))
    xh = fromIntegral (byteSwap32 (fromIntegral (x `shiftR` 32)))
#endif

pokeWord16be :: Ptr Word16 -> Word16 -> IO ()
pokeWord16be :: Ptr Word16 -> Word16 -> IO ()
pokeWord16be = case ByteOrder
targetByteOrder of
  ByteOrder
BigEndian    -> Ptr Word16 -> Word16 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke
  ByteOrder
LittleEndian -> \Ptr Word16
p Word16
w -> Ptr Word16 -> Word16 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word16
p (Word16 -> Word16
byteSwap16 Word16
w)

pokeWord32be :: Ptr Word32 -> Word32 -> IO ()
pokeWord32be :: Ptr Word32 -> Word32 -> IO ()
pokeWord32be = case ByteOrder
targetByteOrder of
  ByteOrder
BigEndian    -> Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke
  ByteOrder
LittleEndian -> \Ptr Word32
p Word32
w -> Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word32
p (Word32 -> Word32
byteSwap32 Word32
w)

pokeWord64be :: Ptr Word64 -> Word64 -> IO ()
pokeWord64be :: Ptr Word64 -> Word64 -> IO ()
pokeWord64be = case ByteOrder
targetByteOrder of
  ByteOrder
BigEndian    -> Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke
  ByteOrder
LittleEndian -> \Ptr Word64
p Word64
w -> Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word64
p (Word64 -> Word64
byteSwap64 Word64
w)


peekWord16be :: Ptr Word16 -> IO Word16
peekWord16be :: Ptr Word16 -> IO Word16
peekWord16be = case ByteOrder
targetByteOrder of
  ByteOrder
BigEndian    -> Ptr Word16 -> IO Word16
forall a. Storable a => Ptr a -> IO a
peek
  ByteOrder
LittleEndian -> \Ptr Word16
p -> (Word16 -> Word16) -> IO Word16 -> IO Word16
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word16 -> Word16
byteSwap16 (Ptr Word16 -> IO Word16
forall a. Storable a => Ptr a -> IO a
peek Ptr Word16
p)

peekWord32be :: Ptr Word32 -> IO Word32
peekWord32be :: Ptr Word32 -> IO Word32
peekWord32be = case ByteOrder
targetByteOrder of
  ByteOrder
BigEndian    -> Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek
  ByteOrder
LittleEndian -> \Ptr Word32
p -> (Word32 -> Word32) -> IO Word32 -> IO Word32
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word32 -> Word32
byteSwap32 (Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
p)

peekWord64be :: Ptr Word64 -> IO Word64
peekWord64be :: Ptr Word64 -> IO Word64
peekWord64be = case ByteOrder
targetByteOrder of
  ByteOrder
BigEndian    -> Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek
  ByteOrder
LittleEndian -> \Ptr Word64
p -> (Word64 -> Word64) -> IO Word64 -> IO Word64
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word64 -> Word64
byteSwap64 (Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
p)