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
  #-}

{-|
Abstraction over an IO action,
which takes a pointer, populates it and
produces a pointer right after the populated data.
-}
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

{-|
Reuses the IsString instance of 'ByteString'.
-}
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

{-|
Concatenate a foldable of pokes.
-}
{-# 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)

{-|
Efficiently copy the contents of ByteString using @memcpy@.
-}
{-# 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

{-|
Encode Word8 as byte, incrementing the pointer by 1.
-}
{-# 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)

{-|
Encode Word64 in Little-endian.
-}
{-# 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)

{-|
Encode Word64 in Big-endian.
-}
{-# 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)

{-|
Encode Text in UTF8.
-}
{-# INLINE textUtf8 #-}
textUtf8 :: Text -> Poke
textUtf8 :: Text -> Poke
textUtf8 (Text.Text Array
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 (Array -> ByteArray#
TextArray.aBA Array
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))


-- * ASCII integers
-------------------------

{-|
Encode Int8 as a signed ASCII decimal.
-}
{-# 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))

{-|
Encode Int16 as a signed ASCII decimal.
-}
{-# 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))

{-|
Encode Int32 as a signed ASCII decimal.
-}
{-# 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))

{-|
Encode Int64 as a signed ASCII decimal.
-}
{-# 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))

{-|
Encode Int as a signed ASCII decimal.
-}
{-# 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))

{-|
Encode Word8 as an unsigned ASCII decimal.
-}
{-# 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))

{-|
Encode Word16 as an unsigned ASCII decimal.
-}
{-# 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))

{-|
Encode Word32 as an unsigned ASCII decimal.
-}
{-# 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))

{-|
Encode Word64 as an unsigned ASCII decimal.
-}
{-# 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))

{-|
Encode Word as an unsigned ASCII decimal.
-}
{-# 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))

{-|
Encode Double as a signed ASCII decimal.
-}
{-# 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)


-- * Low level
-------------------------

{-|
Having the amount of bytes to be written precomputed,
executes an action,
which fills the pointer going downward,
starting from the pointer that follows the chunk.
I.e., you have to decrement the pointer
before writing the first byte,
decrement it again before writing the second byte and so on.
-}
{-# 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