{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -Wno-unused-imports #-}
module PtrPoker.Poke where
import qualified Data.Text.Array as TextArray
import qualified Data.Text.Internal as TextInternal
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 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 =
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 forall (m :: * -> *) a. Monad m => a -> m a
return
mconcat :: [Poke] -> Poke
mconcat =
forall (f :: * -> *). Foldable f => f Poke -> Poke
concat
instance IsString Poke where
fromString :: String -> Poke
fromString = ByteString -> Poke
byteString forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. IsString a => String -> a
fromString
{-# INLINE [1] concat #-}
concat :: Foldable f => f Poke -> Poke
concat :: forall (f :: * -> *). Foldable f => f Poke -> Poke
concat f Poke
pokers =
(Ptr Word8 -> IO (Ptr Word8)) -> Poke
Poke (\Ptr Word8
p -> 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 forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr -> 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 forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> 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 forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> 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 forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> 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 forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> 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 forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> 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 forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> 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 forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> 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 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
{-# INLINE bInt16 #-}
bInt16 :: Int16 -> Poke
bInt16 :: Int16 -> Poke
bInt16 = Word16 -> Poke
bWord16 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
{-# INLINE lInt32 #-}
lInt32 :: Int32 -> Poke
lInt32 :: Int32 -> Poke
lInt32 = Word32 -> Poke
lWord32 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
{-# INLINE bInt32 #-}
bInt32 :: Int32 -> Poke
bInt32 :: Int32 -> Poke
bInt32 = Word32 -> Poke
bWord32 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
{-# INLINE lInt64 #-}
lInt64 :: Int64 -> Poke
lInt64 :: Int64 -> Poke
lInt64 = Word64 -> Poke
lWord64 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
{-# INLINE bInt64 #-}
bInt64 :: Int64 -> Poke
bInt64 :: Int64 -> Poke
bInt64 = Word64 -> Poke
bWord64 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
{-# INLINE textUtf8 #-}
textUtf8 :: Text -> Poke
#if MIN_VERSION_text(2,0,0)
textUtf8 (TextInternal.Text arr off len) =
Poke (\p -> do
stToIO $ TextArray.copyToPointer arr off p len
pure (plusPtr p len))
#else
textUtf8 :: Text -> Poke
textUtf8 = forall x. (ByteArray# -> Int -> Int -> x) -> Text -> x
Text.destruct 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 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
off) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len))
#endif
{-# 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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr ->
Double -> Ptr Word8 -> IO CInt
Ffi.pokeDouble Double
a Ptr Word8
ptr
forall a b. a -> (a -> b) -> b
& forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. Ptr a -> Int -> Ptr b
plusPtr 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
. forall a b. (Integral a, Num b) => a -> b
fromIntegral)
{-# INLINE sizedReverse #-}
sizedReverse :: Int -> (Ptr Word8 -> IO a) -> Poke
sizedReverse :: forall a. Int -> (Ptr Word8 -> IO a) -> Poke
sizedReverse Int
size Ptr Word8 -> IO a
action =
(Ptr Word8 -> IO (Ptr Word8)) -> Poke
Poke forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr ->
let afterPtr :: Ptr Word8
afterPtr =
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
ptr Int
size
in Ptr Word8 -> IO a
action Ptr Word8
afterPtr forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Ptr Word8
afterPtr