{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE StrictData #-}
module Data.Avro.Encoding.FromAvro
( FromAvro(..)
, 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
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)
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
")"
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)]
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
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