module Ptr.Poke where
import qualified Data.Vector as F
import qualified Ptr.PokeAndPeek as B
import Ptr.Prelude
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