git.iko.soy/rowtype-yoga/purescript-yoga-http-api
on feat/custom-type-errors help sign in
feat: Add schema collection and compile-time collision detection
05db924Mark
@@ -1,5 +1,7 @@
1.spago
1.spago
2output
2output
3output-compile-fail
3output-compile-fail
4+output-test
4node_modules
5node_modules
5.purs-repl
6.purs-repl
7+.psc-ide-port
src/Yoga/HTTP/API/Route.purs+1−1
@@ -22,7 +22,7 @@ import Yoga.HTTP.API.Route.HeaderError (HeaderError(..))
22import Yoga.HTTP.API.Route.HeaderValue (class HeaderValue, class HeaderValueType, headerValueType, parseHeader, printHeader)
22import Yoga.HTTP.API.Route.HeaderValue (class HeaderValue, class HeaderValueType, headerValueType, parseHeader, printHeader)
23import Yoga.HTTP.API.Route.Method (DELETE, GET, PATCH, POST, PUT)
23import Yoga.HTTP.API.Route.Method (DELETE, GET, PATCH, POST, PUT)
24import Yoga.HTTP.API.Route.OpenAPI (class CollectOperations, collectOperations, buildOpenAPISpec, buildOpenAPISpec', OpenAPISpec, ServerObject, class ToOpenAPI, toOpenAPI)
24import Yoga.HTTP.API.Route.OpenAPI (class CollectOperations, collectOperations, buildOpenAPISpec, buildOpenAPISpec', OpenAPISpec, ServerObject, class ToOpenAPI, toOpenAPI)
25−import Yoga.HTTP.API.Route.OpenAPIMetadata (class HasDescription, description, class HasExample, example, class HasFormat, format, class HasMinimum, minimum, class HasMaximum, maximum, class HasPattern, pattern, class HasMinLength, minLength, class HasMaxLength, maxLength, class HasTitle, title, class HasNullable, nullable, class HasDefault, default, class HasDeprecated, deprecated, class HasEnum, enum, class GenericEnumValues, genericEnumValues, class HasOperationMetadata, operationMetadata, OperationMetadata, Description, Example, Format, Minimum, Maximum, Pattern, MinLength, MaxLength, Title, Nullable, Default, Deprecated, Enum)
25+import Yoga.HTTP.API.Route.OpenAPIMetadata (class HasDescription, description, class HasExample, example, class HasFormat, format, class HasMinimum, minimum, class HasMaximum, maximum, class HasPattern, pattern, class HasMinLength, minLength, class HasMaxLength, maxLength, class HasTitle, title, class HasNullable, nullable, class HasDefault, default, class HasDeprecated, deprecated, class HasEnum, enum, class GenericEnumValues, genericEnumValues, class HasOperationMetadata, operationMetadata, OperationMetadata, Description, Example, Format, Minimum, Maximum, Pattern, MinLength, MaxLength, Title, Nullable, Default, Deprecated, Enum, Schema)
26import Yoga.HTTP.API.Route.Response (Response(..), ResponseData, respondNoHeaders, respondWith)
26import Yoga.HTTP.API.Route.Response (Response(..), ResponseData, respondNoHeaders, respondWith)
27import Yoga.HTTP.API.Route.Route (Route(..), class ConvertResponseVariant, class ConvertResponseVariantRL)
27import Yoga.HTTP.API.Route.Route (Route(..), class ConvertResponseVariant, class ConvertResponseVariantRL)
28import Yoga.HTTP.API.Route.RouteHandler (Handler, class RouteHandler, mkHandler, runHandler, class APIHandlers, apiHandlers, class ApiRecord)
28import Yoga.HTTP.API.Route.RouteHandler (Handler, class RouteHandler, mkHandler, runHandler, class APIHandlers, apiHandlers, class ApiRecord)
src/Yoga/HTTP/API/Route/OpenAPI.purs+315−4
@@ -45,6 +45,23 @@ module Yoga.HTTP.API.Route.OpenAPI
45 , ServerObject
45 , ServerObject
46 , OpenAPISpec
46 , OpenAPISpec
47 , ResponseHeaderObject
47 , ResponseHeaderObject
48+ , class CollectSchemas
49+ , collectSchemas
50+ , class CollectSchemasRL
51+ , collectSchemasRL
52+ , class CollectVariantSchemasRL
53+ , collectVariantSchemasRL
54+ , class CollectRouteSchemas
55+ , collectRouteSchemas
56+ , class CollectRouteSchemasRL
57+ , collectRouteSchemasRL
58+ , class CollectSchemaNames
59+ , class CollectSchemaNamesRL
60+ , class CollectVariantSchemaNames
61+ , class CollectRouteSchemaNames
62+ , class CollectRouteSchemaNameRL
63+ , class ValidateNoDuplicatesRL
64+ , class ValidateSchemaNames
48 ) where
65 ) where
49
66
50import Prelude
67import Prelude
@@ -66,7 +83,7 @@ import Unsafe.Coerce (unsafeCoerce)
66import Yoga.HTTP.API.Route.BearerToken (BearerToken)
83import Yoga.HTTP.API.Route.BearerToken (BearerToken)
67import Yoga.HTTP.API.Route.Encoding (JSON, FormData, NoBody)
84import Yoga.HTTP.API.Route.Encoding (JSON, FormData, NoBody)
68import Yoga.HTTP.API.Route.HeaderValue (class HeaderValueType, headerValueType)
85import Yoga.HTTP.API.Route.HeaderValue (class HeaderValueType, headerValueType)
69−import Yoga.HTTP.API.Route.OpenAPIMetadata (Description, Example, Format, Minimum, Maximum, Pattern, MinLength, MaxLength, Title, Nullable, Default, Deprecated, Enum, class HasDescription, description, class HasExample, example, class HasFormat, format, class HasDeprecated, deprecated, class HasMinimum, minimum, class HasMaximum, maximum, class HasPattern, pattern, class HasMinLength, minLength, class HasMaxLength, maxLength, class HasTitle, title, class HasNullable, nullable, class HasDefault, default, class HasEnum, enum, class HasOperationMetadata, operationMetadata)
86+import Yoga.HTTP.API.Route.OpenAPIMetadata (Description, Example, Format, Minimum, Maximum, Pattern, MinLength, MaxLength, Title, Nullable, Default, Deprecated, Enum, Schema, class HasDescription, description, class HasExample, example, class HasFormat, format, class HasDeprecated, deprecated, class HasMinimum, minimum, class HasMaximum, maximum, class HasPattern, pattern, class HasMinLength, minLength, class HasMaxLength, maxLength, class HasTitle, title, class HasNullable, nullable, class HasDefault, default, class HasEnum, enum, class HasOperationMetadata, operationMetadata)
70import Yoga.HTTP.API.Route.Response (class ToResponse)
87import Yoga.HTTP.API.Route.Response (class ToResponse)
71import Yoga.HTTP.API.Route.StatusCode (class StatusCodeMap, statusCodeFor, statusCodeToString)
88import Yoga.HTTP.API.Route.StatusCode (class StatusCodeMap, statusCodeFor, statusCodeToString)
72import Yoga.JSON (class WriteForeign, writeImpl)
89import Yoga.JSON (class WriteForeign, writeImpl)
@@ -604,6 +621,14 @@ instance (RenderJSONSchema a, HasEnum (Enum a)) => RenderJSONSchema (Enum a) whe
604 in
621 in
605 unsafeCoerce withEnum
622 unsafeCoerce withEnum
606
623
624+-- Schema wrapper: generates $ref instead of inline schema
625+instance (IsSymbol name, RenderJSONSchema a) => RenderJSONSchema (Schema name a) where
626+ renderJSONSchema _ =
627+ let
628+ schemaName = reflectSymbol (Proxy :: Proxy name)
629+ in
630+ unsafeCoerce $ FObject.singleton "$ref" (unsafeCoerce $ "#/components/schemas/" <> schemaName)
631+
607-- Other metadata wrappers (Minimum, Maximum, Pattern, MinLength, MaxLength, Title, Default)
632-- Other metadata wrappers (Minimum, Maximum, Pattern, MinLength, MaxLength, Title, Default)
608-- are similar but require more complex constraints, so we'll skip them for now in body schemas
633-- are similar but require more complex constraints, so we'll skip them for now in body schemas
609
634
@@ -863,6 +888,282 @@ class ToOpenAPI (route :: Type) where
863toOpenAPI :: forall @a. ToOpenAPI a => String
888toOpenAPI :: forall @a. ToOpenAPI a => String
864toOpenAPI = toOpenAPIImpl (Proxy :: Proxy a)
889toOpenAPI = toOpenAPIImpl (Proxy :: Proxy a)
865
890
891+--------------------------------------------------------------------------------
892+-- CollectSchemas: Collect all Schema wrappers for component extraction
893+--------------------------------------------------------------------------------
894+
895+-- | Collects all Schema wrappers found in a type and returns their definitions
896+class CollectSchemas (ty :: Type) where
897+ collectSchemas :: Proxy ty -> FObject.Object Foreign
898+
899+-- Base cases: primitives don't contain schemas
900+instance CollectSchemas String where
901+ collectSchemas _ = FObject.empty
902+
903+instance CollectSchemas Int where
904+ collectSchemas _ = FObject.empty
905+
906+instance CollectSchemas Number where
907+ collectSchemas _ = FObject.empty
908+
909+instance CollectSchemas Boolean where
910+ collectSchemas _ = FObject.empty
911+
912+instance CollectSchemas Unit where
913+ collectSchemas _ = FObject.empty
914+
915+-- Array: recurse into item type
916+instance CollectSchemas a => CollectSchemas (Array a) where
917+ collectSchemas _ = collectSchemas (Proxy :: Proxy a)
918+
919+-- Maybe: recurse into inner type
920+instance CollectSchemas a => CollectSchemas (Maybe a) where
921+ collectSchemas _ = collectSchemas (Proxy :: Proxy a)
922+
923+-- Record: recurse through all fields
924+instance (RowToList row rl, CollectSchemasRL rl) => CollectSchemas (Record row) where
925+ collectSchemas _ = collectSchemasRL (Proxy :: Proxy rl)
926+
927+-- JSON wrapper: unwrap and recurse
928+instance CollectSchemas a => CollectSchemas (JSON a) where
929+ collectSchemas _ = collectSchemas (Proxy :: Proxy a)
930+
931+-- FormData wrapper: unwrap and recurse
932+instance CollectSchemas a => CollectSchemas (FormData a) where
933+ collectSchemas _ = collectSchemas (Proxy :: Proxy a)
934+
935+-- NoBody: no schemas
936+instance CollectSchemas NoBody where
937+ collectSchemas _ = FObject.empty
938+
939+-- Schema wrapper: COLLECT THIS + recurse into inner type
940+instance (IsSymbol name, RenderJSONSchema inner, CollectSchemas inner) => CollectSchemas (Schema name inner) where
941+ collectSchemas _ =
942+ let
943+ schemaName = reflectSymbol (Proxy :: Proxy name)
944+ -- Render the INNER type (not the Schema wrapper) for the component definition
945+ innerSchema = renderJSONSchema (Proxy :: Proxy inner)
946+ -- Also collect any nested schemas
947+ nestedSchemas = collectSchemas (Proxy :: Proxy inner)
948+ in
949+ FObject.insert schemaName innerSchema nestedSchemas
950+
951+-- Metadata wrappers: recurse through to find schemas
952+instance CollectSchemas a => CollectSchemas (Description desc a) where
953+ collectSchemas _ = collectSchemas (Proxy :: Proxy a)
954+
955+instance CollectSchemas a => CollectSchemas (Example ex a) where
956+ collectSchemas _ = collectSchemas (Proxy :: Proxy a)
957+
958+instance CollectSchemas a => CollectSchemas (Format fmt a) where
959+ collectSchemas _ = collectSchemas (Proxy :: Proxy a)
960+
961+instance CollectSchemas a => CollectSchemas (Minimum v a) where
962+ collectSchemas _ = collectSchemas (Proxy :: Proxy a)
963+
964+instance CollectSchemas a => CollectSchemas (Maximum v a) where
965+ collectSchemas _ = collectSchemas (Proxy :: Proxy a)
966+
967+instance CollectSchemas a => CollectSchemas (Pattern pat a) where
968+ collectSchemas _ = collectSchemas (Proxy :: Proxy a)
969+
970+instance CollectSchemas a => CollectSchemas (MinLength v a) where
971+ collectSchemas _ = collectSchemas (Proxy :: Proxy a)
972+
973+instance CollectSchemas a => CollectSchemas (MaxLength v a) where
974+ collectSchemas _ = collectSchemas (Proxy :: Proxy a)
975+
976+instance CollectSchemas a => CollectSchemas (Title t a) where
977+ collectSchemas _ = collectSchemas (Proxy :: Proxy a)
978+
979+instance CollectSchemas a => CollectSchemas (Nullable a) where
980+ collectSchemas _ = collectSchemas (Proxy :: Proxy a)
981+
982+instance CollectSchemas a => CollectSchemas (Default val a) where
983+ collectSchemas _ = collectSchemas (Proxy :: Proxy a)
984+
985+instance CollectSchemas a => CollectSchemas (Deprecated a) where
986+ collectSchemas _ = collectSchemas (Proxy :: Proxy a)
987+
988+instance CollectSchemas a => CollectSchemas (Enum a) where
989+ collectSchemas _ = collectSchemas (Proxy :: Proxy a)
990+
991+-- | Helper class to collect schemas from record fields
992+class CollectSchemasRL (rl :: RowList Type) where
993+ collectSchemasRL :: Proxy rl -> FObject.Object Foreign
994+
995+instance CollectSchemasRL Nil where
996+ collectSchemasRL _ = FObject.empty
997+
998+instance (IsSymbol name, CollectSchemas ty, CollectSchemasRL tail) => CollectSchemasRL (Cons name ty tail) where
999+ collectSchemasRL _ =
1000+ let
1001+ fieldSchemas = collectSchemas (Proxy :: Proxy ty)
1002+ restSchemas = collectSchemasRL (Proxy :: Proxy tail)
1003+ in
1004+ FObject.union fieldSchemas restSchemas
1005+
1006+-- | Collects schemas from all response bodies in a variant
1007+class CollectVariantSchemasRL (rl :: RowList Type) where
1008+ collectVariantSchemasRL :: Proxy rl -> FObject.Object Foreign
1009+
1010+instance CollectVariantSchemasRL Nil where
1011+ collectVariantSchemasRL _ = FObject.empty
1012+
1013+instance
1014+ ( ToResponse recordType headers body
1015+ , CollectSchemas body
1016+ , CollectVariantSchemasRL tail
1017+ ) =>
1018+ CollectVariantSchemasRL (Cons label recordType tail) where
1019+ collectVariantSchemasRL _ =
1020+ let
1021+ bodySchemas = collectSchemas (Proxy :: Proxy body)
1022+ restSchemas = collectVariantSchemasRL (Proxy :: Proxy tail)
1023+ in
1024+ FObject.union bodySchemas restSchemas
1025+
1026+-- | Collects schemas from a route's request and response types
1027+class CollectRouteSchemas (route :: Type) where
1028+ collectRouteSchemas :: Proxy route -> FObject.Object Foreign
1029+
1030+-- | Helper class for collecting schemas from a record of routes
1031+class CollectRouteSchemasRL (rl :: RowList Type) where
1032+ collectRouteSchemasRL :: Proxy rl -> FObject.Object Foreign
1033+
1034+instance CollectRouteSchemasRL Nil where
1035+ collectRouteSchemasRL _ = FObject.empty
1036+
1037+instance
1038+ ( CollectRouteSchemas routeType
1039+ , CollectRouteSchemasRL tail
1040+ ) =>
1041+ CollectRouteSchemasRL (Cons label routeType tail) where
1042+ collectRouteSchemasRL _ =
1043+ let
1044+ routeSchemas = collectRouteSchemas (Proxy :: Proxy routeType)
1045+ restSchemas = collectRouteSchemasRL (Proxy :: Proxy tail)
1046+ in
1047+ FObject.union routeSchemas restSchemas
1048+
1049+-- Record instance: iterate record fields via RowList
1050+instance (RowToList row rl, CollectRouteSchemasRL rl) => CollectRouteSchemas (Record row) where
1051+ collectRouteSchemas _ = collectRouteSchemasRL (Proxy :: Proxy rl)
1052+
1053+--------------------------------------------------------------------------------
1054+-- CollectSchemaNames: Type-level collision detection
1055+--------------------------------------------------------------------------------
1056+
1057+-- | Collects schema names at the type level as a Row.
1058+-- | Used with Row.Union + Row.Nub to detect name collisions at compile time.
1059+-- | Two Schema wrappers with the same name but different types cause a compile error.
1060+class CollectSchemaNames (ty :: Type) (names :: Row Type) | ty -> names
1061+
1062+instance CollectSchemaNames String ()
1063+instance CollectSchemaNames Int ()
1064+instance CollectSchemaNames Number ()
1065+instance CollectSchemaNames Boolean ()
1066+instance CollectSchemaNames Unit ()
1067+
1068+instance CollectSchemaNames a names => CollectSchemaNames (Array a) names
1069+instance CollectSchemaNames a names => CollectSchemaNames (Maybe a) names
1070+
1071+instance (RowToList row rl, CollectSchemaNamesRL rl names) => CollectSchemaNames (Record row) names
1072+
1073+instance CollectSchemaNames a names => CollectSchemaNames (JSON a) names
1074+instance CollectSchemaNames a names => CollectSchemaNames (FormData a) names
1075+instance CollectSchemaNames NoBody ()
1076+
1077+instance
1078+ ( CollectSchemaNames inner innerNames
1079+ , Row.Cons name inner innerNames names
1080+ , Row.Lacks name innerNames
1081+ ) =>
1082+ CollectSchemaNames (Schema name inner) names
1083+
1084+-- Metadata wrappers: recurse through
1085+instance CollectSchemaNames a names => CollectSchemaNames (Description desc a) names
1086+instance CollectSchemaNames a names => CollectSchemaNames (Example ex a) names
1087+instance CollectSchemaNames a names => CollectSchemaNames (Format fmt a) names
1088+instance CollectSchemaNames a names => CollectSchemaNames (Minimum v a) names
1089+instance CollectSchemaNames a names => CollectSchemaNames (Maximum v a) names
1090+instance CollectSchemaNames a names => CollectSchemaNames (Pattern pat a) names
1091+instance CollectSchemaNames a names => CollectSchemaNames (MinLength v a) names
1092+instance CollectSchemaNames a names => CollectSchemaNames (MaxLength v a) names
1093+instance CollectSchemaNames a names => CollectSchemaNames (Title t a) names
1094+instance CollectSchemaNames a names => CollectSchemaNames (Nullable a) names
1095+instance CollectSchemaNames a names => CollectSchemaNames (Default val a) names
1096+instance CollectSchemaNames a names => CollectSchemaNames (Deprecated a) names
1097+instance CollectSchemaNames a names => CollectSchemaNames (Enum a) names
1098+
1099+-- | Helper class to collect schema names from record fields
1100+class CollectSchemaNamesRL (rl :: RowList Type) (names :: Row Type) | rl -> names
1101+
1102+instance CollectSchemaNamesRL Nil ()
1103+
1104+instance
1105+ ( CollectSchemaNames ty fieldNames
1106+ , CollectSchemaNamesRL tail tailNames
1107+ , Row.Union fieldNames tailNames names
1108+ ) =>
1109+ CollectSchemaNamesRL (Cons name ty tail) names
1110+
1111+-- | Collects schema names from all response bodies in a variant
1112+class CollectVariantSchemaNames (rl :: RowList Type) (names :: Row Type) | rl -> names
1113+
1114+instance CollectVariantSchemaNames Nil ()
1115+
1116+instance
1117+ ( ToResponse recordType headers body
1118+ , CollectSchemaNames body bodyNames
1119+ , CollectVariantSchemaNames tail tailNames
1120+ , Row.Union bodyNames tailNames names
1121+ ) =>
1122+ CollectVariantSchemaNames (Cons label recordType tail) names
1123+
1124+-- | Collects schema names from a route's request and response types
1125+class CollectRouteSchemaNames (route :: Type) (names :: Row Type) | route -> names
1126+
1127+-- | Helper for collecting schema names from a record of routes
1128+class CollectRouteSchemaNameRL (rl :: RowList Type) (names :: Row Type) | rl -> names
1129+
1130+instance CollectRouteSchemaNameRL Nil ()
1131+
1132+instance
1133+ ( CollectRouteSchemaNames routeType routeNames
1134+ , CollectRouteSchemaNameRL tail tailNames
1135+ , Row.Union routeNames tailNames names
1136+ ) =>
1137+ CollectRouteSchemaNameRL (Cons label routeType tail) names
1138+
1139+-- Record instance
1140+instance (RowToList row rl, CollectRouteSchemaNameRL rl names) => CollectRouteSchemaNames (Record row) names
1141+
1142+-- | Walks a RowList and checks each entry against the full row.
1143+-- | If the RowList has duplicate labels from Union, Cons will unify their types.
1144+-- | Same name + same type: Cons succeeds. Same name + different type: Cons fails.
1145+class ValidateNoDuplicatesRL (rl :: RowList Type) (full :: Row Type)
1146+
1147+instance ValidateNoDuplicatesRL Nil full
1148+
1149+instance
1150+ ( Row.Cons name ty _rest full
1151+ , ValidateNoDuplicatesRL tail full
1152+ ) =>
1153+ ValidateNoDuplicatesRL (Cons name ty tail) full
1154+
1155+-- | Validates that all Schema wrappers in a route collection have unique names.
1156+-- | Same name with same type is allowed (deduplication).
1157+-- | Same name with different types is a compile error.
1158+class ValidateSchemaNames (routes :: Type)
1159+
1160+instance
1161+ ( CollectRouteSchemaNames routes names
1162+ , RowToList names rl
1163+ , ValidateNoDuplicatesRL rl names
1164+ ) =>
1165+ ValidateSchemaNames routes
1166+
866--------------------------------------------------------------------------------
1167--------------------------------------------------------------------------------
867-- CollectOperations: Walk a type-level structure of routes
1168-- CollectOperations: Walk a type-level structure of routes
868--------------------------------------------------------------------------------
1169--------------------------------------------------------------------------------
@@ -972,6 +1273,8 @@ type ServerObject =
972buildOpenAPISpec
1273buildOpenAPISpec
973 :: forall @routes
1274 :: forall @routes
974 . CollectOperations routes
1275 . CollectOperations routes
1276+ => CollectRouteSchemas routes
1277+ => ValidateSchemaNames routes
975 => { title :: String, version :: String }
1278 => { title :: String, version :: String }
976 -> OpenAPISpec
1279 -> OpenAPISpec
977buildOpenAPISpec info = buildOpenAPISpec' @routes info { servers: Nothing }
1280buildOpenAPISpec info = buildOpenAPISpec' @routes info { servers: Nothing }
@@ -980,6 +1283,8 @@ buildOpenAPISpec info = buildOpenAPISpec' @routes info { servers: Nothing }
980buildOpenAPISpec'
1283buildOpenAPISpec'
981 :: forall @routes
1284 :: forall @routes
982 . CollectOperations routes
1285 . CollectOperations routes
1286+ => CollectRouteSchemas routes
1287+ => ValidateSchemaNames routes
983 => { title :: String, version :: String }
1288 => { title :: String, version :: String }
984 -> { servers :: Maybe (Array ServerObject) }
1289 -> { servers :: Maybe (Array ServerObject) }
985 -> OpenAPISpec
1290 -> OpenAPISpec
@@ -988,9 +1293,15 @@ buildOpenAPISpec' info config =
988 ops = collectOperations (Proxy :: Proxy routes)
1293 ops = collectOperations (Proxy :: Proxy routes)
989 paths = groupByPath ops
1294 paths = groupByPath ops
990 securitySchemes = buildSecuritySchemes ops
1295 securitySchemes = buildSecuritySchemes ops
1296+ schemas = collectRouteSchemas (Proxy :: Proxy routes)
1297+
1298+ -- Build components object with both schemas and securitySchemes
991 components =
1299 components =
992− if FObject.isEmpty securitySchemes then Nothing
1300+ if FObject.isEmpty schemas && FObject.isEmpty securitySchemes then Nothing
993− else Just { securitySchemes }
1301+ else Just $ unsafeCoerce $ FObject.fromFoldable $
1302+ (if FObject.isEmpty schemas then [] else [ Tuple "schemas" (unsafeCoerce schemas) ])
1303+ <> (if FObject.isEmpty securitySchemes then [] else [ Tuple "securitySchemes" (unsafeCoerce securitySchemes) ])
1304+
994 baseSpec = FObject.fromFoldable
1305 baseSpec = FObject.fromFoldable
995 [ Tuple "openapi" (unsafeCoerce "3.0.0")
1306 [ Tuple "openapi" (unsafeCoerce "3.0.0")
996 , Tuple "info" (unsafeCoerce { title: info.title, version: info.version })
1307 , Tuple "info" (unsafeCoerce { title: info.title, version: info.version })
@@ -998,7 +1309,7 @@ buildOpenAPISpec' info config =
998 ]
1309 ]
999 withComponents = case components of
1310 withComponents = case components of
1000 Nothing -> baseSpec
1311 Nothing -> baseSpec
1001− Just c -> FObject.insert "components" (unsafeCoerce c) baseSpec
1312+ Just c -> FObject.insert "components" c baseSpec
1002 withServers = case config.servers of
1313 withServers = case config.servers of
1003 Nothing -> withComponents
1314 Nothing -> withComponents
1004 Just servers -> FObject.insert "servers" (writeImpl servers) withComponents
1315 Just servers -> FObject.insert "servers" (writeImpl servers) withComponents
src/Yoga/HTTP/API/Route/OpenAPIMetadata.purs+52
@@ -43,6 +43,7 @@ module Yoga.HTTP.API.Route.OpenAPIMetadata
43 , Default
43 , Default
44 , Deprecated
44 , Deprecated
45 , Enum
45 , Enum
46+ , Schema
46 ) where
47 ) where
47
48
48import Prelude
49import Prelude
@@ -140,6 +141,15 @@ data Deprecated a
140data Enum :: Type -> Type
141data Enum :: Type -> Type
141data Enum a
142data Enum a
142
143
144+-- | Mark a type to be extracted as an OpenAPI component schema with $ref.
145+-- | When used in request/response bodies, generates a reference instead of inline schema.
146+-- |
147+-- | Example:
148+-- | type User = { id :: Int, name :: String }
149+-- | Route POST path (Request { body :: JSON (Schema "User" User) }) (ok :: { body :: Schema "User" User })
150+data Schema :: Symbol -> Type -> Type
151+data Schema name a
152+
143--------------------------------------------------------------------------------
153--------------------------------------------------------------------------------
144-- Metadata Extraction Typeclasses
154-- Metadata Extraction Typeclasses
145--
155--
@@ -180,6 +190,8 @@ else instance HasDescription a => HasDescription (Deprecated a) where
180 description _ = description (Proxy :: Proxy a)
190 description _ = description (Proxy :: Proxy a)
181else instance HasDescription a => HasDescription (Enum a) where
191else instance HasDescription a => HasDescription (Enum a) where
182 description _ = description (Proxy :: Proxy a)
192 description _ = description (Proxy :: Proxy a)
193+else instance HasDescription a => HasDescription (Schema name a) where
194+ description _ = description (Proxy :: Proxy a)
183else instance HasDescription ty where
195else instance HasDescription ty where
184 description _ = Nothing
196 description _ = Nothing
185
197
@@ -213,6 +225,8 @@ else instance HasExample a => HasExample (Deprecated a) where
213 example _ = example (Proxy :: Proxy a)
225 example _ = example (Proxy :: Proxy a)
214else instance HasExample a => HasExample (Enum a) where
226else instance HasExample a => HasExample (Enum a) where
215 example _ = example (Proxy :: Proxy a)
227 example _ = example (Proxy :: Proxy a)
228+else instance HasExample a => HasExample (Schema name a) where
229+ example _ = example (Proxy :: Proxy a)
216else instance HasExample ty where
230else instance HasExample ty where
217 example _ = Nothing
231 example _ = Nothing
218
232
@@ -246,6 +260,8 @@ else instance HasFormat a => HasFormat (Deprecated a) where
246 format _ = format (Proxy :: Proxy a)
260 format _ = format (Proxy :: Proxy a)
247else instance HasFormat a => HasFormat (Enum a) where
261else instance HasFormat a => HasFormat (Enum a) where
248 format _ = format (Proxy :: Proxy a)
262 format _ = format (Proxy :: Proxy a)
263+else instance HasFormat a => HasFormat (Schema name a) where
264+ format _ = format (Proxy :: Proxy a)
249else instance HasFormat ty where
265else instance HasFormat ty where
250 format _ = Nothing
266 format _ = Nothing
251
267
@@ -279,6 +295,8 @@ else instance HasMinimum a => HasMinimum (Deprecated a) where
279 minimum _ = minimum (Proxy :: Proxy a)
295 minimum _ = minimum (Proxy :: Proxy a)
280else instance HasMinimum a => HasMinimum (Enum a) where
296else instance HasMinimum a => HasMinimum (Enum a) where
281 minimum _ = minimum (Proxy :: Proxy a)
297 minimum _ = minimum (Proxy :: Proxy a)
298+else instance HasMinimum a => HasMinimum (Schema name a) where
299+ minimum _ = minimum (Proxy :: Proxy a)
282else instance HasMinimum ty where
300else instance HasMinimum ty where
283 minimum _ = Nothing
301 minimum _ = Nothing
284
302
@@ -312,6 +330,8 @@ else instance HasMaximum a => HasMaximum (Deprecated a) where
312 maximum _ = maximum (Proxy :: Proxy a)
330 maximum _ = maximum (Proxy :: Proxy a)
313else instance HasMaximum a => HasMaximum (Enum a) where
331else instance HasMaximum a => HasMaximum (Enum a) where
314 maximum _ = maximum (Proxy :: Proxy a)
332 maximum _ = maximum (Proxy :: Proxy a)
333+else instance HasMaximum a => HasMaximum (Schema name a) where
334+ maximum _ = maximum (Proxy :: Proxy a)
315else instance HasMaximum ty where
335else instance HasMaximum ty where
316 maximum _ = Nothing
336 maximum _ = Nothing
317
337
@@ -345,6 +365,8 @@ else instance HasPattern a => HasPattern (Deprecated a) where
345 pattern _ = pattern (Proxy :: Proxy a)
365 pattern _ = pattern (Proxy :: Proxy a)
346else instance HasPattern a => HasPattern (Enum a) where
366else instance HasPattern a => HasPattern (Enum a) where
347 pattern _ = pattern (Proxy :: Proxy a)
367 pattern _ = pattern (Proxy :: Proxy a)
368+else instance HasPattern a => HasPattern (Schema name a) where
369+ pattern _ = pattern (Proxy :: Proxy a)
348else instance HasPattern ty where
370else instance HasPattern ty where
349 pattern _ = Nothing
371 pattern _ = Nothing
350
372
@@ -378,6 +400,8 @@ else instance HasMinLength a => HasMinLength (Deprecated a) where
378 minLength _ = minLength (Proxy :: Proxy a)
400 minLength _ = minLength (Proxy :: Proxy a)
379else instance HasMinLength a => HasMinLength (Enum a) where
401else instance HasMinLength a => HasMinLength (Enum a) where
380 minLength _ = minLength (Proxy :: Proxy a)
402 minLength _ = minLength (Proxy :: Proxy a)
403+else instance HasMinLength a => HasMinLength (Schema name a) where
404+ minLength _ = minLength (Proxy :: Proxy a)
381else instance HasMinLength ty where
405else instance HasMinLength ty where
382 minLength _ = Nothing
406 minLength _ = Nothing
383
407
@@ -411,6 +435,8 @@ else instance HasMaxLength a => HasMaxLength (Deprecated a) where
411 maxLength _ = maxLength (Proxy :: Proxy a)
435 maxLength _ = maxLength (Proxy :: Proxy a)
412else instance HasMaxLength a => HasMaxLength (Enum a) where
436else instance HasMaxLength a => HasMaxLength (Enum a) where
413 maxLength _ = maxLength (Proxy :: Proxy a)
437 maxLength _ = maxLength (Proxy :: Proxy a)
438+else instance HasMaxLength a => HasMaxLength (Schema name a) where
439+ maxLength _ = maxLength (Proxy :: Proxy a)
414else instance HasMaxLength ty where
440else instance HasMaxLength ty where
415 maxLength _ = Nothing
441 maxLength _ = Nothing
416
442
@@ -444,6 +470,8 @@ else instance HasTitle a => HasTitle (Deprecated a) where
444 title _ = title (Proxy :: Proxy a)
470 title _ = title (Proxy :: Proxy a)
445else instance HasTitle a => HasTitle (Enum a) where
471else instance HasTitle a => HasTitle (Enum a) where
446 title _ = title (Proxy :: Proxy a)
472 title _ = title (Proxy :: Proxy a)
473+else instance HasTitle a => HasTitle (Schema name a) where
474+ title _ = title (Proxy :: Proxy a)
447else instance HasTitle ty where
475else instance HasTitle ty where
448 title _ = Nothing
476 title _ = Nothing
449
477
@@ -477,6 +505,8 @@ else instance HasNullable a => HasNullable (Deprecated a) where
477 nullable _ = nullable (Proxy :: Proxy a)
505 nullable _ = nullable (Proxy :: Proxy a)
478else instance HasNullable a => HasNullable (Enum a) where
506else instance HasNullable a => HasNullable (Enum a) where
479 nullable _ = nullable (Proxy :: Proxy a)
507 nullable _ = nullable (Proxy :: Proxy a)
508+else instance HasNullable a => HasNullable (Schema name a) where
509+ nullable _ = nullable (Proxy :: Proxy a)
480else instance HasNullable ty where
510else instance HasNullable ty where
481 nullable _ = false
511 nullable _ = false
482
512
@@ -510,6 +540,8 @@ else instance HasDefault a => HasDefault (Deprecated a) where
510 default _ = default (Proxy :: Proxy a)
540 default _ = default (Proxy :: Proxy a)
511else instance HasDefault a => HasDefault (Enum a) where
541else instance HasDefault a => HasDefault (Enum a) where
512 default _ = default (Proxy :: Proxy a)
542 default _ = default (Proxy :: Proxy a)
543+else instance HasDefault a => HasDefault (Schema name a) where
544+ default _ = default (Proxy :: Proxy a)
513else instance HasDefault ty where
545else instance HasDefault ty where
514 default _ = Nothing
546 default _ = Nothing
515
547
@@ -543,6 +575,8 @@ else instance HasDeprecated a => HasDeprecated (Default val a) where
543 deprecated _ = deprecated (Proxy :: Proxy a)
575 deprecated _ = deprecated (Proxy :: Proxy a)
544else instance HasDeprecated a => HasDeprecated (Enum a) where
576else instance HasDeprecated a => HasDeprecated (Enum a) where
545 deprecated _ = deprecated (Proxy :: Proxy a)
577 deprecated _ = deprecated (Proxy :: Proxy a)
578+else instance HasDeprecated a => HasDeprecated (Schema name a) where
579+ deprecated _ = deprecated (Proxy :: Proxy a)
546else instance HasDeprecated ty where
580else instance HasDeprecated ty where
547 deprecated _ = false
581 deprecated _ = false
548
582
@@ -592,6 +626,8 @@ else instance HasEnum a => HasEnum (Default val a) where
592 enum _ = enum (Proxy :: Proxy a)
626 enum _ = enum (Proxy :: Proxy a)
593else instance HasEnum a => HasEnum (Deprecated a) where
627else instance HasEnum a => HasEnum (Deprecated a) where
594 enum _ = enum (Proxy :: Proxy a)
628 enum _ = enum (Proxy :: Proxy a)
629+else instance HasEnum a => HasEnum (Schema name a) where
630+ enum _ = enum (Proxy :: Proxy a)
595else instance HasEnum ty where
631else instance HasEnum ty where
596 enum _ = Nothing
632 enum _ = Nothing
597
633
@@ -707,6 +743,10 @@ instance HeaderValue a => HeaderValue (Enum a) where
707 parseHeader s = unsafeCoerce (parseHeader s :: Either String a)
743 parseHeader s = unsafeCoerce (parseHeader s :: Either String a)
708 printHeader x = printHeader (unsafeCoerce x :: a)
744 printHeader x = printHeader (unsafeCoerce x :: a)
709
745
746+instance HeaderValue a => HeaderValue (Schema name a) where
747+ parseHeader s = unsafeCoerce (parseHeader s :: Either String a)
748+ printHeader x = printHeader (unsafeCoerce x :: a)
749+
710-- HeaderValueType instances
750-- HeaderValueType instances
711instance HeaderValueType a => HeaderValueType (Description desc a) where
751instance HeaderValueType a => HeaderValueType (Description desc a) where
712 headerValueType _ = headerValueType (Proxy :: Proxy a)
752 headerValueType _ = headerValueType (Proxy :: Proxy a)
@@ -747,6 +787,9 @@ instance HeaderValueType a => HeaderValueType (Deprecated a) where
747instance HeaderValueType a => HeaderValueType (Enum a) where
787instance HeaderValueType a => HeaderValueType (Enum a) where
748 headerValueType _ = headerValueType (Proxy :: Proxy a)
788 headerValueType _ = headerValueType (Proxy :: Proxy a)
749
789
790+instance HeaderValueType a => HeaderValueType (Schema name a) where
791+ headerValueType _ = headerValueType (Proxy :: Proxy a)
792+
750-- ParseParam instances
793-- ParseParam instances
751instance ParseParam a => ParseParam (Description desc a) where
794instance ParseParam a => ParseParam (Description desc a) where
752 parseParam s = unsafeCoerce (parseParam s :: Either String a)
795 parseParam s = unsafeCoerce (parseParam s :: Either String a)
@@ -815,6 +858,9 @@ instance ParseParam a => ParseParam (Deprecated a) where
815instance ParseParam a => ParseParam (Enum a) where
858instance ParseParam a => ParseParam (Enum a) where
816 parseParam s = unsafeCoerce (parseParam s :: Either String a)
859 parseParam s = unsafeCoerce (parseParam s :: Either String a)
817
860
861+instance ParseParam a => ParseParam (Schema name a) where
862+ parseParam s = unsafeCoerce (parseParam s :: Either String a)
863+
818-- WriteForeign instances
864-- WriteForeign instances
819instance WriteForeign a => WriteForeign (Description desc a) where
865instance WriteForeign a => WriteForeign (Description desc a) where
820 writeImpl x = writeImpl (unsafeCoerce x :: a)
866 writeImpl x = writeImpl (unsafeCoerce x :: a)
@@ -855,6 +901,9 @@ instance WriteForeign a => WriteForeign (Deprecated a) where
855instance WriteForeign a => WriteForeign (Enum a) where
901instance WriteForeign a => WriteForeign (Enum a) where
856 writeImpl x = writeImpl (unsafeCoerce x :: a)
902 writeImpl x = writeImpl (unsafeCoerce x :: a)
857
903
904+instance WriteForeign a => WriteForeign (Schema name a) where
905+ writeImpl x = writeImpl (unsafeCoerce x :: a)
906+
858-- ReadForeign instances
907-- ReadForeign instances
859instance ReadForeign a => ReadForeign (Description desc a) where
908instance ReadForeign a => ReadForeign (Description desc a) where
860 readImpl = unsafeCoerce (readImpl :: Foreign -> _ a)
909 readImpl = unsafeCoerce (readImpl :: Foreign -> _ a)
@@ -894,3 +943,6 @@ instance ReadForeign a => ReadForeign (Deprecated a) where
894
943
895instance ReadForeign a => ReadForeign (Enum a) where
944instance ReadForeign a => ReadForeign (Enum a) where
896 readImpl = unsafeCoerce (readImpl :: Foreign -> _ a)
945 readImpl = unsafeCoerce (readImpl :: Foreign -> _ a)
946+
947+instance ReadForeign a => ReadForeign (Schema name a) where
948+ readImpl = unsafeCoerce (readImpl :: Foreign -> _ a)
src/Yoga/HTTP/API/Route/Response.purs+133−126
@@ -1,6 +1,9 @@
1module Yoga.HTTP.API.Route.Response
1module Yoga.HTTP.API.Route.Response
2 ( Response(..)
2 ( Response(..)
3 , ResponseData
3 , ResponseData
4+ , ResponseHeaders
5+ , ResponseBody
6+ , EmptyResponse
4 , class ToResponse
7 , class ToResponse
5 , class ToResponseRL
8 , class ToResponseRL
6 , respond
9 , respond
@@ -13,130 +16,130 @@ module Yoga.HTTP.API.Route.Response
13 , respondNoContent
16 , respondNoContent
14 , respondNotModified
17 , respondNotModified
15 -- Status code helpers
18 -- Status code helpers
16−, continue
19+ , continue
17−, continueWith
20+ , continueWith
18−, switchingProtocols
21+ , switchingProtocols
19−, switchingProtocolsWith
22+ , switchingProtocolsWith
20−, processing
23+ , processing
21−, processingWith
24+ , processingWith
22−, earlyHints
25+ , earlyHints
23−, earlyHintsWith
26+ , earlyHintsWith
24−, ok
27+ , ok
25−, okWith
28+ , okWith
26−, created
29+ , created
27−, createdWith
30+ , createdWith
28−, accepted
31+ , accepted
29−, acceptedWith
32+ , acceptedWith
30−, nonAuthoritativeInformation
33+ , nonAuthoritativeInformation
31−, nonAuthoritativeInformationWith
34+ , nonAuthoritativeInformationWith
32−, noContent
35+ , noContent
33−, noContentWith
36+ , noContentWith
34−, resetContent
37+ , resetContent
35−, resetContentWith
38+ , resetContentWith
36−, partialContent
39+ , partialContent
37−, partialContentWith
40+ , partialContentWith
38−, multiStatus
41+ , multiStatus
39−, multiStatusWith
42+ , multiStatusWith
40−, alreadyReported
43+ , alreadyReported
41−, alreadyReportedWith
44+ , alreadyReportedWith
42−, imUsed
45+ , imUsed
43−, imUsedWith
46+ , imUsedWith
44−, multipleChoices
47+ , multipleChoices
45−, multipleChoicesWith
48+ , multipleChoicesWith
46−, movedPermanently
49+ , movedPermanently
47−, movedPermanentlyWith
50+ , movedPermanentlyWith
48−, found
51+ , found
49−, foundWith
52+ , foundWith
50−, seeOther
53+ , seeOther
51−, seeOtherWith
54+ , seeOtherWith
52−, notModified
55+ , notModified
53−, notModifiedWith
56+ , notModifiedWith
54−, useProxy
57+ , useProxy
55−, useProxyWith
58+ , useProxyWith
56−, temporaryRedirect
59+ , temporaryRedirect
57−, temporaryRedirectWith
60+ , temporaryRedirectWith
58−, permanentRedirect
61+ , permanentRedirect
59−, permanentRedirectWith
62+ , permanentRedirectWith
60−, badRequest
63+ , badRequest
61−, badRequestWith
64+ , badRequestWith
62−, unauthorized
65+ , unauthorized
63−, unauthorizedWith
66+ , unauthorizedWith
64−, paymentRequired
67+ , paymentRequired
65−, paymentRequiredWith
68+ , paymentRequiredWith
66−, forbidden
69+ , forbidden
67−, forbiddenWith
70+ , forbiddenWith
68−, notFound
71+ , notFound
69−, notFoundWith
72+ , notFoundWith
70−, methodNotAllowed
73+ , methodNotAllowed
71−, methodNotAllowedWith
74+ , methodNotAllowedWith
72−, notAcceptable
75+ , notAcceptable
73−, notAcceptableWith
76+ , notAcceptableWith
74−, proxyAuthenticationRequired
77+ , proxyAuthenticationRequired
75−, proxyAuthenticationRequiredWith
78+ , proxyAuthenticationRequiredWith
76−, requestTimeout
79+ , requestTimeout
77−, requestTimeoutWith
80+ , requestTimeoutWith
78−, conflict
81+ , conflict
79−, conflictWith
82+ , conflictWith
80−, gone
83+ , gone
81−, goneWith
84+ , goneWith
82−, lengthRequired
85+ , lengthRequired
83−, lengthRequiredWith
86+ , lengthRequiredWith
84−, preconditionFailed
87+ , preconditionFailed
85−, preconditionFailedWith
88+ , preconditionFailedWith
86−, payloadTooLarge
89+ , payloadTooLarge
87−, payloadTooLargeWith
90+ , payloadTooLargeWith
88−, uriTooLong
91+ , uriTooLong
89−, uriTooLongWith
92+ , uriTooLongWith
90−, unsupportedMediaType
93+ , unsupportedMediaType
91−, unsupportedMediaTypeWith
94+ , unsupportedMediaTypeWith
92−, rangeNotSatisfiable
95+ , rangeNotSatisfiable
93−, rangeNotSatisfiableWith
96+ , rangeNotSatisfiableWith
94−, expectationFailed
97+ , expectationFailed
95−, expectationFailedWith
98+ , expectationFailedWith
96−, imATeapot
99+ , imATeapot
97−, imATeapotWith
100+ , imATeapotWith
98−, misdirectedRequest
101+ , misdirectedRequest
99−, misdirectedRequestWith
102+ , misdirectedRequestWith
100−, unprocessableEntity
103+ , unprocessableEntity
101−, unprocessableEntityWith
104+ , unprocessableEntityWith
102−, locked
105+ , locked
103−, lockedWith
106+ , lockedWith
104−, failedDependency
107+ , failedDependency
105−, failedDependencyWith
108+ , failedDependencyWith
106−, tooEarly
109+ , tooEarly
107−, tooEarlyWith
110+ , tooEarlyWith
108−, upgradeRequired
111+ , upgradeRequired
109−, upgradeRequiredWith
112+ , upgradeRequiredWith
110−, preconditionRequired
113+ , preconditionRequired
111−, preconditionRequiredWith
114+ , preconditionRequiredWith
112−, tooManyRequests
115+ , tooManyRequests
113−, tooManyRequestsWith
116+ , tooManyRequestsWith
114−, requestHeaderFieldsTooLarge
117+ , requestHeaderFieldsTooLarge
115−, requestHeaderFieldsTooLargeWith
118+ , requestHeaderFieldsTooLargeWith
116−, unavailableForLegalReasons
119+ , unavailableForLegalReasons
117−, unavailableForLegalReasonsWith
120+ , unavailableForLegalReasonsWith
118−, internalServerError
121+ , internalServerError
119−, internalServerErrorWith
122+ , internalServerErrorWith
120−, notImplemented
123+ , notImplemented
121−, notImplementedWith
124+ , notImplementedWith
122−, badGateway
125+ , badGateway
123−, badGatewayWith
126+ , badGatewayWith
124−, serviceUnavailable
127+ , serviceUnavailable
125−, serviceUnavailableWith
128+ , serviceUnavailableWith
126−, gatewayTimeout
129+ , gatewayTimeout
127−, gatewayTimeoutWith
130+ , gatewayTimeoutWith
128−, httpVersionNotSupported
131+ , httpVersionNotSupported
129−, httpVersionNotSupportedWith
132+ , httpVersionNotSupportedWith
130−, variantAlsoNegotiates
133+ , variantAlsoNegotiates
131−, variantAlsoNegotiatesWith
134+ , variantAlsoNegotiatesWith
132−, insufficientStorage
135+ , insufficientStorage
133−, insufficientStorageWith
136+ , insufficientStorageWith
134−, loopDetected
137+ , loopDetected
135−, loopDetectedWith
138+ , loopDetectedWith
136−, notExtended
139+ , notExtended
137−, notExtendedWith
140+ , notExtendedWith
138−, networkAuthenticationRequired
141+ , networkAuthenticationRequired
139−, networkAuthenticationRequiredWith
142+ , networkAuthenticationRequiredWith
140 , module Data.Variant
143 , module Data.Variant
141 ) where
144 ) where
142
145
@@ -162,6 +165,12 @@ data Response headers body = Response
162 , body :: body
165 , body :: body
163 }
166 }
164
167
168+type ResponseBody body = Response () body
169+
170+type ResponseHeaders headers = Response headers Unit
171+
172+type EmptyResponse = Response () Unit
173+
165-- | Deprecated alias for backwards compatibility
174-- | Deprecated alias for backwards compatibility
166type ResponseData headers body = Response headers body
175type ResponseData headers body = Response headers body
167
176
@@ -315,7 +324,6 @@ respondStatusWith
315respondStatusWith headers body =
324respondStatusWith headers body =
316 Variant.inj (Proxy :: Proxy label) (Response { headers, body })
325 Variant.inj (Proxy :: Proxy label) (Response { headers, body })
317
326
318−
319-- | Construct a variant response with headers but no body
327-- | Construct a variant response with headers but no body
320-- |
328-- |
321-- | Example:
329-- | Example:
@@ -617,4 +625,3 @@ notExtendedWith = respondWith (Proxy :: Proxy "notExtended")
617networkAuthenticationRequired = respondNoHeaders @"networkAuthenticationRequired"
625networkAuthenticationRequired = respondNoHeaders @"networkAuthenticationRequired"
618
626
619networkAuthenticationRequiredWith = respondWith (Proxy :: Proxy "networkAuthenticationRequired")
627networkAuthenticationRequiredWith = respondWith (Proxy :: Proxy "networkAuthenticationRequired")
620−
src/Yoga/HTTP/API/Route/Route.purs+28−2
@@ -8,16 +8,17 @@ import Prelude
8
8
9import Data.Array as Array
9import Data.Array as Array
10import Data.Maybe (Maybe(..))
10import Data.Maybe (Maybe(..))
11−import Prim.Row (class Cons, class Lacks)
11+import Prim.Row (class Cons, class Lacks, class Union)
12import Prim.RowList (class RowToList, RowList)
12import Prim.RowList (class RowToList, RowList)
13import Prim.RowList as RL
13import Prim.RowList as RL
14import Type.Proxy (Proxy(..))
14import Type.Proxy (Proxy(..))
15import Yoga.HTTP.API.Path (class PathPattern, pathPattern)
15import Yoga.HTTP.API.Path (class PathPattern, pathPattern)
16import Yoga.HTTP.API.Route.Handler (Request, class DefaultRequestFields, class SegmentPathParams, class SegmentQueryParams)
16import Yoga.HTTP.API.Route.Handler (Request, class DefaultRequestFields, class SegmentPathParams, class SegmentQueryParams)
17−import Yoga.HTTP.API.Route.OpenAPI (class CollectOperations, class RenderHeadersSchema, renderHeadersSchema, class RenderPathParamsSchema, renderPathParamsSchema, class RenderQueryParamsSchema, renderQueryParamsSchema, class RenderRequestBodySchema, renderRequestBodySchema, class RenderVariantResponseSchemaRL, renderVariantResponseSchemaRL, class DetectSecurity, detectSecurity, class ToOpenAPI, toOpenAPIImpl)
17+import Yoga.HTTP.API.Route.OpenAPI (class CollectOperations, class RenderHeadersSchema, renderHeadersSchema, class RenderPathParamsSchema, renderPathParamsSchema, class RenderQueryParamsSchema, renderQueryParamsSchema, class RenderRequestBodySchema, renderRequestBodySchema, class RenderVariantResponseSchemaRL, renderVariantResponseSchemaRL, class DetectSecurity, detectSecurity, class ToOpenAPI, toOpenAPIImpl, class CollectSchemas, collectSchemas, class CollectVariantSchemasRL, collectVariantSchemasRL, class CollectRouteSchemas, class CollectSchemaNames, class CollectVariantSchemaNames, class CollectRouteSchemaNames)
18import Yoga.HTTP.API.Route.OpenAPIMetadata (class HasOperationMetadata, operationMetadata)
18import Yoga.HTTP.API.Route.OpenAPIMetadata (class HasOperationMetadata, operationMetadata)
19import Yoga.HTTP.API.Route.RenderMethod (class RenderMethod, renderMethod)
19import Yoga.HTTP.API.Route.RenderMethod (class RenderMethod, renderMethod)
20import Yoga.HTTP.API.Route.Response (Response, class ToResponse)
20import Yoga.HTTP.API.Route.Response (Response, class ToResponse)
21+import Foreign.Object as FObject
21import Yoga.JSON (writeJSON)
22import Yoga.JSON (writeJSON)
22
23
23data Route :: forall k. Type -> k -> Type -> Row Type -> Type
24data Route :: forall k. Type -> k -> Type -> Row Type -> Type
@@ -107,3 +108,28 @@ instance
107 , operation: toOpenAPIImpl (Proxy :: Proxy (Route method segments request resp))
108 , operation: toOpenAPIImpl (Proxy :: Proxy (Route method segments request resp))
108 }
109 }
109 ]
110 ]
111+
112+-- CollectRouteSchemas instance for Route
113+instance
114+ ( DefaultRequestFields partialRequest reqHeaders encoding
115+ , CollectSchemas encoding
116+ , RowToList userResp rl
117+ , CollectVariantSchemasRL rl
118+ ) =>
119+ CollectRouteSchemas (Route method segments (Request (Record partialRequest)) userResp) where
120+ collectRouteSchemas _ =
121+ let
122+ requestSchemas = collectSchemas (Proxy :: Proxy encoding)
123+ responseSchemas = collectVariantSchemasRL (Proxy :: Proxy rl)
124+ in
125+ FObject.union requestSchemas responseSchemas
126+
127+-- CollectRouteSchemaNames instance for Route (compile-time collision detection)
128+instance
129+ ( DefaultRequestFields partialRequest reqHeaders encoding
130+ , CollectSchemaNames encoding reqNames
131+ , RowToList userResp rl
132+ , CollectVariantSchemaNames rl respNames
133+ , Union reqNames respNames names
134+ ) =>
135+ CollectRouteSchemaNames (Route method segments (Request (Record partialRequest)) userResp) names
test-compile-fail/cases/SchemaNameCollision.pursnew file+21
@@ -0,0 +1,21 @@
1+-- EXPECT: Could not match type
2+module Test.CompileFail.SchemaNameCollision where
3+
4+import Yoga.HTTP.API.Path (Path, Lit)
5+import Yoga.HTTP.API.Route.Encoding (JSON)
6+import Yoga.HTTP.API.Route.Handler (Request)
7+import Yoga.HTTP.API.Route.Method (GET, POST)
8+import Yoga.HTTP.API.Route.OpenAPIMetadata (Schema)
9+import Yoga.HTTP.API.Route.OpenAPI (buildOpenAPISpec, OpenAPISpec)
10+import Yoga.HTTP.API.Route.Route (Route)
11+
12+type UserV1 = { id :: Int, name :: String }
13+type UserV2 = { id :: Int, email :: String, age :: Int }
14+
15+type CollisionAPI =
16+ { getUser :: Route GET (Path (Lit "users")) (Request {}) (ok :: { body :: Schema "User" UserV1 })
17+ , createUser :: Route POST (Path (Lit "users")) (Request { body :: JSON (Schema "User" UserV2) }) (created :: { body :: Schema "User" UserV2 })
18+ }
19+
20+spec :: OpenAPISpec
21+spec = buildOpenAPISpec @CollisionAPI { title: "Test", version: "1.0.0" }
test/SchemaComponentTest.Spec.pursnew file+56
@@ -0,0 +1,56 @@
1+module SchemaComponentTest.Spec where
2+
3+import Prelude
4+
5+import Data.String as String
6+import Effect (Effect)
7+import Yoga.HTTP.API.Path (Path, Lit, type (:), type (/))
8+import Yoga.HTTP.API.Route (GET, POST, Route, Request, JSON, Schema, buildOpenAPISpec)
9+import Yoga.JSON (writeJSON)
10+import ViTest (ViTest, describe, test)
11+import ViTest.Expect (expectToBe)
12+
13+type User = { id :: Int, name :: String }
14+type Post = { id :: Int, title :: String, authorId :: Int }
15+
16+type SchemaAPI =
17+ { getUser ::
18+ Route GET ("users" / "id" : Int)
19+ (Request {})
20+ (ok :: { body :: Schema "User" User })
21+ , createUser ::
22+ Route POST "users"
23+ (Request { body :: JSON (Schema "User" User) })
24+ (created :: { body :: Schema "User" User })
25+ , listPosts :: Route GET (Path (Lit "posts")) (Request {}) (ok :: { body :: Array (Schema "Post" Post) })
26+ }
27+
28+testSchemaComponents :: Effect ViTest
29+testSchemaComponents = describe "Schema Components" do
30+ _ <- test "generates $ref in response body" do
31+ let
32+ spec = buildOpenAPISpec @SchemaAPI { title: "Test", version: "1.0.0" }
33+ json = writeJSON spec
34+ expectToBe true (String.contains (String.Pattern "\"$ref\":\"#/components/schemas/User\"") json)
35+
36+ _ <- test "generates schema definition in components" do
37+ let
38+ spec = buildOpenAPISpec @SchemaAPI { title: "Test", version: "1.0.0" }
39+ json = writeJSON spec
40+ expectToBe true (String.contains (String.Pattern "components") json)
41+ expectToBe true (String.contains (String.Pattern "\"schemas\"") json)
42+
43+ _ <- test "defines User schema with properties" do
44+ let
45+ spec = buildOpenAPISpec @SchemaAPI { title: "Test", version: "1.0.0" }
46+ json = writeJSON spec
47+ -- Schema should be in components, not inline
48+ expectToBe true (String.contains (String.Pattern "\"User\"") json)
49+ expectToBe true (String.contains (String.Pattern "\"id\"") json)
50+ expectToBe true (String.contains (String.Pattern "\"name\"") json)
51+
52+ test "collects nested schemas from arrays" do
53+ let
54+ spec = buildOpenAPISpec @SchemaAPI { title: "Test", version: "1.0.0" }
55+ json = writeJSON spec
56+ expectToBe true (String.contains (String.Pattern "\"Post\"") json)
test/Test.Operators.purs+3−1
@@ -8,6 +8,7 @@ import ParserTest.Spec as ParserTest
8import VariantResponseTest.Spec as VariantResponseTest
8import VariantResponseTest.Spec as VariantResponseTest
9import MetadataValidationTest.Spec as MetadataValidationTest
9import MetadataValidationTest.Spec as MetadataValidationTest
10import APIRecordTest.Spec as APIRecordTest
10import APIRecordTest.Spec as APIRecordTest
11+import SchemaComponentTest.Spec as SchemaComponentTest
11
12
12spec :: Effect ViTest
13spec :: Effect ViTest
13spec = do
14spec = do
@@ -36,7 +37,8 @@ spec = do
36 _ <- APIRecordTest.testCollectOperations
37 _ <- APIRecordTest.testCollectOperations
37 _ <- APIRecordTest.testOperationIds
38 _ <- APIRecordTest.testOperationIds
38 _ <- APIRecordTest.testBuildOpenAPISpec
39 _ <- APIRecordTest.testBuildOpenAPISpec
39− APIRecordTest.testAPIHandlers
40+ _ <- APIRecordTest.testAPIHandlers
41+ SchemaComponentTest.testSchemaComponents
40
42
41main :: ViTest
43main :: ViTest
42main = viTest spec
44main = viTest spec