{-# LANGUAGE CPP                   #-}
{-# LANGUAGE DeriveAnyClass        #-}
{-# LANGUAGE DeriveGeneric         #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE LambdaCase            #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns        #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE PatternSynonyms       #-}
{-# LANGUAGE RecordWildCards       #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE StrictData            #-}
{-# LANGUAGE TupleSections         #-}
{-# LANGUAGE ViewPatterns          #-}
-- {-# LANGUAGE StrictData            #-}

-- | Avro 'Schema's, represented here as values of type 'Schema',
-- describe the serialization and de-serialization of values.
--
-- In Avro schemas are compose-able such that encoding data under a schema and
-- decoding with a variant, such as newer or older version of the original
-- schema, can be accomplished by using the 'Data.Avro.Deconflict' module.
module Data.Avro.Schema.Schema
  (
   -- * Schema description types
    Schema(.., Int', Long', Bytes', String')
  , DefaultValue(..)
  , Field(..), Order(..)
  , TypeName(..)
  , Decimal(..)
  , LogicalTypeBytes(..), LogicalTypeFixed(..)
  , LogicalTypeInt(..), LogicalTypeLong(..)
  , LogicalTypeString(..)
  , renderFullname
  , parseFullname
  , mkEnum, mkUnion
  , validateSchema
  -- * Lower level utilities
  , typeName
  , typeAliases
  , buildTypeEnvironment
  , extractBindings

  , Result(..)
  , badValue
  , resultToEither

  , matches

  , parseBytes
  , serializeBytes

  , parseAvroJSON

  , overlay
  , subdefinition
  , expandNamedTypes
  ) where

import           Control.Applicative
import           Control.DeepSeq            (NFData)
import           Control.Monad
import           Control.Monad.Except
import qualified Control.Monad.Fail         as MF
import           Control.Monad.State.Strict

import           Data.Aeson             (FromJSON (..), ToJSON (..), object, (.!=), (.:!), (.:), (.:?), (.=))
import qualified Data.Aeson             as A
import qualified Data.Aeson.Key         as A
import qualified Data.Aeson.KeyMap      as KM
import           Data.Aeson.Types       (Parser, typeMismatch)
import qualified Data.ByteString        as B
import qualified Data.ByteString.Base16 as Base16
import qualified Data.Char              as Char
import           Data.Function          (on)
import           Data.HashMap.Strict    (HashMap)
import qualified Data.HashMap.Strict    as HashMap
import           Data.Hashable
import           Data.Int
import qualified Data.IntMap            as IM
import qualified Data.List              as L
import           Data.List.NonEmpty     (NonEmpty (..))
import qualified Data.List.NonEmpty     as NE
import           Data.Maybe             (catMaybes, fromMaybe, isJust)
import           Data.Monoid            (First (..))
import           Data.Semigroup
import qualified Data.Set               as S
import           Data.String
import           Data.Text              (Text)
import qualified Data.Text              as T
import           Data.Text.Encoding     as T
import qualified Data.Vector            as V
import           Prelude                as P

import GHC.Generics (Generic)

{- HLINT ignore "Reduce duplication"  -}
{- HLINT ignore "Use &&"              -}

data DefaultValue
      = DNull
      | DBoolean !Bool
      | DInt Schema {-# UNPACK #-} Int32
      | DLong Schema {-# UNPACK #-} Int64
      | DFloat Schema {-# UNPACK #-} Float
      | DDouble Schema {-# UNPACK #-} Double
      | DBytes Schema {-# UNPACK #-} B.ByteString
      | DString Schema {-# UNPACK #-} Text
      | DArray (V.Vector DefaultValue)                   -- ^ Dynamically enforced monomorphic type.
      | DMap (HashMap Text DefaultValue)               -- ^ Dynamically enforced monomorphic type
      | DRecord Schema (HashMap Text DefaultValue) -- Order and a map
      | DUnion (V.Vector Schema) Schema DefaultValue -- ^ Set of union options, schema for selected option, and the actual value.
      | DFixed Schema {-# UNPACK #-} !B.ByteString
      | DEnum Schema {-# UNPACK #-} Int Text  -- ^ An enum is a set of the possible symbols (the schema) and the selected symbol
  deriving (DefaultValue -> DefaultValue -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DefaultValue -> DefaultValue -> Bool
$c/= :: DefaultValue -> DefaultValue -> Bool
== :: DefaultValue -> DefaultValue -> Bool
$c== :: DefaultValue -> DefaultValue -> Bool
Eq, Eq DefaultValue
DefaultValue -> DefaultValue -> Bool
DefaultValue -> DefaultValue -> Ordering
DefaultValue -> DefaultValue -> DefaultValue
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 :: DefaultValue -> DefaultValue -> DefaultValue
$cmin :: DefaultValue -> DefaultValue -> DefaultValue
max :: DefaultValue -> DefaultValue -> DefaultValue
$cmax :: DefaultValue -> DefaultValue -> DefaultValue
>= :: DefaultValue -> DefaultValue -> Bool
$c>= :: DefaultValue -> DefaultValue -> Bool
> :: DefaultValue -> DefaultValue -> Bool
$c> :: DefaultValue -> DefaultValue -> Bool
<= :: DefaultValue -> DefaultValue -> Bool
$c<= :: DefaultValue -> DefaultValue -> Bool
< :: DefaultValue -> DefaultValue -> Bool
$c< :: DefaultValue -> DefaultValue -> Bool
compare :: DefaultValue -> DefaultValue -> Ordering
$ccompare :: DefaultValue -> DefaultValue -> Ordering
Ord, Int -> DefaultValue -> ShowS
[DefaultValue] -> ShowS
DefaultValue -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DefaultValue] -> ShowS
$cshowList :: [DefaultValue] -> ShowS
show :: DefaultValue -> String
$cshow :: DefaultValue -> String
showsPrec :: Int -> DefaultValue -> ShowS
$cshowsPrec :: Int -> DefaultValue -> ShowS
Show, forall x. Rep DefaultValue x -> DefaultValue
forall x. DefaultValue -> Rep DefaultValue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DefaultValue x -> DefaultValue
$cfrom :: forall x. DefaultValue -> Rep DefaultValue x
Generic, DefaultValue -> ()
forall a. (a -> ()) -> NFData a
rnf :: DefaultValue -> ()
$crnf :: DefaultValue -> ()
NFData)

-- | N.B. It is possible to create a Haskell value (of 'Schema' type) that is
-- not a valid Avro schema by violating one of the above or one of the
-- conditions called out in 'validateSchema'.
data Schema
      =
      -- Basic types
        Null
      | Boolean
      | Int    { Schema -> Maybe LogicalTypeInt
logicalTypeI :: Maybe LogicalTypeInt }
      | Long   { Schema -> Maybe LogicalTypeLong
logicalTypeL :: Maybe LogicalTypeLong }
      | Float | Double
      | Bytes  { Schema -> Maybe LogicalTypeBytes
logicalTypeB :: Maybe LogicalTypeBytes }
      | String { Schema -> Maybe LogicalTypeString
logicalTypeS :: Maybe LogicalTypeString }
      | Array  { Schema -> Schema
item :: Schema }
      | Map    { Schema -> Schema
values :: Schema }
      | NamedType TypeName
      -- Declared types
      | Record { Schema -> TypeName
name    :: TypeName
               , Schema -> [TypeName]
aliases :: [TypeName]
               , Schema -> Maybe Text
doc     :: Maybe Text
               , Schema -> [Field]
fields  :: [Field]
               }
      | Enum { name    :: TypeName
             , aliases :: [TypeName]
             , doc     :: Maybe Text
             , Schema -> Vector Text
symbols :: V.Vector Text
             }
      | Union { Schema -> Vector Schema
options     :: V.Vector Schema
              }
      | Fixed { name         :: TypeName
              , aliases      :: [TypeName]
              , Schema -> Int
size         :: Int
              , Schema -> Maybe LogicalTypeFixed
logicalTypeF :: Maybe LogicalTypeFixed
              }
    deriving (Eq Schema
Schema -> Schema -> Bool
Schema -> Schema -> Ordering
Schema -> Schema -> Schema
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 :: Schema -> Schema -> Schema
$cmin :: Schema -> Schema -> Schema
max :: Schema -> Schema -> Schema
$cmax :: Schema -> Schema -> Schema
>= :: Schema -> Schema -> Bool
$c>= :: Schema -> Schema -> Bool
> :: Schema -> Schema -> Bool
$c> :: Schema -> Schema -> Bool
<= :: Schema -> Schema -> Bool
$c<= :: Schema -> Schema -> Bool
< :: Schema -> Schema -> Bool
$c< :: Schema -> Schema -> Bool
compare :: Schema -> Schema -> Ordering
$ccompare :: Schema -> Schema -> Ordering
Ord, Int -> Schema -> ShowS
[Schema] -> ShowS
Schema -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Schema] -> ShowS
$cshowList :: [Schema] -> ShowS
show :: Schema -> String
$cshow :: Schema -> String
showsPrec :: Int -> Schema -> ShowS
$cshowsPrec :: Int -> Schema -> ShowS
Show, forall x. Rep Schema x -> Schema
forall x. Schema -> Rep Schema x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Schema x -> Schema
$cfrom :: forall x. Schema -> Rep Schema x
Generic, Schema -> ()
forall a. (a -> ()) -> NFData a
rnf :: Schema -> ()
$crnf :: Schema -> ()
NFData)

pattern $bInt' :: Schema
$mInt' :: forall {r}. Schema -> ((# #) -> r) -> ((# #) -> r) -> r
Int'    = Int    Nothing
pattern $bLong' :: Schema
$mLong' :: forall {r}. Schema -> ((# #) -> r) -> ((# #) -> r) -> r
Long'   = Long   Nothing
pattern $bBytes' :: Schema
$mBytes' :: forall {r}. Schema -> ((# #) -> r) -> ((# #) -> r) -> r
Bytes'  = Bytes  Nothing
pattern $bString' :: Schema
$mString' :: forall {r}. Schema -> ((# #) -> r) -> ((# #) -> r) -> r
String' = String Nothing

data Field = Field { Field -> Text
fldName    :: Text
                   , Field -> [Text]
fldAliases :: [Text]
                   , Field -> Maybe Text
fldDoc     :: Maybe Text
                   , Field -> Maybe Order
fldOrder   :: Maybe Order
                   , Field -> Schema
fldType    :: Schema
                   , Field -> Maybe DefaultValue
fldDefault :: Maybe DefaultValue
                   }
  deriving (Field -> Field -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Field -> Field -> Bool
$c/= :: Field -> Field -> Bool
== :: Field -> Field -> Bool
$c== :: Field -> Field -> Bool
Eq, Eq Field
Field -> Field -> Bool
Field -> Field -> Ordering
Field -> Field -> Field
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 :: Field -> Field -> Field
$cmin :: Field -> Field -> Field
max :: Field -> Field -> Field
$cmax :: Field -> Field -> Field
>= :: Field -> Field -> Bool
$c>= :: Field -> Field -> Bool
> :: Field -> Field -> Bool
$c> :: Field -> Field -> Bool
<= :: Field -> Field -> Bool
$c<= :: Field -> Field -> Bool
< :: Field -> Field -> Bool
$c< :: Field -> Field -> Bool
compare :: Field -> Field -> Ordering
$ccompare :: Field -> Field -> Ordering
Ord, Int -> Field -> ShowS
[Field] -> ShowS
Field -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Field] -> ShowS
$cshowList :: [Field] -> ShowS
show :: Field -> String
$cshow :: Field -> String
showsPrec :: Int -> Field -> ShowS
$cshowsPrec :: Int -> Field -> ShowS
Show, forall x. Rep Field x -> Field
forall x. Field -> Rep Field x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Field x -> Field
$cfrom :: forall x. Field -> Rep Field x
Generic, Field -> ()
forall a. (a -> ()) -> NFData a
rnf :: Field -> ()
$crnf :: Field -> ()
NFData)

data Order = Ascending | Descending | Ignore
  deriving (Order -> Order -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Order -> Order -> Bool
$c/= :: Order -> Order -> Bool
== :: Order -> Order -> Bool
$c== :: Order -> Order -> Bool
Eq, Eq Order
Order -> Order -> Bool
Order -> Order -> Ordering
Order -> Order -> Order
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 :: Order -> Order -> Order
$cmin :: Order -> Order -> Order
max :: Order -> Order -> Order
$cmax :: Order -> Order -> Order
>= :: Order -> Order -> Bool
$c>= :: Order -> Order -> Bool
> :: Order -> Order -> Bool
$c> :: Order -> Order -> Bool
<= :: Order -> Order -> Bool
$c<= :: Order -> Order -> Bool
< :: Order -> Order -> Bool
$c< :: Order -> Order -> Bool
compare :: Order -> Order -> Ordering
$ccompare :: Order -> Order -> Ordering
Ord, Int -> Order -> ShowS
[Order] -> ShowS
Order -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Order] -> ShowS
$cshowList :: [Order] -> ShowS
show :: Order -> String
$cshow :: Order -> String
showsPrec :: Int -> Order -> ShowS
$cshowsPrec :: Int -> Order -> ShowS
Show, forall x. Rep Order x -> Order
forall x. Order -> Rep Order x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Order x -> Order
$cfrom :: forall x. Order -> Rep Order x
Generic, Order -> ()
forall a. (a -> ()) -> NFData a
rnf :: Order -> ()
$crnf :: Order -> ()
NFData)

-- ** Logical Types

-- $ In addition to primitive types, Avro supports [**logical
-- types**](https://avro.apache.org/docs/current/spec.html#Logical+Types). A
-- logical type is represented the same way as a primitive type, but
-- has an extra annotation in the Avro schema that Avro libraries can
-- use to generate more specific types.
--
-- Example:
--
-- @
-- {
--   "type": "int",
--   "logicalType": "date"
-- }
-- @
--
-- The @date@ logical type represents a calendar date with no
-- timezone. It is encoded as an Avro @int@ with the number of days
-- from the Unix epoch (1970-01-01). Avro implementations /may/ parse
-- this type into a language-specific date type (eg 'Data.Time.Day' in
-- Haskell), but could also treat it as a normal Avro @int@ instead.

newtype LogicalTypeBytes
  = DecimalB Decimal
    -- ^ An arbitrary-precision signed decimal number. See 'Decimal'.
  deriving (LogicalTypeBytes -> LogicalTypeBytes -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LogicalTypeBytes -> LogicalTypeBytes -> Bool
$c/= :: LogicalTypeBytes -> LogicalTypeBytes -> Bool
== :: LogicalTypeBytes -> LogicalTypeBytes -> Bool
$c== :: LogicalTypeBytes -> LogicalTypeBytes -> Bool
Eq, Int -> LogicalTypeBytes -> ShowS
[LogicalTypeBytes] -> ShowS
LogicalTypeBytes -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LogicalTypeBytes] -> ShowS
$cshowList :: [LogicalTypeBytes] -> ShowS
show :: LogicalTypeBytes -> String
$cshow :: LogicalTypeBytes -> String
showsPrec :: Int -> LogicalTypeBytes -> ShowS
$cshowsPrec :: Int -> LogicalTypeBytes -> ShowS
Show, Eq LogicalTypeBytes
LogicalTypeBytes -> LogicalTypeBytes -> Bool
LogicalTypeBytes -> LogicalTypeBytes -> Ordering
LogicalTypeBytes -> LogicalTypeBytes -> LogicalTypeBytes
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 :: LogicalTypeBytes -> LogicalTypeBytes -> LogicalTypeBytes
$cmin :: LogicalTypeBytes -> LogicalTypeBytes -> LogicalTypeBytes
max :: LogicalTypeBytes -> LogicalTypeBytes -> LogicalTypeBytes
$cmax :: LogicalTypeBytes -> LogicalTypeBytes -> LogicalTypeBytes
>= :: LogicalTypeBytes -> LogicalTypeBytes -> Bool
$c>= :: LogicalTypeBytes -> LogicalTypeBytes -> Bool
> :: LogicalTypeBytes -> LogicalTypeBytes -> Bool
$c> :: LogicalTypeBytes -> LogicalTypeBytes -> Bool
<= :: LogicalTypeBytes -> LogicalTypeBytes -> Bool
$c<= :: LogicalTypeBytes -> LogicalTypeBytes -> Bool
< :: LogicalTypeBytes -> LogicalTypeBytes -> Bool
$c< :: LogicalTypeBytes -> LogicalTypeBytes -> Bool
compare :: LogicalTypeBytes -> LogicalTypeBytes -> Ordering
$ccompare :: LogicalTypeBytes -> LogicalTypeBytes -> Ordering
Ord, forall x. Rep LogicalTypeBytes x -> LogicalTypeBytes
forall x. LogicalTypeBytes -> Rep LogicalTypeBytes x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LogicalTypeBytes x -> LogicalTypeBytes
$cfrom :: forall x. LogicalTypeBytes -> Rep LogicalTypeBytes x
Generic, LogicalTypeBytes -> ()
forall a. (a -> ()) -> NFData a
rnf :: LogicalTypeBytes -> ()
$crnf :: LogicalTypeBytes -> ()
NFData)

data LogicalTypeFixed
  = DecimalF Decimal
    -- ^ An arbitrary-precision signed decimal number. See 'Decimal'.
  | Duration
    -- ^ An interval of time, represented as some number of months,
    -- days and milliseconds.
    --
    -- Encoded as three little-endian unsigned integers for months,
    -- days and milliseconds respectively.
  deriving (LogicalTypeFixed -> LogicalTypeFixed -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LogicalTypeFixed -> LogicalTypeFixed -> Bool
$c/= :: LogicalTypeFixed -> LogicalTypeFixed -> Bool
== :: LogicalTypeFixed -> LogicalTypeFixed -> Bool
$c== :: LogicalTypeFixed -> LogicalTypeFixed -> Bool
Eq, Int -> LogicalTypeFixed -> ShowS
[LogicalTypeFixed] -> ShowS
LogicalTypeFixed -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LogicalTypeFixed] -> ShowS
$cshowList :: [LogicalTypeFixed] -> ShowS
show :: LogicalTypeFixed -> String
$cshow :: LogicalTypeFixed -> String
showsPrec :: Int -> LogicalTypeFixed -> ShowS
$cshowsPrec :: Int -> LogicalTypeFixed -> ShowS
Show, Eq LogicalTypeFixed
LogicalTypeFixed -> LogicalTypeFixed -> Bool
LogicalTypeFixed -> LogicalTypeFixed -> Ordering
LogicalTypeFixed -> LogicalTypeFixed -> LogicalTypeFixed
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 :: LogicalTypeFixed -> LogicalTypeFixed -> LogicalTypeFixed
$cmin :: LogicalTypeFixed -> LogicalTypeFixed -> LogicalTypeFixed
max :: LogicalTypeFixed -> LogicalTypeFixed -> LogicalTypeFixed
$cmax :: LogicalTypeFixed -> LogicalTypeFixed -> LogicalTypeFixed
>= :: LogicalTypeFixed -> LogicalTypeFixed -> Bool
$c>= :: LogicalTypeFixed -> LogicalTypeFixed -> Bool
> :: LogicalTypeFixed -> LogicalTypeFixed -> Bool
$c> :: LogicalTypeFixed -> LogicalTypeFixed -> Bool
<= :: LogicalTypeFixed -> LogicalTypeFixed -> Bool
$c<= :: LogicalTypeFixed -> LogicalTypeFixed -> Bool
< :: LogicalTypeFixed -> LogicalTypeFixed -> Bool
$c< :: LogicalTypeFixed -> LogicalTypeFixed -> Bool
compare :: LogicalTypeFixed -> LogicalTypeFixed -> Ordering
$ccompare :: LogicalTypeFixed -> LogicalTypeFixed -> Ordering
Ord, forall x. Rep LogicalTypeFixed x -> LogicalTypeFixed
forall x. LogicalTypeFixed -> Rep LogicalTypeFixed x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LogicalTypeFixed x -> LogicalTypeFixed
$cfrom :: forall x. LogicalTypeFixed -> Rep LogicalTypeFixed x
Generic, LogicalTypeFixed -> ()
forall a. (a -> ()) -> NFData a
rnf :: LogicalTypeFixed -> ()
$crnf :: LogicalTypeFixed -> ()
NFData)

data LogicalTypeInt
  = DecimalI Decimal
    -- ^ An arbitrary-precision signed decimal number. See 'Decimal'.
  | Date
    -- ^ A date (eg @2020-01-10@) with no timezone/locale.
    --
    -- Encoded as the number of days before/after the Unix epoch
    -- (1970-01-01).
  | TimeMillis
    -- ^ A time of day with millisecond precision.
    --
    -- Encoded as the number of milliseconds after midnight.
  deriving (LogicalTypeInt -> LogicalTypeInt -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LogicalTypeInt -> LogicalTypeInt -> Bool
$c/= :: LogicalTypeInt -> LogicalTypeInt -> Bool
== :: LogicalTypeInt -> LogicalTypeInt -> Bool
$c== :: LogicalTypeInt -> LogicalTypeInt -> Bool
Eq, Int -> LogicalTypeInt -> ShowS
[LogicalTypeInt] -> ShowS
LogicalTypeInt -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LogicalTypeInt] -> ShowS
$cshowList :: [LogicalTypeInt] -> ShowS
show :: LogicalTypeInt -> String
$cshow :: LogicalTypeInt -> String
showsPrec :: Int -> LogicalTypeInt -> ShowS
$cshowsPrec :: Int -> LogicalTypeInt -> ShowS
Show, Eq LogicalTypeInt
LogicalTypeInt -> LogicalTypeInt -> Bool
LogicalTypeInt -> LogicalTypeInt -> Ordering
LogicalTypeInt -> LogicalTypeInt -> LogicalTypeInt
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 :: LogicalTypeInt -> LogicalTypeInt -> LogicalTypeInt
$cmin :: LogicalTypeInt -> LogicalTypeInt -> LogicalTypeInt
max :: LogicalTypeInt -> LogicalTypeInt -> LogicalTypeInt
$cmax :: LogicalTypeInt -> LogicalTypeInt -> LogicalTypeInt
>= :: LogicalTypeInt -> LogicalTypeInt -> Bool
$c>= :: LogicalTypeInt -> LogicalTypeInt -> Bool
> :: LogicalTypeInt -> LogicalTypeInt -> Bool
$c> :: LogicalTypeInt -> LogicalTypeInt -> Bool
<= :: LogicalTypeInt -> LogicalTypeInt -> Bool
$c<= :: LogicalTypeInt -> LogicalTypeInt -> Bool
< :: LogicalTypeInt -> LogicalTypeInt -> Bool
$c< :: LogicalTypeInt -> LogicalTypeInt -> Bool
compare :: LogicalTypeInt -> LogicalTypeInt -> Ordering
$ccompare :: LogicalTypeInt -> LogicalTypeInt -> Ordering
Ord, forall x. Rep LogicalTypeInt x -> LogicalTypeInt
forall x. LogicalTypeInt -> Rep LogicalTypeInt x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LogicalTypeInt x -> LogicalTypeInt
$cfrom :: forall x. LogicalTypeInt -> Rep LogicalTypeInt x
Generic, LogicalTypeInt -> ()
forall a. (a -> ()) -> NFData a
rnf :: LogicalTypeInt -> ()
$crnf :: LogicalTypeInt -> ()
NFData)

data LogicalTypeLong
  = DecimalL Decimal
    -- ^ An arbitrary-precision signed decimal number. See 'Decimal'.
  | TimeMicros
    -- ^ A time of day with microsecond precision.
    --
    -- Encoded as the number of microseconds after midnight.
  | TimestampMillis
    -- ^ A UTC timestamp with millisecond precision.
    --
    -- Encoded as the number of milliseconds before/after the Unix
    -- epoch (1970-01-01 00:00:00.000).
  | TimestampMicros
    -- ^ A UTC timestamp with microsecond precision.
    --
    -- Encoded as the number of microseconds before/after the Unix
    -- epoch (1970-01-01 00:00:00.000000).
  | LocalTimestampMillis
    -- ^ A timestamp in the local timezone, whatever that happens to
    -- be, with millisecond precision.
    --
    -- Encoded as the number of milliseconds before/after the Unix
    -- epoch (1970-01-01 00:00:00.000).
  | LocalTimestampMicros
    -- ^ A timestamp in the local timezone, whatever that happens to
    -- be, with microsecond precision.
    --
    -- Encoded as the number of microseconds before/after the Unix
    -- epoch (1970-01-01 00:00:00.000000).
  deriving (LogicalTypeLong -> LogicalTypeLong -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LogicalTypeLong -> LogicalTypeLong -> Bool
$c/= :: LogicalTypeLong -> LogicalTypeLong -> Bool
== :: LogicalTypeLong -> LogicalTypeLong -> Bool
$c== :: LogicalTypeLong -> LogicalTypeLong -> Bool
Eq, Int -> LogicalTypeLong -> ShowS
[LogicalTypeLong] -> ShowS
LogicalTypeLong -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LogicalTypeLong] -> ShowS
$cshowList :: [LogicalTypeLong] -> ShowS
show :: LogicalTypeLong -> String
$cshow :: LogicalTypeLong -> String
showsPrec :: Int -> LogicalTypeLong -> ShowS
$cshowsPrec :: Int -> LogicalTypeLong -> ShowS
Show, Eq LogicalTypeLong
LogicalTypeLong -> LogicalTypeLong -> Bool
LogicalTypeLong -> LogicalTypeLong -> Ordering
LogicalTypeLong -> LogicalTypeLong -> LogicalTypeLong
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 :: LogicalTypeLong -> LogicalTypeLong -> LogicalTypeLong
$cmin :: LogicalTypeLong -> LogicalTypeLong -> LogicalTypeLong
max :: LogicalTypeLong -> LogicalTypeLong -> LogicalTypeLong
$cmax :: LogicalTypeLong -> LogicalTypeLong -> LogicalTypeLong
>= :: LogicalTypeLong -> LogicalTypeLong -> Bool
$c>= :: LogicalTypeLong -> LogicalTypeLong -> Bool
> :: LogicalTypeLong -> LogicalTypeLong -> Bool
$c> :: LogicalTypeLong -> LogicalTypeLong -> Bool
<= :: LogicalTypeLong -> LogicalTypeLong -> Bool
$c<= :: LogicalTypeLong -> LogicalTypeLong -> Bool
< :: LogicalTypeLong -> LogicalTypeLong -> Bool
$c< :: LogicalTypeLong -> LogicalTypeLong -> Bool
compare :: LogicalTypeLong -> LogicalTypeLong -> Ordering
$ccompare :: LogicalTypeLong -> LogicalTypeLong -> Ordering
Ord, forall x. Rep LogicalTypeLong x -> LogicalTypeLong
forall x. LogicalTypeLong -> Rep LogicalTypeLong x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LogicalTypeLong x -> LogicalTypeLong
$cfrom :: forall x. LogicalTypeLong -> Rep LogicalTypeLong x
Generic, LogicalTypeLong -> ()
forall a. (a -> ()) -> NFData a
rnf :: LogicalTypeLong -> ()
$crnf :: LogicalTypeLong -> ()
NFData)

data LogicalTypeString
  = UUID
    -- ^ A Universally Unique Identifier (UUID).
    --
    -- Encoded as a string that is valid according to [RFC
    -- 4122](https://www.ietf.org/rfc/rfc4122.txt).
  deriving (LogicalTypeString -> LogicalTypeString -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LogicalTypeString -> LogicalTypeString -> Bool
$c/= :: LogicalTypeString -> LogicalTypeString -> Bool
== :: LogicalTypeString -> LogicalTypeString -> Bool
$c== :: LogicalTypeString -> LogicalTypeString -> Bool
Eq, Int -> LogicalTypeString -> ShowS
[LogicalTypeString] -> ShowS
LogicalTypeString -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LogicalTypeString] -> ShowS
$cshowList :: [LogicalTypeString] -> ShowS
show :: LogicalTypeString -> String
$cshow :: LogicalTypeString -> String
showsPrec :: Int -> LogicalTypeString -> ShowS
$cshowsPrec :: Int -> LogicalTypeString -> ShowS
Show, Eq LogicalTypeString
LogicalTypeString -> LogicalTypeString -> Bool
LogicalTypeString -> LogicalTypeString -> Ordering
LogicalTypeString -> LogicalTypeString -> LogicalTypeString
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 :: LogicalTypeString -> LogicalTypeString -> LogicalTypeString
$cmin :: LogicalTypeString -> LogicalTypeString -> LogicalTypeString
max :: LogicalTypeString -> LogicalTypeString -> LogicalTypeString
$cmax :: LogicalTypeString -> LogicalTypeString -> LogicalTypeString
>= :: LogicalTypeString -> LogicalTypeString -> Bool
$c>= :: LogicalTypeString -> LogicalTypeString -> Bool
> :: LogicalTypeString -> LogicalTypeString -> Bool
$c> :: LogicalTypeString -> LogicalTypeString -> Bool
<= :: LogicalTypeString -> LogicalTypeString -> Bool
$c<= :: LogicalTypeString -> LogicalTypeString -> Bool
< :: LogicalTypeString -> LogicalTypeString -> Bool
$c< :: LogicalTypeString -> LogicalTypeString -> Bool
compare :: LogicalTypeString -> LogicalTypeString -> Ordering
$ccompare :: LogicalTypeString -> LogicalTypeString -> Ordering
Ord, forall x. Rep LogicalTypeString x -> LogicalTypeString
forall x. LogicalTypeString -> Rep LogicalTypeString x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LogicalTypeString x -> LogicalTypeString
$cfrom :: forall x. LogicalTypeString -> Rep LogicalTypeString x
Generic, LogicalTypeString -> ()
forall a. (a -> ()) -> NFData a
rnf :: LogicalTypeString -> ()
$crnf :: LogicalTypeString -> ()
NFData)

-- | The @decimal@ logical type represents arbitrary-precision decimal
-- numbers. Numbers are represented as @unscaled * (10 ** -scale)@
-- where @scale@ is part of the logical type and @unscaled@ is an
-- integer represented by the underlying primitive type.
--
-- Instances of the @decimal@ logical type need to specify a @scale@
-- and @precision@.
--
-- @decimal@ can be encoded as one of several different primitive
-- types:
--
--  * @bytes@
--  * @fixed@
--  * @long@
--  * @int@
--
-- For @long@ and @int@, @unscaled@ is the underlying number.
--
-- For @bytes@ and @fixed@, @unscaled@ is represented as a
-- two's-complement signed integer in big-endian byte order.
--
-- Note: @int@ and @long@ representations for @decimal@ are not part
-- of the [current Avro
-- specification](https://avro.apache.org/docs/current/spec.html#Decimal),
-- but they are supported by some language implementations including
-- the official Java library. Implementations that do not support this
-- should ignore the logical type and use the underlying primitive
-- type instead.
data Decimal
  = Decimal { Decimal -> Integer
precision :: Integer
              -- ^ The maximum number of digits that can be
              -- represented by this @decimal@ type.
              --
              -- @precision > 0@
            , Decimal -> Integer
scale     :: Integer
              -- ^ The @scale@ in @unscaled * (10 ** -scale)@ for this
              -- type.
              --
              -- @0 ≤ scale ≤ precision@
            }
  deriving (Decimal -> Decimal -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Decimal -> Decimal -> Bool
$c/= :: Decimal -> Decimal -> Bool
== :: Decimal -> Decimal -> Bool
$c== :: Decimal -> Decimal -> Bool
Eq, Int -> Decimal -> ShowS
[Decimal] -> ShowS
Decimal -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Decimal] -> ShowS
$cshowList :: [Decimal] -> ShowS
show :: Decimal -> String
$cshow :: Decimal -> String
showsPrec :: Int -> Decimal -> ShowS
$cshowsPrec :: Int -> Decimal -> ShowS
Show, Eq Decimal
Decimal -> Decimal -> Bool
Decimal -> Decimal -> Ordering
Decimal -> Decimal -> Decimal
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 :: Decimal -> Decimal -> Decimal
$cmin :: Decimal -> Decimal -> Decimal
max :: Decimal -> Decimal -> Decimal
$cmax :: Decimal -> Decimal -> Decimal
>= :: Decimal -> Decimal -> Bool
$c>= :: Decimal -> Decimal -> Bool
> :: Decimal -> Decimal -> Bool
$c> :: Decimal -> Decimal -> Bool
<= :: Decimal -> Decimal -> Bool
$c<= :: Decimal -> Decimal -> Bool
< :: Decimal -> Decimal -> Bool
$c< :: Decimal -> Decimal -> Bool
compare :: Decimal -> Decimal -> Ordering
$ccompare :: Decimal -> Decimal -> Ordering
Ord, forall x. Rep Decimal x -> Decimal
forall x. Decimal -> Rep Decimal x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Decimal x -> Decimal
$cfrom :: forall x. Decimal -> Rep Decimal x
Generic, Decimal -> ()
forall a. (a -> ()) -> NFData a
rnf :: Decimal -> ()
$crnf :: Decimal -> ()
NFData)

instance Eq Schema where
  Schema
Null == :: Schema -> Schema -> Bool
== Schema
Null = Bool
True
  Schema
Boolean == Schema
Boolean = Bool
True
  Int Maybe LogicalTypeInt
lt1 == Int Maybe LogicalTypeInt
lt2 = Maybe LogicalTypeInt
lt1 forall a. Eq a => a -> a -> Bool
== Maybe LogicalTypeInt
lt2
  Long Maybe LogicalTypeLong
lt1 == Long Maybe LogicalTypeLong
lt2 = Maybe LogicalTypeLong
lt1 forall a. Eq a => a -> a -> Bool
== Maybe LogicalTypeLong
lt2
  Schema
Float == Schema
Float = Bool
True
  Schema
Double == Schema
Double = Bool
True
  Bytes Maybe LogicalTypeBytes
lt1 == Bytes Maybe LogicalTypeBytes
lt2 = Maybe LogicalTypeBytes
lt1 forall a. Eq a => a -> a -> Bool
== Maybe LogicalTypeBytes
lt2
  String Maybe LogicalTypeString
lt1 == String Maybe LogicalTypeString
lt2 = Maybe LogicalTypeString
lt1 forall a. Eq a => a -> a -> Bool
== Maybe LogicalTypeString
lt2

  Array Schema
ty == Array Schema
ty2 = Schema
ty forall a. Eq a => a -> a -> Bool
== Schema
ty2
  Map Schema
ty == Map Schema
ty2 = Schema
ty forall a. Eq a => a -> a -> Bool
== Schema
ty2
  NamedType TypeName
t == NamedType TypeName
t2 = TypeName
t forall a. Eq a => a -> a -> Bool
== TypeName
t2

  Record TypeName
name1 [TypeName]
_ Maybe Text
_ [Field]
fs1 == Record TypeName
name2 [TypeName]
_ Maybe Text
_ [Field]
fs2 =
    (TypeName
name1 forall a. Eq a => a -> a -> Bool
== TypeName
name2) Bool -> Bool -> Bool
&& ([Field]
fs1 forall a. Eq a => a -> a -> Bool
== [Field]
fs2)
  Enum TypeName
name1 [TypeName]
_ Maybe Text
_ Vector Text
s == Enum TypeName
name2 [TypeName]
_ Maybe Text
_ Vector Text
s2 =
    (TypeName
name1 forall a. Eq a => a -> a -> Bool
== TypeName
name2) Bool -> Bool -> Bool
&& (Vector Text
s forall a. Eq a => a -> a -> Bool
== Vector Text
s2)
  Union Vector Schema
a == Union Vector Schema
b = Vector Schema
a forall a. Eq a => a -> a -> Bool
== Vector Schema
b
  Fixed TypeName
name1 [TypeName]
_ Int
s Maybe LogicalTypeFixed
lt1 == Fixed TypeName
name2 [TypeName]
_ Int
s2 Maybe LogicalTypeFixed
lt2 =
    (TypeName
name1 forall a. Eq a => a -> a -> Bool
== TypeName
name2) Bool -> Bool -> Bool
&& (Int
s forall a. Eq a => a -> a -> Bool
== Int
s2) Bool -> Bool -> Bool
&& (Maybe LogicalTypeFixed
lt1 forall a. Eq a => a -> a -> Bool
== Maybe LogicalTypeFixed
lt2)

  Schema
_ == Schema
_ = Bool
False

-- | Build an 'Enum' value from its components.
mkEnum :: TypeName
          -- ^ The name of the enum (includes namespace).
       -> [TypeName]
          -- ^ Aliases for the enum (if any).
       -> Maybe Text
          -- ^ Optional documentation for the enum.
       -> [Text]
          -- ^ The symbols of the enum.
       -> Schema
mkEnum :: TypeName -> [TypeName] -> Maybe Text -> [Text] -> Schema
mkEnum TypeName
name [TypeName]
aliases Maybe Text
doc [Text]
symbols = TypeName -> [TypeName] -> Maybe Text -> Vector Text -> Schema
Enum TypeName
name [TypeName]
aliases Maybe Text
doc (forall a. [a] -> Vector a
V.fromList [Text]
symbols)

-- | @mkUnion subTypes@ Defines a union of the provided subTypes.  N.B. it is
-- invalid Avro to include another union or to have more than one of the same
-- type as a direct member of the union.  No check is done for this condition!
mkUnion :: NonEmpty Schema -> Schema
mkUnion :: NonEmpty Schema -> Schema
mkUnion  = Vector Schema -> Schema
Union forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Vector a
V.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmpty a -> [a]
NE.toList

-- | A named type in Avro has a name and, optionally, a namespace.
--
-- A name is a string that starts with an ASCII letter or underscore
-- followed by letters, underscores and digits:
--
-- @
-- name ::= [A-Za-z_][A-Za-z0-9_]*
-- @
--
-- Examples include @"_foo7"@, @"Bar_"@ and @"x"@.
--
-- A namespace is a sequence of names with the same lexical
-- structure. When written as a string, the components of a namespace
-- are separated with dots (@"com.example"@).
--
-- 'TypeName' represents a /fullname/—a name combined with a
-- namespace. These are written and parsed as dot-separated
-- strings. The 'TypeName' @TN "Foo" ["com", "example"]@ is rendered
-- as @"com.example.Foo"@.
--
-- Fullnames have to be globally unique inside an Avro schema.
--
-- A namespace of @[]@ or @[""]@ is the "null namespace". In avro
-- an explicitly null-namespaced identifier is written as ".Foo"
data TypeName = TN { TypeName -> Text
baseName  :: T.Text
                   , TypeName -> [Text]
namespace :: [T.Text]
                   }
  deriving (TypeName -> TypeName -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TypeName -> TypeName -> Bool
$c/= :: TypeName -> TypeName -> Bool
== :: TypeName -> TypeName -> Bool
$c== :: TypeName -> TypeName -> Bool
Eq, Eq TypeName
TypeName -> TypeName -> Bool
TypeName -> TypeName -> Ordering
TypeName -> TypeName -> TypeName
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 :: TypeName -> TypeName -> TypeName
$cmin :: TypeName -> TypeName -> TypeName
max :: TypeName -> TypeName -> TypeName
$cmax :: TypeName -> TypeName -> TypeName
>= :: TypeName -> TypeName -> Bool
$c>= :: TypeName -> TypeName -> Bool
> :: TypeName -> TypeName -> Bool
$c> :: TypeName -> TypeName -> Bool
<= :: TypeName -> TypeName -> Bool
$c<= :: TypeName -> TypeName -> Bool
< :: TypeName -> TypeName -> Bool
$c< :: TypeName -> TypeName -> Bool
compare :: TypeName -> TypeName -> Ordering
$ccompare :: TypeName -> TypeName -> Ordering
Ord, forall x. Rep TypeName x -> TypeName
forall x. TypeName -> Rep TypeName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TypeName x -> TypeName
$cfrom :: forall x. TypeName -> Rep TypeName x
Generic, TypeName -> ()
forall a. (a -> ()) -> NFData a
rnf :: TypeName -> ()
$crnf :: TypeName -> ()
NFData)

-- | Show the 'TypeName' as a string literal compatible with its
-- 'IsString' instance.
instance Show TypeName where
  show :: TypeName -> String
show = forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeName -> Text
renderFullname

-- | Render a fullname as a dot separated string.
--
-- @
-- > renderFullname (TN "Foo" ["com", "example"])
-- "com.example.Foo"
-- @
--
-- @
-- > renderFullname (TN "Foo" [])
-- ".Foo"
-- @
renderFullname :: TypeName -> T.Text
renderFullname :: TypeName -> Text
renderFullname TN { Text
baseName :: Text
baseName :: TypeName -> Text
baseName, [Text]
namespace :: [Text]
namespace :: TypeName -> [Text]
namespace } =
  Text -> [Text] -> Text
T.intercalate Text
"." forall a b. (a -> b) -> a -> b
$ [Text]
namespace forall a. [a] -> [a] -> [a]
++ [Text
baseName]

-- | Parses a fullname into a 'TypeName', assuming the string
-- representation is valid.
--
-- @
-- > parseFullname "com.example.Foo"
-- TN { baseName = "Foo", components = ["com", "example"] }
-- @
parseFullname :: T.Text -> TypeName
parseFullname :: Text -> TypeName
parseFullname (Text -> Text -> [Text]
T.splitOn Text
"." -> [Text]
components) = TN { Text
baseName :: Text
baseName :: Text
baseName, [Text]
namespace :: [Text]
namespace :: [Text]
namespace }
  where
    baseName :: Text
baseName  = forall a. [a] -> a
last [Text]
components
    namespace :: [Text]
namespace = forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= Text
"") (forall a. [a] -> [a]
init [Text]
components)

-- | Build a type name out of the @name@ and @namespace@ fields of an
-- Avro record, enum or fixed definition.
--
-- This follows the rules laid out in the Avro specification:
--
--  1. If the @"name"@ field contains dots, it is parsed as a
--  /fullname/ (see 'parseFullname') and the @"namespace"@ field is
--  ignored if present.
--
--  2. Otherwise, if both @"name"@ and @"namespace"@ fields are
--  present, they make up the /fullname/
--
--  3. If only the @"name"@ field is specified, the @"namespace"@ is
--  inferred from the namespace of the most tightly enclosing schema
--  or protocol (the "context"). If there is no containing schema, the
--  namespace is null.
mkTypeName :: Maybe TypeName
              -- ^ The name of the enclosing schema or protocol, if
              -- any. This provides the context for inferring
              -- namespaces.
           -> Text
              -- ^ The @"name"@ field of the definition.
           -> Maybe Text
              -- ^ The @"namespace"@ field of the definition, if
              -- present.
           -> TypeName
              -- ^ The resulting /fullname/ of the generated type,
              -- according to the rules laid out above.
mkTypeName :: Maybe TypeName -> Text -> Maybe Text -> TypeName
mkTypeName Maybe TypeName
context Text
name Maybe Text
ns
  | Text -> Bool
isFullName Text
name = Text -> TypeName
parseFullname Text
name
  | Bool
otherwise       = case Maybe Text
ns of
      Just Text
ns -> Text -> [Text] -> TypeName
TN Text
name forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= Text
"") (Text -> Text -> [Text]
T.splitOn Text
"." Text
ns)
      Maybe Text
Nothing -> Text -> [Text] -> TypeName
TN Text
name forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] TypeName -> [Text]
namespace Maybe TypeName
context
  where isFullName :: Text -> Bool
isFullName = forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Maybe Char
T.find (forall a. Eq a => a -> a -> Bool
== Char
'.')

-- | This lets us write 'TypeName's as string literals in a fully
-- qualified style. @"com.example.foo"@ is the name @"foo"@ with the
-- namespace @"com.example"@; @"foo"@ is the name @"foo"@ with no
-- namespace.
instance IsString TypeName where
  fromString :: String -> TypeName
fromString = Text -> TypeName
parseFullname forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => String -> a
fromString

instance Hashable TypeName where
  hashWithSalt :: Int -> TypeName -> Int
hashWithSalt Int
s (TypeName -> Text
renderFullname -> Text
name) =
    forall a. Hashable a => Int -> a -> Int
hashWithSalt (forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s (Text
"AvroTypeName" :: Text)) Text
name

-- |Get the name of the type.  In the case of unions, get the name of the
-- first value in the union schema.
typeName :: Schema -> Text
typeName :: Schema -> Text
typeName Schema
bt =
  case Schema
bt of
    Schema
Null            -> Text
"null"
    Schema
Boolean         -> Text
"boolean"
    Int Maybe LogicalTypeInt
Nothing     -> Text
"int"
    Int (Just (DecimalI Decimal
d))
                    -> Decimal -> Text
decimalName Decimal
d
    Int (Just LogicalTypeInt
Date) -> Text
"date"
    Int (Just LogicalTypeInt
TimeMillis)
                    -> Text
"time-millis"
    Long Maybe LogicalTypeLong
Nothing    -> Text
"long"
    Long (Just (DecimalL Decimal
d))
                    -> Decimal -> Text
decimalName Decimal
d
    Long (Just LogicalTypeLong
TimeMicros)
                    -> Text
"time-micros"
    Long (Just LogicalTypeLong
TimestampMillis)
                    -> Text
"timestamp-millis"
    Long (Just LogicalTypeLong
TimestampMicros)
                    -> Text
"timestamp-micros"
    Long (Just LogicalTypeLong
LocalTimestampMillis)
                    -> Text
"local-timestamp-millis"
    Long (Just LogicalTypeLong
LocalTimestampMicros)
                    -> Text
"local-timestamp-micros"
    Schema
Float           -> Text
"float"
    Schema
Double          -> Text
"double"
    Bytes Maybe LogicalTypeBytes
Nothing   -> Text
"bytes"
    Bytes (Just (DecimalB Decimal
d))
                    -> Decimal -> Text
decimalName Decimal
d
    String Maybe LogicalTypeString
Nothing  -> Text
"string"
    String (Just LogicalTypeString
UUID)
                    -> Text
"uuid"
    Array Schema
_         -> Text
"array"
    Map   Schema
_         -> Text
"map"
    NamedType TypeName
name  -> TypeName -> Text
renderFullname TypeName
name
    Union Vector Schema
ts        -> Schema -> Text
typeName (forall a. Vector a -> a
V.head Vector Schema
ts)
    Fixed TypeName
_ [TypeName]
_ Int
_ (Just (DecimalF Decimal
d))
                    -> Decimal -> Text
decimalName Decimal
d
    Fixed TypeName
_ [TypeName]
_ Int
_ (Just LogicalTypeFixed
Duration)
                    -> Text
"duration"
    Schema
_               -> TypeName -> Text
renderFullname forall a b. (a -> b) -> a -> b
$ Schema -> TypeName
name Schema
bt
  where
    decimalName :: Decimal -> Text
decimalName (Decimal Integer
prec Integer
sc) = Text
"decimal(" forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (forall a. Show a => a -> String
show Integer
prec) forall a. Semigroup a => a -> a -> a
<> Text
"," forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (forall a. Show a => a -> String
show Integer
sc) forall a. Semigroup a => a -> a -> a
<> Text
")"

-- |Get the aliases of the type.
typeAliases :: Schema -> [TypeName]
typeAliases :: Schema -> [TypeName]
typeAliases Schema
bt =
  case Schema
bt of
    Record { [TypeName]
aliases :: [TypeName]
aliases :: Schema -> [TypeName]
aliases } -> [TypeName]
aliases
    Enum { [TypeName]
aliases :: [TypeName]
aliases :: Schema -> [TypeName]
aliases} -> [TypeName]
aliases
    Fixed { [TypeName]
aliases :: [TypeName]
aliases :: Schema -> [TypeName]
aliases } -> [TypeName]
aliases
    Schema
_ -> []

instance FromJSON Schema where
  parseJSON :: Value -> Parser Schema
parseJSON = Maybe TypeName -> Value -> Parser Schema
parseSchemaJSON forall a. Maybe a
Nothing

-- | A helper function that parses an Avro schema from JSON, resolving
-- namespaces based on context.
--
-- See 'mkTypeName' for details on how namespaces are resolved.
parseSchemaJSON :: Maybe TypeName
                -- ^ The name of the enclosing type of this schema, if
                -- any. Used to resolve namespaces.
                -> A.Value
                -- ^ An Avro schema encoded in JSON.
                -> Parser Schema
parseSchemaJSON :: Maybe TypeName -> Value -> Parser Schema
parseSchemaJSON Maybe TypeName
context = \case
  A.String Text
s -> case Text
s of
    Text
"null"                   -> forall (m :: * -> *) a. Monad m => a -> m a
return Schema
Null
    Text
"boolean"                -> forall (m :: * -> *) a. Monad m => a -> m a
return Schema
Boolean
    Text
"int"                    -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Maybe LogicalTypeInt -> Schema
Int forall a. Maybe a
Nothing
    Text
"long"                   -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Maybe LogicalTypeLong -> Schema
Long forall a. Maybe a
Nothing
    Text
"float"                  -> forall (m :: * -> *) a. Monad m => a -> m a
return Schema
Float
    Text
"double"                 -> forall (m :: * -> *) a. Monad m => a -> m a
return Schema
Double
    Text
"bytes"                  -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Maybe LogicalTypeBytes -> Schema
Bytes forall a. Maybe a
Nothing
    Text
"string"                 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Maybe LogicalTypeString -> Schema
String forall a. Maybe a
Nothing
    Text
"uuid"                   -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Maybe LogicalTypeString -> Schema
String (forall a. a -> Maybe a
Just LogicalTypeString
UUID)
    Text
"date"                   -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Maybe LogicalTypeInt -> Schema
Int (forall a. a -> Maybe a
Just LogicalTypeInt
Date)
    Text
"time-millis"            -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Maybe LogicalTypeInt -> Schema
Int (forall a. a -> Maybe a
Just LogicalTypeInt
TimeMillis)
    Text
"time-micros"            -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Maybe LogicalTypeLong -> Schema
Long (forall a. a -> Maybe a
Just LogicalTypeLong
TimeMicros)
    Text
"timestamp-millis"       -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Maybe LogicalTypeLong -> Schema
Long (forall a. a -> Maybe a
Just LogicalTypeLong
TimestampMillis)
    Text
"timestamp-micros"       -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Maybe LogicalTypeLong -> Schema
Long (forall a. a -> Maybe a
Just LogicalTypeLong
TimestampMicros)
    Text
"local-timestamp-millis" -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Maybe LogicalTypeLong -> Schema
Long (forall a. a -> Maybe a
Just LogicalTypeLong
LocalTimestampMillis)
    Text
"local-timestamp-micros" -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Maybe LogicalTypeLong -> Schema
Long (forall a. a -> Maybe a
Just LogicalTypeLong
LocalTimestampMicros)
    Text
somename                 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ TypeName -> Schema
NamedType forall a b. (a -> b) -> a -> b
$ Maybe TypeName -> Text -> Maybe Text -> TypeName
mkTypeName Maybe TypeName
context Text
somename forall a. Maybe a
Nothing
  A.Array Vector Value
arr
    | forall a. Vector a -> Int
V.length Vector Value
arr forall a. Ord a => a -> a -> Bool
> Int
0 ->
      Vector Schema -> Schema
Union forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Vector a -> m (Vector b)
V.mapM (Maybe TypeName -> Value -> Parser Schema
parseSchemaJSON Maybe TypeName
context) Vector Value
arr
    | Bool
otherwise        -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unions must have at least one type."
  A.Object Object
o -> do
    Maybe Text
logicalType :: Maybe Text <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"logicalType"
    Text
ty                        <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"

    case Maybe Text
logicalType of
      Just Text
"decimal" -> do
        Integer
prec <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"precision"
        Integer
sc   <- forall a. a -> Maybe a -> a
fromMaybe Integer
0 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"scale"
        let dec :: Decimal
dec = Integer -> Integer -> Decimal
Decimal Integer
prec Integer
sc
        case Text
ty of
          Text
"bytes" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Maybe LogicalTypeBytes -> Schema
Bytes (forall a. a -> Maybe a
Just (Decimal -> LogicalTypeBytes
DecimalB Decimal
dec))
          Text
"fixed" -> (\Schema
fx -> Schema
fx { logicalTypeF :: Maybe LogicalTypeFixed
logicalTypeF = forall a. a -> Maybe a
Just (Decimal -> LogicalTypeFixed
DecimalF Decimal
dec) }) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Parser Schema
parseFixed Object
o
          Text
"int"   -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Maybe LogicalTypeInt -> Schema
Int (forall a. a -> Maybe a
Just (Decimal -> LogicalTypeInt
DecimalI Decimal
dec))
          Text
"long"  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Maybe LogicalTypeLong -> Schema
Long (forall a. a -> Maybe a
Just (Decimal -> LogicalTypeLong
DecimalL Decimal
dec))
          Text
s       -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Unsupported underlying type: " forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
s
      Just Text
"uuid" -> case Text
ty of
          Text
"string" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Maybe LogicalTypeString -> Schema
String (forall a. a -> Maybe a
Just LogicalTypeString
UUID)
          Text
s        -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Unsupported underlying type: " forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
s
      Just Text
"date" -> case Text
ty of
          Text
"int" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Maybe LogicalTypeInt -> Schema
Int (forall a. a -> Maybe a
Just LogicalTypeInt
Date)
          Text
s     -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Unsupported underlying type: " forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
s
      Just Text
"time-millis" -> case Text
ty of
          Text
"int" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Maybe LogicalTypeInt -> Schema
Int (forall a. a -> Maybe a
Just LogicalTypeInt
TimeMillis)
          Text
s     -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Unsupported underlying type: " forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
s
      Just Text
"time-micros" -> case Text
ty of
          Text
"long" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Maybe LogicalTypeLong -> Schema
Long (forall a. a -> Maybe a
Just LogicalTypeLong
TimeMicros)
          Text
s      -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Unsupported underlying type: " forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
s
      Just Text
"timestamp-millis" -> case Text
ty of
          Text
"long" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Maybe LogicalTypeLong -> Schema
Long (forall a. a -> Maybe a
Just LogicalTypeLong
TimestampMillis)
          Text
s      -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Unsupported underlying type: " forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
s
      Just Text
"timestamp-micros" -> case Text
ty of
          Text
"long" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Maybe LogicalTypeLong -> Schema
Long (forall a. a -> Maybe a
Just LogicalTypeLong
TimestampMicros)
          Text
s      -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Unsupported underlying type: " forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
s
      Just Text
"local-timestamp-millis" -> case Text
ty of
          Text
"long" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Maybe LogicalTypeLong -> Schema
Long (forall a. a -> Maybe a
Just LogicalTypeLong
LocalTimestampMillis)
          Text
s      -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Unsupported underlying type: " forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
s
      Just Text
"local-timestamp-micros" -> case Text
ty of
          Text
"long" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Maybe LogicalTypeLong -> Schema
Long (forall a. a -> Maybe a
Just LogicalTypeLong
LocalTimestampMicros)
          Text
s      -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Unsupported underlying type: " forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
s
      Just Text
"duration" -> case Text
ty of
          Text
"fixed" -> (\Schema
fx -> Schema
fx { logicalTypeF :: Maybe LogicalTypeFixed
logicalTypeF = forall a. a -> Maybe a
Just LogicalTypeFixed
Duration }) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Parser Schema
parseFixed Object
o
          Text
s       -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Unsupported underlying type: " forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
s
      Just Text
_  -> forall a. FromJSON a => Value -> Parser a
parseJSON (Text -> Value
A.String Text
ty)
      Maybe Text
Nothing -> case Text
ty of
        Text
"map"    -> Schema -> Schema
Map forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Maybe TypeName -> Value -> Parser Schema
parseSchemaJSON Maybe TypeName
context forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"values")
        Text
"array"  -> Schema -> Schema
Array forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Maybe TypeName -> Value -> Parser Schema
parseSchemaJSON Maybe TypeName
context forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"items")
        Text
"record" -> do
          Text
name      <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
          Maybe Text
namespace <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"namespace"
          let typeName :: TypeName
typeName = Maybe TypeName -> Text -> Maybe Text -> TypeName
mkTypeName Maybe TypeName
context Text
name Maybe Text
namespace
              mkAlias :: Text -> TypeName
mkAlias Text
name = Maybe TypeName -> Text -> Maybe Text -> TypeName
mkTypeName (forall a. a -> Maybe a
Just TypeName
typeName) Text
name forall a. Maybe a
Nothing
          [TypeName]
aliases <- TypeName -> [Text] -> [TypeName]
mkAliases TypeName
typeName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"aliases" forall a. Parser (Maybe a) -> a -> Parser a
.!= [])
          Maybe Text
doc     <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"doc"
          [Field]
fields  <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (TypeName -> Value -> Parser Field
parseField TypeName
typeName) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"fields")
          forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ TypeName -> [TypeName] -> Maybe Text -> [Field] -> Schema
Record TypeName
typeName [TypeName]
aliases Maybe Text
doc [Field]
fields
        Text
"enum"   -> do
          Text
name      <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
          Maybe Text
namespace <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"namespace"
          let typeName :: TypeName
typeName = Maybe TypeName -> Text -> Maybe Text -> TypeName
mkTypeName Maybe TypeName
context Text
name Maybe Text
namespace
              mkAlias :: Text -> TypeName
mkAlias Text
name = Maybe TypeName -> Text -> Maybe Text -> TypeName
mkTypeName (forall a. a -> Maybe a
Just TypeName
typeName) Text
name forall a. Maybe a
Nothing
          [TypeName]
aliases <- TypeName -> [Text] -> [TypeName]
mkAliases TypeName
typeName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"aliases" forall a. Parser (Maybe a) -> a -> Parser a
.!= [])
          Maybe Text
doc     <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"doc"
          [Text]
symbols <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"symbols"
          forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ TypeName -> [TypeName] -> Maybe Text -> [Text] -> Schema
mkEnum TypeName
typeName [TypeName]
aliases Maybe Text
doc [Text]
symbols
        Text
"fixed"   -> Object -> Parser Schema
parseFixed Object
o
        Text
"null"    -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Schema
Null
        Text
"boolean" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Schema
Boolean
        Text
"int"     -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Maybe LogicalTypeInt -> Schema
Int forall a. Maybe a
Nothing
        Text
"long"    -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Maybe LogicalTypeLong -> Schema
Long forall a. Maybe a
Nothing
        Text
"float"   -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Schema
Float
        Text
"double"  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Schema
Double
        Text
"bytes"   -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Maybe LogicalTypeBytes -> Schema
Bytes forall a. Maybe a
Nothing
        Text
"string"  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Maybe LogicalTypeString -> Schema
String forall a. Maybe a
Nothing
        Text
s        -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Unrecognized object type: " forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
s

  Value
invalid    -> forall a. String -> Value -> Parser a
typeMismatch String
"Invalid JSON for Avro Schema" Value
invalid

  where
    parseFixed :: Object -> Parser Schema
parseFixed Object
o = do
      Text
name      <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
      Maybe Text
namespace <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"namespace"
      let typeName :: TypeName
typeName = Maybe TypeName -> Text -> Maybe Text -> TypeName
mkTypeName Maybe TypeName
context Text
name Maybe Text
namespace
          mkAlias :: Text -> TypeName
mkAlias Text
name = Maybe TypeName -> Text -> Maybe Text -> TypeName
mkTypeName (forall a. a -> Maybe a
Just TypeName
typeName) Text
name forall a. Maybe a
Nothing
      [TypeName]
aliases <- TypeName -> [Text] -> [TypeName]
mkAliases TypeName
typeName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"aliases" forall a. Parser (Maybe a) -> a -> Parser a
.!= [])
      Int
size    <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"size"
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ TypeName -> [TypeName] -> Int -> Maybe LogicalTypeFixed -> Schema
Fixed TypeName
typeName [TypeName]
aliases Int
size forall a. Maybe a
Nothing

-- | Parse aliases, inferring the namespace based on the type being aliases.
mkAliases :: TypeName
             -- ^ The name of the type being aliased.
          -> [Text]
             -- ^ The aliases.
          -> [TypeName]
mkAliases :: TypeName -> [Text] -> [TypeName]
mkAliases TypeName
context = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a -> b) -> a -> b
$ \ Text
name ->
  Maybe TypeName -> Text -> Maybe Text -> TypeName
mkTypeName (forall a. a -> Maybe a
Just TypeName
context) Text
name forall a. Maybe a
Nothing

-- | A helper function that parses field definitions, using the name
-- of the record for namespace resolution (see 'mkTypeName' for more
-- details).
parseField :: TypeName
              -- ^ The name of the record this field belongs to.
           -> A.Value
              -- ^ The JSON object defining the field in the schema.
           -> Parser Field
parseField :: TypeName -> Value -> Parser Field
parseField TypeName
record = \case
  A.Object Object
o -> do
    Text
name  <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
    Maybe Text
doc   <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"doc"
    Schema
ty    <- Maybe TypeName -> Value -> Parser Schema
parseSchemaJSON (forall a. a -> Maybe a
Just TypeName
record) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
    let err :: a
err = forall a. HasCallStack => String -> a
error String
"Haskell Avro bindings does not support default for aliased or recursive types at this time."
    Maybe Value
defM  <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:! Key
"default"
    Maybe DefaultValue
def   <- case (TypeName -> Maybe Schema)
-> Schema -> Value -> Result DefaultValue
parseFieldDefault forall {a}. a
err Schema
ty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Value
defM of
      Just (Success DefaultValue
x) -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just DefaultValue
x)
      Just (Error String
e)   -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
e
      Maybe (Result DefaultValue)
Nothing          -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
    Maybe Order
order <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"order" forall a. Parser (Maybe a) -> a -> Parser a
.!= forall a. a -> Maybe a
Just Order
Ascending

    let mkAlias :: Text -> TypeName
mkAlias Text
name = Maybe TypeName -> Text -> Maybe Text -> TypeName
mkTypeName (forall a. a -> Maybe a
Just TypeName
record) Text
name forall a. Maybe a
Nothing
    [Text]
aliases  <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"aliases"  forall a. Parser (Maybe a) -> a -> Parser a
.!= []
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text
-> [Text]
-> Maybe Text
-> Maybe Order
-> Schema
-> Maybe DefaultValue
-> Field
Field Text
name [Text]
aliases Maybe Text
doc Maybe Order
order Schema
ty Maybe DefaultValue
def
  Value
invalid    -> forall a. String -> Value -> Parser a
typeMismatch String
"Field" Value
invalid

instance ToJSON Schema where
  toJSON :: Schema -> Value
toJSON = Maybe TypeName -> Schema -> Value
schemaToJSON forall a. Maybe a
Nothing

-- | Serializes a 'Schema' to JSON.
--
-- The optional name is used as the context for namespace
-- inference. If the context has the namespace @com.example@, then any
-- names in the @com.example@ namespace will be rendered without an
-- explicit namespace.
schemaToJSON :: Maybe TypeName
                -- ^ The context used for keeping track of namespace
                -- inference.
             -> Schema
                -- ^ The schema to serialize to JSON.
             -> A.Value
schemaToJSON :: Maybe TypeName -> Schema -> Value
schemaToJSON Maybe TypeName
context = \case
  Schema
Null            -> Text -> Value
A.String Text
"null"
  Schema
Boolean         -> Text -> Value
A.String Text
"boolean"
  Int Maybe LogicalTypeInt
Nothing     -> Text -> Value
A.String Text
"int"
  Int (Just (DecimalI (Decimal Integer
prec Integer
sc))) ->
    [Pair] -> Value
object [ Key
"type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"int" :: Text), Key
"logicalType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"decimal" :: Text)
           , Key
"precision" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Integer
prec, Key
"scale" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Integer
sc ]
  Int (Just LogicalTypeInt
Date) ->
    [Pair] -> Value
object [ Key
"type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"int" :: Text), Key
"logicalType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"date" :: Text) ]
  Int (Just LogicalTypeInt
TimeMillis) ->
    [Pair] -> Value
object [ Key
"type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"int" :: Text), Key
"logicalType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"time-millis" :: Text) ]
  Long Maybe LogicalTypeLong
Nothing    -> Text -> Value
A.String Text
"long"
  Long (Just (DecimalL (Decimal Integer
prec Integer
sc))) ->
    [Pair] -> Value
object [ Key
"type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"long" :: Text), Key
"logicalType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"decimal" :: Text)
           , Key
"precision" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Integer
prec, Key
"scale" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Integer
sc ]
  Long (Just LogicalTypeLong
TimeMicros) ->
    [Pair] -> Value
object [ Key
"type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"long" :: Text), Key
"logicalType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"time-micros" :: Text) ]
  Long (Just LogicalTypeLong
TimestampMillis) ->
    [Pair] -> Value
object [ Key
"type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"long" :: Text), Key
"logicalType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"timestamp-millis" :: Text) ]
  Long (Just LogicalTypeLong
TimestampMicros) ->
    [Pair] -> Value
object [ Key
"type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"long" :: Text), Key
"logicalType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"timestamp-micros" :: Text) ]
  Long (Just LogicalTypeLong
LocalTimestampMillis) ->
    [Pair] -> Value
object [ Key
"type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"long" :: Text), Key
"logicalType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"local-timestamp-millis" :: Text) ]
  Long (Just LogicalTypeLong
LocalTimestampMicros) ->
    [Pair] -> Value
object [ Key
"type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"long" :: Text), Key
"logicalType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"local-timestamp-micros" :: Text) ]
  Schema
Float           -> Text -> Value
A.String Text
"float"
  Schema
Double          -> Text -> Value
A.String Text
"double"
  Bytes Maybe LogicalTypeBytes
Nothing   -> Text -> Value
A.String Text
"bytes"
  Bytes (Just (DecimalB (Decimal Integer
prec Integer
sc))) ->
    [Pair] -> Value
object [ Key
"type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"bytes" :: Text), Key
"logicalType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"decimal" :: Text)
           , Key
"precision" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Integer
prec, Key
"scale" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Integer
sc ]
  String Maybe LogicalTypeString
Nothing  -> Text -> Value
A.String Text
"string"
  String (Just LogicalTypeString
UUID) ->
    [Pair] -> Value
object [ Key
"type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"string" :: Text), Key
"logicalType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"uuid" :: Text) ]
  Array Schema
tn        ->
    [Pair] -> Value
object [ Key
"type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"array" :: Text), Key
"items" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe TypeName -> Schema -> Value
schemaToJSON Maybe TypeName
context Schema
tn ]
  Map Schema
tn          ->
    [Pair] -> Value
object [ Key
"type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"map" :: Text), Key
"values" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe TypeName -> Schema -> Value
schemaToJSON Maybe TypeName
context Schema
tn ]
  NamedType TypeName
name  -> forall a. ToJSON a => a -> Value
toJSON forall a b. (a -> b) -> a -> b
$ Maybe TypeName -> TypeName -> Text
render Maybe TypeName
context TypeName
name
  Record {[TypeName]
[Field]
Maybe Text
TypeName
fields :: [Field]
doc :: Maybe Text
aliases :: [TypeName]
name :: TypeName
fields :: Schema -> [Field]
doc :: Schema -> Maybe Text
aliases :: Schema -> [TypeName]
name :: Schema -> TypeName
..}     ->
    let opts :: [Pair]
opts = forall a. [Maybe a] -> [a]
catMaybes
          [ (Key
"doc" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=)   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
doc
          ]
    in [Pair] -> Value
object forall a b. (a -> b) -> a -> b
$ [Pair]
opts forall a. [a] -> [a] -> [a]
++
       [ Key
"type"    forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"record" :: Text)
       , Key
"name"    forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe TypeName -> TypeName -> Text
render Maybe TypeName
context TypeName
name
       , Key
"aliases" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Maybe TypeName -> TypeName -> Text
render (forall a. a -> Maybe a
Just TypeName
name) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TypeName]
aliases)
       , Key
"fields"  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (TypeName -> Field -> Value
fieldToJSON TypeName
name forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Field]
fields)
       ]
  Enum   {[TypeName]
Maybe Text
Vector Text
TypeName
symbols :: Vector Text
doc :: Maybe Text
aliases :: [TypeName]
name :: TypeName
symbols :: Schema -> Vector Text
doc :: Schema -> Maybe Text
aliases :: Schema -> [TypeName]
name :: Schema -> TypeName
..} ->
    let opts :: [Pair]
opts = forall a. [Maybe a] -> [a]
catMaybes [(Key
"doc" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
doc]
    in [Pair] -> Value
object forall a b. (a -> b) -> a -> b
$ [Pair]
opts forall a. [a] -> [a] -> [a]
++
       [ Key
"type"    forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"enum" :: Text)
       , Key
"name"    forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe TypeName -> TypeName -> Text
render Maybe TypeName
context TypeName
name
       , Key
"aliases" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Maybe TypeName -> TypeName -> Text
render (forall a. a -> Maybe a
Just TypeName
name) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TypeName]
aliases)
       , Key
"symbols" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Vector Text
symbols
       ]
  Union  {Vector Schema
options :: Vector Schema
options :: Schema -> Vector Schema
..} -> forall a. ToJSON a => a -> Value
toJSON forall a b. (a -> b) -> a -> b
$ Maybe TypeName -> Schema -> Value
schemaToJSON Maybe TypeName
context forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector Schema
options
  Fixed  {Int
[TypeName]
Maybe LogicalTypeFixed
TypeName
logicalTypeF :: Maybe LogicalTypeFixed
size :: Int
aliases :: [TypeName]
name :: TypeName
logicalTypeF :: Schema -> Maybe LogicalTypeFixed
size :: Schema -> Int
aliases :: Schema -> [TypeName]
name :: Schema -> TypeName
..} ->
    let basic :: [Pair]
basic =
           [ Key
"type"    forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"fixed" :: Text)
           , Key
"name"    forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe TypeName -> TypeName -> Text
render Maybe TypeName
context TypeName
name
           , Key
"aliases" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Maybe TypeName -> TypeName -> Text
render (forall a. a -> Maybe a
Just TypeName
name) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TypeName]
aliases)
           , Key
"size"    forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
size
           ]
        extended :: [Pair]
extended = case Maybe LogicalTypeFixed
logicalTypeF of
          Maybe LogicalTypeFixed
Nothing       -> []
          Just LogicalTypeFixed
Duration -> [ Key
"logicalType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"duration" :: Text) ]
          Just (DecimalF (Decimal Integer
prec Integer
sc))
                   -> [ Key
"logicalType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"decimal" :: Text)
                      , Key
"precision" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Integer
prec, Key
"scale" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Integer
sc ]
    in [Pair] -> Value
object ([Pair]
basic forall a. [a] -> [a] -> [a]
++ [Pair]
extended)
  where render :: Maybe TypeName -> TypeName -> Text
render Maybe TypeName
context TypeName
typeName
          | Just TypeName
ctx <- Maybe TypeName
context
          , TypeName -> [Text]
namespace TypeName
ctx forall a. Eq a => a -> a -> Bool
== TypeName -> [Text]
namespace TypeName
typeName = TypeName -> Text
baseName TypeName
typeName
          | Bool
otherwise                           = TypeName -> Text
renderFullname TypeName
typeName

        fieldToJSON :: TypeName -> Field -> Value
fieldToJSON TypeName
context Field {[Text]
Maybe Text
Maybe Order
Maybe DefaultValue
Text
Schema
fldDefault :: Maybe DefaultValue
fldType :: Schema
fldOrder :: Maybe Order
fldDoc :: Maybe Text
fldAliases :: [Text]
fldName :: Text
fldDefault :: Field -> Maybe DefaultValue
fldType :: Field -> Schema
fldOrder :: Field -> Maybe Order
fldDoc :: Field -> Maybe Text
fldAliases :: Field -> [Text]
fldName :: Field -> Text
..} =
          let opts :: [Pair]
opts = forall a. [Maybe a] -> [a]
catMaybes
                [ (Key
"order" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=)     forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Order
fldOrder
                , (Key
"doc" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=)       forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
fldDoc
                , (Key
"default" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=)   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DefaultValue -> DefaultValue
adjustDefaultValue Maybe DefaultValue
fldDefault
                ]
          in [Pair] -> Value
object forall a b. (a -> b) -> a -> b
$ [Pair]
opts forall a. [a] -> [a] -> [a]
++
             [ Key
"name"    forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
fldName
             , Key
"type"    forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe TypeName -> Schema -> Value
schemaToJSON (forall a. a -> Maybe a
Just TypeName
context) Schema
fldType
             , Key
"aliases" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Text]
fldAliases
             ]

        -- Default values for unions are encoded differently:
        -- the default value always represents the first element of a union
        adjustDefaultValue :: DefaultValue -> DefaultValue
adjustDefaultValue (DUnion Vector Schema
_ Schema
_ DefaultValue
val) = DefaultValue
val
        adjustDefaultValue DefaultValue
ty               = DefaultValue
ty

instance ToJSON DefaultValue where
  toJSON :: DefaultValue -> Value
toJSON DefaultValue
av =
    case DefaultValue
av of
      DefaultValue
DNull            -> Value
A.Null
      DBoolean Bool
b       -> Bool -> Value
A.Bool Bool
b
      DInt Schema
_ Int32
i         -> Scientific -> Value
A.Number (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
i)
      DLong Schema
_ Int64
i        -> Scientific -> Value
A.Number (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
i)
      DFloat Schema
_ Float
f       -> Scientific -> Value
A.Number (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
f)
      DDouble Schema
_ Double
d      -> Scientific -> Value
A.Number (forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
d)
      DBytes Schema
_ ByteString
bs      -> Text -> Value
A.String (ByteString -> Text
serializeBytes ByteString
bs)
      DString Schema
_ Text
t      -> Text -> Value
A.String Text
t
      DArray Vector DefaultValue
vec       -> Vector Value -> Value
A.Array (forall a b. (a -> b) -> Vector a -> Vector b
V.map forall a. ToJSON a => a -> Value
toJSON Vector DefaultValue
vec)
      DMap HashMap Text DefaultValue
mp          -> Object -> Value
A.Object forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. ToJSON a => a -> Value
toJSON (forall v. HashMap Text v -> KeyMap v
KM.fromHashMapText HashMap Text DefaultValue
mp)
      DRecord Schema
_ HashMap Text DefaultValue
flds   -> Object -> Value
A.Object forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. ToJSON a => a -> Value
toJSON (forall v. HashMap Text v -> KeyMap v
KM.fromHashMapText HashMap Text DefaultValue
flds)
      DUnion Vector Schema
_ Schema
_ DefaultValue
DNull -> Value
A.Null
      DUnion Vector Schema
_ Schema
ty DefaultValue
val  -> [Pair] -> Value
object [ Text -> Key
A.fromText (Schema -> Text
typeName Schema
ty) forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= DefaultValue
val ]
      DFixed Schema
_ ByteString
bs      -> Text -> Value
A.String (ByteString -> Text
serializeBytes ByteString
bs)
      DEnum Schema
_ Int
_ Text
txt    -> Text -> Value
A.String Text
txt

data Result a = Success a | Error String
  deriving (Result a -> Result a -> Bool
forall a. Eq a => Result a -> Result a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Result a -> Result a -> Bool
$c/= :: forall a. Eq a => Result a -> Result a -> Bool
== :: Result a -> Result a -> Bool
$c== :: forall a. Eq a => Result a -> Result a -> Bool
Eq, Result a -> Result a -> Bool
Result a -> Result a -> Ordering
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
forall {a}. Ord a => Eq (Result a)
forall a. Ord a => Result a -> Result a -> Bool
forall a. Ord a => Result a -> Result a -> Ordering
forall a. Ord a => Result a -> Result a -> Result a
min :: Result a -> Result a -> Result a
$cmin :: forall a. Ord a => Result a -> Result a -> Result a
max :: Result a -> Result a -> Result a
$cmax :: forall a. Ord a => Result a -> Result a -> Result a
>= :: Result a -> Result a -> Bool
$c>= :: forall a. Ord a => Result a -> Result a -> Bool
> :: Result a -> Result a -> Bool
$c> :: forall a. Ord a => Result a -> Result a -> Bool
<= :: Result a -> Result a -> Bool
$c<= :: forall a. Ord a => Result a -> Result a -> Bool
< :: Result a -> Result a -> Bool
$c< :: forall a. Ord a => Result a -> Result a -> Bool
compare :: Result a -> Result a -> Ordering
$ccompare :: forall a. Ord a => Result a -> Result a -> Ordering
Ord, Int -> Result a -> ShowS
forall a. Show a => Int -> Result a -> ShowS
forall a. Show a => [Result a] -> ShowS
forall a. Show a => Result a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Result a] -> ShowS
$cshowList :: forall a. Show a => [Result a] -> ShowS
show :: Result a -> String
$cshow :: forall a. Show a => Result a -> String
showsPrec :: Int -> Result a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Result a -> ShowS
Show, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Result a) x -> Result a
forall a x. Result a -> Rep (Result a) x
$cto :: forall a x. Rep (Result a) x -> Result a
$cfrom :: forall a x. Result a -> Rep (Result a) x
Generic, forall a. NFData a => Result a -> ()
forall a. (a -> ()) -> NFData a
rnf :: Result a -> ()
$crnf :: forall a. NFData a => Result a -> ()
NFData)

badValue :: Show t => t -> String -> Result a
badValue :: forall t a. Show t => t -> String -> Result a
badValue t
v String
t = forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Unexpected value for '" forall a. Semigroup a => a -> a -> a
<> String
t forall a. Semigroup a => a -> a -> a
<> String
"': " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show t
v

resultToEither :: Result b -> Either String b
resultToEither :: forall b. Result b -> Either String b
resultToEither Result b
r =
  case Result b
r of
    Success b
v -> forall a b. b -> Either a b
Right b
v
    Error String
err -> forall a b. a -> Either a b
Left String
err
{-# INLINE resultToEither #-}

instance Monad Result where
  return :: forall a. a -> Result a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
  Success a
a >>= :: forall a b. Result a -> (a -> Result b) -> Result b
>>= a -> Result b
k = a -> Result b
k a
a
  Error String
e >>= a -> Result b
_   = forall a. String -> Result a
Error String
e
#if !MIN_VERSION_base(4,13,0)
  fail = MF.fail
#endif
instance Functor Result where
  fmap :: forall a b. (a -> b) -> Result a -> Result b
fmap a -> b
f (Success a
x) = forall a. a -> Result a
Success (a -> b
f a
x)
  fmap a -> b
_ (Error String
e)   = forall a. String -> Result a
Error String
e
instance MF.MonadFail Result where
  fail :: forall a. String -> Result a
fail = forall a. String -> Result a
Error
instance MonadError String Result where
  throwError :: forall a. String -> Result a
throwError = forall (m :: * -> *) a. MonadFail m => String -> m a
fail
  catchError :: forall a. Result a -> (String -> Result a) -> Result a
catchError a :: Result a
a@(Success a
_) String -> Result a
_ = Result a
a
  catchError (Error String
e) String -> Result a
k     = String -> Result a
k String
e
instance Applicative Result where
  pure :: forall a. a -> Result a
pure  = forall a. a -> Result a
Success
  <*> :: forall a b. Result (a -> b) -> Result a -> Result b
(<*>) = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
instance Alternative Result where
  empty :: forall a. Result a
empty = forall (m :: * -> *) a. MonadPlus m => m a
mzero
  <|> :: forall a. Result a -> Result a -> Result a
(<|>) = forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus
instance MonadPlus Result where
  mzero :: forall a. Result a
mzero = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"mzero"
  mplus :: forall a. Result a -> Result a -> Result a
mplus a :: Result a
a@(Success a
_) Result a
_ = Result a
a
  mplus Result a
_ Result a
b             = Result a
b
instance Semigroup (Result a) where
  <> :: Result a -> Result a -> Result a
(<>) = forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus
instance Monoid (Result a) where
  mempty :: Result a
mempty = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Empty Result"
  mappend :: Result a -> Result a -> Result a
mappend = forall a. Semigroup a => a -> a -> a
(<>)
instance Foldable Result where
  foldMap :: forall m a. Monoid m => (a -> m) -> Result a -> m
foldMap a -> m
_ (Error String
_)   = forall a. Monoid a => a
mempty
  foldMap a -> m
f (Success a
y) = a -> m
f a
y
  foldr :: forall a b. (a -> b -> b) -> b -> Result a -> b
foldr a -> b -> b
_ b
z (Error String
_)   = b
z
  foldr a -> b -> b
f b
z (Success a
y) = a -> b -> b
f a
y b
z
instance Traversable Result where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Result a -> f (Result b)
traverse a -> f b
_ (Error String
err) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. String -> Result a
Error String
err)
  traverse a -> f b
f (Success a
v) = forall a. a -> Result a
Success forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
v

-- | Field defaults are in the normal Avro JSON format except for
-- unions. Default values for unions are specified as JSON encodings
-- of the first type in the union.
parseFieldDefault :: (TypeName -> Maybe Schema)
                     -- ^ Lookup function for names defined in schema.
                  -> Schema
                     -- ^ The schema of the default value being parsed.
                  -> A.Value
                     -- ^ JSON encoding of an Avro value.
                  -> Result DefaultValue
parseFieldDefault :: (TypeName -> Maybe Schema)
-> Schema -> Value -> Result DefaultValue
parseFieldDefault TypeName -> Maybe Schema
env Schema
schema Value
value = (Schema -> Value -> Result DefaultValue)
-> (TypeName -> Maybe Schema)
-> Schema
-> Value
-> Result DefaultValue
parseAvroJSON Schema -> Value -> Result DefaultValue
defaultUnion TypeName -> Maybe Schema
env Schema
schema Value
value
  where defaultUnion :: Schema -> Value -> Result DefaultValue
defaultUnion (Union Vector Schema
ts) Value
val = Vector Schema -> Schema -> DefaultValue -> DefaultValue
DUnion Vector Schema
ts (forall a. Vector a -> a
V.head Vector Schema
ts) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TypeName -> Maybe Schema)
-> Schema -> Value -> Result DefaultValue
parseFieldDefault TypeName -> Maybe Schema
env (forall a. Vector a -> a
V.head Vector Schema
ts) Value
val
        defaultUnion Schema
_ Value
_            = forall a. HasCallStack => String -> a
error String
"Impossible: not Union."

-- | Parse JSON-encoded avro data.
parseAvroJSON :: (Schema -> A.Value -> Result DefaultValue)
                 -- ^ How to handle unions. The way unions are
                 -- formatted in JSON depends on whether we're parsing
                 -- a normal Avro object or we're parsing a default
                 -- declaration in a schema.
                 --
                 -- This function will only ever be passed 'Union'
                 -- schemas. It /should/ error out if this is not the
                 -- case—it represents a bug in this code.
              -> (TypeName -> Maybe Schema)
              -> Schema
              -> A.Value
              -> Result DefaultValue
parseAvroJSON :: (Schema -> Value -> Result DefaultValue)
-> (TypeName -> Maybe Schema)
-> Schema
-> Value
-> Result DefaultValue
parseAvroJSON Schema -> Value -> Result DefaultValue
union TypeName -> Maybe Schema
env (NamedType TypeName
name) Value
av =
  case TypeName -> Maybe Schema
env TypeName
name of
    Maybe Schema
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Could not resolve type name for " forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack (TypeName -> Text
renderFullname TypeName
name)
    Just Schema
t  -> (Schema -> Value -> Result DefaultValue)
-> (TypeName -> Maybe Schema)
-> Schema
-> Value
-> Result DefaultValue
parseAvroJSON Schema -> Value -> Result DefaultValue
union TypeName -> Maybe Schema
env Schema
t Value
av
parseAvroJSON Schema -> Value -> Result DefaultValue
union TypeName -> Maybe Schema
_ u :: Schema
u@Union{} Value
av             = Schema
u Schema -> Value -> Result DefaultValue
`union` Value
av
parseAvroJSON Schema -> Value -> Result DefaultValue
union TypeName -> Maybe Schema
env Schema
ty Value
av                  =
    case Value
av of
      A.String Text
s      ->
        case Schema
ty of
          String Maybe LogicalTypeString
_    -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Schema -> Text -> DefaultValue
DString Schema
ty Text
s
          Enum {[TypeName]
Maybe Text
Vector Text
TypeName
symbols :: Vector Text
doc :: Maybe Text
aliases :: [TypeName]
name :: TypeName
symbols :: Schema -> Vector Text
doc :: Schema -> Maybe Text
aliases :: Schema -> [TypeName]
name :: Schema -> TypeName
..}   ->
              case Text
s forall a. Eq a => a -> Vector a -> Maybe Int
`V.elemIndex` Vector Text
symbols of
                Just Int
i  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Schema -> Int -> Text -> DefaultValue
DEnum Schema
ty Int
i Text
s
                Maybe Int
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"JSON string is not one of the expected symbols for enum '" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show TypeName
name forall a. Semigroup a => a -> a -> a
<> String
"': " forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
s
          Bytes Maybe LogicalTypeBytes
_     -> Schema -> ByteString -> DefaultValue
DBytes Schema
ty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Result ByteString
parseBytes Text
s
          Fixed {Int
[TypeName]
Maybe LogicalTypeFixed
TypeName
logicalTypeF :: Maybe LogicalTypeFixed
size :: Int
aliases :: [TypeName]
name :: TypeName
logicalTypeF :: Schema -> Maybe LogicalTypeFixed
size :: Schema -> Int
aliases :: Schema -> [TypeName]
name :: Schema -> TypeName
..}  -> do
            ByteString
bytes <- Text -> Result ByteString
parseBytes Text
s
            let len :: Int
len = ByteString -> Int
B.length ByteString
bytes
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
len forall a. Eq a => a -> a -> Bool
/= Int
size) forall a b. (a -> b) -> a -> b
$
              forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Fixed string wrong size. Expected " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
size forall a. Semigroup a => a -> a -> a
<> String
" but got " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
len
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Schema -> ByteString -> DefaultValue
DFixed Schema
ty ByteString
bytes
          Schema
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Expected type String, Enum, Bytes, or Fixed, but found (Type,Value)="
             forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (Schema
ty, Value
av)
      A.Bool Bool
b       -> case Schema
ty of
                          Schema
Boolean -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Bool -> DefaultValue
DBoolean Bool
b
                          Schema
_       -> forall a. Schema -> Text -> Result a
avroTypeMismatch Schema
ty Text
"boolean"
      A.Number Scientific
i     ->
        case Schema
ty of
          Int Maybe LogicalTypeInt
_  -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Schema -> Int32 -> DefaultValue
DInt    Schema
ty (forall a b. (RealFrac a, Integral b) => a -> b
floor Scientific
i)
          Long Maybe LogicalTypeLong
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Schema -> Int64 -> DefaultValue
DLong   Schema
ty (forall a b. (RealFrac a, Integral b) => a -> b
floor Scientific
i)
          Schema
Float  -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Schema -> Float -> DefaultValue
DFloat  Schema
ty (forall a b. (Real a, Fractional b) => a -> b
realToFrac Scientific
i)
          Schema
Double -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Schema -> Double -> DefaultValue
DDouble Schema
ty (forall a b. (Real a, Fractional b) => a -> b
realToFrac Scientific
i)
          Schema
_      -> forall a. Schema -> Text -> Result a
avroTypeMismatch Schema
ty Text
"number"
      A.Array Vector Value
vec    ->
        case Schema
ty of
          Array Schema
t -> Vector DefaultValue -> DefaultValue
DArray forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Vector a -> m (Vector b)
V.mapM ((Schema -> Value -> Result DefaultValue)
-> (TypeName -> Maybe Schema)
-> Schema
-> Value
-> Result DefaultValue
parseAvroJSON Schema -> Value -> Result DefaultValue
union TypeName -> Maybe Schema
env Schema
t) Vector Value
vec
          Schema
_       -> forall a. Schema -> Text -> Result a
avroTypeMismatch Schema
ty Text
"array"
      A.Object Object
obj ->
        case Schema
ty of
          Map Schema
mTy     -> HashMap Text DefaultValue -> DefaultValue
DMap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Schema -> Value -> Result DefaultValue)
-> (TypeName -> Maybe Schema)
-> Schema
-> Value
-> Result DefaultValue
parseAvroJSON Schema -> Value -> Result DefaultValue
union TypeName -> Maybe Schema
env Schema
mTy) (forall v. KeyMap v -> HashMap Text v
KM.toHashMapText Object
obj)
          Record {[TypeName]
[Field]
Maybe Text
TypeName
fields :: [Field]
doc :: Maybe Text
aliases :: [TypeName]
name :: TypeName
fields :: Schema -> [Field]
doc :: Schema -> Maybe Text
aliases :: Schema -> [TypeName]
name :: Schema -> TypeName
..} ->
           do let lkAndParse :: Field -> Result DefaultValue
lkAndParse Field
f =
                    case forall v. Key -> KeyMap v -> Maybe v
KM.lookup (Text -> Key
A.fromText (Field -> Text
fldName Field
f)) Object
obj of
                      Maybe Value
Nothing -> case Field -> Maybe DefaultValue
fldDefault Field
f of
                                  Just DefaultValue
v  -> forall (m :: * -> *) a. Monad m => a -> m a
return DefaultValue
v
                                  Maybe DefaultValue
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Decode failure: No record field '" forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack (Field -> Text
fldName Field
f) forall a. Semigroup a => a -> a -> a
<> String
"' and no default in schema."
                      Just Value
v  -> (Schema -> Value -> Result DefaultValue)
-> (TypeName -> Maybe Schema)
-> Schema
-> Value
-> Result DefaultValue
parseAvroJSON Schema -> Value -> Result DefaultValue
union TypeName -> Maybe Schema
env (Field -> Schema
fldType Field
f) Value
v
              Schema -> HashMap Text DefaultValue -> DefaultValue
DRecord Schema
ty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\Field
f -> (Field -> Text
fldName Field
f,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Field -> Result DefaultValue
lkAndParse Field
f) [Field]
fields
          Schema
_ -> forall a. Schema -> Text -> Result a
avroTypeMismatch Schema
ty Text
"object"
      Value
A.Null -> case Schema
ty of
                  Schema
Null -> forall (m :: * -> *) a. Monad m => a -> m a
return DefaultValue
DNull
                  Schema
_    -> forall a. Schema -> Text -> Result a
avroTypeMismatch Schema
ty Text
"null"

-- | Parses a string literal into a bytestring in the format expected
-- for bytes and fixed values. Will fail if every character does not
-- have a codepoint between 0 and 255.
parseBytes :: Text -> Result B.ByteString
parseBytes :: Text -> Result ByteString
parseBytes Text
bytes = case (Char -> Bool) -> Text -> Maybe Char
T.find (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
inRange) Text
bytes of
  Just Char
badChar -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Invalid character in bytes or fixed string representation: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Char
badChar
  Maybe Char
Nothing      -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Word8] -> ByteString
B.pack forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
Char.ord forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> String
T.unpack Text
bytes
  where inRange :: Char -> Bool
inRange (Char -> Int
Char.ord -> Int
c) = Int
c forall a. Ord a => a -> a -> Bool
>= Int
0x00 Bool -> Bool -> Bool
&& Int
c forall a. Ord a => a -> a -> Bool
<= Int
0xFF

-- | Turn a 'ByteString' into a 'Text' that matches the format Avro
-- expects from bytes and fixed literals in JSON. Each byte is mapped
-- to a single Unicode codepoint between 0 and 255.
serializeBytes :: B.ByteString -> Text
serializeBytes :: ByteString -> Text
serializeBytes = String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (Int -> Char
Char.chr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
B.unpack

avroTypeMismatch :: Schema -> Text -> Result a
avroTypeMismatch :: forall a. Schema -> Text -> Result a
avroTypeMismatch Schema
expected Text
actual =
  forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Could not resolve type '" forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
actual forall a. Semigroup a => a -> a -> a
<> String
"' with expected type: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Schema
expected

instance ToJSON Order where
  toJSON :: Order -> Value
toJSON Order
o =
    case Order
o of
      Order
Ascending  -> Text -> Value
A.String Text
"ascending"
      Order
Descending -> Text -> Value
A.String Text
"descending"
      Order
Ignore     -> Text -> Value
A.String Text
"ignore"

instance FromJSON Order where
  parseJSON :: Value -> Parser Order
parseJSON (A.String Text
s) =
    case Text
s of
      Text
"ascending"  -> forall (m :: * -> *) a. Monad m => a -> m a
return Order
Ascending
      Text
"descending" -> forall (m :: * -> *) a. Monad m => a -> m a
return Order
Descending
      Text
"ignore"     -> forall (m :: * -> *) a. Monad m => a -> m a
return Order
Ignore
      Text
_            -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Unknown string for order: " forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
s
  parseJSON Value
j = forall a. String -> Value -> Parser a
typeMismatch String
"Order" Value
j

-- | Placeholder NO-OP function!
--
-- Validates a schema to ensure:
--
--  * All types are defined
--  * Unions do not directly contain other unions
--  * Unions are not ambiguous (may not contain more than one schema with
--  the same type except for named types of record, fixed and enum)
--  * Default values for unions can be cast as the type indicated by the
--  first structure.
--  * Default values can be cast/de-serialize correctly.
--  * Named types are resolvable
validateSchema :: Schema -> Parser ()
validateSchema :: Schema -> Parser ()
validateSchema Schema
_sch = forall (m :: * -> *) a. Monad m => a -> m a
return () -- XXX TODO

-- | @buildTypeEnvironment schema@ builds a function mapping type names to
-- the types declared in the traversed schema.
--
-- This mapping includes both the base type names and any aliases they
-- have. Aliases and normal names are not differentiated in any way.
buildTypeEnvironment :: Applicative m
                     => (TypeName -> m Schema)
                        -- ^ Callback to handle type names not in the
                        -- schema.
                     -> Schema
                        -- ^ The schema that we're generating a lookup
                        -- function for.
                     -> (TypeName -> m Schema)
buildTypeEnvironment :: forall (m :: * -> *).
Applicative m =>
(TypeName -> m Schema) -> Schema -> TypeName -> m Schema
buildTypeEnvironment TypeName -> m Schema
failure Schema
from =
    \ TypeName
forTy -> case forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup TypeName
forTy HashMap TypeName Schema
env of
                 Maybe Schema
Nothing  -> TypeName -> m Schema
failure TypeName
forTy
                 Just Schema
res -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Schema
res
  where
    env :: HashMap TypeName Schema
env = Schema -> HashMap TypeName Schema
extractBindings Schema
from

-- | Checks that two schemas match. This is like equality of schemas,
-- except 'NamedTypes' match against other types /with the same name/.
--
-- This extends recursively: two records match if they have the same
-- name, the same number of fields and the fields all match.
matches :: Schema -> Schema -> Bool
matches :: Schema -> Schema -> Bool
matches n :: Schema
n@NamedType{} Schema
t             = Schema -> Text
typeName Schema
n forall a. Eq a => a -> a -> Bool
== Schema -> Text
typeName Schema
t
matches Schema
t n :: Schema
n@NamedType{}             = Schema -> Text
typeName Schema
t forall a. Eq a => a -> a -> Bool
== Schema -> Text
typeName Schema
n
matches (Array Schema
itemA) (Array Schema
itemB) = Schema -> Schema -> Bool
matches Schema
itemA Schema
itemB
matches a :: Schema
a@Record{} b :: Schema
b@Record{}       =
  forall (t :: * -> *). Foldable t => t Bool -> Bool
and [ Schema -> TypeName
name Schema
a forall a. Eq a => a -> a -> Bool
== Schema -> TypeName
name Schema
b
      , forall (t :: * -> *) a. Foldable t => t a -> Int
length (Schema -> [Field]
fields Schema
a) forall a. Eq a => a -> a -> Bool
== forall (t :: * -> *) a. Foldable t => t a -> Int
length (Schema -> [Field]
fields Schema
b)
      , forall (t :: * -> *). Foldable t => t Bool -> Bool
and forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Field -> Field -> Bool
fieldMatches (Schema -> [Field]
fields Schema
a) (Schema -> [Field]
fields Schema
b)
      ]
  where fieldMatches :: Field -> Field -> Bool
fieldMatches = Schema -> Schema -> Bool
matches forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Field -> Schema
fldType
matches a :: Schema
a@Union{} b :: Schema
b@Union{}         = forall (t :: * -> *). Foldable t => t Bool -> Bool
and forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> Vector a -> Vector b -> Vector c
V.zipWith Schema -> Schema -> Bool
matches (Schema -> Vector Schema
options Schema
a) (Schema -> Vector Schema
options Schema
b)
matches Schema
t1 Schema
t2                       = Schema
t1 forall a. Eq a => a -> a -> Bool
== Schema
t2

-- | @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 :: Schema -> HashMap.HashMap TypeName Schema
extractBindings :: Schema -> HashMap TypeName Schema
extractBindings = \case
  t :: Schema
t@Record{[TypeName]
[Field]
Maybe Text
TypeName
fields :: [Field]
doc :: Maybe Text
aliases :: [TypeName]
name :: TypeName
fields :: Schema -> [Field]
doc :: Schema -> Maybe Text
aliases :: Schema -> [TypeName]
name :: Schema -> TypeName
..} ->
    let withRecord :: HashMap TypeName Schema
withRecord = forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList forall a b. (a -> b) -> a -> b
$ (TypeName
name forall a. a -> [a] -> [a]
: [TypeName]
aliases) forall a b. [a] -> [b] -> [(a, b)]
`zip` forall a. a -> [a]
repeat Schema
t
    in forall k v. (Eq k, Hashable k) => [HashMap k v] -> HashMap k v
HashMap.unions forall a b. (a -> b) -> a -> b
$ HashMap TypeName Schema
withRecord forall a. a -> [a] -> [a]
: (Schema -> HashMap TypeName Schema
extractBindings forall b c a. (b -> c) -> (a -> b) -> a -> c
. Field -> Schema
fldType forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Field]
fields)
  e :: Schema
e@Enum{[TypeName]
Maybe Text
Vector Text
TypeName
symbols :: Vector Text
doc :: Maybe Text
aliases :: [TypeName]
name :: TypeName
symbols :: Schema -> Vector Text
doc :: Schema -> Maybe Text
aliases :: Schema -> [TypeName]
name :: Schema -> TypeName
..}   -> forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList forall a b. (a -> b) -> a -> b
$ (TypeName
name forall a. a -> [a] -> [a]
: [TypeName]
aliases) forall a b. [a] -> [b] -> [(a, b)]
`zip` forall a. a -> [a]
repeat Schema
e
  Union{Vector Schema
options :: Vector Schema
options :: Schema -> Vector Schema
..}    -> forall k v. (Eq k, Hashable k) => [HashMap k v] -> HashMap k v
HashMap.unions forall a b. (a -> b) -> a -> b
$ forall a. Vector a -> [a]
V.toList forall a b. (a -> b) -> a -> b
$ Schema -> HashMap TypeName Schema
extractBindings forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector Schema
options
  f :: Schema
f@Fixed{Int
[TypeName]
Maybe LogicalTypeFixed
TypeName
logicalTypeF :: Maybe LogicalTypeFixed
size :: Int
aliases :: [TypeName]
name :: TypeName
logicalTypeF :: Schema -> Maybe LogicalTypeFixed
size :: Schema -> Int
aliases :: Schema -> [TypeName]
name :: Schema -> TypeName
..}  -> forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList forall a b. (a -> b) -> a -> b
$ (TypeName
name forall a. a -> [a] -> [a]
: [TypeName]
aliases) forall a b. [a] -> [b] -> [(a, b)]
`zip` forall a. a -> [a]
repeat Schema
f
  Array{Schema
item :: Schema
item :: Schema -> Schema
..}    -> Schema -> HashMap TypeName Schema
extractBindings Schema
item
  Map{Schema
values :: Schema
values :: Schema -> Schema
..}      -> Schema -> HashMap TypeName Schema
extractBindings Schema
values
  Schema
_            -> forall k v. HashMap k v
HashMap.empty


expandNamedTypes :: Schema -> Schema
expandNamedTypes :: Schema -> Schema
expandNamedTypes =
  forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s a. State s a -> s -> a
evalState forall k v. HashMap k v
HashMap.empty forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> StateT (HashMap TypeName Schema) Identity Schema
go
  where
    expandField :: Field -> StateT (HashMap TypeName Schema) Identity Field
expandField f :: Field
f@Field{Schema
fldType :: Schema
fldType :: Field -> Schema
fldType} = (\Schema
x -> Field
f { fldType :: Schema
fldType = Schema
x }) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Schema -> StateT (HashMap TypeName Schema) Identity Schema
go Schema
fldType
    go :: Schema -> StateT (HashMap TypeName Schema) Identity Schema
go = \case
      t :: Schema
t@(NamedType TypeName
n)   -> forall a. a -> Maybe a -> a
fromMaybe Schema
t forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup TypeName
n)
      a :: Schema
a@Array{Schema
item :: Schema
item :: Schema -> Schema
item}     -> (\Schema
x -> Schema
a { item :: Schema
item = Schema
x })   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Schema -> StateT (HashMap TypeName Schema) Identity Schema
go Schema
item
      m :: Schema
m@Map{Schema
values :: Schema
values :: Schema -> Schema
values}     -> (\Schema
x -> Schema
m { values :: Schema
values = Schema
x }) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Schema -> StateT (HashMap TypeName Schema) Identity Schema
go Schema
values
      u :: Schema
u@Union{Vector Schema
options :: Vector Schema
options :: Schema -> Vector Schema
options}  -> Vector Schema -> Schema
Union forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Schema -> StateT (HashMap TypeName Schema) Identity Schema
go Vector Schema
options

      r :: Schema
r@Record{TypeName
name :: TypeName
name :: Schema -> TypeName
name, [Field]
fields :: [Field]
fields :: Schema -> [Field]
fields}  -> do
        [Field]
fields' <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Field -> StateT (HashMap TypeName Schema) Identity Field
expandField [Field]
fields
        let r' :: Schema
r' = Schema
r { fields :: [Field]
fields = [Field]
fields' }
        forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert TypeName
name Schema
r')
        forall (f :: * -> *) a. Applicative f => a -> f a
pure Schema
r'

      r :: Schema
r@Enum{TypeName
name :: TypeName
name :: Schema -> TypeName
name} -> do
        forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert TypeName
name Schema
r)
        forall (f :: * -> *) a. Applicative f => a -> f a
pure Schema
r

      Schema
other -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Schema
other

-- | Merge two schemas to produce a third.
-- Specifically, @overlay schema reference@ fills in 'NamedTypes' in 'schema' using any matching definitions from 'reference'.
overlay :: Schema -> Schema -> Schema
overlay :: Schema -> Schema -> Schema
overlay Schema
input Schema
supplement = Schema -> Schema
overlayType Schema
input
  where
    overlayField :: Field -> Field
overlayField f :: Field
f@Field{[Text]
Maybe Text
Maybe Order
Maybe DefaultValue
Text
Schema
fldDefault :: Maybe DefaultValue
fldType :: Schema
fldOrder :: Maybe Order
fldDoc :: Maybe Text
fldAliases :: [Text]
fldName :: Text
fldDefault :: Field -> Maybe DefaultValue
fldType :: Field -> Schema
fldOrder :: Field -> Maybe Order
fldDoc :: Field -> Maybe Text
fldAliases :: Field -> [Text]
fldName :: Field -> Text
..}      = Field
f { fldType :: Schema
fldType = Schema -> Schema
overlayType Schema
fldType }
    overlayType :: Schema -> Schema
overlayType  a :: Schema
a@Array{Schema
item :: Schema
item :: Schema -> Schema
..}      = Schema
a { item :: Schema
item    = Schema -> Schema
overlayType Schema
item }
    overlayType  m :: Schema
m@Map{Schema
values :: Schema
values :: Schema -> Schema
..}        = Schema
m { values :: Schema
values  = Schema -> Schema
overlayType Schema
values }
    overlayType  r :: Schema
r@Record{[TypeName]
[Field]
Maybe Text
TypeName
fields :: [Field]
doc :: Maybe Text
aliases :: [TypeName]
name :: TypeName
fields :: Schema -> [Field]
doc :: Schema -> Maybe Text
aliases :: Schema -> [TypeName]
name :: Schema -> TypeName
..}     = Schema
r { fields :: [Field]
fields  = forall a b. (a -> b) -> [a] -> [b]
map Field -> Field
overlayField [Field]
fields }
    overlayType  u :: Schema
u@Union{Vector Schema
options :: Vector Schema
options :: Schema -> Vector Schema
..}      = Vector Schema -> Schema
Union (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Schema -> Schema
overlayType Vector Schema
options)
    overlayType  nt :: Schema
nt@(NamedType TypeName
_) = Schema -> Schema
rebind Schema
nt
    overlayType  Schema
other            = Schema
other

    rebind :: Schema -> Schema
rebind (NamedType TypeName
tn) = forall k v. (Eq k, Hashable k) => v -> k -> HashMap k v -> v
HashMap.lookupDefault (TypeName -> Schema
NamedType TypeName
tn) TypeName
tn HashMap TypeName Schema
bindings
    bindings :: HashMap TypeName Schema
bindings              = Schema -> HashMap TypeName Schema
extractBindings Schema
supplement

-- | Extract the named inner type definition as its own schema.
subdefinition :: Schema -> Text -> Maybe Schema
subdefinition :: Schema -> Text -> Maybe Schema
subdefinition Schema
schema Text
name = Maybe TypeName -> Text -> Maybe Text -> TypeName
mkTypeName forall a. Maybe a
Nothing Text
name forall a. Maybe a
Nothing forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
`HashMap.lookup` Schema -> HashMap TypeName Schema
extractBindings Schema
schema