{-# language BangPatterns #-}
{-# language BinaryLiterals #-}
{-# language DerivingStrategies #-}
{-# language NumericUnderscores #-}

module Kafka.RecordBatch.Attributes
  ( -- * Types
    Compression(..)
  , TimestampType(..)
    -- * Getters
  , getCompression
  , getTimestampType
  ) where

import Data.Word (Word16)
import Data.Bits ((.&.),testBit)

data Compression
  = None
  | Gzip
  | Snappy
  | Lz4
  deriving stock (Compression -> Compression -> Bool
(Compression -> Compression -> Bool)
-> (Compression -> Compression -> Bool) -> Eq Compression
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Compression -> Compression -> Bool
== :: Compression -> Compression -> Bool
$c/= :: Compression -> Compression -> Bool
/= :: Compression -> Compression -> Bool
Eq,Int -> Compression -> ShowS
[Compression] -> ShowS
Compression -> String
(Int -> Compression -> ShowS)
-> (Compression -> String)
-> ([Compression] -> ShowS)
-> Show Compression
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Compression -> ShowS
showsPrec :: Int -> Compression -> ShowS
$cshow :: Compression -> String
show :: Compression -> String
$cshowList :: [Compression] -> ShowS
showList :: [Compression] -> ShowS
Show)

data TimestampType
  = CreateTime
  | LogAppendTime
  deriving stock (TimestampType -> TimestampType -> Bool
(TimestampType -> TimestampType -> Bool)
-> (TimestampType -> TimestampType -> Bool) -> Eq TimestampType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TimestampType -> TimestampType -> Bool
== :: TimestampType -> TimestampType -> Bool
$c/= :: TimestampType -> TimestampType -> Bool
/= :: TimestampType -> TimestampType -> Bool
Eq,Int -> TimestampType -> ShowS
[TimestampType] -> ShowS
TimestampType -> String
(Int -> TimestampType -> ShowS)
-> (TimestampType -> String)
-> ([TimestampType] -> ShowS)
-> Show TimestampType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TimestampType -> ShowS
showsPrec :: Int -> TimestampType -> ShowS
$cshow :: TimestampType -> String
show :: TimestampType -> String
$cshowList :: [TimestampType] -> ShowS
showList :: [TimestampType] -> ShowS
Show)

getCompression :: Word16 -> Compression
getCompression :: Word16 -> Compression
getCompression !Word16
w = case Word16
w Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. Word16
0b0000_0000_0000_0011 of
  Word16
0 -> Compression
None
  Word16
1 -> Compression
Gzip
  Word16
2 -> Compression
Snappy
  Word16
_ -> Compression
Lz4

getTimestampType :: Word16 -> TimestampType
getTimestampType :: Word16 -> TimestampType
getTimestampType !Word16
w = if Word16 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word16
w Int
2
  then TimestampType
LogAppendTime
  else TimestampType
CreateTime