{-# LANGUAGE DeriveAnyClass    #-}
{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE StrictData        #-}
{-# LANGUAGE TupleSections     #-}
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 BS
import qualified Data.ByteString             as B
import qualified Data.ByteString.Lazy        as BL
import qualified Data.Char                   as Char
import           Data.HashMap.Strict         (HashMap)
import qualified Data.HashMap.Strict         as HashMap
import           Data.Int
import           Data.List.NonEmpty          (NonEmpty)
import           Data.Foldable               (traverse_)
import qualified Data.Map                    as Map
import           Data.Text                   (Text)
import qualified Data.Text                   as Text
import qualified Data.Text                   as T
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
(Value -> Value -> Bool) -> (Value -> Value -> Bool) -> Eq Value
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
(Int -> Value -> ShowS)
-> (Value -> String) -> ([Value] -> ShowS) -> Show Value
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. Value -> Rep Value x)
-> (forall x. Rep Value x -> Value) -> Generic Value
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 -> ()
(Value -> ()) -> NFData 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 (" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ReadSchema -> String
forall a. Show a => a -> String
show ReadSchema
s String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"
  Long ReadSchema
s Int64
_      -> String
"Long (" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ReadSchema -> String
forall a. Show a => a -> String
show ReadSchema
s String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"
  Float ReadSchema
s Float
_     -> String
"Float (" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ReadSchema -> String
forall a. Show a => a -> String
show ReadSchema
s String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"
  Double ReadSchema
s Double
_    -> String
"Double (" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ReadSchema -> String
forall a. Show a => a -> String
show ReadSchema
s String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"
  Bytes ReadSchema
s ByteString
_     -> String
"Bytes (" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ReadSchema -> String
forall a. Show a => a -> String
show ReadSchema
s String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"
  String ReadSchema
s Text
_    -> String
"String (" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ReadSchema -> String
forall a. Show a => a -> String
show ReadSchema
s String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"
  Union ReadSchema
s Int
ix Value
_  -> String
"Union (position = " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
ix String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
", schema = " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ReadSchema -> String
forall a. Show a => a -> String
show ReadSchema
s String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"
  Fixed ReadSchema
s ByteString
_     -> String
"Fixed (" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ReadSchema -> String
forall a. Show a => a -> String
show ReadSchema
s String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"
  Enum ReadSchema
s Int
ix Text
_   -> String
"Enum (position = " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
ix String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
", schema =" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ReadSchema -> String
forall a. Show a => a -> String
show ReadSchema
s String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"
  Array Vector Value
vs      -> String
"Array (length = " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (Vector Value -> Int
forall a. Vector a -> Int
V.length Vector Value
vs) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"
  Map HashMap Text Value
vs        -> String
"Map (length = " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (HashMap Text Value -> Int
forall k v. HashMap k v -> Int
HashMap.size HashMap Text Value
vs) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"
  Record ReadSchema
s Vector Value
vs   -> String
"Record (name = " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> TypeName -> String
forall a. Show a => a -> String
show (ReadSchema -> TypeName
ReadSchema.name ReadSchema
s) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" fieldsNum = " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (Vector Value -> Int
forall a. Vector a -> Int
V.length Vector Value
vs) String -> ShowS
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)  = Int -> Either String Int
forall a b. b -> Either a b
Right (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
x)
  fromAvro (Long ReadSchema
_ Int64
x) = Int -> Either String Int
forall a b. b -> Either a b
Right (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
x)
  fromAvro Value
x          = String -> Either String Int
forall a b. a -> Either a b
Left (String
"Unable to decode Int from: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
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) = Int32 -> Either String Int32
forall a b. b -> Either a b
Right Int32
x
  fromAvro Value
x         = String -> Either String Int32
forall a b. a -> Either a b
Left (String
"Unable to decode Int32 from: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
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) = Int64 -> Either String Int64
forall a b. b -> Either a b
Right Int64
x
  fromAvro (Int ReadSchema
_ Int32
x)  = Int64 -> Either String Int64
forall a b. b -> Either a b
Right (Int32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
x)
  fromAvro Value
x          = String -> Either String Int64
forall a b. a -> Either a b
Left (String
"Unable to decode Int64 from: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
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) = Double -> Either String Double
forall a b. b -> Either a b
Right Double
x
  fromAvro (Float ReadSchema
_ Float
x)  = Double -> Either String Double
forall a b. b -> Either a b
Right (Float -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
x)
  fromAvro (Long ReadSchema
_ Int64
x)   = Double -> Either String Double
forall a b. b -> Either a b
Right (Int64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
x)
  fromAvro (Int ReadSchema
_ Int32
x)    = Double -> Either String Double
forall a b. b -> Either a b
Right (Int32 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
x)
  fromAvro Value
x            = String -> Either String Double
forall a b. a -> Either a b
Left (String
"Unable to decode Double from: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
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) = Float -> Either String Float
forall a b. b -> Either a b
Right Float
x
  fromAvro (Long ReadSchema
_ Int64
x)  = Float -> Either String Float
forall a b. b -> Either a b
Right (Int64 -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
x)
  fromAvro (Int ReadSchema
_ Int32
x)   = Float -> Either String Float
forall a b. b -> Either a b
Right (Int32 -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
x)
  fromAvro Value
x           = String -> Either String Float
forall a b. a -> Either a b
Left (String
"Unable to decode Double from: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
forall a. Show a => a -> String
show (Value -> String
describeValue Value
x))
  {-# INLINE fromAvro #-}

instance FromAvro () where
  fromAvro :: Value -> Either String ()
fromAvro Value
Null = () -> Either String ()
forall a b. b -> Either a b
Right ()
  fromAvro Value
x    = String -> Either String ()
forall a b. a -> Either a b
Left (String
"Unable to decode () from: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
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) = Bool -> Either String Bool
forall a b. b -> Either a b
Right Bool
x
  fromAvro Value
x           = String -> Either String Bool
forall a b. a -> Either a b
Left (String
"Unable to decode Bool from: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
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) = Text -> Either String Text
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 -> String -> Either String Text
forall a b. a -> Either a b
Left (UnicodeException -> String
forall a. Show a => a -> String
show UnicodeException
unicodeExc)
    Right Text
text      -> Text -> Either String Text
forall a b. b -> Either a b
Right Text
text
  fromAvro Value
x          = String -> Either String Text
forall a b. a -> Either a b
Left (String
"Unable to decode Text from: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
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)  = ByteString -> Either String ByteString
forall a b. b -> Either a b
Right ByteString
x
  fromAvro (String ReadSchema
_ Text
x) = ByteString -> Either String ByteString
forall a b. b -> Either a b
Right (Text -> ByteString
Text.encodeUtf8 Text
x)
  fromAvro Value
x            = String -> Either String ByteString
forall a b. a -> Either a b
Left (String
"Unable to decode Bytes from: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
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) = ByteString -> Either String ByteString
forall a b. b -> Either a b
Right (ByteString -> ByteString
BL.fromStrict ByteString
bs)
  fromAvro (String ReadSchema
_ Text
x) = ByteString -> Either String ByteString
forall a b. b -> Either a b
Right (ByteString -> ByteString
BL.fromStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
Text.encodeUtf8 Text
x)
  fromAvro Value
x            = String -> Either String ByteString
forall a b. a -> Either a b
Left (String
"Unable to decode Bytes from: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
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) = Decimal p s -> Either String (Decimal p s)
forall a b. b -> Either a b
Right (Decimal p s -> Either String (Decimal p s))
-> Decimal p s -> Either String (Decimal p s)
forall a b. (a -> b) -> a -> b
$ Integer -> Decimal p s
forall (p :: Nat) (s :: Nat). KnownNat s => Integer -> Decimal p s
D.fromUnderlyingValue (Integer -> Decimal p s) -> Integer -> Decimal p s
forall a b. (a -> b) -> a -> b
$ Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
n
  fromAvro (Int ReadSchema
_ Int32
n)  = Decimal p s -> Either String (Decimal p s)
forall a b. b -> Either a b
Right (Decimal p s -> Either String (Decimal p s))
-> Decimal p s -> Either String (Decimal p s)
forall a b. (a -> b) -> a -> b
$ Integer -> Decimal p s
forall (p :: Nat) (s :: Nat). KnownNat s => Integer -> Decimal p s
D.fromUnderlyingValue (Integer -> Decimal p s) -> Integer -> Decimal p s
forall a b. (a -> b) -> a -> b
$ Int32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
n
  fromAvro Value
x          = String -> Either String (Decimal p s)
forall a b. a -> Either a b
Left (String
"Unable to decode Decimal from: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
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 -> String -> Either String UUID
forall a b. a -> Either a b
Left String
"Unable to UUID from a given String value"
      Just UUID
u  -> UUID -> Either String UUID
forall a b. b -> Either a b
Right UUID
u
  fromAvro Value
x            = String -> Either String UUID
forall a b. a -> Either a b
Left (String
"Unable to decode UUID from: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
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) = Day -> Either String Day
forall a b. b -> Either a b
Right (Day -> Either String Day) -> Day -> Either String Day
forall a b. (a -> b) -> a -> b
$ Integer -> Day
fromDaysSinceEpoch (Int32 -> Integer
forall a. Integral a => a -> Integer
toInteger Int32
n)
  fromAvro Value
x                                               = String -> Either String Day
forall a b. a -> Either a b
Left (String
"Unable to decode Day from: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
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)          = DiffTime -> Either String DiffTime
forall a b. b -> Either a b
Right (DiffTime -> Either String DiffTime)
-> DiffTime -> Either String DiffTime
forall a b. (a -> b) -> a -> b
$ Integer -> DiffTime
millisToDiffTime (Int32 -> Integer
forall a. Integral a => a -> Integer
toInteger Int32
n)
  fromAvro (Long (ReadSchema.Long ReadLong
_ (Just LogicalTypeLong
ReadSchema.TimestampMillis)) Int64
n) = DiffTime -> Either String DiffTime
forall a b. b -> Either a b
Right (DiffTime -> Either String DiffTime)
-> DiffTime -> Either String DiffTime
forall a b. (a -> b) -> a -> b
$ Integer -> DiffTime
millisToDiffTime (Int64 -> Integer
forall a. Integral a => a -> Integer
toInteger Int64
n)
  fromAvro (Long (ReadSchema.Long ReadLong
_ (Just LogicalTypeLong
ReadSchema.TimeMicros)) Int64
n)      = DiffTime -> Either String DiffTime
forall a b. b -> Either a b
Right (DiffTime -> Either String DiffTime)
-> DiffTime -> Either String DiffTime
forall a b. (a -> b) -> a -> b
$ Integer -> DiffTime
microsToDiffTime (Int64 -> Integer
forall a. Integral a => a -> Integer
toInteger Int64
n)
  fromAvro (Long (ReadSchema.Long ReadLong
_ (Just LogicalTypeLong
ReadSchema.TimestampMicros)) Int64
n) = DiffTime -> Either String DiffTime
forall a b. b -> Either a b
Right (DiffTime -> Either String DiffTime)
-> DiffTime -> Either String DiffTime
forall a b. (a -> b) -> a -> b
$ Integer -> DiffTime
microsToDiffTime (Int64 -> Integer
forall a. Integral a => a -> Integer
toInteger Int64
n)
  fromAvro Value
x                                                              = String -> Either String DiffTime
forall a b. a -> Either a b
Left (String
"Unable to decode TimeDiff from: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
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) = UTCTime -> Either String UTCTime
forall a b. b -> Either a b
Right (UTCTime -> Either String UTCTime)
-> UTCTime -> Either String UTCTime
forall a b. (a -> b) -> a -> b
$ Integer -> UTCTime
microsToUTCTime (Int64 -> Integer
forall a. Integral a => a -> Integer
toInteger Int64
n)
  fromAvro (Long (ReadSchema.Long ReadLong
_ (Just LogicalTypeLong
ReadSchema.TimestampMillis)) Int64
n) = UTCTime -> Either String UTCTime
forall a b. b -> Either a b
Right (UTCTime -> Either String UTCTime)
-> UTCTime -> Either String UTCTime
forall a b. (a -> b) -> a -> b
$ Integer -> UTCTime
millisToUTCTime (Int64 -> Integer
forall a. Integral a => a -> Integer
toInteger Int64
n)
  fromAvro Value
x                                                              = String -> Either String UTCTime
forall a b. a -> Either a b
Left (String
"Unable to decode UTCTime from: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
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) = (Value -> Either String a) -> [Value] -> Either String [a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Value -> Either String a
forall a. FromAvro a => Value -> Either String a
fromAvro ([Value] -> Either String [a]) -> [Value] -> Either String [a]
forall a b. (a -> b) -> a -> b
$ Vector Value -> [Value]
forall a. Vector a -> [a]
V.toList Vector Value
vec
  fromAvro Value
x           = String -> Either String [a]
forall a b. a -> Either a b
Left (String
"Unable to decode Array from: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
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) = (Value -> Either String a)
-> Vector Value -> Either String (Vector a)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Value -> Either String a
forall a. FromAvro a => Value -> Either String a
fromAvro Vector Value
vec
  fromAvro Value
x           = String -> Either String (Vector a)
forall a b. a -> Either a b
Left (String
"Unable to decode Array from: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
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) = Vector a -> Vector a
forall (v :: * -> *) a (w :: * -> *).
(Vector v a, Vector w a) =>
v a -> w a
UV.convert (Vector a -> Vector a)
-> Either String (Vector a) -> Either String (Vector a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Either String a)
-> Vector Value -> Either String (Vector a)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Value -> Either String a
forall a. FromAvro a => Value -> Either String a
fromAvro Vector Value
vec
  fromAvro Value
x           = String -> Either String (Vector a)
forall a b. a -> Either a b
Left (String
"Unable to decode Array from: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
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) = a -> Identity a
forall a. a -> Identity a
Identity (a -> Identity a) -> Either String a -> Either String (Identity a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Either String a
forall a. FromAvro a => Value -> Either String a
fromAvro Value
v
  fromAvro (Union ReadSchema
_ Int
n Value
_) = String -> Either String (Identity a)
forall a b. a -> Either a b
Left (String
"Unable to decode Identity value from value with a position #" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
n)
  fromAvro Value
x             = String -> Either String (Identity a)
forall a b. a -> Either a b
Left (String
"Unable to decode Identity from: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
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) = Maybe a -> Either String (Maybe a)
forall a b. b -> Either a b
Right Maybe a
forall a. Maybe a
Nothing
  fromAvro (Union ReadSchema
_ Int
_ Value
v)    = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Either String a -> Either String (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Either String a
forall a. FromAvro a => Value -> Either String a
fromAvro Value
v
  fromAvro Value
x                = String -> Either String (Maybe a)
forall a b. a -> Either a b
Left (String
"Unable to decode Maybe from: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
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) = a -> Either a b
forall a b. a -> Either a b
Left (a -> Either a b) -> Either String a -> Either String (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Either String a
forall a. FromAvro a => Value -> Either String a
fromAvro Value
a
  fromAvro (Union ReadSchema
_ Int
1 Value
b) = b -> Either a b
forall a b. b -> Either a b
Right (b -> Either a b) -> Either String b -> Either String (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Either String b
forall a. FromAvro a => Value -> Either String a
fromAvro Value
b
  fromAvro (Union ReadSchema
_ Int
n Value
_) = String -> Either String (Either a b)
forall a b. a -> Either a b
Left (String
"Unable to decode Either value with a position #" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
n)
  fromAvro Value
x             = String -> Either String (Either a b)
forall a b. a -> Either a b
Left (String
"Unable to decode Either from: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
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) = (Value -> Either String a)
-> Map Text Value -> Either String (Map Text a)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Value -> Either String a
forall a. FromAvro a => Value -> Either String a
fromAvro ([(Text, Value)] -> Map Text Value
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (HashMap Text Value -> [(Text, Value)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList HashMap Text Value
mp))
  fromAvro Value
x        = String -> Either String (Map Text a)
forall a b. a -> Either a b
Left (String
"Unable to decode Map from: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
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) = (Value -> Either String a)
-> HashMap Text Value -> Either String (HashMap Text a)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Value -> Either String a
forall a. FromAvro a => Value -> Either String a
fromAvro HashMap Text Value
mp
  fromAvro Value
x        = String -> Either String (HashMap Text a)
forall a b. a -> Either a b
Left (String
"Unable to decode Map from: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
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     -> Value -> Get Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
Null
  ReadSchema
ReadSchema.Boolean  -> (Bool -> Value) -> Get Bool -> Get Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Value
Boolean                Get Bool
Get.getBoolean

  ReadSchema.Int Maybe LogicalTypeInt
_ -> (Int32 -> Value) -> Get Int32 -> Get Value
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
_     -> (Int64 -> Value) -> Get Int64 -> Get Value
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
_  -> (Int32 -> Value) -> Get Int32 -> Get Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ReadSchema -> Int64 -> Value
Long ReadSchema
sch (Int64 -> Value) -> (Int32 -> Int64) -> Int32 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral)  Get Int32
Get.getInt

  ReadSchema.Float ReadFloat
ReadSchema.ReadFloat      -> (Float -> Value) -> Get Float -> Get Value
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   -> (Int32 -> Value) -> Get Int32 -> Get Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ReadSchema -> Float -> Value
Float ReadSchema
sch (Float -> Value) -> (Int32 -> Float) -> Int32 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral) Get Int32
Get.getInt
  ReadSchema.Float ReadFloat
ReadSchema.FloatFromLong  -> (Int64 -> Value) -> Get Int64 -> Get Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ReadSchema -> Float -> Value
Float ReadSchema
sch (Float -> Value) -> (Int64 -> Float) -> Int64 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral) Get Int64
Get.getLong

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

  ReadSchema.String Maybe LogicalTypeString
_              -> (Text -> Value) -> Get Text -> Get Value
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   -> (Vector Value -> Value) -> Get (Vector Value) -> Get Value
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
_               -> (ByteString -> Value) -> Get ByteString -> Get Value
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 TypeName -> HashMap TypeName ReadSchema -> Maybe ReadSchema
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 -> String -> Get Value
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get Value) -> String -> Get Value
forall a b. (a -> b) -> a -> b
$ String
"Unable to resolve type name " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> TypeName -> String
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 Vector Text -> Int -> Maybe Text
forall a. Vector a -> Int -> Maybe a
V.!? Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
i of
      Maybe Text
Nothing -> String -> Get Value
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get Value) -> String -> Get Value
forall a b. (a -> b) -> a -> b
$ String
"Enum " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Vector Text -> String
forall a. Show a => a -> String
show Vector Text
symbs String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" doesn't contain value at position " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int64 -> String
forall a. Show a => a -> String
show Int64
i
      Just Text
v  -> Value -> Get Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Get Value) -> Value -> Get Value
forall a b. (a -> b) -> a -> b
$ ReadSchema -> Int -> Text -> Value
Enum ReadSchema
sch (Int64 -> Int
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 Vector (Int, ReadSchema) -> Int -> Maybe (Int, ReadSchema)
forall a. Vector a -> Int -> Maybe a
V.!? Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
i of
      Maybe (Int, ReadSchema)
Nothing      -> String -> Get Value
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get Value) -> String -> Get Value
forall a b. (a -> b) -> a -> b
$ String
"Decoded Avro tag is outside the expected range for a Union. Tag: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int64 -> String
forall a. Show a => a -> String
show Int64
i String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" union of: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Vector (Int, ReadSchema) -> String
forall a. Show a => a -> String
show Vector (Int, ReadSchema)
opts
      Just (Int
i', ReadSchema
t) -> ReadSchema -> Int -> Value -> Value
Union ReadSchema
sch (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i') (Value -> Value) -> Get Value -> Get Value
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 (ByteString -> Value) -> Get ByteString -> Get Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getByteString (Int -> Int
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
    Value -> Get Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Get Value) -> Value -> Get Value
forall a b. (a -> b) -> a -> b
$ Vector Value -> Value
Array ([Value] -> Vector Value
forall a. [a] -> Vector a
V.fromList ([Value] -> Vector Value) -> [Value] -> Vector Value
forall a b. (a -> b) -> a -> b
$ [[Value]] -> [Value]
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
    Value -> Get Value
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> Get Value) -> Value -> Get Value
forall a b. (a -> b) -> a -> b
$ HashMap Text Value -> Value
Map ([(Text, Value)] -> HashMap Text Value
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ([(Text, Value)] -> HashMap Text Value)
-> [(Text, Value)] -> HashMap Text Value
forall a b. (a -> b) -> a -> b
$ [[(Text, Value)]] -> [(Text, Value)]
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
    Value -> Get Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Get Value) -> Value -> Get Value
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 <- Int64 -> Int64
forall a. Num a => a -> a
abs (Int64 -> Int64) -> Get Int64 -> Get Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int64
Get.getLong
  if Int64
blockLength Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
0
  then [[(Text, Value)]] -> Get [[(Text, Value)]]
forall (m :: * -> *) a. Monad m => a -> m a
return []
  else do [(Text, Value)]
vs <- Int -> Get (Text, Value) -> Get [(Text, Value)]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
blockLength) ((,) (Text -> Value -> (Text, Value))
-> Get Text -> Get (Value -> (Text, Value))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Text
Get.getString Get (Value -> (Text, Value)) -> Get Value -> Get (Text, Value)
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)]
vs[(Text, Value)] -> [[(Text, Value)]] -> [[(Text, Value)]]
forall a. a -> [a] -> [a]
:) ([[(Text, Value)]] -> [[(Text, Value)]])
-> Get [[(Text, Value)]] -> Get [[(Text, Value)]]
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 <- Int64 -> Int64
forall a. Num a => a -> a
abs (Int64 -> Int64) -> Get Int64 -> Get Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int64
Get.getLong
  if Int64
blockLength Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
0
  then [[Value]] -> Get [[Value]]
forall (m :: * -> *) a. Monad m => a -> m a
return []
  else do
    [Value]
vs <- Int -> Get Value -> Get [Value]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Int64 -> Int
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]
vs[Value] -> [[Value]] -> [[Value]]
forall a. a -> [a] -> [a]
:) ([[Value]] -> [[Value]]) -> Get [[Value]] -> Get [[Value]]
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 <- ([[(Int, Value)]] -> [(Int, Value)])
-> Get [[(Int, Value)]] -> Get [(Int, Value)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[(Int, Value)]] -> [(Int, Value)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Get [[(Int, Value)]] -> Get [(Int, Value)])
-> ((ReadField -> Get [(Int, Value)]) -> Get [[(Int, Value)]])
-> (ReadField -> Get [(Int, Value)])
-> Get [(Int, Value)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ReadField]
-> (ReadField -> Get [(Int, Value)]) -> Get [[(Int, Value)]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [ReadField]
fs ((ReadField -> Get [(Int, Value)]) -> Get [(Int, Value)])
-> (ReadField -> Get [(Int, Value)]) -> Get [(Int, Value)]
forall a b. (a -> b) -> a -> b
$ \ReadField
f ->
    case ReadField -> FieldStatus
ReadSchema.fldStatus ReadField
f of
      FieldStatus
ReadSchema.Ignored       -> [] [(Int, Value)] -> Get Value -> Get [(Int, Value)]
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)]) (Value -> [(Int, Value)]) -> Get Value -> Get [(Int, Value)]
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 -> [(Int, Value)] -> Get [(Int, Value)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [(Int
i, DefaultValue -> Value
convertValue DefaultValue
v)] --undefined

  Vector Value -> Get (Vector Value)
forall (m :: * -> *) a. Monad m => a -> m a
return (Vector Value -> Get (Vector Value))
-> Vector Value -> Get (Vector Value)
forall a b. (a -> b) -> a -> b
$ (forall s. ST s (MVector s Value)) -> Vector Value
forall a. (forall s. ST s (MVector s a)) -> Vector a
V.create ((forall s. ST s (MVector s Value)) -> Vector Value)
-> (forall s. ST s (MVector s Value)) -> Vector Value
forall a b. (a -> b) -> a -> b
$ do
    MVector s Value
vals <- Int -> ST s (MVector (PrimState (ST s)) Value)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> m (MVector (PrimState m) a)
MV.unsafeNew ([(Int, Value)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Int, Value)]
moos)
    ((Int, Value) -> ST s ()) -> [(Int, Value)] -> ST s ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ ((Int -> Value -> ST s ()) -> (Int, Value) -> ST s ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (MVector (PrimState (ST s)) Value -> Int -> Value -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m ()
MV.write MVector s Value
MVector (PrimState (ST s)) Value
vals)) [(Int, Value)]
moos
    MVector s Value -> ST s (MVector s Value)
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 (Vector Value -> Value) -> Vector Value -> Value
forall a b. (a -> b) -> a -> b
$ (DefaultValue -> Value) -> Vector DefaultValue -> Vector Value
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 (HashMap Text Value -> Value) -> HashMap Text Value -> Value
forall a b. (a -> b) -> a -> b
$ (DefaultValue -> Value)
-> HashMap Text DefaultValue -> HashMap Text Value
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 Schema -> Vector Schema -> Maybe Int
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 -> String -> Value
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 (Field -> Text) -> [Field] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Schema -> [Field]
Schema.fields Schema
sch
      values :: [Value]
values = (Text -> Value) -> [Text] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Text
n -> DefaultValue -> Value
convertValue (DefaultValue -> Value) -> DefaultValue -> Value
forall a b. (a -> b) -> a -> b
$ HashMap Text DefaultValue
vs HashMap Text DefaultValue -> Text -> DefaultValue
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) (Vector Value -> Value) -> Vector Value -> Value
forall a b. (a -> b) -> a -> b
$ [Value] -> Vector Value
forall a. [a] -> Vector a
V.fromList [Value]
values