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
import qualified Data.Text.Internal as Text
import qualified Data.Text.Array as TextArray
{-# 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 byteString #-}
byteString :: ByteString -> Poke
byteString bs =
Poke $ \ ptr -> inline 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 textUtf8 #-}
textUtf8 :: Text -> Poke
textUtf8 (Text.Text arr off len) =
Poke (\ p -> Ffi.encodeText p (TextArray.aBA arr) (fromIntegral off) (fromIntegral len))
{-# 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