{-# 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)
.= :: forall a. ToAvro a => Text -> a -> (Text, Encoder)
(.=) Text
fieldName a
fieldValue = (Text
fieldName, (Schema -> Builder) -> Encoder
Encoder (forall a b c. (a -> b -> c) -> b -> a -> c
flip 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 =
  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 = forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList [(Text, Encoder)]
vs

    providedNames :: [Text]
providedNames = forall a b. (a, b) -> a
fst 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 = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Field '" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show (Field -> Text
S.fldName Field
fld) forall a. Semigroup a => a -> a -> a
<> [Char]
"' is missing from the provided list of fields: " forall a. Semigroup a => a -> a -> a
<> 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 =
      forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Field -> Builder
failField Field
fld) (forall a b c. (a -> b -> c) -> b -> a -> c
flip Encoder -> Schema -> Builder
runEncoder (Field -> Schema
S.fldType Field
fld)) (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 = forall a. EncodeRaw a => a -> Builder
encodeRaw @Int64 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i)
  toAvro (S.Int Maybe LogicalTypeInt
_) Int
i  = forall a. EncodeRaw a => a -> Builder
encodeRaw @Int32 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i)
  toAvro Schema
s Int
_          = forall a. HasCallStack => [Char] -> a
error ([Char]
"Unable to encode Int as: " forall a. Semigroup a => a -> a -> a
<> 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 = forall a. EncodeRaw a => a -> Builder
encodeRaw @Int64 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
i)
  toAvro (S.Int Maybe LogicalTypeInt
_) Int32
i  = forall a. EncodeRaw a => a -> Builder
encodeRaw @Int32 Int32
i
  toAvro Schema
S.Double Int32
i   = forall a. ToAvro a => Schema -> a -> Builder
toAvro @Double Schema
S.Double (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
i)
  toAvro Schema
S.Float Int32
i    = forall a. ToAvro a => Schema -> a -> Builder
toAvro @Float Schema
S.Float (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
i)
  toAvro Schema
s Int32
_          = forall a. HasCallStack => [Char] -> a
error ([Char]
"Unable to encode Int32 as: " forall a. Semigroup a => a -> a -> a
<> 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 = forall a. EncodeRaw a => a -> Builder
encodeRaw @Int64 Int64
i
  toAvro Schema
S.Double Int64
i   = forall a. ToAvro a => Schema -> a -> Builder
toAvro @Double Schema
S.Double (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
i)
  toAvro Schema
S.Float Int64
i    = forall a. ToAvro a => Schema -> a -> Builder
toAvro @Float Schema
S.Float (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
i)
  toAvro Schema
s Int64
_          = forall a. HasCallStack => [Char] -> a
error ([Char]
"Unable to encode Int64 as: " forall a. Semigroup a => a -> a -> a
<> 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  = forall a. EncodeRaw a => a -> Builder
encodeRaw @Word8 Word8
i
  toAvro (S.Long Maybe LogicalTypeLong
_) Word8
i = forall a. EncodeRaw a => a -> Builder
encodeRaw @Word64 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
i)
  toAvro Schema
S.Double Word8
i   = forall a. ToAvro a => Schema -> a -> Builder
toAvro @Double Schema
S.Double (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
i)
  toAvro Schema
S.Float Word8
i    = forall a. ToAvro a => Schema -> a -> Builder
toAvro @Float Schema
S.Float (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
i)
  toAvro Schema
s Word8
_          = forall a. HasCallStack => [Char] -> a
error ([Char]
"Unable to encode Word8 as: " forall a. Semigroup a => a -> a -> a
<> 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  = forall a. EncodeRaw a => a -> Builder
encodeRaw @Word16 Word16
i
  toAvro (S.Long Maybe LogicalTypeLong
_) Word16
i = forall a. EncodeRaw a => a -> Builder
encodeRaw @Word64 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
i)
  toAvro Schema
S.Double Word16
i   = forall a. ToAvro a => Schema -> a -> Builder
toAvro @Double Schema
S.Double (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
i)
  toAvro Schema
S.Float Word16
i    = forall a. ToAvro a => Schema -> a -> Builder
toAvro @Float Schema
S.Float (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
i)
  toAvro Schema
s Word16
_          = forall a. HasCallStack => [Char] -> a
error ([Char]
"Unable to encode Word16 as: " forall a. Semigroup a => a -> a -> a
<> 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  = forall a. EncodeRaw a => a -> Builder
encodeRaw @Word32 Word32
i
  toAvro (S.Long Maybe LogicalTypeLong
_) Word32
i = forall a. EncodeRaw a => a -> Builder
encodeRaw @Word64 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
i)
  toAvro Schema
S.Double Word32
i   = forall a. ToAvro a => Schema -> a -> Builder
toAvro @Double Schema
S.Double (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
i)
  toAvro Schema
S.Float Word32
i    = forall a. ToAvro a => Schema -> a -> Builder
toAvro @Float Schema
S.Float (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
i)
  toAvro Schema
s Word32
_          = forall a. HasCallStack => [Char] -> a
error ([Char]
"Unable to encode Word32 as: " forall a. Semigroup a => a -> a -> a
<> 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 = forall a. EncodeRaw a => a -> Builder
encodeRaw @Word64 Word64
i
  toAvro Schema
S.Double Word64
i   = forall a. ToAvro a => Schema -> a -> Builder
toAvro @Double Schema
S.Double (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
i)
  toAvro Schema
s Word64
_          = forall a. HasCallStack => [Char] -> a
error ([Char]
"Unable to encode Word64 as: " forall a. Semigroup a => a -> a -> a
<> 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
_        = forall a. HasCallStack => [Char] -> a
error ([Char]
"Unable to encode Double as: " forall a. Semigroup a => a -> a -> a
<> 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 forall a b. (a -> b) -> a -> b
$ forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
i)
  toAvro Schema
s Float
_        = forall a. HasCallStack => [Char] -> a
error ([Char]
"Unable to encode Float as: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show Schema
s)
  {-# INLINE toAvro #-}

instance ToAvro () where
  toAvro :: Schema -> () -> Builder
toAvro Schema
S.Null () = forall a. Monoid a => a
mempty
  toAvro Schema
s ()      = forall a. HasCallStack => [Char] -> a
error ([Char]
"Unable to encode () as: " forall a. Semigroup a => a -> a -> a
<> 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 forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Enum a => a -> Int
fromEnum Bool
v)
  toAvro Schema
s Bool
_         = forall a. HasCallStack => [Char] -> a
error ([Char]
"Unable to encode Bool as: " forall a. Semigroup a => a -> a -> a
<> 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 = forall a. ToAvro a => Schema -> a -> Builder
toAvro @Int64 Schema
s forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasCallStack => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a. ToAvro a => Schema -> a -> Builder
toAvro Schema
s 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 = forall a. ToAvro a => Schema -> a -> Builder
toAvro @Int32 Schema
s forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral 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))      = forall a. ToAvro a => Schema -> a -> Builder
toAvro @Int64 Schema
s forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiffTime -> Integer
diffTimeToMicros
  toAvro s :: Schema
s@(S.Long (Just LogicalTypeLong
S.TimestampMicros)) = forall a. ToAvro a => Schema -> a -> Builder
toAvro @Int64 Schema
s forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiffTime -> Integer
diffTimeToMicros
  toAvro s :: Schema
s@(S.Long (Just LogicalTypeLong
S.TimestampMillis)) = forall a. ToAvro a => Schema -> a -> Builder
toAvro @Int64 Schema
s forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiffTime -> Integer
diffTimeToMillis
  toAvro s :: Schema
s@(S.Int  (Just LogicalTypeInt
S.TimeMillis))      = forall a. ToAvro a => Schema -> a -> Builder
toAvro @Int32 Schema
s forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiffTime -> Integer
diffTimeToMillis
  toAvro Schema
s                                   = forall a. HasCallStack => [Char] -> a
error ([Char]
"Unble to encode DiffTime as " forall a. Semigroup a => a -> a -> a
<> 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)) = forall a. ToAvro a => Schema -> a -> Builder
toAvro @Int64 Schema
s forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> Integer
utcTimeToMicros
  toAvro s :: Schema
s@(S.Long (Just LogicalTypeLong
S.TimestampMillis)) = forall a. ToAvro a => Schema -> a -> Builder
toAvro @Int64 Schema
s forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> Integer
utcTimeToMillis
  toAvro Schema
s                                   = forall a. HasCallStack => [Char] -> a
error ([Char]
"Unable to encode UTCTime as " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show Schema
s)

instance ToAvro Time.LocalTime where
  toAvro :: Schema -> LocalTime -> Builder
toAvro s :: Schema
s@(S.Long (Just LogicalTypeLong
S.LocalTimestampMicros)) =
    forall a. ToAvro a => Schema -> a -> Builder
toAvro @Int64 Schema
s forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalTime -> Integer
localTimeToMicros
  toAvro s :: Schema
s@(S.Long (Just LogicalTypeLong
S.LocalTimestampMillis)) =
    forall a. ToAvro a => Schema -> a -> Builder
toAvro @Int64 Schema
s forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalTime -> Integer
localTimeToMillis
  toAvro Schema
s =
    forall a. HasCallStack => [Char] -> a
error ([Char]
"Unable to encode LocalTime as " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show Schema
s)

instance ToAvro B.ByteString where
  toAvro :: Schema -> ByteString -> Builder
toAvro Schema
s ByteString
bs = case Schema
s of
    (S.Bytes Maybe LogicalTypeBytes
_)                        -> forall a. EncodeRaw a => a -> Builder
encodeRaw (ByteString -> Int
B.length ByteString
bs) forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
byteString ByteString
bs
    (S.String Maybe LogicalTypeString
_)                       -> forall a. EncodeRaw a => a -> Builder
encodeRaw (ByteString -> Int
B.length ByteString
bs) forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
byteString ByteString
bs
    S.Fixed TypeName
_ [TypeName]
_ Int
l Maybe LogicalTypeFixed
_ | Int
l 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
_                    -> forall a. HasCallStack => [Char] -> a
error ([Char]
"Unable to encode ByteString as Fixed(" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show Int
l forall a. Semigroup a => a -> a -> a
<> [Char]
") because its length is " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show (ByteString -> Int
B.length ByteString
bs))
    Schema
_                                  -> forall a. HasCallStack => [Char] -> a
error ([Char]
"Unable to encode ByteString as: " forall a. Semigroup a => a -> a -> a
<> 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 = 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 = forall a. EncodeRaw a => a -> Builder
encodeRaw (ByteString -> Int
B.length ByteString
bs) 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
_            -> forall a. HasCallStack => [Char] -> a
error ([Char]
"Unable to encode Text as: " forall a. Semigroup a => a -> a -> a
<> 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 = 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 forall (t :: * -> *) a. Foldable t => t a -> Bool
DL.null [a]
as then Builder
long0 else forall a. EncodeRaw a => a -> Builder
encodeRaw (forall (t :: * -> *) a. Foldable t => t a -> Int
F.length [a]
as) forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall a. ToAvro a => Schema -> a -> Builder
toAvro Schema
s) [a]
as forall a. Semigroup a => a -> a -> a
<> Builder
long0
  toAvro Schema
s [a]
_         = forall a. HasCallStack => [Char] -> a
error ([Char]
"Unable to encode Haskell list as: " forall a. Semigroup a => a -> a -> a
<> 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 forall a. Vector a -> Bool
V.null Vector a
as then Builder
long0 else forall a. EncodeRaw a => a -> Builder
encodeRaw (forall a. Vector a -> Int
V.length Vector a
as) forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall a. ToAvro a => Schema -> a -> Builder
toAvro Schema
s) Vector a
as forall a. Semigroup a => a -> a -> a
<> Builder
long0
  toAvro Schema
s Vector a
_         = forall a. HasCallStack => [Char] -> a
error ([Char]
"Unable to encode Vector list as: " forall a. Semigroup a => a -> a -> a
<> 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 forall (t :: * -> *) a. Foldable t => t a -> Int
F.length Array i a
as forall a. Eq a => a -> a -> Bool
== Int
0 then Builder
long0 else forall a. EncodeRaw a => a -> Builder
encodeRaw (forall (t :: * -> *) a. Foldable t => t a -> Int
F.length Array i a
as) forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall a. ToAvro a => Schema -> a -> Builder
toAvro Schema
s) Array i a
as forall a. Semigroup a => a -> a -> a
<> Builder
long0
  toAvro Schema
s Array i a
_         = forall a. HasCallStack => [Char] -> a
error ([Char]
"Unable to encode indexed Array list as: " forall a. Semigroup a => a -> a -> a
<> 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 forall a. Unbox a => Vector a -> Bool
U.null Vector a
as then Builder
long0 else forall a. EncodeRaw a => a -> Builder
encodeRaw (forall a. Unbox a => Vector a -> Int
U.length Vector a
as) forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall a. ToAvro a => Schema -> a -> Builder
toAvro Schema
s) (forall a. Unbox a => Vector a -> [a]
U.toList Vector a
as) forall a. Semigroup a => a -> a -> a
<> Builder
long0
  toAvro Schema
s Vector a
_         = forall a. HasCallStack => [Char] -> a
error ([Char]
"Unable to encode Vector list as: " forall a. Semigroup a => a -> a -> a
<> 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 forall k a. Map k a -> Bool
Map.null Map Text a
hm then Builder
long0 else Int -> Builder
putI (forall (t :: * -> *) a. Foldable t => t a -> Int
F.length Map Text a
hm) forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Text, a) -> Builder
putKV (forall k a. Map k a -> [(k, a)]
Map.toList Map Text a
hm) forall a. Semigroup a => a -> a -> a
<> Builder
long0
    where putKV :: (Text, a) -> Builder
putKV (Text
k,a
v) = forall a. ToAvro a => Schema -> a -> Builder
toAvro Schema
S.String' Text
k forall a. Semigroup a => a -> a -> a
<> forall a. ToAvro a => Schema -> a -> Builder
toAvro Schema
s a
v
  toAvro Schema
s Map Text a
_         = forall a. HasCallStack => [Char] -> a
error ([Char]
"Unable to encode HashMap as: " forall a. Semigroup a => a -> a -> a
<> 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 forall k v. HashMap k v -> Bool
HashMap.null HashMap Text a
hm then Builder
long0 else Int -> Builder
putI (forall (t :: * -> *) a. Foldable t => t a -> Int
F.length HashMap Text a
hm) forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Text, a) -> Builder
putKV (forall k v. HashMap k v -> [(k, v)]
HashMap.toList HashMap Text a
hm) forall a. Semigroup a => a -> a -> a
<> Builder
long0
    where putKV :: (Text, a) -> Builder
putKV (Text
k,a
v) = forall a. ToAvro a => Schema -> a -> Builder
toAvro Schema
S.String' Text
k forall a. Semigroup a => a -> a -> a
<> forall a. ToAvro a => Schema -> a -> Builder
toAvro Schema
s a
v
  toAvro Schema
s HashMap Text a
_         = forall a. HasCallStack => [Char] -> a
error ([Char]
"Unable to encode HashMap as: " forall a. Semigroup a => a -> a -> a
<> 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 forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList Vector Schema
opts of
      [Schema
S.Null, Schema
s] -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Int -> Builder
putI Int
0) (\a
a -> Int -> Builder
putI Int
1 forall a. Semigroup a => a -> a -> a
<> forall a. ToAvro a => Schema -> a -> Builder
toAvro Schema
s a
a) Maybe a
v
      [Schema
s, Schema
S.Null] -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Int -> Builder
putI Int
1) (\a
a -> Int -> Builder
putI Int
0 forall a. Semigroup a => a -> a -> a
<> forall a. ToAvro a => Schema -> a -> Builder
toAvro Schema
s a
a) Maybe a
v
      [Schema]
wrongOpts   -> forall a. HasCallStack => [Char] -> a
error ([Char]
"Unable to encode Maybe as " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show [Schema]
wrongOpts)
  toAvro Schema
s Maybe a
_ = forall a. HasCallStack => [Char] -> a
error ([Char]
"Unable to encode Maybe as " forall a. Semigroup a => a -> a -> a
<> 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 forall a. Vector a -> Int
V.length Vector Schema
opts forall a. Eq a => a -> a -> Bool
== Int
1
      then Int -> Builder
putI Int
0 forall a. Semigroup a => a -> a -> a
<> forall a. ToAvro a => Schema -> a -> Builder
toAvro (forall a. Vector a -> Int -> a
V.unsafeIndex Vector Schema
opts Int
0) a
a
      else forall a. HasCallStack => [Char] -> a
error ([Char]
"Unable to encode Identity as a single-value union: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show Vector Schema
opts)
  toAvro Schema
s Identity a
_ = forall a. HasCallStack => [Char] -> a
error ([Char]
"Unable to encode Identity value as " forall a. Semigroup a => a -> a -> a
<> 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 forall a. Vector a -> Int
V.length Vector Schema
opts forall a. Eq a => a -> a -> Bool
== Int
2
      then case Either a b
v of
        Left a
a  -> Int -> Builder
putI Int
0 forall a. Semigroup a => a -> a -> a
<> forall a. ToAvro a => Schema -> a -> Builder
toAvro (forall a. Vector a -> Int -> a
V.unsafeIndex Vector Schema
opts Int
0) a
a
        Right b
b -> Int -> Builder
putI Int
1 forall a. Semigroup a => a -> a -> a
<> forall a. ToAvro a => Schema -> a -> Builder
toAvro (forall a. Vector a -> Int -> a
V.unsafeIndex Vector Schema
opts Int
1) b
b
      else forall a. HasCallStack => [Char] -> a
error ([Char]
"Unable to encode Either as " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show Vector Schema
opts)
  toAvro Schema
s Either a b
_ = forall a. HasCallStack => [Char] -> a
error ([Char]
"Unable to encode Either as " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show Schema
s)