{-# 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 #-}