{-# LANGUAGE CPP #-}

module PtrPoker.IO.Prim where

import PtrPoker.Prelude

{-# INLINE pokeStorable #-}
pokeStorable :: (Storable a) => Ptr Word8 -> a -> IO ()
pokeStorable :: forall a. Storable a => Ptr Word8 -> a -> IO ()
pokeStorable Ptr Word8
ptr a
value =
  {-# SCC "pokeStorable" #-}
  forall a. Storable a => Ptr a -> a -> IO ()
poke (forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
ptr) a
value

{-# INLINE pokeWord8 #-}
pokeWord8 :: Ptr Word8 -> Word8 -> IO ()
pokeWord8 :: Ptr Word8 -> Word8 -> IO ()
pokeWord8 Ptr Word8
ptr Word8
value =
  {-# SCC "pokeWord8" #-}
  forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
ptr Word8
value

{-# INLINE pokeWord8Off #-}
pokeWord8Off :: Ptr Word8 -> Int -> Word8 -> IO ()
pokeWord8Off :: Ptr Word8 -> Int -> Word8 -> IO ()
pokeWord8Off Ptr Word8
ptr Int
off Word8
value =
  {-# SCC "pokeWord8Off" #-}
  forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
ptr Int
off Word8
value

{-# INLINE pokeBEWord16 #-}
pokeBEWord16 :: Ptr Word8 -> Word16 -> IO ()
#ifdef WORDS_BIGENDIAN
pokeBEWord16 =
  {-# SCC "pokeBEWord16" #-}
  pokeStorable
#else
pokeBEWord16 :: Ptr Word8 -> Word16 -> IO ()
pokeBEWord16 Ptr Word8
ptr =
  {-# SCC "pokeBEWord16" #-}
  forall a. Storable a => Ptr Word8 -> a -> IO ()
pokeStorable Ptr Word8
ptr forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Word16 -> Word16
byteSwap16
#endif

{-# INLINE pokeBEWord32 #-}
pokeBEWord32 :: Ptr Word8 -> Word32 -> IO ()
#ifdef WORDS_BIGENDIAN
pokeBEWord32 =
  {-# SCC "pokeBEWord32" #-}
  pokeStorable
#else
pokeBEWord32 :: Ptr Word8 -> Word32 -> IO ()
pokeBEWord32 Ptr Word8
ptr =
  {-# SCC "pokeBEWord32" #-}
  forall a. Storable a => Ptr Word8 -> a -> IO ()
pokeStorable Ptr Word8
ptr forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Word32 -> Word32
byteSwap32
#endif

{-# INLINE pokeBEWord64 #-}
pokeBEWord64 :: Ptr Word8 -> Word64 -> IO ()
#ifdef WORDS_BIGENDIAN
pokeBEWord64 =
  {-# SCC "pokeBEWord64" #-}
  pokeStorable
#else
pokeBEWord64 :: Ptr Word8 -> Word64 -> IO ()
pokeBEWord64 Ptr Word8
ptr =
  {-# SCC "pokeBEWord64" #-}
  forall a. Storable a => Ptr Word8 -> a -> IO ()
pokeStorable Ptr Word8
ptr forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Word64 -> Word64
byteSwap64
#endif

{-# INLINE pokeLEWord16 #-}
pokeLEWord16 :: Ptr Word8 -> Word16 -> IO ()
#ifdef WORDS_BIGENDIAN
pokeLEWord16 ptr =
  {-# SCC "pokeLEWord16" #-}
  pokeStorable ptr . byteSwap16
#else
pokeLEWord16 :: Ptr Word8 -> Word16 -> IO ()
pokeLEWord16 =
  {-# SCC "pokeLEWord16" #-}
  forall a. Storable a => Ptr Word8 -> a -> IO ()
pokeStorable
#endif

{-# INLINE pokeLEWord32 #-}
pokeLEWord32 :: Ptr Word8 -> Word32 -> IO ()
#ifdef WORDS_BIGENDIAN
pokeLEWord32 ptr =
  {-# SCC "pokeLEWord32" #-}
  pokeStorable ptr . byteSwap32
#else
pokeLEWord32 :: Ptr Word8 -> Word32 -> IO ()
pokeLEWord32 =
  {-# SCC "pokeLEWord32" #-}
  forall a. Storable a => Ptr Word8 -> a -> IO ()
pokeStorable
#endif

{-# INLINE pokeLEWord64 #-}
pokeLEWord64 :: Ptr Word8 -> Word64 -> IO ()
#ifdef WORDS_BIGENDIAN
pokeLEWord64 ptr =
  {-# SCC "pokeLEWord64" #-}
  pokeStorable ptr . byteSwap64
#else
pokeLEWord64 :: Ptr Word8 -> Word64 -> IO ()
pokeLEWord64 =
  {-# SCC "pokeLEWord64" #-}
  forall a. Storable a => Ptr Word8 -> a -> IO ()
pokeStorable
#endif