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

, describeValue
)
where

import           Control.DeepSeq             (NFData)
import           Control.Monad               (forM, replicateM, void, when)
import           Control.Monad.Identity      (Identity (..))
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)
import qualified Data.ByteString             as BS
import qualified Data.ByteString.Lazy        as BL
import           Data.Foldable               (traverse_)
import           Data.HashMap.Strict         (HashMap)
import qualified Data.HashMap.Strict         as HashMap
import           Data.Int
import qualified Data.Map                    as Map
import           Data.Text                   (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
(Value -> Value -> Bool) -> (Value -> Value -> Bool) -> Eq Value
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Value -> Value -> Bool
== :: Value -> Value -> Bool
$c/= :: Value -> Value -> Bool
/= :: 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
$cshowsPrec :: Int -> Value -> ShowS
showsPrec :: Int -> Value -> ShowS
$cshow :: Value -> String
show :: Value -> String
$cshowList :: [Value] -> ShowS
showList :: [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
$cfrom :: forall x. Value -> Rep Value x
from :: forall x. Value -> Rep Value x
$cto :: forall x. Rep Value x -> Value
to :: forall x. Rep Value x -> Value
Generic, Value -> ()
(Value -> ()) -> NFData Value
forall a. (a -> ()) -> NFData a
$crnf :: Value -> ()
rnf :: 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
_    -> 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 Time.LocalTime where
  fromAvro :: Value -> Either String LocalTime
fromAvro (Long (ReadSchema.Long ReadLong
_ (Just LogicalTypeLong
ReadSchema.LocalTimestampMicros)) Int64
n) =
    LocalTime -> Either String LocalTime
forall a b. b -> Either a b
Right (LocalTime -> Either String LocalTime)
-> LocalTime -> Either String LocalTime
forall a b. (a -> b) -> a -> b
$ Integer -> LocalTime
microsToLocalTime (Int64 -> Integer
forall a. Integral a => a -> Integer
toInteger Int64
n)
  fromAvro (Long (ReadSchema.Long ReadLong
_ (Just LogicalTypeLong
ReadSchema.LocalTimestampMillis)) Int64
n) =
    LocalTime -> Either String LocalTime
forall a b. b -> Either a b
Right (LocalTime -> Either String LocalTime)
-> LocalTime -> Either String LocalTime
forall a b. (a -> b) -> a -> b
$ Integer -> LocalTime
millisToLocalTime (Int64 -> Integer
forall a. Integral a => a -> Integer
toInteger Int64
n)
  fromAvro Value
x = String -> Either String LocalTime
forall a b. a -> Either a b
Left (String
"Unable to decode LocalTime 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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Vector a -> m (Vector 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)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Vector a -> m (Vector 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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Map Text a -> f (Map Text 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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> HashMap Text a -> f (HashMap Text 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 a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
Null
  ReadSchema
ReadSchema.Boolean  -> (Bool -> Value) -> Get Bool -> Get Value
forall a b. (a -> b) -> Get a -> Get b
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 a b. (a -> b) -> Get a -> Get b
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 a b. (a -> b) -> Get a -> Get b
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 a b. (a -> b) -> Get a -> Get b
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 a b. (a -> b) -> Get a -> Get b
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 a b. (a -> b) -> Get a -> Get b
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 a b. (a -> b) -> Get a -> Get b
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 a b. (a -> b) -> Get a -> Get b
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 a b. (a -> b) -> Get a -> Get b
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 a b. (a -> b) -> Get a -> Get b
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 a b. (a -> b) -> Get a -> Get b
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 a b. (a -> b) -> Get a -> Get b
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 a b. (a -> b) -> Get a -> Get b
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 a b. (a -> b) -> Get a -> Get b
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 a. String -> Get a
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 a. String -> Get a
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 a. a -> Get a
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 a. String -> Get a
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 a. a -> Get a
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 a. a -> Get a
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 a. a -> Get a
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


-- | Read a Map from blocks of KV pairs
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
lengthIndicator <- Get Int64
Get.getLong
  if Int64
lengthIndicator Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
0 then
    [[(Text, Value)]] -> Get [[(Text, Value)]]
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return []
  else do
    -- When the block's count is negative, its absolute value is used, and the count is followed immediately by a
    -- long block size indicating the number of bytes in the block.
    Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int64
lengthIndicator Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int64
0) (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$ Get Int64 -> Get ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Get Int64
Get.getLong -- number of bytes in block (ignored)
    let blockLength :: Int64
blockLength = Int64 -> Int64
forall a. Num a => a -> a
abs Int64
lengthIndicator
    [(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 a b. Get (a -> b) -> Get a -> Get b
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 #-}

-- | Read an array from blocks.
getBlocksOf :: HashMap Schema.TypeName ReadSchema -> ReadSchema -> Get [[Value]]
getBlocksOf :: HashMap TypeName ReadSchema -> ReadSchema -> Get [[Value]]
getBlocksOf HashMap TypeName ReadSchema
env ReadSchema
t = do
  Int64
lengthIndicator <- Get Int64
Get.getLong
  if Int64
lengthIndicator Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
0 then
    [[Value]] -> Get [[Value]]
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return []
  else do
    -- When the block's count is negative, its absolute value is used, and the count is followed immediately by a
    -- long block size indicating the number of bytes in the block.
    Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int64
lengthIndicator Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int64
0) (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$ Get Int64 -> Get ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Get Int64
Get.getLong -- number of bytes in block (ignored)
    let blockLength :: Int64
blockLength = Int64 -> Int64
forall a. Num a => a -> a
abs Int64
lengthIndicator
    [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 a b. (a -> b) -> Get a -> Get b
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 a b. a -> Get b -> Get a
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
fld -> [(Int
i,Value
fld)]) (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 a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [(Int
i, DefaultValue -> Value
convertValue DefaultValue
v)] --undefined

  Vector Value -> Get (Vector Value)
forall a. a -> Get a
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 a. [a] -> 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 a. a -> ST s a
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 a b. (a -> b) -> Vector a -> Vector 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 (HashMap Text Value -> Value) -> HashMap Text Value -> Value
forall a b. (a -> b) -> a -> b
$ (DefaultValue -> Value)
-> HashMap Text DefaultValue -> HashMap Text Value
forall a b. (a -> b) -> HashMap Text a -> HashMap Text 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 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 a b. (a -> b) -> [a] -> [b]
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