module PtrPoker.Poke
where
import PtrPoker.Prelude hiding (concat)
import qualified PtrPoker.IO.ByteString as ByteStringIO
import qualified PtrPoker.IO.Prim as PrimIO
import qualified PtrPoker.Ffi as Ffi
{-# RULES
"foldMap" forall f foldable. foldMap f foldable =
Poke $ \ p -> foldM (\ p (Poke poker) -> poker p) p foldable
#-}
newtype Poke =
Poke { pokePtr :: Ptr Word8 -> IO (Ptr Word8) }
instance Semigroup Poke where
{-# INLINE[1] (<>) #-}
Poke lIO <> Poke rIO =
Poke (lIO >=> rIO)
sconcat =
concat
instance Monoid Poke where
{-# INLINE[1] mempty #-}
mempty =
Poke return
mconcat =
concat
instance IsString Poke where
fromString = byteString . fromString
{-# INLINE[1] concat #-}
concat :: Foldable f => f Poke -> Poke
concat pokers =
Poke (\ p -> foldM (\ p (Poke io) -> io p) p pokers)
{-# INLINE[1] byteString #-}
byteString :: ByteString -> Poke
byteString bs =
Poke $ \ ptr -> ByteStringIO.pokeByteString ptr bs
{-# INLINE[1] word8 #-}
word8 :: Word8 -> Poke
word8 a =
Poke (\ p -> PrimIO.pokeWord8 p a $> plusPtr p 1)
{-# INLINE[1] lWord64 #-}
lWord64 :: Word64 -> Poke
lWord64 a =
Poke (\ p -> PrimIO.pokeLEWord64 p a $> plusPtr p 8)
{-# INLINE[1] bWord64 #-}
bWord64 :: Word64 -> Poke
bWord64 a =
Poke (\ p -> PrimIO.pokeBEWord64 p a $> plusPtr p 8)
{-# INLINE[1] int8AsciiDec #-}
int8AsciiDec :: Int8 -> Poke
int8AsciiDec a =
Poke (Ffi.pokeIntInDec (fromIntegral a))
{-# INLINE[1] int16AsciiDec #-}
int16AsciiDec :: Int16 -> Poke
int16AsciiDec a =
Poke (Ffi.pokeIntInDec (fromIntegral a))
{-# INLINE[1] int32AsciiDec #-}
int32AsciiDec :: Int32 -> Poke
int32AsciiDec a =
Poke (Ffi.pokeIntInDec (fromIntegral a))
{-# INLINE[1] int64AsciiDec #-}
int64AsciiDec :: Int64 -> Poke
int64AsciiDec a =
Poke (Ffi.pokeLongLongIntInDec (fromIntegral a))
{-# INLINE[1] intAsciiDec #-}
intAsciiDec :: Int -> Poke
intAsciiDec a =
Poke (Ffi.pokeLongLongIntInDec (fromIntegral a))
{-# INLINE[1] word8AsciiDec #-}
word8AsciiDec :: Word8 -> Poke
word8AsciiDec a =
Poke (Ffi.pokeUIntInDec (fromIntegral a))
{-# INLINE[1] word16AsciiDec #-}
word16AsciiDec :: Word16 -> Poke
word16AsciiDec a =
Poke (Ffi.pokeUIntInDec (fromIntegral a))
{-# INLINE[1] word32AsciiDec #-}
word32AsciiDec :: Word32 -> Poke
word32AsciiDec a =
Poke (Ffi.pokeUIntInDec (fromIntegral a))
{-# INLINE[1] word64AsciiDec #-}
word64AsciiDec :: Word64 -> Poke
word64AsciiDec a =
Poke (Ffi.pokeLongLongUIntInDec (fromIntegral a))
{-# INLINE[1] wordAsciiDec #-}
wordAsciiDec :: Word -> Poke
wordAsciiDec a =
Poke (Ffi.pokeLongLongUIntInDec (fromIntegral a))
{-# INLINE doubleAsciiDec #-}
doubleAsciiDec :: Double -> Poke
doubleAsciiDec a =
Poke $ \ ptr ->
Ffi.pokeDouble a ptr
& fmap (plusPtr ptr . fromIntegral)
{-# INLINE sizedReverse #-}
sizedReverse :: Int -> (Ptr Word8 -> IO a) -> Poke
sizedReverse size action =
Poke $ \ ptr ->
let
afterPtr =
plusPtr ptr size
in action afterPtr $> afterPtr