{-# language BangPatterns #-}
{-# language LambdaCase #-}

-- Note: This actually gets used in more places than the
-- parser. Should probably get rid of End.
module Kafka.Parser.Context
  ( Context(..)
  , ContextualizedErrorCode(..)
  , Field(..)
  , encodeContextString
  ) where

import Kafka.ErrorCode (ErrorCode)

data ContextualizedErrorCode = ContextualizedErrorCode
  { ContextualizedErrorCode -> Context
context :: !Context
  , ContextualizedErrorCode -> ErrorCode
errorCode :: !ErrorCode
  }

encodeContextString :: Context -> String
encodeContextString :: Context -> String
encodeContextString = \case
  Context
Top -> String
""
  Context
End -> String
"!"
  Index !Int
ix Context
c -> Context -> String
encodeContextString Context
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"." String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
ix
  Field Field
f Context
c -> Context -> String
encodeContextString Context
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"." String -> String -> String
forall a. [a] -> [a] -> [a]
++ Field -> String
forall a. Show a => a -> String
show Field
f

data Context
  = Top
  | Field Field !Context
  | Index !Int !Context
  | End -- Signifies that end-of-input was expected
  deriving (Int -> Context -> String -> String
[Context] -> String -> String
Context -> String
(Int -> Context -> String -> String)
-> (Context -> String)
-> ([Context] -> String -> String)
-> Show Context
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Context -> String -> String
showsPrec :: Int -> Context -> String -> String
$cshow :: Context -> String
show :: Context -> String
$cshowList :: [Context] -> String -> String
showList :: [Context] -> String -> String
Show)

-- | This exists so that we can get better error messages when decoding fails.
data Field
  = AbortedTransactions
  | ApiKey
  | ApiKeys
  | AssignedPartitions
  | Assignment
  | Attributes
  | AuthorizedOperations
  | BaseOffset
  | BaseSequence
  | BaseTimestamp
  | BatchLength
  | BatchLengthLeftoverBytes
  | BatchLengthNegative
  | BatchLengthNotEnoughBytes
  | Brokers
  | ClusterId
  | CommittedLeaderEpoch
  | CommittedOffset
  | ControllerId
  | Coordinators
  | CorrelationId
  | Crc
  | CrcMismatch
  | ErrorCode
  | ErrorMessage
  | Errors
  | GenerationId
  | GroupInstanceId
  | Groups
  | HighWatermark
  | Host
  | Id
  | Internal
  | IsrNodes
  | Ix
  | Key
  | LastOffsetDelta
  | LastStableOffset
  | Leader
  | LeaderEpoch
  | LeaderId
  | LogAppendTimeMilliseconds
  | LogStartOffset
  | Magic
  | MaxTimestamp
  | MaxVersion
  | MemberId
  | Members
  | Message
  | Metadata
  | MinVersion
  | Name
  | NodeId
  | OfflineReplicas
  | Offset
  | OwnedPartitions
  | PartitionLeaderEpoch
  | Partitions
  | Port
  | PreferredReadReplica
  | ProducerEpoch
  | ProducerId
  | ProtocolName
  | ProtocolType
  | Rack
  | RecordBatch
  | RecordBatchLeftoverBytes
  | RecordBatchLength
  | RecordBatchNotEnoughBytes
  | RecordsCount
  | ReplicaNodes
  | SessionId
  | SkipAssignment
  | TagBuffer
  | TaggedFieldContents
  | TaggedFieldLength
  | TaggedFieldTag
  | ThrottleTimeMilliseconds
  | Timestamp
  | Topic
  | Topics
  | UserData
  | Version
  deriving (Int -> Field -> String -> String
[Field] -> String -> String
Field -> String
(Int -> Field -> String -> String)
-> (Field -> String) -> ([Field] -> String -> String) -> Show Field
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Field -> String -> String
showsPrec :: Int -> Field -> String -> String
$cshow :: Field -> String
show :: Field -> String
$cshowList :: [Field] -> String -> String
showList :: [Field] -> String -> String
Show)