{-# 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 BasePrelude

peekWord8 :: Ptr a -> IO Word8
peekWord8 :: Ptr a -> IO Word8
peekWord8 = Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek (Ptr Word8 -> IO Word8)
-> (Ptr a -> Ptr Word8) -> Ptr a -> IO Word8
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Ptr a -> Ptr Word8
forall a b. Ptr a -> Ptr b
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 :: Ptr a -> IO Word16
peekUnalnWord16LE = Ptr Word16 -> IO Word16
forall a. Storable a => Ptr a -> IO a
peek (Ptr Word16 -> IO Word16)
-> (Ptr a -> Ptr Word16) -> Ptr a -> IO Word16
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Ptr a -> Ptr Word16
forall a b. Ptr a -> Ptr b
castPtr

peekUnalnWord32LE :: Ptr a -> IO Word32
peekUnalnWord32LE :: Ptr a -> IO Word32
peekUnalnWord32LE = Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek (Ptr Word32 -> IO Word32)
-> (Ptr a -> Ptr Word32) -> Ptr a -> IO Word32
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Ptr a -> Ptr Word32
forall a b. Ptr a -> Ptr b
castPtr

pokeUnalnWord32LE :: Ptr a -> Word32 -> IO ()
pokeUnalnWord32LE :: Ptr a -> Word32 -> IO ()
pokeUnalnWord32LE p :: Ptr a
p w :: Word32
w = Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr a -> Ptr Word32
forall a b. Ptr a -> Ptr b
castPtr Ptr a
p) Word32
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 :: Ptr a -> IO Word16
peekUnalnWord16BE = (Word16 -> Word16) -> IO Word16 -> IO Word16
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word16 -> Word16
byteSwap16 (IO Word16 -> IO Word16)
-> (Ptr a -> IO Word16) -> Ptr a -> IO Word16
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Ptr Word16 -> IO Word16
forall a. Storable a => Ptr a -> IO a
peek (Ptr Word16 -> IO Word16)
-> (Ptr a -> Ptr Word16) -> Ptr a -> IO Word16
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Ptr a -> Ptr Word16
forall a b. Ptr a -> Ptr b
castPtr

peekUnalnWord32BE :: Ptr a -> IO Word32
peekUnalnWord32BE :: Ptr a -> IO Word32
peekUnalnWord32BE = (Word32 -> Word32) -> IO Word32 -> IO Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word32 -> Word32
byteSwap32 (IO Word32 -> IO Word32)
-> (Ptr a -> IO Word32) -> Ptr a -> IO Word32
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek (Ptr Word32 -> IO Word32)
-> (Ptr a -> Ptr Word32) -> Ptr a -> IO Word32
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Ptr a -> Ptr Word32
forall a b. Ptr a -> Ptr b
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