Safe Haskell | None |
---|---|
Language | Haskell2010 |
Data.OpenApi.Internal.ParamSchema
Synopsis
- binarySchema :: Schema
- byteSchema :: Schema
- passwordSchema :: Schema
- class ToParamSchema a where
- toParamSchema :: Proxy a -> Schema
- toParamSchemaBoundedIntegral :: forall {k} a (t :: k). (Bounded a, Integral a) => Proxy a -> Schema
- timeParamSchema :: String -> Schema
- type family ToParamSchemaByteStringError bs :: k where ...
- genericToParamSchema :: forall {k} a (t :: k). (Generic a, GToParamSchema (Rep a)) => SchemaOptions -> Proxy a -> Schema
- class GToParamSchema (f :: Type -> Type) where
- gtoParamSchema :: SchemaOptions -> Proxy f -> Schema -> Schema
- class GEnumParamSchema (f :: Type -> Type) where
- genumParamSchema :: SchemaOptions -> Proxy f -> Schema -> Schema
- data Proxy3 (a :: k) (b :: k1) (c :: k2) = Proxy3
Documentation
binarySchema :: Schema Source #
Default schema for binary data (any sequence of octets).
byteSchema :: Schema Source #
Default schema for binary data (base64 encoded).
passwordSchema :: Schema Source #
Default schema for password string.
"password"
format is used to hint UIs the input needs to be obscured.
class ToParamSchema a where Source #
Convert a type into a plain
.Schema
In previous versions of the package there was a separate type called ParamSchema
, which was
included in a greater Schema
. Now this is a single class, but distinction for schema generators
for "simple" types is preserved.
ToParamSchema
is suited only for primitive-like types without nested fields and such.
An example type and instance:
{-# LANGUAGE OverloadedStrings #-} -- allows to write Text
literals
import Control.Lens
data Direction = Up | Down
instance ToParamSchema Direction where
toParamSchema _ = mempty
& type_ ?~ OpenApiString
& enum_ ?~ [ "Up", "Down" ]
Instead of manually writing your
instance you can
use a default generic implementation of ToParamSchema
.toParamSchema
To do that, simply add deriving
clause to your datatype
and declare a Generic
instance for your datatype without
giving definition for ToParamSchema
.toParamSchema
For instance, the previous example can be simplified into this:
{-# LANGUAGE DeriveGeneric #-} import GHC.Generics (Generic) data Direction = Up | Down deriving Generic instance ToParamSchema Direction
Minimal complete definition
Nothing
Methods
toParamSchema :: Proxy a -> Schema Source #
Convert a type into a plain parameter schema.
>>>
BSL.putStrLn $ encodePretty $ toParamSchema (Proxy :: Proxy Integer)
{ "type": "integer" }
default toParamSchema :: (Generic a, GToParamSchema (Rep a)) => Proxy a -> Schema Source #
Instances
toParamSchemaBoundedIntegral :: forall {k} a (t :: k). (Bounded a, Integral a) => Proxy a -> Schema Source #
timeParamSchema :: String -> Schema Source #
type family ToParamSchemaByteStringError bs :: k where ... Source #
Equations
ToParamSchemaByteStringError bs = TypeError (((('Text "Impossible to have an instance " ':<>: 'ShowType (ToParamSchema bs)) ':<>: 'Text ".") ':$$: (('Text "Please, use a newtype wrapper around " ':<>: 'ShowType bs) ':<>: 'Text " instead.")) ':$$: 'Text "Consider using byteParamSchema or binaryParamSchemaemplates.") :: k |
genericToParamSchema :: forall {k} a (t :: k). (Generic a, GToParamSchema (Rep a)) => SchemaOptions -> Proxy a -> Schema Source #
A configurable generic
creator.Schema
>>>
:set -XDeriveGeneric
>>>
data Color = Red | Blue deriving Generic
>>>
BSL.putStrLn $ encodePretty $ genericToParamSchema defaultSchemaOptions (Proxy :: Proxy Color)
{ "enum": [ "Red", "Blue" ], "type": "string" }
class GToParamSchema (f :: Type -> Type) where Source #
Methods
gtoParamSchema :: SchemaOptions -> Proxy f -> Schema -> Schema Source #
Instances
(GEnumParamSchema f, GEnumParamSchema g) => GToParamSchema (f :+: g) Source # | |
Defined in Data.OpenApi.Internal.ParamSchema Methods gtoParamSchema :: SchemaOptions -> Proxy (f :+: g) -> Schema -> Schema Source # | |
GToParamSchema f => GToParamSchema (C1 c (S1 s f)) Source # | |
Defined in Data.OpenApi.Internal.ParamSchema Methods gtoParamSchema :: SchemaOptions -> Proxy (C1 c (S1 s f)) -> Schema -> Schema Source # | |
Constructor c => GToParamSchema (C1 c (U1 :: Type -> Type)) Source # | |
Defined in Data.OpenApi.Internal.ParamSchema | |
GToParamSchema f => GToParamSchema (D1 d f) Source # | |
Defined in Data.OpenApi.Internal.ParamSchema Methods gtoParamSchema :: SchemaOptions -> Proxy (D1 d f) -> Schema -> Schema Source # | |
ToParamSchema c => GToParamSchema (K1 i c :: Type -> Type) Source # | |
Defined in Data.OpenApi.Internal.ParamSchema Methods gtoParamSchema :: SchemaOptions -> Proxy (K1 i c :: Type -> Type) -> Schema -> Schema Source # |
class GEnumParamSchema (f :: Type -> Type) where Source #
Methods
genumParamSchema :: SchemaOptions -> Proxy f -> Schema -> Schema Source #
Instances
(GEnumParamSchema f, GEnumParamSchema g) => GEnumParamSchema (f :+: g) Source # | |
Defined in Data.OpenApi.Internal.ParamSchema Methods genumParamSchema :: SchemaOptions -> Proxy (f :+: g) -> Schema -> Schema Source # | |
Constructor c => GEnumParamSchema (C1 c (U1 :: Type -> Type)) Source # | |
Defined in Data.OpenApi.Internal.ParamSchema |
>>>
import Data.Aeson (encode)
>>>
import Data.OpenApi.Internal.Utils