{-# LANGUAGE UnboxedTuples #-}
module Bytezap where
import GHC.Exts
import Data.ByteString qualified as B
import Data.ByteString.Internal qualified as B
import GHC.IO
import Data.Word
type Poke# = Addr# -> State# RealWorld -> (# State# RealWorld, Addr# #)
newtype Poke = Poke
{
Poke -> Poke#
unPoke :: Poke#
}
poke :: Poke# -> Poke
poke :: Poke# -> Poke
poke = Poke# -> Poke
Poke
{-# INLINE poke #-}
instance Semigroup Poke where
{-# INLINE (<>) #-}
Poke Poke#
l <> :: Poke -> Poke -> Poke
<> Poke Poke#
r = Poke# -> Poke
Poke (Poke# -> Poke) -> Poke# -> Poke
forall a b. (a -> b) -> a -> b
$ \Addr#
addr# State# RealWorld
st# ->
case Poke#
l Addr#
addr# State# RealWorld
st# of (# State# RealWorld
st'#, Addr#
addr'# #) -> Poke#
r Addr#
addr'# State# RealWorld
st'#
instance Monoid Poke where
{-# INLINE mempty #-}
mempty :: Poke
mempty = Poke# -> Poke
Poke (Poke# -> Poke) -> Poke# -> Poke
forall a b. (a -> b) -> a -> b
$ \Addr#
addr# State# RealWorld
st# -> (# State# RealWorld
st#, Addr#
addr# #)
runPoke :: Int -> Poke -> B.ByteString
runPoke :: Int -> Poke -> ByteString
runPoke Int
len = Int -> (Ptr Word8 -> IO ()) -> ByteString
B.unsafeCreate Int
len ((Ptr Word8 -> IO ()) -> ByteString)
-> (Poke -> Ptr Word8 -> IO ()) -> Poke -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Poke -> Ptr Word8 -> IO ()
wrapPoke
{-# INLINE runPoke #-}
wrapPoke :: Poke -> Ptr Word8 -> IO ()
wrapPoke :: Poke -> Ptr Word8 -> IO ()
wrapPoke (Poke Poke#
p) (Ptr Addr#
addr#) =
(State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO (\State# RealWorld
st# -> case Poke#
p Addr#
addr# State# RealWorld
st# of (# State# RealWorld
l, Addr#
_r #) -> (# State# RealWorld
l, () #))
{-# INLINE wrapPoke #-}
data Write = Write
{ Write -> Int
writeSize :: {-# UNPACK #-} !Int
, Write -> Poke
writePoke :: !Poke
}
write :: Int -> Poke# -> Write
write :: Int -> Poke# -> Write
write Int
len Poke#
p = Int -> Poke -> Write
Write Int
len (Poke# -> Poke
Poke Poke#
p)
{-# INLINE write #-}
instance Semigroup Write where
{-# INLINE (<>) #-}
Write Int
ll Poke
lp <> :: Write -> Write -> Write
<> Write Int
rl Poke
rp = Int -> Poke -> Write
Write (Int
ll Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rl) (Poke
lp Poke -> Poke -> Poke
forall a. Semigroup a => a -> a -> a
<> Poke
rp)
instance Monoid Write where
{-# INLINE mempty #-}
mempty :: Write
mempty = Int -> Poke -> Write
Write Int
0 Poke
forall a. Monoid a => a
mempty
instance Show Write where showsPrec :: Int -> Write -> ShowS
showsPrec Int
p = Int -> ByteString -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
p (ByteString -> ShowS) -> (Write -> ByteString) -> Write -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Write -> ByteString
runWrite
runWrite :: Write -> B.ByteString
runWrite :: Write -> ByteString
runWrite (Write Int
len Poke
p) = Int -> Poke -> ByteString
runPoke Int
len Poke
p
{-# INLINE runWrite #-}