7e27641 · typeable/swagger2

git.iko.soy/typeable/swagger2

on master help sign in

Add SchemaOptions to allow fieldLabelModifier

7e27641Nickolay Kudasov11 years ago

src/Data/Swagger/Schema.hs+2

compare with master

unifiedsplit

@@ -2,6 +2,8 @@ module Data.Swagger.Schema (

2 ToSchema(..),

3 toSchemaBoundedIntegral,

4 toSchemaBoundedEnum,

5+ SchemaOptions(..),

6+ defaultSchemaOptions,

5 genericToSchema,

7 genericToSchema,

6) where

8) where

src/Data/Swagger/Schema/Internal.hs+19−12

@@ -27,10 +27,10 @@ import Data.Swagger.Lens

27class ToSchema a where

28 toSchema :: proxy a -> Schema

29 default toSchema :: (Generic a, GToSchema (Rep a)) => proxy a -> Schema

30− toSchema = genericToSchema

30+ toSchema = genericToSchema defaultSchemaOptions

32class GToSchema (f :: * -> *) where

33− gtoSchema :: proxy f -> Schema -> Schema

33+ gtoSchema :: SchemaOptions -> proxy f -> Schema -> Schema

35instance {-# OVERLAPPABLE #-} ToSchema a => ToSchema [a] where

36 toSchema _ = mempty

@@ -107,6 +107,13 @@ instance ToSchema a => ToSchema (First a) where toSchema _ = toSchema (Proxy :

107instance ToSchema a => ToSchema (Last a) where toSchema _ = toSchema (Proxy :: Proxy a)

108instance ToSchema a => ToSchema (Dual a) where toSchema _ = toSchema (Proxy :: Proxy a)

109

110+data SchemaOptions = SchemaOptions

111+ { fieldLabelModifier :: String -> String }

112+

113+defaultSchemaOptions :: SchemaOptions

114+defaultSchemaOptions = SchemaOptions

115+ { fieldLabelModifier = id }

116+

110toSchemaBoundedIntegral :: forall a proxy. (Bounded a, Integral a) => proxy a -> Schema

117toSchemaBoundedIntegral :: forall a proxy. (Bounded a, Integral a) => proxy a -> Schema

111toSchemaBoundedIntegral _ = mempty

118toSchemaBoundedIntegral _ = mempty

112 & schemaType .~ SchemaInteger

119 & schemaType .~ SchemaInteger

@@ -118,15 +125,15 @@ toSchemaBoundedEnum _ = mempty

118 & schemaType .~ SchemaString

125 & schemaType .~ SchemaString

119 & schemaEnum ?~ map toJSON [minBound..maxBound :: a]

126 & schemaEnum ?~ map toJSON [minBound..maxBound :: a]

120

127

121−genericToSchema :: forall a proxy. (Generic a, GToSchema (Rep a)) => proxy a -> Schema

128+genericToSchema :: forall a proxy. (Generic a, GToSchema (Rep a)) => SchemaOptions -> proxy a -> Schema

122−genericToSchema _ = gtoSchema (Proxy :: Proxy (Rep a)) mempty

129+genericToSchema opts _ = gtoSchema opts (Proxy :: Proxy (Rep a)) mempty

123

130

124instance (GToSchema f, GToSchema g) => GToSchema (f :*: g) where

131instance (GToSchema f, GToSchema g) => GToSchema (f :*: g) where

125− gtoSchema _ = gtoSchema (Proxy :: Proxy f) . gtoSchema (Proxy :: Proxy g)

132+ gtoSchema opts _ = gtoSchema opts (Proxy :: Proxy f) . gtoSchema opts (Proxy :: Proxy g)

126

133

127-- | Single constructor data types.

134-- | Single constructor data types.

128instance GToSchema f => GToSchema (D1 d (C1 c f)) where

135instance GToSchema f => GToSchema (D1 d (C1 c f)) where

129− gtoSchema _ = gtoSchema (Proxy :: Proxy f)

136+ gtoSchema opts _ = gtoSchema opts (Proxy :: Proxy f)

130

137

131appendItem :: Referenced Schema -> Maybe SchemaItems -> Maybe SchemaItems

138appendItem :: Referenced Schema -> Maybe SchemaItems -> Maybe SchemaItems

132appendItem x Nothing = Just (SchemaItemsArray [x])

139appendItem x Nothing = Just (SchemaItemsArray [x])

@@ -135,7 +142,7 @@ appendItem _ _ = error "GToSchema.appendItem: cannot append to SchemaItemsObject

135

142

136-- | Optional record fields.

143-- | Optional record fields.

137instance {-# OVERLAPPING #-} (Selector s, ToSchema c) => GToSchema (S1 s (K1 i (Maybe c))) where

144instance {-# OVERLAPPING #-} (Selector s, ToSchema c) => GToSchema (S1 s (K1 i (Maybe c))) where

138− gtoSchema _ schema

145+ gtoSchema opts _ schema

139 | T.null fieldName = schema

146 | T.null fieldName = schema

140 & schemaType .~ SchemaArray

147 & schemaType .~ SchemaArray

141 & schemaItems %~ appendItem (Inline fieldSchema)

148 & schemaItems %~ appendItem (Inline fieldSchema)

@@ -143,12 +150,12 @@ instance {-# OVERLAPPING #-} (Selector s, ToSchema c) => GToSchema (S1 s (K1 i (

143 & schemaType .~ SchemaObject

150 & schemaType .~ SchemaObject

144 & schemaProperties . at fieldName ?~ Inline fieldSchema

151 & schemaProperties . at fieldName ?~ Inline fieldSchema

145 where

152 where

146− fieldName = T.pack (selName (undefined :: S1 s f p))

153+ fieldName = T.pack (fieldLabelModifier opts (selName (undefined :: S1 s f p)))

147 fieldSchema = toSchema (Proxy :: Proxy c)

154 fieldSchema = toSchema (Proxy :: Proxy c)

148

155

149-- | Record fields.

156-- | Record fields.

150instance {-# OVERLAPPABLE #-} (Selector s, GToSchema f) => GToSchema (S1 s f) where

157instance {-# OVERLAPPABLE #-} (Selector s, GToSchema f) => GToSchema (S1 s f) where

151− gtoSchema _ schema

158+ gtoSchema opts _ schema

152 | T.null fieldName = schema

159 | T.null fieldName = schema

153 & schemaType .~ SchemaArray

160 & schemaType .~ SchemaArray

154 & schemaItems %~ appendItem (Inline fieldSchema)

161 & schemaItems %~ appendItem (Inline fieldSchema)

@@ -157,9 +164,9 @@ instance {-# OVERLAPPABLE #-} (Selector s, GToSchema f) => GToSchema (S1 s f) wh

157 & schemaProperties . at fieldName ?~ Inline fieldSchema

164 & schemaProperties . at fieldName ?~ Inline fieldSchema

158 & schemaRequired %~ (fieldName :)

165 & schemaRequired %~ (fieldName :)

159 where

166 where

160− fieldName = T.pack (selName (undefined :: S1 s f p))

167+ fieldName = T.pack (fieldLabelModifier opts (selName (undefined :: S1 s f p)))

161− fieldSchema = gtoSchema (Proxy :: Proxy f) mempty

168+ fieldSchema = gtoSchema opts (Proxy :: Proxy f) mempty

162

169

163instance ToSchema c => GToSchema (K1 i c) where

170instance ToSchema c => GToSchema (K1 i c) where

164− gtoSchema _ _ = toSchema (Proxy :: Proxy c)

171+ gtoSchema _ _ _ = toSchema (Proxy :: Proxy c)

165

172