{-# LANGUAGE DeriveAnyClass  #-}
{-# LANGUAGE DeriveGeneric   #-}
{-# LANGUAGE LambdaCase      #-}
{-# LANGUAGE RecordWildCards #-}
module Data.Avro.Schema.ReadSchema
( ReadSchema(..), ReadField(..)

, ReadLong(..), ReadFloat(..), ReadDouble(..)
, fromSchema, fromField

, extractBindings

, S.Decimal(..)
, S.LogicalTypeBytes(..), S.LogicalTypeFixed(..)
, S.LogicalTypeInt(..), S.LogicalTypeLong(..)
, S.LogicalTypeString(..)
, FieldStatus(..)
)
where

import           Control.DeepSeq         (NFData)
import           Data.Avro.Schema.Schema (LogicalTypeBytes, LogicalTypeFixed, LogicalTypeInt, LogicalTypeLong, LogicalTypeString, Order, TypeName)
import qualified Data.Avro.Schema.Schema as S
import           Data.HashMap.Strict     (HashMap)
import qualified Data.HashMap.Strict     as HashMap
import           Data.Text               (Text)
import qualified Data.Text               as T
import qualified Data.Vector             as V
import           GHC.Generics            (Generic)

-- | How to decode a value of target type @Long@.
-- This type controls how many bits are needed to be read from the encoded bytestring.
-- The number of bits can be different depending on differences between reader and writer schemas.
--
-- The rules are described in <https://avro.apache.org/docs/current/spec.html#Schema+Resolution>
data ReadLong
  = LongFromInt -- ^ Read @Int@ (32 bits) and cast it to @Long@ (Rule: int is promotable to long, float, or double)
  | ReadLong    -- ^ Read @Long@ (64 bits) and use as is
  deriving (Int -> ReadLong -> ShowS
[ReadLong] -> ShowS
ReadLong -> String
(Int -> ReadLong -> ShowS)
-> (ReadLong -> String) -> ([ReadLong] -> ShowS) -> Show ReadLong
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReadLong] -> ShowS
$cshowList :: [ReadLong] -> ShowS
show :: ReadLong -> String
$cshow :: ReadLong -> String
showsPrec :: Int -> ReadLong -> ShowS
$cshowsPrec :: Int -> ReadLong -> ShowS
Show, ReadLong -> ReadLong -> Bool
(ReadLong -> ReadLong -> Bool)
-> (ReadLong -> ReadLong -> Bool) -> Eq ReadLong
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReadLong -> ReadLong -> Bool
$c/= :: ReadLong -> ReadLong -> Bool
== :: ReadLong -> ReadLong -> Bool
$c== :: ReadLong -> ReadLong -> Bool
Eq, Eq ReadLong
Eq ReadLong
-> (ReadLong -> ReadLong -> Ordering)
-> (ReadLong -> ReadLong -> Bool)
-> (ReadLong -> ReadLong -> Bool)
-> (ReadLong -> ReadLong -> Bool)
-> (ReadLong -> ReadLong -> Bool)
-> (ReadLong -> ReadLong -> ReadLong)
-> (ReadLong -> ReadLong -> ReadLong)
-> Ord ReadLong
ReadLong -> ReadLong -> Bool
ReadLong -> ReadLong -> Ordering
ReadLong -> ReadLong -> ReadLong
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ReadLong -> ReadLong -> ReadLong
$cmin :: ReadLong -> ReadLong -> ReadLong
max :: ReadLong -> ReadLong -> ReadLong
$cmax :: ReadLong -> ReadLong -> ReadLong
>= :: ReadLong -> ReadLong -> Bool
$c>= :: ReadLong -> ReadLong -> Bool
> :: ReadLong -> ReadLong -> Bool
$c> :: ReadLong -> ReadLong -> Bool
<= :: ReadLong -> ReadLong -> Bool
$c<= :: ReadLong -> ReadLong -> Bool
< :: ReadLong -> ReadLong -> Bool
$c< :: ReadLong -> ReadLong -> Bool
compare :: ReadLong -> ReadLong -> Ordering
$ccompare :: ReadLong -> ReadLong -> Ordering
$cp1Ord :: Eq ReadLong
Ord, (forall x. ReadLong -> Rep ReadLong x)
-> (forall x. Rep ReadLong x -> ReadLong) -> Generic ReadLong
forall x. Rep ReadLong x -> ReadLong
forall x. ReadLong -> Rep ReadLong x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ReadLong x -> ReadLong
$cfrom :: forall x. ReadLong -> Rep ReadLong x
Generic, ReadLong -> ()
(ReadLong -> ()) -> NFData ReadLong
forall a. (a -> ()) -> NFData a
rnf :: ReadLong -> ()
$crnf :: ReadLong -> ()
NFData)

-- | How to decode a value of target type @Float@.
-- This type controls how many bits are needed to be read from the encoded bytestring.
-- The number of bits can be different depending on differences between reader and writer schemas.
--
-- The rules are described in <https://avro.apache.org/docs/current/spec.html#Schema+Resolution>
data ReadFloat
  = FloatFromInt    -- ^ Read @Int@ (32 bits) and cast it to @Float@
  | FloatFromLong   -- ^ Read @Long@ (64 bits) and cast it to @Float@ (Rule: long is promotable to float or double)
  | ReadFloat       -- ^ Read @Float@ and use as is
  deriving (Int -> ReadFloat -> ShowS
[ReadFloat] -> ShowS
ReadFloat -> String
(Int -> ReadFloat -> ShowS)
-> (ReadFloat -> String)
-> ([ReadFloat] -> ShowS)
-> Show ReadFloat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReadFloat] -> ShowS
$cshowList :: [ReadFloat] -> ShowS
show :: ReadFloat -> String
$cshow :: ReadFloat -> String
showsPrec :: Int -> ReadFloat -> ShowS
$cshowsPrec :: Int -> ReadFloat -> ShowS
Show, ReadFloat -> ReadFloat -> Bool
(ReadFloat -> ReadFloat -> Bool)
-> (ReadFloat -> ReadFloat -> Bool) -> Eq ReadFloat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReadFloat -> ReadFloat -> Bool
$c/= :: ReadFloat -> ReadFloat -> Bool
== :: ReadFloat -> ReadFloat -> Bool
$c== :: ReadFloat -> ReadFloat -> Bool
Eq, Eq ReadFloat
Eq ReadFloat
-> (ReadFloat -> ReadFloat -> Ordering)
-> (ReadFloat -> ReadFloat -> Bool)
-> (ReadFloat -> ReadFloat -> Bool)
-> (ReadFloat -> ReadFloat -> Bool)
-> (ReadFloat -> ReadFloat -> Bool)
-> (ReadFloat -> ReadFloat -> ReadFloat)
-> (ReadFloat -> ReadFloat -> ReadFloat)
-> Ord ReadFloat
ReadFloat -> ReadFloat -> Bool
ReadFloat -> ReadFloat -> Ordering
ReadFloat -> ReadFloat -> ReadFloat
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ReadFloat -> ReadFloat -> ReadFloat
$cmin :: ReadFloat -> ReadFloat -> ReadFloat
max :: ReadFloat -> ReadFloat -> ReadFloat
$cmax :: ReadFloat -> ReadFloat -> ReadFloat
>= :: ReadFloat -> ReadFloat -> Bool
$c>= :: ReadFloat -> ReadFloat -> Bool
> :: ReadFloat -> ReadFloat -> Bool
$c> :: ReadFloat -> ReadFloat -> Bool
<= :: ReadFloat -> ReadFloat -> Bool
$c<= :: ReadFloat -> ReadFloat -> Bool
< :: ReadFloat -> ReadFloat -> Bool
$c< :: ReadFloat -> ReadFloat -> Bool
compare :: ReadFloat -> ReadFloat -> Ordering
$ccompare :: ReadFloat -> ReadFloat -> Ordering
$cp1Ord :: Eq ReadFloat
Ord, (forall x. ReadFloat -> Rep ReadFloat x)
-> (forall x. Rep ReadFloat x -> ReadFloat) -> Generic ReadFloat
forall x. Rep ReadFloat x -> ReadFloat
forall x. ReadFloat -> Rep ReadFloat x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ReadFloat x -> ReadFloat
$cfrom :: forall x. ReadFloat -> Rep ReadFloat x
Generic, ReadFloat -> ()
(ReadFloat -> ()) -> NFData ReadFloat
forall a. (a -> ()) -> NFData a
rnf :: ReadFloat -> ()
$crnf :: ReadFloat -> ()
NFData)

-- | How to decode a value of target type @Double@.
-- This type controls how many bits are needed to be read from the encoded bytestring.
-- The number of bits can be different depending on differences between reader and writer schemas.
--
-- The rules are described in <https://avro.apache.org/docs/current/spec.html#Schema+Resolution>
data ReadDouble
  = DoubleFromInt     -- ^ Read @Int@ (32 bits) and cast it to @Double@ (Rule: int is promotable to long, float, or double)
  | DoubleFromFloat   -- ^ Read @Float@ (64 bits) and cast it to @Double@ (Rule: float is promotable to float or double)
  | DoubleFromLong    -- ^ Read @Long@ (64 bits) and cast it to @Double@ (Rule: long is promotable to float or double)
  | ReadDouble
  deriving (Int -> ReadDouble -> ShowS
[ReadDouble] -> ShowS
ReadDouble -> String
(Int -> ReadDouble -> ShowS)
-> (ReadDouble -> String)
-> ([ReadDouble] -> ShowS)
-> Show ReadDouble
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReadDouble] -> ShowS
$cshowList :: [ReadDouble] -> ShowS
show :: ReadDouble -> String
$cshow :: ReadDouble -> String
showsPrec :: Int -> ReadDouble -> ShowS
$cshowsPrec :: Int -> ReadDouble -> ShowS
Show, ReadDouble -> ReadDouble -> Bool
(ReadDouble -> ReadDouble -> Bool)
-> (ReadDouble -> ReadDouble -> Bool) -> Eq ReadDouble
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReadDouble -> ReadDouble -> Bool
$c/= :: ReadDouble -> ReadDouble -> Bool
== :: ReadDouble -> ReadDouble -> Bool
$c== :: ReadDouble -> ReadDouble -> Bool
Eq, Eq ReadDouble
Eq ReadDouble
-> (ReadDouble -> ReadDouble -> Ordering)
-> (ReadDouble -> ReadDouble -> Bool)
-> (ReadDouble -> ReadDouble -> Bool)
-> (ReadDouble -> ReadDouble -> Bool)
-> (ReadDouble -> ReadDouble -> Bool)
-> (ReadDouble -> ReadDouble -> ReadDouble)
-> (ReadDouble -> ReadDouble -> ReadDouble)
-> Ord ReadDouble
ReadDouble -> ReadDouble -> Bool
ReadDouble -> ReadDouble -> Ordering
ReadDouble -> ReadDouble -> ReadDouble
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ReadDouble -> ReadDouble -> ReadDouble
$cmin :: ReadDouble -> ReadDouble -> ReadDouble
max :: ReadDouble -> ReadDouble -> ReadDouble
$cmax :: ReadDouble -> ReadDouble -> ReadDouble
>= :: ReadDouble -> ReadDouble -> Bool
$c>= :: ReadDouble -> ReadDouble -> Bool
> :: ReadDouble -> ReadDouble -> Bool
$c> :: ReadDouble -> ReadDouble -> Bool
<= :: ReadDouble -> ReadDouble -> Bool
$c<= :: ReadDouble -> ReadDouble -> Bool
< :: ReadDouble -> ReadDouble -> Bool
$c< :: ReadDouble -> ReadDouble -> Bool
compare :: ReadDouble -> ReadDouble -> Ordering
$ccompare :: ReadDouble -> ReadDouble -> Ordering
$cp1Ord :: Eq ReadDouble
Ord, (forall x. ReadDouble -> Rep ReadDouble x)
-> (forall x. Rep ReadDouble x -> ReadDouble) -> Generic ReadDouble
forall x. Rep ReadDouble x -> ReadDouble
forall x. ReadDouble -> Rep ReadDouble x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ReadDouble x -> ReadDouble
$cfrom :: forall x. ReadDouble -> Rep ReadDouble x
Generic, ReadDouble -> ()
(ReadDouble -> ()) -> NFData ReadDouble
forall a. (a -> ()) -> NFData a
rnf :: ReadDouble -> ()
$crnf :: ReadDouble -> ()
NFData)

-- | This type represents a /deconflicted/ version of a 'Schema'.
-- Schema resolution is described in Avro specification: <https://avro.apache.org/docs/current/spec.html#Schema+Resolution>
--
-- This library represents "normal" schema and "deconflicted" schema as different types to avoid confusion
-- between these two usecases (we shouldn't serialise values with such schema) and to be able to accomodate
-- some extra information that links between how data is supposed transformed between what reader wants
-- and what writer has.
data ReadSchema
      =
      -- Basic types
        Null
      | Boolean
      | Int    { ReadSchema -> Maybe LogicalTypeInt
logicalTypeI :: Maybe LogicalTypeInt }
      | Long   { ReadSchema -> ReadLong
longReadFrom :: ReadLong, ReadSchema -> Maybe LogicalTypeLong
logicalTypeL :: Maybe LogicalTypeLong }
      | Float  { ReadSchema -> ReadFloat
floatReadFrom :: ReadFloat }
      | Double { ReadSchema -> ReadDouble
doubleReadFrom :: ReadDouble }
      | Bytes  { ReadSchema -> Maybe LogicalTypeBytes
logicalTypeB :: Maybe LogicalTypeBytes }
      | String { ReadSchema -> Maybe LogicalTypeString
logicalTypeS :: Maybe LogicalTypeString }
      | Array  { ReadSchema -> ReadSchema
item :: ReadSchema }
      | Map    { ReadSchema -> ReadSchema
values :: ReadSchema }
      | NamedType TypeName
      -- Declared types
      | Record { ReadSchema -> TypeName
name    :: TypeName
               , ReadSchema -> [TypeName]
aliases :: [TypeName]
               , ReadSchema -> Maybe Text
doc     :: Maybe Text
               , ReadSchema -> [ReadField]
fields  :: [ReadField]
               }
      | Enum { name    :: TypeName
             , aliases :: [TypeName]
             , doc     :: Maybe Text
             , ReadSchema -> Vector Text
symbols :: V.Vector Text
             }
      | Union { ReadSchema -> Vector (Int, ReadSchema)
options      :: V.Vector (Int, ReadSchema)
              -- ^ Order of values represents order in the writer schema, an index represents order in a reader schema
              }
      | Fixed { name         :: TypeName
              , aliases      :: [TypeName]
              , ReadSchema -> Int
size         :: Int
              , ReadSchema -> Maybe LogicalTypeFixed
logicalTypeF :: Maybe LogicalTypeFixed
              }
      | FreeUnion { ReadSchema -> Int
pos :: Int, ReadSchema -> ReadSchema
ty :: ReadSchema }
    deriving (ReadSchema -> ReadSchema -> Bool
(ReadSchema -> ReadSchema -> Bool)
-> (ReadSchema -> ReadSchema -> Bool) -> Eq ReadSchema
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReadSchema -> ReadSchema -> Bool
$c/= :: ReadSchema -> ReadSchema -> Bool
== :: ReadSchema -> ReadSchema -> Bool
$c== :: ReadSchema -> ReadSchema -> Bool
Eq, Int -> ReadSchema -> ShowS
[ReadSchema] -> ShowS
ReadSchema -> String
(Int -> ReadSchema -> ShowS)
-> (ReadSchema -> String)
-> ([ReadSchema] -> ShowS)
-> Show ReadSchema
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReadSchema] -> ShowS
$cshowList :: [ReadSchema] -> ShowS
show :: ReadSchema -> String
$cshow :: ReadSchema -> String
showsPrec :: Int -> ReadSchema -> ShowS
$cshowsPrec :: Int -> ReadSchema -> ShowS
Show, (forall x. ReadSchema -> Rep ReadSchema x)
-> (forall x. Rep ReadSchema x -> ReadSchema) -> Generic ReadSchema
forall x. Rep ReadSchema x -> ReadSchema
forall x. ReadSchema -> Rep ReadSchema x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ReadSchema x -> ReadSchema
$cfrom :: forall x. ReadSchema -> Rep ReadSchema x
Generic, ReadSchema -> ()
(ReadSchema -> ()) -> NFData ReadSchema
forall a. (a -> ()) -> NFData a
rnf :: ReadSchema -> ()
$crnf :: ReadSchema -> ()
NFData)

-- | Depending on differences between reader and writer schemas,
-- a record field can be found:
--
-- * Present in the reader schema but missing from the writer schema.
-- In this case the reader field is marked as 'Defaulted' with the
-- default value from the reader schema. An index value represents
-- the position of the field in the reader schema.
--
-- * Present in the writer schema but missing from the reader schema.
-- In this case the record field is marked as 'Ignored': the corresponding
-- bytes still need to be read from the payload (to advance the position in a bytestring),
-- but the result is discarded.
--
-- * Present in both reader and writer schemas.
-- In this case the field is marked to be read 'AsIs' with an index that
-- represents the field's position in the reader schema.
data FieldStatus
  = AsIs Int
  | Ignored
  | Defaulted Int S.DefaultValue
  deriving (Int -> FieldStatus -> ShowS
[FieldStatus] -> ShowS
FieldStatus -> String
(Int -> FieldStatus -> ShowS)
-> (FieldStatus -> String)
-> ([FieldStatus] -> ShowS)
-> Show FieldStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FieldStatus] -> ShowS
$cshowList :: [FieldStatus] -> ShowS
show :: FieldStatus -> String
$cshow :: FieldStatus -> String
showsPrec :: Int -> FieldStatus -> ShowS
$cshowsPrec :: Int -> FieldStatus -> ShowS
Show, FieldStatus -> FieldStatus -> Bool
(FieldStatus -> FieldStatus -> Bool)
-> (FieldStatus -> FieldStatus -> Bool) -> Eq FieldStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FieldStatus -> FieldStatus -> Bool
$c/= :: FieldStatus -> FieldStatus -> Bool
== :: FieldStatus -> FieldStatus -> Bool
$c== :: FieldStatus -> FieldStatus -> Bool
Eq, Eq FieldStatus
Eq FieldStatus
-> (FieldStatus -> FieldStatus -> Ordering)
-> (FieldStatus -> FieldStatus -> Bool)
-> (FieldStatus -> FieldStatus -> Bool)
-> (FieldStatus -> FieldStatus -> Bool)
-> (FieldStatus -> FieldStatus -> Bool)
-> (FieldStatus -> FieldStatus -> FieldStatus)
-> (FieldStatus -> FieldStatus -> FieldStatus)
-> Ord FieldStatus
FieldStatus -> FieldStatus -> Bool
FieldStatus -> FieldStatus -> Ordering
FieldStatus -> FieldStatus -> FieldStatus
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FieldStatus -> FieldStatus -> FieldStatus
$cmin :: FieldStatus -> FieldStatus -> FieldStatus
max :: FieldStatus -> FieldStatus -> FieldStatus
$cmax :: FieldStatus -> FieldStatus -> FieldStatus
>= :: FieldStatus -> FieldStatus -> Bool
$c>= :: FieldStatus -> FieldStatus -> Bool
> :: FieldStatus -> FieldStatus -> Bool
$c> :: FieldStatus -> FieldStatus -> Bool
<= :: FieldStatus -> FieldStatus -> Bool
$c<= :: FieldStatus -> FieldStatus -> Bool
< :: FieldStatus -> FieldStatus -> Bool
$c< :: FieldStatus -> FieldStatus -> Bool
compare :: FieldStatus -> FieldStatus -> Ordering
$ccompare :: FieldStatus -> FieldStatus -> Ordering
$cp1Ord :: Eq FieldStatus
Ord, (forall x. FieldStatus -> Rep FieldStatus x)
-> (forall x. Rep FieldStatus x -> FieldStatus)
-> Generic FieldStatus
forall x. Rep FieldStatus x -> FieldStatus
forall x. FieldStatus -> Rep FieldStatus x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FieldStatus x -> FieldStatus
$cfrom :: forall x. FieldStatus -> Rep FieldStatus x
Generic, FieldStatus -> ()
(FieldStatus -> ()) -> NFData FieldStatus
forall a. (a -> ()) -> NFData a
rnf :: FieldStatus -> ()
$crnf :: FieldStatus -> ()
NFData)

-- | Deconflicted record field.
data ReadField = ReadField
  { ReadField -> Text
fldName    :: Text
  , ReadField -> [Text]
fldAliases :: [Text]
  , ReadField -> Maybe Text
fldDoc     :: Maybe Text
  , ReadField -> Maybe Order
fldOrder   :: Maybe Order
  , ReadField -> FieldStatus
fldStatus  :: FieldStatus           -- ^ How the value of this field should be treated. See 'FieldStatus' documentation.
  , ReadField -> ReadSchema
fldType    :: ReadSchema
  , ReadField -> Maybe DefaultValue
fldDefault :: Maybe S.DefaultValue
  }
  deriving (ReadField -> ReadField -> Bool
(ReadField -> ReadField -> Bool)
-> (ReadField -> ReadField -> Bool) -> Eq ReadField
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReadField -> ReadField -> Bool
$c/= :: ReadField -> ReadField -> Bool
== :: ReadField -> ReadField -> Bool
$c== :: ReadField -> ReadField -> Bool
Eq, Int -> ReadField -> ShowS
[ReadField] -> ShowS
ReadField -> String
(Int -> ReadField -> ShowS)
-> (ReadField -> String)
-> ([ReadField] -> ShowS)
-> Show ReadField
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReadField] -> ShowS
$cshowList :: [ReadField] -> ShowS
show :: ReadField -> String
$cshow :: ReadField -> String
showsPrec :: Int -> ReadField -> ShowS
$cshowsPrec :: Int -> ReadField -> ShowS
Show, (forall x. ReadField -> Rep ReadField x)
-> (forall x. Rep ReadField x -> ReadField) -> Generic ReadField
forall x. Rep ReadField x -> ReadField
forall x. ReadField -> Rep ReadField x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ReadField x -> ReadField
$cfrom :: forall x. ReadField -> Rep ReadField x
Generic, ReadField -> ()
(ReadField -> ()) -> NFData ReadField
forall a. (a -> ()) -> NFData a
rnf :: ReadField -> ()
$crnf :: ReadField -> ()
NFData)

-- | Converts Avro Schema to ReaderSchema trivially.
-- This function is useful when no deconflicting is required.
fromSchema :: S.Schema -> ReadSchema
fromSchema :: Schema -> ReadSchema
fromSchema = \case
  Schema
S.Null        -> ReadSchema
Null
  Schema
S.Boolean     -> ReadSchema
Boolean
  S.Int Maybe LogicalTypeInt
l       -> Maybe LogicalTypeInt -> ReadSchema
Int Maybe LogicalTypeInt
l
  S.Long Maybe LogicalTypeLong
l      -> ReadLong -> Maybe LogicalTypeLong -> ReadSchema
Long ReadLong
ReadLong Maybe LogicalTypeLong
l
  Schema
S.Float       -> ReadFloat -> ReadSchema
Float ReadFloat
ReadFloat
  Schema
S.Double      -> ReadDouble -> ReadSchema
Double ReadDouble
ReadDouble
  S.Bytes Maybe LogicalTypeBytes
l     -> Maybe LogicalTypeBytes -> ReadSchema
Bytes Maybe LogicalTypeBytes
l
  S.String Maybe LogicalTypeString
l    -> Maybe LogicalTypeString -> ReadSchema
String Maybe LogicalTypeString
l
  S.Array Schema
vs    -> ReadSchema -> ReadSchema
Array (ReadSchema -> ReadSchema) -> ReadSchema -> ReadSchema
forall a b. (a -> b) -> a -> b
$ Schema -> ReadSchema
fromSchema Schema
vs
  S.Map Schema
vs      -> ReadSchema -> ReadSchema
Map (ReadSchema -> ReadSchema) -> ReadSchema -> ReadSchema
forall a b. (a -> b) -> a -> b
$ Schema -> ReadSchema
fromSchema Schema
vs
  S.NamedType TypeName
v -> TypeName -> ReadSchema
NamedType TypeName
v
  v :: Schema
v@S.Record{}  -> Record :: TypeName -> [TypeName] -> Maybe Text -> [ReadField] -> ReadSchema
Record
    { name :: TypeName
name    = Schema -> TypeName
S.name Schema
v
    , aliases :: [TypeName]
aliases = Schema -> [TypeName]
S.aliases Schema
v
    , doc :: Maybe Text
doc     = Schema -> Maybe Text
S.doc Schema
v
    , fields :: [ReadField]
fields  = (\(Int
i, Field
x) -> FieldStatus -> Field -> ReadField
fromField (Int -> FieldStatus
AsIs Int
i) Field
x) ((Int, Field) -> ReadField) -> [(Int, Field)] -> [ReadField]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int] -> [Field] -> [(Int, Field)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] (Schema -> [Field]
S.fields Schema
v)
    }
  v :: Schema
v@S.Enum{} -> Enum :: TypeName -> [TypeName] -> Maybe Text -> Vector Text -> ReadSchema
Enum
    { name :: TypeName
name    = Schema -> TypeName
S.name Schema
v
    , aliases :: [TypeName]
aliases = Schema -> [TypeName]
S.aliases Schema
v
    , doc :: Maybe Text
doc     = Schema -> Maybe Text
S.doc Schema
v
    , symbols :: Vector Text
symbols = Schema -> Vector Text
S.symbols Schema
v
    }
  S.Union Vector Schema
vs  -> Vector (Int, ReadSchema) -> ReadSchema
Union (Vector (Int, ReadSchema) -> ReadSchema)
-> (Vector ReadSchema -> Vector (Int, ReadSchema))
-> Vector ReadSchema
-> ReadSchema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector ReadSchema -> Vector (Int, ReadSchema)
forall a. Vector a -> Vector (Int, a)
V.indexed (Vector ReadSchema -> ReadSchema)
-> Vector ReadSchema -> ReadSchema
forall a b. (a -> b) -> a -> b
$ Schema -> ReadSchema
fromSchema (Schema -> ReadSchema) -> Vector Schema -> Vector ReadSchema
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector Schema
vs
  v :: Schema
v@S.Fixed{} -> Fixed :: TypeName
-> [TypeName] -> Int -> Maybe LogicalTypeFixed -> ReadSchema
Fixed
    { name :: TypeName
name          = Schema -> TypeName
S.name Schema
v
    , aliases :: [TypeName]
aliases       = Schema -> [TypeName]
S.aliases Schema
v
    , size :: Int
size          = Schema -> Int
S.size Schema
v
    , logicalTypeF :: Maybe LogicalTypeFixed
logicalTypeF  = Schema -> Maybe LogicalTypeFixed
S.logicalTypeF Schema
v
    }

fromField :: FieldStatus -> S.Field -> ReadField
fromField :: FieldStatus -> Field -> ReadField
fromField FieldStatus
s Field
v = ReadField :: Text
-> [Text]
-> Maybe Text
-> Maybe Order
-> FieldStatus
-> ReadSchema
-> Maybe DefaultValue
-> ReadField
ReadField
  { fldName :: Text
fldName     = Field -> Text
S.fldName Field
v
  , fldAliases :: [Text]
fldAliases  = Field -> [Text]
S.fldAliases Field
v
  , fldDoc :: Maybe Text
fldDoc      = Field -> Maybe Text
S.fldDoc Field
v
  , fldOrder :: Maybe Order
fldOrder    = Field -> Maybe Order
S.fldOrder Field
v
  , fldStatus :: FieldStatus
fldStatus   = FieldStatus
s
  , fldType :: ReadSchema
fldType     = Schema -> ReadSchema
fromSchema (Field -> Schema
S.fldType Field
v)
  , fldDefault :: Maybe DefaultValue
fldDefault  = Field -> Maybe DefaultValue
S.fldDefault Field
v
  }

-- | @extractBindings schema@ traverses a schema and builds a map of all declared
-- types.
--
-- Types declared implicitly in record field definitions are also included. No distinction
-- is made between aliases and normal names.
extractBindings :: ReadSchema -> HashMap.HashMap TypeName ReadSchema
extractBindings :: ReadSchema -> HashMap TypeName ReadSchema
extractBindings = \case
  t :: ReadSchema
t@Record{[TypeName]
[ReadField]
Maybe Text
TypeName
fields :: [ReadField]
doc :: Maybe Text
aliases :: [TypeName]
name :: TypeName
fields :: ReadSchema -> [ReadField]
doc :: ReadSchema -> Maybe Text
aliases :: ReadSchema -> [TypeName]
name :: ReadSchema -> TypeName
..} ->
    let withRecord :: HashMap TypeName ReadSchema
withRecord = [(TypeName, ReadSchema)] -> HashMap TypeName ReadSchema
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ([(TypeName, ReadSchema)] -> HashMap TypeName ReadSchema)
-> [(TypeName, ReadSchema)] -> HashMap TypeName ReadSchema
forall a b. (a -> b) -> a -> b
$ (TypeName
name TypeName -> [TypeName] -> [TypeName]
forall a. a -> [a] -> [a]
: [TypeName]
aliases) [TypeName] -> [ReadSchema] -> [(TypeName, ReadSchema)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` ReadSchema -> [ReadSchema]
forall a. a -> [a]
repeat ReadSchema
t
    in [HashMap TypeName ReadSchema] -> HashMap TypeName ReadSchema
forall k v. (Eq k, Hashable k) => [HashMap k v] -> HashMap k v
HashMap.unions ([HashMap TypeName ReadSchema] -> HashMap TypeName ReadSchema)
-> [HashMap TypeName ReadSchema] -> HashMap TypeName ReadSchema
forall a b. (a -> b) -> a -> b
$ HashMap TypeName ReadSchema
withRecord HashMap TypeName ReadSchema
-> [HashMap TypeName ReadSchema] -> [HashMap TypeName ReadSchema]
forall a. a -> [a] -> [a]
: (ReadSchema -> HashMap TypeName ReadSchema
extractBindings (ReadSchema -> HashMap TypeName ReadSchema)
-> (ReadField -> ReadSchema)
-> ReadField
-> HashMap TypeName ReadSchema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReadField -> ReadSchema
fldType (ReadField -> HashMap TypeName ReadSchema)
-> [ReadField] -> [HashMap TypeName ReadSchema]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ReadField]
fields)
  e :: ReadSchema
e@Enum{[TypeName]
Maybe Text
Vector Text
TypeName
symbols :: Vector Text
doc :: Maybe Text
aliases :: [TypeName]
name :: TypeName
symbols :: ReadSchema -> Vector Text
doc :: ReadSchema -> Maybe Text
aliases :: ReadSchema -> [TypeName]
name :: ReadSchema -> TypeName
..}   -> [(TypeName, ReadSchema)] -> HashMap TypeName ReadSchema
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ([(TypeName, ReadSchema)] -> HashMap TypeName ReadSchema)
-> [(TypeName, ReadSchema)] -> HashMap TypeName ReadSchema
forall a b. (a -> b) -> a -> b
$ (TypeName
name TypeName -> [TypeName] -> [TypeName]
forall a. a -> [a] -> [a]
: [TypeName]
aliases) [TypeName] -> [ReadSchema] -> [(TypeName, ReadSchema)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` ReadSchema -> [ReadSchema]
forall a. a -> [a]
repeat ReadSchema
e
  Union{Vector (Int, ReadSchema)
options :: Vector (Int, ReadSchema)
options :: ReadSchema -> Vector (Int, ReadSchema)
..}    -> [HashMap TypeName ReadSchema] -> HashMap TypeName ReadSchema
forall k v. (Eq k, Hashable k) => [HashMap k v] -> HashMap k v
HashMap.unions ([HashMap TypeName ReadSchema] -> HashMap TypeName ReadSchema)
-> [HashMap TypeName ReadSchema] -> HashMap TypeName ReadSchema
forall a b. (a -> b) -> a -> b
$ Vector (HashMap TypeName ReadSchema)
-> [HashMap TypeName ReadSchema]
forall a. Vector a -> [a]
V.toList (Vector (HashMap TypeName ReadSchema)
 -> [HashMap TypeName ReadSchema])
-> Vector (HashMap TypeName ReadSchema)
-> [HashMap TypeName ReadSchema]
forall a b. (a -> b) -> a -> b
$ ReadSchema -> HashMap TypeName ReadSchema
extractBindings (ReadSchema -> HashMap TypeName ReadSchema)
-> ((Int, ReadSchema) -> ReadSchema)
-> (Int, ReadSchema)
-> HashMap TypeName ReadSchema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, ReadSchema) -> ReadSchema
forall a b. (a, b) -> b
snd ((Int, ReadSchema) -> HashMap TypeName ReadSchema)
-> Vector (Int, ReadSchema) -> Vector (HashMap TypeName ReadSchema)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector (Int, ReadSchema)
options
  f :: ReadSchema
f@Fixed{Int
[TypeName]
Maybe LogicalTypeFixed
TypeName
logicalTypeF :: Maybe LogicalTypeFixed
size :: Int
aliases :: [TypeName]
name :: TypeName
logicalTypeF :: ReadSchema -> Maybe LogicalTypeFixed
size :: ReadSchema -> Int
aliases :: ReadSchema -> [TypeName]
name :: ReadSchema -> TypeName
..}  -> [(TypeName, ReadSchema)] -> HashMap TypeName ReadSchema
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ([(TypeName, ReadSchema)] -> HashMap TypeName ReadSchema)
-> [(TypeName, ReadSchema)] -> HashMap TypeName ReadSchema
forall a b. (a -> b) -> a -> b
$ (TypeName
name TypeName -> [TypeName] -> [TypeName]
forall a. a -> [a] -> [a]
: [TypeName]
aliases) [TypeName] -> [ReadSchema] -> [(TypeName, ReadSchema)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` ReadSchema -> [ReadSchema]
forall a. a -> [a]
repeat ReadSchema
f
  Array{ReadSchema
item :: ReadSchema
item :: ReadSchema -> ReadSchema
..}    -> ReadSchema -> HashMap TypeName ReadSchema
extractBindings ReadSchema
item
  Map{ReadSchema
values :: ReadSchema
values :: ReadSchema -> ReadSchema
..}      -> ReadSchema -> HashMap TypeName ReadSchema
extractBindings ReadSchema
values
  FreeUnion {Int
ReadSchema
ty :: ReadSchema
pos :: Int
ty :: ReadSchema -> ReadSchema
pos :: ReadSchema -> Int
..} -> ReadSchema -> HashMap TypeName ReadSchema
extractBindings ReadSchema
ty
  ReadSchema
_            -> HashMap TypeName ReadSchema
forall k v. HashMap k v
HashMap.empty