module PtrPoker.Poke where
import qualified PtrPoker.Ffi as Ffi
import qualified PtrPoker.IO.ByteString as ByteStringIO
import qualified PtrPoker.IO.Prim as PrimIO
import PtrPoker.Prelude hiding (concat)
import qualified PtrPoker.Text as Text
{-# RULES
"foldMap" forall f foldable.
foldMap f foldable =
Poke $ \p -> foldM (\p (Poke poker) -> poker p) p foldable
#-}
newtype Poke = Poke {Poke -> Ptr Word8 -> IO (Ptr Word8)
pokePtr :: Ptr Word8 -> IO (Ptr Word8)}
instance Semigroup Poke where
{-# INLINE [1] (<>) #-}
Poke Ptr Word8 -> IO (Ptr Word8)
lIO <> :: Poke -> Poke -> Poke
<> Poke Ptr Word8 -> IO (Ptr Word8)
rIO =
(Ptr Word8 -> IO (Ptr Word8)) -> Poke
Poke (Ptr Word8 -> IO (Ptr Word8)
lIO (Ptr Word8 -> IO (Ptr Word8))
-> (Ptr Word8 -> IO (Ptr Word8)) -> Ptr Word8 -> IO (Ptr Word8)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Ptr Word8 -> IO (Ptr Word8)
rIO)
sconcat :: NonEmpty Poke -> Poke
sconcat =
NonEmpty Poke -> Poke
forall (f :: * -> *). Foldable f => f Poke -> Poke
concat
instance Monoid Poke where
{-# INLINE [1] mempty #-}
mempty :: Poke
mempty =
(Ptr Word8 -> IO (Ptr Word8)) -> Poke
Poke Ptr Word8 -> IO (Ptr Word8)
forall (m :: * -> *) a. Monad m => a -> m a
return
mconcat :: [Poke] -> Poke
mconcat =
[Poke] -> Poke
forall (f :: * -> *). Foldable f => f Poke -> Poke
concat
instance IsString Poke where
fromString :: String -> Poke
fromString = ByteString -> Poke
byteString (ByteString -> Poke) -> (String -> ByteString) -> String -> Poke
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> ByteString
forall a. IsString a => String -> a
fromString
{-# INLINE [1] concat #-}
concat :: Foldable f => f Poke -> Poke
concat :: f Poke -> Poke
concat f Poke
pokers =
(Ptr Word8 -> IO (Ptr Word8)) -> Poke
Poke (\Ptr Word8
p -> (Ptr Word8 -> Poke -> IO (Ptr Word8))
-> Ptr Word8 -> f Poke -> IO (Ptr Word8)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\Ptr Word8
p (Poke Ptr Word8 -> IO (Ptr Word8)
io) -> Ptr Word8 -> IO (Ptr Word8)
io Ptr Word8
p) Ptr Word8
p f Poke
pokers)
{-# INLINE byteString #-}
byteString :: ByteString -> Poke
byteString :: ByteString -> Poke
byteString ByteString
bs =
(Ptr Word8 -> IO (Ptr Word8)) -> Poke
Poke ((Ptr Word8 -> IO (Ptr Word8)) -> Poke)
-> (Ptr Word8 -> IO (Ptr Word8)) -> Poke
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr -> (Ptr Word8 -> ByteString -> IO (Ptr Word8))
-> Ptr Word8 -> ByteString -> IO (Ptr Word8)
forall a. a -> a
inline Ptr Word8 -> ByteString -> IO (Ptr Word8)
ByteStringIO.pokeByteString Ptr Word8
ptr ByteString
bs
{-# INLINE [1] word8 #-}
word8 :: Word8 -> Poke
word8 :: Word8 -> Poke
word8 Word8
a =
(Ptr Word8 -> IO (Ptr Word8)) -> Poke
Poke (\Ptr Word8
p -> Ptr Word8 -> Word8 -> IO ()
PrimIO.pokeWord8 Ptr Word8
p Word8
a 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
p Int
1)
{-# INLINE [1] lWord16 #-}
lWord16 :: Word16 -> Poke
lWord16 :: Word16 -> Poke
lWord16 Word16
a =
(Ptr Word8 -> IO (Ptr Word8)) -> Poke
Poke (\Ptr Word8
p -> Ptr Word8 -> Word16 -> IO ()
PrimIO.pokeLEWord16 Ptr Word8
p Word16
a 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
p Int
2)
{-# INLINE [1] bWord16 #-}
bWord16 :: Word16 -> Poke
bWord16 :: Word16 -> Poke
bWord16 Word16
a =
(Ptr Word8 -> IO (Ptr Word8)) -> Poke
Poke (\Ptr Word8
p -> Ptr Word8 -> Word16 -> IO ()
PrimIO.pokeBEWord16 Ptr Word8
p Word16
a 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
p Int
2)
{-# INLINE [1] lWord32 #-}
lWord32 :: Word32 -> Poke
lWord32 :: Word32 -> Poke
lWord32 Word32
a =
(Ptr Word8 -> IO (Ptr Word8)) -> Poke
Poke (\Ptr Word8
p -> Ptr Word8 -> Word32 -> IO ()
PrimIO.pokeLEWord32 Ptr Word8
p Word32
a 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
p Int
4)
{-# INLINE [1] bWord32 #-}
bWord32 :: Word32 -> Poke
bWord32 :: Word32 -> Poke
bWord32 Word32
a =
(Ptr Word8 -> IO (Ptr Word8)) -> Poke
Poke (\Ptr Word8
p -> Ptr Word8 -> Word32 -> IO ()
PrimIO.pokeBEWord32 Ptr Word8
p Word32
a 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
p Int
4)
{-# INLINE [1] lWord64 #-}
lWord64 :: Word64 -> Poke
lWord64 :: Word64 -> Poke
lWord64 Word64
a =
(Ptr Word8 -> IO (Ptr Word8)) -> Poke
Poke (\Ptr Word8
p -> Ptr Word8 -> Word64 -> IO ()
PrimIO.pokeLEWord64 Ptr Word8
p Word64
a 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
p Int
8)
{-# INLINE [1] bWord64 #-}
bWord64 :: Word64 -> Poke
bWord64 :: Word64 -> Poke
bWord64 Word64
a =
(Ptr Word8 -> IO (Ptr Word8)) -> Poke
Poke (\Ptr Word8
p -> Ptr Word8 -> Word64 -> IO ()
PrimIO.pokeBEWord64 Ptr Word8
p Word64
a 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
p Int
8)
{-# INLINE lInt16 #-}
lInt16 :: Int16 -> Poke
lInt16 :: Int16 -> Poke
lInt16 = Word16 -> Poke
lWord16 (Word16 -> Poke) -> (Int16 -> Word16) -> Int16 -> Poke
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int16 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral
{-# INLINE bInt16 #-}
bInt16 :: Int16 -> Poke
bInt16 :: Int16 -> Poke
bInt16 = Word16 -> Poke
bWord16 (Word16 -> Poke) -> (Int16 -> Word16) -> Int16 -> Poke
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int16 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral
{-# INLINE lInt32 #-}
lInt32 :: Int32 -> Poke
lInt32 :: Int32 -> Poke
lInt32 = Word32 -> Poke
lWord32 (Word32 -> Poke) -> (Int32 -> Word32) -> Int32 -> Poke
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral
{-# INLINE bInt32 #-}
bInt32 :: Int32 -> Poke
bInt32 :: Int32 -> Poke
bInt32 = Word32 -> Poke
bWord32 (Word32 -> Poke) -> (Int32 -> Word32) -> Int32 -> Poke
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral
{-# INLINE lInt64 #-}
lInt64 :: Int64 -> Poke
lInt64 :: Int64 -> Poke
lInt64 = Word64 -> Poke
lWord64 (Word64 -> Poke) -> (Int64 -> Word64) -> Int64 -> Poke
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
{-# INLINE bInt64 #-}
bInt64 :: Int64 -> Poke
bInt64 :: Int64 -> Poke
bInt64 = Word64 -> Poke
bWord64 (Word64 -> Poke) -> (Int64 -> Word64) -> Int64 -> Poke
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
{-# INLINE textUtf8 #-}
textUtf8 :: Text -> Poke
textUtf8 :: Text -> Poke
textUtf8 = (ByteArray# -> Int -> Int -> Poke) -> Text -> Poke
forall x. (ByteArray# -> Int -> Int -> x) -> Text -> x
Text.destruct ((ByteArray# -> Int -> Int -> Poke) -> Text -> Poke)
-> (ByteArray# -> Int -> Int -> Poke) -> Text -> Poke
forall a b. (a -> b) -> a -> b
$ \ByteArray#
arr Int
off Int
len ->
(Ptr Word8 -> IO (Ptr Word8)) -> Poke
Poke (\Ptr Word8
p -> Ptr Word8 -> ByteArray# -> CSize -> CSize -> IO (Ptr Word8)
Ffi.encodeText Ptr Word8
p ByteArray#
arr (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
off) (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len))
{-# INLINE [1] int8AsciiDec #-}
int8AsciiDec :: Int8 -> Poke
int8AsciiDec :: Int8 -> Poke
int8AsciiDec Int8
a =
(Ptr Word8 -> IO (Ptr Word8)) -> Poke
Poke (CInt -> Ptr Word8 -> IO (Ptr Word8)
Ffi.pokeIntInDec (Int8 -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int8
a))
{-# INLINE [1] int16AsciiDec #-}
int16AsciiDec :: Int16 -> Poke
int16AsciiDec :: Int16 -> Poke
int16AsciiDec Int16
a =
(Ptr Word8 -> IO (Ptr Word8)) -> Poke
Poke (CInt -> Ptr Word8 -> IO (Ptr Word8)
Ffi.pokeIntInDec (Int16 -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int16
a))
{-# INLINE [1] int32AsciiDec #-}
int32AsciiDec :: Int32 -> Poke
int32AsciiDec :: Int32 -> Poke
int32AsciiDec Int32
a =
(Ptr Word8 -> IO (Ptr Word8)) -> Poke
Poke (CInt -> Ptr Word8 -> IO (Ptr Word8)
Ffi.pokeIntInDec (Int32 -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
a))
{-# INLINE [1] int64AsciiDec #-}
int64AsciiDec :: Int64 -> Poke
int64AsciiDec :: Int64 -> Poke
int64AsciiDec Int64
a =
(Ptr Word8 -> IO (Ptr Word8)) -> Poke
Poke (CLLong -> Ptr Word8 -> IO (Ptr Word8)
Ffi.pokeLongLongIntInDec (Int64 -> CLLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
a))
{-# INLINE [1] intAsciiDec #-}
intAsciiDec :: Int -> Poke
intAsciiDec :: Int -> Poke
intAsciiDec Int
a =
(Ptr Word8 -> IO (Ptr Word8)) -> Poke
Poke (CLLong -> Ptr Word8 -> IO (Ptr Word8)
Ffi.pokeLongLongIntInDec (Int -> CLLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
a))
{-# INLINE [1] word8AsciiDec #-}
word8AsciiDec :: Word8 -> Poke
word8AsciiDec :: Word8 -> Poke
word8AsciiDec Word8
a =
(Ptr Word8 -> IO (Ptr Word8)) -> Poke
Poke (CUInt -> Ptr Word8 -> IO (Ptr Word8)
Ffi.pokeUIntInDec (Word8 -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
a))
{-# INLINE [1] word16AsciiDec #-}
word16AsciiDec :: Word16 -> Poke
word16AsciiDec :: Word16 -> Poke
word16AsciiDec Word16
a =
(Ptr Word8 -> IO (Ptr Word8)) -> Poke
Poke (CUInt -> Ptr Word8 -> IO (Ptr Word8)
Ffi.pokeUIntInDec (Word16 -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
a))
{-# INLINE [1] word32AsciiDec #-}
word32AsciiDec :: Word32 -> Poke
word32AsciiDec :: Word32 -> Poke
word32AsciiDec Word32
a =
(Ptr Word8 -> IO (Ptr Word8)) -> Poke
Poke (CUInt -> Ptr Word8 -> IO (Ptr Word8)
Ffi.pokeUIntInDec (Word32 -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
a))
{-# INLINE [1] word64AsciiDec #-}
word64AsciiDec :: Word64 -> Poke
word64AsciiDec :: Word64 -> Poke
word64AsciiDec Word64
a =
(Ptr Word8 -> IO (Ptr Word8)) -> Poke
Poke (CULLong -> Ptr Word8 -> IO (Ptr Word8)
Ffi.pokeLongLongUIntInDec (Word64 -> CULLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
a))
{-# INLINE [1] wordAsciiDec #-}
wordAsciiDec :: Word -> Poke
wordAsciiDec :: Word -> Poke
wordAsciiDec Word
a =
(Ptr Word8 -> IO (Ptr Word8)) -> Poke
Poke (CULLong -> Ptr Word8 -> IO (Ptr Word8)
Ffi.pokeLongLongUIntInDec (Word -> CULLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
a))
{-# INLINE doubleAsciiDec #-}
doubleAsciiDec :: Double -> Poke
doubleAsciiDec :: Double -> Poke
doubleAsciiDec Double
a =
(Ptr Word8 -> IO (Ptr Word8)) -> Poke
Poke ((Ptr Word8 -> IO (Ptr Word8)) -> Poke)
-> (Ptr Word8 -> IO (Ptr Word8)) -> Poke
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr ->
Double -> Ptr Word8 -> IO CInt
Ffi.pokeDouble Double
a Ptr Word8
ptr
IO CInt -> (IO CInt -> IO (Ptr Word8)) -> IO (Ptr Word8)
forall a b. a -> (a -> b) -> b
& (CInt -> Ptr Word8) -> IO CInt -> IO (Ptr Word8)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
ptr (Int -> Ptr Word8) -> (CInt -> Int) -> CInt -> Ptr Word8
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
{-# INLINE sizedReverse #-}
sizedReverse :: Int -> (Ptr Word8 -> IO a) -> Poke
sizedReverse :: Int -> (Ptr Word8 -> IO a) -> Poke
sizedReverse Int
size Ptr Word8 -> IO a
action =
(Ptr Word8 -> IO (Ptr Word8)) -> Poke
Poke ((Ptr Word8 -> IO (Ptr Word8)) -> Poke)
-> (Ptr Word8 -> IO (Ptr Word8)) -> Poke
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr ->
let afterPtr :: Ptr Word8
afterPtr =
Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
ptr Int
size
in Ptr Word8 -> IO a
action Ptr Word8
afterPtr IO a -> Ptr Word8 -> IO (Ptr Word8)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Ptr Word8
afterPtr