{-# 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

-- | Not all valid Haskell types have a valid swagger mapping. Simple records
-- are fine, but sum types should be either "real" Enums or every option must
-- contain a value. For more information see the swagger2 haskell package.
type family IsValidSwaggerType ty (ts :: [*]) :: Constraint where
    IsValidSwaggerType 'SpecRecord xs = 'True ~ 'True
    IsValidSwaggerType 'SpecSum xs = NoneAre () xs ~ 'True
    IsValidSwaggerType 'SpecEnum xs = AllAre () xs ~ 'True

-- | Automatically generate a 'NamedSchema' from a 'HighSpec'
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

-- | Automatically generate a 'NamedSchema' from a 'HighSpec' while optionally
-- providing an example value
makeDeclareNamedSchema' ::
    (AllHave ToSchema ts, AllHave ToJSON ts, IsValidSwaggerType ty ts)
    => HighSpec k ty ts
    -> Maybe k
    -- ^ example value
    -> 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')