-- |
-- Module      : Data.Aeson.RecordAsTuple
-- Copyright   : (c) Michael Ledger 2026
-- License     : MPL-2.0
-- Maintainer  : Michael Ledger <mike@quasimal.com>
module Data.Aeson.RecordAsTuple (RecordAsTuple (..)) 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 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 -> JSON.Array
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]