{-# LANGUAGE CPP #-}
{-# LANGUAGE UndecidableInstances #-}

#include <MachDeps.h>

-- | __Unsigned LEB128 codec__. This codec encodes an unsigned number
-- [as described here](https://en.wikipedia.org/wiki/LEB128#Unsigned_LEB128).
--
-- Any /getXXX/ decoder can decode bytes generated using any of the /putXXX/
-- encoders, provided the encoded number fits in the target type.
--
-- __WARNING__: This is not compatible with the /Signed LEB128/ codec at
-- "Data.Binary.SLEB128" nor with the /ZigZag LEB128/ codec at
-- "Data.Binary.ZLEB128".
module Data.Binary.ULEB128 {--}
  ( ULEB128 (..)

    -- * Put
  , putNatural
  , putWord64
  , putWord32
  , putWord16
  , putWord8
  , putWord

    -- * Get
  , getNatural
  , getWord64
  , getWord32
  , getWord16
  , getWord8
  , getWord
  , getInteger
  , getInt64
  , getInt32
  , getInt16
  , getInt8
  , getInt

    -- * ByteString
  , putByteString
  , getByteString

    -- ** Lazy
  , putLazyByteString
  , getLazyByteString

    -- ** Short
  , putShortByteString
  , getShortByteString
  ) -- }
where

import Data.Binary qualified as Bin
import Data.Binary.Get qualified as Bin
import Data.Binary.Put qualified as Bin
import Data.Bits
import Data.ByteString qualified as B
import Data.ByteString.Builder.Prim qualified as BB
import Data.ByteString.Builder.Prim.Internal qualified as BB
import Data.ByteString.Lazy qualified as BL
import Data.ByteString.Short qualified as BS
import Data.Int
import Foreign.Ptr
import Foreign.Storable
import GHC.Exts
import GHC.TypeLits qualified as GHC
import GHC.Num.Natural
import GHC.Word

--------------------------------------------------------------------------------

-- | Newtype wrapper for 'Bin.Binary' encoding and decoding @x@ using the
-- /Unsigned LEB128/ codec. Useful in conjunction with @DerivingVia@.
newtype ULEB128 x = ULEB128 x

-- | Note: Maximum allowed number of input bytes is restricted to 1024.
-- Use 'putNatural' if you want a greater limit.
instance Bin.Binary (ULEB128 Natural) where
  put :: ULEB128 Natural -> Put
put = (Natural -> Put) -> ULEB128 Natural -> Put
forall a b. Coercible a b => a -> b
coerce Natural -> Put
putNatural
  {-# INLINE put #-}
  get :: Get (ULEB128 Natural)
get = Get Natural -> Get (ULEB128 Natural)
forall a b. Coercible a b => a -> b
coerce (Int -> Get Natural
getNatural Int
1024)
  {-# INLINE get #-}

instance Bin.Binary (ULEB128 Word) where
  put :: ULEB128 Word -> Put
put = (Word -> Put) -> ULEB128 Word -> Put
forall a b. Coercible a b => a -> b
coerce Word -> Put
putWord
  {-# INLINE put #-}
  get :: Get (ULEB128 Word)
get = Get Word -> Get (ULEB128 Word)
forall a b. Coercible a b => a -> b
coerce Get Word
getWord
  {-# INLINE get #-}

instance Bin.Binary (ULEB128 Word8) where
  put :: ULEB128 Word8 -> Put
put = (Word8 -> Put) -> ULEB128 Word8 -> Put
forall a b. Coercible a b => a -> b
coerce Word8 -> Put
putWord8
  {-# INLINE put #-}
  get :: Get (ULEB128 Word8)
get = Get Word8 -> Get (ULEB128 Word8)
forall a b. Coercible a b => a -> b
coerce Get Word8
getWord8
  {-# INLINE get #-}

instance Bin.Binary (ULEB128 Word16) where
  put :: ULEB128 Word16 -> Put
put = (Word16 -> Put) -> ULEB128 Word16 -> Put
forall a b. Coercible a b => a -> b
coerce Word16 -> Put
putWord16
  {-# INLINE put #-}
  get :: Get (ULEB128 Word16)
get = Get Word16 -> Get (ULEB128 Word16)
forall a b. Coercible a b => a -> b
coerce Get Word16
getWord16
  {-# INLINE get #-}

instance Bin.Binary (ULEB128 Word32) where
  put :: ULEB128 Word32 -> Put
put = (Word32 -> Put) -> ULEB128 Word32 -> Put
forall a b. Coercible a b => a -> b
coerce Word32 -> Put
putWord32
  {-# INLINE put #-}
  get :: Get (ULEB128 Word32)
get = Get Word32 -> Get (ULEB128 Word32)
forall a b. Coercible a b => a -> b
coerce Get Word32
getWord32
  {-# INLINE get #-}

instance Bin.Binary (ULEB128 Word64) where
  put :: ULEB128 Word64 -> Put
put = (Word64 -> Put) -> ULEB128 Word64 -> Put
forall a b. Coercible a b => a -> b
coerce Word64 -> Put
putWord64
  {-# INLINE put #-}
  get :: Get (ULEB128 Word64)
get = Get Word64 -> Get (ULEB128 Word64)
forall a b. Coercible a b => a -> b
coerce Get Word64
getWord64
  {-# INLINE get #-}

instance DecodeOnly "getInt8" => Bin.Binary (ULEB128 Int8) where
  put :: ULEB128 Int8 -> Put
put = ULEB128 Int8 -> Put
forall a. HasCallStack => a
undefined
  get :: Get (ULEB128 Int8)
get = Get (ULEB128 Int8)
forall a. HasCallStack => a
undefined

instance DecodeOnly "getInt16" => Bin.Binary (ULEB128 Int16) where
  put :: ULEB128 Int16 -> Put
put = ULEB128 Int16 -> Put
forall a. HasCallStack => a
undefined
  get :: Get (ULEB128 Int16)
get = Get (ULEB128 Int16)
forall a. HasCallStack => a
undefined

instance DecodeOnly "getInt32" => Bin.Binary (ULEB128 Int32) where
  put :: ULEB128 Int32 -> Put
put = ULEB128 Int32 -> Put
forall a. HasCallStack => a
undefined
  get :: Get (ULEB128 Int32)
get = Get (ULEB128 Int32)
forall a. HasCallStack => a
undefined

instance DecodeOnly "getInt64" => Bin.Binary (ULEB128 Int64) where
  put :: ULEB128 Int64 -> Put
put = ULEB128 Int64 -> Put
forall a. HasCallStack => a
undefined
  get :: Get (ULEB128 Int64)
get = Get (ULEB128 Int64)
forall a. HasCallStack => a
undefined

instance DecodeOnly "getInt" => Bin.Binary (ULEB128 Int) where
  put :: ULEB128 Int -> Put
put = ULEB128 Int -> Put
forall a. HasCallStack => a
undefined
  get :: Get (ULEB128 Int)
get = Get (ULEB128 Int)
forall a. HasCallStack => a
undefined

instance DecodeOnly "getInteger" => Bin.Binary (ULEB128 Integer) where
  put :: ULEB128 Integer -> Put
put = ULEB128 Integer -> Put
forall a. HasCallStack => a
undefined
  get :: Get (ULEB128 Integer)
get = Get (ULEB128 Integer)
forall a. HasCallStack => a
undefined

type family DecodeOnly s where
  DecodeOnly s = GHC.TypeError (
    'GHC.Text "ULEB128 can't encode signed numbers, " 'GHC.:<>:
    'GHC.Text "use SLEB128 or ZLEB128 instead." 'GHC.:$$:
    'GHC.Text "To decode, use “ULEB128." 'GHC.:<>: 'GHC.Text s 'GHC.:<>:
    'GHC.Text "”.")

--------------------------------------------------------------------------------

putNatural :: Natural -> Bin.Put
putNatural :: Natural -> Put
putNatural (NS Word#
w#) = Word -> Put
putWord (Word# -> Word
W# Word#
w#)
putNatural Natural
a =
  let b :: Word8
b = Natural -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
a :: Word8
  in  case Natural -> Int -> Natural
forall a. Bits a => a -> Int -> a
unsafeShiftR Natural
a Int
7 of
        Natural
c | Natural
c Natural -> Natural -> Bool
forall a. Eq a => a -> a -> Bool
/= Natural
0    -> Word8 -> Put
Bin.putWord8 (Word8
b Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
0x80) Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Natural -> Put
putNatural Natural
c
          | Bool
otherwise -> Word8 -> Put
Bin.putWord8 Word8
b
{-# INLINE putNatural #-}

putWord8 :: Word8 -> Bin.Put
putWord8 :: Word8 -> Put
putWord8 = Builder -> Put
Bin.putBuilder
         (Builder -> Put) -> (Word8 -> Builder) -> Word8 -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BoundedPrim Word8 -> Word8 -> Builder
forall a. BoundedPrim a -> a -> Builder
BB.primBounded (Int -> (Word8 -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim Word8
forall a.
Int -> (a -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim a
BB.boundedPrim Int
2 Word8 -> Ptr Word8 -> IO (Ptr Word8)
forall a. (Bits a, Integral a) => a -> Ptr Word8 -> IO (Ptr Word8)
unsafePokeUnsigned)
{-# INLINE putWord8 #-}

putWord16 :: Word16 -> Bin.Put
putWord16 :: Word16 -> Put
putWord16 = Builder -> Put
Bin.putBuilder
          (Builder -> Put) -> (Word16 -> Builder) -> Word16 -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BoundedPrim Word16 -> Word16 -> Builder
forall a. BoundedPrim a -> a -> Builder
BB.primBounded (Int
-> (Word16 -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim Word16
forall a.
Int -> (a -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim a
BB.boundedPrim Int
3 Word16 -> Ptr Word8 -> IO (Ptr Word8)
forall a. (Bits a, Integral a) => a -> Ptr Word8 -> IO (Ptr Word8)
unsafePokeUnsigned)
{-# INLINE putWord16 #-}

putWord32 :: Word32 -> Bin.Put
putWord32 :: Word32 -> Put
putWord32 = Builder -> Put
Bin.putBuilder
          (Builder -> Put) -> (Word32 -> Builder) -> Word32 -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BoundedPrim Word32 -> Word32 -> Builder
forall a. BoundedPrim a -> a -> Builder
BB.primBounded (Int
-> (Word32 -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim Word32
forall a.
Int -> (a -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim a
BB.boundedPrim Int
5 Word32 -> Ptr Word8 -> IO (Ptr Word8)
forall a. (Bits a, Integral a) => a -> Ptr Word8 -> IO (Ptr Word8)
unsafePokeUnsigned)
{-# INLINE putWord32 #-}

putWord64 :: Word64 -> Bin.Put
putWord64 :: Word64 -> Put
putWord64 = Builder -> Put
Bin.putBuilder
          (Builder -> Put) -> (Word64 -> Builder) -> Word64 -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BoundedPrim Word64 -> Word64 -> Builder
forall a. BoundedPrim a -> a -> Builder
BB.primBounded (Int
-> (Word64 -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim Word64
forall a.
Int -> (a -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim a
BB.boundedPrim Int
10 Word64 -> Ptr Word8 -> IO (Ptr Word8)
forall a. (Bits a, Integral a) => a -> Ptr Word8 -> IO (Ptr Word8)
unsafePokeUnsigned)
{-# INLINE putWord64 #-}

putWord :: Word -> Bin.Put
putWord :: Word -> Put
putWord =
#if WORD_SIZE_IN_BITS == 64
  Builder -> Put
Bin.putBuilder (Builder -> Put) -> (Word -> Builder) -> Word -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BoundedPrim Word -> Word -> Builder
forall a. BoundedPrim a -> a -> Builder
BB.primBounded (Int -> (Word -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim Word
forall a.
Int -> (a -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim a
BB.boundedPrim Int
10 Word -> Ptr Word8 -> IO (Ptr Word8)
forall a. (Bits a, Integral a) => a -> Ptr Word8 -> IO (Ptr Word8)
unsafePokeUnsigned)
#elif WORD_SIZE_IN_BITS == 32
  Bin.putBuilder . BB.primBounded (BB.boundedPrim 5 unsafePokeUnsigned)
#endif
{-# INLINE putWord #-}

--------------------------------------------------------------------------------

getNatural
  :: Int
  -- ^ /Maximum/ number of bytes to consume. If the 'Natural' number can be
  -- determined before consuming this number of bytes, it will be. If @0@,
  -- parsing fails.
  --
  -- Each ULEB128 byte encodes at most 7 bits of data. That is,
  -- \(length(encoded) == \lceil\frac{length(data)}{7}\rceil\).
  -> Bin.Get Natural
getNatural :: Int -> Get Natural
getNatural = (Word8 -> Natural) -> Int -> Get Natural
forall a. (Bits a, Num a) => (Word8 -> a) -> Int -> Get a
unsafeGetUnsigned Word8 -> Natural
word8ToNatural
{-# INLINE getNatural #-}

-- | Like 'getNatural', except it's offered here so that other parsers can use
-- this specilized to types other than 'Natural'. This is unsafe because it
-- only works for unsigned numbers whose ULEB128 representation is at most as
-- long as the specified 'Int', but none of that is checked by this parser.
{-# INLINE unsafeGetUnsigned #-}
unsafeGetUnsigned
  :: forall a. (Bits a, Num a) => (Word8 -> a) -> Int -> Bin.Get a
unsafeGetUnsigned :: forall a. (Bits a, Num a) => (Word8 -> a) -> Int -> Get a
unsafeGetUnsigned Word8 -> a
fromWord8 = \Int
m -> String -> Get a -> Get a
forall a. String -> Get a -> Get a
Bin.label String
"ULEB128" (Int -> Int -> a -> Get a
go Int
m Int
0 a
0)
 where
  {-# INLINE go #-}
  go :: Int -> Int -> a -> Bin.Get a
  go :: Int -> Int -> a -> Get a
go Int
m Int
i a
o | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
m = do
    Word8
w <- Get Word8
Bin.getWord8
    if Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
0x80
      then Int -> Int -> a -> Get a
go Int
m (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (a -> Get a) -> a -> Get a
forall a b. (a -> b) -> a -> b
$! a
o a -> a -> a
forall a. Bits a => a -> a -> a
.|. a -> Int -> a
forall a. Bits a => a -> Int -> a
unsafeShiftL (Word8 -> a
fromWord8 (Word8
w Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x7f)) (Int
7 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i)
      else a -> Get a
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Get a) -> a -> Get a
forall a b. (a -> b) -> a -> b
$! a
o a -> a -> a
forall a. Bits a => a -> a -> a
.|. a -> Int -> a
forall a. Bits a => a -> Int -> a
unsafeShiftL (Word8 -> a
fromWord8 Word8
w) (Int
7 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i)
  go Int
_ Int
_ a
_ = String -> Get a
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"input exceeds maximum allowed bytes"

getInteger
  :: Int
  -- ^ /Maximum/ number of bytes to consume. If the 'Integer' number can be
  -- determined before consuming this number of bytes, it will be. If @0@,
  -- parsing fails.
  --
  -- Each ULEB128 byte encodes at most 7 bits of data. That is,
  -- \(length(encoded) == \lceil\frac{length(data)}{7}\rceil\).
  -> Bin.Get Integer
getInteger :: Int -> Get Integer
getInteger = (Natural -> Integer) -> Get Natural -> Get Integer
forall a b. (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Natural -> Integer
forall a. Integral a => a -> Integer
toInteger (Get Natural -> Get Integer)
-> (Int -> Get Natural) -> Int -> Get Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Get Natural
getNatural
{-# INLINE getInteger #-}

getBoundedIntegral
  :: forall s u
  .  (Bits s, Integral s, Bits u, Integral u)
  => Bin.Get s
  -> Bin.Get u
getBoundedIntegral :: forall s u.
(Bits s, Integral s, Bits u, Integral u) =>
Get s -> Get u
getBoundedIntegral = \Get s
gs -> do
  s
s <- Get s
gs
  String -> Get u -> Get u
forall a. String -> Get a -> Get a
Bin.label String
"ULEB128" (Get u -> Get u) -> Get u -> Get u
forall a b. (a -> b) -> a -> b
$ case s -> Maybe u
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
toIntegralSized s
s of
    Just u
u  -> u -> Get u
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure u
u
    Maybe u
Nothing -> String -> Get u
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"underflow or overflow"
{-# INLINE getBoundedIntegral #-}

getWord8 :: Bin.Get Word8
getWord8 :: Get Word8
getWord8 = (Word8 -> Word8) -> Int -> Get Word8
forall a. (Bits a, Num a) => (Word8 -> a) -> Int -> Get a
unsafeGetUnsigned Word8 -> Word8
forall a. a -> a
id Int
2
{-# INLINE getWord8 #-}

getWord16 :: Bin.Get Word16
getWord16 :: Get Word16
getWord16 = (Word8 -> Word16) -> Int -> Get Word16
forall a. (Bits a, Num a) => (Word8 -> a) -> Int -> Get a
unsafeGetUnsigned Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
3
{-# INLINE getWord16 #-}

getWord32 :: Bin.Get Word32
getWord32 :: Get Word32
getWord32 = (Word8 -> Word32) -> Int -> Get Word32
forall a. (Bits a, Num a) => (Word8 -> a) -> Int -> Get a
unsafeGetUnsigned Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
5
{-# INLINE getWord32 #-}

getWord64 :: Bin.Get Word64
getWord64 :: Get Word64
getWord64 = (Word8 -> Word64) -> Int -> Get Word64
forall a. (Bits a, Num a) => (Word8 -> a) -> Int -> Get a
unsafeGetUnsigned Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
10
{-# INLINE getWord64 #-}

getWord :: Bin.Get Word
getWord :: Get Word
getWord =
#if WORD_SIZE_IN_BITS == 64
  (Word8 -> Word) -> Int -> Get Word
forall a. (Bits a, Num a) => (Word8 -> a) -> Int -> Get a
unsafeGetUnsigned Word8 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
10
#elif WORD_SIZE_IN_BITS == 32
  unsafeGetUnsigned fromIntegral 5
#endif
{-# INLINE getWord #-}

getInt8 :: Bin.Get Int8
getInt8 :: Get Int8
getInt8 = Get Word8 -> Get Int8
forall s u.
(Bits s, Integral s, Bits u, Integral u) =>
Get s -> Get u
getBoundedIntegral (forall a. (Bits a, Num a) => (Word8 -> a) -> Int -> Get a
unsafeGetUnsigned @Word8 Word8 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
1)
{-# INLINE getInt8 #-}

getInt16 :: Bin.Get Int16
getInt16 :: Get Int16
getInt16 = Get Word16 -> Get Int16
forall s u.
(Bits s, Integral s, Bits u, Integral u) =>
Get s -> Get u
getBoundedIntegral Get Word16
getWord16
{-# INLINE getInt16 #-}

getInt32 :: Bin.Get Int32
getInt32 :: Get Int32
getInt32 = Get Word32 -> Get Int32
forall s u.
(Bits s, Integral s, Bits u, Integral u) =>
Get s -> Get u
getBoundedIntegral Get Word32
getWord32
{-# INLINE getInt32 #-}

getInt64 :: Bin.Get Int64
getInt64 :: Get Int64
getInt64 = Get Word64 -> Get Int64
forall s u.
(Bits s, Integral s, Bits u, Integral u) =>
Get s -> Get u
getBoundedIntegral Get Word64
getWord64
{-# INLINE getInt64 #-}

getInt :: Bin.Get Int
getInt :: Get Int
getInt = Get Word -> Get Int
forall s u.
(Bits s, Integral s, Bits u, Integral u) =>
Get s -> Get u
getBoundedIntegral Get Word
getWord
{-# INLINE getInt #-}

--------------------------------------------------------------------------------

-- | Puts a strict 'B.ByteString' with its ULEB128-encoded length as prefix.
--
-- See 'getByteString'.
putByteString :: B.ByteString -> Bin.Put
putByteString :: ByteString -> Put
putByteString = \ByteString
a -> do
  Word -> Put
putWord (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
B.length ByteString
a :: Int))
  ByteString -> Put
Bin.putByteString ByteString
a
{-# INLINE putByteString #-}

-- | Gets a strict 'B.ByteString' with its ULEB128-encoded length as prefix.
--
-- See 'putByteString'.
getByteString :: Bin.Get B.ByteString
getByteString :: Get ByteString
getByteString = Int -> Get ByteString
Bin.getByteString (Int -> Get ByteString) -> Get Int -> Get ByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Get Int
getInt
{-# INLINE getByteString #-}

-- | Puts a lazy 'B.ByteString' with its ULEB128-encoded length as prefix.
--
-- See 'getLazyByteString'.
putLazyByteString :: BL.ByteString -> Bin.Put
putLazyByteString :: ByteString -> Put
putLazyByteString = \ByteString
a -> do
  Word64 -> Put
putWord64 (Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int64
BL.length ByteString
a :: Int64))
  ByteString -> Put
Bin.putLazyByteString ByteString
a
{-# INLINE putLazyByteString #-}

-- | Gets a lazy 'BL.ByteString' with its ULEB128-encoded length as prefix.
--
-- See 'putLazyByteString'.
getLazyByteString :: Bin.Get BL.ByteString
getLazyByteString :: Get ByteString
getLazyByteString = Int64 -> Get ByteString
Bin.getLazyByteString (Int64 -> Get ByteString) -> Get Int64 -> Get ByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Get Int64
getInt64
{-# INLINE getLazyByteString #-}

-- | Puts a 'BS.ShortByteString' with its ULEB128-encoded length as prefix.
--
-- See 'getShortByteString'.
putShortByteString :: BS.ShortByteString -> Bin.Put
putShortByteString :: ShortByteString -> Put
putShortByteString = \ShortByteString
a -> do
  Word -> Put
putWord (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ShortByteString -> Int
BS.length ShortByteString
a :: Int))
  ShortByteString -> Put
Bin.putShortByteString ShortByteString
a
{-# INLINE putShortByteString #-}

-- | Gets a 'BS.ShortByteString' with its ULEB128-encoded length as prefix.
--
-- See 'putShortByteString'.
getShortByteString :: Bin.Get BS.ShortByteString
getShortByteString :: Get ShortByteString
getShortByteString = (ByteString -> ShortByteString)
-> Get ByteString -> Get ShortByteString
forall a b. (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> ShortByteString
BS.toShort (Int -> Get ByteString
Bin.getByteString (Int -> Get ByteString) -> Get Int -> Get ByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Get Int
getInt)
{-# INLINE getShortByteString #-}

--------------------------------------------------------------------------------

-- | ULEB128-encodes @a@ and writes it into 'Ptr'. Returns one past the last
-- written address. Only works with unsigned types. None of this is not checked.
unsafePokeUnsigned :: (Bits a, Integral a) => a -> Ptr Word8 -> IO (Ptr Word8)
unsafePokeUnsigned :: forall a. (Bits a, Integral a) => a -> Ptr Word8 -> IO (Ptr Word8)
unsafePokeUnsigned = \ !a
a !Ptr Word8
p ->
  case a -> Int -> a
forall a. Bits a => a -> Int -> a
unsafeShiftR a
a Int
7 of
    a
b | a
b a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
0 -> do
          Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
p (Word8 -> IO ()) -> Word8 -> IO ()
forall a b. (a -> b) -> a -> b
$! Word8
0x80 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. a -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
a
          a -> Ptr Word8 -> IO (Ptr Word8)
forall a. (Bits a, Integral a) => a -> Ptr Word8 -> IO (Ptr Word8)
unsafePokeUnsigned a
b (Ptr Word8 -> IO (Ptr Word8)) -> Ptr Word8 -> IO (Ptr Word8)
forall a b. (a -> b) -> a -> b
$! Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
p Int
1
      | Bool
otherwise -> do
          Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
p (Word8 -> IO ()) -> Word8 -> IO ()
forall a b. (a -> b) -> a -> b
$! a -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
a
          Ptr Word8 -> IO (Ptr Word8)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ptr Word8 -> IO (Ptr Word8)) -> Ptr Word8 -> IO (Ptr Word8)
forall a b. (a -> b) -> a -> b
$! Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
p Int
1
{-# INLINE unsafePokeUnsigned #-}


-- | This is faster than 'fromIntegral', which goes through 'Integer'.
word8ToNatural :: Word8 -> Natural
word8ToNatural :: Word8 -> Natural
word8ToNatural (W8# Word8#
a) = Word# -> Natural
NS (Word8# -> Word#
word8ToWord# Word8#
a)
{-# INLINE word8ToNatural #-}