{-# 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
  , 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.Hashable
import           Data.HashMap.Strict    (HashMap)
import qualified Data.HashMap.Strict    as HashMap
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
(DefaultValue -> DefaultValue -> Bool)
-> (DefaultValue -> DefaultValue -> Bool) -> Eq DefaultValue
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
Eq DefaultValue
-> (DefaultValue -> DefaultValue -> Ordering)
-> (DefaultValue -> DefaultValue -> Bool)
-> (DefaultValue -> DefaultValue -> Bool)
-> (DefaultValue -> DefaultValue -> Bool)
-> (DefaultValue -> DefaultValue -> Bool)
-> (DefaultValue -> DefaultValue -> DefaultValue)
-> (DefaultValue -> DefaultValue -> DefaultValue)
-> Ord 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
$cp1Ord :: Eq DefaultValue
Ord, Int -> DefaultValue -> ShowS
[DefaultValue] -> ShowS
DefaultValue -> String
(Int -> DefaultValue -> ShowS)
-> (DefaultValue -> String)
-> ([DefaultValue] -> ShowS)
-> Show DefaultValue
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. DefaultValue -> Rep DefaultValue x)
-> (forall x. Rep DefaultValue x -> DefaultValue)
-> Generic DefaultValue
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 -> ()
(DefaultValue -> ()) -> NFData 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
Eq Schema
-> (Schema -> Schema -> Ordering)
-> (Schema -> Schema -> Bool)
-> (Schema -> Schema -> Bool)
-> (Schema -> Schema -> Bool)
-> (Schema -> Schema -> Bool)
-> (Schema -> Schema -> Schema)
-> (Schema -> Schema -> Schema)
-> Ord 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
$cp1Ord :: Eq Schema
Ord, Int -> Schema -> ShowS
[Schema] -> ShowS
Schema -> String
(Int -> Schema -> ShowS)
-> (Schema -> String) -> ([Schema] -> ShowS) -> Show Schema
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. Schema -> Rep Schema x)
-> (forall x. Rep Schema x -> Schema) -> Generic Schema
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 -> ()
(Schema -> ()) -> NFData Schema
forall a. (a -> ()) -> NFData a
rnf :: Schema -> ()
$crnf :: Schema -> ()
NFData)

pattern $bInt' :: Schema
$mInt' :: forall r. Schema -> (Void# -> r) -> (Void# -> r) -> r
Int'    = Int    Nothing
pattern $bLong' :: Schema
$mLong' :: forall r. Schema -> (Void# -> r) -> (Void# -> r) -> r
Long'   = Long   Nothing
pattern $bBytes' :: Schema
$mBytes' :: forall r. Schema -> (Void# -> r) -> (Void# -> r) -> r
Bytes'  = Bytes  Nothing
pattern $bString' :: Schema
$mString' :: forall r. Schema -> (Void# -> r) -> (Void# -> 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
(Field -> Field -> Bool) -> (Field -> Field -> Bool) -> Eq Field
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
Eq Field
-> (Field -> Field -> Ordering)
-> (Field -> Field -> Bool)
-> (Field -> Field -> Bool)
-> (Field -> Field -> Bool)
-> (Field -> Field -> Bool)
-> (Field -> Field -> Field)
-> (Field -> Field -> Field)
-> Ord 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
$cp1Ord :: Eq Field
Ord, Int -> Field -> ShowS
[Field] -> ShowS
Field -> String
(Int -> Field -> ShowS)
-> (Field -> String) -> ([Field] -> ShowS) -> Show Field
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. Field -> Rep Field x)
-> (forall x. Rep Field x -> Field) -> Generic Field
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 -> ()
(Field -> ()) -> NFData Field
forall a. (a -> ()) -> NFData a
rnf :: Field -> ()
$crnf :: Field -> ()
NFData)

data Order = Ascending | Descending | Ignore
  deriving (Order -> Order -> Bool
(Order -> Order -> Bool) -> (Order -> Order -> Bool) -> Eq Order
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
Eq Order
-> (Order -> Order -> Ordering)
-> (Order -> Order -> Bool)
-> (Order -> Order -> Bool)
-> (Order -> Order -> Bool)
-> (Order -> Order -> Bool)
-> (Order -> Order -> Order)
-> (Order -> Order -> Order)
-> Ord 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
$cp1Ord :: Eq Order
Ord, Int -> Order -> ShowS
[Order] -> ShowS
Order -> String
(Int -> Order -> ShowS)
-> (Order -> String) -> ([Order] -> ShowS) -> Show Order
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. Order -> Rep Order x)
-> (forall x. Rep Order x -> Order) -> Generic Order
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 -> ()
(Order -> ()) -> NFData Order
forall a. (a -> ()) -> NFData a
rnf :: Order -> ()
$crnf :: Order -> ()
NFData)

data Decimal
  = Decimal { Decimal -> Integer
precision :: Integer, Decimal -> Integer
scale :: Integer }
  deriving (Decimal -> Decimal -> Bool
(Decimal -> Decimal -> Bool)
-> (Decimal -> Decimal -> Bool) -> Eq Decimal
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
(Int -> Decimal -> ShowS)
-> (Decimal -> String) -> ([Decimal] -> ShowS) -> Show Decimal
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
Eq Decimal
-> (Decimal -> Decimal -> Ordering)
-> (Decimal -> Decimal -> Bool)
-> (Decimal -> Decimal -> Bool)
-> (Decimal -> Decimal -> Bool)
-> (Decimal -> Decimal -> Bool)
-> (Decimal -> Decimal -> Decimal)
-> (Decimal -> Decimal -> Decimal)
-> Ord 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
$cp1Ord :: Eq Decimal
Ord, (forall x. Decimal -> Rep Decimal x)
-> (forall x. Rep Decimal x -> Decimal) -> Generic Decimal
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 -> ()
(Decimal -> ()) -> NFData Decimal
forall a. (a -> ()) -> NFData a
rnf :: Decimal -> ()
$crnf :: Decimal -> ()
NFData)

newtype LogicalTypeBytes
  = DecimalB Decimal
  deriving (LogicalTypeBytes -> LogicalTypeBytes -> Bool
(LogicalTypeBytes -> LogicalTypeBytes -> Bool)
-> (LogicalTypeBytes -> LogicalTypeBytes -> Bool)
-> Eq LogicalTypeBytes
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
(Int -> LogicalTypeBytes -> ShowS)
-> (LogicalTypeBytes -> String)
-> ([LogicalTypeBytes] -> ShowS)
-> Show LogicalTypeBytes
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
Eq LogicalTypeBytes
-> (LogicalTypeBytes -> LogicalTypeBytes -> Ordering)
-> (LogicalTypeBytes -> LogicalTypeBytes -> Bool)
-> (LogicalTypeBytes -> LogicalTypeBytes -> Bool)
-> (LogicalTypeBytes -> LogicalTypeBytes -> Bool)
-> (LogicalTypeBytes -> LogicalTypeBytes -> Bool)
-> (LogicalTypeBytes -> LogicalTypeBytes -> LogicalTypeBytes)
-> (LogicalTypeBytes -> LogicalTypeBytes -> LogicalTypeBytes)
-> Ord 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
$cp1Ord :: Eq LogicalTypeBytes
Ord, (forall x. LogicalTypeBytes -> Rep LogicalTypeBytes x)
-> (forall x. Rep LogicalTypeBytes x -> LogicalTypeBytes)
-> Generic LogicalTypeBytes
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 -> ()
(LogicalTypeBytes -> ()) -> NFData LogicalTypeBytes
forall a. (a -> ()) -> NFData a
rnf :: LogicalTypeBytes -> ()
$crnf :: LogicalTypeBytes -> ()
NFData)

data LogicalTypeFixed
  = DecimalF Decimal | Duration
  deriving (LogicalTypeFixed -> LogicalTypeFixed -> Bool
(LogicalTypeFixed -> LogicalTypeFixed -> Bool)
-> (LogicalTypeFixed -> LogicalTypeFixed -> Bool)
-> Eq LogicalTypeFixed
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
(Int -> LogicalTypeFixed -> ShowS)
-> (LogicalTypeFixed -> String)
-> ([LogicalTypeFixed] -> ShowS)
-> Show LogicalTypeFixed
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
Eq LogicalTypeFixed
-> (LogicalTypeFixed -> LogicalTypeFixed -> Ordering)
-> (LogicalTypeFixed -> LogicalTypeFixed -> Bool)
-> (LogicalTypeFixed -> LogicalTypeFixed -> Bool)
-> (LogicalTypeFixed -> LogicalTypeFixed -> Bool)
-> (LogicalTypeFixed -> LogicalTypeFixed -> Bool)
-> (LogicalTypeFixed -> LogicalTypeFixed -> LogicalTypeFixed)
-> (LogicalTypeFixed -> LogicalTypeFixed -> LogicalTypeFixed)
-> Ord 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
$cp1Ord :: Eq LogicalTypeFixed
Ord, (forall x. LogicalTypeFixed -> Rep LogicalTypeFixed x)
-> (forall x. Rep LogicalTypeFixed x -> LogicalTypeFixed)
-> Generic LogicalTypeFixed
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 -> ()
(LogicalTypeFixed -> ()) -> NFData LogicalTypeFixed
forall a. (a -> ()) -> NFData a
rnf :: LogicalTypeFixed -> ()
$crnf :: LogicalTypeFixed -> ()
NFData)

data LogicalTypeInt
  = DecimalI Decimal | Date | TimeMillis
  deriving (LogicalTypeInt -> LogicalTypeInt -> Bool
(LogicalTypeInt -> LogicalTypeInt -> Bool)
-> (LogicalTypeInt -> LogicalTypeInt -> Bool) -> Eq LogicalTypeInt
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
(Int -> LogicalTypeInt -> ShowS)
-> (LogicalTypeInt -> String)
-> ([LogicalTypeInt] -> ShowS)
-> Show LogicalTypeInt
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
Eq LogicalTypeInt
-> (LogicalTypeInt -> LogicalTypeInt -> Ordering)
-> (LogicalTypeInt -> LogicalTypeInt -> Bool)
-> (LogicalTypeInt -> LogicalTypeInt -> Bool)
-> (LogicalTypeInt -> LogicalTypeInt -> Bool)
-> (LogicalTypeInt -> LogicalTypeInt -> Bool)
-> (LogicalTypeInt -> LogicalTypeInt -> LogicalTypeInt)
-> (LogicalTypeInt -> LogicalTypeInt -> LogicalTypeInt)
-> Ord 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
$cp1Ord :: Eq LogicalTypeInt
Ord, (forall x. LogicalTypeInt -> Rep LogicalTypeInt x)
-> (forall x. Rep LogicalTypeInt x -> LogicalTypeInt)
-> Generic LogicalTypeInt
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 -> ()
(LogicalTypeInt -> ()) -> NFData LogicalTypeInt
forall a. (a -> ()) -> NFData a
rnf :: LogicalTypeInt -> ()
$crnf :: LogicalTypeInt -> ()
NFData)

data LogicalTypeLong
  = DecimalL Decimal | TimeMicros | TimestampMillis | TimestampMicros
  deriving (LogicalTypeLong -> LogicalTypeLong -> Bool
(LogicalTypeLong -> LogicalTypeLong -> Bool)
-> (LogicalTypeLong -> LogicalTypeLong -> Bool)
-> Eq LogicalTypeLong
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
(Int -> LogicalTypeLong -> ShowS)
-> (LogicalTypeLong -> String)
-> ([LogicalTypeLong] -> ShowS)
-> Show LogicalTypeLong
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
Eq LogicalTypeLong
-> (LogicalTypeLong -> LogicalTypeLong -> Ordering)
-> (LogicalTypeLong -> LogicalTypeLong -> Bool)
-> (LogicalTypeLong -> LogicalTypeLong -> Bool)
-> (LogicalTypeLong -> LogicalTypeLong -> Bool)
-> (LogicalTypeLong -> LogicalTypeLong -> Bool)
-> (LogicalTypeLong -> LogicalTypeLong -> LogicalTypeLong)
-> (LogicalTypeLong -> LogicalTypeLong -> LogicalTypeLong)
-> Ord 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
$cp1Ord :: Eq LogicalTypeLong
Ord, (forall x. LogicalTypeLong -> Rep LogicalTypeLong x)
-> (forall x. Rep LogicalTypeLong x -> LogicalTypeLong)
-> Generic LogicalTypeLong
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 -> ()
(LogicalTypeLong -> ()) -> NFData LogicalTypeLong
forall a. (a -> ()) -> NFData a
rnf :: LogicalTypeLong -> ()
$crnf :: LogicalTypeLong -> ()
NFData)

data LogicalTypeString
  = UUID
  deriving (LogicalTypeString -> LogicalTypeString -> Bool
(LogicalTypeString -> LogicalTypeString -> Bool)
-> (LogicalTypeString -> LogicalTypeString -> Bool)
-> Eq LogicalTypeString
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
(Int -> LogicalTypeString -> ShowS)
-> (LogicalTypeString -> String)
-> ([LogicalTypeString] -> ShowS)
-> Show LogicalTypeString
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
Eq LogicalTypeString
-> (LogicalTypeString -> LogicalTypeString -> Ordering)
-> (LogicalTypeString -> LogicalTypeString -> Bool)
-> (LogicalTypeString -> LogicalTypeString -> Bool)
-> (LogicalTypeString -> LogicalTypeString -> Bool)
-> (LogicalTypeString -> LogicalTypeString -> Bool)
-> (LogicalTypeString -> LogicalTypeString -> LogicalTypeString)
-> (LogicalTypeString -> LogicalTypeString -> LogicalTypeString)
-> Ord 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
$cp1Ord :: Eq LogicalTypeString
Ord, (forall x. LogicalTypeString -> Rep LogicalTypeString x)
-> (forall x. Rep LogicalTypeString x -> LogicalTypeString)
-> Generic LogicalTypeString
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 -> ()
(LogicalTypeString -> ()) -> NFData LogicalTypeString
forall a. (a -> ()) -> NFData a
rnf :: LogicalTypeString -> ()
$crnf :: LogicalTypeString -> ()
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 Maybe LogicalTypeInt -> Maybe LogicalTypeInt -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe LogicalTypeInt
lt2
  Long Maybe LogicalTypeLong
lt1 == Long Maybe LogicalTypeLong
lt2 = Maybe LogicalTypeLong
lt1 Maybe LogicalTypeLong -> Maybe LogicalTypeLong -> Bool
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 Maybe LogicalTypeBytes -> Maybe LogicalTypeBytes -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe LogicalTypeBytes
lt2
  String Maybe LogicalTypeString
lt1 == String Maybe LogicalTypeString
lt2 = Maybe LogicalTypeString
lt1 Maybe LogicalTypeString -> Maybe LogicalTypeString -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe LogicalTypeString
lt2

  Array Schema
ty == Array Schema
ty2 = Schema
ty Schema -> Schema -> Bool
forall a. Eq a => a -> a -> Bool
== Schema
ty2
  Map Schema
ty == Map Schema
ty2 = Schema
ty Schema -> Schema -> Bool
forall a. Eq a => a -> a -> Bool
== Schema
ty2
  NamedType TypeName
t == NamedType TypeName
t2 = TypeName
t TypeName -> TypeName -> Bool
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 TypeName -> TypeName -> Bool
forall a. Eq a => a -> a -> Bool
== TypeName
name2) Bool -> Bool -> Bool
&& ([Field]
fs1 [Field] -> [Field] -> Bool
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 TypeName -> TypeName -> Bool
forall a. Eq a => a -> a -> Bool
== TypeName
name2) Bool -> Bool -> Bool
&& (Vector Text
s Vector Text -> Vector Text -> Bool
forall a. Eq a => a -> a -> Bool
== Vector Text
s2)
  Union Vector Schema
a == Union Vector Schema
b = Vector Schema
a Vector Schema -> Vector Schema -> Bool
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 TypeName -> TypeName -> Bool
forall a. Eq a => a -> a -> Bool
== TypeName
name2) Bool -> Bool -> Bool
&& (Int
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
s2) Bool -> Bool -> Bool
&& (Maybe LogicalTypeFixed
lt1 Maybe LogicalTypeFixed -> Maybe LogicalTypeFixed -> Bool
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 ([Text] -> Vector Text
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 (Vector Schema -> Schema)
-> (NonEmpty Schema -> Vector Schema) -> NonEmpty Schema -> Schema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Schema] -> Vector Schema
forall a. [a] -> Vector a
V.fromList ([Schema] -> Vector Schema)
-> (NonEmpty Schema -> [Schema])
-> NonEmpty Schema
-> Vector Schema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Schema -> [Schema]
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
(TypeName -> TypeName -> Bool)
-> (TypeName -> TypeName -> Bool) -> Eq TypeName
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
Eq TypeName
-> (TypeName -> TypeName -> Ordering)
-> (TypeName -> TypeName -> Bool)
-> (TypeName -> TypeName -> Bool)
-> (TypeName -> TypeName -> Bool)
-> (TypeName -> TypeName -> Bool)
-> (TypeName -> TypeName -> TypeName)
-> (TypeName -> TypeName -> TypeName)
-> Ord 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
$cp1Ord :: Eq TypeName
Ord, (forall x. TypeName -> Rep TypeName x)
-> (forall x. Rep TypeName x -> TypeName) -> Generic TypeName
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 -> ()
(TypeName -> ()) -> NFData 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 = Text -> String
forall a. Show a => a -> String
show (Text -> String) -> (TypeName -> Text) -> TypeName -> String
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
"." ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [Text]
namespace [Text] -> [Text] -> [Text]
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 -> [Text] -> TypeName
TN { Text
baseName :: Text
baseName :: Text
baseName, [Text]
namespace :: [Text]
namespace :: [Text]
namespace }
  where
    baseName :: Text
baseName  = [Text] -> Text
forall a. [a] -> a
last [Text]
components
    namespace :: [Text]
namespace = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"") ([Text] -> [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 ([Text] -> TypeName) -> [Text] -> TypeName
forall a b. (a -> b) -> a -> b
$ (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Text -> Bool
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 ([Text] -> TypeName) -> [Text] -> TypeName
forall a b. (a -> b) -> a -> b
$ [Text] -> (TypeName -> [Text]) -> Maybe TypeName -> [Text]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] TypeName -> [Text]
namespace Maybe TypeName
context
  where isFullName :: Text -> Bool
isFullName = Maybe Char -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Char -> Bool) -> (Text -> Maybe Char) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Maybe Char
T.find (Char -> Char -> Bool
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 (Text -> TypeName) -> (String -> Text) -> String -> TypeName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a. IsString a => String -> a
fromString

instance Hashable TypeName where
  hashWithSalt :: Int -> TypeName -> Int
hashWithSalt Int
s (TypeName -> Text
renderFullname -> Text
name) =
    Int -> Text -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt (Int -> Text -> Int
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"
    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 (Vector Schema -> Schema
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 (TypeName -> Text) -> TypeName -> Text
forall a b. (a -> b) -> a -> b
$ Schema -> TypeName
name Schema
bt
  where
    decimalName :: Decimal -> Text
decimalName (Decimal Integer
prec Integer
sc) = Text
"decimal(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Integer -> String
forall a. Show a => a -> String
show Integer
prec) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"," Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Integer -> String
forall a. Show a => a -> String
show Integer
sc) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"

instance FromJSON Schema where
  parseJSON :: Value -> Parser Schema
parseJSON = Maybe TypeName -> Value -> Parser Schema
parseSchemaJSON Maybe TypeName
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"             -> Schema -> Parser Schema
forall (m :: * -> *) a. Monad m => a -> m a
return Schema
Null
    Text
"boolean"          -> Schema -> Parser Schema
forall (m :: * -> *) a. Monad m => a -> m a
return Schema
Boolean
    Text
"int"              -> Schema -> Parser Schema
forall (m :: * -> *) a. Monad m => a -> m a
return (Schema -> Parser Schema) -> Schema -> Parser Schema
forall a b. (a -> b) -> a -> b
$ Maybe LogicalTypeInt -> Schema
Int Maybe LogicalTypeInt
forall a. Maybe a
Nothing
    Text
"long"             -> Schema -> Parser Schema
forall (m :: * -> *) a. Monad m => a -> m a
return (Schema -> Parser Schema) -> Schema -> Parser Schema
forall a b. (a -> b) -> a -> b
$ Maybe LogicalTypeLong -> Schema
Long Maybe LogicalTypeLong
forall a. Maybe a
Nothing
    Text
"float"            -> Schema -> Parser Schema
forall (m :: * -> *) a. Monad m => a -> m a
return Schema
Float
    Text
"double"           -> Schema -> Parser Schema
forall (m :: * -> *) a. Monad m => a -> m a
return Schema
Double
    Text
"bytes"            -> Schema -> Parser Schema
forall (m :: * -> *) a. Monad m => a -> m a
return (Schema -> Parser Schema) -> Schema -> Parser Schema
forall a b. (a -> b) -> a -> b
$ Maybe LogicalTypeBytes -> Schema
Bytes Maybe LogicalTypeBytes
forall a. Maybe a
Nothing
    Text
"string"           -> Schema -> Parser Schema
forall (m :: * -> *) a. Monad m => a -> m a
return (Schema -> Parser Schema) -> Schema -> Parser Schema
forall a b. (a -> b) -> a -> b
$ Maybe LogicalTypeString -> Schema
String Maybe LogicalTypeString
forall a. Maybe a
Nothing
    Text
"uuid"             -> Schema -> Parser Schema
forall (m :: * -> *) a. Monad m => a -> m a
return (Schema -> Parser Schema) -> Schema -> Parser Schema
forall a b. (a -> b) -> a -> b
$ Maybe LogicalTypeString -> Schema
String (LogicalTypeString -> Maybe LogicalTypeString
forall a. a -> Maybe a
Just LogicalTypeString
UUID)
    Text
"date"             -> Schema -> Parser Schema
forall (m :: * -> *) a. Monad m => a -> m a
return (Schema -> Parser Schema) -> Schema -> Parser Schema
forall a b. (a -> b) -> a -> b
$ Maybe LogicalTypeInt -> Schema
Int (LogicalTypeInt -> Maybe LogicalTypeInt
forall a. a -> Maybe a
Just LogicalTypeInt
Date)
    Text
"time-millis"      -> Schema -> Parser Schema
forall (m :: * -> *) a. Monad m => a -> m a
return (Schema -> Parser Schema) -> Schema -> Parser Schema
forall a b. (a -> b) -> a -> b
$ Maybe LogicalTypeInt -> Schema
Int (LogicalTypeInt -> Maybe LogicalTypeInt
forall a. a -> Maybe a
Just LogicalTypeInt
TimeMillis)
    Text
"time-micros"      -> Schema -> Parser Schema
forall (m :: * -> *) a. Monad m => a -> m a
return (Schema -> Parser Schema) -> Schema -> Parser Schema
forall a b. (a -> b) -> a -> b
$ Maybe LogicalTypeLong -> Schema
Long (LogicalTypeLong -> Maybe LogicalTypeLong
forall a. a -> Maybe a
Just LogicalTypeLong
TimeMicros)
    Text
"timestamp-millis" -> Schema -> Parser Schema
forall (m :: * -> *) a. Monad m => a -> m a
return (Schema -> Parser Schema) -> Schema -> Parser Schema
forall a b. (a -> b) -> a -> b
$ Maybe LogicalTypeLong -> Schema
Long (LogicalTypeLong -> Maybe LogicalTypeLong
forall a. a -> Maybe a
Just LogicalTypeLong
TimestampMillis)
    Text
"timestamp-micros" -> Schema -> Parser Schema
forall (m :: * -> *) a. Monad m => a -> m a
return (Schema -> Parser Schema) -> Schema -> Parser Schema
forall a b. (a -> b) -> a -> b
$ Maybe LogicalTypeLong -> Schema
Long (LogicalTypeLong -> Maybe LogicalTypeLong
forall a. a -> Maybe a
Just LogicalTypeLong
TimestampMicros)
    Text
somename           -> Schema -> Parser Schema
forall (m :: * -> *) a. Monad m => a -> m a
return (Schema -> Parser Schema) -> Schema -> Parser Schema
forall a b. (a -> b) -> a -> b
$ TypeName -> Schema
NamedType (TypeName -> Schema) -> TypeName -> Schema
forall a b. (a -> b) -> a -> b
$ Maybe TypeName -> Text -> Maybe Text -> TypeName
mkTypeName Maybe TypeName
context Text
somename Maybe Text
forall a. Maybe a
Nothing
  A.Array Array
arr
    | Array -> Int
forall a. Vector a -> Int
V.length Array
arr Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 ->
      Vector Schema -> Schema
Union (Vector Schema -> Schema)
-> Parser (Vector Schema) -> Parser Schema
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Parser Schema) -> Array -> Parser (Vector Schema)
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) Array
arr
    | Bool
otherwise        -> String -> Parser Schema
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 Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"logicalType"
    Text
ty                        <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"

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

  Value
invalid    -> String -> Value -> Parser Schema
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 Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
      Maybe Text
namespace <- Object
o Object -> Key -> Parser (Maybe Text)
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 (TypeName -> Maybe TypeName
forall a. a -> Maybe a
Just TypeName
typeName) Text
name Maybe Text
forall a. Maybe a
Nothing
      [TypeName]
aliases <- TypeName -> [Text] -> [TypeName]
mkAliases TypeName
typeName ([Text] -> [TypeName]) -> Parser [Text] -> Parser [TypeName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"aliases" Parser (Maybe [Text]) -> [Text] -> Parser [Text]
forall a. Parser (Maybe a) -> a -> Parser a
.!= [])
      Int
size    <- Object
o Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"size"
      Schema -> Parser Schema
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Schema -> Parser Schema) -> Schema -> Parser Schema
forall a b. (a -> b) -> a -> b
$ TypeName -> [TypeName] -> Int -> Maybe LogicalTypeFixed -> Schema
Fixed TypeName
typeName [TypeName]
aliases Int
size Maybe LogicalTypeFixed
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 = (Text -> TypeName) -> [Text] -> [TypeName]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> TypeName) -> [Text] -> [TypeName])
-> (Text -> TypeName) -> [Text] -> [TypeName]
forall a b. (a -> b) -> a -> b
$ \ Text
name ->
  Maybe TypeName -> Text -> Maybe Text -> TypeName
mkTypeName (TypeName -> Maybe TypeName
forall a. a -> Maybe a
Just TypeName
context) Text
name Maybe Text
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 Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
    Maybe Text
doc   <- Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"doc"
    Schema
ty    <- Maybe TypeName -> Value -> Parser Schema
parseSchemaJSON (TypeName -> Maybe TypeName
forall a. a -> Maybe a
Just TypeName
record) (Value -> Parser Schema) -> Parser Value -> Parser Schema
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o Object -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
    let err :: a
err = String -> a
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 Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:! Key
"default"
    Maybe DefaultValue
def   <- case (TypeName -> Maybe Schema)
-> Schema -> Value -> Result DefaultValue
parseFieldDefault TypeName -> Maybe Schema
forall a. a
err Schema
ty (Value -> Result DefaultValue)
-> Maybe Value -> Maybe (Result DefaultValue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Value
defM of
      Just (Success DefaultValue
x) -> Maybe DefaultValue -> Parser (Maybe DefaultValue)
forall (m :: * -> *) a. Monad m => a -> m a
return (DefaultValue -> Maybe DefaultValue
forall a. a -> Maybe a
Just DefaultValue
x)
      Just (Error String
e)   -> String -> Parser (Maybe DefaultValue)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
e
      Maybe (Result DefaultValue)
Nothing          -> Maybe DefaultValue -> Parser (Maybe DefaultValue)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe DefaultValue
forall a. Maybe a
Nothing
    Maybe Order
order <- Object
o Object -> Key -> Parser (Maybe (Maybe Order))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"order" Parser (Maybe (Maybe Order)) -> Maybe Order -> Parser (Maybe Order)
forall a. Parser (Maybe a) -> a -> Parser a
.!= Order -> Maybe Order
forall a. a -> Maybe a
Just Order
Ascending

    let mkAlias :: Text -> TypeName
mkAlias Text
name = Maybe TypeName -> Text -> Maybe Text -> TypeName
mkTypeName (TypeName -> Maybe TypeName
forall a. a -> Maybe a
Just TypeName
record) Text
name Maybe Text
forall a. Maybe a
Nothing
    [Text]
aliases  <- Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"aliases"  Parser (Maybe [Text]) -> [Text] -> Parser [Text]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
    Field -> Parser Field
forall (m :: * -> *) a. Monad m => a -> m a
return (Field -> Parser Field) -> Field -> Parser Field
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    -> String -> Value -> Parser Field
forall a. String -> Value -> Parser a
typeMismatch String
"Field" Value
invalid

instance ToJSON Schema where
  toJSON :: Schema -> Value
toJSON = Maybe TypeName -> Schema -> Value
schemaToJSON Maybe TypeName
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" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"int" :: Text), Key
"logicalType" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"decimal" :: Text)
           , Key
"precision" Key -> Integer -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Integer
prec, Key
"scale" Key -> Integer -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Integer
sc ]
  Int (Just LogicalTypeInt
Date) ->
    [Pair] -> Value
object [ Key
"type" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"int" :: Text), Key
"logicalType" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"date" :: Text) ]
  Int (Just LogicalTypeInt
TimeMillis) ->
    [Pair] -> Value
object [ Key
"type" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"int" :: Text), Key
"logicalType" Key -> Text -> Pair
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" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"long" :: Text), Key
"logicalType" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"decimal" :: Text)
           , Key
"precision" Key -> Integer -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Integer
prec, Key
"scale" Key -> Integer -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Integer
sc ]
  Long (Just LogicalTypeLong
TimeMicros) ->
    [Pair] -> Value
object [ Key
"type" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"long" :: Text), Key
"logicalType" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"time-micros" :: Text) ]
  Long (Just LogicalTypeLong
TimestampMillis) ->
    [Pair] -> Value
object [ Key
"type" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"long" :: Text), Key
"logicalType" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"timestamp-millis" :: Text) ]
  Long (Just LogicalTypeLong
TimestampMicros) ->
    [Pair] -> Value
object [ Key
"type" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"long" :: Text), Key
"logicalType" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"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" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"bytes" :: Text), Key
"logicalType" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"decimal" :: Text)
           , Key
"precision" Key -> Integer -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Integer
prec, Key
"scale" Key -> Integer -> Pair
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" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"string" :: Text), Key
"logicalType" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"uuid" :: Text) ]
  Array Schema
tn        ->
    [Pair] -> Value
object [ Key
"type" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"array" :: Text), Key
"items" Key -> Value -> Pair
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" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"map" :: Text), Key
"values" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe TypeName -> Schema -> Value
schemaToJSON Maybe TypeName
context Schema
tn ]
  NamedType TypeName
name  -> Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> Text -> Value
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 = [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes
          [ (Key
"doc" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=)   (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
doc
          ]
    in [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Pair]
opts [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++
       [ Key
"type"    Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"record" :: Text)
       , Key
"name"    Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe TypeName -> TypeName -> Text
render Maybe TypeName
context TypeName
name
       , Key
"aliases" Key -> [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Maybe TypeName -> TypeName -> Text
render (TypeName -> Maybe TypeName
forall a. a -> Maybe a
Just TypeName
name) (TypeName -> Text) -> [TypeName] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TypeName]
aliases)
       , Key
"fields"  Key -> [Value] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (TypeName -> Field -> Value
fieldToJSON TypeName
name (Field -> Value) -> [Field] -> [Value]
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 = [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [(Key
"doc" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
doc]
    in [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Pair]
opts [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++
       [ Key
"type"    Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"enum" :: Text)
       , Key
"name"    Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe TypeName -> TypeName -> Text
render Maybe TypeName
context TypeName
name
       , Key
"aliases" Key -> [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Maybe TypeName -> TypeName -> Text
render (TypeName -> Maybe TypeName
forall a. a -> Maybe a
Just TypeName
name) (TypeName -> Text) -> [TypeName] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TypeName]
aliases)
       , Key
"symbols" Key -> Vector Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Vector Text
symbols
       ]
  Union  {Vector Schema
options :: Vector Schema
options :: Schema -> Vector Schema
..} -> Array -> Value
forall a. ToJSON a => a -> Value
toJSON (Array -> Value) -> Array -> Value
forall a b. (a -> b) -> a -> b
$ Maybe TypeName -> Schema -> Value
schemaToJSON Maybe TypeName
context (Schema -> Value) -> Vector Schema -> Array
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"    Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"fixed" :: Text)
           , Key
"name"    Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe TypeName -> TypeName -> Text
render Maybe TypeName
context TypeName
name
           , Key
"aliases" Key -> [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Maybe TypeName -> TypeName -> Text
render (TypeName -> Maybe TypeName
forall a. a -> Maybe a
Just TypeName
name) (TypeName -> Text) -> [TypeName] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TypeName]
aliases)
           , Key
"size"    Key -> Int -> Pair
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" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"duration" :: Text) ]
          Just (DecimalF (Decimal Integer
prec Integer
sc))
                   -> [ Key
"logicalType" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"decimal" :: Text)
                      , Key
"precision" Key -> Integer -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Integer
prec, Key
"scale" Key -> Integer -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Integer
sc ]
    in [Pair] -> Value
object ([Pair]
basic [Pair] -> [Pair] -> [Pair]
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 [Text] -> [Text] -> Bool
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 = [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes
                [ (Key
"order" Key -> Order -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=)     (Order -> Pair) -> Maybe Order -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Order
fldOrder
                , (Key
"doc" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=)       (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
fldDoc
                , (Key
"default" Key -> DefaultValue -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=)   (DefaultValue -> Pair) -> Maybe DefaultValue -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DefaultValue -> DefaultValue)
-> Maybe DefaultValue -> Maybe DefaultValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DefaultValue -> DefaultValue
adjustDefaultValue Maybe DefaultValue
fldDefault
                ]
          in [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Pair]
opts [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++
             [ Key
"name"    Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
fldName
             , Key
"type"    Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe TypeName -> Schema -> Value
schemaToJSON (TypeName -> Maybe TypeName
forall a. a -> Maybe a
Just TypeName
context) Schema
fldType
             , Key
"aliases" Key -> [Text] -> Pair
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 (Int32 -> Scientific
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
i)
      DLong Schema
_ Int64
i        -> Scientific -> Value
A.Number (Int64 -> Scientific
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
i)
      DFloat Schema
_ Float
f       -> Scientific -> Value
A.Number (Float -> Scientific
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
f)
      DDouble Schema
_ Double
d      -> Scientific -> Value
A.Number (Double -> Scientific
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       -> Array -> Value
A.Array ((DefaultValue -> Value) -> Vector DefaultValue -> Array
forall a b. (a -> b) -> Vector a -> Vector b
V.map DefaultValue -> Value
forall a. ToJSON a => a -> Value
toJSON Vector DefaultValue
vec)
      DMap HashMap Text DefaultValue
mp          -> Object -> Value
A.Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ (DefaultValue -> Value) -> KeyMap DefaultValue -> Object
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DefaultValue -> Value
forall a. ToJSON a => a -> Value
toJSON (HashMap Text DefaultValue -> KeyMap DefaultValue
forall v. HashMap Text v -> KeyMap v
KM.fromHashMapText HashMap Text DefaultValue
mp)
      DRecord Schema
_ HashMap Text DefaultValue
flds   -> Object -> Value
A.Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ (DefaultValue -> Value) -> KeyMap DefaultValue -> Object
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DefaultValue -> Value
forall a. ToJSON a => a -> Value
toJSON (HashMap Text DefaultValue -> KeyMap DefaultValue
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) Key -> DefaultValue -> Pair
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
(Result a -> Result a -> Bool)
-> (Result a -> Result a -> Bool) -> Eq (Result a)
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, Eq (Result a)
Eq (Result a)
-> (Result a -> Result a -> Ordering)
-> (Result a -> Result a -> Bool)
-> (Result a -> Result a -> Bool)
-> (Result a -> Result a -> Bool)
-> (Result a -> Result a -> Bool)
-> (Result a -> Result a -> Result a)
-> (Result a -> Result a -> Result a)
-> Ord (Result a)
Result a -> Result a -> Bool
Result a -> Result a -> Ordering
Result a -> Result a -> Result a
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
$cp1Ord :: forall a. Ord a => Eq (Result a)
Ord, Int -> Result a -> ShowS
[Result a] -> ShowS
Result a -> String
(Int -> Result a -> ShowS)
-> (Result a -> String) -> ([Result a] -> ShowS) -> Show (Result a)
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 x. Result a -> Rep (Result a) x)
-> (forall x. Rep (Result a) x -> Result a) -> Generic (Result a)
forall x. Rep (Result a) x -> Result a
forall x. Result a -> Rep (Result a) x
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, Result a -> ()
(Result a -> ()) -> NFData (Result a)
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 :: t -> String -> Result a
badValue t
v String
t = String -> Result a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Result a) -> String -> Result a
forall a b. (a -> b) -> a -> b
$ String
"Unexpected value for '" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
t String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"': " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> t -> String
forall a. Show a => a -> String
show t
v

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

instance Monad Result where
  return :: a -> Result a
return = a -> Result a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  Success a
a >>= :: Result a -> (a -> Result b) -> Result b
>>= a -> Result b
k = a -> Result b
k a
a
  Error String
e >>= a -> Result b
_ = String -> 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 :: (a -> b) -> Result a -> Result b
fmap a -> b
f (Success a
x) = b -> Result b
forall a. a -> Result a
Success (a -> b
f a
x)
  fmap a -> b
_ (Error String
e)   = String -> Result b
forall a. String -> Result a
Error String
e
instance MF.MonadFail Result where
  fail :: String -> Result a
fail = String -> Result a
forall a. String -> Result a
Error
instance MonadError String Result where
  throwError :: String -> Result a
throwError = String -> Result a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail
  catchError :: 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 :: a -> Result a
pure  = a -> Result a
forall a. a -> Result a
Success
  <*> :: Result (a -> b) -> Result a -> Result 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 :: Result a
empty = Result a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
  <|> :: Result a -> Result a -> Result a
(<|>) = Result a -> Result a -> Result a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus
instance MonadPlus Result where
  mzero :: Result a
mzero = String -> Result a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"mzero"
  mplus :: 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
(<>) = 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 = String -> Result a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Empty Result"
  mappend :: Result a -> Result a -> Result a
mappend = Result a -> Result a -> Result a
forall a. Semigroup a => a -> a -> a
(<>)
instance Foldable Result where
  foldMap :: (a -> m) -> Result a -> m
foldMap a -> m
_ (Error String
_)   = m
forall a. Monoid a => a
mempty
  foldMap a -> m
f (Success a
y) = a -> m
f a
y
  foldr :: (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 :: (a -> f b) -> Result a -> f (Result b)
traverse a -> f b
_ (Error String
err) = Result b -> f (Result b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Result b
forall a. String -> Result a
Error String
err)
  traverse a -> f b
f (Success a
v) = b -> Result b
forall a. a -> Result a
Success (b -> Result b) -> f b -> f (Result b)
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 (Vector Schema -> Schema
forall a. Vector a -> a
V.head Vector Schema
ts) (DefaultValue -> DefaultValue)
-> Result DefaultValue -> Result DefaultValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TypeName -> Maybe Schema)
-> Schema -> Value -> Result DefaultValue
parseFieldDefault TypeName -> Maybe Schema
env (Vector Schema -> Schema
forall a. Vector a -> a
V.head Vector Schema
ts) Value
val
        defaultUnion Schema
_ Value
_            = String -> Result DefaultValue
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 -> String -> Result DefaultValue
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Result DefaultValue) -> String -> Result DefaultValue
forall a b. (a -> b) -> a -> b
$ String
"Could not resolve type name for " String -> ShowS
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
_    -> DefaultValue -> Result DefaultValue
forall (m :: * -> *) a. Monad m => a -> m a
return (DefaultValue -> Result DefaultValue)
-> DefaultValue -> Result DefaultValue
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 Text -> Vector Text -> Maybe Int
forall a. Eq a => a -> Vector a -> Maybe Int
`V.elemIndex` Vector Text
symbols of
                Just Int
i  -> DefaultValue -> Result DefaultValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DefaultValue -> Result DefaultValue)
-> DefaultValue -> Result DefaultValue
forall a b. (a -> b) -> a -> b
$ Schema -> Int -> Text -> DefaultValue
DEnum Schema
ty Int
i Text
s
                Maybe Int
Nothing -> String -> Result DefaultValue
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Result DefaultValue) -> String -> Result DefaultValue
forall a b. (a -> b) -> a -> b
$ String
"JSON string is not one of the expected symbols for enum '" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> TypeName -> String
forall a. Show a => a -> String
show TypeName
name String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"': " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
s
          Bytes Maybe LogicalTypeBytes
_     -> Schema -> ByteString -> DefaultValue
DBytes Schema
ty (ByteString -> DefaultValue)
-> Result ByteString -> Result DefaultValue
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
            Bool -> Result () -> Result ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
size) (Result () -> Result ()) -> Result () -> Result ()
forall a b. (a -> b) -> a -> b
$
              String -> Result ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Result ()) -> String -> Result ()
forall a b. (a -> b) -> a -> b
$ String
"Fixed string wrong size. Expected " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
size String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" but got " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
len
            DefaultValue -> Result DefaultValue
forall (m :: * -> *) a. Monad m => a -> m a
return (DefaultValue -> Result DefaultValue)
-> DefaultValue -> Result DefaultValue
forall a b. (a -> b) -> a -> b
$ Schema -> ByteString -> DefaultValue
DFixed Schema
ty ByteString
bytes
          Schema
_ -> String -> Result DefaultValue
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Result DefaultValue) -> String -> Result DefaultValue
forall a b. (a -> b) -> a -> b
$ String
"Expected type String, Enum, Bytes, or Fixed, but found (Type,Value)="
             String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (Schema, Value) -> String
forall a. Show a => a -> String
show (Schema
ty, Value
av)
      A.Bool Bool
b       -> case Schema
ty of
                          Schema
Boolean -> DefaultValue -> Result DefaultValue
forall (m :: * -> *) a. Monad m => a -> m a
return (DefaultValue -> Result DefaultValue)
-> DefaultValue -> Result DefaultValue
forall a b. (a -> b) -> a -> b
$ Bool -> DefaultValue
DBoolean Bool
b
                          Schema
_       -> Schema -> Text -> Result DefaultValue
forall a. Schema -> Text -> Result a
avroTypeMismatch Schema
ty Text
"boolean"
      A.Number Scientific
i     ->
        case Schema
ty of
          Int Maybe LogicalTypeInt
_  -> DefaultValue -> Result DefaultValue
forall (m :: * -> *) a. Monad m => a -> m a
return (DefaultValue -> Result DefaultValue)
-> DefaultValue -> Result DefaultValue
forall a b. (a -> b) -> a -> b
$ Schema -> Int32 -> DefaultValue
DInt    Schema
ty (Scientific -> Int32
forall a b. (RealFrac a, Integral b) => a -> b
floor Scientific
i)
          Long Maybe LogicalTypeLong
_ -> DefaultValue -> Result DefaultValue
forall (m :: * -> *) a. Monad m => a -> m a
return (DefaultValue -> Result DefaultValue)
-> DefaultValue -> Result DefaultValue
forall a b. (a -> b) -> a -> b
$ Schema -> Int64 -> DefaultValue
DLong   Schema
ty (Scientific -> Int64
forall a b. (RealFrac a, Integral b) => a -> b
floor Scientific
i)
          Schema
Float  -> DefaultValue -> Result DefaultValue
forall (m :: * -> *) a. Monad m => a -> m a
return (DefaultValue -> Result DefaultValue)
-> DefaultValue -> Result DefaultValue
forall a b. (a -> b) -> a -> b
$ Schema -> Float -> DefaultValue
DFloat  Schema
ty (Scientific -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac Scientific
i)
          Schema
Double -> DefaultValue -> Result DefaultValue
forall (m :: * -> *) a. Monad m => a -> m a
return (DefaultValue -> Result DefaultValue)
-> DefaultValue -> Result DefaultValue
forall a b. (a -> b) -> a -> b
$ Schema -> Double -> DefaultValue
DDouble Schema
ty (Scientific -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Scientific
i)
          Schema
_      -> Schema -> Text -> Result DefaultValue
forall a. Schema -> Text -> Result a
avroTypeMismatch Schema
ty Text
"number"
      A.Array Array
vec    ->
        case Schema
ty of
          Array Schema
t -> Vector DefaultValue -> DefaultValue
DArray (Vector DefaultValue -> DefaultValue)
-> Result (Vector DefaultValue) -> Result DefaultValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Result DefaultValue)
-> Array -> Result (Vector DefaultValue)
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) Array
vec
          Schema
_       -> Schema -> Text -> Result DefaultValue
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 (HashMap Text DefaultValue -> DefaultValue)
-> Result (HashMap Text DefaultValue) -> Result DefaultValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Result DefaultValue)
-> HashMap Text Value -> Result (HashMap Text DefaultValue)
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) (Object -> HashMap Text Value
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 Key -> Object -> Maybe Value
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  -> DefaultValue -> Result DefaultValue
forall (m :: * -> *) a. Monad m => a -> m a
return DefaultValue
v
                                  Maybe DefaultValue
Nothing -> String -> Result DefaultValue
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Result DefaultValue) -> String -> Result DefaultValue
forall a b. (a -> b) -> a -> b
$ String
"Decode failure: No record field '" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack (Field -> Text
fldName Field
f) String -> ShowS
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 (HashMap Text DefaultValue -> DefaultValue)
-> ([(Text, DefaultValue)] -> HashMap Text DefaultValue)
-> [(Text, DefaultValue)]
-> DefaultValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, DefaultValue)] -> HashMap Text DefaultValue
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ([(Text, DefaultValue)] -> DefaultValue)
-> Result [(Text, DefaultValue)] -> Result DefaultValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Field -> Result (Text, DefaultValue))
-> [Field] -> Result [(Text, DefaultValue)]
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,) (DefaultValue -> (Text, DefaultValue))
-> Result DefaultValue -> Result (Text, DefaultValue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Field -> Result DefaultValue
lkAndParse Field
f) [Field]
fields
          Schema
_ -> Schema -> Text -> Result DefaultValue
forall a. Schema -> Text -> Result a
avroTypeMismatch Schema
ty Text
"object"
      Value
A.Null -> case Schema
ty of
                  Schema
Null -> DefaultValue -> Result DefaultValue
forall (m :: * -> *) a. Monad m => a -> m a
return DefaultValue
DNull
                  Schema
_    -> Schema -> Text -> Result DefaultValue
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 (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
inRange) Text
bytes of
  Just Char
badChar -> String -> Result ByteString
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Result ByteString) -> String -> Result ByteString
forall a b. (a -> b) -> a -> b
$ String
"Invalid character in bytes or fixed string representation: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Char -> String
forall a. Show a => a -> String
show Char
badChar
  Maybe Char
Nothing      -> ByteString -> Result ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Result ByteString)
-> ByteString -> Result ByteString
forall a b. (a -> b) -> a -> b
$ [Word8] -> ByteString
B.pack ([Word8] -> ByteString) -> [Word8] -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> (Char -> Int) -> Char -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
Char.ord (Char -> Word8) -> String -> [Word8]
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0x00 Bool -> Bool -> Bool
&& Int
c Int -> Int -> Bool
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 (String -> Text) -> (ByteString -> String) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Char) -> [Word8] -> String
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Char
Char.chr (Int -> Char) -> (Word8 -> Int) -> Word8 -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) ([Word8] -> String)
-> (ByteString -> [Word8]) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
B.unpack

avroTypeMismatch :: Schema -> Text -> Result a
avroTypeMismatch :: Schema -> Text -> Result a
avroTypeMismatch Schema
expected Text
actual =
  String -> Result a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Result a) -> String -> Result a
forall a b. (a -> b) -> a -> b
$ String
"Could not resolve type '" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
actual String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"' with expected type: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Schema -> String
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"  -> Order -> Parser Order
forall (m :: * -> *) a. Monad m => a -> m a
return Order
Ascending
      Text
"descending" -> Order -> Parser Order
forall (m :: * -> *) a. Monad m => a -> m a
return Order
Descending
      Text
"ignore"     -> Order -> Parser Order
forall (m :: * -> *) a. Monad m => a -> m a
return Order
Ignore
      Text
_            -> String -> Parser Order
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Order) -> String -> Parser Order
forall a b. (a -> b) -> a -> b
$ String
"Unknown string for order: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
s
  parseJSON Value
j = String -> Value -> Parser Order
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 = () -> Parser ()
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 :: (TypeName -> m Schema) -> Schema -> TypeName -> m Schema
buildTypeEnvironment TypeName -> m Schema
failure Schema
from =
    \ TypeName
forTy -> case TypeName -> HashMap TypeName Schema -> Maybe Schema
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 -> Schema -> m Schema
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 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Schema -> Text
typeName Schema
t
matches Schema
t n :: Schema
n@NamedType{}             = Schema -> Text
typeName Schema
t Text -> Text -> Bool
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{}       =
  [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [ Schema -> TypeName
name Schema
a TypeName -> TypeName -> Bool
forall a. Eq a => a -> a -> Bool
== Schema -> TypeName
name Schema
b
      , [Field] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Schema -> [Field]
fields Schema
a) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [Field] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Schema -> [Field]
fields Schema
b)
      , [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ (Field -> Field -> Bool) -> [Field] -> [Field] -> [Bool]
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 (Schema -> Schema -> Bool)
-> (Field -> Schema) -> Field -> Field -> Bool
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{}         = Vector Bool -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and (Vector Bool -> Bool) -> Vector Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (Schema -> Schema -> Bool)
-> Vector Schema -> Vector Schema -> Vector Bool
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 Schema -> Schema -> Bool
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 = [(TypeName, Schema)] -> HashMap TypeName Schema
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ([(TypeName, Schema)] -> HashMap TypeName Schema)
-> [(TypeName, Schema)] -> HashMap TypeName Schema
forall a b. (a -> b) -> a -> b
$ (TypeName
name TypeName -> [TypeName] -> [TypeName]
forall a. a -> [a] -> [a]
: [TypeName]
aliases) [TypeName] -> [Schema] -> [(TypeName, Schema)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` Schema -> [Schema]
forall a. a -> [a]
repeat Schema
t
    in [HashMap TypeName Schema] -> HashMap TypeName Schema
forall k v. (Eq k, Hashable k) => [HashMap k v] -> HashMap k v
HashMap.unions ([HashMap TypeName Schema] -> HashMap TypeName Schema)
-> [HashMap TypeName Schema] -> HashMap TypeName Schema
forall a b. (a -> b) -> a -> b
$ HashMap TypeName Schema
withRecord HashMap TypeName Schema
-> [HashMap TypeName Schema] -> [HashMap TypeName Schema]
forall a. a -> [a] -> [a]
: (Schema -> HashMap TypeName Schema
extractBindings (Schema -> HashMap TypeName Schema)
-> (Field -> Schema) -> Field -> HashMap TypeName Schema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Field -> Schema
fldType (Field -> HashMap TypeName Schema)
-> [Field] -> [HashMap TypeName Schema]
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
..}   -> [(TypeName, Schema)] -> HashMap TypeName Schema
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ([(TypeName, Schema)] -> HashMap TypeName Schema)
-> [(TypeName, Schema)] -> HashMap TypeName Schema
forall a b. (a -> b) -> a -> b
$ (TypeName
name TypeName -> [TypeName] -> [TypeName]
forall a. a -> [a] -> [a]
: [TypeName]
aliases) [TypeName] -> [Schema] -> [(TypeName, Schema)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` Schema -> [Schema]
forall a. a -> [a]
repeat Schema
e
  Union{Vector Schema
options :: Vector Schema
options :: Schema -> Vector Schema
..}    -> [HashMap TypeName Schema] -> HashMap TypeName Schema
forall k v. (Eq k, Hashable k) => [HashMap k v] -> HashMap k v
HashMap.unions ([HashMap TypeName Schema] -> HashMap TypeName Schema)
-> [HashMap TypeName Schema] -> HashMap TypeName Schema
forall a b. (a -> b) -> a -> b
$ Vector (HashMap TypeName Schema) -> [HashMap TypeName Schema]
forall a. Vector a -> [a]
V.toList (Vector (HashMap TypeName Schema) -> [HashMap TypeName Schema])
-> Vector (HashMap TypeName Schema) -> [HashMap TypeName Schema]
forall a b. (a -> b) -> a -> b
$ Schema -> HashMap TypeName Schema
extractBindings (Schema -> HashMap TypeName Schema)
-> Vector Schema -> Vector (HashMap TypeName Schema)
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
..}  -> [(TypeName, Schema)] -> HashMap TypeName Schema
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ([(TypeName, Schema)] -> HashMap TypeName Schema)
-> [(TypeName, Schema)] -> HashMap TypeName Schema
forall a b. (a -> b) -> a -> b
$ (TypeName
name TypeName -> [TypeName] -> [TypeName]
forall a. a -> [a] -> [a]
: [TypeName]
aliases) [TypeName] -> [Schema] -> [(TypeName, Schema)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` Schema -> [Schema]
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
_            -> HashMap TypeName Schema
forall k v. HashMap k v
HashMap.empty


expandNamedTypes :: Schema -> Schema
expandNamedTypes :: Schema -> Schema
expandNamedTypes =
  (State (HashMap TypeName Schema) Schema
 -> HashMap TypeName Schema -> Schema)
-> HashMap TypeName Schema
-> State (HashMap TypeName Schema) Schema
-> Schema
forall a b c. (a -> b -> c) -> b -> a -> c
flip State (HashMap TypeName Schema) Schema
-> HashMap TypeName Schema -> Schema
forall s a. State s a -> s -> a
evalState HashMap TypeName Schema
forall k v. HashMap k v
HashMap.empty (State (HashMap TypeName Schema) Schema -> Schema)
-> (Schema -> State (HashMap TypeName Schema) Schema)
-> Schema
-> Schema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> State (HashMap TypeName Schema) 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 }) (Schema -> Field)
-> State (HashMap TypeName Schema) Schema
-> StateT (HashMap TypeName Schema) Identity Field
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Schema -> State (HashMap TypeName Schema) Schema
go Schema
fldType
    go :: Schema -> State (HashMap TypeName Schema) Schema
go = \case
      t :: Schema
t@(NamedType TypeName
n)   -> Schema -> Maybe Schema -> Schema
forall a. a -> Maybe a -> a
fromMaybe Schema
t (Maybe Schema -> Schema)
-> StateT (HashMap TypeName Schema) Identity (Maybe Schema)
-> State (HashMap TypeName Schema) Schema
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (HashMap TypeName Schema -> Maybe Schema)
-> StateT (HashMap TypeName Schema) Identity (Maybe Schema)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (TypeName -> HashMap TypeName Schema -> Maybe Schema
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 })   (Schema -> Schema)
-> State (HashMap TypeName Schema) Schema
-> State (HashMap TypeName Schema) Schema
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Schema -> State (HashMap TypeName Schema) Schema
go Schema
item
      m :: Schema
m@Map{Schema
values :: Schema
values :: Schema -> Schema
values}     -> (\Schema
x -> Schema
m { values :: Schema
values = Schema
x }) (Schema -> Schema)
-> State (HashMap TypeName Schema) Schema
-> State (HashMap TypeName Schema) Schema
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Schema -> State (HashMap TypeName Schema) Schema
go Schema
values
      u :: Schema
u@Union{Vector Schema
options :: Vector Schema
options :: Schema -> Vector Schema
options}  -> Vector Schema -> Schema
Union (Vector Schema -> Schema)
-> StateT (HashMap TypeName Schema) Identity (Vector Schema)
-> State (HashMap TypeName Schema) Schema
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Schema -> State (HashMap TypeName Schema) Schema)
-> Vector Schema
-> StateT (HashMap TypeName Schema) Identity (Vector Schema)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Schema -> State (HashMap TypeName Schema) 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' <- (Field -> StateT (HashMap TypeName Schema) Identity Field)
-> [Field] -> StateT (HashMap TypeName Schema) Identity [Field]
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' }
        (HashMap TypeName Schema -> HashMap TypeName Schema)
-> StateT (HashMap TypeName Schema) Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (TypeName
-> Schema -> HashMap TypeName Schema -> HashMap TypeName Schema
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert TypeName
name Schema
r')
        Schema -> State (HashMap TypeName Schema) Schema
forall (f :: * -> *) a. Applicative f => a -> f a
pure Schema
r'

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

      Schema
other -> Schema -> State (HashMap TypeName Schema) Schema
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  = (Field -> Field) -> [Field] -> [Field]
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 ((Schema -> Schema) -> Vector Schema -> Vector Schema
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) = Schema -> TypeName -> HashMap TypeName Schema -> Schema
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 Maybe TypeName
forall a. Maybe a
Nothing Text
name Maybe Text
forall a. Maybe a
Nothing TypeName -> HashMap TypeName Schema -> Maybe Schema
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
`HashMap.lookup` Schema -> HashMap TypeName Schema
extractBindings Schema
schema