{-# language BangPatterns #-}
{-# language LambdaCase #-}
{-# language MultiWayIf #-}
{-# language NumericUnderscores #-}

module Kafka.Parser
  ( compactArray
  , array
  , compactBytes
  , nonCompactBytes
  , compactString
  , compactNullableString
  , string
  , compactInt32Array
  , int32Array
  , varintLengthPrefixedArray
  , varWordNative
  , varIntNative
  , varInt32
  , varInt64
  , apiKey
  , errorCode
  , boolean
  , BigEndian.int16
  , BigEndian.int32
  , BigEndian.word16
  , BigEndian.word32
  , BigEndian.int64
  , BigEndian.word128
  , Parser.fail
  ) where

import Data.Bytes (Bytes)
import Data.Bytes.Parser (Parser)
import Data.Int (Int32,Int64)
import Data.Primitive (SmallArray,PrimArray)
import Data.Text (Text)
import Kafka.ApiKey (ApiKey(ApiKey))
import Kafka.ErrorCode (ErrorCode(ErrorCode))
import Kafka.Parser.Context (Context)

import qualified Kafka.Parser.Context as Ctx
import qualified Data.Primitive as PM
import qualified Data.Bytes.Parser as Parser
import qualified Data.Bytes.Parser.Leb128 as Leb128
import qualified Data.Bytes.Parser.BigEndian as BigEndian
import qualified Data.Text.Short as TS
import qualified Data.Bytes as Bytes

boolean :: Context -> Parser Context s Bool
boolean :: forall s. Context -> Parser Context s Bool
boolean Context
ctx = Context -> Parser Context s Word8
forall e s. e -> Parser e s Word8
Parser.any Context
ctx Parser Context s Word8
-> (Word8 -> Parser Context s Bool) -> Parser Context s Bool
forall a b.
Parser Context s a
-> (a -> Parser Context s b) -> Parser Context s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Word8
0 -> Bool -> Parser Context s Bool
forall a. a -> Parser Context s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
  Word8
_ -> Bool -> Parser Context s Bool
forall a. a -> Parser Context s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True

nonCompactBytes :: Context -> Parser Context s Bytes
nonCompactBytes :: forall s. Context -> Parser Context s Bytes
nonCompactBytes Context
ctx = do
  Int32
len <- Context -> Parser Context s Int32
forall e s. e -> Parser e s Int32
BigEndian.int32 Context
ctx
  if | Int32
len Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
<= (-Int32
2) -> Context -> Parser Context s Bytes
forall e s a. e -> Parser e s a
Parser.fail Context
ctx
     | Int32
len Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int32
0 -> Bytes -> Parser Context s Bytes
forall a. a -> Parser Context s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bytes
forall a. Monoid a => a
mempty
     | Int32
len Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int32
1000000 -> Context -> Parser Context s Bytes
forall e s a. e -> Parser e s a
Parser.fail Context
ctx
     | Bool
otherwise -> Context -> Int -> Parser Context s Bytes
forall e s. e -> Int -> Parser e s Bytes
Parser.take Context
ctx (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
len)

-- | This maps NULL to the empty byte sequence.
compactBytes :: Context -> Parser Context s Bytes
compactBytes :: forall s. Context -> Parser Context s Bytes
compactBytes Context
ctx = do
  Word32
len0 <- Context -> Parser Context s Word32
forall e s. e -> Parser e s Word32
Leb128.word32 Context
ctx
  let !lenSucc :: Int
lenSucc = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
len0 :: Int
  if Int
lenSucc Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2
    then Bytes -> Parser Context s Bytes
forall a. a -> Parser Context s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bytes
forall a. Monoid a => a
mempty
    else do
      let len :: Int
len = Int
lenSucc Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
      Context -> Int -> Parser Context s Bytes
forall e s. e -> Int -> Parser e s Bytes
Parser.take Context
ctx Int
len

string :: Context -> Parser Context s Text
string :: forall s. Context -> Parser Context s Text
string Context
ctx = do
  Int16
len <- Context -> Parser Context s Int16
forall e s. e -> Parser e s Int16
BigEndian.int16 Context
ctx
  if | Int16
len Int16 -> Int16 -> Bool
forall a. Ord a => a -> a -> Bool
<= (-Int16
2) -> Context -> Parser Context s Text
forall e s a. e -> Parser e s a
Parser.fail Context
ctx
     | Int16
len Int16 -> Int16 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int16
0 -> Text -> Parser Context s Text
forall a. a -> Parser Context s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
forall a. Monoid a => a
mempty
     | Bool
otherwise -> do
         Bytes
b <- Context -> Int -> Parser Context s Bytes
forall e s. e -> Int -> Parser e s Bytes
Parser.take Context
ctx (Int16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int16
len)
         let sbs :: ShortByteString
sbs = Bytes -> ShortByteString
Bytes.toShortByteString Bytes
b
         case ShortByteString -> Maybe ShortText
TS.fromShortByteString ShortByteString
sbs of
           Maybe ShortText
Nothing -> Context -> Parser Context s Text
forall e s a. e -> Parser e s a
Parser.fail Context
ctx
           Just ShortText
ts -> Text -> Parser Context s Text
forall a. a -> Parser Context s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ShortText -> Text
TS.toText ShortText
ts)

-- | This maps NULL to the empty string.
compactString :: Context -> Parser Context s Text
compactString :: forall s. Context -> Parser Context s Text
compactString Context
ctx = do
  Word32
len0 <- Context -> Parser Context s Word32
forall e s. e -> Parser e s Word32
Leb128.word32 Context
ctx
  let !lenSucc :: Int
lenSucc = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
len0 :: Int
  if Int
lenSucc Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2
    then Text -> Parser Context s Text
forall a. a -> Parser Context s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
forall a. Monoid a => a
mempty
    else do
      let len :: Int
len = Int
lenSucc Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
      Bytes
b <- Context -> Int -> Parser Context s Bytes
forall e s. e -> Int -> Parser e s Bytes
Parser.take Context
ctx Int
len
      let sbs :: ShortByteString
sbs = Bytes -> ShortByteString
Bytes.toShortByteString Bytes
b
      case ShortByteString -> Maybe ShortText
TS.fromShortByteString ShortByteString
sbs of
        Maybe ShortText
Nothing -> Context -> Parser Context s Text
forall e s a. e -> Parser e s a
Parser.fail Context
ctx
        Just ShortText
ts -> Text -> Parser Context s Text
forall a. a -> Parser Context s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ShortText -> Text
TS.toText ShortText
ts)

compactNullableString :: Context -> Parser Context s (Maybe Text)
compactNullableString :: forall s. Context -> Parser Context s (Maybe Text)
compactNullableString Context
ctx = do
  Word32
len0 <- Context -> Parser Context s Word32
forall e s. e -> Parser e s Word32
Leb128.word32 Context
ctx
  let !lenSucc :: Int
lenSucc = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
len0 :: Int
  case Int
lenSucc of
    Int
0 -> Maybe Text -> Parser Context s (Maybe Text)
forall a. a -> Parser Context s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
forall a. Maybe a
Nothing
    Int
1 -> Maybe Text -> Parser Context s (Maybe Text)
forall a. a -> Parser Context s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
forall a. Monoid a => a
mempty)
    Int
_ -> do
      let len :: Int
len = Int
lenSucc Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
      Bytes
b <- Context -> Int -> Parser Context s Bytes
forall e s. e -> Int -> Parser e s Bytes
Parser.take Context
ctx Int
len
      let sbs :: ShortByteString
sbs = Bytes -> ShortByteString
Bytes.toShortByteString Bytes
b
      case ShortByteString -> Maybe ShortText
TS.fromShortByteString ShortByteString
sbs of
        Maybe ShortText
Nothing -> Context -> Parser Context s (Maybe Text)
forall e s a. e -> Parser e s a
Parser.fail Context
ctx
        Just ShortText
ts -> Maybe Text -> Parser Context s (Maybe Text)
forall a. a -> Parser Context s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Maybe Text
forall a. a -> Maybe a
Just (ShortText -> Text
TS.toText ShortText
ts))

int32Array :: Context -> Parser Context s (PrimArray Int32)
int32Array :: forall s. Context -> Parser Context s (PrimArray Int32)
int32Array Context
ctx = do
  Int32
len0 <- Context -> Parser Context s Int32
forall e s. e -> Parser e s Int32
BigEndian.int32 Context
ctx
  if | Int32
len0 Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
<= (-Int32
2) -> Context -> Parser Context s (PrimArray Int32)
forall e s a. e -> Parser e s a
Parser.fail Context
ctx
     | Int32
len0 Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int32
0 -> PrimArray Int32 -> Parser Context s (PrimArray Int32)
forall a. a -> Parser Context s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PrimArray Int32
forall a. Monoid a => a
mempty
     | Int32
len0 Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int32
1000000 -> Context -> Parser Context s (PrimArray Int32)
forall e s a. e -> Parser e s a
Parser.fail Context
ctx
     | Bool
otherwise -> do
         let len :: Int
len = Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
len0 :: Int
         MutablePrimArray s Int32
dst <- ST s (MutablePrimArray s Int32)
-> Parser Context s (MutablePrimArray s Int32)
forall s a e. ST s a -> Parser e s a
Parser.effect (Int -> ST s (MutablePrimArray (PrimState (ST s)) Int32)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
PM.newPrimArray Int
len)
         let go :: Int -> Parser Context s (PrimArray Int32)
go !Int
ix = if Int
ix Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
len
               then do
                 Int32
a <- Context -> Parser Context s Int32
forall e s. e -> Parser e s Int32
BigEndian.int32 (Int -> Context -> Context
Ctx.Index Int
ix Context
ctx)
                 ST s () -> Parser Context s ()
forall s a e. ST s a -> Parser e s a
Parser.effect (MutablePrimArray (PrimState (ST s)) Int32
-> Int -> Int32 -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
PM.writePrimArray MutablePrimArray s Int32
MutablePrimArray (PrimState (ST s)) Int32
dst Int
ix Int32
a)
                 Int -> Parser Context s (PrimArray Int32)
go (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
               else ST s (PrimArray Int32) -> Parser Context s (PrimArray Int32)
forall s a e. ST s a -> Parser e s a
Parser.effect (MutablePrimArray (PrimState (ST s)) Int32 -> ST s (PrimArray Int32)
forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
PM.unsafeFreezePrimArray MutablePrimArray s Int32
MutablePrimArray (PrimState (ST s)) Int32
dst)
         Int -> Parser Context s (PrimArray Int32)
go (Int
0 :: Int)

-- | This maps NULL to the empty array.
compactInt32Array :: Context -> Parser Context s (PrimArray Int32)
compactInt32Array :: forall s. Context -> Parser Context s (PrimArray Int32)
compactInt32Array Context
ctx = do
  Word32
len0 <- Context -> Parser Context s Word32
forall e s. e -> Parser e s Word32
Leb128.word32 Context
ctx
  let !lenSucc :: Int
lenSucc = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
len0 :: Int
  if Int
lenSucc Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2
    then PrimArray Int32 -> Parser Context s (PrimArray Int32)
forall a. a -> Parser Context s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PrimArray Int32
forall a. Monoid a => a
mempty
    else do
      let len :: Int
len = Int
lenSucc Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
      MutablePrimArray s Int32
dst <- ST s (MutablePrimArray s Int32)
-> Parser Context s (MutablePrimArray s Int32)
forall s a e. ST s a -> Parser e s a
Parser.effect (Int -> ST s (MutablePrimArray (PrimState (ST s)) Int32)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
PM.newPrimArray Int
len)
      let go :: Int -> Parser Context s (PrimArray Int32)
go !Int
ix = if Int
ix Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
len
            then do
              Int32
a <- Context -> Parser Context s Int32
forall e s. e -> Parser e s Int32
BigEndian.int32 (Int -> Context -> Context
Ctx.Index Int
ix Context
ctx)
              ST s () -> Parser Context s ()
forall s a e. ST s a -> Parser e s a
Parser.effect (MutablePrimArray (PrimState (ST s)) Int32
-> Int -> Int32 -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
PM.writePrimArray MutablePrimArray s Int32
MutablePrimArray (PrimState (ST s)) Int32
dst Int
ix Int32
a)
              Int -> Parser Context s (PrimArray Int32)
go (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
            else ST s (PrimArray Int32) -> Parser Context s (PrimArray Int32)
forall s a e. ST s a -> Parser e s a
Parser.effect (MutablePrimArray (PrimState (ST s)) Int32 -> ST s (PrimArray Int32)
forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
PM.unsafeFreezePrimArray MutablePrimArray s Int32
MutablePrimArray (PrimState (ST s)) Int32
dst)
      Int -> Parser Context s (PrimArray Int32)
go (Int
0 :: Int)

-- | This maps NULL to the empty array.
array :: (Context -> Parser Context s a) -> Context -> Parser Context s (SmallArray a)
{-# inline array #-}
array :: forall s a.
(Context -> Parser Context s a)
-> Context -> Parser Context s (SmallArray a)
array Context -> Parser Context s a
f Context
ctx = do
  Int32
len <- Context -> Parser Context s Int32
forall e s. e -> Parser e s Int32
BigEndian.int32 Context
ctx
  if | Int32
len Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
<= (-Int32
2) -> Context -> Parser Context s (SmallArray a)
forall e s a. e -> Parser e s a
Parser.fail Context
ctx
     | Int32
len Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int32
0 -> SmallArray a -> Parser Context s (SmallArray a)
forall a. a -> Parser Context s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SmallArray a
forall a. Monoid a => a
mempty
     | Int32
len Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int32
1000000 -> Context -> Parser Context s (SmallArray a)
forall e s a. e -> Parser e s a
Parser.fail Context
ctx
     | Bool
otherwise -> (Context -> Parser Context s a)
-> Int -> Context -> Parser Context s (SmallArray a)
forall s a.
(Context -> Parser Context s a)
-> Int -> Context -> Parser Context s (SmallArray a)
replicateN Context -> Parser Context s a
f (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
len) Context
ctx

-- | This maps NULL to the empty array.
compactArray :: (Context -> Parser Context s a) -> Context -> Parser Context s (SmallArray a)
{-# inline compactArray #-}
compactArray :: forall s a.
(Context -> Parser Context s a)
-> Context -> Parser Context s (SmallArray a)
compactArray Context -> Parser Context s a
f Context
ctx = do
  Word32
len0 <- Context -> Parser Context s Word32
forall e s. e -> Parser e s Word32
Leb128.word32 Context
ctx
  let !lenSucc :: Int
lenSucc = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
len0 :: Int
  if Int
lenSucc Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2
    then SmallArray a -> Parser Context s (SmallArray a)
forall a. a -> Parser Context s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SmallArray a
forall a. Monoid a => a
mempty
    else do
      let len :: Int
len = Int
lenSucc Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
      (Context -> Parser Context s a)
-> Int -> Context -> Parser Context s (SmallArray a)
forall s a.
(Context -> Parser Context s a)
-> Int -> Context -> Parser Context s (SmallArray a)
replicateN Context -> Parser Context s a
f Int
len Context
ctx

-- | This is the same thing as 'compactArray' except that the encoded number
-- is not expected to be the successor of the array length. Instead, it should
-- be the actual array length.
varintLengthPrefixedArray :: (Context -> Parser Context s a) -> Context -> Parser Context s (SmallArray a)
{-# inline varintLengthPrefixedArray #-}
varintLengthPrefixedArray :: forall s a.
(Context -> Parser Context s a)
-> Context -> Parser Context s (SmallArray a)
varintLengthPrefixedArray Context -> Parser Context s a
f Context
ctx = do
  Word32
len0 <- Context -> Parser Context s Word32
forall e s. e -> Parser e s Word32
Leb128.word32 Context
ctx
  let !len :: Int
len = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
len0 :: Int
  case Int
len of
    Int
0 -> SmallArray a -> Parser Context s (SmallArray a)
forall a. a -> Parser Context s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SmallArray a
forall a. Monoid a => a
mempty
    Int
_ | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
10_000_000 -> Context -> Parser Context s (SmallArray a)
forall e s a. e -> Parser e s a
Parser.fail Context
ctx
      | Bool
otherwise -> (Context -> Parser Context s a)
-> Int -> Context -> Parser Context s (SmallArray a)
forall s a.
(Context -> Parser Context s a)
-> Int -> Context -> Parser Context s (SmallArray a)
replicateN Context -> Parser Context s a
f Int
len Context
ctx

replicateN :: (Context -> Parser Context s a) -> Int -> Context -> Parser Context s (SmallArray a)
{-# inline replicateN #-}
replicateN :: forall s a.
(Context -> Parser Context s a)
-> Int -> Context -> Parser Context s (SmallArray a)
replicateN Context -> Parser Context s a
f !Int
len Context
ctx = do
  SmallMutableArray s a
dst <- ST s (SmallMutableArray s a)
-> Parser Context s (SmallMutableArray s a)
forall s a e. ST s a -> Parser e s a
Parser.effect (Int -> a -> ST s (SmallMutableArray (PrimState (ST s)) a)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (SmallMutableArray (PrimState m) a)
PM.newSmallArray Int
len a
forall a. a
uninitializedArray)
  let go :: Int -> Parser Context s (SmallArray a)
go !Int
ix = if Int
ix Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
len
        then do
          a
a <- Context -> Parser Context s a
f (Int -> Context -> Context
Ctx.Index Int
ix Context
ctx)
          ST s () -> Parser Context s ()
forall s a e. ST s a -> Parser e s a
Parser.effect (SmallMutableArray (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
PM.writeSmallArray SmallMutableArray s a
SmallMutableArray (PrimState (ST s)) a
dst Int
ix a
a)
          Int -> Parser Context s (SmallArray a)
go (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
        else ST s (SmallArray a) -> Parser Context s (SmallArray a)
forall s a e. ST s a -> Parser e s a
Parser.effect (SmallMutableArray (PrimState (ST s)) a -> ST s (SmallArray a)
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> m (SmallArray a)
PM.unsafeFreezeSmallArray SmallMutableArray s a
SmallMutableArray (PrimState (ST s)) a
dst)
  Int -> Parser Context s (SmallArray a)
go (Int
0 :: Int)

uninitializedArray :: a
uninitializedArray :: forall a. a
uninitializedArray = [Char] -> a
forall a. [Char] -> a
errorWithoutStackTrace [Char]
"Kafka.Parser: uninitializedArray"

varWordNative :: e -> Parser e s Word
{-# inline varWordNative #-}
varWordNative :: forall e s. e -> Parser e s Word
varWordNative e
e = (Word32 -> Word) -> Parser e s Word32 -> Parser e s Word
forall a b. (a -> b) -> Parser e s a -> Parser e s b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word32 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (e -> Parser e s Word32
forall e s. e -> Parser e s Word32
Leb128.word32 e
e)

-- This is only ever used for array lengths, so we restrict the
-- range to 32-bit integers.
varIntNative :: e -> Parser e s Int
{-# inline varIntNative #-}
varIntNative :: forall e s. e -> Parser e s Int
varIntNative e
e = (Int32 -> Int) -> Parser e s Int32 -> Parser e s Int
forall a b. (a -> b) -> Parser e s a -> Parser e s b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (e -> Parser e s Int32
forall e s. e -> Parser e s Int32
Leb128.int32 e
e)

varInt32 :: e -> Parser e s Int32
{-# inline varInt32 #-}
varInt32 :: forall e s. e -> Parser e s Int32
varInt32 e
e = e -> Parser e s Int32
forall e s. e -> Parser e s Int32
Leb128.int32 e
e

varInt64 :: e -> Parser e s Int64
{-# inline varInt64 #-}
varInt64 :: forall e s. e -> Parser e s Int64
varInt64 e
e = e -> Parser e s Int64
forall e s. e -> Parser e s Int64
Leb128.int64 e
e

-- | Same thing as 'int16' but wraps it up in ApiKey newtype.
apiKey :: e -> Parser e s ApiKey
{-# inline apiKey #-}
apiKey :: forall e s. e -> Parser e s ApiKey
apiKey e
e = (Int16 -> ApiKey) -> Parser e s Int16 -> Parser e s ApiKey
forall a b. (a -> b) -> Parser e s a -> Parser e s b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int16 -> ApiKey
ApiKey (e -> Parser e s Int16
forall e s. e -> Parser e s Int16
BigEndian.int16 e
e)

-- | Same thing as 'int16' but wraps it up in ErrorCode newtype.
errorCode :: e -> Parser e s ErrorCode
{-# inline errorCode #-}
errorCode :: forall e s. e -> Parser e s ErrorCode
errorCode e
e = (Int16 -> ErrorCode) -> Parser e s Int16 -> Parser e s ErrorCode
forall a b. (a -> b) -> Parser e s a -> Parser e s b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int16 -> ErrorCode
ErrorCode (e -> Parser e s Int16
forall e s. e -> Parser e s Int16
BigEndian.int16 e
e)