{-# 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 B
import           Data.ByteString.Lazy     (ByteString)
import qualified Data.ByteString.Lazy     as BL
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 :: 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 B.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 BL.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 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 [Tagged a Schema -> Schema
forall k (s :: k) 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 [Tagged a Schema -> Schema
forall k (s :: k) b. Tagged s b -> b
untag @a Tagged a Schema
forall a. HasAvroSchema a => Tagged a Schema
schema, Tagged b Schema -> Schema
forall k (s :: k) 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 = (Schema -> Schema) -> Tagged a Schema -> Tagged (Map Text a) 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 = (Schema -> Schema)
-> Tagged a Schema -> Tagged (HashMap Text a) 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 = (Schema -> Schema) -> Tagged a Schema -> Tagged (Map Text a) 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 = (Schema -> Schema)
-> Tagged a Schema -> Tagged (HashMap Text a) 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 = (Schema -> Schema)
-> Tagged a Schema -> Tagged (Map String a) 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 = (Schema -> Schema)
-> Tagged a Schema -> Tagged (HashMap String a) 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
:| [Tagged a Schema -> Schema
forall k (s :: k) 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 = (Schema -> Schema) -> Tagged a Schema -> Tagged [a] 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 = (Schema -> Schema) -> Tagged a Schema -> Tagged (Array i a) 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 = (Schema -> Schema) -> Tagged a Schema -> Tagged (Vector a) 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 = (Schema -> Schema) -> Tagged a Schema -> Tagged (Vector a) 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 = (Schema -> Schema) -> Tagged a Schema -> Tagged (Set a) 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 :: (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 #-}