{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module Deriving.Aeson.OrphanInstances () where

import Data.Aeson qualified as A
import Data.Kind
import Data.OpenApi
import Data.OpenApi.Internal.ParamSchema
import Data.OpenApi.Internal.Schema
import Data.Proxy
import Data.Typeable
import Deriving.Aeson qualified as A
import GHC.Generics
import GHC.TypeLits

instance (ToSchemaOptions t, Generic a, GToSchema (Rep a), Typeable a, Typeable (A.CustomJSON t a)) => ToSchema (A.CustomJSON t a) where
  declareNamedSchema :: Proxy (CustomJSON t a) -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy (CustomJSON t a)
Proxy = SchemaOptions
-> Proxy a -> Declare (Definitions Schema) NamedSchema
forall a.
(Generic a, GToSchema (Rep a), Typeable a) =>
SchemaOptions
-> Proxy a -> Declare (Definitions Schema) NamedSchema
genericDeclareNamedSchema (Proxy t -> SchemaOptions
forall (xs :: [*]). ToSchemaOptions xs => Proxy xs -> SchemaOptions
schemaOptions (Proxy t -> SchemaOptions) -> Proxy t -> SchemaOptions
forall a b. (a -> b) -> a -> b
$ forall (t :: [*]). Proxy t
forall {k} (t :: k). Proxy t
Proxy @t) (Proxy a -> Declare (Definitions Schema) NamedSchema)
-> Proxy a -> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a
instance (ToSchemaOptions t, Generic a, GToParamSchema (Rep a)) => ToParamSchema (A.CustomJSON t a) where
  toParamSchema :: Proxy (CustomJSON t a) -> Schema
toParamSchema Proxy (CustomJSON t a)
Proxy = SchemaOptions -> Proxy a -> Schema
forall {k} a (t :: k).
(Generic a, GToParamSchema (Rep a)) =>
SchemaOptions -> Proxy a -> Schema
genericToParamSchema (Proxy t -> SchemaOptions
forall (xs :: [*]). ToSchemaOptions xs => Proxy xs -> SchemaOptions
schemaOptions (Proxy t -> SchemaOptions) -> Proxy t -> SchemaOptions
forall a b. (a -> b) -> a -> b
$ forall (t :: [*]). Proxy t
forall {k} (t :: k). Proxy t
Proxy @t) (Proxy a -> Schema) -> Proxy a -> Schema
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a

type ToSchemaOptions :: [Type] -> Constraint
class ToSchemaOptions xs where
  schemaOptions :: Proxy xs -> SchemaOptions

instance ToSchemaOptions '[] where
  schemaOptions :: Proxy '[] -> SchemaOptions
schemaOptions Proxy '[]
Proxy = SchemaOptions
defaultSchemaOptions

instance ToSchemaOptions xs => ToSchemaOptions (A.UnwrapUnaryRecords ': xs) where
  schemaOptions :: Proxy (UnwrapUnaryRecords : xs) -> SchemaOptions
schemaOptions Proxy (UnwrapUnaryRecords : xs)
Proxy = (Proxy xs -> SchemaOptions
forall (xs :: [*]). ToSchemaOptions xs => Proxy xs -> SchemaOptions
schemaOptions (Proxy xs -> SchemaOptions) -> Proxy xs -> SchemaOptions
forall a b. (a -> b) -> a -> b
$ forall (t :: [*]). Proxy t
forall {k} (t :: k). Proxy t
Proxy @xs) {unwrapUnaryRecords = True}

-- instance ToSchemaOptions xs => ToSchemaOptions (A.OmitNothingFields ': xs) where
--  schemaOptions Proxy = (schemaOptions $ Proxy @xs) { omitNothingFields = True }

instance ToSchemaOptions xs => ToSchemaOptions (A.RejectUnknownFields ': xs) where
  schemaOptions :: Proxy (RejectUnknownFields : xs) -> SchemaOptions
schemaOptions Proxy (RejectUnknownFields : xs)
Proxy = Proxy xs -> SchemaOptions
forall (xs :: [*]). ToSchemaOptions xs => Proxy xs -> SchemaOptions
schemaOptions (Proxy xs -> SchemaOptions) -> Proxy xs -> SchemaOptions
forall a b. (a -> b) -> a -> b
$ forall (t :: [*]). Proxy t
forall {k} (t :: k). Proxy t
Proxy @xs

instance (A.StringModifier f, ToSchemaOptions xs) => ToSchemaOptions (A.FieldLabelModifier f ': xs) where
  schemaOptions :: Proxy (FieldLabelModifier f : xs) -> SchemaOptions
schemaOptions Proxy (FieldLabelModifier f : xs)
Proxy =
    let next :: SchemaOptions
next = Proxy xs -> SchemaOptions
forall (xs :: [*]). ToSchemaOptions xs => Proxy xs -> SchemaOptions
schemaOptions (Proxy xs -> SchemaOptions) -> Proxy xs -> SchemaOptions
forall a b. (a -> b) -> a -> b
$ forall (t :: [*]). Proxy t
forall {k} (t :: k). Proxy t
Proxy @xs
     in SchemaOptions
next {fieldLabelModifier = fieldLabelModifier next . A.getStringModifier @f}

instance (A.StringModifier f, ToSchemaOptions xs) => ToSchemaOptions (A.ConstructorTagModifier f ': xs) where
  schemaOptions :: Proxy (ConstructorTagModifier f : xs) -> SchemaOptions
schemaOptions Proxy (ConstructorTagModifier f : xs)
Proxy =
    let next :: SchemaOptions
next = Proxy xs -> SchemaOptions
forall (xs :: [*]). ToSchemaOptions xs => Proxy xs -> SchemaOptions
schemaOptions (Proxy xs -> SchemaOptions) -> Proxy xs -> SchemaOptions
forall a b. (a -> b) -> a -> b
$ forall (t :: [*]). Proxy t
forall {k} (t :: k). Proxy t
Proxy @xs
     in SchemaOptions
next {constructorTagModifier = constructorTagModifier next . A.getStringModifier @f}

instance (KnownSymbol t, KnownSymbol c, ToSchemaOptions xs) => ToSchemaOptions (A.SumTaggedObject t c ': xs) where
  schemaOptions :: Proxy (SumTaggedObject t c : xs) -> SchemaOptions
schemaOptions Proxy (SumTaggedObject t c : xs)
Proxy =
    (Proxy xs -> SchemaOptions
forall (xs :: [*]). ToSchemaOptions xs => Proxy xs -> SchemaOptions
schemaOptions (Proxy xs -> SchemaOptions) -> Proxy xs -> SchemaOptions
forall a b. (a -> b) -> a -> b
$ forall (t :: [*]). Proxy t
forall {k} (t :: k). Proxy t
Proxy @xs)
      { sumEncoding =
          A.TaggedObject
            { A.tagFieldName = symbolVal $ Proxy @t
            , A.contentsFieldName = symbolVal $ Proxy @c
            }
      }