{-# LANGUAGE DeriveAnyClass    #-}
{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE StrictData        #-}
module Data.Avro.Encoding.FromAvro
( FromAvro(..)
  -- ** For internal use
, Value(..)
, getValue
)
where

import           Control.DeepSeq             (NFData)
import           Control.Monad               (forM, replicateM)
import           Control.Monad.Identity      (Identity (..))
import           Control.Monad.ST            (ST)
import qualified Data.Aeson                  as A
import qualified Data.Avro.Internal.Get      as Get
import           Data.Avro.Internal.Time
import           Data.Avro.Schema.Decimal    as D
import           Data.Avro.Schema.ReadSchema (ReadSchema)
import qualified Data.Avro.Schema.ReadSchema as ReadSchema
import qualified Data.Avro.Schema.Schema     as Schema
import           Data.Binary.Get             (Get, getByteString, runGetOrFail)
import qualified Data.ByteString             as B
import qualified Data.ByteString             as BS
import qualified Data.ByteString.Lazy        as BL
import qualified Data.Char                   as Char
import           Data.Foldable               (traverse_)
import           Data.HashMap.Strict         (HashMap)
import qualified Data.HashMap.Strict         as HashMap
import           Data.Int
import           Data.List.NonEmpty          (NonEmpty)
import qualified Data.Map                    as Map
import           Data.Text                   (Text)
import qualified Data.Text                   as T
import qualified Data.Text                   as Text
import qualified Data.Text.Encoding          as Text
import qualified Data.Time                   as Time
import qualified Data.UUID                   as UUID
import           Data.Vector                 (Vector)
import qualified Data.Vector                 as V
import qualified Data.Vector.Mutable         as MV
import qualified Data.Vector.Unboxed         as UV
import           GHC.Generics                (Generic)
import           GHC.TypeLits

-- | An intermediate data structute for decoding between Avro bytes and Haskell types.
--
-- Because reader and writer schemas, and therefore expected data types and layout
-- can be different, deserialising bytes into Haskell types directly is not possible.
--
-- To overcome this issue this intermediate data structure is used: bytes are decoded into
-- values of type 'Value' (using reader's layout and rules) and then translated to target
-- Haskell types using 'FromAvro' type class machinery.
data Value
      = Null
      | Boolean Bool
      | Int     ReadSchema {-# UNPACK #-} Int32
      | Long    ReadSchema {-# UNPACK #-} Int64
      | Float   ReadSchema {-# UNPACK #-} Float
      | Double  ReadSchema {-# UNPACK #-} Double
      | Bytes   ReadSchema {-# UNPACK #-} BS.ByteString
      | String  ReadSchema {-# UNPACK #-} Text
      | Array   (Vector Value)
      | Map     (HashMap Text Value)
      | Record  ReadSchema (Vector Value)
      | Union   ReadSchema {-# UNPACK #-} Int Value
      | Fixed   ReadSchema {-# UNPACK #-} BS.ByteString
      | Enum    ReadSchema {-# UNPACK #-} Int {-# UNPACK #-} Text
  deriving (Value -> Value -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Value -> Value -> Bool
$c/= :: Value -> Value -> Bool
== :: Value -> Value -> Bool
$c== :: Value -> Value -> Bool
Eq, Int -> Value -> ShowS
[Value] -> ShowS
Value -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Value] -> ShowS
$cshowList :: [Value] -> ShowS
show :: Value -> String
$cshow :: Value -> String
showsPrec :: Int -> Value -> ShowS
$cshowsPrec :: Int -> Value -> ShowS
Show, forall x. Rep Value x -> Value
forall x. Value -> Rep Value x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Value x -> Value
$cfrom :: forall x. Value -> Rep Value x
Generic, Value -> ()
forall a. (a -> ()) -> NFData a
rnf :: Value -> ()
$crnf :: Value -> ()
NFData)

-- | Descrive the value in a way that is safe to use in error messages
-- (i.e. do not print values)
describeValue :: Value -> String
describeValue :: Value -> String
describeValue = \case
  Value
Null         -> String
"Null"
  Boolean Bool
b    -> String
"Boolean"
  Int ReadSchema
s Int32
_      -> String
"Int (" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show ReadSchema
s forall a. Semigroup a => a -> a -> a
<> String
")"
  Long ReadSchema
s Int64
_     -> String
"Long (" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show ReadSchema
s forall a. Semigroup a => a -> a -> a
<> String
")"
  Float ReadSchema
s Float
_    -> String
"Float (" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show ReadSchema
s forall a. Semigroup a => a -> a -> a
<> String
")"
  Double ReadSchema
s Double
_   -> String
"Double (" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show ReadSchema
s forall a. Semigroup a => a -> a -> a
<> String
")"
  Bytes ReadSchema
s ByteString
_    -> String
"Bytes (" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show ReadSchema
s forall a. Semigroup a => a -> a -> a
<> String
")"
  String ReadSchema
s Text
_   -> String
"String (" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show ReadSchema
s forall a. Semigroup a => a -> a -> a
<> String
")"
  Union ReadSchema
s Int
ix Value
_ -> String
"Union (position = " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
ix forall a. Semigroup a => a -> a -> a
<> String
", schema = " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show ReadSchema
s forall a. Semigroup a => a -> a -> a
<> String
")"
  Fixed ReadSchema
s ByteString
_    -> String
"Fixed (" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show ReadSchema
s forall a. Semigroup a => a -> a -> a
<> String
")"
  Enum ReadSchema
s Int
ix Text
_  -> String
"Enum (position = " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
ix forall a. Semigroup a => a -> a -> a
<> String
", schema =" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show ReadSchema
s forall a. Semigroup a => a -> a -> a
<> String
")"
  Array Vector Value
vs     -> String
"Array (length = " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (forall a. Vector a -> Int
V.length Vector Value
vs) forall a. Semigroup a => a -> a -> a
<> String
")"
  Map HashMap Text Value
vs       -> String
"Map (length = " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (forall k v. HashMap k v -> Int
HashMap.size HashMap Text Value
vs) forall a. Semigroup a => a -> a -> a
<> String
")"
  Record ReadSchema
s Vector Value
vs  -> String
"Record (name = " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (ReadSchema -> TypeName
ReadSchema.name ReadSchema
s) forall a. Semigroup a => a -> a -> a
<> String
" fieldsNum = " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (forall a. Vector a -> Int
V.length Vector Value
vs) forall a. Semigroup a => a -> a -> a
<> String
")"

--------------------------------------------------------------------------

-- fromRecord :: Schema -> Either String a

-- | Descrives how to convert a given intermediate 'Value' into a Haskell data type.
class FromAvro a where
  fromAvro :: Value -> Either String a

instance FromAvro Int where
  fromAvro :: Value -> Either String Int
fromAvro (Int ReadSchema
_ Int32
x)  = forall a b. b -> Either a b
Right (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
x)
  fromAvro (Long ReadSchema
_ Int64
x) = forall a b. b -> Either a b
Right (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
x)
  fromAvro Value
x          = forall a b. a -> Either a b
Left (String
"Unable to decode Int from: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (Value -> String
describeValue Value
x))
  {-# INLINE fromAvro #-}

instance FromAvro Int32 where
  fromAvro :: Value -> Either String Int32
fromAvro (Int ReadSchema
_ Int32
x) = forall a b. b -> Either a b
Right Int32
x
  fromAvro Value
x         = forall a b. a -> Either a b
Left (String
"Unable to decode Int32 from: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (Value -> String
describeValue Value
x))
  {-# INLINE fromAvro #-}

instance FromAvro Int64 where
  fromAvro :: Value -> Either String Int64
fromAvro (Long ReadSchema
_ Int64
x) = forall a b. b -> Either a b
Right Int64
x
  fromAvro (Int ReadSchema
_ Int32
x)  = forall a b. b -> Either a b
Right (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
x)
  fromAvro Value
x          = forall a b. a -> Either a b
Left (String
"Unable to decode Int64 from: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (Value -> String
describeValue Value
x))
  {-# INLINE fromAvro #-}

instance FromAvro Double where
  fromAvro :: Value -> Either String Double
fromAvro (Double ReadSchema
_ Double
x) = forall a b. b -> Either a b
Right Double
x
  fromAvro (Float ReadSchema
_ Float
x)  = forall a b. b -> Either a b
Right (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
x)
  fromAvro (Long ReadSchema
_ Int64
x)   = forall a b. b -> Either a b
Right (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
x)
  fromAvro (Int ReadSchema
_ Int32
x)    = forall a b. b -> Either a b
Right (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
x)
  fromAvro Value
x            = forall a b. a -> Either a b
Left (String
"Unable to decode Double from: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (Value -> String
describeValue Value
x))
  {-# INLINE fromAvro #-}

instance FromAvro Float where
  fromAvro :: Value -> Either String Float
fromAvro (Float ReadSchema
_ Float
x) = forall a b. b -> Either a b
Right Float
x
  fromAvro (Long ReadSchema
_ Int64
x)  = forall a b. b -> Either a b
Right (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
x)
  fromAvro (Int ReadSchema
_ Int32
x)   = forall a b. b -> Either a b
Right (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
x)
  fromAvro Value
x           = forall a b. a -> Either a b
Left (String
"Unable to decode Double from: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (Value -> String
describeValue Value
x))
  {-# INLINE fromAvro #-}

instance FromAvro () where
  fromAvro :: Value -> Either String ()
fromAvro Value
Null = forall a b. b -> Either a b
Right ()
  fromAvro Value
x    = forall a b. a -> Either a b
Left (String
"Unable to decode () from: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (Value -> String
describeValue Value
x))
  {-# INLINE fromAvro #-}

instance FromAvro Bool where
  fromAvro :: Value -> Either String Bool
fromAvro (Boolean Bool
x) = forall a b. b -> Either a b
Right Bool
x
  fromAvro Value
x           = forall a b. a -> Either a b
Left (String
"Unable to decode Bool from: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (Value -> String
describeValue Value
x))
  {-# INLINE fromAvro #-}

instance FromAvro Text where
  fromAvro :: Value -> Either String Text
fromAvro (String ReadSchema
_ Text
x) = forall a b. b -> Either a b
Right Text
x
  fromAvro (Bytes ReadSchema
_ ByteString
x) = case ByteString -> Either UnicodeException Text
Text.decodeUtf8' ByteString
x of
    Left UnicodeException
unicodeExc -> forall a b. a -> Either a b
Left (forall a. Show a => a -> String
show UnicodeException
unicodeExc)
    Right Text
text      -> forall a b. b -> Either a b
Right Text
text
  fromAvro Value
x          = forall a b. a -> Either a b
Left (String
"Unable to decode Text from: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (Value -> String
describeValue Value
x))
  {-# INLINE fromAvro #-}

instance FromAvro BS.ByteString where
  fromAvro :: Value -> Either String ByteString
fromAvro (Bytes ReadSchema
_ ByteString
x)  = forall a b. b -> Either a b
Right ByteString
x
  fromAvro (String ReadSchema
_ Text
x) = forall a b. b -> Either a b
Right (Text -> ByteString
Text.encodeUtf8 Text
x)
  fromAvro Value
x            = forall a b. a -> Either a b
Left (String
"Unable to decode Bytes from: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (Value -> String
describeValue Value
x))
  {-# INLINE fromAvro #-}

instance FromAvro BL.ByteString where
  fromAvro :: Value -> Either String ByteString
fromAvro (Bytes ReadSchema
_ ByteString
bs) = forall a b. b -> Either a b
Right (ByteString -> ByteString
BL.fromStrict ByteString
bs)
  fromAvro (String ReadSchema
_ Text
x) = forall a b. b -> Either a b
Right (ByteString -> ByteString
BL.fromStrict forall a b. (a -> b) -> a -> b
$ Text -> ByteString
Text.encodeUtf8 Text
x)
  fromAvro Value
x            = forall a b. a -> Either a b
Left (String
"Unable to decode Bytes from: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (Value -> String
describeValue Value
x))
  {-# INLINE fromAvro #-}

instance (KnownNat p, KnownNat s) => FromAvro (D.Decimal p s) where
  fromAvro :: Value -> Either String (Decimal p s)
fromAvro (Long ReadSchema
_ Int64
n) = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall (p :: Nat) (s :: Nat). KnownNat s => Integer -> Decimal p s
D.fromUnderlyingValue forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
n
  fromAvro (Int ReadSchema
_ Int32
n)  = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall (p :: Nat) (s :: Nat). KnownNat s => Integer -> Decimal p s
D.fromUnderlyingValue forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
n
  fromAvro Value
x          = forall a b. a -> Either a b
Left (String
"Unable to decode Decimal from: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (Value -> String
describeValue Value
x))
  {-# INLINE fromAvro #-}

instance FromAvro UUID.UUID where
  fromAvro :: Value -> Either String UUID
fromAvro (String ReadSchema
_ Text
x) =
    case Text -> Maybe UUID
UUID.fromText Text
x of
      Maybe UUID
Nothing -> forall a b. a -> Either a b
Left String
"Unable to UUID from a given String value"
      Just UUID
u  -> forall a b. b -> Either a b
Right UUID
u
  fromAvro Value
x            = forall a b. a -> Either a b
Left (String
"Unable to decode UUID from: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (Value -> String
describeValue Value
x))
  {-# INLINE fromAvro #-}

instance FromAvro Time.Day where
  fromAvro :: Value -> Either String Day
fromAvro (Int (ReadSchema.Int (Just LogicalTypeInt
ReadSchema.Date)) Int32
n) = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Integer -> Day
fromDaysSinceEpoch (forall a. Integral a => a -> Integer
toInteger Int32
n)
  fromAvro Value
x                                               = forall a b. a -> Either a b
Left (String
"Unable to decode Day from: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (Value -> String
describeValue Value
x))
  {-# INLINE fromAvro #-}

instance FromAvro Time.DiffTime where
  fromAvro :: Value -> Either String DiffTime
fromAvro (Int (ReadSchema.Int (Just LogicalTypeInt
ReadSchema.TimeMillis)) Int32
n)          = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Integer -> DiffTime
millisToDiffTime (forall a. Integral a => a -> Integer
toInteger Int32
n)
  fromAvro (Long (ReadSchema.Long ReadLong
_ (Just LogicalTypeLong
ReadSchema.TimestampMillis)) Int64
n) = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Integer -> DiffTime
millisToDiffTime (forall a. Integral a => a -> Integer
toInteger Int64
n)
  fromAvro (Long (ReadSchema.Long ReadLong
_ (Just LogicalTypeLong
ReadSchema.TimeMicros)) Int64
n)      = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Integer -> DiffTime
microsToDiffTime (forall a. Integral a => a -> Integer
toInteger Int64
n)
  fromAvro (Long (ReadSchema.Long ReadLong
_ (Just LogicalTypeLong
ReadSchema.TimestampMicros)) Int64
n) = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Integer -> DiffTime
microsToDiffTime (forall a. Integral a => a -> Integer
toInteger Int64
n)
  fromAvro Value
x                                                              = forall a b. a -> Either a b
Left (String
"Unable to decode TimeDiff from: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (Value -> String
describeValue Value
x))
  {-# INLINE fromAvro #-}

instance FromAvro Time.UTCTime where
  fromAvro :: Value -> Either String UTCTime
fromAvro (Long (ReadSchema.Long ReadLong
_ (Just LogicalTypeLong
ReadSchema.TimestampMicros)) Int64
n) = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Integer -> UTCTime
microsToUTCTime (forall a. Integral a => a -> Integer
toInteger Int64
n)
  fromAvro (Long (ReadSchema.Long ReadLong
_ (Just LogicalTypeLong
ReadSchema.TimestampMillis)) Int64
n) = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Integer -> UTCTime
millisToUTCTime (forall a. Integral a => a -> Integer
toInteger Int64
n)
  fromAvro Value
x                                                              = forall a b. a -> Either a b
Left (String
"Unable to decode UTCTime from: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (Value -> String
describeValue Value
x))
  {-# INLINE fromAvro #-}

instance FromAvro Time.LocalTime where
  fromAvro :: Value -> Either String LocalTime
fromAvro (Long (ReadSchema.Long ReadLong
_ (Just LogicalTypeLong
ReadSchema.LocalTimestampMicros)) Int64
n) =
    forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Integer -> LocalTime
microsToLocalTime (forall a. Integral a => a -> Integer
toInteger Int64
n)
  fromAvro (Long (ReadSchema.Long ReadLong
_ (Just LogicalTypeLong
ReadSchema.LocalTimestampMillis)) Int64
n) =
    forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Integer -> LocalTime
millisToLocalTime (forall a. Integral a => a -> Integer
toInteger Int64
n)
  fromAvro Value
x = forall a b. a -> Either a b
Left (String
"Unable to decode LocalTime from: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (Value -> String
describeValue Value
x))
  {-# INLINE fromAvro #-}
  

instance FromAvro a => FromAvro [a] where
  fromAvro :: Value -> Either String [a]
fromAvro (Array Vector Value
vec) = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a. FromAvro a => Value -> Either String a
fromAvro forall a b. (a -> b) -> a -> b
$ forall a. Vector a -> [a]
V.toList Vector Value
vec
  fromAvro Value
x           = forall a b. a -> Either a b
Left (String
"Unable to decode Array from: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (Value -> String
describeValue Value
x))
  {-# INLINE fromAvro #-}

instance FromAvro a => FromAvro (Vector a) where
  fromAvro :: Value -> Either String (Vector a)
fromAvro (Array Vector Value
vec) = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a. FromAvro a => Value -> Either String a
fromAvro Vector Value
vec
  fromAvro Value
x           = forall a b. a -> Either a b
Left (String
"Unable to decode Array from: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (Value -> String
describeValue Value
x))
  {-# INLINE fromAvro #-}

instance (UV.Unbox a, FromAvro a) => FromAvro (UV.Vector a) where
  fromAvro :: Value -> Either String (Vector a)
fromAvro (Array Vector Value
vec) = forall (v :: * -> *) a (w :: * -> *).
(Vector v a, Vector w a) =>
v a -> w a
UV.convert forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a. FromAvro a => Value -> Either String a
fromAvro Vector Value
vec
  fromAvro Value
x           = forall a b. a -> Either a b
Left (String
"Unable to decode Array from: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (Value -> String
describeValue Value
x))
  {-# INLINE fromAvro #-}

instance FromAvro a => FromAvro (Identity a) where
  fromAvro :: Value -> Either String (Identity a)
fromAvro (Union ReadSchema
_ Int
0 Value
v) = forall a. a -> Identity a
Identity forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromAvro a => Value -> Either String a
fromAvro Value
v
  fromAvro (Union ReadSchema
_ Int
n Value
_) = forall a b. a -> Either a b
Left (String
"Unable to decode Identity value from value with a position #" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
n)
  fromAvro Value
x             = forall a b. a -> Either a b
Left (String
"Unable to decode Identity from: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (Value -> String
describeValue Value
x))
  {-# INLINE fromAvro #-}

instance FromAvro a => FromAvro (Maybe a) where
  fromAvro :: Value -> Either String (Maybe a)
fromAvro (Union ReadSchema
_ Int
_ Value
Null) = forall a b. b -> Either a b
Right forall a. Maybe a
Nothing
  fromAvro (Union ReadSchema
_ Int
_ Value
v)    = forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromAvro a => Value -> Either String a
fromAvro Value
v
  fromAvro Value
x                = forall a b. a -> Either a b
Left (String
"Unable to decode Maybe from: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (Value -> String
describeValue Value
x))
  {-# INLINE fromAvro #-}

instance (FromAvro a, FromAvro b) => FromAvro (Either a b) where
  fromAvro :: Value -> Either String (Either a b)
fromAvro (Union ReadSchema
_ Int
0 Value
a) = forall a b. a -> Either a b
Left forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromAvro a => Value -> Either String a
fromAvro Value
a
  fromAvro (Union ReadSchema
_ Int
1 Value
b) = forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromAvro a => Value -> Either String a
fromAvro Value
b
  fromAvro (Union ReadSchema
_ Int
n Value
_) = forall a b. a -> Either a b
Left (String
"Unable to decode Either value with a position #" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
n)
  fromAvro Value
x             = forall a b. a -> Either a b
Left (String
"Unable to decode Either from: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (Value -> String
describeValue Value
x))
  {-# INLINE fromAvro #-}

instance FromAvro a => FromAvro (Map.Map Text a) where
  fromAvro :: Value -> Either String (Map Text a)
fromAvro (Map HashMap Text Value
mp) = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall a. FromAvro a => Value -> Either String a
fromAvro (forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (forall k v. HashMap k v -> [(k, v)]
HashMap.toList HashMap Text Value
mp))
  fromAvro Value
x        = forall a b. a -> Either a b
Left (String
"Unable to decode Map from: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (Value -> String
describeValue Value
x))
  {-# INLINE fromAvro #-}

instance FromAvro a => FromAvro (HashMap.HashMap Text a) where
  fromAvro :: Value -> Either String (HashMap Text a)
fromAvro (Map HashMap Text Value
mp) = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall a. FromAvro a => Value -> Either String a
fromAvro HashMap Text Value
mp
  fromAvro Value
x        = forall a b. a -> Either a b
Left (String
"Unable to decode Map from: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (Value -> String
describeValue Value
x))
  {-# INLINE fromAvro #-}


getValue :: ReadSchema -> Get Value
getValue :: ReadSchema -> Get Value
getValue ReadSchema
sch =
  let env :: HashMap TypeName ReadSchema
env = ReadSchema -> HashMap TypeName ReadSchema
ReadSchema.extractBindings ReadSchema
sch
  in HashMap TypeName ReadSchema -> ReadSchema -> Get Value
getField HashMap TypeName ReadSchema
env ReadSchema
sch

getField :: HashMap Schema.TypeName ReadSchema -> ReadSchema -> Get Value
getField :: HashMap TypeName ReadSchema -> ReadSchema -> Get Value
getField HashMap TypeName ReadSchema
env ReadSchema
sch = case ReadSchema
sch of
  ReadSchema
ReadSchema.Null     -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
Null
  ReadSchema
ReadSchema.Boolean  -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Value
Boolean                Get Bool
Get.getBoolean

  ReadSchema.Int Maybe LogicalTypeInt
_ -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ReadSchema -> Int32 -> Value
Int ReadSchema
sch)              Get Int32
Get.getInt

  ReadSchema.Long ReadLong
ReadSchema.ReadLong Maybe LogicalTypeLong
_     -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ReadSchema -> Int64 -> Value
Long ReadSchema
sch)                Get Int64
Get.getLong
  ReadSchema.Long ReadLong
ReadSchema.LongFromInt Maybe LogicalTypeLong
_  -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ReadSchema -> Int64 -> Value
Long ReadSchema
sch forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral)  Get Int32
Get.getInt

  ReadSchema.Float ReadFloat
ReadSchema.ReadFloat      -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ReadSchema -> Float -> Value
Float ReadSchema
sch)                Get Float
Get.getFloat
  ReadSchema.Float ReadFloat
ReadSchema.FloatFromInt   -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ReadSchema -> Float -> Value
Float ReadSchema
sch forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) Get Int32
Get.getInt
  ReadSchema.Float ReadFloat
ReadSchema.FloatFromLong  -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ReadSchema -> Float -> Value
Float ReadSchema
sch forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) Get Int64
Get.getLong

  ReadSchema.Double ReadDouble
ReadSchema.ReadDouble      -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ReadSchema -> Double -> Value
Double ReadSchema
sch)                 Get Double
Get.getDouble
  ReadSchema.Double ReadDouble
ReadSchema.DoubleFromInt   -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ReadSchema -> Double -> Value
Double ReadSchema
sch forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral)  Get Int32
Get.getInt
  ReadSchema.Double ReadDouble
ReadSchema.DoubleFromFloat -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ReadSchema -> Double -> Value
Double ReadSchema
sch forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Real a, Fractional b) => a -> b
realToFrac)    Get Float
Get.getFloat
  ReadSchema.Double ReadDouble
ReadSchema.DoubleFromLong  -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ReadSchema -> Double -> Value
Double ReadSchema
sch forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral)  Get Int64
Get.getLong

  ReadSchema.String Maybe LogicalTypeString
_              -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ReadSchema -> Text -> Value
String ReadSchema
sch)           Get Text
Get.getString
  ReadSchema.Record TypeName
_ [TypeName]
_ Maybe Text
_ [ReadField]
fields   -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ReadSchema -> Vector Value -> Value
Record ReadSchema
sch)             (HashMap TypeName ReadSchema -> [ReadField] -> Get (Vector Value)
getRecord HashMap TypeName ReadSchema
env [ReadField]
fields)
  ReadSchema.Bytes Maybe LogicalTypeBytes
_               -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ReadSchema -> ByteString -> Value
Bytes ReadSchema
sch)            Get ByteString
Get.getBytes

  ReadSchema.NamedType TypeName
tn          ->
    case forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup TypeName
tn HashMap TypeName ReadSchema
env of
      Maybe ReadSchema
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Unable to resolve type name " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show TypeName
tn
      Just ReadSchema
r  -> HashMap TypeName ReadSchema -> ReadSchema -> Get Value
getField HashMap TypeName ReadSchema
env ReadSchema
r

  ReadSchema.Enum TypeName
_ [TypeName]
_ Maybe Text
_ Vector Text
symbs      -> do
    Int64
i <- Get Int64
Get.getLong
    case Vector Text
symbs forall a. Vector a -> Int -> Maybe a
V.!? forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
i of
      Maybe Text
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Enum " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Vector Text
symbs forall a. Semigroup a => a -> a -> a
<> String
" doesn't contain value at position " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int64
i
      Just Text
v  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ReadSchema -> Int -> Text -> Value
Enum ReadSchema
sch (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
i) Text
v

  ReadSchema.Union Vector (Int, ReadSchema)
opts            -> do
    Int64
i <- Get Int64
Get.getLong
    case Vector (Int, ReadSchema)
opts forall a. Vector a -> Int -> Maybe a
V.!? forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
i of
      Maybe (Int, ReadSchema)
Nothing      -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Decoded Avro tag is outside the expected range for a Union. Tag: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int64
i forall a. Semigroup a => a -> a -> a
<> String
" union of: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Vector (Int, ReadSchema)
opts
      Just (Int
i', ReadSchema
t) -> ReadSchema -> Int -> Value -> Value
Union ReadSchema
sch (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i') forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashMap TypeName ReadSchema -> ReadSchema -> Get Value
getField HashMap TypeName ReadSchema
env ReadSchema
t

  ReadSchema.Fixed TypeName
_ [TypeName]
_ Int
size Maybe LogicalTypeFixed
_ -> ReadSchema -> ByteString -> Value
Fixed ReadSchema
sch forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getByteString (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size)

  ReadSchema.Array ReadSchema
t -> do
    [[Value]]
vals <- HashMap TypeName ReadSchema -> ReadSchema -> Get [[Value]]
getBlocksOf HashMap TypeName ReadSchema
env ReadSchema
t
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Vector Value -> Value
Array (forall a. [a] -> Vector a
V.fromList forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [[Value]]
vals)

  ReadSchema.Map  ReadSchema
t  -> do
    [[(Text, Value)]]
kvs <- HashMap TypeName ReadSchema -> ReadSchema -> Get [[(Text, Value)]]
getKVBlocks HashMap TypeName ReadSchema
env ReadSchema
t
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ HashMap Text Value -> Value
Map (forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [[(Text, Value)]]
kvs)

  ReadSchema.FreeUnion Int
ix ReadSchema
t -> do
    Value
v <- HashMap TypeName ReadSchema -> ReadSchema -> Get Value
getField HashMap TypeName ReadSchema
env ReadSchema
t
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ReadSchema -> Int -> Value -> Value
Union ReadSchema
sch Int
ix Value
v

getKVBlocks :: HashMap Schema.TypeName ReadSchema -> ReadSchema -> Get [[(Text, Value)]]
getKVBlocks :: HashMap TypeName ReadSchema -> ReadSchema -> Get [[(Text, Value)]]
getKVBlocks HashMap TypeName ReadSchema
env ReadSchema
t = do
  Int64
blockLength <- forall a. Num a => a -> a
abs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int64
Get.getLong
  if Int64
blockLength forall a. Eq a => a -> a -> Bool
== Int64
0
  then forall (m :: * -> *) a. Monad m => a -> m a
return []
  else do [(Text, Value)]
vs <- forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
blockLength) ((,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Text
Get.getString forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> HashMap TypeName ReadSchema -> ReadSchema -> Get Value
getField HashMap TypeName ReadSchema
env ReadSchema
t)
          ([(Text, Value)]
vsforall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashMap TypeName ReadSchema -> ReadSchema -> Get [[(Text, Value)]]
getKVBlocks HashMap TypeName ReadSchema
env ReadSchema
t
{-# INLINE getKVBlocks #-}

getBlocksOf :: HashMap Schema.TypeName ReadSchema -> ReadSchema -> Get [[Value]]
getBlocksOf :: HashMap TypeName ReadSchema -> ReadSchema -> Get [[Value]]
getBlocksOf HashMap TypeName ReadSchema
env ReadSchema
t = do
  Int64
blockLength <- forall a. Num a => a -> a
abs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int64
Get.getLong
  if Int64
blockLength forall a. Eq a => a -> a -> Bool
== Int64
0
  then forall (m :: * -> *) a. Monad m => a -> m a
return []
  else do
    [Value]
vs <- forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
blockLength) (HashMap TypeName ReadSchema -> ReadSchema -> Get Value
getField HashMap TypeName ReadSchema
env ReadSchema
t)
    ([Value]
vsforall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashMap TypeName ReadSchema -> ReadSchema -> Get [[Value]]
getBlocksOf HashMap TypeName ReadSchema
env ReadSchema
t

getRecord :: HashMap Schema.TypeName ReadSchema -> [ReadSchema.ReadField] -> Get (Vector Value)
getRecord :: HashMap TypeName ReadSchema -> [ReadField] -> Get (Vector Value)
getRecord HashMap TypeName ReadSchema
env [ReadField]
fs = do
  [(Int, Value)]
moos <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [ReadField]
fs forall a b. (a -> b) -> a -> b
$ \ReadField
f ->
    case ReadField -> FieldStatus
ReadSchema.fldStatus ReadField
f of
      FieldStatus
ReadSchema.Ignored       -> [] forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ HashMap TypeName ReadSchema -> ReadSchema -> Get Value
getField HashMap TypeName ReadSchema
env (ReadField -> ReadSchema
ReadSchema.fldType ReadField
f)
      ReadSchema.AsIs Int
i        -> (\Value
f -> [(Int
i,Value
f)]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashMap TypeName ReadSchema -> ReadSchema -> Get Value
getField HashMap TypeName ReadSchema
env (ReadField -> ReadSchema
ReadSchema.fldType ReadField
f)
      ReadSchema.Defaulted Int
i DefaultValue
v -> forall (f :: * -> *) a. Applicative f => a -> f a
pure [(Int
i, DefaultValue -> Value
convertValue DefaultValue
v)] --undefined

  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. (forall s. ST s (MVector s a)) -> Vector a
V.create forall a b. (a -> b) -> a -> b
$ do
    MVector s Value
vals <- forall (m :: * -> *) a.
PrimMonad m =>
Int -> m (MVector (PrimState m) a)
MV.unsafeNew (forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Int, Value)]
moos)
    forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m ()
MV.write MVector s Value
vals)) [(Int, Value)]
moos
    forall (m :: * -> *) a. Monad m => a -> m a
return MVector s Value
vals

-- | This function will be unnecessary when we fully migrate to 'Value'
convertValue :: Schema.DefaultValue -> Value
convertValue :: DefaultValue -> Value
convertValue = \case
  DefaultValue
Schema.DNull -> Value
Null
  Schema.DBoolean Bool
v       -> Bool -> Value
Boolean Bool
v
  Schema.DInt Schema
s Int32
v         -> ReadSchema -> Int32 -> Value
Int (Schema -> ReadSchema
ReadSchema.fromSchema Schema
s) Int32
v
  Schema.DLong Schema
s Int64
v        -> ReadSchema -> Int64 -> Value
Long (Schema -> ReadSchema
ReadSchema.fromSchema Schema
s) Int64
v
  Schema.DFloat Schema
s Float
v       -> ReadSchema -> Float -> Value
Float (Schema -> ReadSchema
ReadSchema.fromSchema Schema
s) Float
v
  Schema.DDouble Schema
s Double
v      -> ReadSchema -> Double -> Value
Double (Schema -> ReadSchema
ReadSchema.fromSchema Schema
s) Double
v
  Schema.DBytes Schema
s ByteString
v       -> ReadSchema -> ByteString -> Value
Bytes (Schema -> ReadSchema
ReadSchema.fromSchema Schema
s) ByteString
v
  Schema.DString Schema
s Text
v      -> ReadSchema -> Text -> Value
String (Schema -> ReadSchema
ReadSchema.fromSchema Schema
s) Text
v
  Schema.DArray Vector DefaultValue
v         -> Vector Value -> Value
Array forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DefaultValue -> Value
convertValue Vector DefaultValue
v
  Schema.DMap HashMap Text DefaultValue
v           -> HashMap Text Value -> Value
Map forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DefaultValue -> Value
convertValue HashMap Text DefaultValue
v
  Schema.DFixed Schema
s ByteString
v       -> ReadSchema -> ByteString -> Value
Fixed (Schema -> ReadSchema
ReadSchema.fromSchema Schema
s) ByteString
v
  Schema.DEnum Schema
s Int
i Text
v      -> ReadSchema -> Int -> Text -> Value
Enum (Schema -> ReadSchema
ReadSchema.fromSchema Schema
s) Int
i Text
v
  Schema.DUnion Vector Schema
vs Schema
sch DefaultValue
v  ->
    case forall a. Eq a => a -> Vector a -> Maybe Int
V.elemIndex Schema
sch Vector Schema
vs of
      Just Int
ix -> ReadSchema -> Int -> Value -> Value
Union (Schema -> ReadSchema
ReadSchema.fromSchema Schema
sch) Int
ix (DefaultValue -> Value
convertValue DefaultValue
v)
      Maybe Int
Nothing -> forall a. HasCallStack => String -> a
error String
"Union contains a value of an unknown schema"
  Schema.DRecord Schema
sch HashMap Text DefaultValue
vs   ->
    let
      fldNames :: [Text]
fldNames = Field -> Text
Schema.fldName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Schema -> [Field]
Schema.fields Schema
sch
      values :: [Value]
values = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Text
n -> DefaultValue -> Value
convertValue forall a b. (a -> b) -> a -> b
$ HashMap Text DefaultValue
vs forall k v.
(Eq k, Hashable k, HasCallStack) =>
HashMap k v -> k -> v
HashMap.! Text
n) [Text]
fldNames
    in ReadSchema -> Vector Value -> Value
Record (Schema -> ReadSchema
ReadSchema.fromSchema Schema
sch) forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Vector a
V.fromList [Value]
values