{-# language BangPatterns #-}
{-# language DerivingStrategies #-}
{-# language DuplicateRecordFields #-}
{-# language NamedFieldPuns #-}

module Kafka.OffsetFetch.Response.V8
  ( Response(..)
  , Group(..)
  , Topic(..)
  , Partition(..)
  , parser
  , decode
  ) where

import Prelude hiding (id)

import Control.Applicative (liftA2)
import Data.Bytes (Bytes)
import Data.Bytes.Parser (Parser)
import Data.Int (Int16,Int32,Int64)
import Data.Primitive (SmallArray,PrimArray)
import Data.Text (Text)
import Data.WideWord (Word128)
import Data.Word (Word32)
import Kafka.ErrorCode (ErrorCode)
import Kafka.Parser.Context (Context)
import Kafka.TaggedField (TaggedField)

import qualified Data.Bytes.Parser as Parser
import qualified Kafka.Parser.Context as Ctx
import qualified Kafka.TaggedField as TaggedField
import qualified Kafka.Parser
import qualified Kafka.Header.Response.V1 as Header

data Response = Response
  { Response -> Int32
throttleTimeMilliseconds :: !Int32
  , Response -> SmallArray Group
groups :: !(SmallArray Group)
  , Response -> SmallArray TaggedField
taggedFields :: !(SmallArray TaggedField)
  } deriving stock (Int -> Response -> ShowS
[Response] -> ShowS
Response -> String
(Int -> Response -> ShowS)
-> (Response -> String) -> ([Response] -> ShowS) -> Show Response
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Response -> ShowS
showsPrec :: Int -> Response -> ShowS
$cshow :: Response -> String
show :: Response -> String
$cshowList :: [Response] -> ShowS
showList :: [Response] -> ShowS
Show)

data Group = Group
  { Group -> Text
id :: !Text
  , Group -> SmallArray Topic
topics :: !(SmallArray Topic)
  , Group -> ErrorCode
errorCode :: !ErrorCode
  , Group -> SmallArray TaggedField
taggedFields :: !(SmallArray TaggedField)
  } deriving stock (Int -> Group -> ShowS
[Group] -> ShowS
Group -> String
(Int -> Group -> ShowS)
-> (Group -> String) -> ([Group] -> ShowS) -> Show Group
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Group -> ShowS
showsPrec :: Int -> Group -> ShowS
$cshow :: Group -> String
show :: Group -> String
$cshowList :: [Group] -> ShowS
showList :: [Group] -> ShowS
Show)

data Topic = Topic
  { Topic -> Text
name :: !Text
  , Topic -> SmallArray Partition
partitions :: !(SmallArray Partition)
  , Topic -> SmallArray TaggedField
taggedFields :: !(SmallArray TaggedField)
  } deriving stock (Int -> Topic -> ShowS
[Topic] -> ShowS
Topic -> String
(Int -> Topic -> ShowS)
-> (Topic -> String) -> ([Topic] -> ShowS) -> Show Topic
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Topic -> ShowS
showsPrec :: Int -> Topic -> ShowS
$cshow :: Topic -> String
show :: Topic -> String
$cshowList :: [Topic] -> ShowS
showList :: [Topic] -> ShowS
Show)

data Partition = Partition
  { Partition -> Int32
index :: !Int32
  , Partition -> Int64
committedOffset :: !Int64
  , Partition -> Int32
committedLeaderEpoch :: !Int32
  , Partition -> Text
metadata :: !Text
  , Partition -> ErrorCode
errorCode :: !ErrorCode
  , Partition -> SmallArray TaggedField
taggedFields :: !(SmallArray TaggedField)
  } deriving stock (Int -> Partition -> ShowS
[Partition] -> ShowS
Partition -> String
(Int -> Partition -> ShowS)
-> (Partition -> String)
-> ([Partition] -> ShowS)
-> Show Partition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Partition -> ShowS
showsPrec :: Int -> Partition -> ShowS
$cshow :: Partition -> String
show :: Partition -> String
$cshowList :: [Partition] -> ShowS
showList :: [Partition] -> ShowS
Show)

decode :: Bytes -> Either Context Response
decode :: Bytes -> Either Context Response
decode !Bytes
b = (forall s. Parser Context s Response)
-> Bytes -> Either Context Response
forall e a. (forall s. Parser e s a) -> Bytes -> Either e a
Parser.parseBytesEither (Context -> Parser Context s Response
forall s. Context -> Parser Context s Response
parser Context
Ctx.Top Parser Context s Response
-> Parser Context s () -> Parser Context s Response
forall a b.
Parser Context s a -> Parser Context s b -> Parser Context s a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Context -> Parser Context s ()
forall e s. e -> Parser e s ()
Parser.endOfInput Context
Ctx.End) Bytes
b

parser :: Context -> Parser Context s Response
parser :: forall s. Context -> Parser Context s Response
parser Context
ctx = do
  Int32
throttleTimeMilliseconds <- Context -> Parser Context s Int32
forall e s. e -> Parser e s Int32
Kafka.Parser.int32 (Field -> Context -> Context
Ctx.Field Field
Ctx.ThrottleTimeMilliseconds Context
ctx)
  SmallArray Group
groups <- (Context -> Parser Context s Group)
-> Context -> Parser Context s (SmallArray Group)
forall s a.
(Context -> Parser Context s a)
-> Context -> Parser Context s (SmallArray a)
Kafka.Parser.compactArray Context -> Parser Context s Group
forall s. Context -> Parser Context s Group
parserGroup (Field -> Context -> Context
Ctx.Field Field
Ctx.Groups Context
ctx)
  SmallArray TaggedField
taggedFields <- Context -> Parser Context s (SmallArray TaggedField)
forall s. Context -> Parser Context s (SmallArray TaggedField)
TaggedField.parserMany (Field -> Context -> Context
Ctx.Field Field
Ctx.TagBuffer Context
ctx)
  Response -> Parser Context s Response
forall a. a -> Parser Context s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Response{Int32
$sel:throttleTimeMilliseconds:Response :: Int32
throttleTimeMilliseconds :: Int32
throttleTimeMilliseconds,SmallArray Group
$sel:groups:Response :: SmallArray Group
groups :: SmallArray Group
groups,SmallArray TaggedField
$sel:taggedFields:Response :: SmallArray TaggedField
taggedFields :: SmallArray TaggedField
taggedFields}

parserGroup :: Context -> Parser Context s Group
parserGroup :: forall s. Context -> Parser Context s Group
parserGroup Context
ctx = do
  Text
id <- Context -> Parser Context s Text
forall s. Context -> Parser Context s Text
Kafka.Parser.compactString (Field -> Context -> Context
Ctx.Field Field
Ctx.Id Context
ctx)
  SmallArray Topic
topics <- (Context -> Parser Context s Topic)
-> Context -> Parser Context s (SmallArray Topic)
forall s a.
(Context -> Parser Context s a)
-> Context -> Parser Context s (SmallArray a)
Kafka.Parser.compactArray Context -> Parser Context s Topic
forall s. Context -> Parser Context s Topic
parserTopic (Field -> Context -> Context
Ctx.Field Field
Ctx.Topics Context
ctx)
  ErrorCode
errorCode <- Context -> Parser Context s ErrorCode
forall e s. e -> Parser e s ErrorCode
Kafka.Parser.errorCode (Field -> Context -> Context
Ctx.Field Field
Ctx.ErrorCode Context
ctx)
  SmallArray TaggedField
taggedFields <- Context -> Parser Context s (SmallArray TaggedField)
forall s. Context -> Parser Context s (SmallArray TaggedField)
TaggedField.parserMany (Field -> Context -> Context
Ctx.Field Field
Ctx.TagBuffer Context
ctx)
  Group -> Parser Context s Group
forall a. a -> Parser Context s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Group{Text
$sel:id:Group :: Text
id :: Text
id,SmallArray Topic
$sel:topics:Group :: SmallArray Topic
topics :: SmallArray Topic
topics,ErrorCode
$sel:errorCode:Group :: ErrorCode
errorCode :: ErrorCode
errorCode,SmallArray TaggedField
$sel:taggedFields:Group :: SmallArray TaggedField
taggedFields :: SmallArray TaggedField
taggedFields}

parserTopic :: Context -> Parser Context s Topic
parserTopic :: forall s. Context -> Parser Context s Topic
parserTopic Context
ctx = do
  Text
name <- Context -> Parser Context s Text
forall s. Context -> Parser Context s Text
Kafka.Parser.compactString (Field -> Context -> Context
Ctx.Field Field
Ctx.Name Context
ctx)
  SmallArray Partition
partitions <- (Context -> Parser Context s Partition)
-> Context -> Parser Context s (SmallArray Partition)
forall s a.
(Context -> Parser Context s a)
-> Context -> Parser Context s (SmallArray a)
Kafka.Parser.compactArray Context -> Parser Context s Partition
forall s. Context -> Parser Context s Partition
parserPartition (Field -> Context -> Context
Ctx.Field Field
Ctx.Partitions Context
ctx)
  SmallArray TaggedField
taggedFields <- Context -> Parser Context s (SmallArray TaggedField)
forall s. Context -> Parser Context s (SmallArray TaggedField)
TaggedField.parserMany (Field -> Context -> Context
Ctx.Field Field
Ctx.TagBuffer Context
ctx)
  Topic -> Parser Context s Topic
forall a. a -> Parser Context s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Topic{Text
$sel:name:Topic :: Text
name :: Text
name,SmallArray Partition
$sel:partitions:Topic :: SmallArray Partition
partitions :: SmallArray Partition
partitions,SmallArray TaggedField
$sel:taggedFields:Topic :: SmallArray TaggedField
taggedFields :: SmallArray TaggedField
taggedFields}

parserPartition :: Context -> Parser Context s Partition
parserPartition :: forall s. Context -> Parser Context s Partition
parserPartition Context
ctx = do
  Int32
index <- Context -> Parser Context s Int32
forall e s. e -> Parser e s Int32
Kafka.Parser.int32 (Field -> Context -> Context
Ctx.Field Field
Ctx.Ix Context
ctx)
  Int64
committedOffset <- Context -> Parser Context s Int64
forall e s. e -> Parser e s Int64
Kafka.Parser.int64 (Field -> Context -> Context
Ctx.Field Field
Ctx.CommittedOffset Context
ctx)
  Int32
committedLeaderEpoch <- Context -> Parser Context s Int32
forall e s. e -> Parser e s Int32
Kafka.Parser.int32 (Field -> Context -> Context
Ctx.Field Field
Ctx.CommittedLeaderEpoch Context
ctx)
  Text
metadata <- Context -> Parser Context s Text
forall s. Context -> Parser Context s Text
Kafka.Parser.compactString (Field -> Context -> Context
Ctx.Field Field
Ctx.Metadata Context
ctx)
  ErrorCode
errorCode <- Context -> Parser Context s ErrorCode
forall e s. e -> Parser e s ErrorCode
Kafka.Parser.errorCode (Field -> Context -> Context
Ctx.Field Field
Ctx.ErrorCode Context
ctx)
  SmallArray TaggedField
taggedFields <- Context -> Parser Context s (SmallArray TaggedField)
forall s. Context -> Parser Context s (SmallArray TaggedField)
TaggedField.parserMany (Field -> Context -> Context
Ctx.Field Field
Ctx.TagBuffer Context
ctx)
  Partition -> Parser Context s Partition
forall a. a -> Parser Context s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Partition
    { Int32
$sel:index:Partition :: Int32
index :: Int32
index
    , Int64
$sel:committedOffset:Partition :: Int64
committedOffset :: Int64
committedOffset
    , Int32
$sel:committedLeaderEpoch:Partition :: Int32
committedLeaderEpoch :: Int32
committedLeaderEpoch
    , Text
$sel:metadata:Partition :: Text
metadata :: Text
metadata
    , ErrorCode
$sel:errorCode:Partition :: ErrorCode
errorCode :: ErrorCode
errorCode
    , SmallArray TaggedField
$sel:taggedFields:Partition :: SmallArray TaggedField
taggedFields :: SmallArray TaggedField
taggedFields
    }