-- |
-- Module      : Data.Aeson.RecordAsTuple
-- Copyright   : (c) Michael Ledger 2026
-- License     : MPL-2.0
-- Maintainer  : Michael Ledger <mike@quasimal.com>
module Data.Aeson.RecordAsTuple (
  RecordAsTuple (..),
  gtupleToJSON,
  gtupleToEncoding,
  gtupleParseJSON,
) where

import Control.Monad.ST.Strict (ST)
import Data.Aeson (FromJSON, ToJSON)
import Data.Aeson qualified as JSON (Array, Encoding, FromJSON (parseJSON), ToJSON (toEncoding, toJSON), Value (..), withArray)
import Data.Aeson.Encoding.Internal (closeBracket, comma, emptyArray_, openBracket, (><))
import Data.Aeson.Types qualified as JSON (Parser)
import Data.Data (Proxy (..))
import Data.OpenApi (Definitions, NamedSchema (..), OpenApiItems (..), OpenApiType (..), Referenced (..), Schema (..), ToSchema (..))
import Data.OpenApi.Declare (Declare)
import Data.Primitive.Array (
  MutableArray,
  createArray,
  writeArray,
 )
import Data.String (fromString)
import Data.Typeable (Typeable, typeRep)
import Data.Vector (Vector)
import Data.Vector qualified as Vector
import GHC.Generics (
  C1,
  D1,
  Generic (..),
  K1 (K1),
  M1 (M1),
  S1,
  type (:*:) (..),
 )
import GHC.TypeNats (KnownNat, Nat, natVal, type (+))

-- | Use this with @-XDerivingVia@ to derive aeson decoders and encoders for
-- record types which encode the record as a JSON array rather than object.
--
-- Examples
-- >>> data P = P {x,y,z,w::Float} deriving stock (Show,Generic) deriving (ToJSON,FromJSON) via (RecordAsTuple P)
-- >>> JSON.toJSON (P 1 2 3 4)
-- Array [Number 1.0,Number 2.0,Number 3.0,Number 4.0]
-- >>> JSON.fromJSON @P (JSON.toJSON (P 1 2 3 4))
-- Success (P {x = 1.0, y = 2.0, z = 3.0, w = 4.0})
-- >>> data T = T {a,b,c::Float} deriving stock (Generic)
-- >>> JSON.toJSON (RecordAsTuple (T 1 2 3))
-- Array [Number 1.0,Number 2.0,Number 3.0]
newtype RecordAsTuple a = RecordAsTuple a
  deriving stock (RecordAsTuple a -> RecordAsTuple a -> Bool
(RecordAsTuple a -> RecordAsTuple a -> Bool)
-> (RecordAsTuple a -> RecordAsTuple a -> Bool)
-> Eq (RecordAsTuple a)
forall a. Eq a => RecordAsTuple a -> RecordAsTuple a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => RecordAsTuple a -> RecordAsTuple a -> Bool
== :: RecordAsTuple a -> RecordAsTuple a -> Bool
$c/= :: forall a. Eq a => RecordAsTuple a -> RecordAsTuple a -> Bool
/= :: RecordAsTuple a -> RecordAsTuple a -> Bool
Eq, Eq (RecordAsTuple a)
Eq (RecordAsTuple a) =>
(RecordAsTuple a -> RecordAsTuple a -> Ordering)
-> (RecordAsTuple a -> RecordAsTuple a -> Bool)
-> (RecordAsTuple a -> RecordAsTuple a -> Bool)
-> (RecordAsTuple a -> RecordAsTuple a -> Bool)
-> (RecordAsTuple a -> RecordAsTuple a -> Bool)
-> (RecordAsTuple a -> RecordAsTuple a -> RecordAsTuple a)
-> (RecordAsTuple a -> RecordAsTuple a -> RecordAsTuple a)
-> Ord (RecordAsTuple a)
RecordAsTuple a -> RecordAsTuple a -> Bool
RecordAsTuple a -> RecordAsTuple a -> Ordering
RecordAsTuple a -> RecordAsTuple a -> RecordAsTuple 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 (RecordAsTuple a)
forall a. Ord a => RecordAsTuple a -> RecordAsTuple a -> Bool
forall a. Ord a => RecordAsTuple a -> RecordAsTuple a -> Ordering
forall a.
Ord a =>
RecordAsTuple a -> RecordAsTuple a -> RecordAsTuple a
$ccompare :: forall a. Ord a => RecordAsTuple a -> RecordAsTuple a -> Ordering
compare :: RecordAsTuple a -> RecordAsTuple a -> Ordering
$c< :: forall a. Ord a => RecordAsTuple a -> RecordAsTuple a -> Bool
< :: RecordAsTuple a -> RecordAsTuple a -> Bool
$c<= :: forall a. Ord a => RecordAsTuple a -> RecordAsTuple a -> Bool
<= :: RecordAsTuple a -> RecordAsTuple a -> Bool
$c> :: forall a. Ord a => RecordAsTuple a -> RecordAsTuple a -> Bool
> :: RecordAsTuple a -> RecordAsTuple a -> Bool
$c>= :: forall a. Ord a => RecordAsTuple a -> RecordAsTuple a -> Bool
>= :: RecordAsTuple a -> RecordAsTuple a -> Bool
$cmax :: forall a.
Ord a =>
RecordAsTuple a -> RecordAsTuple a -> RecordAsTuple a
max :: RecordAsTuple a -> RecordAsTuple a -> RecordAsTuple a
$cmin :: forall a.
Ord a =>
RecordAsTuple a -> RecordAsTuple a -> RecordAsTuple a
min :: RecordAsTuple a -> RecordAsTuple a -> RecordAsTuple a
Ord, Int -> RecordAsTuple a -> ShowS
[RecordAsTuple a] -> ShowS
RecordAsTuple a -> String
(Int -> RecordAsTuple a -> ShowS)
-> (RecordAsTuple a -> String)
-> ([RecordAsTuple a] -> ShowS)
-> Show (RecordAsTuple a)
forall a. Show a => Int -> RecordAsTuple a -> ShowS
forall a. Show a => [RecordAsTuple a] -> ShowS
forall a. Show a => RecordAsTuple a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> RecordAsTuple a -> ShowS
showsPrec :: Int -> RecordAsTuple a -> ShowS
$cshow :: forall a. Show a => RecordAsTuple a -> String
show :: RecordAsTuple a -> String
$cshowList :: forall a. Show a => [RecordAsTuple a] -> ShowS
showList :: [RecordAsTuple a] -> ShowS
Show, ReadPrec [RecordAsTuple a]
ReadPrec (RecordAsTuple a)
Int -> ReadS (RecordAsTuple a)
ReadS [RecordAsTuple a]
(Int -> ReadS (RecordAsTuple a))
-> ReadS [RecordAsTuple a]
-> ReadPrec (RecordAsTuple a)
-> ReadPrec [RecordAsTuple a]
-> Read (RecordAsTuple a)
forall a. Read a => ReadPrec [RecordAsTuple a]
forall a. Read a => ReadPrec (RecordAsTuple a)
forall a. Read a => Int -> ReadS (RecordAsTuple a)
forall a. Read a => ReadS [RecordAsTuple a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall a. Read a => Int -> ReadS (RecordAsTuple a)
readsPrec :: Int -> ReadS (RecordAsTuple a)
$creadList :: forall a. Read a => ReadS [RecordAsTuple a]
readList :: ReadS [RecordAsTuple a]
$creadPrec :: forall a. Read a => ReadPrec (RecordAsTuple a)
readPrec :: ReadPrec (RecordAsTuple a)
$creadListPrec :: forall a. Read a => ReadPrec [RecordAsTuple a]
readListPrec :: ReadPrec [RecordAsTuple a]
Read)

instance
  ( Generic a
  , Rep a ~ D1 _dt (C1 _mcons flds)
  , GFieldsToJSON flds
  , KnownNat (ProductSize flds)
  )
  => ToJSON (RecordAsTuple a)
  where
  {-# INLINE toJSON #-}
  {-# INLINE toEncoding #-}
  toJSON :: RecordAsTuple a -> Value
toJSON (RecordAsTuple a
a) = Array -> Value
JSON.Array (D1 _dt (C1 _mcons flds) Any -> Array
forall {k} (flds :: k -> *) (k :: k) {w :: Meta} {w :: Meta}.
(KnownNat (ProductSize flds), GFieldsToJSON flds) =>
D1 w (C1 w flds) k -> Array
gtupleToJSON (a -> Rep a Any
forall x. a -> Rep a x
forall a x. Generic a => a -> Rep a x
from a
a))
  toEncoding :: RecordAsTuple a -> Encoding
toEncoding (RecordAsTuple a
a) = D1 _dt (C1 _mcons flds) Any -> Encoding
forall {k} (flds :: k -> *) (k :: k) {w :: Meta} {w :: Meta}.
(KnownNat (ProductSize flds), GFieldsToJSON flds) =>
D1 w (C1 w flds) k -> Encoding
gtupleToEncoding (a -> Rep a Any
forall x. a -> Rep a x
forall a x. Generic a => a -> Rep a x
from a
a)

instance (Generic a, Rep a ~ D1 _dt (C1 _mcons flds), GFieldsFromJSON flds) => FromJSON (RecordAsTuple a) where
  {-# INLINE parseJSON #-}
  parseJSON :: Value -> Parser (RecordAsTuple a)
parseJSON Value
v = a -> RecordAsTuple a
forall a. a -> RecordAsTuple a
RecordAsTuple (a -> RecordAsTuple a)
-> (D1 _dt (C1 _mcons flds) Any -> a)
-> D1 _dt (C1 _mcons flds) Any
-> RecordAsTuple a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. D1 _dt (C1 _mcons flds) Any -> a
Rep a Any -> a
forall a x. Generic a => Rep a x -> a
forall x. Rep a x -> a
to (D1 _dt (C1 _mcons flds) Any -> RecordAsTuple a)
-> Parser (D1 _dt (C1 _mcons flds) Any) -> Parser (RecordAsTuple a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
-> (Array -> Parser (D1 _dt (C1 _mcons flds) Any))
-> Value
-> Parser (D1 _dt (C1 _mcons flds) Any)
forall a. String -> (Array -> Parser a) -> Value -> Parser a
JSON.withArray String
"RecordAsTuple" Array -> Parser (D1 _dt (C1 _mcons flds) Any)
forall {k} (flds :: k -> *) (k :: k) {w :: Meta} {w :: Meta}.
GFieldsFromJSON flds =>
Array -> Parser (D1 w (C1 w flds) k)
gtupleParseJSON Value
v

type family ProductSize flds :: Nat where
  ProductSize (f :*: g) = ProductSize f + ProductSize g
  ProductSize _ = 1

{-# INLINE recordSize #-}
{-# INLINE gtupleToJSON #-}
{-# INLINE gtupleToEncoding #-}
{-# INLINE gtupleParseJSON #-}

recordSize :: forall x. (KnownNat (ProductSize x)) => Int
recordSize :: forall {k} (x :: k -> *). KnownNat (ProductSize x) => Int
recordSize = Natural -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Proxy (ProductSize x) -> Natural
forall (n :: Natural) (proxy :: Natural -> *).
KnownNat n =>
proxy n -> Natural
natVal (forall (t :: Natural). Proxy t
forall {k} (t :: k). Proxy t
Proxy @(ProductSize x)))

gtupleToJSON :: (KnownNat (ProductSize flds), GFieldsToJSON flds) => D1 _dt (C1 _mcons flds) k -> Vector JSON.Value
gtupleToJSON :: D1 w (C1 w flds) k -> Array
gtupleToJSON (M1 (M1 flds k
flds) :: D1 _ (C1 _ flds) _) =
  Array Value -> Array
forall a. Array a -> Vector a
Vector.fromArray
    ( Int
-> Value
-> (forall s. MutableArray s Value -> ST s ())
-> Array Value
forall a.
Int -> a -> (forall s. MutableArray s a -> ST s ()) -> Array a
createArray Int
len (String -> Value
forall a. HasCallStack => String -> a
error String
"gtupleToJSON: unitialised element") \MutableArray s Value
mut -> do
        Int -> MutableArray s Value -> flds k -> ST s ()
forall s (k :: k). Int -> MutableArray s Value -> flds k -> ST s ()
forall {k} (a :: k -> *) s (k :: k).
GFieldsToJSON a =>
Int -> MutableArray s Value -> a k -> ST s ()
gunsafeWriteFieldsToJSON Int
0 MutableArray s Value
mut flds k
flds
    )
  where
    !len :: Int
len = forall {k} (x :: k -> *). KnownNat (ProductSize x) => Int
forall (x :: k -> *). KnownNat (ProductSize x) => Int
recordSize @flds

gtupleToEncoding :: (KnownNat (ProductSize flds), GFieldsToJSON flds) => D1 _dt (C1 _mcons flds) k -> JSON.Encoding
gtupleToEncoding :: D1 w (C1 w flds) k -> Encoding
gtupleToEncoding (M1 (M1 flds k
flds) :: D1 _ (C1 _ flds) _)
  | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = Encoding
forall a. Encoding' a
openBracket Encoding -> Encoding -> Encoding
forall a. Encoding' a -> Encoding' a -> Encoding' a
>< flds k -> Encoding
forall (k :: k). flds k -> Encoding
forall {k} (a :: k -> *) (k :: k).
GFieldsToJSON a =>
a k -> Encoding
gfieldsToEncoding flds k
flds Encoding -> Encoding -> Encoding
forall a. Encoding' a -> Encoding' a -> Encoding' a
>< Encoding
forall a. Encoding' a
closeBracket
  | Bool
otherwise = Encoding
emptyArray_
  where
    !len :: Int
len = forall {k} (x :: k -> *). KnownNat (ProductSize x) => Int
forall (x :: k -> *). KnownNat (ProductSize x) => Int
recordSize @flds

gtupleParseJSON :: (GFieldsFromJSON flds) => JSON.Array -> JSON.Parser (D1 _dt (C1 _mcons flds) k)
gtupleParseJSON :: Array -> Parser (D1 w (C1 w flds) k)
gtupleParseJSON Array
arr = C1 w flds k -> D1 w (C1 w flds) k
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (C1 w flds k -> D1 w (C1 w flds) k)
-> (flds k -> C1 w flds k) -> flds k -> D1 w (C1 w flds) k
forall b c a. (b -> c) -> (a -> b) -> a -> c
. flds k -> C1 w flds k
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (flds k -> D1 w (C1 w flds) k)
-> Parser (flds k) -> Parser (D1 w (C1 w flds) k)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Array -> Parser (flds k)
forall (k :: k). Int -> Array -> Parser (flds k)
forall {k} (a :: k -> *) (k :: k).
GFieldsFromJSON a =>
Int -> Array -> Parser (a k)
gfieldsParseJSON Int
0 Array
arr

class GFieldsToJSON a where
  gunsafeWriteFieldsToJSON :: Int -> MutableArray s JSON.Value -> a k -> ST s ()
  gfieldsToEncoding :: a k -> JSON.Encoding

class GFieldsFromJSON a where
  gfieldsParseJSON :: Int -> JSON.Array -> JSON.Parser (a k)

instance (GFieldsToJSON f, GFieldsToJSON g, KnownNat (ProductSize f), KnownNat (ProductSize g)) => GFieldsToJSON (f :*: g) where
  {-# INLINE gunsafeWriteFieldsToJSON #-}
  {-# INLINE gfieldsToEncoding #-}
  gunsafeWriteFieldsToJSON :: forall s (k :: k).
Int -> MutableArray s Value -> (:*:) f g k -> ST s ()
gunsafeWriteFieldsToJSON Int
i MutableArray s Value
mut (f k
f :*: g k
g) = do
    Int -> MutableArray s Value -> f k -> ST s ()
forall s (k :: k). Int -> MutableArray s Value -> f k -> ST s ()
forall {k} (a :: k -> *) s (k :: k).
GFieldsToJSON a =>
Int -> MutableArray s Value -> a k -> ST s ()
gunsafeWriteFieldsToJSON Int
i MutableArray s Value
mut f k
f
    Int -> MutableArray s Value -> g k -> ST s ()
forall s (k :: k). Int -> MutableArray s Value -> g k -> ST s ()
forall {k} (a :: k -> *) s (k :: k).
GFieldsToJSON a =>
Int -> MutableArray s Value -> a k -> ST s ()
gunsafeWriteFieldsToJSON (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
alen) MutableArray s Value
mut g k
g
    where
      !alen :: Int
alen = forall {k} (x :: k -> *). KnownNat (ProductSize x) => Int
forall (x :: k -> *). KnownNat (ProductSize x) => Int
recordSize @f
  gfieldsToEncoding :: forall (k :: k). (:*:) f g k -> Encoding
gfieldsToEncoding (f k
f :*: g k
g) = f k -> Encoding
forall (k :: k). f k -> Encoding
forall {k} (a :: k -> *) (k :: k).
GFieldsToJSON a =>
a k -> Encoding
gfieldsToEncoding f k
f Encoding -> Encoding -> Encoding
forall a. Encoding' a -> Encoding' a -> Encoding' a
>< Encoding
forall a. Encoding' a
comma Encoding -> Encoding -> Encoding
forall a. Encoding' a -> Encoding' a -> Encoding' a
>< g k -> Encoding
forall (k :: k). g k -> Encoding
forall {k} (a :: k -> *) (k :: k).
GFieldsToJSON a =>
a k -> Encoding
gfieldsToEncoding g k
g

instance (GFieldsFromJSON f, GFieldsFromJSON g, KnownNat (ProductSize f), KnownNat (ProductSize g)) => GFieldsFromJSON (f :*: g) where
  {-# INLINE gfieldsParseJSON #-}
  gfieldsParseJSON :: forall (k :: k). Int -> Array -> Parser ((:*:) f g k)
gfieldsParseJSON Int
i Array
arr =
    (f k -> g k -> (:*:) f g k)
-> Parser (f k) -> Parser (g k) -> Parser ((:*:) f g k)
forall a b c. (a -> b -> c) -> Parser a -> Parser b -> Parser c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
      f k -> g k -> (:*:) f g k
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:)
      (Int -> Array -> Parser (f k)
forall (k :: k). Int -> Array -> Parser (f k)
forall {k} (a :: k -> *) (k :: k).
GFieldsFromJSON a =>
Int -> Array -> Parser (a k)
gfieldsParseJSON Int
i Array
arr)
      (Int -> Array -> Parser (g k)
forall (k :: k). Int -> Array -> Parser (g k)
forall {k} (a :: k -> *) (k :: k).
GFieldsFromJSON a =>
Int -> Array -> Parser (a k)
gfieldsParseJSON (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
alen) Array
arr)
    where
      !alen :: Int
alen = forall {k} (x :: k -> *). KnownNat (ProductSize x) => Int
forall (x :: k -> *). KnownNat (ProductSize x) => Int
recordSize @f

instance (ToJSON a) => GFieldsToJSON (S1 _metasel (K1 _r a)) where
  {-# INLINE gunsafeWriteFieldsToJSON #-}
  {-# INLINE gfieldsToEncoding #-}
  gunsafeWriteFieldsToJSON :: forall s (k :: k).
Int -> MutableArray s Value -> S1 _metasel (K1 _r a) k -> ST s ()
gunsafeWriteFieldsToJSON Int
i MutableArray s Value
mut (M1 (K1 a
x)) = MutableArray (PrimState (ST s)) Value -> Int -> Value -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray MutableArray s Value
MutableArray (PrimState (ST s)) Value
mut Int
i (a -> Value
forall a. ToJSON a => a -> Value
JSON.toJSON a
x)
  gfieldsToEncoding :: forall (k :: k). S1 _metasel (K1 _r a) k -> Encoding
gfieldsToEncoding (M1 (K1 a
x)) = a -> Encoding
forall a. ToJSON a => a -> Encoding
JSON.toEncoding a
x

instance (FromJSON a) => GFieldsFromJSON (S1 _metasel (K1 _r a)) where
  {-# INLINE gfieldsParseJSON #-}
  gfieldsParseJSON :: forall (k :: k). Int -> Array -> Parser (S1 _metasel (K1 _r a) k)
gfieldsParseJSON Int
i Array
arr = K1 _r a k -> M1 S _metasel (K1 _r a) k
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (K1 _r a k -> M1 S _metasel (K1 _r a) k)
-> (a -> K1 _r a k) -> a -> M1 S _metasel (K1 _r a) k
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> K1 _r a k
forall k i c (p :: k). c -> K1 i c p
K1 (a -> M1 S _metasel (K1 _r a) k)
-> Parser a -> Parser (M1 S _metasel (K1 _r a) k)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser a
forall a. FromJSON a => Value -> Parser a
JSON.parseJSON (Array
arr Array -> Int -> Value
forall a. Vector a -> Int -> a
Vector.! Int
i)

--------------------------------------------------------------------------------
-- openapi interop

-- | Gives the schema the name @show (typeRep @a _)@
instance
  ( Generic a
  , Typeable a
  , Rep a ~ D1 _dt (C1 _mcons flds)
  , GFieldsToSchema flds
  )
  => ToSchema (RecordAsTuple a)
  where
  declareNamedSchema :: Proxy (RecordAsTuple a) -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy (RecordAsTuple a)
_ = do
    [Referenced Schema]
itemSchemas <- forall {k} (a :: k).
GFieldsToSchema a =>
Declare (Definitions Schema) [Referenced Schema]
forall (a :: * -> *).
GFieldsToSchema a =>
Declare (Definitions Schema) [Referenced Schema]
gfieldSchemas @flds
    NamedSchema -> Declare (Definitions Schema) NamedSchema
forall a. a -> DeclareT (Definitions Schema) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      ( Maybe Text -> Schema -> NamedSchema
NamedSchema
          (Text -> Maybe Text
forall a. a -> Maybe a
Just (String -> Text
forall a. IsString a => String -> a
fromString (TypeRep -> String
forall a. Show a => a -> String
show (Proxy a -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy a
forall {k} (t :: k). Proxy t
Proxy :: Proxy a)))))
          Schema
forall a. Monoid a => a
mempty
            { _schemaType = Just OpenApiArray
            , _schemaItems = Just (OpenApiItemsArray itemSchemas)
            , _schemaMinItems = Just (fromIntegral (length itemSchemas))
            , _schemaMaxItems = Just (fromIntegral (length itemSchemas))
            }
      )

class GFieldsToSchema a where
  gfieldSchemas :: Declare (Definitions Schema) [Referenced Schema]

instance (GFieldsToSchema f, GFieldsToSchema g) => GFieldsToSchema (f :*: g) where
  gfieldSchemas :: Declare (Definitions Schema) [Referenced Schema]
gfieldSchemas = ([Referenced Schema] -> [Referenced Schema] -> [Referenced Schema])
-> Declare (Definitions Schema) [Referenced Schema]
-> Declare (Definitions Schema) [Referenced Schema]
-> Declare (Definitions Schema) [Referenced Schema]
forall a b c.
(a -> b -> c)
-> DeclareT (Definitions Schema) Identity a
-> DeclareT (Definitions Schema) Identity b
-> DeclareT (Definitions Schema) Identity c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 [Referenced Schema] -> [Referenced Schema] -> [Referenced Schema]
forall a. Semigroup a => a -> a -> a
(<>) (forall {k} (a :: k).
GFieldsToSchema a =>
Declare (Definitions Schema) [Referenced Schema]
forall (a :: k -> *).
GFieldsToSchema a =>
Declare (Definitions Schema) [Referenced Schema]
gfieldSchemas @f) (forall {k} (a :: k).
GFieldsToSchema a =>
Declare (Definitions Schema) [Referenced Schema]
forall (a :: k -> *).
GFieldsToSchema a =>
Declare (Definitions Schema) [Referenced Schema]
gfieldSchemas @g)

instance (ToSchema a) => GFieldsToSchema (S1 _metasel (K1 _r a)) where
  gfieldSchemas :: Declare (Definitions Schema) [Referenced Schema]
gfieldSchemas = do
    NamedSchema Maybe Text
_ Schema
s <- Proxy a -> Declare (Definitions Schema) NamedSchema
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) NamedSchema
declareNamedSchema (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a)
    [Referenced Schema]
-> Declare (Definitions Schema) [Referenced Schema]
forall a. a -> DeclareT (Definitions Schema) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Schema -> Referenced Schema
forall a. a -> Referenced a
Inline Schema
s]