{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
module Data.HighJson.Swagger
( makeDeclareNamedSchema, makeDeclareNamedSchema', DeclM
, IsValidSwaggerType, AllAre, NoneAre
)
where
import Control.Lens
import Data.HVect (AllHave)
import Data.HashMap.Strict.InsOrd (InsOrdHashMap)
import Data.HighJson
import Data.Kind
import Data.Proxy
import Data.Swagger
import Data.Swagger.Declare
import qualified Data.HashMap.Strict.InsOrd as IOM
import qualified Data.Text as T
type DeclM = Declare (Definitions Schema)
type family AllAre x (xs :: [*]) :: Bool where
AllAre x (x ': xs) = AllAre x xs
AllAre x '[] = 'True
type family NoneAre x (xs :: [*]) :: Bool where
NoneAre x (x ': xs) = 'False
NoneAre x (y ': xs) = NoneAre x xs
NoneAre x '[] = 'True
type family IsValidSwaggerType ty (ts :: [*]) :: Constraint where
IsValidSwaggerType 'SpecRecord xs = 'True ~ 'True
IsValidSwaggerType 'SpecSum xs = NoneAre () xs ~ 'True
IsValidSwaggerType 'SpecEnum xs = AllAre () xs ~ 'True
makeDeclareNamedSchema ::
(AllHave ToSchema ts, AllHave ToJSON ts, IsValidSwaggerType ty ts)
=> HighSpec k ty ts
-> f k
-> DeclM NamedSchema
makeDeclareNamedSchema :: HighSpec k ty ts -> f k -> DeclM NamedSchema
makeDeclareNamedSchema HighSpec k ty ts
spec = HighSpec k ty ts -> Maybe k -> f k -> DeclM NamedSchema
forall (ts :: [*]) (ty :: SpecType) k (f :: * -> *).
(AllHave ToSchema ts, AllHave ToJSON ts,
IsValidSwaggerType ty ts) =>
HighSpec k ty ts -> Maybe k -> f k -> DeclM NamedSchema
makeDeclareNamedSchema' HighSpec k ty ts
spec Maybe k
forall a. Maybe a
Nothing
makeDeclareNamedSchema' ::
(AllHave ToSchema ts, AllHave ToJSON ts, IsValidSwaggerType ty ts)
=> HighSpec k ty ts
-> Maybe k
-> f k
-> DeclM NamedSchema
makeDeclareNamedSchema' :: HighSpec k ty ts -> Maybe k -> f k -> DeclM NamedSchema
makeDeclareNamedSchema' HighSpec k ty ts
spec Maybe k
exVal f k
_ =
case HighSpec k ty ts -> BodySpec ty k ts
forall a (ty :: SpecType) (as :: [*]).
HighSpec a ty as -> BodySpec ty a as
hs_bodySpec HighSpec k ty ts
spec of
BodySpecRecord RecordSpec k ts
r ->
do (InsOrdHashMap Text (Referenced Schema)
props, [Text]
reqs) <- RecordSpec k ts
-> DeclM (InsOrdHashMap Text (Referenced Schema), [Text])
forall k (ts :: [*]).
AllHave ToSchema ts =>
RecordSpec k ts
-> DeclM (InsOrdHashMap Text (Referenced Schema), [Text])
computeRecProperties RecordSpec k ts
r
NamedSchema -> DeclM NamedSchema
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamedSchema -> DeclM NamedSchema)
-> NamedSchema -> DeclM NamedSchema
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Schema -> NamedSchema
NamedSchema (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ HighSpec k ty ts -> Text
forall a (ty :: SpecType) (as :: [*]). HighSpec a ty as -> Text
hs_name HighSpec k ty ts
spec) (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)
-> SwaggerType 'SwaggerKindSchema -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ SwaggerType 'SwaggerKindSchema
SwaggerObject
Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe Text -> Identity (Maybe Text)) -> Schema -> Identity Schema
forall s a. HasDescription s a => Lens' s a
description ((Maybe Text -> Identity (Maybe Text))
-> Schema -> Identity Schema)
-> Maybe Text -> Schema -> Schema
forall s t a b. ASetter s t a b -> b -> s -> t
.~ HighSpec k ty ts -> Maybe Text
forall a (ty :: SpecType) (as :: [*]).
HighSpec a ty as -> Maybe Text
hs_description HighSpec k ty ts
spec
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
.~ InsOrdHashMap Text (Referenced Schema)
props
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]
reqs
Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe Integer -> Identity (Maybe Integer))
-> Schema -> Identity Schema
forall s a. HasMaxProperties s a => Lens' s a
maxProperties ((Maybe Integer -> Identity (Maybe Integer))
-> Schema -> Identity Schema)
-> Maybe Integer -> Schema -> Schema
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Maybe Integer
forall a. a -> Maybe a
Just (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ InsOrdHashMap Text (Referenced Schema) -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length InsOrdHashMap Text (Referenced Schema)
props)
Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe Integer -> Identity (Maybe Integer))
-> Schema -> Identity Schema
forall s a. HasMinProperties s a => Lens' s a
minProperties ((Maybe Integer -> Identity (Maybe Integer))
-> Schema -> Identity Schema)
-> Maybe Integer -> Schema -> Schema
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Maybe Integer
forall a. a -> Maybe a
Just (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
reqs)
Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe Value -> Identity (Maybe Value))
-> Schema -> Identity Schema
forall s a. HasExample s a => Lens' s a
example ((Maybe Value -> Identity (Maybe Value))
-> Schema -> Identity Schema)
-> Maybe Value -> Schema -> Schema
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (k -> Value) -> Maybe k -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (HighSpec k ty ts -> k -> Value
forall (as :: [*]) a (ty :: SpecType).
AllHave ToJSON as =>
HighSpec a ty as -> a -> Value
jsonSerializer HighSpec k ty ts
spec) Maybe k
exVal
BodySpecSum SumSpec k ts
r ->
do (InsOrdHashMap Text (Referenced Schema)
props, [Text]
reqs) <- SumSpec k ts
-> DeclM (InsOrdHashMap Text (Referenced Schema), [Text])
forall k (ts :: [*]).
AllHave ToSchema ts =>
SumSpec k ts
-> DeclM (InsOrdHashMap Text (Referenced Schema), [Text])
computeSumProperties SumSpec k ts
r
NamedSchema -> DeclM NamedSchema
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamedSchema -> DeclM NamedSchema)
-> NamedSchema -> DeclM NamedSchema
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Schema -> NamedSchema
NamedSchema (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ HighSpec k ty ts -> Text
forall a (ty :: SpecType) (as :: [*]). HighSpec a ty as -> Text
hs_name HighSpec k ty ts
spec) (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)
-> SwaggerType 'SwaggerKindSchema -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ SwaggerType 'SwaggerKindSchema
SwaggerObject
Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe Text -> Identity (Maybe Text)) -> Schema -> Identity Schema
forall s a. HasDescription s a => Lens' s a
description ((Maybe Text -> Identity (Maybe Text))
-> Schema -> Identity Schema)
-> Maybe Text -> Schema -> Schema
forall s t a b. ASetter s t a b -> b -> s -> t
.~ HighSpec k ty ts -> Maybe Text
forall a (ty :: SpecType) (as :: [*]).
HighSpec a ty as -> Maybe Text
hs_description HighSpec k ty ts
spec
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
.~ InsOrdHashMap Text (Referenced Schema)
props
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]
reqs
Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe Integer -> Identity (Maybe Integer))
-> Schema -> Identity Schema
forall s a. HasMaxProperties s a => Lens' s a
maxProperties ((Maybe Integer -> Identity (Maybe Integer))
-> Schema -> Identity Schema)
-> Maybe Integer -> Schema -> Schema
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
1
Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe Integer -> Identity (Maybe Integer))
-> Schema -> Identity Schema
forall s a. HasMinProperties s a => Lens' s a
minProperties ((Maybe Integer -> Identity (Maybe Integer))
-> Schema -> Identity Schema)
-> Maybe Integer -> Schema -> Schema
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
1
Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe Value -> Identity (Maybe Value))
-> Schema -> Identity Schema
forall s a. HasExample s a => Lens' s a
example ((Maybe Value -> Identity (Maybe Value))
-> Schema -> Identity Schema)
-> Maybe Value -> Schema -> Schema
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (k -> Value) -> Maybe k -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (HighSpec k ty ts -> k -> Value
forall (as :: [*]) a (ty :: SpecType).
AllHave ToJSON as =>
HighSpec a ty as -> a -> Value
jsonSerializer HighSpec k ty ts
spec) Maybe k
exVal
BodySpecEnum EnumSpec k
r ->
let ps :: ParamSchema 'SwaggerKindSchema
ps =
ParamSchema 'SwaggerKindSchema
forall a. Monoid a => a
mempty
ParamSchema 'SwaggerKindSchema
-> (ParamSchema 'SwaggerKindSchema
-> ParamSchema 'SwaggerKindSchema)
-> ParamSchema 'SwaggerKindSchema
forall a b. a -> (a -> b) -> b
& (Maybe (SwaggerType 'SwaggerKindSchema)
-> Identity (Maybe (SwaggerType 'SwaggerKindSchema)))
-> ParamSchema 'SwaggerKindSchema
-> Identity (ParamSchema 'SwaggerKindSchema)
forall s a. HasType s a => Lens' s a
type_ ((Maybe (SwaggerType 'SwaggerKindSchema)
-> Identity (Maybe (SwaggerType 'SwaggerKindSchema)))
-> ParamSchema 'SwaggerKindSchema
-> Identity (ParamSchema 'SwaggerKindSchema))
-> SwaggerType 'SwaggerKindSchema
-> ParamSchema 'SwaggerKindSchema
-> ParamSchema 'SwaggerKindSchema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ SwaggerType 'SwaggerKindSchema
forall (t :: SwaggerKind *). SwaggerType t
SwaggerString
ParamSchema 'SwaggerKindSchema
-> (ParamSchema 'SwaggerKindSchema
-> ParamSchema 'SwaggerKindSchema)
-> ParamSchema 'SwaggerKindSchema
forall a b. a -> (a -> b) -> b
& (Maybe [Value] -> Identity (Maybe [Value]))
-> ParamSchema 'SwaggerKindSchema
-> Identity (ParamSchema 'SwaggerKindSchema)
forall s a. HasEnum s a => Lens' s a
enum_ ((Maybe [Value] -> Identity (Maybe [Value]))
-> ParamSchema 'SwaggerKindSchema
-> Identity (ParamSchema 'SwaggerKindSchema))
-> Maybe [Value]
-> ParamSchema 'SwaggerKindSchema
-> ParamSchema 'SwaggerKindSchema
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Value] -> Maybe [Value]
forall a. a -> Maybe a
Just ((EnumOption k -> Value) -> [EnumOption k] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> (EnumOption k -> Text) -> EnumOption k -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnumOption k -> Text
forall t. EnumOption t -> Text
eo_jsonKey) (EnumSpec k -> [EnumOption k]
forall a. EnumSpec a -> [EnumOption a]
es_options EnumSpec k
r))
in NamedSchema -> DeclM NamedSchema
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamedSchema -> DeclM NamedSchema)
-> NamedSchema -> DeclM NamedSchema
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Schema -> NamedSchema
NamedSchema (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ HighSpec k ty ts -> Text
forall a (ty :: SpecType) (as :: [*]). HighSpec a ty as -> Text
hs_name HighSpec k ty ts
spec) (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)
-> SwaggerType 'SwaggerKindSchema -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ SwaggerType 'SwaggerKindSchema
forall (t :: SwaggerKind *). SwaggerType t
SwaggerString
Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe Text -> Identity (Maybe Text)) -> Schema -> Identity Schema
forall s a. HasDescription s a => Lens' s a
description ((Maybe Text -> Identity (Maybe Text))
-> Schema -> Identity Schema)
-> Maybe Text -> Schema -> Schema
forall s t a b. ASetter s t a b -> b -> s -> t
.~ HighSpec k ty ts -> Maybe Text
forall a (ty :: SpecType) (as :: [*]).
HighSpec a ty as -> Maybe Text
hs_description HighSpec k ty ts
spec
Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe Value -> Identity (Maybe Value))
-> Schema -> Identity Schema
forall s a. HasExample s a => Lens' s a
example ((Maybe Value -> Identity (Maybe Value))
-> Schema -> Identity Schema)
-> Maybe Value -> Schema -> Schema
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (k -> Value) -> Maybe k -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (HighSpec k ty ts -> k -> Value
forall (as :: [*]) a (ty :: SpecType).
AllHave ToJSON as =>
HighSpec a ty as -> a -> Value
jsonSerializer HighSpec k ty ts
spec) Maybe k
exVal
Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (ParamSchema 'SwaggerKindSchema
-> Identity (ParamSchema 'SwaggerKindSchema))
-> Schema -> Identity Schema
forall s a. HasParamSchema s a => Lens' s a
paramSchema ((ParamSchema 'SwaggerKindSchema
-> Identity (ParamSchema 'SwaggerKindSchema))
-> Schema -> Identity Schema)
-> ParamSchema 'SwaggerKindSchema -> Schema -> Schema
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ParamSchema 'SwaggerKindSchema
ps
computeSumProperties ::
forall k ts. AllHave ToSchema ts
=> SumSpec k ts
-> DeclM (InsOrdHashMap T.Text (Referenced Schema), [ParamName])
computeSumProperties :: SumSpec k ts
-> DeclM (InsOrdHashMap Text (Referenced Schema), [Text])
computeSumProperties SumSpec k ts
fs =
SumOptions k ts
-> (InsOrdHashMap Text (Referenced Schema), [Text])
-> DeclM (InsOrdHashMap Text (Referenced Schema), [Text])
forall (qs :: [*]).
AllHave ToSchema qs =>
SumOptions k qs
-> (InsOrdHashMap Text (Referenced Schema), [Text])
-> DeclM (InsOrdHashMap Text (Referenced Schema), [Text])
go (SumSpec k ts -> SumOptions k ts
forall a (os :: [*]). SumSpec a os -> SumOptions a os
ss_options SumSpec k ts
fs) (InsOrdHashMap Text (Referenced Schema)
forall a. Monoid a => a
mempty, [Text]
forall a. Monoid a => a
mempty)
where
go ::
forall qs. AllHave ToSchema qs
=> SumOptions k qs
-> (InsOrdHashMap T.Text (Referenced Schema), [ParamName])
-> DeclM (InsOrdHashMap T.Text (Referenced Schema), [ParamName])
go :: SumOptions k qs
-> (InsOrdHashMap Text (Referenced Schema), [Text])
-> DeclM (InsOrdHashMap Text (Referenced Schema), [Text])
go SumOptions k qs
spec (InsOrdHashMap Text (Referenced Schema)
props, [Text]
reqs) =
case SumOptions k qs
spec of
SumOptions k qs
SOEmpty ->
(InsOrdHashMap Text (Referenced Schema), [Text])
-> DeclM (InsOrdHashMap Text (Referenced Schema), [Text])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InsOrdHashMap Text (Referenced Schema)
props, [Text]
reqs)
(SumOption k o
key :: SumOption k t) :|: SumOptions k os1
rest ->
do Referenced Schema
fieldSchema <- Proxy o -> Declare (Definitions Schema) (Referenced Schema)
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) (Referenced Schema)
declareSchemaRef (Proxy o
forall k (t :: k). Proxy t
Proxy :: Proxy t)
let fld :: InsOrdHashMap Text (Referenced Schema)
fld =
Text -> Referenced Schema -> InsOrdHashMap Text (Referenced Schema)
forall k v. Hashable k => k -> v -> InsOrdHashMap k v
IOM.singleton (SumOption k o -> Text
forall t o. SumOption t o -> Text
so_jsonKey SumOption k o
key) Referenced Schema
fieldSchema
SumOptions k os1
-> (InsOrdHashMap Text (Referenced Schema), [Text])
-> DeclM (InsOrdHashMap Text (Referenced Schema), [Text])
forall (qs :: [*]).
AllHave ToSchema qs =>
SumOptions k qs
-> (InsOrdHashMap Text (Referenced Schema), [Text])
-> DeclM (InsOrdHashMap Text (Referenced Schema), [Text])
go SumOptions k os1
rest (InsOrdHashMap Text (Referenced Schema)
fld InsOrdHashMap Text (Referenced Schema)
-> InsOrdHashMap Text (Referenced Schema)
-> InsOrdHashMap Text (Referenced Schema)
forall a. Semigroup a => a -> a -> a
<> InsOrdHashMap Text (Referenced Schema)
props, [Text]
reqs)
computeRecProperties ::
forall k ts. AllHave ToSchema ts
=> RecordSpec k ts
-> DeclM (InsOrdHashMap T.Text (Referenced Schema), [ParamName])
computeRecProperties :: RecordSpec k ts
-> DeclM (InsOrdHashMap Text (Referenced Schema), [Text])
computeRecProperties RecordSpec k ts
fs =
RecordFields k ts
-> (InsOrdHashMap Text (Referenced Schema), [Text])
-> DeclM (InsOrdHashMap Text (Referenced Schema), [Text])
forall (qs :: [*]).
AllHave ToSchema qs =>
RecordFields k qs
-> (InsOrdHashMap Text (Referenced Schema), [Text])
-> DeclM (InsOrdHashMap Text (Referenced Schema), [Text])
go (RecordSpec k ts -> RecordFields k ts
forall a (fs :: [*]). RecordSpec a fs -> RecordFields a fs
rs_fields RecordSpec k ts
fs) (InsOrdHashMap Text (Referenced Schema)
forall a. Monoid a => a
mempty, [Text]
forall a. Monoid a => a
mempty)
where
go ::
forall qs. AllHave ToSchema qs
=> RecordFields k qs
-> (InsOrdHashMap T.Text (Referenced Schema), [ParamName])
-> DeclM (InsOrdHashMap T.Text (Referenced Schema), [ParamName])
go :: RecordFields k qs
-> (InsOrdHashMap Text (Referenced Schema), [Text])
-> DeclM (InsOrdHashMap Text (Referenced Schema), [Text])
go RecordFields k qs
spec (InsOrdHashMap Text (Referenced Schema)
props, [Text]
reqs) =
case RecordFields k qs
spec of
RecordFields k qs
RFEmpty ->
(InsOrdHashMap Text (Referenced Schema), [Text])
-> DeclM (InsOrdHashMap Text (Referenced Schema), [Text])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InsOrdHashMap Text (Referenced Schema)
props, [Text]
reqs)
(RecordField k f
key :: RecordField k t) :+: RecordFields k fs1
rest ->
do Referenced Schema
fieldSchema <- Proxy f -> Declare (Definitions Schema) (Referenced Schema)
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) (Referenced Schema)
declareSchemaRef (Proxy f
forall k (t :: k). Proxy t
Proxy :: Proxy t)
let fld :: InsOrdHashMap Text (Referenced Schema)
fld =
Text -> Referenced Schema -> InsOrdHashMap Text (Referenced Schema)
forall k v. Hashable k => k -> v -> InsOrdHashMap k v
IOM.singleton (RecordField k f -> Text
forall t f. RecordField t f -> Text
rf_jsonKey RecordField k f
key) Referenced Schema
fieldSchema
reqs' :: [Text]
reqs' =
if Bool -> Bool
not (RecordField k f -> Bool
forall t f. RecordField t f -> Bool
rf_optional RecordField k f
key)
then RecordField k f -> Text
forall t f. RecordField t f -> Text
rf_jsonKey RecordField k f
key Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
reqs
else [Text]
reqs
RecordFields k fs1
-> (InsOrdHashMap Text (Referenced Schema), [Text])
-> DeclM (InsOrdHashMap Text (Referenced Schema), [Text])
forall (qs :: [*]).
AllHave ToSchema qs =>
RecordFields k qs
-> (InsOrdHashMap Text (Referenced Schema), [Text])
-> DeclM (InsOrdHashMap Text (Referenced Schema), [Text])
go RecordFields k fs1
rest (InsOrdHashMap Text (Referenced Schema)
fld InsOrdHashMap Text (Referenced Schema)
-> InsOrdHashMap Text (Referenced Schema)
-> InsOrdHashMap Text (Referenced Schema)
forall a. Semigroup a => a -> a -> a
<> InsOrdHashMap Text (Referenced Schema)
props, [Text]
reqs')