{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# 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 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.HashMap.Strict as H
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 :: 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)
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
$ Text -> Value -> Object -> Object
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
H.insert Text
field (a -> Value
forall a. ToJSON a => a -> Value
toJSON a
a) Object
vs
_ -> [Pair] -> Value
object [
"value" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Value
jsonb
, Text
field Text -> a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> 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 (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (WithField s a b)
wrapper
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)
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 -> Text -> Parser a
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
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
$ Text -> Object -> Object
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
H.delete Text
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 -> Text -> Parser a
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
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 -> Text -> Parser b
forall a. FromJSON a => Object -> Text -> 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 k v.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k v -> HashMap k v
H.union Object
avs Object
bvs
_ -> Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ Text -> Value -> Object -> Object
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
H.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 Text -> Object -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup "value" Object
avs of
Nothing -> Text -> Value -> Object -> Object
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
H.insert "value" Value
jsonb Object
avs
Just _ -> Object
avs
_ -> [Pair] -> Value
object [
"injected" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Value
jsona
, "value" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> 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 (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((, 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 -> Text -> Parser a
forall a. FromJSON a => Object -> Text -> Parser a
.: "injected"))
let o' :: Object
o' = (if Bool
isInjected then Text -> Object -> Object
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
H.delete "injected" else [Text] -> Object -> Object
forall k v. (Eq k, Hashable k) => [k] -> HashMap k v -> HashMap k v
deleteAll (a -> [Text]
ToJSON a => a -> [Text]
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 (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Object
o' Object -> Text -> Parser b
forall a. FromJSON a => Object -> Text -> 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 (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Object
o Object -> Text -> Parser b
forall a. FromJSON a => Object -> Text -> 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 :: (Eq k, Hashable k) => [k] -> H.HashMap k v -> H.HashMap k v
deleteAll :: [k] -> HashMap k v -> HashMap k v
deleteAll ks :: [k]
ks m :: HashMap k v
m = (HashMap k v -> k -> HashMap k v)
-> HashMap k v -> [k] -> HashMap k v
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' ((k -> HashMap k v -> HashMap k v)
-> HashMap k v -> k -> HashMap k v
forall a b c. (a -> b -> c) -> b -> a -> c
flip k -> HashMap k v -> HashMap k v
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
H.delete) HashMap k v
m [k]
ks
extractFields :: ToJSON a => a -> [T.Text]
extractFields :: a -> [Text]
extractFields a :: a
a = case a -> Value
forall a. ToJSON a => a -> Value
toJSON a
a of
Object vs :: Object
vs -> Object -> [Text]
forall k v. HashMap k v -> [k]
H.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 [ Text
field Text -> a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= a
a ]
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)
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 -> Text -> Parser a
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
field
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)
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
<> Text
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
.~ [(Text
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
.~ [Text
Item [Text]
field]
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)