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 :: forall a' a. (a' -> a) -> Poke a -> Poke a'
contramap a' -> a
fn (Poke Int
size Ptr Word8 -> a -> IO ()
io) =
    forall input. Int -> (Ptr Word8 -> input -> IO ()) -> Poke input
Poke Int
size (\Ptr Word8
ptr a'
input -> Ptr Word8 -> a -> IO ()
io Ptr Word8
ptr (a' -> a
fn a'
input))

instance Divisible Poke where
  {-# INLINE conquer #-}
  conquer :: forall a. Poke a
conquer =
    forall input. Int -> (Ptr Word8 -> input -> IO ()) -> Poke input
Poke Int
0 (\Ptr Word8
_ a
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
  {-# INLINE divide #-}
  divide :: forall a b c. (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) =
    forall input. Int -> (Ptr Word8 -> input -> IO ()) -> Poke input
Poke (Int
size1 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 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Ptr Word8 -> c -> IO ()
io2 (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 =
  forall input output. PokeAndPeek input output -> Poke input
pokeAndPeek InvPokeAndPeek Word8
B.word8

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

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

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

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

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

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

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

{-# INLINE pokeAndPeek #-}
pokeAndPeek :: B.PokeAndPeek input output -> Poke input
pokeAndPeek :: forall input output. PokeAndPeek input output -> Poke input
pokeAndPeek (B.PokeAndPeek Int
size Ptr Word8 -> input -> IO ()
io Ptr Word8 -> IO output
_) =
  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 =
  forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (forall a b. (Integral a, Num b) => a -> b
fromIntegral 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 =
  forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (forall a. Num a => a -> a -> a
+ Word8
48) Poke Word8
word8

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

{-# INLINE vector #-}
vector :: Int -> Poke element -> Poke (F.Vector element)
vector :: forall element. Int -> Poke element -> Poke (Vector element)
vector Int
vectorSize (Poke Int
elementByteSize Ptr Word8 -> element -> IO ()
elementIO) =
  forall input. Int -> (Ptr Word8 -> input -> IO ()) -> Poke input
Poke Int
vectorByteSize Ptr Word8 -> Vector element -> IO ()
vectorIO
  where
    vectorByteSize :: Int
vectorByteSize =
      Int
vectorSize forall a. Num a => a -> a -> a
* Int
elementByteSize
    vectorIO :: Ptr Word8 -> Vector element -> IO ()
vectorIO =
      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 forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
ptr Int
elementByteSize