module Ptr.Poke where

import qualified Data.Vector as F
import qualified Ptr.PokeAndPeek as B
import Ptr.Prelude

-- |
-- Specification of a sized and errorless writing action to a pointer.
data Poke input
  = Poke !Int !(Ptr Word8 -> input -> IO ())

instance Contravariant Poke where
  {-# INLINE contramap #-}
  contramap :: (a -> b) -> Poke b -> Poke a
contramap a -> b
fn (Poke Int
size Ptr Word8 -> b -> IO ()
io) =
    Int -> (Ptr Word8 -> a -> IO ()) -> Poke a
forall input. Int -> (Ptr Word8 -> input -> IO ()) -> Poke input
Poke Int
size (\Ptr Word8
ptr a
input -> Ptr Word8 -> b -> IO ()
io Ptr Word8
ptr (a -> b
fn a
input))

instance Divisible Poke where
  {-# INLINE conquer #-}
  conquer :: Poke a
conquer =
    Int -> (Ptr Word8 -> a -> IO ()) -> Poke a
forall input. Int -> (Ptr Word8 -> input -> IO ()) -> Poke input
Poke Int
0 (\Ptr Word8
_ a
_ -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
  {-# INLINE divide #-}
  divide :: (a -> (b, c)) -> Poke b -> Poke c -> Poke a
divide a -> (b, c)
fn (Poke Int
size1 Ptr Word8 -> b -> IO ()
io1) (Poke Int
size2 Ptr Word8 -> c -> IO ()
io2) =
    Int -> (Ptr Word8 -> a -> IO ()) -> Poke a
forall input. Int -> (Ptr Word8 -> input -> IO ()) -> Poke input
Poke (Int
size1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
size2) (\Ptr Word8
ptr a
input -> case a -> (b, c)
fn a
input of (b
input1, c
input2) -> Ptr Word8 -> b -> IO ()
io1 Ptr Word8
ptr b
input1 IO () -> IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Ptr Word8 -> c -> IO ()
io2 (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
ptr Int
size1) c
input2)

{-# INLINE word8 #-}
word8 :: Poke Word8
word8 :: Poke Word8
word8 =
  PokeAndPeek Word8 Word8 -> Poke Word8
forall input output. PokeAndPeek input output -> Poke input
pokeAndPeek PokeAndPeek Word8 Word8
B.word8

{-# INLINE leWord16 #-}
leWord16 :: Poke Word16
leWord16 :: Poke Word16
leWord16 =
  PokeAndPeek Word16 Word16 -> Poke Word16
forall input output. PokeAndPeek input output -> Poke input
pokeAndPeek PokeAndPeek Word16 Word16
B.leWord16

{-# INLINE leWord32 #-}
leWord32 :: Poke Word32
leWord32 :: Poke Word32
leWord32 =
  PokeAndPeek Word32 Word32 -> Poke Word32
forall input output. PokeAndPeek input output -> Poke input
pokeAndPeek PokeAndPeek Word32 Word32
B.leWord32

{-# INLINE leWord64 #-}
leWord64 :: Poke Word64
leWord64 :: Poke Word64
leWord64 =
  PokeAndPeek Word64 Word64 -> Poke Word64
forall input output. PokeAndPeek input output -> Poke input
pokeAndPeek PokeAndPeek Word64 Word64
B.leWord64

{-# INLINE beWord16 #-}
beWord16 :: Poke Word16
beWord16 :: Poke Word16
beWord16 =
  PokeAndPeek Word16 Word16 -> Poke Word16
forall input output. PokeAndPeek input output -> Poke input
pokeAndPeek PokeAndPeek Word16 Word16
B.beWord16

{-# INLINE beWord32 #-}
beWord32 :: Poke Word32
beWord32 :: Poke Word32
beWord32 =
  PokeAndPeek Word32 Word32 -> Poke Word32
forall input output. PokeAndPeek input output -> Poke input
pokeAndPeek PokeAndPeek Word32 Word32
B.beWord32

{-# INLINE beWord64 #-}
beWord64 :: Poke Word64
beWord64 :: Poke Word64
beWord64 =
  PokeAndPeek Word64 Word64 -> Poke Word64
forall input output. PokeAndPeek input output -> Poke input
pokeAndPeek PokeAndPeek Word64 Word64
B.beWord64

{-# INLINE bytes #-}
bytes :: Int -> Poke ByteString
bytes :: Int -> Poke ByteString
bytes Int
amount =
  PokeAndPeek ByteString ByteString -> Poke ByteString
forall input output. PokeAndPeek input output -> Poke input
pokeAndPeek (Int -> PokeAndPeek ByteString ByteString
B.bytes Int
amount)

{-# INLINE pokeAndPeek #-}
pokeAndPeek :: B.PokeAndPeek input output -> Poke input
pokeAndPeek :: PokeAndPeek input output -> Poke input
pokeAndPeek (B.PokeAndPeek Int
size Ptr Word8 -> input -> IO ()
io Ptr Word8 -> IO output
_) =
  Int -> (Ptr Word8 -> input -> IO ()) -> Poke input
forall input. Int -> (Ptr Word8 -> input -> IO ()) -> Poke input
Poke Int
size Ptr Word8 -> input -> IO ()
io

{-# INLINE asciiChar #-}
asciiChar :: Poke Char
asciiChar :: Poke Char
asciiChar =
  (Char -> Word8) -> Poke Word8 -> Poke Char
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> (Char -> Int) -> Char -> Word8
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Char -> Int
ord) Poke Word8
word8

{-# INLINE asciiDigit #-}
asciiDigit :: Poke Word8
asciiDigit :: Poke Word8
asciiDigit =
  (Word8 -> Word8) -> Poke Word8 -> Poke Word8
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap (Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
48) Poke Word8
word8

{-# INLINE asciiHexDigit #-}
asciiHexDigit :: Poke Word8
asciiHexDigit :: Poke Word8
asciiHexDigit =
  (Word8 -> Word8) -> Poke Word8 -> Poke Word8
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap (\Word8
n -> if Word8
n Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
10 then Word8
48 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
n else Word8
55 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
n) Poke Word8
word8

{-# INLINE vector #-}
vector :: Int -> Poke element -> Poke (F.Vector element)
vector :: Int -> Poke element -> Poke (Vector element)
vector Int
vectorSize (Poke Int
elementByteSize Ptr Word8 -> element -> IO ()
elementIO) =
  Int
-> (Ptr Word8 -> Vector element -> IO ()) -> Poke (Vector element)
forall input. Int -> (Ptr Word8 -> input -> IO ()) -> Poke input
Poke Int
vectorByteSize Ptr Word8 -> Vector element -> IO ()
vectorIO
  where
    vectorByteSize :: Int
vectorByteSize =
      Int
vectorSize Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
elementByteSize
    vectorIO :: Ptr Word8 -> Vector element -> IO ()
vectorIO =
      (Ptr Word8 -> element -> IO (Ptr Word8))
-> Ptr Word8 -> Vector element -> IO ()
forall (m :: * -> *) a b.
Monad m =>
(a -> b -> m a) -> a -> Vector b -> m ()
F.foldM'_ Ptr Word8 -> element -> IO (Ptr Word8)
step
      where
        step :: Ptr Word8 -> element -> IO (Ptr Word8)
step Ptr Word8
ptr element
element =
          Ptr Word8 -> element -> IO ()
elementIO Ptr Word8
ptr element
element IO () -> Ptr Word8 -> IO (Ptr Word8)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
ptr Int
elementByteSize