{-# LANGUAGE GADTs #-}

module Kafka.Internal where

import qualified Control.Exception.Safe as Exception
import qualified Data.Aeson as Aeson
import qualified Kafka.Producer as Producer
import qualified Prelude

-- | A handler for writing to Kafka
data Handler = Handler
  { -- | sends messages asynchronously with to Kafka
    --
    -- This is the recommended approach for high throughput. The C++ library
    -- behind hte scenes, librdkafka, will batch messages together.
    Handler -> Task Never () -> Msg -> Task Text ()
sendAsync :: Task Never () -> Msg -> Task Text (),
    -- | sends messages synchronously with to Kafka
    --
    -- This can have a large negative impact on throughput. Use sparingly!
    Handler -> Msg -> Task Text ()
sendSync :: Msg -> Task Text ()
  }

-- | A message that can be written to Kafka
data Msg = Msg
  { Msg -> Topic
topic :: Topic,
    Msg -> Maybe Key
key :: Maybe Key,
    Msg -> Maybe Encodable
payload :: Maybe Encodable
  }
  deriving ((forall x. Msg -> Rep Msg x)
-> (forall x. Rep Msg x -> Msg) -> Generic Msg
forall x. Rep Msg x -> Msg
forall x. Msg -> Rep Msg x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Msg x -> Msg
$cfrom :: forall x. Msg -> Rep Msg x
Generic, Int -> Msg -> ShowS
[Msg] -> ShowS
Msg -> String
(Int -> Msg -> ShowS)
-> (Msg -> String) -> ([Msg] -> ShowS) -> Show Msg
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Msg] -> ShowS
$cshowList :: [Msg] -> ShowS
show :: Msg -> String
$cshow :: Msg -> String
showsPrec :: Int -> Msg -> ShowS
$cshowsPrec :: Int -> Msg -> ShowS
Show)

instance Aeson.ToJSON Msg

data Encodable where
  Encodable :: (Aeson.FromJSON a, Aeson.ToJSON a) => a -> Encodable

instance Aeson.ToJSON Encodable where
  toJSON :: Encodable -> Value
toJSON (Encodable a
x) = a -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON a
x
  toEncoding :: Encodable -> Encoding
toEncoding (Encodable a
x) = a -> Encoding
forall a. ToJSON a => a -> Encoding
Aeson.toEncoding a
x

instance Aeson.FromJSON Encodable where
  parseJSON :: Value -> Parser Encodable
parseJSON Value
x = do
    Value
val <- Value -> Parser Value
forall a. FromJSON a => Value -> Parser a
Aeson.parseJSON Value
x
    Encodable -> Parser Encodable
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (Value -> Encodable
forall a. (FromJSON a, ToJSON a) => a -> Encodable
Encodable (Value
val :: Aeson.Value))

instance Show Encodable where
  show :: Encodable -> String
show (Encodable a
x) = Value -> String
forall a. Show a => a -> String
Prelude.show (a -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON a
x)

-- | Errors.
-- If you experience an 'Uncaught' exception, please wrap it here type here!
data Error
  = SendingFailed (Producer.ProducerRecord, Producer.KafkaError)
  | Uncaught Exception.SomeException
  deriving (Int -> Error -> ShowS
[Error] -> ShowS
Error -> String
(Int -> Error -> ShowS)
-> (Error -> String) -> ([Error] -> ShowS) -> Show Error
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Error] -> ShowS
$cshowList :: [Error] -> ShowS
show :: Error -> String
$cshow :: Error -> String
showsPrec :: Int -> Error -> ShowS
$cshowsPrec :: Int -> Error -> ShowS
Show)

errorToText :: Error -> Text
errorToText :: Error -> Text
errorToText Error
err = String -> Text
Text.fromList (Error -> String
forall a. Show a => a -> String
Prelude.show Error
err)

-- | A kafka topic
newtype Topic = Topic {Topic -> Text
unTopic :: Text} deriving ([Topic] -> Encoding
[Topic] -> Value
Topic -> Encoding
Topic -> Value
(Topic -> Value)
-> (Topic -> Encoding)
-> ([Topic] -> Value)
-> ([Topic] -> Encoding)
-> ToJSON Topic
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Topic] -> Encoding
$ctoEncodingList :: [Topic] -> Encoding
toJSONList :: [Topic] -> Value
$ctoJSONList :: [Topic] -> Value
toEncoding :: Topic -> Encoding
$ctoEncoding :: Topic -> Encoding
toJSON :: Topic -> Value
$ctoJSON :: Topic -> Value
Aeson.ToJSON, 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
showList :: [Topic] -> ShowS
$cshowList :: [Topic] -> ShowS
show :: Topic -> String
$cshow :: Topic -> String
showsPrec :: Int -> Topic -> ShowS
$cshowsPrec :: Int -> Topic -> ShowS
Show)

-- | A kafka key
newtype Key = Key {Key -> Text
unKey :: Text} deriving (Int -> Key -> ShowS
[Key] -> ShowS
Key -> String
(Int -> Key -> ShowS)
-> (Key -> String) -> ([Key] -> ShowS) -> Show Key
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Key] -> ShowS
$cshowList :: [Key] -> ShowS
show :: Key -> String
$cshow :: Key -> String
showsPrec :: Int -> Key -> ShowS
$cshowsPrec :: Int -> Key -> ShowS
Show, [Key] -> Encoding
[Key] -> Value
Key -> Encoding
Key -> Value
(Key -> Value)
-> (Key -> Encoding)
-> ([Key] -> Value)
-> ([Key] -> Encoding)
-> ToJSON Key
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Key] -> Encoding
$ctoEncodingList :: [Key] -> Encoding
toJSONList :: [Key] -> Value
$ctoJSONList :: [Key] -> Value
toEncoding :: Key -> Encoding
$ctoEncoding :: Key -> Encoding
toJSON :: Key -> Value
$ctoJSON :: Key -> Value
Aeson.ToJSON, Key -> Key -> Bool
(Key -> Key -> Bool) -> (Key -> Key -> Bool) -> Eq Key
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Key -> Key -> Bool
$c/= :: Key -> Key -> Bool
== :: Key -> Key -> Bool
$c== :: Key -> Key -> Bool
Eq, Eq Key
Eq Key
-> (Key -> Key -> Ordering)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Key)
-> (Key -> Key -> Key)
-> Ord Key
Key -> Key -> Bool
Key -> Key -> Ordering
Key -> Key -> Key
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Key -> Key -> Key
$cmin :: Key -> Key -> Key
max :: Key -> Key -> Key
$cmax :: Key -> Key -> Key
>= :: Key -> Key -> Bool
$c>= :: Key -> Key -> Bool
> :: Key -> Key -> Bool
$c> :: Key -> Key -> Bool
<= :: Key -> Key -> Bool
$c<= :: Key -> Key -> Bool
< :: Key -> Key -> Bool
$c< :: Key -> Key -> Bool
compare :: Key -> Key -> Ordering
$ccompare :: Key -> Key -> Ordering
$cp1Ord :: Eq Key
Ord)

data MsgWithMetaData = MsgWithMetaData
  { MsgWithMetaData -> MetaData
metaData :: MetaData,
    MsgWithMetaData -> Encodable
value :: Encodable
  }
  deriving ((forall x. MsgWithMetaData -> Rep MsgWithMetaData x)
-> (forall x. Rep MsgWithMetaData x -> MsgWithMetaData)
-> Generic MsgWithMetaData
forall x. Rep MsgWithMetaData x -> MsgWithMetaData
forall x. MsgWithMetaData -> Rep MsgWithMetaData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MsgWithMetaData x -> MsgWithMetaData
$cfrom :: forall x. MsgWithMetaData -> Rep MsgWithMetaData x
Generic)

instance Aeson.ToJSON MsgWithMetaData

instance Aeson.FromJSON MsgWithMetaData

newtype MetaData = MetaData
  { MetaData -> Text
requestId :: Text
  }
  deriving ((forall x. MetaData -> Rep MetaData x)
-> (forall x. Rep MetaData x -> MetaData) -> Generic MetaData
forall x. Rep MetaData x -> MetaData
forall x. MetaData -> Rep MetaData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MetaData x -> MetaData
$cfrom :: forall x. MetaData -> Rep MetaData x
Generic)

instance Aeson.ToJSON MetaData

instance Aeson.FromJSON MetaData

newtype Offset = Offset Int