{-# LANGUAGE CPP #-}
module ByteString.StrictBuilder.Population where

import ByteString.StrictBuilder.Prelude
import qualified Data.ByteString.Internal as B
import qualified Data.ByteString.Lazy.Internal as C
import qualified Data.ByteString.Builder.Internal as G
import qualified ByteString.StrictBuilder.Population.UncheckedShifting as D
import qualified ByteString.StrictBuilder.UTF8 as E


newtype Population =
  Population { Population -> Ptr Word8 -> IO (Ptr Word8)
populationPtrUpdate :: Ptr Word8 -> IO (Ptr Word8) }

instance Semigroup Population where
  <> :: Population -> Population -> Population
(<>) (Population Ptr Word8 -> IO (Ptr Word8)
leftPtrUpdate) (Population Ptr Word8 -> IO (Ptr Word8)
rightPtrUpdate) =
    (Ptr Word8 -> IO (Ptr Word8)) -> Population
Population (Ptr Word8 -> IO (Ptr Word8)
leftPtrUpdate (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)
rightPtrUpdate)

instance Monoid Population where
  {-# INLINE mempty #-}
  mempty :: Population
mempty =
    (Ptr Word8 -> IO (Ptr Word8)) -> Population
Population Ptr Word8 -> IO (Ptr Word8)
forall (m :: * -> *) a. Monad m => a -> m a
return


{-|
Turns into the standard lazy bytestring builder.
-}
{-# INLINE populationChunksBuilder #-}
populationChunksBuilder :: Population -> G.Builder
populationChunksBuilder :: Population -> Builder
populationChunksBuilder (Population Ptr Word8 -> IO (Ptr Word8)
ptrUpdate) =
  (forall r. BuildStep r -> BuildStep r) -> Builder
G.builder forall r. BuildStep r -> BuildStep r
stepUpdate
  where
    stepUpdate :: G.BuildStep a -> G.BuildStep a
    stepUpdate :: BuildStep a -> BuildStep a
stepUpdate BuildStep a
nextStep (G.BufferRange Ptr Word8
beginningPtr Ptr Word8
afterPtr) =
      do
        Ptr Word8
newBeginningPtr <- Ptr Word8 -> IO (Ptr Word8)
ptrUpdate Ptr Word8
beginningPtr
        BuildStep a
nextStep BuildStep a -> BuildStep a
forall a b. (a -> b) -> a -> b
$! Ptr Word8 -> Ptr Word8 -> BufferRange
G.BufferRange Ptr Word8
newBeginningPtr Ptr Word8
afterPtr

{-# INLINE followParallelly #-}
followParallelly :: Population -> Int -> Population -> Population
followParallelly :: Population -> Int -> Population -> Population
followParallelly (Population Ptr Word8 -> IO (Ptr Word8)
followerPtrUpdate) Int
followeeLength (Population Ptr Word8 -> IO (Ptr Word8)
followeePtrUpdate) =
  (Ptr Word8 -> IO (Ptr Word8)) -> Population
Population Ptr Word8 -> IO (Ptr Word8)
ptrUpdate
  where
    ptrUpdate :: Ptr Word8 -> IO (Ptr Word8)
ptrUpdate Ptr Word8
ptr =
      do
        MVar ()
lock <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar
        IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
          Ptr Word8 -> IO (Ptr Word8)
followeePtrUpdate Ptr Word8
ptr
          MVar () -> () -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar ()
lock ()
        Ptr Word8 -> IO (Ptr Word8)
followerPtrUpdate (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
ptr Int
followeeLength) IO (Ptr Word8) -> IO () -> IO (Ptr Word8)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* MVar () -> IO ()
forall a. MVar a -> IO a
takeMVar MVar ()
lock

-- |
-- Write the given bytes into the pointer and
-- return a pointer incremented by the amount of written bytes.
{-# INLINE bytes #-}
bytes :: B.ByteString -> Population
bytes :: ByteString -> Population
bytes (B.PS ForeignPtr Word8
foreignPointer Int
offset Int
length) =
  (Ptr Word8 -> IO (Ptr Word8)) -> Population
Population ((Ptr Word8 -> IO (Ptr Word8)) -> Population)
-> (Ptr Word8 -> IO (Ptr Word8)) -> Population
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr ->
  ForeignPtr Word8 -> (Ptr Word8 -> IO (Ptr Word8)) -> IO (Ptr Word8)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
foreignPointer ((Ptr Word8 -> IO (Ptr Word8)) -> IO (Ptr Word8))
-> (Ptr Word8 -> IO (Ptr Word8)) -> IO (Ptr Word8)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr' ->
  Ptr Word8 -> Ptr Word8 -> Int -> IO ()
B.memcpy Ptr Word8
ptr (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
ptr' Int
offset) Int
length 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
ptr Int
length

{-# INLINE storable #-}
storable :: Storable a => Int -> a -> Population
storable :: Int -> a -> Population
storable Int
size a
value =
  (Ptr Word8 -> IO (Ptr Word8)) -> Population
Population (\Ptr Word8
ptr -> Ptr a -> a -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8 -> Ptr a
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
ptr) a
value 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
ptr Int
size)

{-# INLINE word8 #-}
word8 :: Word8 -> Population
word8 :: Word8 -> Population
word8 Word8
value =
  (Ptr Word8 -> IO (Ptr Word8)) -> Population
Population ((Ptr Word8 -> IO (Ptr Word8)) -> Population)
-> (Ptr Word8 -> IO (Ptr Word8)) -> Population
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr ->
  Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
ptr Word8
value 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
ptr Int
1

{-# INLINE word16BE #-}
word16BE :: Word16 -> Population
#ifdef WORDS_BIGENDIAN
word16BE =
  storable 2
#else
word16BE :: Word16 -> Population
word16BE Word16
value =
  (Ptr Word8 -> IO (Ptr Word8)) -> Population
Population ((Ptr Word8 -> IO (Ptr Word8)) -> Population)
-> (Ptr Word8 -> IO (Ptr Word8)) -> Population
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr -> do
    Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
ptr (Word16 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int -> Word16
D.shiftr_w16 Word16
value Int
8) :: Word8)
    Ptr Word8 -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
ptr Int
1 (Word16 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
value :: Word8)
    Ptr Word8 -> IO (Ptr Word8)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
ptr Int
2)
#endif

{-# INLINE word32BE #-}
word32BE :: Word32 -> Population
#ifdef WORDS_BIGENDIAN
word32BE =
  storable 4
#else
word32BE :: Word32 -> Population
word32BE Word32
value =
  (Ptr Word8 -> IO (Ptr Word8)) -> Population
Population ((Ptr Word8 -> IO (Ptr Word8)) -> Population)
-> (Ptr Word8 -> IO (Ptr Word8)) -> Population
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr -> do
    Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
ptr (Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int -> Word32
D.shiftr_w32 Word32
value Int
24) :: Word8)
    Ptr Word8 -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
ptr Int
1 (Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int -> Word32
D.shiftr_w32 Word32
value Int
16) :: Word8)
    Ptr Word8 -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
ptr Int
2 (Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int -> Word32
D.shiftr_w32 Word32
value Int
8) :: Word8)
    Ptr Word8 -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
ptr Int
3 (Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
value :: Word8)
    Ptr Word8 -> IO (Ptr Word8)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
ptr Int
4)
#endif

{-# INLINE word64BE #-}
word64BE :: Word64 -> Population
#ifdef WORDS_BIGENDIAN
word64BE =
  storable 8
#else
#if WORD_SIZE_IN_BITS < 64
--
-- To avoid expensive 64 bit shifts on 32 bit machines, we cast to
-- Word32, and write that
--
word64BE :: Word64 -> Population
word64BE Word64
value =
  Word32 -> Population
word32BE (Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int -> Word64
D.shiftr_w64 Word64
value Int
32)) Population -> Population -> Population
forall a. Semigroup a => a -> a -> a
<>
  Word32 -> Population
word32BE (Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
value)
#else
word64BE value =
  Population $ \ptr -> do
    poke ptr (fromIntegral (D.shiftr_w64 value 56) :: Word8)
    pokeByteOff ptr 1 (fromIntegral (D.shiftr_w64 value 48) :: Word8)
    pokeByteOff ptr 2 (fromIntegral (D.shiftr_w64 value 40) :: Word8)
    pokeByteOff ptr 3 (fromIntegral (D.shiftr_w64 value 32) :: Word8)
    pokeByteOff ptr 4 (fromIntegral (D.shiftr_w64 value 24) :: Word8)
    pokeByteOff ptr 5 (fromIntegral (D.shiftr_w64 value 16) :: Word8)
    pokeByteOff ptr 6 (fromIntegral (D.shiftr_w64 value  8) :: Word8)
    pokeByteOff ptr 7 (fromIntegral value :: Word8)
    return (plusPtr ptr 8)
#endif
#endif

{-# INLINE int8 #-}
int8 :: Int8 -> Population
int8 :: Int8 -> Population
int8 =
  Word8 -> Population
word8 (Word8 -> Population) -> (Int8 -> Word8) -> Int8 -> Population
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int8 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Encoding 'Int16's in big endian format.
{-# INLINE int16BE #-}
int16BE :: Int16 -> Population
int16BE :: Int16 -> Population
int16BE =
  Word16 -> Population
word16BE (Word16 -> Population) -> (Int16 -> Word16) -> Int16 -> Population
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int16 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Encoding 'Int32's in big endian format.
{-# INLINE int32BE #-}
int32BE :: Int32 -> Population
int32BE :: Int32 -> Population
int32BE =
  Word32 -> Population
word32BE (Word32 -> Population) -> (Int32 -> Word32) -> Int32 -> Population
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Encoding 'Int64's in big endian format.
{-# INLINE int64BE #-}
int64BE :: Int64 -> Population
int64BE :: Int64 -> Population
int64BE =
  Word64 -> Population
word64BE (Word64 -> Population) -> (Int64 -> Word64) -> Int64 -> Population
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral

{-# INLINE bytes_1 #-}
bytes_1 :: Word8 -> Population
bytes_1 :: Word8 -> Population
bytes_1 Word8
byte1 =
  (Ptr Word8 -> IO (Ptr Word8)) -> Population
Population ((Ptr Word8 -> IO (Ptr Word8)) -> Population)
-> (Ptr Word8 -> IO (Ptr Word8)) -> Population
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr -> do
    Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
ptr Word8
byte1
    Ptr Word8 -> IO (Ptr Word8)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
ptr Int
1)

{-# INLINE bytes_2 #-}
bytes_2 :: Word8 -> Word8 -> Population
bytes_2 :: Word8 -> Word8 -> Population
bytes_2 Word8
byte1 Word8
byte2 =
  (Ptr Word8 -> IO (Ptr Word8)) -> Population
Population ((Ptr Word8 -> IO (Ptr Word8)) -> Population)
-> (Ptr Word8 -> IO (Ptr Word8)) -> Population
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr -> do
    Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
ptr Word8
byte1
    Ptr Word8 -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
ptr Int
1 Word8
byte2
    Ptr Word8 -> IO (Ptr Word8)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
ptr Int
2)

{-# INLINE bytes_3 #-}
bytes_3 :: Word8 -> Word8 -> Word8 -> Population
bytes_3 :: Word8 -> Word8 -> Word8 -> Population
bytes_3 Word8
byte1 Word8
byte2 Word8
byte3 =
  (Ptr Word8 -> IO (Ptr Word8)) -> Population
Population ((Ptr Word8 -> IO (Ptr Word8)) -> Population)
-> (Ptr Word8 -> IO (Ptr Word8)) -> Population
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr -> do
    Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
ptr Word8
byte1
    Ptr Word8 -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
ptr Int
1 Word8
byte2
    Ptr Word8 -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
ptr Int
2 Word8
byte3
    Ptr Word8 -> IO (Ptr Word8)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
ptr Int
3)

{-# INLINE bytes_4 #-}
bytes_4 :: Word8 -> Word8 -> Word8 -> Word8 -> Population
bytes_4 :: Word8 -> Word8 -> Word8 -> Word8 -> Population
bytes_4 Word8
byte1 Word8
byte2 Word8
byte3 Word8
byte4 =
  (Ptr Word8 -> IO (Ptr Word8)) -> Population
Population ((Ptr Word8 -> IO (Ptr Word8)) -> Population)
-> (Ptr Word8 -> IO (Ptr Word8)) -> Population
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr -> do
    Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
ptr Word8
byte1
    Ptr Word8 -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
ptr Int
1 Word8
byte2
    Ptr Word8 -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
ptr Int
2 Word8
byte3
    Ptr Word8 -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
ptr Int
3 Word8
byte4
    Ptr Word8 -> IO (Ptr Word8)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
ptr Int
4)

{-# INLINE utf8UnicodeCodePoint #-}
utf8UnicodeCodePoint :: Int -> Population
utf8UnicodeCodePoint :: Int -> Population
utf8UnicodeCodePoint Int
x =
  Int
-> (Word8 -> Population)
-> (Word8 -> Word8 -> Population)
-> (Word8 -> Word8 -> Word8 -> Population)
-> (Word8 -> Word8 -> Word8 -> Word8 -> Population)
-> Population
Int -> UTF8Char
E.unicodeCodePoint Int
x Word8 -> Population
bytes_1 Word8 -> Word8 -> Population
bytes_2 Word8 -> Word8 -> Word8 -> Population
bytes_3 Word8 -> Word8 -> Word8 -> Word8 -> Population
bytes_4

{-# INLINE utf8Char #-}
utf8Char :: Int -> Population
utf8Char :: Int -> Population
utf8Char Int
x =
  Int
-> (Word8 -> Population)
-> (Word8 -> Word8 -> Population)
-> (Word8 -> Word8 -> Word8 -> Population)
-> (Word8 -> Word8 -> Word8 -> Word8 -> Population)
-> Population
Int -> UTF8Char
E.unicodeCodePoint Int
x Word8 -> Population
bytes_1 Word8 -> Word8 -> Population
bytes_2 Word8 -> Word8 -> Word8 -> Population
bytes_3 Word8 -> Word8 -> Word8 -> Word8 -> Population
bytes_4