{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} module Data.Avro.HasAvroSchema where import Control.Monad.Identity (Identity) import qualified Data.Array as Ar import Data.Avro.Schema.Decimal as D import Data.Avro.Schema.Schema as S import qualified Data.ByteString as Strict import qualified Data.ByteString.Lazy as Lazy import qualified Data.HashMap.Strict as HashMap import Data.Int import Data.Ix (Ix) import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.Map as Map import Data.Monoid ((<>)) import Data.Proxy import qualified Data.Set as S import Data.Tagged import Data.Text (Text) import qualified Data.Text as Text import qualified Data.Text.Lazy as TL import qualified Data.Time as Time import qualified Data.UUID as UUID import qualified Data.Vector as V import qualified Data.Vector.Unboxed as U import Data.Word import GHC.TypeLits class HasAvroSchema a where schema :: Tagged a Schema schemaOf :: (HasAvroSchema a) => a -> Schema schemaOf :: forall a. HasAvroSchema a => a -> Schema schemaOf = Tagged a Schema -> a -> Schema forall a b. Tagged a b -> a -> b witness Tagged a Schema forall a. HasAvroSchema a => Tagged a Schema schema instance HasAvroSchema Word8 where schema :: Tagged Word8 Schema schema = Schema -> Tagged Word8 Schema forall {k} (s :: k) b. b -> Tagged s b Tagged Schema S.Int' instance HasAvroSchema Word16 where schema :: Tagged Word16 Schema schema = Schema -> Tagged Word16 Schema forall {k} (s :: k) b. b -> Tagged s b Tagged Schema S.Int' instance HasAvroSchema Word32 where schema :: Tagged Word32 Schema schema = Schema -> Tagged Word32 Schema forall {k} (s :: k) b. b -> Tagged s b Tagged Schema S.Long' instance HasAvroSchema Word64 where schema :: Tagged Word64 Schema schema = Schema -> Tagged Word64 Schema forall {k} (s :: k) b. b -> Tagged s b Tagged Schema S.Long' instance HasAvroSchema Bool where schema :: Tagged Bool Schema schema = Schema -> Tagged Bool Schema forall {k} (s :: k) b. b -> Tagged s b Tagged Schema S.Boolean instance HasAvroSchema () where schema :: Tagged () Schema schema = Schema -> Tagged () Schema forall {k} (s :: k) b. b -> Tagged s b Tagged Schema S.Null instance HasAvroSchema Int where schema :: Tagged Int Schema schema = Schema -> Tagged Int Schema forall {k} (s :: k) b. b -> Tagged s b Tagged Schema S.Long' instance HasAvroSchema Int8 where schema :: Tagged Int8 Schema schema = Schema -> Tagged Int8 Schema forall {k} (s :: k) b. b -> Tagged s b Tagged Schema S.Int' instance HasAvroSchema Int16 where schema :: Tagged Int16 Schema schema = Schema -> Tagged Int16 Schema forall {k} (s :: k) b. b -> Tagged s b Tagged Schema S.Int' instance HasAvroSchema Int32 where schema :: Tagged Int32 Schema schema = Schema -> Tagged Int32 Schema forall {k} (s :: k) b. b -> Tagged s b Tagged Schema S.Int' instance HasAvroSchema Int64 where schema :: Tagged Int64 Schema schema = Schema -> Tagged Int64 Schema forall {k} (s :: k) b. b -> Tagged s b Tagged Schema S.Long' instance HasAvroSchema Double where schema :: Tagged Double Schema schema = Schema -> Tagged Double Schema forall {k} (s :: k) b. b -> Tagged s b Tagged Schema S.Double instance HasAvroSchema Float where schema :: Tagged Float Schema schema = Schema -> Tagged Float Schema forall {k} (s :: k) b. b -> Tagged s b Tagged Schema S.Float instance HasAvroSchema Text.Text where schema :: Tagged Text Schema schema = Schema -> Tagged Text Schema forall {k} (s :: k) b. b -> Tagged s b Tagged Schema S.String' instance HasAvroSchema TL.Text where schema :: Tagged Text Schema schema = Schema -> Tagged Text Schema forall {k} (s :: k) b. b -> Tagged s b Tagged Schema S.String' instance HasAvroSchema Strict.ByteString where schema :: Tagged ByteString Schema schema = Schema -> Tagged ByteString Schema forall {k} (s :: k) b. b -> Tagged s b Tagged Schema S.Bytes' instance HasAvroSchema Lazy.ByteString where schema :: Tagged ByteString Schema schema = Schema -> Tagged ByteString Schema forall {k} (s :: k) b. b -> Tagged s b Tagged Schema S.Bytes' instance (KnownNat p, KnownNat s) => HasAvroSchema (D.Decimal p s) where schema :: Tagged (Decimal p s) Schema schema = Schema -> Tagged (Decimal p s) Schema forall {k} (s :: k) b. b -> Tagged s b Tagged (Schema -> Tagged (Decimal p s) Schema) -> Schema -> Tagged (Decimal p s) Schema forall a b. (a -> b) -> a -> b $ Maybe LogicalTypeLong -> Schema S.Long (LogicalTypeLong -> Maybe LogicalTypeLong forall a. a -> Maybe a Just (Decimal -> LogicalTypeLong DecimalL (Integer -> Integer -> Decimal S.Decimal Integer pp Integer ss))) where ss :: Integer ss = Proxy s -> Integer forall (n :: Nat) (proxy :: Nat -> *). KnownNat n => proxy n -> Integer natVal (Proxy s forall {k} (t :: k). Proxy t Proxy :: Proxy s) pp :: Integer pp = Proxy p -> Integer forall (n :: Nat) (proxy :: Nat -> *). KnownNat n => proxy n -> Integer natVal (Proxy p forall {k} (t :: k). Proxy t Proxy :: Proxy p) instance HasAvroSchema UUID.UUID where schema :: Tagged UUID Schema schema = Schema -> Tagged UUID Schema forall {k} (s :: k) b. b -> Tagged s b Tagged (Schema -> Tagged UUID Schema) -> Schema -> Tagged UUID Schema forall a b. (a -> b) -> a -> b $ Maybe LogicalTypeString -> Schema S.String (LogicalTypeString -> Maybe LogicalTypeString forall a. a -> Maybe a Just LogicalTypeString UUID) instance HasAvroSchema Time.Day where schema :: Tagged Day Schema schema = Schema -> Tagged Day Schema forall {k} (s :: k) b. b -> Tagged s b Tagged (Schema -> Tagged Day Schema) -> Schema -> Tagged Day Schema forall a b. (a -> b) -> a -> b $ Maybe LogicalTypeInt -> Schema S.Int (LogicalTypeInt -> Maybe LogicalTypeInt forall a. a -> Maybe a Just LogicalTypeInt Date) instance HasAvroSchema Time.DiffTime where schema :: Tagged DiffTime Schema schema = Schema -> Tagged DiffTime Schema forall {k} (s :: k) b. b -> Tagged s b Tagged (Schema -> Tagged DiffTime Schema) -> Schema -> Tagged DiffTime Schema forall a b. (a -> b) -> a -> b $ Maybe LogicalTypeLong -> Schema S.Long (LogicalTypeLong -> Maybe LogicalTypeLong forall a. a -> Maybe a Just LogicalTypeLong TimeMicros) instance HasAvroSchema Time.UTCTime where schema :: Tagged UTCTime Schema schema = Schema -> Tagged UTCTime Schema forall {k} (s :: k) b. b -> Tagged s b Tagged (Schema -> Tagged UTCTime Schema) -> Schema -> Tagged UTCTime Schema forall a b. (a -> b) -> a -> b $ Maybe LogicalTypeLong -> Schema S.Long (LogicalTypeLong -> Maybe LogicalTypeLong forall a. a -> Maybe a Just LogicalTypeLong TimestampMicros) instance HasAvroSchema Time.LocalTime where schema :: Tagged LocalTime Schema schema = Schema -> Tagged LocalTime Schema forall {k} (s :: k) b. b -> Tagged s b Tagged (Schema -> Tagged LocalTime Schema) -> Schema -> Tagged LocalTime Schema forall a b. (a -> b) -> a -> b $ Maybe LogicalTypeLong -> Schema S.Long (LogicalTypeLong -> Maybe LogicalTypeLong forall a. a -> Maybe a Just LogicalTypeLong LocalTimestampMicros) instance (HasAvroSchema a) => HasAvroSchema (Identity a) where schema :: Tagged (Identity a) Schema schema = Schema -> Tagged (Identity a) Schema forall {k} (s :: k) b. b -> Tagged s b Tagged (Schema -> Tagged (Identity a) Schema) -> Schema -> Tagged (Identity a) Schema forall a b. (a -> b) -> a -> b $ Vector Schema -> Schema S.Union (Vector Schema -> Schema) -> Vector Schema -> Schema forall a b. (a -> b) -> a -> b $ Int -> [Schema] -> Vector Schema forall a. Int -> [a] -> Vector a V.fromListN Int 1 [forall {k} (s :: k) b. Tagged s b -> b forall s b. Tagged s b -> b untag @a Tagged a Schema forall a. HasAvroSchema a => Tagged a Schema schema] instance (HasAvroSchema a, HasAvroSchema b) => HasAvroSchema (Either a b) where schema :: Tagged (Either a b) Schema schema = Schema -> Tagged (Either a b) Schema forall {k} (s :: k) b. b -> Tagged s b Tagged (Schema -> Tagged (Either a b) Schema) -> Schema -> Tagged (Either a b) Schema forall a b. (a -> b) -> a -> b $ Vector Schema -> Schema S.Union (Vector Schema -> Schema) -> Vector Schema -> Schema forall a b. (a -> b) -> a -> b $ Int -> [Schema] -> Vector Schema forall a. Int -> [a] -> Vector a V.fromListN Int 2 [forall {k} (s :: k) b. Tagged s b -> b forall s b. Tagged s b -> b untag @a Tagged a Schema forall a. HasAvroSchema a => Tagged a Schema schema, forall {k} (s :: k) b. Tagged s b -> b forall s b. Tagged s b -> b untag @b Tagged b Schema forall a. HasAvroSchema a => Tagged a Schema schema] instance (HasAvroSchema a) => HasAvroSchema (Map.Map Text a) where schema :: Tagged (Map Text a) Schema schema = forall a b. (Schema -> Schema) -> Tagged a Schema -> Tagged b Schema wrapTag @a Schema -> Schema S.Map Tagged a Schema forall a. HasAvroSchema a => Tagged a Schema schema instance (HasAvroSchema a) => HasAvroSchema (HashMap.HashMap Text a) where schema :: Tagged (HashMap Text a) Schema schema = forall a b. (Schema -> Schema) -> Tagged a Schema -> Tagged b Schema wrapTag @a Schema -> Schema S.Map Tagged a Schema forall a. HasAvroSchema a => Tagged a Schema schema instance (HasAvroSchema a) => HasAvroSchema (Map.Map TL.Text a) where schema :: Tagged (Map Text a) Schema schema = forall a b. (Schema -> Schema) -> Tagged a Schema -> Tagged b Schema wrapTag @a Schema -> Schema S.Map Tagged a Schema forall a. HasAvroSchema a => Tagged a Schema schema instance (HasAvroSchema a) => HasAvroSchema (HashMap.HashMap TL.Text a) where schema :: Tagged (HashMap Text a) Schema schema = forall a b. (Schema -> Schema) -> Tagged a Schema -> Tagged b Schema wrapTag @a Schema -> Schema S.Map Tagged a Schema forall a. HasAvroSchema a => Tagged a Schema schema instance (HasAvroSchema a) => HasAvroSchema (Map.Map String a) where schema :: Tagged (Map String a) Schema schema = forall a b. (Schema -> Schema) -> Tagged a Schema -> Tagged b Schema wrapTag @a Schema -> Schema S.Map Tagged a Schema forall a. HasAvroSchema a => Tagged a Schema schema instance (HasAvroSchema a) => HasAvroSchema (HashMap.HashMap String a) where schema :: Tagged (HashMap String a) Schema schema = forall a b. (Schema -> Schema) -> Tagged a Schema -> Tagged b Schema wrapTag @a Schema -> Schema S.Map Tagged a Schema forall a. HasAvroSchema a => Tagged a Schema schema instance (HasAvroSchema a) => HasAvroSchema (Maybe a) where schema :: Tagged (Maybe a) Schema schema = Schema -> Tagged (Maybe a) Schema forall {k} (s :: k) b. b -> Tagged s b Tagged (Schema -> Tagged (Maybe a) Schema) -> Schema -> Tagged (Maybe a) Schema forall a b. (a -> b) -> a -> b $ NonEmpty Schema -> Schema mkUnion (Schema S.NullSchema -> [Schema] -> NonEmpty Schema forall a. a -> [a] -> NonEmpty a :| [forall {k} (s :: k) b. Tagged s b -> b forall s b. Tagged s b -> b untag @a Tagged a Schema forall a. HasAvroSchema a => Tagged a Schema schema]) instance (HasAvroSchema a) => HasAvroSchema [a] where schema :: Tagged [a] Schema schema = forall a b. (Schema -> Schema) -> Tagged a Schema -> Tagged b Schema wrapTag @a Schema -> Schema S.Array Tagged a Schema forall a. HasAvroSchema a => Tagged a Schema schema instance (HasAvroSchema a, Ix i) => HasAvroSchema (Ar.Array i a) where schema :: Tagged (Array i a) Schema schema = forall a b. (Schema -> Schema) -> Tagged a Schema -> Tagged b Schema wrapTag @a Schema -> Schema S.Array Tagged a Schema forall a. HasAvroSchema a => Tagged a Schema schema instance HasAvroSchema a => HasAvroSchema (V.Vector a) where schema :: Tagged (Vector a) Schema schema = forall a b. (Schema -> Schema) -> Tagged a Schema -> Tagged b Schema wrapTag @a Schema -> Schema S.Array Tagged a Schema forall a. HasAvroSchema a => Tagged a Schema schema instance HasAvroSchema a => HasAvroSchema (U.Vector a) where schema :: Tagged (Vector a) Schema schema = forall a b. (Schema -> Schema) -> Tagged a Schema -> Tagged b Schema wrapTag @a Schema -> Schema S.Array Tagged a Schema forall a. HasAvroSchema a => Tagged a Schema schema instance HasAvroSchema a => HasAvroSchema (S.Set a) where schema :: Tagged (Set a) Schema schema = forall a b. (Schema -> Schema) -> Tagged a Schema -> Tagged b Schema wrapTag @a Schema -> Schema S.Array Tagged a Schema forall a. HasAvroSchema a => Tagged a Schema schema wrapTag :: (Schema -> Schema) -> Tagged a Schema -> Tagged b Schema wrapTag :: forall a b. (Schema -> Schema) -> Tagged a Schema -> Tagged b Schema wrapTag Schema -> Schema f = Schema -> Tagged b Schema forall {k} (s :: k) b. b -> Tagged s b Tagged (Schema -> Tagged b Schema) -> (Tagged a Schema -> Schema) -> Tagged a Schema -> Tagged b Schema forall b c a. (b -> c) -> (a -> b) -> a -> c . Schema -> Schema f (Schema -> Schema) -> (Tagged a Schema -> Schema) -> Tagged a Schema -> Schema forall b c a. (b -> c) -> (a -> b) -> a -> c . Tagged a Schema -> Schema forall {k} (s :: k) b. Tagged s b -> b untag {-# INLINE wrapTag #-}