{-# LANGUAGE CPP #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleInstances         #-}
{-# LANGUAGE OverloadedStrings         #-}
{-# LANGUAGE RankNTypes                #-}
{-# LANGUAGE ScopedTypeVariables       #-}
{-# LANGUAGE TypeApplications          #-}
{-# LANGUAGE TypeFamilies              #-}

module Data.Avro.Encoding.ToAvro
where

import           Control.Monad.Identity       (Identity (..))
import qualified Data.Array                   as Ar
import           Data.Avro.Internal.EncodeRaw
import           Data.Avro.Internal.Time
import           Data.Avro.Schema.Decimal     as D
import           Data.Avro.Schema.Schema      as S
import qualified Data.Binary.IEEE754          as IEEE
import qualified Data.ByteString              as B
import           Data.ByteString.Builder
import           Data.ByteString.Lazy         as BL
import qualified Data.Foldable                as F
import           Data.HashMap.Strict          (HashMap)
import qualified Data.HashMap.Strict          as HashMap
import           Data.Int
import           Data.Ix                      (Ix)
import           Data.List                    as DL
import qualified Data.Map.Strict              as Map
import           Data.Maybe                   (fromJust)
import           Data.Text                    (Text)
import qualified Data.Text                    as T
import qualified Data.Text.Encoding           as T
#if MIN_VERSION_text(2,0,0)
import qualified Data.Text.Foreign            as T
#endif
import qualified Data.Text.Lazy               as TL
import qualified Data.Text.Lazy.Encoding      as TL
import qualified Data.Time                    as Time
import qualified Data.UUID                    as UUID
import qualified Data.Vector                  as V
import qualified Data.Vector.Unboxed          as U
import           Data.Word
import           GHC.TypeLits

{- HLINT ignore "Use section"         -}

newtype Encoder = Encoder { Encoder -> Schema -> Builder
runEncoder :: Schema -> Builder }

(.=) :: forall a. ToAvro a => Text -> a -> (Text, Encoder)
.= :: Text -> a -> (Text, Encoder)
(.=) Text
fieldName a
fieldValue = (Text
fieldName, (Schema -> Builder) -> Encoder
Encoder ((Schema -> a -> Builder) -> a -> Schema -> Builder
forall a b c. (a -> b -> c) -> b -> a -> c
flip Schema -> a -> Builder
forall a. ToAvro a => Schema -> a -> Builder
toAvro a
fieldValue))

record :: Schema -> [(Text, Encoder)] -> Builder
record :: Schema -> [(Text, Encoder)] -> Builder
record (S.Record TypeName
_ [TypeName]
_ Maybe Text
_ [Field]
fs) [(Text, Encoder)]
vs =
  (Field -> Builder) -> [Field] -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (HashMap Text Encoder -> Field -> Builder
mapField HashMap Text Encoder
provided) [Field]
fs
  where
    provided :: HashMap Text Encoder
    provided :: HashMap Text Encoder
provided = [(Text, Encoder)] -> HashMap Text Encoder
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList [(Text, Encoder)]
vs

    providedNames :: [Text]
providedNames = (Text, Encoder) -> Text
forall a b. (a, b) -> a
fst ((Text, Encoder) -> Text) -> [(Text, Encoder)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Encoder)]
vs

    failField :: S.Field -> Builder
    failField :: Field -> Builder
failField Field
fld = [Char] -> Builder
forall a. HasCallStack => [Char] -> a
error ([Char] -> Builder) -> [Char] -> Builder
forall a b. (a -> b) -> a -> b
$ [Char]
"Field '" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
forall a. Show a => a -> [Char]
show (Field -> Text
S.fldName Field
fld) [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"' is missing from the provided list of fields: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Text] -> [Char]
forall a. Show a => a -> [Char]
show [Text]
providedNames

    mapField :: HashMap Text Encoder -> S.Field -> Builder
    mapField :: HashMap Text Encoder -> Field -> Builder
mapField HashMap Text Encoder
env Field
fld =
      Builder -> (Encoder -> Builder) -> Maybe Encoder -> Builder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Field -> Builder
failField Field
fld) ((Encoder -> Schema -> Builder) -> Schema -> Encoder -> Builder
forall a b c. (a -> b -> c) -> b -> a -> c
flip Encoder -> Schema -> Builder
runEncoder (Field -> Schema
S.fldType Field
fld)) (Text -> HashMap Text Encoder -> Maybe Encoder
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup (Field -> Text
S.fldName Field
fld) HashMap Text Encoder
env)

-- | Describes how to encode Haskell data types into Avro bytes
class ToAvro a where
  toAvro :: Schema -> a -> Builder

instance ToAvro Int where
  toAvro :: Schema -> Int -> Builder
toAvro (S.Long Maybe LogicalTypeLong
_) Int
i = Int64 -> Builder
forall a. EncodeRaw a => a -> Builder
encodeRaw @Int64 (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i)
  toAvro (S.Int Maybe LogicalTypeInt
_) Int
i  = Int32 -> Builder
forall a. EncodeRaw a => a -> Builder
encodeRaw @Int32 (Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i)
  toAvro Schema
s Int
_          = [Char] -> Builder
forall a. HasCallStack => [Char] -> a
error ([Char]
"Unable to encode Int as: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Schema -> [Char]
forall a. Show a => a -> [Char]
show Schema
s)
  {-# INLINE toAvro #-}

instance ToAvro Int32 where
  toAvro :: Schema -> Int32 -> Builder
toAvro (S.Long Maybe LogicalTypeLong
_) Int32
i = Int64 -> Builder
forall a. EncodeRaw a => a -> Builder
encodeRaw @Int64 (Int32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
i)
  toAvro (S.Int Maybe LogicalTypeInt
_) Int32
i  = Int32 -> Builder
forall a. EncodeRaw a => a -> Builder
encodeRaw @Int32 Int32
i
  toAvro Schema
S.Double Int32
i   = Schema -> Double -> Builder
forall a. ToAvro a => Schema -> a -> Builder
toAvro @Double Schema
S.Double (Int32 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
i)
  toAvro Schema
S.Float Int32
i    = Schema -> Float -> Builder
forall a. ToAvro a => Schema -> a -> Builder
toAvro @Float Schema
S.Float (Int32 -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
i)
  toAvro Schema
s Int32
_          = [Char] -> Builder
forall a. HasCallStack => [Char] -> a
error ([Char]
"Unable to encode Int32 as: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Schema -> [Char]
forall a. Show a => a -> [Char]
show Schema
s)
  {-# INLINE toAvro #-}

instance ToAvro Int64 where
  toAvro :: Schema -> Int64 -> Builder
toAvro (S.Long Maybe LogicalTypeLong
_) Int64
i = Int64 -> Builder
forall a. EncodeRaw a => a -> Builder
encodeRaw @Int64 Int64
i
  toAvro Schema
S.Double Int64
i   = Schema -> Double -> Builder
forall a. ToAvro a => Schema -> a -> Builder
toAvro @Double Schema
S.Double (Int64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
i)
  toAvro Schema
S.Float Int64
i    = Schema -> Float -> Builder
forall a. ToAvro a => Schema -> a -> Builder
toAvro @Float Schema
S.Float (Int64 -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
i)
  toAvro Schema
s Int64
_          = [Char] -> Builder
forall a. HasCallStack => [Char] -> a
error ([Char]
"Unable to encode Int64 as: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Schema -> [Char]
forall a. Show a => a -> [Char]
show Schema
s)
  {-# INLINE toAvro #-}

instance ToAvro Word8 where
  toAvro :: Schema -> Word8 -> Builder
toAvro (S.Int Maybe LogicalTypeInt
_) Word8
i  = Word8 -> Builder
forall a. EncodeRaw a => a -> Builder
encodeRaw @Word8 Word8
i
  toAvro (S.Long Maybe LogicalTypeLong
_) Word8
i = Word64 -> Builder
forall a. EncodeRaw a => a -> Builder
encodeRaw @Word64 (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
i)
  toAvro Schema
S.Double Word8
i   = Schema -> Double -> Builder
forall a. ToAvro a => Schema -> a -> Builder
toAvro @Double Schema
S.Double (Word8 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
i)
  toAvro Schema
S.Float Word8
i    = Schema -> Float -> Builder
forall a. ToAvro a => Schema -> a -> Builder
toAvro @Float Schema
S.Float (Word8 -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
i)
  toAvro Schema
s Word8
_          = [Char] -> Builder
forall a. HasCallStack => [Char] -> a
error ([Char]
"Unable to encode Word8 as: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Schema -> [Char]
forall a. Show a => a -> [Char]
show Schema
s)
  {-# INLINE toAvro #-}

instance ToAvro Word16 where
  toAvro :: Schema -> Word16 -> Builder
toAvro (S.Int Maybe LogicalTypeInt
_) Word16
i  = Word16 -> Builder
forall a. EncodeRaw a => a -> Builder
encodeRaw @Word16 Word16
i
  toAvro (S.Long Maybe LogicalTypeLong
_) Word16
i = Word64 -> Builder
forall a. EncodeRaw a => a -> Builder
encodeRaw @Word64 (Word16 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
i)
  toAvro Schema
S.Double Word16
i   = Schema -> Double -> Builder
forall a. ToAvro a => Schema -> a -> Builder
toAvro @Double Schema
S.Double (Word16 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
i)
  toAvro Schema
S.Float Word16
i    = Schema -> Float -> Builder
forall a. ToAvro a => Schema -> a -> Builder
toAvro @Float Schema
S.Float (Word16 -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
i)
  toAvro Schema
s Word16
_          = [Char] -> Builder
forall a. HasCallStack => [Char] -> a
error ([Char]
"Unable to encode Word16 as: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Schema -> [Char]
forall a. Show a => a -> [Char]
show Schema
s)
  {-# INLINE toAvro #-}

instance ToAvro Word32 where
  toAvro :: Schema -> Word32 -> Builder
toAvro (S.Int Maybe LogicalTypeInt
_) Word32
i  = Word32 -> Builder
forall a. EncodeRaw a => a -> Builder
encodeRaw @Word32 Word32
i
  toAvro (S.Long Maybe LogicalTypeLong
_) Word32
i = Word64 -> Builder
forall a. EncodeRaw a => a -> Builder
encodeRaw @Word64 (Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
i)
  toAvro Schema
S.Double Word32
i   = Schema -> Double -> Builder
forall a. ToAvro a => Schema -> a -> Builder
toAvro @Double Schema
S.Double (Word32 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
i)
  toAvro Schema
S.Float Word32
i    = Schema -> Float -> Builder
forall a. ToAvro a => Schema -> a -> Builder
toAvro @Float Schema
S.Float (Word32 -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
i)
  toAvro Schema
s Word32
_          = [Char] -> Builder
forall a. HasCallStack => [Char] -> a
error ([Char]
"Unable to encode Word32 as: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Schema -> [Char]
forall a. Show a => a -> [Char]
show Schema
s)
  {-# INLINE toAvro #-}

instance ToAvro Word64 where
  toAvro :: Schema -> Word64 -> Builder
toAvro (S.Long Maybe LogicalTypeLong
_) Word64
i = Word64 -> Builder
forall a. EncodeRaw a => a -> Builder
encodeRaw @Word64 Word64
i
  toAvro Schema
S.Double Word64
i   = Schema -> Double -> Builder
forall a. ToAvro a => Schema -> a -> Builder
toAvro @Double Schema
S.Double (Word64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
i)
  toAvro Schema
s Word64
_          = [Char] -> Builder
forall a. HasCallStack => [Char] -> a
error ([Char]
"Unable to encode Word64 as: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Schema -> [Char]
forall a. Show a => a -> [Char]
show Schema
s)
  {-# INLINE toAvro #-}

instance ToAvro Double where
  toAvro :: Schema -> Double -> Builder
toAvro Schema
S.Double Double
i = Word64 -> Builder
word64LE (Double -> Word64
IEEE.doubleToWord Double
i)
  toAvro Schema
s Double
_        = [Char] -> Builder
forall a. HasCallStack => [Char] -> a
error ([Char]
"Unable to encode Double as: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Schema -> [Char]
forall a. Show a => a -> [Char]
show Schema
s)
  {-# INLINE toAvro #-}

instance ToAvro Float where
  toAvro :: Schema -> Float -> Builder
toAvro Schema
S.Float Float
i  = Word32 -> Builder
word32LE (Float -> Word32
IEEE.floatToWord Float
i)
  toAvro Schema
S.Double Float
i = Word64 -> Builder
word64LE (Double -> Word64
IEEE.doubleToWord (Double -> Word64) -> Double -> Word64
forall a b. (a -> b) -> a -> b
$ Float -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
i)
  toAvro Schema
s Float
_        = [Char] -> Builder
forall a. HasCallStack => [Char] -> a
error ([Char]
"Unable to encode Float as: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Schema -> [Char]
forall a. Show a => a -> [Char]
show Schema
s)
  {-# INLINE toAvro #-}

instance ToAvro () where
  toAvro :: Schema -> () -> Builder
toAvro Schema
S.Null () = Builder
forall a. Monoid a => a
mempty
  toAvro Schema
s ()      = [Char] -> Builder
forall a. HasCallStack => [Char] -> a
error ([Char]
"Unable to encode () as: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Schema -> [Char]
forall a. Show a => a -> [Char]
show Schema
s)

instance ToAvro Bool where
  toAvro :: Schema -> Bool -> Builder
toAvro Schema
S.Boolean Bool
v = Word8 -> Builder
word8 (Word8 -> Builder) -> Word8 -> Builder
forall a b. (a -> b) -> a -> b
$ Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Bool -> Int
forall a. Enum a => a -> Int
fromEnum Bool
v)
  toAvro Schema
s Bool
_         = [Char] -> Builder
forall a. HasCallStack => [Char] -> a
error ([Char]
"Unable to encode Bool as: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Schema -> [Char]
forall a. Show a => a -> [Char]
show Schema
s)
  {-# INLINE toAvro #-}

instance (KnownNat p, KnownNat s) => ToAvro (D.Decimal p s) where
  toAvro :: Schema -> Decimal p s -> Builder
toAvro Schema
s = Schema -> Int64 -> Builder
forall a. ToAvro a => Schema -> a -> Builder
toAvro @Int64 Schema
s (Int64 -> Builder)
-> (Decimal p s -> Int64) -> Decimal p s -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int64) -> (Decimal p s -> Int) -> Decimal p s -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Int -> Int)
-> (Decimal p s -> Maybe Int) -> Decimal p s -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Decimal p s -> Maybe Int
forall (s :: Nat) (p :: Nat).
(KnownNat p, KnownNat s) =>
Decimal p s -> Maybe Int
D.underlyingValue

instance ToAvro UUID.UUID where
  toAvro :: Schema -> UUID -> Builder
toAvro Schema
s = Schema -> Text -> Builder
forall a. ToAvro a => Schema -> a -> Builder
toAvro Schema
s (Text -> Builder) -> (UUID -> Text) -> UUID -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UUID -> Text
UUID.toText
  {-# INLINE toAvro #-}

instance ToAvro Time.Day where
  toAvro :: Schema -> Day -> Builder
toAvro Schema
s = Schema -> Int32 -> Builder
forall a. ToAvro a => Schema -> a -> Builder
toAvro @Int32 Schema
s (Int32 -> Builder) -> (Day -> Int32) -> Day -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int32) -> (Day -> Integer) -> Day -> Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> Integer
daysSinceEpoch
  {-# INLINE toAvro #-}

instance ToAvro Time.DiffTime where
  toAvro :: Schema -> DiffTime -> Builder
toAvro s :: Schema
s@(S.Long (Just LogicalTypeLong
S.TimeMicros))      = Schema -> Int64 -> Builder
forall a. ToAvro a => Schema -> a -> Builder
toAvro @Int64 Schema
s (Int64 -> Builder) -> (DiffTime -> Int64) -> DiffTime -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int64) -> (DiffTime -> Integer) -> DiffTime -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiffTime -> Integer
diffTimeToMicros
  toAvro s :: Schema
s@(S.Long (Just LogicalTypeLong
S.TimestampMicros)) = Schema -> Int64 -> Builder
forall a. ToAvro a => Schema -> a -> Builder
toAvro @Int64 Schema
s (Int64 -> Builder) -> (DiffTime -> Int64) -> DiffTime -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int64) -> (DiffTime -> Integer) -> DiffTime -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiffTime -> Integer
diffTimeToMicros
  toAvro s :: Schema
s@(S.Long (Just LogicalTypeLong
S.TimestampMillis)) = Schema -> Int64 -> Builder
forall a. ToAvro a => Schema -> a -> Builder
toAvro @Int64 Schema
s (Int64 -> Builder) -> (DiffTime -> Int64) -> DiffTime -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int64) -> (DiffTime -> Integer) -> DiffTime -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiffTime -> Integer
diffTimeToMillis
  toAvro s :: Schema
s@(S.Int  (Just LogicalTypeInt
S.TimeMillis))      = Schema -> Int32 -> Builder
forall a. ToAvro a => Schema -> a -> Builder
toAvro @Int32 Schema
s (Int32 -> Builder) -> (DiffTime -> Int32) -> DiffTime -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int32) -> (DiffTime -> Integer) -> DiffTime -> Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiffTime -> Integer
diffTimeToMillis
  toAvro Schema
s                                   = [Char] -> DiffTime -> Builder
forall a. HasCallStack => [Char] -> a
error ([Char]
"Unble to decode DiffTime from " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Schema -> [Char]
forall a. Show a => a -> [Char]
show Schema
s)

instance ToAvro Time.UTCTime where
  toAvro :: Schema -> UTCTime -> Builder
toAvro s :: Schema
s@(S.Long (Just LogicalTypeLong
S.TimestampMicros)) = Schema -> Int64 -> Builder
forall a. ToAvro a => Schema -> a -> Builder
toAvro @Int64 Schema
s (Int64 -> Builder) -> (UTCTime -> Int64) -> UTCTime -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int64) -> (UTCTime -> Integer) -> UTCTime -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> Integer
utcTimeToMicros
  toAvro s :: Schema
s@(S.Long (Just LogicalTypeLong
S.TimestampMillis)) = Schema -> Int64 -> Builder
forall a. ToAvro a => Schema -> a -> Builder
toAvro @Int64 Schema
s (Int64 -> Builder) -> (UTCTime -> Int64) -> UTCTime -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int64) -> (UTCTime -> Integer) -> UTCTime -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> Integer
utcTimeToMillis

instance ToAvro B.ByteString where
  toAvro :: Schema -> ByteString -> Builder
toAvro Schema
s ByteString
bs = case Schema
s of
    (S.Bytes Maybe LogicalTypeBytes
_)                        -> Int -> Builder
forall a. EncodeRaw a => a -> Builder
encodeRaw (ByteString -> Int
B.length ByteString
bs) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
byteString ByteString
bs
    (S.String Maybe LogicalTypeString
_)                       -> Int -> Builder
forall a. EncodeRaw a => a -> Builder
encodeRaw (ByteString -> Int
B.length ByteString
bs) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
byteString ByteString
bs
    S.Fixed TypeName
_ [TypeName]
_ Int
l Maybe LogicalTypeFixed
_ | Int
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> Int
B.length ByteString
bs -> ByteString -> Builder
byteString ByteString
bs
    S.Fixed TypeName
_ [TypeName]
_ Int
l Maybe LogicalTypeFixed
_                    -> [Char] -> Builder
forall a. HasCallStack => [Char] -> a
error ([Char]
"Unable to encode ByteString as Fixed(" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Int -> [Char]
forall a. Show a => a -> [Char]
show Int
l [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
") because its length is " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Int -> [Char]
forall a. Show a => a -> [Char]
show (ByteString -> Int
B.length ByteString
bs))
    Schema
_                                  -> [Char] -> Builder
forall a. HasCallStack => [Char] -> a
error ([Char]
"Unable to encode ByteString as: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Schema -> [Char]
forall a. Show a => a -> [Char]
show Schema
s)
  {-# INLINE toAvro #-}

instance ToAvro BL.ByteString where
  toAvro :: Schema -> ByteString -> Builder
toAvro Schema
s ByteString
bs = Schema -> ByteString -> Builder
forall a. ToAvro a => Schema -> a -> Builder
toAvro Schema
s (ByteString -> ByteString
BL.toStrict ByteString
bs)
  {-# INLINE toAvro #-}

instance ToAvro Text where
  toAvro :: Schema -> Text -> Builder
toAvro Schema
s Text
v =
#if MIN_VERSION_text(2,0,0)
    let
      res =
        encodeRaw @Int64 (fromIntegral (T.lengthWord8 v)) <> T.encodeUtf8Builder v
     in case s of
       (S.Bytes _)  -> res
       (S.String _) -> res
       _            -> error ("Unable to encode Text as: " <> show s)
#else
    let
      bs :: ByteString
bs = Text -> ByteString
T.encodeUtf8 Text
v
      res :: Builder
res = Int -> Builder
forall a. EncodeRaw a => a -> Builder
encodeRaw (ByteString -> Int
B.length ByteString
bs) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
byteString ByteString
bs
    in case Schema
s of
      (S.Bytes Maybe LogicalTypeBytes
_)  -> Builder
res
      (S.String Maybe LogicalTypeString
_) -> Builder
res
      Schema
_            -> [Char] -> Builder
forall a. HasCallStack => [Char] -> a
error ([Char]
"Unable to encode Text as: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Schema -> [Char]
forall a. Show a => a -> [Char]
show Schema
s)
#endif
  {-# INLINE toAvro #-}

instance ToAvro TL.Text where
  toAvro :: Schema -> Text -> Builder
toAvro Schema
s Text
v = Schema -> Text -> Builder
forall a. ToAvro a => Schema -> a -> Builder
toAvro Schema
s (Text -> Text
TL.toStrict Text
v)
  {-# INLINE toAvro #-}

instance ToAvro a => ToAvro [a] where
  toAvro :: Schema -> [a] -> Builder
toAvro (S.Array Schema
s) [a]
as =
    if [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
DL.null [a]
as then Builder
long0 else Int -> Builder
forall a. EncodeRaw a => a -> Builder
encodeRaw ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
F.length [a]
as) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (a -> Builder) -> [a] -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Schema -> a -> Builder
forall a. ToAvro a => Schema -> a -> Builder
toAvro Schema
s) [a]
as Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
long0
  toAvro Schema
s [a]
_         = [Char] -> Builder
forall a. HasCallStack => [Char] -> a
error ([Char]
"Unable to encode Haskell list as: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Schema -> [Char]
forall a. Show a => a -> [Char]
show Schema
s)

instance ToAvro a => ToAvro (V.Vector a) where
  toAvro :: Schema -> Vector a -> Builder
toAvro (S.Array Schema
s) Vector a
as =
    if Vector a -> Bool
forall a. Vector a -> Bool
V.null Vector a
as then Builder
long0 else Int -> Builder
forall a. EncodeRaw a => a -> Builder
encodeRaw (Vector a -> Int
forall a. Vector a -> Int
V.length Vector a
as) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (a -> Builder) -> Vector a -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Schema -> a -> Builder
forall a. ToAvro a => Schema -> a -> Builder
toAvro Schema
s) Vector a
as Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
long0
  toAvro Schema
s Vector a
_         = [Char] -> Builder
forall a. HasCallStack => [Char] -> a
error ([Char]
"Unable to encode Vector list as: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Schema -> [Char]
forall a. Show a => a -> [Char]
show Schema
s)

instance (Ix i, ToAvro a) => ToAvro (Ar.Array i a) where
  toAvro :: Schema -> Array i a -> Builder
toAvro (S.Array Schema
s) Array i a
as =
    if Array i a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
F.length Array i a
as Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Builder
long0 else Int -> Builder
forall a. EncodeRaw a => a -> Builder
encodeRaw (Array i a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
F.length Array i a
as) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (a -> Builder) -> Array i a -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Schema -> a -> Builder
forall a. ToAvro a => Schema -> a -> Builder
toAvro Schema
s) Array i a
as Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
long0
  toAvro Schema
s Array i a
_         = [Char] -> Builder
forall a. HasCallStack => [Char] -> a
error ([Char]
"Unable to encode indexed Array list as: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Schema -> [Char]
forall a. Show a => a -> [Char]
show Schema
s)

instance (U.Unbox a, ToAvro a) => ToAvro (U.Vector a) where
  toAvro :: Schema -> Vector a -> Builder
toAvro (S.Array Schema
s) Vector a
as =
    if Vector a -> Bool
forall a. Unbox a => Vector a -> Bool
U.null Vector a
as then Builder
long0 else Int -> Builder
forall a. EncodeRaw a => a -> Builder
encodeRaw (Vector a -> Int
forall a. Unbox a => Vector a -> Int
U.length Vector a
as) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (a -> Builder) -> [a] -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Schema -> a -> Builder
forall a. ToAvro a => Schema -> a -> Builder
toAvro Schema
s) (Vector a -> [a]
forall a. Unbox a => Vector a -> [a]
U.toList Vector a
as) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
long0
  toAvro Schema
s Vector a
_         = [Char] -> Builder
forall a. HasCallStack => [Char] -> a
error ([Char]
"Unable to encode Vector list as: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Schema -> [Char]
forall a. Show a => a -> [Char]
show Schema
s)

instance ToAvro a => ToAvro (Map.Map Text a) where
  toAvro :: Schema -> Map Text a -> Builder
toAvro (S.Map Schema
s) Map Text a
hm =
    if Map Text a -> Bool
forall k a. Map k a -> Bool
Map.null Map Text a
hm then Builder
long0 else Int -> Builder
putI (Map Text a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
F.length Map Text a
hm) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ((Text, a) -> Builder) -> [(Text, a)] -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Text, a) -> Builder
putKV (Map Text a -> [(Text, a)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Text a
hm) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
long0
    where putKV :: (Text, a) -> Builder
putKV (Text
k,a
v) = Schema -> Text -> Builder
forall a. ToAvro a => Schema -> a -> Builder
toAvro Schema
S.String' Text
k Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Schema -> a -> Builder
forall a. ToAvro a => Schema -> a -> Builder
toAvro Schema
s a
v
  toAvro Schema
s Map Text a
_         = [Char] -> Builder
forall a. HasCallStack => [Char] -> a
error ([Char]
"Unable to encode HashMap as: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Schema -> [Char]
forall a. Show a => a -> [Char]
show Schema
s)

instance ToAvro a => ToAvro (HashMap Text a) where
  toAvro :: Schema -> HashMap Text a -> Builder
toAvro (S.Map Schema
s) HashMap Text a
hm =
    if HashMap Text a -> Bool
forall k v. HashMap k v -> Bool
HashMap.null HashMap Text a
hm then Builder
long0 else Int -> Builder
putI (HashMap Text a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
F.length HashMap Text a
hm) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ((Text, a) -> Builder) -> [(Text, a)] -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Text, a) -> Builder
putKV (HashMap Text a -> [(Text, a)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList HashMap Text a
hm) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
long0
    where putKV :: (Text, a) -> Builder
putKV (Text
k,a
v) = Schema -> Text -> Builder
forall a. ToAvro a => Schema -> a -> Builder
toAvro Schema
S.String' Text
k Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Schema -> a -> Builder
forall a. ToAvro a => Schema -> a -> Builder
toAvro Schema
s a
v
  toAvro Schema
s HashMap Text a
_         = [Char] -> Builder
forall a. HasCallStack => [Char] -> a
error ([Char]
"Unable to encode HashMap as: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Schema -> [Char]
forall a. Show a => a -> [Char]
show Schema
s)

instance ToAvro a => ToAvro (Maybe a) where
  toAvro :: Schema -> Maybe a -> Builder
toAvro (S.Union Vector Schema
opts) Maybe a
v =
    case Vector Schema -> [Schema]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList Vector Schema
opts of
      [Schema
S.Null, Schema
s] -> Builder -> (a -> Builder) -> Maybe a -> Builder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Int -> Builder
putI Int
0) (\a
a -> Int -> Builder
putI Int
1 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Schema -> a -> Builder
forall a. ToAvro a => Schema -> a -> Builder
toAvro Schema
s a
a) Maybe a
v
      [Schema
s, Schema
S.Null] -> Builder -> (a -> Builder) -> Maybe a -> Builder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Int -> Builder
putI Int
1) (\a
a -> Int -> Builder
putI Int
0 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Schema -> a -> Builder
forall a. ToAvro a => Schema -> a -> Builder
toAvro Schema
s a
a) Maybe a
v
      [Schema]
wrongOpts   -> [Char] -> Builder
forall a. HasCallStack => [Char] -> a
error ([Char]
"Unable to encode Maybe as " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Schema] -> [Char]
forall a. Show a => a -> [Char]
show [Schema]
wrongOpts)
  toAvro Schema
s Maybe a
_ = [Char] -> Builder
forall a. HasCallStack => [Char] -> a
error ([Char]
"Unable to encode Maybe as " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Schema -> [Char]
forall a. Show a => a -> [Char]
show Schema
s)

instance (ToAvro a) => ToAvro (Identity a) where
  toAvro :: Schema -> Identity a -> Builder
toAvro (S.Union Vector Schema
opts) e :: Identity a
e@(Identity a
a) =
    if Vector Schema -> Int
forall a. Vector a -> Int
V.length Vector Schema
opts Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
      then Int -> Builder
putI Int
0 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Schema -> a -> Builder
forall a. ToAvro a => Schema -> a -> Builder
toAvro (Vector Schema -> Int -> Schema
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Schema
opts Int
0) a
a
      else [Char] -> Builder
forall a. HasCallStack => [Char] -> a
error ([Char]
"Unable to encode Identity as a single-value union: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Vector Schema -> [Char]
forall a. Show a => a -> [Char]
show Vector Schema
opts)
  toAvro Schema
s Identity a
_ = [Char] -> Builder
forall a. HasCallStack => [Char] -> a
error ([Char]
"Unable to encode Identity value as " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Schema -> [Char]
forall a. Show a => a -> [Char]
show Schema
s)

instance (ToAvro a, ToAvro b) => ToAvro (Either a b) where
  toAvro :: Schema -> Either a b -> Builder
toAvro (S.Union Vector Schema
opts) Either a b
v =
    if Vector Schema -> Int
forall a. Vector a -> Int
V.length Vector Schema
opts Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2
      then case Either a b
v of
        Left a
a  -> Int -> Builder
putI Int
0 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Schema -> a -> Builder
forall a. ToAvro a => Schema -> a -> Builder
toAvro (Vector Schema -> Int -> Schema
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Schema
opts Int
0) a
a
        Right b
b -> Int -> Builder
putI Int
1 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Schema -> b -> Builder
forall a. ToAvro a => Schema -> a -> Builder
toAvro (Vector Schema -> Int -> Schema
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Schema
opts Int
1) b
b
      else [Char] -> Builder
forall a. HasCallStack => [Char] -> a
error ([Char]
"Unable to encode Either as " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Vector Schema -> [Char]
forall a. Show a => a -> [Char]
show Vector Schema
opts)
  toAvro Schema
s Either a b
_ = [Char] -> Builder
forall a. HasCallStack => [Char] -> a
error ([Char]
"Unable to encode Either as " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Schema -> [Char]
forall a. Show a => a -> [Char]
show Schema
s)