{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
module Data.Aeson.WithField(
WithField(..)
, WithId
, WithFields(..)
, OnlyField(..)
, OnlyId
) where
import Control.Applicative
import Control.DeepSeq
import Control.Lens hiding ((.=))
import Control.Monad
import Data.Aeson
import Data.Aeson.Types (typeMismatch)
import qualified Data.Aeson.Key as Key
import qualified Data.Aeson.KeyMap as KM
import Data.Aeson.WithField.Internal
import Data.Hashable
import Data.Monoid
import Data.Proxy
import Data.Swagger
import GHC.Generics
import GHC.TypeLits
import Servant.Docs
import qualified Data.Foldable as F
import qualified Data.List as L
import qualified Data.Text as T
data WithField (s :: Symbol) a b = WithField !a !b
deriving ((forall x. WithField s a b -> Rep (WithField s a b) x)
-> (forall x. Rep (WithField s a b) x -> WithField s a b)
-> Generic (WithField s a b)
forall x. Rep (WithField s a b) x -> WithField s a b
forall x. WithField s a b -> Rep (WithField s a b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (s :: Symbol) a b x.
Rep (WithField s a b) x -> WithField s a b
forall (s :: Symbol) a b x.
WithField s a b -> Rep (WithField s a b) x
$cto :: forall (s :: Symbol) a b x.
Rep (WithField s a b) x -> WithField s a b
$cfrom :: forall (s :: Symbol) a b x.
WithField s a b -> Rep (WithField s a b) x
Generic, WithField s a b -> WithField s a b -> Bool
(WithField s a b -> WithField s a b -> Bool)
-> (WithField s a b -> WithField s a b -> Bool)
-> Eq (WithField s a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (s :: Symbol) a b.
(Eq a, Eq b) =>
WithField s a b -> WithField s a b -> Bool
/= :: WithField s a b -> WithField s a b -> Bool
$c/= :: forall (s :: Symbol) a b.
(Eq a, Eq b) =>
WithField s a b -> WithField s a b -> Bool
== :: WithField s a b -> WithField s a b -> Bool
$c== :: forall (s :: Symbol) a b.
(Eq a, Eq b) =>
WithField s a b -> WithField s a b -> Bool
Eq, Int -> WithField s a b -> ShowS
[WithField s a b] -> ShowS
WithField s a b -> String
(Int -> WithField s a b -> ShowS)
-> (WithField s a b -> String)
-> ([WithField s a b] -> ShowS)
-> Show (WithField s a b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (s :: Symbol) a b.
(Show a, Show b) =>
Int -> WithField s a b -> ShowS
forall (s :: Symbol) a b.
(Show a, Show b) =>
[WithField s a b] -> ShowS
forall (s :: Symbol) a b.
(Show a, Show b) =>
WithField s a b -> String
showList :: [WithField s a b] -> ShowS
$cshowList :: forall (s :: Symbol) a b.
(Show a, Show b) =>
[WithField s a b] -> ShowS
show :: WithField s a b -> String
$cshow :: forall (s :: Symbol) a b.
(Show a, Show b) =>
WithField s a b -> String
showsPrec :: Int -> WithField s a b -> ShowS
$cshowsPrec :: forall (s :: Symbol) a b.
(Show a, Show b) =>
Int -> WithField s a b -> ShowS
Show, ReadPrec [WithField s a b]
ReadPrec (WithField s a b)
Int -> ReadS (WithField s a b)
ReadS [WithField s a b]
(Int -> ReadS (WithField s a b))
-> ReadS [WithField s a b]
-> ReadPrec (WithField s a b)
-> ReadPrec [WithField s a b]
-> Read (WithField s a b)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall (s :: Symbol) a b.
(Read a, Read b) =>
ReadPrec [WithField s a b]
forall (s :: Symbol) a b.
(Read a, Read b) =>
ReadPrec (WithField s a b)
forall (s :: Symbol) a b.
(Read a, Read b) =>
Int -> ReadS (WithField s a b)
forall (s :: Symbol) a b.
(Read a, Read b) =>
ReadS [WithField s a b]
readListPrec :: ReadPrec [WithField s a b]
$creadListPrec :: forall (s :: Symbol) a b.
(Read a, Read b) =>
ReadPrec [WithField s a b]
readPrec :: ReadPrec (WithField s a b)
$creadPrec :: forall (s :: Symbol) a b.
(Read a, Read b) =>
ReadPrec (WithField s a b)
readList :: ReadS [WithField s a b]
$creadList :: forall (s :: Symbol) a b.
(Read a, Read b) =>
ReadS [WithField s a b]
readsPrec :: Int -> ReadS (WithField s a b)
$creadsPrec :: forall (s :: Symbol) a b.
(Read a, Read b) =>
Int -> ReadS (WithField s a b)
Read)
instance (NFData a, NFData b) => NFData (WithField s a b)
instance Functor (WithField s a) where
fmap :: (a -> b) -> WithField s a a -> WithField s a b
fmap f :: a -> b
f (WithField a :: a
a b :: a
b) = a -> b -> WithField s a b
forall (s :: Symbol) a b. a -> b -> WithField s a b
WithField a
a (a -> b
f a
b)
instance Bifunctor (WithField s) where
bimap :: (a -> b) -> (c -> d) -> WithField s a c -> WithField s b d
bimap fa :: a -> b
fa fb :: c -> d
fb (WithField a :: a
a b :: c
b) = b -> d -> WithField s b d
forall (s :: Symbol) a b. a -> b -> WithField s a b
WithField (a -> b
fa a
a) (c -> d
fb c
b)
type WithId i a = WithField "id" i a
instance (ToSample a, ToSample b) => ToSample (WithField s a b) where
toSamples :: Proxy (WithField s a b) -> [(Text, WithField s a b)]
toSamples _ = [WithField s a b] -> [(Text, WithField s a b)]
forall a. [a] -> [(Text, a)]
samples ([WithField s a b] -> [(Text, WithField s a b)])
-> [WithField s a b] -> [(Text, WithField s a b)]
forall a b. (a -> b) -> a -> b
$ a -> b -> WithField s a b
forall (s :: Symbol) a b. a -> b -> WithField s a b
WithField (a -> b -> WithField s a b) -> [a] -> [b -> WithField s a b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a]
as [b -> WithField s a b] -> [b] -> [WithField s a b]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [b]
bs
where
as :: [a]
as = (Text, a) -> a
forall a b. (a, b) -> b
snd ((Text, a) -> a) -> [(Text, a)] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy a -> [(Text, a)]
forall a. ToSample a => Proxy a -> [(Text, a)]
toSamples (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)
bs :: [b]
bs = (Text, b) -> b
forall a b. (a, b) -> b
snd ((Text, b) -> b) -> [(Text, b)] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy b -> [(Text, b)]
forall a. ToSample a => Proxy a -> [(Text, a)]
toSamples (Proxy b
forall k (t :: k). Proxy t
Proxy :: Proxy b)
instance (KnownSymbol s, ToJSON a, ToJSON b) => ToJSON (WithField s a b) where
toJSON :: WithField s a b -> Value
toJSON (WithField a :: a
a b :: b
b) = let
jsonb :: Value
jsonb = b -> Value
forall a. ToJSON a => a -> Value
toJSON b
b
field :: Key
field = KnownSymbol s => Key
forall (s :: Symbol). KnownSymbol s => Key
mkFieldName @s
in case b -> Value
forall a. ToJSON a => a -> Value
toJSON b
b of
Object vs :: Object
vs -> Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ Key -> Value -> Object -> Object
forall v. Key -> v -> KeyMap v -> KeyMap v
KM.insert Key
field (a -> Value
forall a. ToJSON a => a -> Value
toJSON a
a) Object
vs
_ -> [Pair] -> Value
object [
"value" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Value
jsonb
, Key
field Key -> a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= a
a
]
instance (KnownSymbol s, FromJSON a, FromJSON b) => FromJSON (WithField s a b) where
parseJSON :: Value -> Parser (WithField s a b)
parseJSON val :: Value
val@(Object o :: Object
o) = Parser (WithField s a b)
injected Parser (WithField s a b)
-> Parser (WithField s a b) -> Parser (WithField s a b)
forall a. Parser a -> Parser a -> Parser a
`mplus0` Parser (WithField s a b)
wrapper
where
field :: Key
field = KnownSymbol s => Key
forall (s :: Symbol). KnownSymbol s => Key
mkFieldName @s
injected :: Parser (WithField s a b)
injected = a -> b -> WithField s a b
forall (s :: Symbol) a b. a -> b -> WithField s a b
WithField
(a -> b -> WithField s a b)
-> Parser a -> Parser (b -> WithField s a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser a
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
field
Parser (b -> WithField s a b)
-> Parser b -> Parser (WithField s a b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Parser b
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ Key -> Object -> Object
forall v. Key -> KeyMap v -> KeyMap v
KM.delete Key
field Object
o) Parser b -> Parser b -> Parser b
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value -> Parser b
forall a. FromJSON a => Value -> Parser a
parseJSON Value
val)
wrapper :: Parser (WithField s a b)
wrapper = a -> b -> WithField s a b
forall (s :: Symbol) a b. a -> b -> WithField s a b
WithField
(a -> b -> WithField s a b)
-> Parser a -> Parser (b -> WithField s a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser a
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
field
Parser (b -> WithField s a b)
-> Parser b -> Parser (WithField s a b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser b
forall a. FromJSON a => Object -> Key -> Parser a
.: "value"
parseJSON wat :: Value
wat = String -> Value -> Parser (WithField s a b)
forall a. String -> Value -> Parser a
typeMismatch "Expected JSON Object" Value
wat
instance (KnownSymbol s, ToSchema a, ToSchema b) => ToSchema (WithField s a b) where
declareNamedSchema :: Proxy (WithField s a b) -> Declare (Definitions Schema) NamedSchema
declareNamedSchema _ = do
NamedSchema n :: Maybe Text
n s :: Schema
s <- Proxy b -> Declare (Definitions Schema) NamedSchema
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) NamedSchema
declareNamedSchema (Proxy b
forall k (t :: k). Proxy t
Proxy :: Proxy b)
if Schema
s Schema
-> Getting
(Maybe (SwaggerType 'SwaggerKindSchema))
Schema
(Maybe (SwaggerType 'SwaggerKindSchema))
-> Maybe (SwaggerType 'SwaggerKindSchema)
forall s a. s -> Getting a s a -> a
^. Getting
(Maybe (SwaggerType 'SwaggerKindSchema))
Schema
(Maybe (SwaggerType 'SwaggerKindSchema))
forall s a. HasType s a => Lens' s a
type_ Maybe (SwaggerType 'SwaggerKindSchema)
-> Maybe (SwaggerType 'SwaggerKindSchema) -> Bool
forall a. Eq a => a -> a -> Bool
== SwaggerType 'SwaggerKindSchema
-> Maybe (SwaggerType 'SwaggerKindSchema)
forall a. a -> Maybe a
Just SwaggerType 'SwaggerKindSchema
SwaggerObject then Maybe Text -> Schema -> Declare (Definitions Schema) NamedSchema
inline Maybe Text
n Schema
s
else Maybe Text -> Schema -> Declare (Definitions Schema) NamedSchema
wrapper Maybe Text
n Schema
s
where
field :: Text
field = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Proxy s -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy s
forall k (t :: k). Proxy t
Proxy :: Proxy s)
namePrefix :: Text
namePrefix = "WithField '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
field Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "' "
wrapper :: Maybe Text -> Schema -> Declare (Definitions Schema) NamedSchema
wrapper n :: Maybe Text
n s :: Schema
s = do
Schema
indexSchema <- Proxy a -> Declare (Definitions Schema) Schema
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) Schema
declareSchema (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)
NamedSchema -> Declare (Definitions Schema) NamedSchema
forall (m :: * -> *) a. Monad m => a -> m a
return (NamedSchema -> Declare (Definitions Schema) NamedSchema)
-> NamedSchema -> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Schema -> NamedSchema
NamedSchema ((Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text
namePrefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) Maybe Text
n) (Schema -> NamedSchema) -> Schema -> NamedSchema
forall a b. (a -> b) -> a -> b
$ Schema
forall a. Monoid a => a
mempty
Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe (SwaggerType 'SwaggerKindSchema)
-> Identity (Maybe (SwaggerType 'SwaggerKindSchema)))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
type_ ((Maybe (SwaggerType 'SwaggerKindSchema)
-> Identity (Maybe (SwaggerType 'SwaggerKindSchema)))
-> Schema -> Identity Schema)
-> Maybe (SwaggerType 'SwaggerKindSchema) -> Schema -> Schema
forall s t a b. ASetter s t a b -> b -> s -> t
.~ SwaggerType 'SwaggerKindSchema
-> Maybe (SwaggerType 'SwaggerKindSchema)
forall a. a -> Maybe a
Just SwaggerType 'SwaggerKindSchema
SwaggerObject
Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (InsOrdHashMap Text (Referenced Schema)
-> Identity (InsOrdHashMap Text (Referenced Schema)))
-> Schema -> Identity Schema
forall s a. HasProperties s a => Lens' s a
properties ((InsOrdHashMap Text (Referenced Schema)
-> Identity (InsOrdHashMap Text (Referenced Schema)))
-> Schema -> Identity Schema)
-> InsOrdHashMap Text (Referenced Schema) -> Schema -> Schema
forall s t a b. ASetter s t a b -> b -> s -> t
.~
[ ("value", Schema -> Referenced Schema
forall a. a -> Referenced a
Inline Schema
s)
, (Text
field, Schema -> Referenced Schema
forall a. a -> Referenced a
Inline Schema
indexSchema)
]
Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& ([Text] -> Identity [Text]) -> Schema -> Identity Schema
forall s a. HasRequired s a => Lens' s a
required (([Text] -> Identity [Text]) -> Schema -> Identity Schema)
-> [Text] -> Schema -> Schema
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ([Text] -> [Text]
forall a. Eq a => [a] -> [a]
L.nub [ "value", Text
Item [Text]
field ])
inline :: Maybe Text -> Schema -> Declare (Definitions Schema) NamedSchema
inline n :: Maybe Text
n s :: Schema
s = do
Schema
indexSchema <- Proxy a -> Declare (Definitions Schema) Schema
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) Schema
declareSchema (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)
NamedSchema -> Declare (Definitions Schema) NamedSchema
forall (m :: * -> *) a. Monad m => a -> m a
return (NamedSchema -> Declare (Definitions Schema) NamedSchema)
-> NamedSchema -> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Schema -> NamedSchema
NamedSchema ((Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text
namePrefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) Maybe Text
n) (Schema -> NamedSchema) -> Schema -> NamedSchema
forall a b. (a -> b) -> a -> b
$ Schema
s
Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (InsOrdHashMap Text (Referenced Schema)
-> Identity (InsOrdHashMap Text (Referenced Schema)))
-> Schema -> Identity Schema
forall s a. HasProperties s a => Lens' s a
properties ((InsOrdHashMap Text (Referenced Schema)
-> Identity (InsOrdHashMap Text (Referenced Schema)))
-> Schema -> Identity Schema)
-> (InsOrdHashMap Text (Referenced Schema)
-> InsOrdHashMap Text (Referenced Schema))
-> Schema
-> Schema
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ([(Text
field, Schema -> Referenced Schema
forall a. a -> Referenced a
Inline Schema
indexSchema)] InsOrdHashMap Text (Referenced Schema)
-> InsOrdHashMap Text (Referenced Schema)
-> InsOrdHashMap Text (Referenced Schema)
forall a. Semigroup a => a -> a -> a
<>)
Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& ([Text] -> Identity [Text]) -> Schema -> Identity Schema
forall s a. HasRequired s a => Lens' s a
required (([Text] -> Identity [Text]) -> Schema -> Identity Schema)
-> ([Text] -> [Text]) -> Schema -> Schema
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ([Text
Item [Text]
field] [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<>)
data WithFields a b = WithFields !a !b
deriving ((forall x. WithFields a b -> Rep (WithFields a b) x)
-> (forall x. Rep (WithFields a b) x -> WithFields a b)
-> Generic (WithFields a b)
forall x. Rep (WithFields a b) x -> WithFields a b
forall x. WithFields a b -> Rep (WithFields a b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a b x. Rep (WithFields a b) x -> WithFields a b
forall a b x. WithFields a b -> Rep (WithFields a b) x
$cto :: forall a b x. Rep (WithFields a b) x -> WithFields a b
$cfrom :: forall a b x. WithFields a b -> Rep (WithFields a b) x
Generic, WithFields a b -> WithFields a b -> Bool
(WithFields a b -> WithFields a b -> Bool)
-> (WithFields a b -> WithFields a b -> Bool)
-> Eq (WithFields a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b.
(Eq a, Eq b) =>
WithFields a b -> WithFields a b -> Bool
/= :: WithFields a b -> WithFields a b -> Bool
$c/= :: forall a b.
(Eq a, Eq b) =>
WithFields a b -> WithFields a b -> Bool
== :: WithFields a b -> WithFields a b -> Bool
$c== :: forall a b.
(Eq a, Eq b) =>
WithFields a b -> WithFields a b -> Bool
Eq, Int -> WithFields a b -> ShowS
[WithFields a b] -> ShowS
WithFields a b -> String
(Int -> WithFields a b -> ShowS)
-> (WithFields a b -> String)
-> ([WithFields a b] -> ShowS)
-> Show (WithFields a b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b. (Show a, Show b) => Int -> WithFields a b -> ShowS
forall a b. (Show a, Show b) => [WithFields a b] -> ShowS
forall a b. (Show a, Show b) => WithFields a b -> String
showList :: [WithFields a b] -> ShowS
$cshowList :: forall a b. (Show a, Show b) => [WithFields a b] -> ShowS
show :: WithFields a b -> String
$cshow :: forall a b. (Show a, Show b) => WithFields a b -> String
showsPrec :: Int -> WithFields a b -> ShowS
$cshowsPrec :: forall a b. (Show a, Show b) => Int -> WithFields a b -> ShowS
Show, ReadPrec [WithFields a b]
ReadPrec (WithFields a b)
Int -> ReadS (WithFields a b)
ReadS [WithFields a b]
(Int -> ReadS (WithFields a b))
-> ReadS [WithFields a b]
-> ReadPrec (WithFields a b)
-> ReadPrec [WithFields a b]
-> Read (WithFields a b)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall a b. (Read a, Read b) => ReadPrec [WithFields a b]
forall a b. (Read a, Read b) => ReadPrec (WithFields a b)
forall a b. (Read a, Read b) => Int -> ReadS (WithFields a b)
forall a b. (Read a, Read b) => ReadS [WithFields a b]
readListPrec :: ReadPrec [WithFields a b]
$creadListPrec :: forall a b. (Read a, Read b) => ReadPrec [WithFields a b]
readPrec :: ReadPrec (WithFields a b)
$creadPrec :: forall a b. (Read a, Read b) => ReadPrec (WithFields a b)
readList :: ReadS [WithFields a b]
$creadList :: forall a b. (Read a, Read b) => ReadS [WithFields a b]
readsPrec :: Int -> ReadS (WithFields a b)
$creadsPrec :: forall a b. (Read a, Read b) => Int -> ReadS (WithFields a b)
Read)
instance (NFData a, NFData b) => NFData (WithFields a b)
instance Functor (WithFields a) where
fmap :: (a -> b) -> WithFields a a -> WithFields a b
fmap f :: a -> b
f (WithFields a :: a
a b :: a
b) = a -> b -> WithFields a b
forall a b. a -> b -> WithFields a b
WithFields a
a (a -> b
f a
b)
instance Bifunctor WithFields where
bimap :: (a -> b) -> (c -> d) -> WithFields a c -> WithFields b d
bimap fa :: a -> b
fa fb :: c -> d
fb (WithFields a :: a
a b :: c
b) = b -> d -> WithFields b d
forall a b. a -> b -> WithFields a b
WithFields (a -> b
fa a
a) (c -> d
fb c
b)
instance (ToSample a, ToSample b) => ToSample (WithFields a b) where
toSamples :: Proxy (WithFields a b) -> [(Text, WithFields a b)]
toSamples _ = [WithFields a b] -> [(Text, WithFields a b)]
forall a. [a] -> [(Text, a)]
samples ([WithFields a b] -> [(Text, WithFields a b)])
-> [WithFields a b] -> [(Text, WithFields a b)]
forall a b. (a -> b) -> a -> b
$ a -> b -> WithFields a b
forall a b. a -> b -> WithFields a b
WithFields (a -> b -> WithFields a b) -> [a] -> [b -> WithFields a b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a]
as [b -> WithFields a b] -> [b] -> [WithFields a b]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [b]
bs
where
as :: [a]
as = (Text, a) -> a
forall a b. (a, b) -> b
snd ((Text, a) -> a) -> [(Text, a)] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy a -> [(Text, a)]
forall a. ToSample a => Proxy a -> [(Text, a)]
toSamples (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)
bs :: [b]
bs = (Text, b) -> b
forall a b. (a, b) -> b
snd ((Text, b) -> b) -> [(Text, b)] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy b -> [(Text, b)]
forall a. ToSample a => Proxy a -> [(Text, a)]
toSamples (Proxy b
forall k (t :: k). Proxy t
Proxy :: Proxy b)
instance (ToJSON a, ToJSON b) => ToJSON (WithFields a b) where
toJSON :: WithFields a b -> Value
toJSON (WithFields a :: a
a b :: b
b) = let
jsonb :: Value
jsonb = b -> Value
forall a. ToJSON a => a -> Value
toJSON b
b
jsona :: Value
jsona = a -> Value
forall a. ToJSON a => a -> Value
toJSON a
a
in case Value
jsonb of
Object bvs :: Object
bvs -> case Value
jsona of
Object avs :: Object
avs -> Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ Object -> Object -> Object
forall v. KeyMap v -> KeyMap v -> KeyMap v
KM.union Object
avs Object
bvs
_ -> Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ Key -> Value -> Object -> Object
forall v. Key -> v -> KeyMap v -> KeyMap v
KM.insert "injected" Value
jsona Object
bvs
_ -> case Value
jsona of
Object avs :: Object
avs -> Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ case Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KM.lookup "value" Object
avs of
Nothing -> Key -> Value -> Object -> Object
forall v. Key -> v -> KeyMap v -> KeyMap v
KM.insert "value" Value
jsonb Object
avs
Just _ -> Object
avs
_ -> [Pair] -> Value
object [
"injected" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Value
jsona
, "value" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Value
jsonb
]
instance (ToJSON a, FromJSON a, FromJSON b) => FromJSON (WithFields a b) where
parseJSON :: Value -> Parser (WithFields a b)
parseJSON val :: Value
val@(Object o :: Object
o) = do
(a :: a
a, isInjected :: Bool
isInjected) <- ((, Bool
False) (a -> (a, Bool)) -> Parser a -> Parser (a, Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON Value
val) Parser (a, Bool) -> Parser (a, Bool) -> Parser (a, Bool)
forall a. Parser a -> Parser a -> Parser a
`mplus0` ((, Bool
True) (a -> (a, Bool)) -> Parser a -> Parser (a, Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser a
forall a. FromJSON a => Object -> Key -> Parser a
.: "injected"))
let o' :: Object
o' = (if Bool
isInjected then Key -> Object -> Object
forall v. Key -> KeyMap v -> KeyMap v
KM.delete "injected" else [Key] -> Object -> Object
forall v. [Key] -> KeyMap v -> KeyMap v
deleteAll (a -> [Key]
ToJSON a => a -> [Key]
extractFields a
a)) Object
o
b
b <- ((Value -> Parser b
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o')) Parser b -> Parser b -> Parser b
forall a. Parser a -> Parser a -> Parser a
`mplus0` (Object
o' Object -> Key -> Parser b
forall a. FromJSON a => Object -> Key -> Parser a
.: "value"))
Parser b -> Parser b -> Parser b
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((Value -> Parser b
forall a. FromJSON a => Value -> Parser a
parseJSON Value
val) Parser b -> Parser b -> Parser b
forall a. Parser a -> Parser a -> Parser a
`mplus0` (Object
o Object -> Key -> Parser b
forall a. FromJSON a => Object -> Key -> Parser a
.: "value"))
WithFields a b -> Parser (WithFields a b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WithFields a b -> Parser (WithFields a b))
-> WithFields a b -> Parser (WithFields a b)
forall a b. (a -> b) -> a -> b
$ a -> b -> WithFields a b
forall a b. a -> b -> WithFields a b
WithFields a
a b
b
where
deleteAll :: [Key.Key] -> KM.KeyMap v -> KM.KeyMap v
deleteAll :: [Key] -> KeyMap v -> KeyMap v
deleteAll ks :: [Key]
ks m :: KeyMap v
m = (KeyMap v -> Key -> KeyMap v) -> KeyMap v -> [Key] -> KeyMap v
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' ((Key -> KeyMap v -> KeyMap v) -> KeyMap v -> Key -> KeyMap v
forall a b c. (a -> b -> c) -> b -> a -> c
flip Key -> KeyMap v -> KeyMap v
forall v. Key -> KeyMap v -> KeyMap v
KM.delete) KeyMap v
m [Key]
ks
extractFields :: ToJSON a => a -> [Key.Key]
extractFields :: a -> [Key]
extractFields a :: a
a = case a -> Value
forall a. ToJSON a => a -> Value
toJSON a
a of
Object vs :: Object
vs -> Object -> [Key]
forall v. KeyMap v -> [Key]
KM.keys Object
vs
_ -> []
parseJSON wat :: Value
wat = String -> Value -> Parser (WithFields a b)
forall a. String -> Value -> Parser a
typeMismatch "Expected JSON Object" Value
wat
instance (ToSchema a, ToSchema b) => ToSchema (WithFields a b) where
declareNamedSchema :: Proxy (WithFields a b) -> Declare (Definitions Schema) NamedSchema
declareNamedSchema _ = do
NamedSchema nb :: Maybe Text
nb sb :: Schema
sb <- Proxy b -> Declare (Definitions Schema) NamedSchema
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) NamedSchema
declareNamedSchema (Proxy b
forall k (t :: k). Proxy t
Proxy :: Proxy b)
NamedSchema na :: Maybe Text
na sa :: Schema
sa <- Proxy a -> Declare (Definitions Schema) NamedSchema
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) NamedSchema
declareNamedSchema (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)
let newName :: Maybe Text
newName = Text -> Text -> Text
forall a. (Semigroup a, IsString a) => a -> a -> a
combinedName (Text -> Text -> Text) -> Maybe Text -> Maybe (Text -> Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
na Maybe (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Text
nb
NamedSchema -> Declare (Definitions Schema) NamedSchema
forall (m :: * -> *) a. Monad m => a -> m a
return (NamedSchema -> Declare (Definitions Schema) NamedSchema)
-> (Schema -> NamedSchema)
-> Schema
-> Declare (Definitions Schema) NamedSchema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Text -> Schema -> NamedSchema
NamedSchema Maybe Text
newName (Schema -> Declare (Definitions Schema) NamedSchema)
-> Schema -> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$ case (Schema
sa Schema
-> Getting
(Maybe (SwaggerType 'SwaggerKindSchema))
Schema
(Maybe (SwaggerType 'SwaggerKindSchema))
-> Maybe (SwaggerType 'SwaggerKindSchema)
forall s a. s -> Getting a s a -> a
^. Getting
(Maybe (SwaggerType 'SwaggerKindSchema))
Schema
(Maybe (SwaggerType 'SwaggerKindSchema))
forall s a. HasType s a => Lens' s a
type_ , Schema
sb Schema
-> Getting
(Maybe (SwaggerType 'SwaggerKindSchema))
Schema
(Maybe (SwaggerType 'SwaggerKindSchema))
-> Maybe (SwaggerType 'SwaggerKindSchema)
forall s a. s -> Getting a s a -> a
^. Getting
(Maybe (SwaggerType 'SwaggerKindSchema))
Schema
(Maybe (SwaggerType 'SwaggerKindSchema))
forall s a. HasType s a => Lens' s a
type_) of
(Just SwaggerObject, Just SwaggerObject) -> Schema
sb Schema -> Schema -> Schema
forall a. Semigroup a => a -> a -> a
<> Schema
sa
(Just SwaggerObject, _) -> Schema -> Schema
forall b a a a a.
(Monoid b, HasType b (Maybe (SwaggerType 'SwaggerKindSchema)),
HasProperties b a, HasRequired b a, IsList a, IsList a, IsString a,
IsString (Item a), Item a ~ (a, Referenced a)) =>
a -> b
bwrapper Schema
sb Schema -> Schema -> Schema
forall a. Semigroup a => a -> a -> a
<> Schema
sa
(_, Just SwaggerObject) -> Schema
sb Schema -> Schema -> Schema
forall a. Semigroup a => a -> a -> a
<> Schema -> Schema
forall b a a a a.
(Monoid b, HasType b (Maybe (SwaggerType 'SwaggerKindSchema)),
HasProperties b a, HasRequired b a, IsList a, IsList a, IsString a,
IsString (Item a), Item a ~ (a, Referenced a)) =>
a -> b
awrapper Schema
sa
_ -> Schema -> Schema
forall b a a a a.
(Monoid b, HasType b (Maybe (SwaggerType 'SwaggerKindSchema)),
HasProperties b a, HasRequired b a, IsList a, IsList a, IsString a,
IsString (Item a), Item a ~ (a, Referenced a)) =>
a -> b
bwrapper Schema
sb Schema -> Schema -> Schema
forall a. Semigroup a => a -> a -> a
<> Schema -> Schema
forall b a a a a.
(Monoid b, HasType b (Maybe (SwaggerType 'SwaggerKindSchema)),
HasProperties b a, HasRequired b a, IsList a, IsList a, IsString a,
IsString (Item a), Item a ~ (a, Referenced a)) =>
a -> b
awrapper Schema
sa
where
combinedName :: a -> a -> a
combinedName a :: a
a b :: a
b = "WithFields_" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
a a -> a -> a
forall a. Semigroup a => a -> a -> a
<> "_" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
b
awrapper :: a -> b
awrapper nas :: a
nas = b
forall a. Monoid a => a
mempty
b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
& (Maybe (SwaggerType 'SwaggerKindSchema)
-> Identity (Maybe (SwaggerType 'SwaggerKindSchema)))
-> b -> Identity b
forall s a. HasType s a => Lens' s a
type_ ((Maybe (SwaggerType 'SwaggerKindSchema)
-> Identity (Maybe (SwaggerType 'SwaggerKindSchema)))
-> b -> Identity b)
-> Maybe (SwaggerType 'SwaggerKindSchema) -> b -> b
forall s t a b. ASetter s t a b -> b -> s -> t
.~ SwaggerType 'SwaggerKindSchema
-> Maybe (SwaggerType 'SwaggerKindSchema)
forall a. a -> Maybe a
Just SwaggerType 'SwaggerKindSchema
SwaggerObject
b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
& (a -> Identity a) -> b -> Identity b
forall s a. HasProperties s a => Lens' s a
properties ((a -> Identity a) -> b -> Identity b) -> a -> b -> b
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [ ("injected", a -> Referenced a
forall a. a -> Referenced a
Inline a
nas) ]
b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
& (a -> Identity a) -> b -> Identity b
forall s a. HasRequired s a => Lens' s a
required ((a -> Identity a) -> b -> Identity b) -> a -> b -> b
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [ "injected" ]
bwrapper :: a -> b
bwrapper nbs :: a
nbs = b
forall a. Monoid a => a
mempty
b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
& (Maybe (SwaggerType 'SwaggerKindSchema)
-> Identity (Maybe (SwaggerType 'SwaggerKindSchema)))
-> b -> Identity b
forall s a. HasType s a => Lens' s a
type_ ((Maybe (SwaggerType 'SwaggerKindSchema)
-> Identity (Maybe (SwaggerType 'SwaggerKindSchema)))
-> b -> Identity b)
-> Maybe (SwaggerType 'SwaggerKindSchema) -> b -> b
forall s t a b. ASetter s t a b -> b -> s -> t
.~ SwaggerType 'SwaggerKindSchema
-> Maybe (SwaggerType 'SwaggerKindSchema)
forall a. a -> Maybe a
Just SwaggerType 'SwaggerKindSchema
SwaggerObject
b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
& (a -> Identity a) -> b -> Identity b
forall s a. HasProperties s a => Lens' s a
properties ((a -> Identity a) -> b -> Identity b) -> a -> b -> b
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [ ("value", a -> Referenced a
forall a. a -> Referenced a
Inline a
nbs) ]
b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
& (a -> Identity a) -> b -> Identity b
forall s a. HasRequired s a => Lens' s a
required ((a -> Identity a) -> b -> Identity b) -> a -> b -> b
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [ "value" ]
newtype OnlyField (s :: Symbol) a = OnlyField { OnlyField s a -> a
unOnlyField :: a }
deriving ((forall x. OnlyField s a -> Rep (OnlyField s a) x)
-> (forall x. Rep (OnlyField s a) x -> OnlyField s a)
-> Generic (OnlyField s a)
forall x. Rep (OnlyField s a) x -> OnlyField s a
forall x. OnlyField s a -> Rep (OnlyField s a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (s :: Symbol) a x. Rep (OnlyField s a) x -> OnlyField s a
forall (s :: Symbol) a x. OnlyField s a -> Rep (OnlyField s a) x
$cto :: forall (s :: Symbol) a x. Rep (OnlyField s a) x -> OnlyField s a
$cfrom :: forall (s :: Symbol) a x. OnlyField s a -> Rep (OnlyField s a) x
Generic, Int -> OnlyField s a -> ShowS
[OnlyField s a] -> ShowS
OnlyField s a -> String
(Int -> OnlyField s a -> ShowS)
-> (OnlyField s a -> String)
-> ([OnlyField s a] -> ShowS)
-> Show (OnlyField s a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (s :: Symbol) a. Show a => Int -> OnlyField s a -> ShowS
forall (s :: Symbol) a. Show a => [OnlyField s a] -> ShowS
forall (s :: Symbol) a. Show a => OnlyField s a -> String
showList :: [OnlyField s a] -> ShowS
$cshowList :: forall (s :: Symbol) a. Show a => [OnlyField s a] -> ShowS
show :: OnlyField s a -> String
$cshow :: forall (s :: Symbol) a. Show a => OnlyField s a -> String
showsPrec :: Int -> OnlyField s a -> ShowS
$cshowsPrec :: forall (s :: Symbol) a. Show a => Int -> OnlyField s a -> ShowS
Show, ReadPrec [OnlyField s a]
ReadPrec (OnlyField s a)
Int -> ReadS (OnlyField s a)
ReadS [OnlyField s a]
(Int -> ReadS (OnlyField s a))
-> ReadS [OnlyField s a]
-> ReadPrec (OnlyField s a)
-> ReadPrec [OnlyField s a]
-> Read (OnlyField s a)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall (s :: Symbol) a. Read a => ReadPrec [OnlyField s a]
forall (s :: Symbol) a. Read a => ReadPrec (OnlyField s a)
forall (s :: Symbol) a. Read a => Int -> ReadS (OnlyField s a)
forall (s :: Symbol) a. Read a => ReadS [OnlyField s a]
readListPrec :: ReadPrec [OnlyField s a]
$creadListPrec :: forall (s :: Symbol) a. Read a => ReadPrec [OnlyField s a]
readPrec :: ReadPrec (OnlyField s a)
$creadPrec :: forall (s :: Symbol) a. Read a => ReadPrec (OnlyField s a)
readList :: ReadS [OnlyField s a]
$creadList :: forall (s :: Symbol) a. Read a => ReadS [OnlyField s a]
readsPrec :: Int -> ReadS (OnlyField s a)
$creadsPrec :: forall (s :: Symbol) a. Read a => Int -> ReadS (OnlyField s a)
Read, OnlyField s a -> OnlyField s a -> Bool
(OnlyField s a -> OnlyField s a -> Bool)
-> (OnlyField s a -> OnlyField s a -> Bool) -> Eq (OnlyField s a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (s :: Symbol) a.
Eq a =>
OnlyField s a -> OnlyField s a -> Bool
/= :: OnlyField s a -> OnlyField s a -> Bool
$c/= :: forall (s :: Symbol) a.
Eq a =>
OnlyField s a -> OnlyField s a -> Bool
== :: OnlyField s a -> OnlyField s a -> Bool
$c== :: forall (s :: Symbol) a.
Eq a =>
OnlyField s a -> OnlyField s a -> Bool
Eq)
type OnlyId i = OnlyField "id" i
instance Functor (OnlyField s) where
fmap :: (a -> b) -> OnlyField s a -> OnlyField s b
fmap f :: a -> b
f (OnlyField a :: a
a) = b -> OnlyField s b
forall (s :: Symbol) a. a -> OnlyField s a
OnlyField (a -> b
f a
a)
instance ToSample a => ToSample (OnlyField s a) where
toSamples :: Proxy (OnlyField s a) -> [(Text, OnlyField s a)]
toSamples _ = [OnlyField s a] -> [(Text, OnlyField s a)]
forall a. [a] -> [(Text, a)]
samples ([OnlyField s a] -> [(Text, OnlyField s a)])
-> [OnlyField s a] -> [(Text, OnlyField s a)]
forall a b. (a -> b) -> a -> b
$ a -> OnlyField s a
forall (s :: Symbol) a. a -> OnlyField s a
OnlyField (a -> OnlyField s a) -> [a] -> [OnlyField s a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a]
as
where
as :: [a]
as = (Text, a) -> a
forall a b. (a, b) -> b
snd ((Text, a) -> a) -> [(Text, a)] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy a -> [(Text, a)]
forall a. ToSample a => Proxy a -> [(Text, a)]
toSamples (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)
instance (KnownSymbol s, ToJSON a) => ToJSON (OnlyField s a) where
toJSON :: OnlyField s a -> Value
toJSON (OnlyField a :: a
a) = [Pair] -> Value
object [ KnownSymbol s => Key
forall (s :: Symbol). KnownSymbol s => Key
mkFieldName @s Key -> a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= a
a ]
instance (KnownSymbol s, FromJSON a) => FromJSON (OnlyField s a) where
parseJSON :: Value -> Parser (OnlyField s a)
parseJSON (Object o :: Object
o) = a -> OnlyField s a
forall (s :: Symbol) a. a -> OnlyField s a
OnlyField (a -> OnlyField s a) -> Parser a -> Parser (OnlyField s a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser a
forall a. FromJSON a => Object -> Key -> Parser a
.: (KnownSymbol s => Key
forall (s :: Symbol). KnownSymbol s => Key
mkFieldName @s)
parseJSON _ = Parser (OnlyField s a)
forall (m :: * -> *) a. MonadPlus m => m a
mzero
instance (KnownSymbol s, ToSchema a) => ToSchema (OnlyField s a) where
declareNamedSchema :: Proxy (OnlyField s a) -> Declare (Definitions Schema) NamedSchema
declareNamedSchema _ = do
NamedSchema an :: Maybe Text
an as :: Schema
as <- Proxy a -> Declare (Definitions Schema) NamedSchema
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) NamedSchema
declareNamedSchema (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)
let namePrefix :: Text
namePrefix = "OnlyField '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Key -> Text
Key.toText Key
field Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "' "
NamedSchema -> Declare (Definitions Schema) NamedSchema
forall (m :: * -> *) a. Monad m => a -> m a
return (NamedSchema -> Declare (Definitions Schema) NamedSchema)
-> NamedSchema -> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Schema -> NamedSchema
NamedSchema ((Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text
namePrefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) Maybe Text
an) (Schema -> NamedSchema) -> Schema -> NamedSchema
forall a b. (a -> b) -> a -> b
$ Schema
forall a. Monoid a => a
mempty
Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe (SwaggerType 'SwaggerKindSchema)
-> Identity (Maybe (SwaggerType 'SwaggerKindSchema)))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
type_ ((Maybe (SwaggerType 'SwaggerKindSchema)
-> Identity (Maybe (SwaggerType 'SwaggerKindSchema)))
-> Schema -> Identity Schema)
-> Maybe (SwaggerType 'SwaggerKindSchema) -> Schema -> Schema
forall s t a b. ASetter s t a b -> b -> s -> t
.~ SwaggerType 'SwaggerKindSchema
-> Maybe (SwaggerType 'SwaggerKindSchema)
forall a. a -> Maybe a
Just SwaggerType 'SwaggerKindSchema
SwaggerObject
Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (InsOrdHashMap Text (Referenced Schema)
-> Identity (InsOrdHashMap Text (Referenced Schema)))
-> Schema -> Identity Schema
forall s a. HasProperties s a => Lens' s a
properties ((InsOrdHashMap Text (Referenced Schema)
-> Identity (InsOrdHashMap Text (Referenced Schema)))
-> Schema -> Identity Schema)
-> InsOrdHashMap Text (Referenced Schema) -> Schema -> Schema
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [(Key -> Text
Key.toText Key
field, Schema -> Referenced Schema
forall a. a -> Referenced a
Inline Schema
as)]
Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& ([Text] -> Identity [Text]) -> Schema -> Identity Schema
forall s a. HasRequired s a => Lens' s a
required (([Text] -> Identity [Text]) -> Schema -> Identity Schema)
-> [Text] -> Schema -> Schema
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Key -> Text
Key.toText Key
field]
where
field :: Key
field = KnownSymbol s => Key
forall (s :: Symbol). KnownSymbol s => Key
mkFieldName @s
mkFieldName :: forall s . KnownSymbol s => Key.Key
mkFieldName :: Key
mkFieldName = String -> Key
Key.fromString (String -> Key) -> String -> Key
forall a b. (a -> b) -> a -> b
$ Proxy s -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy s
forall k (t :: k). Proxy t
Proxy :: Proxy s)