{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
module Data.JsonSpec.OpenApi (
toOpenApiSchema,
Schemaable,
EncodingSchema(..),
DecodingSchema(..),
) where
import Control.Lens (At(at), (&), over, set)
import Data.Aeson (ToJSON(toJSON))
import Data.Functor.Identity (Identity(runIdentity))
import Data.JsonSpec (FieldSpec(Optional, Required),
HasJsonDecodingSpec(DecodingSpec), HasJsonEncodingSpec(EncodingSpec),
Specification(JsonArray, JsonBool, JsonDateTime, JsonEither, JsonInt,
JsonLet, JsonNullable, JsonNum, JsonObject, JsonRef, JsonString,
JsonTag))
import Data.OpenApi (AdditionalProperties(AdditionalPropertiesAllowed),
HasAdditionalProperties(additionalProperties), HasEnum(enum_),
HasFormat(format), HasItems(items), HasOneOf(oneOf),
HasProperties(properties), HasRequired(required), HasType(type_),
NamedSchema(NamedSchema), OpenApiItems(OpenApiItemsObject),
OpenApiType(OpenApiArray, OpenApiBoolean, OpenApiInteger, OpenApiNull,
OpenApiNumber, OpenApiObject, OpenApiString), Reference(Reference),
Referenced(Inline, Ref), ToSchema(declareNamedSchema), Definitions,
Schema)
import Data.OpenApi.Declare (DeclareT(runDeclareT), MonadDeclare(declare))
import Data.String (IsString(fromString))
import Data.Text (Text)
import Data.Typeable (Proxy(Proxy), Typeable)
import GHC.TypeError (ErrorMessage((:$$:), (:<>:)), Unsatisfiable,
unsatisfiable)
import GHC.TypeLits (KnownSymbol, Symbol, symbolVal)
import Prelude (Applicative(pure), Bool(False), Functor(fmap), Maybe(Just,
Nothing), Monoid(mempty), ($), (.))
import qualified Data.HashMap.Strict.InsOrd as HMI
import qualified GHC.TypeError as TE
toOpenApiSchema
:: (Schemaable spec)
=> Proxy (spec :: Specification)
-> (Definitions Schema, Schema)
toOpenApiSchema :: forall (spec :: Specification).
Schemaable spec =>
Proxy spec -> (Definitions Schema, Schema)
toOpenApiSchema Proxy spec
spec =
Identity (Definitions Schema, Schema)
-> (Definitions Schema, Schema)
forall a. Identity a -> a
runIdentity (DeclareT (Definitions Schema) Identity Schema
-> Definitions Schema -> Identity (Definitions Schema, Schema)
forall d (m :: * -> *) a. DeclareT d m a -> d -> m (d, a)
runDeclareT (Proxy spec -> DeclareT (Definitions Schema) Identity Schema
forall (spec :: Specification) (m :: * -> *).
(Schemaable spec, MonadDeclare (Definitions Schema) m) =>
Proxy spec -> m Schema
forall (m :: * -> *).
MonadDeclare (Definitions Schema) m =>
Proxy spec -> m Schema
schemaable Proxy spec
spec) Definitions Schema
forall a. Monoid a => a
mempty)
class Refable (spec :: Specification) where
refable
:: (MonadDeclare (Definitions Schema) m)
=> Proxy spec
-> m (Referenced Schema)
instance (KnownSymbol name) => Refable (JsonRef name) where
refable :: forall (m :: * -> *).
MonadDeclare (Definitions Schema) m =>
Proxy ('JsonRef name) -> m (Referenced Schema)
refable Proxy ('JsonRef name)
Proxy =
Referenced Schema -> m (Referenced Schema)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Referenced Schema
forall a. Text -> Referenced a
ref (forall (a :: Symbol) b. (IsString b, KnownSymbol a) => b
sym @name))
instance
( Defs defs
, KnownSymbol name
)
=>
Refable (JsonLet defs (JsonRef name))
where
refable :: forall (m :: * -> *).
MonadDeclare (Definitions Schema) m =>
Proxy ('JsonLet defs ('JsonRef name)) -> m (Referenced Schema)
refable Proxy ('JsonLet defs ('JsonRef name))
Proxy = do
Proxy defs -> m ()
forall (defs :: [(Symbol, Specification)]) (m :: * -> *).
(Defs defs, MonadDeclare (Definitions Schema) m) =>
Proxy defs -> m ()
forall (m :: * -> *).
MonadDeclare (Definitions Schema) m =>
Proxy defs -> m ()
mkDefs (forall (t :: [(Symbol, Specification)]). Proxy t
forall {k} (t :: k). Proxy t
Proxy @defs)
Proxy ('JsonRef name) -> m (Referenced Schema)
forall (spec :: Specification) (m :: * -> *).
(Refable spec, MonadDeclare (Definitions Schema) m) =>
Proxy spec -> m (Referenced Schema)
forall (m :: * -> *).
MonadDeclare (Definitions Schema) m =>
Proxy ('JsonRef name) -> m (Referenced Schema)
refable (forall {k} (t :: k). Proxy t
forall (t :: Specification). Proxy t
Proxy @(JsonRef name))
instance {-# overlaps #-} (Schemaable a) => Refable a where
refable :: forall (m :: * -> *).
MonadDeclare (Definitions Schema) m =>
Proxy a -> m (Referenced Schema)
refable = (Schema -> Referenced Schema) -> m Schema -> m (Referenced Schema)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Schema -> Referenced Schema
forall a. a -> Referenced a
Inline (m Schema -> m (Referenced Schema))
-> (Proxy a -> m Schema) -> Proxy a -> m (Referenced Schema)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy a -> m Schema
forall (spec :: Specification) (m :: * -> *).
(Schemaable spec, MonadDeclare (Definitions Schema) m) =>
Proxy spec -> m Schema
forall (m :: * -> *).
MonadDeclare (Definitions Schema) m =>
Proxy a -> m Schema
schemaable
class Schemaable (spec :: Specification) where
schemaable
:: (MonadDeclare (Definitions Schema) m)
=> Proxy spec
-> m Schema
instance (KnownSymbol tag) => Schemaable ('JsonTag tag) where
schemaable :: forall (m :: * -> *).
MonadDeclare (Definitions Schema) m =>
Proxy ('JsonTag tag) -> m Schema
schemaable Proxy ('JsonTag tag)
Proxy =
Schema -> m Schema
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Schema -> m Schema) -> Schema -> m Schema
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
& ASetter Schema Schema (Maybe [Value]) (Maybe [Value])
-> Maybe [Value] -> Schema -> Schema
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Schema Schema (Maybe [Value]) (Maybe [Value])
forall s a. HasEnum s a => Lens' s a
Lens' Schema (Maybe [Value])
enum_ ([Value] -> Maybe [Value]
forall a. a -> Maybe a
Just [Text -> Value
forall a. ToJSON a => a -> Value
toJSON (forall (a :: Symbol) b. (IsString b, KnownSymbol a) => b
sym @tag :: Text)])
instance Schemaable 'JsonString where
schemaable :: forall (m :: * -> *).
MonadDeclare (Definitions Schema) m =>
Proxy 'JsonString -> m Schema
schemaable Proxy 'JsonString
Proxy =
Schema -> m Schema
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Schema -> m Schema) -> Schema -> m Schema
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
& ASetter Schema Schema (Maybe OpenApiType) (Maybe OpenApiType)
-> Maybe OpenApiType -> Schema -> Schema
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Schema Schema (Maybe OpenApiType) (Maybe OpenApiType)
forall s a. HasType s a => Lens' s a
Lens' Schema (Maybe OpenApiType)
type_ (OpenApiType -> Maybe OpenApiType
forall a. a -> Maybe a
Just OpenApiType
OpenApiString)
instance
( Schemaable left
, Schemaable right
)
=>
Schemaable ('JsonEither left right)
where
schemaable :: forall (m :: * -> *).
MonadDeclare (Definitions Schema) m =>
Proxy ('JsonEither left right) -> m Schema
schemaable Proxy ('JsonEither left right)
Proxy = do
Schema
schemaLeft <- Proxy left -> m Schema
forall (spec :: Specification) (m :: * -> *).
(Schemaable spec, MonadDeclare (Definitions Schema) m) =>
Proxy spec -> m Schema
forall (m :: * -> *).
MonadDeclare (Definitions Schema) m =>
Proxy left -> m Schema
schemaable (forall {k} (t :: k). Proxy t
forall (t :: Specification). Proxy t
Proxy @left)
Schema
schemaRight <- Proxy right -> m Schema
forall (spec :: Specification) (m :: * -> *).
(Schemaable spec, MonadDeclare (Definitions Schema) m) =>
Proxy spec -> m Schema
forall (m :: * -> *).
MonadDeclare (Definitions Schema) m =>
Proxy right -> m Schema
schemaable (forall {k} (t :: k). Proxy t
forall (t :: Specification). Proxy t
Proxy @right)
Schema -> m Schema
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Schema -> m Schema) -> Schema -> m Schema
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
& ASetter
Schema
Schema
(Maybe [Referenced Schema])
(Maybe [Referenced Schema])
-> Maybe [Referenced Schema] -> Schema -> Schema
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
Schema
Schema
(Maybe [Referenced Schema])
(Maybe [Referenced Schema])
forall s a. HasOneOf s a => Lens' s a
Lens' Schema (Maybe [Referenced Schema])
oneOf ([Referenced Schema] -> Maybe [Referenced Schema]
forall a. a -> Maybe a
Just
[ Schema -> Referenced Schema
forall a. a -> Referenced a
Inline Schema
schemaLeft
, Schema -> Referenced Schema
forall a. a -> Referenced a
Inline Schema
schemaRight
]
)
instance Schemaable 'JsonNum where
schemaable :: forall (m :: * -> *).
MonadDeclare (Definitions Schema) m =>
Proxy 'JsonNum -> m Schema
schemaable Proxy 'JsonNum
Proxy =
Schema -> m Schema
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Schema -> m Schema) -> Schema -> m Schema
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
& ASetter Schema Schema (Maybe OpenApiType) (Maybe OpenApiType)
-> Maybe OpenApiType -> Schema -> Schema
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Schema Schema (Maybe OpenApiType) (Maybe OpenApiType)
forall s a. HasType s a => Lens' s a
Lens' Schema (Maybe OpenApiType)
type_ (OpenApiType -> Maybe OpenApiType
forall a. a -> Maybe a
Just OpenApiType
OpenApiNumber)
instance Schemaable 'JsonInt where
schemaable :: forall (m :: * -> *).
MonadDeclare (Definitions Schema) m =>
Proxy 'JsonInt -> m Schema
schemaable Proxy 'JsonInt
Proxy =
Schema -> m Schema
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Schema -> m Schema) -> Schema -> m Schema
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
& ASetter Schema Schema (Maybe OpenApiType) (Maybe OpenApiType)
-> Maybe OpenApiType -> Schema -> Schema
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Schema Schema (Maybe OpenApiType) (Maybe OpenApiType)
forall s a. HasType s a => Lens' s a
Lens' Schema (Maybe OpenApiType)
type_ (OpenApiType -> Maybe OpenApiType
forall a. a -> Maybe a
Just OpenApiType
OpenApiInteger)
instance Schemaable ('JsonObject '[]) where
schemaable :: forall (m :: * -> *).
MonadDeclare (Definitions Schema) m =>
Proxy ('JsonObject '[]) -> m Schema
schemaable Proxy ('JsonObject '[])
Proxy =
Schema -> m Schema
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Schema -> m Schema) -> Schema -> m Schema
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
& ASetter Schema Schema (Maybe OpenApiType) (Maybe OpenApiType)
-> Maybe OpenApiType -> Schema -> Schema
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Schema Schema (Maybe OpenApiType) (Maybe OpenApiType)
forall s a. HasType s a => Lens' s a
Lens' Schema (Maybe OpenApiType)
type_ (OpenApiType -> Maybe OpenApiType
forall a. a -> Maybe a
Just OpenApiType
OpenApiObject)
Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& ASetter
Schema
Schema
(Maybe AdditionalProperties)
(Maybe AdditionalProperties)
-> Maybe AdditionalProperties -> Schema -> Schema
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
Schema
Schema
(Maybe AdditionalProperties)
(Maybe AdditionalProperties)
forall s a. HasAdditionalProperties s a => Lens' s a
Lens' Schema (Maybe AdditionalProperties)
additionalProperties (AdditionalProperties -> Maybe AdditionalProperties
forall a. a -> Maybe a
Just (Bool -> AdditionalProperties
AdditionalPropertiesAllowed Bool
False))
instance
( Schemaable ('JsonObject more)
, Refable spec
, KnownSymbol key
)
=>
Schemaable ('JsonObject ( Optional key spec : more ))
where
schemaable :: forall (m :: * -> *).
MonadDeclare (Definitions Schema) m =>
Proxy ('JsonObject ('Optional key spec : more)) -> m Schema
schemaable Proxy ('JsonObject ('Optional key spec : more))
Proxy = do
Referenced Schema
propertySchema <- Proxy spec -> m (Referenced Schema)
forall (spec :: Specification) (m :: * -> *).
(Refable spec, MonadDeclare (Definitions Schema) m) =>
Proxy spec -> m (Referenced Schema)
forall (m :: * -> *).
MonadDeclare (Definitions Schema) m =>
Proxy spec -> m (Referenced Schema)
refable (forall {k} (t :: k). Proxy t
forall (t :: Specification). Proxy t
Proxy @spec)
Schema
more <- Proxy ('JsonObject more) -> m Schema
forall (spec :: Specification) (m :: * -> *).
(Schemaable spec, MonadDeclare (Definitions Schema) m) =>
Proxy spec -> m Schema
forall (m :: * -> *).
MonadDeclare (Definitions Schema) m =>
Proxy ('JsonObject more) -> m Schema
schemaable (forall {k} (t :: k). Proxy t
forall (t :: Specification). Proxy t
Proxy @('JsonObject more))
Schema -> m Schema
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Schema -> m Schema) -> Schema -> m Schema
forall a b. (a -> b) -> a -> b
$
Schema
more
Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& ASetter
Schema
Schema
(InsOrdHashMap Text (Referenced Schema))
(InsOrdHashMap Text (Referenced 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
over
ASetter
Schema
Schema
(InsOrdHashMap Text (Referenced Schema))
(InsOrdHashMap Text (Referenced Schema))
forall s a. HasProperties s a => Lens' s a
Lens' Schema (InsOrdHashMap Text (Referenced Schema))
properties
(ASetter
(InsOrdHashMap Text (Referenced Schema))
(InsOrdHashMap Text (Referenced Schema))
(Maybe (IxValue (InsOrdHashMap Text (Referenced Schema))))
(Maybe (Referenced Schema))
-> Maybe (Referenced Schema)
-> InsOrdHashMap Text (Referenced Schema)
-> InsOrdHashMap Text (Referenced Schema)
forall s t a b. ASetter s t a b -> b -> s -> t
set (Index (InsOrdHashMap Text (Referenced Schema))
-> Lens'
(InsOrdHashMap Text (Referenced Schema))
(Maybe (IxValue (InsOrdHashMap Text (Referenced Schema))))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at (forall (a :: Symbol) b. (IsString b, KnownSymbol a) => b
sym @key)) (Referenced Schema -> Maybe (Referenced Schema)
forall a. a -> Maybe a
Just Referenced Schema
propertySchema))
instance
( Schemaable ('JsonObject more)
, Refable spec
, KnownSymbol key
)
=>
Schemaable (JsonObject ( Required key spec : more ))
where
schemaable :: forall (m :: * -> *).
MonadDeclare (Definitions Schema) m =>
Proxy ('JsonObject ('Required key spec : more)) -> m Schema
schemaable Proxy ('JsonObject ('Required key spec : more))
Proxy = do
Schema
schema <- Proxy ('JsonObject ('Optional key spec : more)) -> m Schema
forall (spec :: Specification) (m :: * -> *).
(Schemaable spec, MonadDeclare (Definitions Schema) m) =>
Proxy spec -> m Schema
forall (m :: * -> *).
MonadDeclare (Definitions Schema) m =>
Proxy ('JsonObject ('Optional key spec : more)) -> m Schema
schemaable (forall {k} (t :: k). Proxy t
forall (t :: Specification). Proxy t
Proxy @(JsonObject ( Optional key spec : more )))
Schema -> m Schema
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Schema -> m Schema) -> Schema -> m Schema
forall a b. (a -> b) -> a -> b
$
Schema
schema
Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& ASetter Schema Schema [Text] [Text]
-> ([Text] -> [Text]) -> Schema -> Schema
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter Schema Schema [Text] [Text]
forall s a. HasRequired s a => Lens' s a
Lens' Schema [Text]
required (forall (a :: Symbol) b. (IsString b, KnownSymbol a) => b
sym @keyText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:)
instance (Schemaable spec) => Schemaable ('JsonArray spec) where
schemaable :: forall (m :: * -> *).
MonadDeclare (Definitions Schema) m =>
Proxy ('JsonArray spec) -> m Schema
schemaable Proxy ('JsonArray spec)
Proxy = do
Schema
elementSchema <- Proxy spec -> m Schema
forall (spec :: Specification) (m :: * -> *).
(Schemaable spec, MonadDeclare (Definitions Schema) m) =>
Proxy spec -> m Schema
forall (m :: * -> *).
MonadDeclare (Definitions Schema) m =>
Proxy spec -> m Schema
schemaable (forall {k} (t :: k). Proxy t
forall (t :: Specification). Proxy t
Proxy @spec)
Schema -> m Schema
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Schema -> m Schema) -> Schema -> m Schema
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
& ASetter Schema Schema (Maybe OpenApiType) (Maybe OpenApiType)
-> Maybe OpenApiType -> Schema -> Schema
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Schema Schema (Maybe OpenApiType) (Maybe OpenApiType)
forall s a. HasType s a => Lens' s a
Lens' Schema (Maybe OpenApiType)
type_ (OpenApiType -> Maybe OpenApiType
forall a. a -> Maybe a
Just OpenApiType
OpenApiArray)
Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& ASetter Schema Schema (Maybe OpenApiItems) (Maybe OpenApiItems)
-> Maybe OpenApiItems -> Schema -> Schema
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Schema Schema (Maybe OpenApiItems) (Maybe OpenApiItems)
forall s a. HasItems s a => Lens' s a
Lens' Schema (Maybe OpenApiItems)
items (OpenApiItems -> Maybe OpenApiItems
forall a. a -> Maybe a
Just (Referenced Schema -> OpenApiItems
OpenApiItemsObject (Schema -> Referenced Schema
forall a. a -> Referenced a
Inline Schema
elementSchema)))
instance Schemaable 'JsonBool where
schemaable :: forall (m :: * -> *).
MonadDeclare (Definitions Schema) m =>
Proxy 'JsonBool -> m Schema
schemaable Proxy 'JsonBool
Proxy =
Schema -> m Schema
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Schema -> m Schema) -> Schema -> m Schema
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
& ASetter Schema Schema (Maybe OpenApiType) (Maybe OpenApiType)
-> Maybe OpenApiType -> Schema -> Schema
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Schema Schema (Maybe OpenApiType) (Maybe OpenApiType)
forall s a. HasType s a => Lens' s a
Lens' Schema (Maybe OpenApiType)
type_ (OpenApiType -> Maybe OpenApiType
forall a. a -> Maybe a
Just OpenApiType
OpenApiBoolean)
instance Schemaable 'JsonDateTime where
schemaable :: forall (m :: * -> *).
MonadDeclare (Definitions Schema) m =>
Proxy 'JsonDateTime -> m Schema
schemaable Proxy 'JsonDateTime
Proxy =
Schema -> m Schema
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Schema -> m Schema) -> Schema -> m Schema
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
& ASetter Schema Schema (Maybe OpenApiType) (Maybe OpenApiType)
-> Maybe OpenApiType -> Schema -> Schema
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Schema Schema (Maybe OpenApiType) (Maybe OpenApiType)
forall s a. HasType s a => Lens' s a
Lens' Schema (Maybe OpenApiType)
type_ (OpenApiType -> Maybe OpenApiType
forall a. a -> Maybe a
Just OpenApiType
OpenApiString)
Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& ASetter Schema Schema (Maybe Text) (Maybe Text)
-> Maybe Text -> Schema -> Schema
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Schema Schema (Maybe Text) (Maybe Text)
forall s a. HasFormat s a => Lens' s a
Lens' Schema (Maybe Text)
format (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"date-time")
instance
Unsatisfiable (
T "`JsonRef \"" :<>: T target :<>: T "\"` is not defined.\n"
:$$: T "You are trying to use a JsonRef as the \"top level\" "
:$$: T "schema. We try to satisfy this request by looking up "
:$$: T "the reference and inlining it. However in this case you "
:$$: T "are trying to reference a schema which is not defined, "
:$$: T "so this won't work.\n"
)
=>
Schemaable (JsonLet '[] (JsonRef target))
where
schemaable :: forall (m :: * -> *).
MonadDeclare (Definitions Schema) m =>
Proxy ('JsonLet '[] ('JsonRef target)) -> m Schema
schemaable = Proxy ('JsonLet '[] ('JsonRef target)) -> m Schema
forall (msg :: ErrorMessage) a. Unsatisfiable msg => a
unsatisfiable
instance
{-# overlaps #-}
( KnownSymbol target
, Schemaable def
, Schemaable (JsonLet more def)
)
=>
Schemaable (JsonLet ( '(target, def) ': more) (JsonRef target))
where
schemaable :: forall (m :: * -> *).
MonadDeclare (Definitions Schema) m =>
Proxy ('JsonLet ('(target, def) : more) ('JsonRef target))
-> m Schema
schemaable Proxy ('JsonLet ('(target, def) : more) ('JsonRef target))
Proxy = do
Schema
defSchema <- Proxy def -> m Schema
forall (spec :: Specification) (m :: * -> *).
(Schemaable spec, MonadDeclare (Definitions Schema) m) =>
Proxy spec -> m Schema
forall (m :: * -> *).
MonadDeclare (Definitions Schema) m =>
Proxy def -> m Schema
schemaable (forall {k} (t :: k). Proxy t
forall (t :: Specification). Proxy t
Proxy @def)
Definitions Schema -> m ()
forall d (m :: * -> *). MonadDeclare d m => d -> m ()
declare (Text -> Schema -> Definitions Schema
forall k v. Hashable k => k -> v -> InsOrdHashMap k v
HMI.singleton (forall (a :: Symbol) b. (IsString b, KnownSymbol a) => b
sym @target) Schema
defSchema)
Proxy ('JsonLet more def) -> m Schema
forall (spec :: Specification) (m :: * -> *).
(Schemaable spec, MonadDeclare (Definitions Schema) m) =>
Proxy spec -> m Schema
forall (m :: * -> *).
MonadDeclare (Definitions Schema) m =>
Proxy ('JsonLet more def) -> m Schema
schemaable (forall {k} (t :: k). Proxy t
forall (t :: Specification). Proxy t
Proxy @(JsonLet more def))
instance
{-# overlaps #-}
( KnownSymbol name
, Schemaable def
, Schemaable (JsonLet more (JsonRef target))
)
=>
Schemaable (JsonLet ( '(name, def) ': more) (JsonRef target))
where
schemaable :: forall (m :: * -> *).
MonadDeclare (Definitions Schema) m =>
Proxy ('JsonLet ('(name, def) : more) ('JsonRef target))
-> m Schema
schemaable Proxy ('JsonLet ('(name, def) : more) ('JsonRef target))
Proxy = do
Schema
defSchema <- Proxy def -> m Schema
forall (spec :: Specification) (m :: * -> *).
(Schemaable spec, MonadDeclare (Definitions Schema) m) =>
Proxy spec -> m Schema
forall (m :: * -> *).
MonadDeclare (Definitions Schema) m =>
Proxy def -> m Schema
schemaable (forall {k} (t :: k). Proxy t
forall (t :: Specification). Proxy t
Proxy @def)
Definitions Schema -> m ()
forall d (m :: * -> *). MonadDeclare d m => d -> m ()
declare (Text -> Schema -> Definitions Schema
forall k v. Hashable k => k -> v -> InsOrdHashMap k v
HMI.singleton (forall (a :: Symbol) b. (IsString b, KnownSymbol a) => b
sym @name) Schema
defSchema)
Proxy ('JsonLet more ('JsonRef target)) -> m Schema
forall (spec :: Specification) (m :: * -> *).
(Schemaable spec, MonadDeclare (Definitions Schema) m) =>
Proxy spec -> m Schema
forall (m :: * -> *).
MonadDeclare (Definitions Schema) m =>
Proxy ('JsonLet more ('JsonRef target)) -> m Schema
schemaable (forall {k} (t :: k). Proxy t
forall (t :: Specification). Proxy t
Proxy @(JsonLet more (JsonRef target)))
instance
{-# overlaps #-}
( Defs defs
, Schemaable spec
)
=>
Schemaable (JsonLet defs spec)
where
schemaable :: forall (m :: * -> *).
MonadDeclare (Definitions Schema) m =>
Proxy ('JsonLet defs spec) -> m Schema
schemaable Proxy ('JsonLet defs spec)
Proxy = do
Proxy defs -> m ()
forall (defs :: [(Symbol, Specification)]) (m :: * -> *).
(Defs defs, MonadDeclare (Definitions Schema) m) =>
Proxy defs -> m ()
forall (m :: * -> *).
MonadDeclare (Definitions Schema) m =>
Proxy defs -> m ()
mkDefs (forall (t :: [(Symbol, Specification)]). Proxy t
forall {k} (t :: k). Proxy t
Proxy @defs)
Proxy spec -> m Schema
forall (spec :: Specification) (m :: * -> *).
(Schemaable spec, MonadDeclare (Definitions Schema) m) =>
Proxy spec -> m Schema
forall (m :: * -> *).
MonadDeclare (Definitions Schema) m =>
Proxy spec -> m Schema
schemaable (forall {k} (t :: k). Proxy t
forall (t :: Specification). Proxy t
Proxy @spec)
instance (Schemaable spec) => Schemaable (JsonNullable spec) where
schemaable :: forall (m :: * -> *).
MonadDeclare (Definitions Schema) m =>
Proxy ('JsonNullable spec) -> m Schema
schemaable Proxy ('JsonNullable spec)
Proxy = do
Schema
schema <- Proxy spec -> m Schema
forall (spec :: Specification) (m :: * -> *).
(Schemaable spec, MonadDeclare (Definitions Schema) m) =>
Proxy spec -> m Schema
forall (m :: * -> *).
MonadDeclare (Definitions Schema) m =>
Proxy spec -> m Schema
schemaable (forall {k} (t :: k). Proxy t
forall (t :: Specification). Proxy t
Proxy @spec)
Schema -> m Schema
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Schema -> m Schema) -> Schema -> m Schema
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
& ASetter
Schema
Schema
(Maybe [Referenced Schema])
(Maybe [Referenced Schema])
-> Maybe [Referenced Schema] -> Schema -> Schema
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
Schema
Schema
(Maybe [Referenced Schema])
(Maybe [Referenced Schema])
forall s a. HasOneOf s a => Lens' s a
Lens' Schema (Maybe [Referenced Schema])
oneOf ([Referenced Schema] -> Maybe [Referenced Schema]
forall a. a -> Maybe a
Just
[ Schema -> Referenced Schema
forall a. a -> Referenced a
Inline (Schema
forall a. Monoid a => a
mempty Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& ASetter Schema Schema (Maybe OpenApiType) (Maybe OpenApiType)
-> Maybe OpenApiType -> Schema -> Schema
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Schema Schema (Maybe OpenApiType) (Maybe OpenApiType)
forall s a. HasType s a => Lens' s a
Lens' Schema (Maybe OpenApiType)
type_ (OpenApiType -> Maybe OpenApiType
forall a. a -> Maybe a
Just OpenApiType
OpenApiNull))
, Schema -> Referenced Schema
forall a. a -> Referenced a
Inline Schema
schema
]
)
class Defs (defs :: [(Symbol, Specification)]) where
mkDefs
:: (MonadDeclare (Definitions Schema) m)
=> Proxy defs
-> m ()
instance Defs '[] where
mkDefs :: forall (m :: * -> *).
MonadDeclare (Definitions Schema) m =>
Proxy '[] -> m ()
mkDefs Proxy '[]
Proxy = () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
instance
( Defs more
, Schemaable spec
, KnownSymbol name
)
=>
Defs ( '(name, spec) ': more)
where
mkDefs :: forall (m :: * -> *).
MonadDeclare (Definitions Schema) m =>
Proxy ('(name, spec) : more) -> m ()
mkDefs Proxy ('(name, spec) : more)
Proxy = do
Schema
schema <- Proxy spec -> m Schema
forall (spec :: Specification) (m :: * -> *).
(Schemaable spec, MonadDeclare (Definitions Schema) m) =>
Proxy spec -> m Schema
forall (m :: * -> *).
MonadDeclare (Definitions Schema) m =>
Proxy spec -> m Schema
schemaable (forall {k} (t :: k). Proxy t
forall (t :: Specification). Proxy t
Proxy @spec)
Definitions Schema -> m ()
forall d (m :: * -> *). MonadDeclare d m => d -> m ()
declare (Text -> Schema -> Definitions Schema
forall k v. Hashable k => k -> v -> InsOrdHashMap k v
HMI.singleton (forall (a :: Symbol) b. (IsString b, KnownSymbol a) => b
sym @name) Schema
schema)
Proxy more -> m ()
forall (defs :: [(Symbol, Specification)]) (m :: * -> *).
(Defs defs, MonadDeclare (Definitions Schema) m) =>
Proxy defs -> m ()
forall (m :: * -> *).
MonadDeclare (Definitions Schema) m =>
Proxy more -> m ()
mkDefs (forall (t :: [(Symbol, Specification)]). Proxy t
forall {k} (t :: k). Proxy t
Proxy @more)
newtype EncodingSchema a =
EncodingSchema {forall a. EncodingSchema a -> a
unEncodingSchema :: a}
instance
( Schemaable (EncodingSpec a)
, Typeable a
)
=>
ToSchema (EncodingSchema a)
where
declareNamedSchema :: Proxy (EncodingSchema a)
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy (EncodingSchema a)
_ = do
let (Definitions Schema
declarations, Schema
schema) = Proxy (EncodingSpec a) -> (Definitions Schema, Schema)
forall (spec :: Specification).
Schemaable spec =>
Proxy spec -> (Definitions Schema, Schema)
toOpenApiSchema (forall {k} (t :: k). Proxy t
forall (t :: Specification). Proxy t
Proxy @(EncodingSpec a))
Definitions Schema -> DeclareT (Definitions Schema) Identity ()
forall d (m :: * -> *). MonadDeclare d m => d -> m ()
declare Definitions Schema
declarations
NamedSchema -> Declare (Definitions Schema) NamedSchema
forall a. a -> DeclareT (Definitions Schema) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text -> Schema -> NamedSchema
NamedSchema Maybe Text
forall a. Maybe a
Nothing Schema
schema)
newtype DecodingSchema a =
DecodingSchema {forall a. DecodingSchema a -> a
unDecodingSchema :: a}
instance
( Schemaable (DecodingSpec a)
, Typeable a
)
=>
ToSchema (DecodingSchema a)
where
declareNamedSchema :: Proxy (DecodingSchema a)
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy (DecodingSchema a)
_ = do
let (Definitions Schema
declarations, Schema
schema) = Proxy (DecodingSpec a) -> (Definitions Schema, Schema)
forall (spec :: Specification).
Schemaable spec =>
Proxy spec -> (Definitions Schema, Schema)
toOpenApiSchema (forall {k} (t :: k). Proxy t
forall (t :: Specification). Proxy t
Proxy @(DecodingSpec a))
Definitions Schema -> DeclareT (Definitions Schema) Identity ()
forall d (m :: * -> *). MonadDeclare d m => d -> m ()
declare Definitions Schema
declarations
NamedSchema -> Declare (Definitions Schema) NamedSchema
forall a. a -> DeclareT (Definitions Schema) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text -> Schema -> NamedSchema
NamedSchema Maybe Text
forall a. Maybe a
Nothing Schema
schema)
sym
:: forall a b.
( IsString b
, KnownSymbol a
)
=> b
sym :: forall (a :: Symbol) b. (IsString b, KnownSymbol a) => b
sym = String -> b
forall a. IsString a => String -> a
fromString (String -> b) -> String -> b
forall a b. (a -> b) -> a -> b
$ Proxy a -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @a)
ref :: Text -> Referenced a
ref :: forall a. Text -> Referenced a
ref = Reference -> Referenced a
forall a. Reference -> Referenced a
Ref (Reference -> Referenced a)
-> (Text -> Reference) -> Text -> Referenced a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Reference
Reference
type T (msg :: Symbol) = TE.Text msg