git.iko.soy/typeable/swagger2
on master help sign in
Merge pull request #180 from fieldstrength/monomorphic-proxy
29f720fOleg Grenrus
src/Data/Swagger/Internal/AesonUtils.hs+2−2
@@ -67,10 +67,10 @@ mkSwaggerAesonOptions pfx = SwaggerAesonOptions pfx [] Nothing
67makeLenses ''SwaggerAesonOptions
67makeLenses ''SwaggerAesonOptions
68
68
69class (Generic a, All2 AesonDefaultValue (Code a)) => HasSwaggerAesonOptions a where
69class (Generic a, All2 AesonDefaultValue (Code a)) => HasSwaggerAesonOptions a where
70− swaggerAesonOptions :: proxy a -> SwaggerAesonOptions
70+ swaggerAesonOptions :: Proxy a -> SwaggerAesonOptions
71
71
72 -- So far we use only default definitions
72 -- So far we use only default definitions
73− aesonDefaults :: proxy a -> POP Maybe (Code a)
73+ aesonDefaults :: Proxy a -> POP Maybe (Code a)
74 aesonDefaults _ = hcpure (Proxy :: Proxy AesonDefaultValue) defaultValue
74 aesonDefaults _ = hcpure (Proxy :: Proxy AesonDefaultValue) defaultValue
75
75
76-------------------------------------------------------------------------------
76-------------------------------------------------------------------------------
src/Data/Swagger/Internal/ParamSchema.hs+6−6
@@ -115,8 +115,8 @@ class ToParamSchema a where
115 --
115 --
116 -- >>> encode $ toParamSchema (Proxy :: Proxy Integer)
116 -- >>> encode $ toParamSchema (Proxy :: Proxy Integer)
117 -- "{\"type\":\"integer\"}"
117 -- "{\"type\":\"integer\"}"
118− toParamSchema :: proxy a -> ParamSchema t
118+ toParamSchema :: Proxy a -> ParamSchema t
119− default toParamSchema :: (Generic a, GToParamSchema (Rep a)) => proxy a -> ParamSchema t
119+ default toParamSchema :: (Generic a, GToParamSchema (Rep a)) => Proxy a -> ParamSchema t
120 toParamSchema = genericToParamSchema defaultSchemaOptions
120 toParamSchema = genericToParamSchema defaultSchemaOptions
121
121
122instance OVERLAPPING_ ToParamSchema String where
122instance OVERLAPPING_ ToParamSchema String where
@@ -154,7 +154,7 @@ instance ToParamSchema Word64 where toParamSchema = toParamSchemaBoundedIntegral
154--
154--
155-- >>> encode $ toParamSchemaBoundedIntegral (Proxy :: Proxy Int8)
155-- >>> encode $ toParamSchemaBoundedIntegral (Proxy :: Proxy Int8)
156-- "{\"maximum\":127,\"minimum\":-128,\"type\":\"integer\"}"
156-- "{\"maximum\":127,\"minimum\":-128,\"type\":\"integer\"}"
157−toParamSchemaBoundedIntegral :: forall proxy a t. (Bounded a, Integral a) => proxy a -> ParamSchema t
157+toParamSchemaBoundedIntegral :: forall a t. (Bounded a, Integral a) => Proxy a -> ParamSchema t
158toParamSchemaBoundedIntegral _ = mempty
158toParamSchemaBoundedIntegral _ = mempty
159 & type_ .~ SwaggerInteger
159 & type_ .~ SwaggerInteger
160 & minimum_ ?~ fromInteger (toInteger (minBound :: a))
160 & minimum_ ?~ fromInteger (toInteger (minBound :: a))
@@ -288,11 +288,11 @@ instance ToParamSchema UUID where
288-- >>> data Color = Red | Blue deriving Generic
288-- >>> data Color = Red | Blue deriving Generic
289-- >>> encode $ genericToParamSchema defaultSchemaOptions (Proxy :: Proxy Color)
289-- >>> encode $ genericToParamSchema defaultSchemaOptions (Proxy :: Proxy Color)
290-- "{\"type\":\"string\",\"enum\":[\"Red\",\"Blue\"]}"
290-- "{\"type\":\"string\",\"enum\":[\"Red\",\"Blue\"]}"
291−genericToParamSchema :: forall proxy a t. (Generic a, GToParamSchema (Rep a)) => SchemaOptions -> proxy a -> ParamSchema t
291+genericToParamSchema :: forall a t. (Generic a, GToParamSchema (Rep a)) => SchemaOptions -> Proxy a -> ParamSchema t
292genericToParamSchema opts _ = gtoParamSchema opts (Proxy :: Proxy (Rep a)) mempty
292genericToParamSchema opts _ = gtoParamSchema opts (Proxy :: Proxy (Rep a)) mempty
293
293
294class GToParamSchema (f :: * -> *) where
294class GToParamSchema (f :: * -> *) where
295− gtoParamSchema :: SchemaOptions -> proxy f -> ParamSchema t -> ParamSchema t
295+ gtoParamSchema :: SchemaOptions -> Proxy f -> ParamSchema t -> ParamSchema t
296
296
297instance GToParamSchema f => GToParamSchema (D1 d f) where
297instance GToParamSchema f => GToParamSchema (D1 d f) where
298 gtoParamSchema opts _ = gtoParamSchema opts (Proxy :: Proxy f)
298 gtoParamSchema opts _ = gtoParamSchema opts (Proxy :: Proxy f)
@@ -310,7 +310,7 @@ instance (GEnumParamSchema f, GEnumParamSchema g) => GToParamSchema (f :+: g) wh
310 gtoParamSchema opts _ = genumParamSchema opts (Proxy :: Proxy (f :+: g))
310 gtoParamSchema opts _ = genumParamSchema opts (Proxy :: Proxy (f :+: g))
311
311
312class GEnumParamSchema (f :: * -> *) where
312class GEnumParamSchema (f :: * -> *) where
313− genumParamSchema :: SchemaOptions -> proxy f -> ParamSchema t -> ParamSchema t
313+ genumParamSchema :: SchemaOptions -> Proxy f -> ParamSchema t -> ParamSchema t
314
314
315instance (GEnumParamSchema f, GEnumParamSchema g) => GEnumParamSchema (f :+: g) where
315instance (GEnumParamSchema f, GEnumParamSchema g) => GEnumParamSchema (f :+: g) where
316 genumParamSchema opts _ = genumParamSchema opts (Proxy :: Proxy f) . genumParamSchema opts (Proxy :: Proxy g)
316 genumParamSchema opts _ = genumParamSchema opts (Proxy :: Proxy f) . genumParamSchema opts (Proxy :: Proxy g)
src/Data/Swagger/Internal/Schema.hs+41−42
@@ -142,13 +142,13 @@ class ToSchema a where
142 -- together with all used definitions.
142 -- together with all used definitions.
143 -- Note that the schema itself is included in definitions
143 -- Note that the schema itself is included in definitions
144 -- only if it is recursive (and thus needs its definition in scope).
144 -- only if it is recursive (and thus needs its definition in scope).
145− declareNamedSchema :: proxy a -> Declare (Definitions Schema) NamedSchema
145+ declareNamedSchema :: Proxy a -> Declare (Definitions Schema) NamedSchema
146 default declareNamedSchema :: (Generic a, GToSchema (Rep a), TypeHasSimpleShape a "genericDeclareNamedSchemaUnrestricted") =>
146 default declareNamedSchema :: (Generic a, GToSchema (Rep a), TypeHasSimpleShape a "genericDeclareNamedSchemaUnrestricted") =>
147− proxy a -> Declare (Definitions Schema) NamedSchema
147+ Proxy a -> Declare (Definitions Schema) NamedSchema
148 declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions
148 declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions
149
149
150-- | Convert a type into a schema and declare all used schema definitions.
150-- | Convert a type into a schema and declare all used schema definitions.
151−declareSchema :: ToSchema a => proxy a -> Declare (Definitions Schema) Schema
151+declareSchema :: ToSchema a => Proxy a -> Declare (Definitions Schema) Schema
152declareSchema = fmap _namedSchemaSchema . declareNamedSchema
152declareSchema = fmap _namedSchemaSchema . declareNamedSchema
153
153
154-- | Convert a type into an optionally named schema.
154-- | Convert a type into an optionally named schema.
@@ -162,7 +162,7 @@ declareSchema = fmap _namedSchemaSchema . declareNamedSchema
162-- Just "Day"
162-- Just "Day"
163-- >>> encode (toNamedSchema (Proxy :: Proxy Day) ^. schema)
163-- >>> encode (toNamedSchema (Proxy :: Proxy Day) ^. schema)
164-- "{\"example\":\"2016-07-22\",\"format\":\"date\",\"type\":\"string\"}"
164-- "{\"example\":\"2016-07-22\",\"format\":\"date\",\"type\":\"string\"}"
165−toNamedSchema :: ToSchema a => proxy a -> NamedSchema
165+toNamedSchema :: ToSchema a => Proxy a -> NamedSchema
166toNamedSchema = undeclare . declareNamedSchema
166toNamedSchema = undeclare . declareNamedSchema
167
167
168-- | Get type's schema name according to its @'ToSchema'@ instance.
168-- | Get type's schema name according to its @'ToSchema'@ instance.
@@ -172,7 +172,7 @@ toNamedSchema = undeclare . declareNamedSchema
172--
172--
173-- >>> schemaName (Proxy :: Proxy UTCTime)
173-- >>> schemaName (Proxy :: Proxy UTCTime)
174-- Just "UTCTime"
174-- Just "UTCTime"
175−schemaName :: ToSchema a => proxy a -> Maybe T.Text
175+schemaName :: ToSchema a => Proxy a -> Maybe T.Text
176schemaName = _namedSchemaName . toNamedSchema
176schemaName = _namedSchemaName . toNamedSchema
177
177
178-- | Convert a type into a schema.
178-- | Convert a type into a schema.
@@ -182,7 +182,7 @@ schemaName = _namedSchemaName . toNamedSchema
182--
182--
183-- >>> encode $ toSchema (Proxy :: Proxy [Day])
183-- >>> encode $ toSchema (Proxy :: Proxy [Day])
184-- "{\"items\":{\"$ref\":\"#/definitions/Day\"},\"type\":\"array\"}"
184-- "{\"items\":{\"$ref\":\"#/definitions/Day\"},\"type\":\"array\"}"
185−toSchema :: ToSchema a => proxy a -> Schema
185+toSchema :: ToSchema a => Proxy a -> Schema
186toSchema = _namedSchemaSchema . toNamedSchema
186toSchema = _namedSchemaSchema . toNamedSchema
187
187
188-- | Convert a type into a referenced schema if possible.
188-- | Convert a type into a referenced schema if possible.
@@ -193,7 +193,7 @@ toSchema = _namedSchemaSchema . toNamedSchema
193--
193--
194-- >>> encode $ toSchemaRef (Proxy :: Proxy Day)
194-- >>> encode $ toSchemaRef (Proxy :: Proxy Day)
195-- "{\"$ref\":\"#/definitions/Day\"}"
195-- "{\"$ref\":\"#/definitions/Day\"}"
196−toSchemaRef :: ToSchema a => proxy a -> Referenced Schema
196+toSchemaRef :: ToSchema a => Proxy a -> Referenced Schema
197toSchemaRef = undeclare . declareSchemaRef
197toSchemaRef = undeclare . declareSchemaRef
198
198
199-- | Convert a type into a referenced schema if possible
199-- | Convert a type into a referenced schema if possible
@@ -203,7 +203,7 @@ toSchemaRef = undeclare . declareSchemaRef
203-- Schema definitions are typically declared for every referenced schema.
203-- Schema definitions are typically declared for every referenced schema.
204-- If @'declareSchemaRef'@ returns a reference, a corresponding schema
204-- If @'declareSchemaRef'@ returns a reference, a corresponding schema
205-- will be declared (regardless of whether it is recusive or not).
205-- will be declared (regardless of whether it is recusive or not).
206−declareSchemaRef :: ToSchema a => proxy a -> Declare (Definitions Schema) (Referenced Schema)
206+declareSchemaRef :: ToSchema a => Proxy a -> Declare (Definitions Schema) (Referenced Schema)
207declareSchemaRef proxy = do
207declareSchemaRef proxy = do
208 case toNamedSchema proxy of
208 case toNamedSchema proxy of
209 NamedSchema (Just name) schema -> do
209 NamedSchema (Just name) schema -> do
@@ -265,7 +265,7 @@ inlineAllSchemas = inlineSchemasWhen (const True)
265--
265--
266-- __WARNING:__ @'toInlinedSchema'@ will produce infinite schema
266-- __WARNING:__ @'toInlinedSchema'@ will produce infinite schema
267-- when inlining recursive schemas.
267-- when inlining recursive schemas.
268−toInlinedSchema :: ToSchema a => proxy a -> Schema
268+toInlinedSchema :: ToSchema a => Proxy a -> Schema
269toInlinedSchema proxy = inlineAllSchemas defs schema
269toInlinedSchema proxy = inlineAllSchemas defs schema
270 where
270 where
271 (defs, schema) = runDeclare (declareSchema proxy) mempty
271 (defs, schema) = runDeclare (declareSchema proxy) mempty
@@ -410,7 +410,7 @@ sketchStrictSchema = go . toJSON
410 names = HashMap.keys o
410 names = HashMap.keys o
411
411
412class GToSchema (f :: * -> *) where
412class GToSchema (f :: * -> *) where
413− gdeclareNamedSchema :: SchemaOptions -> proxy f -> Schema -> Declare (Definitions Schema) NamedSchema
413+ gdeclareNamedSchema :: SchemaOptions -> Proxy f -> Schema -> Declare (Definitions Schema) NamedSchema
414
414
415instance OVERLAPPABLE_ ToSchema a => ToSchema [a] where
415instance OVERLAPPABLE_ ToSchema a => ToSchema [a] where
416 declareNamedSchema _ = do
416 declareNamedSchema _ = do
@@ -593,26 +593,26 @@ instance ToSchema a => ToSchema (Identity a) where declareNamedSchema _ = declar
593--
593--
594-- >>> encode $ toSchemaBoundedIntegral (Proxy :: Proxy Int16)
594-- >>> encode $ toSchemaBoundedIntegral (Proxy :: Proxy Int16)
595-- "{\"maximum\":32767,\"minimum\":-32768,\"type\":\"integer\"}"
595-- "{\"maximum\":32767,\"minimum\":-32768,\"type\":\"integer\"}"
596−toSchemaBoundedIntegral :: forall a proxy. (Bounded a, Integral a) => proxy a -> Schema
596+toSchemaBoundedIntegral :: forall a. (Bounded a, Integral a) => Proxy a -> Schema
597toSchemaBoundedIntegral _ = mempty
597toSchemaBoundedIntegral _ = mempty
598 & type_ .~ SwaggerInteger
598 & type_ .~ SwaggerInteger
599 & minimum_ ?~ fromInteger (toInteger (minBound :: a))
599 & minimum_ ?~ fromInteger (toInteger (minBound :: a))
600 & maximum_ ?~ fromInteger (toInteger (maxBound :: a))
600 & maximum_ ?~ fromInteger (toInteger (maxBound :: a))
601
601
602-- | Default generic named schema for @'Bounded'@, @'Integral'@ types.
602-- | Default generic named schema for @'Bounded'@, @'Integral'@ types.
603−genericToNamedSchemaBoundedIntegral :: forall a d f proxy.
603+genericToNamedSchemaBoundedIntegral :: forall a d f.
604 ( Bounded a, Integral a
604 ( Bounded a, Integral a
605 , Generic a, Rep a ~ D1 d f, Datatype d)
605 , Generic a, Rep a ~ D1 d f, Datatype d)
606− => SchemaOptions -> proxy a -> NamedSchema
606+ => SchemaOptions -> Proxy a -> NamedSchema
607genericToNamedSchemaBoundedIntegral opts proxy
607genericToNamedSchemaBoundedIntegral opts proxy
608 = genericNameSchema opts proxy (toSchemaBoundedIntegral proxy)
608 = genericNameSchema opts proxy (toSchemaBoundedIntegral proxy)
609
609
610-- | Declare a named schema for a @newtype@ wrapper.
610-- | Declare a named schema for a @newtype@ wrapper.
611−genericDeclareNamedSchemaNewtype :: forall proxy a d c s i inner.
611+genericDeclareNamedSchemaNewtype :: forall a d c s i inner.
612 (Generic a, Datatype d, Rep a ~ D1 d (C1 c (S1 s (K1 i inner))))
612 (Generic a, Datatype d, Rep a ~ D1 d (C1 c (S1 s (K1 i inner))))
613 => SchemaOptions -- ^ How to derive the name.
613 => SchemaOptions -- ^ How to derive the name.
614 -> (Proxy inner -> Declare (Definitions Schema) Schema) -- ^ How to create a schema for the wrapped type.
614 -> (Proxy inner -> Declare (Definitions Schema) Schema) -- ^ How to create a schema for the wrapped type.
615− -> proxy a
615+ -> Proxy a
616 -> Declare (Definitions Schema) NamedSchema
616 -> Declare (Definitions Schema) NamedSchema
617genericDeclareNamedSchemaNewtype opts f proxy = genericNameSchema opts proxy <$> f (Proxy :: Proxy inner)
617genericDeclareNamedSchemaNewtype opts f proxy = genericNameSchema opts proxy <$> f (Proxy :: Proxy inner)
618
618
@@ -629,9 +629,9 @@ genericDeclareNamedSchemaNewtype opts f proxy = genericNameSchema opts proxy <$>
629--
629--
630-- Note: this is only useful when @key@ is encoded with 'ToJSONKeyText'.
630-- Note: this is only useful when @key@ is encoded with 'ToJSONKeyText'.
631-- If it is encoded with 'ToJSONKeyValue' then a regular schema for @[(key, value)]@ is used.
631-- If it is encoded with 'ToJSONKeyValue' then a regular schema for @[(key, value)]@ is used.
632−declareSchemaBoundedEnumKeyMapping :: forall map key value proxy.
632+declareSchemaBoundedEnumKeyMapping :: forall map key value.
633 (Bounded key, Enum key, ToJSONKey key, ToSchema key, ToSchema value)
633 (Bounded key, Enum key, ToJSONKey key, ToSchema key, ToSchema value)
634− => proxy (map key value) -> Declare (Definitions Schema) Schema
634+ => Proxy (map key value) -> Declare (Definitions Schema) Schema
635declareSchemaBoundedEnumKeyMapping _ = case toJSONKey :: ToJSONKeyFunction key of
635declareSchemaBoundedEnumKeyMapping _ = case toJSONKey :: ToJSONKeyFunction key of
636 ToJSONKeyText keyToText _ -> objectSchema keyToText
636 ToJSONKeyText keyToText _ -> objectSchema keyToText
637 ToJSONKeyValue _ _ -> declareSchema (Proxy :: Proxy [(key, value)])
637 ToJSONKeyValue _ _ -> declareSchema (Proxy :: Proxy [(key, value)])
@@ -657,46 +657,46 @@ declareSchemaBoundedEnumKeyMapping _ = case toJSONKey :: ToJSONKeyFunction key o
657--
657--
658-- Note: this is only useful when @key@ is encoded with 'ToJSONKeyText'.
658-- Note: this is only useful when @key@ is encoded with 'ToJSONKeyText'.
659-- If it is encoded with 'ToJSONKeyValue' then a regular schema for @[(key, value)]@ is used.
659-- If it is encoded with 'ToJSONKeyValue' then a regular schema for @[(key, value)]@ is used.
660−toSchemaBoundedEnumKeyMapping :: forall map key value proxy.
660+toSchemaBoundedEnumKeyMapping :: forall map key value.
661 (Bounded key, Enum key, ToJSONKey key, ToSchema key, ToSchema value)
661 (Bounded key, Enum key, ToJSONKey key, ToSchema key, ToSchema value)
662− => proxy (map key value) -> Schema
662+ => Proxy (map key value) -> Schema
663toSchemaBoundedEnumKeyMapping = flip evalDeclare mempty . declareSchemaBoundedEnumKeyMapping
663toSchemaBoundedEnumKeyMapping = flip evalDeclare mempty . declareSchemaBoundedEnumKeyMapping
664
664
665-- | A configurable generic @'Schema'@ creator.
665-- | A configurable generic @'Schema'@ creator.
666genericDeclareSchema :: (Generic a, GToSchema (Rep a), TypeHasSimpleShape a "genericDeclareSchemaUnrestricted") =>
666genericDeclareSchema :: (Generic a, GToSchema (Rep a), TypeHasSimpleShape a "genericDeclareSchemaUnrestricted") =>
667− SchemaOptions -> proxy a -> Declare (Definitions Schema) Schema
667+ SchemaOptions -> Proxy a -> Declare (Definitions Schema) Schema
668genericDeclareSchema = genericDeclareSchemaUnrestricted
668genericDeclareSchema = genericDeclareSchemaUnrestricted
669
669
670-- | A configurable generic @'NamedSchema'@ creator.
670-- | A configurable generic @'NamedSchema'@ creator.
671-- This function applied to @'defaultSchemaOptions'@
671-- This function applied to @'defaultSchemaOptions'@
672-- is used as the default for @'declareNamedSchema'@
672-- is used as the default for @'declareNamedSchema'@
673-- when the type is an instance of @'Generic'@.
673-- when the type is an instance of @'Generic'@.
674−genericDeclareNamedSchema :: forall a proxy. (Generic a, GToSchema (Rep a), TypeHasSimpleShape a "genericDeclareNamedSchemaUnrestricted") =>
674+genericDeclareNamedSchema :: (Generic a, GToSchema (Rep a), TypeHasSimpleShape a "genericDeclareNamedSchemaUnrestricted") =>
675− SchemaOptions -> proxy a -> Declare (Definitions Schema) NamedSchema
675+ SchemaOptions -> Proxy a -> Declare (Definitions Schema) NamedSchema
676genericDeclareNamedSchema = genericDeclareNamedSchemaUnrestricted
676genericDeclareNamedSchema = genericDeclareNamedSchemaUnrestricted
677
677
678-- | A configurable generic @'Schema'@ creator.
678-- | A configurable generic @'Schema'@ creator.
679--
679--
680-- Unlike 'genericDeclareSchema' also works for mixed sum types.
680-- Unlike 'genericDeclareSchema' also works for mixed sum types.
681-- Use with care since some Swagger tools do not support well schemas for mixed sum types.
681-- Use with care since some Swagger tools do not support well schemas for mixed sum types.
682−genericDeclareSchemaUnrestricted :: (Generic a, GToSchema (Rep a)) => SchemaOptions -> proxy a -> Declare (Definitions Schema) Schema
682+genericDeclareSchemaUnrestricted :: (Generic a, GToSchema (Rep a)) => SchemaOptions -> Proxy a -> Declare (Definitions Schema) Schema
683genericDeclareSchemaUnrestricted opts proxy = _namedSchemaSchema <$> genericDeclareNamedSchemaUnrestricted opts proxy
683genericDeclareSchemaUnrestricted opts proxy = _namedSchemaSchema <$> genericDeclareNamedSchemaUnrestricted opts proxy
684
684
685-- | A configurable generic @'NamedSchema'@ creator.
685-- | A configurable generic @'NamedSchema'@ creator.
686--
686--
687-- Unlike 'genericDeclareNamedSchema' also works for mixed sum types.
687-- Unlike 'genericDeclareNamedSchema' also works for mixed sum types.
688-- Use with care since some Swagger tools do not support well schemas for mixed sum types.
688-- Use with care since some Swagger tools do not support well schemas for mixed sum types.
689−genericDeclareNamedSchemaUnrestricted :: forall a proxy. (Generic a, GToSchema (Rep a)) =>
689+genericDeclareNamedSchemaUnrestricted :: forall a. (Generic a, GToSchema (Rep a)) =>
690− SchemaOptions -> proxy a -> Declare (Definitions Schema) NamedSchema
690+ SchemaOptions -> Proxy a -> Declare (Definitions Schema) NamedSchema
691genericDeclareNamedSchemaUnrestricted opts _ = gdeclareNamedSchema opts (Proxy :: Proxy (Rep a)) mempty
691genericDeclareNamedSchemaUnrestricted opts _ = gdeclareNamedSchema opts (Proxy :: Proxy (Rep a)) mempty
692
692
693-- | Derive a 'Generic'-based name for a datatype and assign it to a given 'Schema'.
693-- | Derive a 'Generic'-based name for a datatype and assign it to a given 'Schema'.
694−genericNameSchema :: forall a d f proxy.
694+genericNameSchema :: forall a d f.
695 (Generic a, Rep a ~ D1 d f, Datatype d)
695 (Generic a, Rep a ~ D1 d f, Datatype d)
696− => SchemaOptions -> proxy a -> Schema -> NamedSchema
696+ => SchemaOptions -> Proxy a -> Schema -> NamedSchema
697genericNameSchema opts _ = NamedSchema (gdatatypeSchemaName opts (Proxy :: Proxy d))
697genericNameSchema opts _ = NamedSchema (gdatatypeSchemaName opts (Proxy :: Proxy d))
698
698
699−gdatatypeSchemaName :: forall proxy d. Datatype d => SchemaOptions -> proxy d -> Maybe T.Text
699+gdatatypeSchemaName :: forall d. Datatype d => SchemaOptions -> Proxy d -> Maybe T.Text
700gdatatypeSchemaName opts _ = case orig of
700gdatatypeSchemaName opts _ = case orig of
701 (c:_) | isAlpha c && isUpper c -> Just (T.pack name)
701 (c:_) | isAlpha c && isUpper c -> Just (T.pack name)
702 _ -> Nothing
702 _ -> Nothing
@@ -705,24 +705,23 @@ gdatatypeSchemaName opts _ = case orig of
705 name = datatypeNameModifier opts orig
705 name = datatypeNameModifier opts orig
706
706
707-- | Lift a plain @'ParamSchema'@ into a model @'NamedSchema'@.
707-- | Lift a plain @'ParamSchema'@ into a model @'NamedSchema'@.
708−paramSchemaToNamedSchema :: forall a d f proxy.
709− (ToParamSchema a, Generic a, Rep a ~ D1 d f, Datatype d)
708+paramSchemaToNamedSchema :: (ToParamSchema a, Generic a, Rep a ~ D1 d f, Datatype d) =>
710− => SchemaOptions -> proxy a -> NamedSchema
709+ SchemaOptions -> Proxy a -> NamedSchema
711paramSchemaToNamedSchema opts proxy = genericNameSchema opts proxy (paramSchemaToSchema proxy)
710paramSchemaToNamedSchema opts proxy = genericNameSchema opts proxy (paramSchemaToSchema proxy)
712
711
713-- | Lift a plain @'ParamSchema'@ into a model @'Schema'@.
712-- | Lift a plain @'ParamSchema'@ into a model @'Schema'@.
714−paramSchemaToSchema :: forall a proxy. ToParamSchema a => proxy a -> Schema
713+paramSchemaToSchema :: ToParamSchema a => Proxy a -> Schema
715−paramSchemaToSchema _ = mempty & paramSchema .~ toParamSchema (Proxy :: Proxy a)
714+paramSchemaToSchema proxy = mempty & paramSchema .~ toParamSchema proxy
716
715
717nullarySchema :: Schema
716nullarySchema :: Schema
718nullarySchema = mempty
717nullarySchema = mempty
719 & type_ .~ SwaggerArray
718 & type_ .~ SwaggerArray
720 & items ?~ SwaggerItemsArray []
719 & items ?~ SwaggerItemsArray []
721
720
722−gtoNamedSchema :: GToSchema f => SchemaOptions -> proxy f -> NamedSchema
721+gtoNamedSchema :: GToSchema f => SchemaOptions -> Proxy f -> NamedSchema
723gtoNamedSchema opts proxy = undeclare $ gdeclareNamedSchema opts proxy mempty
722gtoNamedSchema opts proxy = undeclare $ gdeclareNamedSchema opts proxy mempty
724
723
725−gdeclareSchema :: GToSchema f => SchemaOptions -> proxy f -> Declare (Definitions Schema) Schema
724+gdeclareSchema :: GToSchema f => SchemaOptions -> Proxy f -> Declare (Definitions Schema) Schema
726gdeclareSchema opts proxy = _namedSchemaSchema <$> gdeclareNamedSchema opts proxy mempty
725gdeclareSchema opts proxy = _namedSchemaSchema <$> gdeclareNamedSchema opts proxy mempty
727
726
728instance (GToSchema f, GToSchema g) => GToSchema (f :*: g) where
727instance (GToSchema f, GToSchema g) => GToSchema (f :*: g) where
@@ -756,7 +755,7 @@ instance (Selector s, GToSchema f, GToSchema (S1 s f)) => GToSchema (C1 c (S1 s
756 recordSchema = gdeclareNamedSchema opts (Proxy :: Proxy (S1 s f)) s
755 recordSchema = gdeclareNamedSchema opts (Proxy :: Proxy (S1 s f)) s
757 fieldSchema = gdeclareNamedSchema opts (Proxy :: Proxy f) s
756 fieldSchema = gdeclareNamedSchema opts (Proxy :: Proxy f) s
758
757
759−gdeclareSchemaRef :: GToSchema a => SchemaOptions -> proxy a -> Declare (Definitions Schema) (Referenced Schema)
758+gdeclareSchemaRef :: GToSchema a => SchemaOptions -> Proxy a -> Declare (Definitions Schema) (Referenced Schema)
760gdeclareSchemaRef opts proxy = do
759gdeclareSchemaRef opts proxy = do
761 case gtoNamedSchema opts proxy of
760 case gtoNamedSchema opts proxy of
762 NamedSchema (Just name) schema -> do
761 NamedSchema (Just name) schema -> do
@@ -820,7 +819,7 @@ instance ( GSumToSchema f
820 where
819 where
821 gdeclareNamedSchema = gdeclareNamedSumSchema
820 gdeclareNamedSchema = gdeclareNamedSumSchema
822
821
823−gdeclareNamedSumSchema :: GSumToSchema f => SchemaOptions -> proxy f -> Schema -> Declare (Definitions Schema) NamedSchema
822+gdeclareNamedSumSchema :: GSumToSchema f => SchemaOptions -> Proxy f -> Schema -> Declare (Definitions Schema) NamedSchema
824gdeclareNamedSumSchema opts proxy s
823gdeclareNamedSumSchema opts proxy s
825 | allNullaryToStringTag opts && allNullary = pure $ unnamed (toStringTag sumSchema)
824 | allNullaryToStringTag opts && allNullary = pure $ unnamed (toStringTag sumSchema)
826 | otherwise = (unnamed . fst) <$> runWriterT declareSumSchema
825 | otherwise = (unnamed . fst) <$> runWriterT declareSumSchema
@@ -835,13 +834,13 @@ gdeclareNamedSumSchema opts proxy s
835type AllNullary = All
834type AllNullary = All
836
835
837class GSumToSchema (f :: * -> *) where
836class GSumToSchema (f :: * -> *) where
838− gsumToSchema :: SchemaOptions -> proxy f -> Schema -> WriterT AllNullary (Declare (Definitions Schema)) Schema
837+ gsumToSchema :: SchemaOptions -> Proxy f -> Schema -> WriterT AllNullary (Declare (Definitions Schema)) Schema
839
838
840instance (GSumToSchema f, GSumToSchema g) => GSumToSchema (f :+: g) where
839instance (GSumToSchema f, GSumToSchema g) => GSumToSchema (f :+: g) where
841 gsumToSchema opts _ = gsumToSchema opts (Proxy :: Proxy f) >=> gsumToSchema opts (Proxy :: Proxy g)
840 gsumToSchema opts _ = gsumToSchema opts (Proxy :: Proxy f) >=> gsumToSchema opts (Proxy :: Proxy g)
842
841
843−gsumConToSchemaWith :: forall c f proxy. (GToSchema (C1 c f), Constructor c) =>
842+gsumConToSchemaWith :: forall c f. (GToSchema (C1 c f), Constructor c) =>
844− Referenced Schema -> SchemaOptions -> proxy (C1 c f) -> Schema -> Schema
843+ Referenced Schema -> SchemaOptions -> Proxy (C1 c f) -> Schema -> Schema
845gsumConToSchemaWith ref opts _ schema = schema
844gsumConToSchemaWith ref opts _ schema = schema
846 & type_ .~ SwaggerObject
845 & type_ .~ SwaggerObject
847 & properties . at tag ?~ ref
846 & properties . at tag ?~ ref
@@ -850,8 +849,8 @@ gsumConToSchemaWith ref opts _ schema = schema
850 where
849 where
851 tag = T.pack (constructorTagModifier opts (conName (Proxy3 :: Proxy3 c f p)))
850 tag = T.pack (constructorTagModifier opts (conName (Proxy3 :: Proxy3 c f p)))
852
851
853−gsumConToSchema :: forall c f proxy. (GToSchema (C1 c f), Constructor c) =>
852+gsumConToSchema :: (GToSchema (C1 c f), Constructor c) =>
854− SchemaOptions -> proxy (C1 c f) -> Schema -> Declare (Definitions Schema) Schema
853+ SchemaOptions -> Proxy (C1 c f) -> Schema -> Declare (Definitions Schema) Schema
855gsumConToSchema opts proxy schema = do
854gsumConToSchema opts proxy schema = do
856 ref <- gdeclareSchemaRef opts proxy
855 ref <- gdeclareSchemaRef opts proxy
857 return $ gsumConToSchemaWith ref opts proxy schema
856 return $ gsumConToSchemaWith ref opts proxy schema
src/Data/Swagger/Operation.hs+2−2
@@ -37,6 +37,7 @@ import Control.Lens
37import Data.Data.Lens
37import Data.Data.Lens
38import Data.List.Compat
38import Data.List.Compat
39import Data.Maybe (mapMaybe)
39import Data.Maybe (mapMaybe)
40+import Data.Proxy
40import qualified Data.Set as Set
41import qualified Data.Set as Set
41
42
42import Data.Swagger.Declare
43import Data.Swagger.Declare
@@ -118,7 +119,7 @@ applyTagsFor ops ts swag = swag
118--
119--
119-- >>> encode $ runDeclare (declareResponse (Proxy :: Proxy Day)) mempty
120-- >>> encode $ runDeclare (declareResponse (Proxy :: Proxy Day)) mempty
120-- "[{\"Day\":{\"example\":\"2016-07-22\",\"format\":\"date\",\"type\":\"string\"}},{\"description\":\"\",\"schema\":{\"$ref\":\"#/definitions/Day\"}}]"
121-- "[{\"Day\":{\"example\":\"2016-07-22\",\"format\":\"date\",\"type\":\"string\"}},{\"description\":\"\",\"schema\":{\"$ref\":\"#/definitions/Day\"}}]"
121−declareResponse :: ToSchema a => proxy a -> Declare (Definitions Schema) Response
122+declareResponse :: ToSchema a => Proxy a -> Declare (Definitions Schema) Response
122declareResponse proxy = do
123declareResponse proxy = do
123 s <- declareSchemaRef proxy
124 s <- declareSchemaRef proxy
124 return (mempty & schema ?~ s)
125 return (mempty & schema ?~ s)
@@ -189,4 +190,3 @@ setResponseForWith ops f code dres swag = swag
189 Nothing -> new -- response name can't be dereferenced, replacing with new response
190 Nothing -> new -- response name can't be dereferenced, replacing with new response
190 combine (Just (Inline old)) = f old new
191 combine (Just (Inline old)) = f old new
191 combine Nothing = new
192 combine Nothing = new
192−