{-# LANGUAGE CPP #-}
-- | Utilities to read multibyte quantities from arbitrary positions.
module Bio.Util.Storable
    ( peekWord8
    , peekUnalnWord16LE
    , peekUnalnWord16BE
    , peekUnalnWord32LE
    , peekUnalnWord32BE
    , pokeUnalnWord32LE
    ) where

#if __GLASGOW_HASKELL__ >= 710
#define HAVE_BYTESWAP_PRIMOPS
#endif

#if i386_HOST_ARCH || x86_64_HOST_ARCH
#define MEM_UNALIGNED_OPS
#endif

import Bio.Prelude

#if defined(HAVE_BYTESWAP_PRIMOPS)
import GHC.Word ( byteSwap16, byteSwap32 )
#endif

peekWord8 :: Ptr a -> IO Word8
peekWord8 = peek . castPtr

#if defined(MEM_UNALIGNED_OPS) && defined(WORDS_BIGENDIAN) && defined(HAVE_BYTESWAP_PRIMOPS)
peekUnalnWord16LE :: Ptr a -> IO Word16
peekUnalnWord16LE = fmap byteSwap16 . peek . castPtr

peekUnalnWord32LE :: Ptr a -> IO Word32
peekUnalnWord32LE = fmap byteSwap32 . peek . castPtr

pokeUnalnWord32LE :: Ptr a -> Word32 -> IO ()
pokeUnalnWord32LE p w = poke (castPtr p) (byteSwap32 w)

#elif defined(MEM_UNALIGNED_OPS) && !defined(WORDS_BIGENDIAN)
peekUnalnWord16LE :: Ptr a -> IO Word16
peekUnalnWord16LE = peek . castPtr

peekUnalnWord32LE :: Ptr a -> IO Word32
peekUnalnWord32LE = peek . castPtr

pokeUnalnWord32LE :: Ptr a -> Word32 -> IO ()
pokeUnalnWord32LE p w = poke (castPtr p) w

#else
peekUnalnWord16LE :: Ptr a -> IO Word16
peekUnalnWord16LE p = do
    x <- fromIntegral <$> peekWord8 (plusPtr p 0)
    y <- fromIntegral <$> peekWord8 (plusPtr p 1)
    return $! x .|. unsafeShiftL y 8

peekUnalnWord32LE :: Ptr a -> IO Word32
peekUnalnWord32LE p = do
    x <- fromIntegral <$> peekWord8 (plusPtr p 0)
    y <- fromIntegral <$> peekWord8 (plusPtr p 1)
    z <- fromIntegral <$> peekWord8 (plusPtr p 2)
    w <- fromIntegral <$> peekWord8 (plusPtr p 3)
    return $! x .|. unsafeShiftL y 8 .|. unsafeShiftL z 16 .|. unsafeShiftL w 24

pokeUnalnWord32LE :: Ptr a -> Word32 -> IO ()
pokeUnalnWord32LE p w = do pokeByteOff p 0 (fromIntegral $ shiftR w  0 :: Word8)
                           pokeByteOff p 1 (fromIntegral $ shiftR w  8 :: Word8)
                           pokeByteOff p 2 (fromIntegral $ shiftR w 16 :: Word8)
                           pokeByteOff p 3 (fromIntegral $ shiftR w 24 :: Word8)
#endif


#if defined(MEM_UNALIGNED_OPS) && !defined(WORDS_BIGENDIAN) && defined(HAVE_BYTESWAP_PRIMOPS)
peekUnalnWord16BE :: Ptr a -> IO Word16
peekUnalnWord16BE = fmap byteSwap16 . peek . castPtr

peekUnalnWord32BE :: Ptr a -> IO Word32
peekUnalnWord32BE = fmap byteSwap32 . peek . castPtr

#elif defined(MEM_UNALIGNED_OPS) && defined(WORDS_BIGENDIAN)
peekUnalnWord16BE :: Ptr a -> IO Word16
peekUnalnWord16BE = peek . castPtr

peekUnalnWord32BE :: Ptr a -> IO Word32
peekUnalnWord32BE = peek . castPtr

#else
peekUnalnWord16BE :: Ptr a -> IO Word16
peekUnalnWord16BE p = do
    x <- fromIntegral <$> peekWord8 (plusPtr p 0)
    y <- fromIntegral <$> peekWord8 (plusPtr p 1)
    return $! y .|. unsafeShiftL x 8

peekUnalnWord32BE :: Ptr a -> IO Word32
peekUnalnWord32BE p = do
    x <- fromIntegral <$> peekWord8 (plusPtr p 0)
    y <- fromIntegral <$> peekWord8 (plusPtr p 1)
    z <- fromIntegral <$> peekWord8 (plusPtr p 2)
    w <- fromIntegral <$> peekWord8 (plusPtr p 3)
    return $! w .|. unsafeShiftL z 8 .|. unsafeShiftL y 16 .|. unsafeShiftL x 24
#endif