packages feed

acolyte-openapi (empty) → 0.1.0.0

raw patch · 9 files changed

+1506/−0 lines, 9 filesdep +acolyte-coredep +acolyte-openapidep +aeson

Dependencies added: acolyte-core, acolyte-openapi, aeson, base, bytestring, containers, http-types, text

Files

+ CHANGELOG.md view
@@ -0,0 +1,7 @@+# Revision history for acolyte-openapi++## 0.1.0.0 -- 2026-04-27++* Initial release. Generates OpenAPI 3.1 (and 2.0/Swagger) documents+  from acolyte-core API types, so the spec stays in lockstep with+  the running server and client.
+ LICENSE view
@@ -0,0 +1,27 @@+Copyright (c) 2024-2026, Josh Burgess++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice,+   this list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright notice,+   this list of conditions and the following disclaimer in the documentation+   and/or other materials provided with the distribution.++3. Neither the name of the copyright holder nor the names of its+   contributors may be used to endorse or promote products derived from this+   software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE+LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR+CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF+SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS+INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN+CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)+ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+POSSIBILITY OF SUCH DAMAGE.
+ acolyte-openapi.cabal view
@@ -0,0 +1,87 @@+cabal-version:   3.0+name:            acolyte-openapi+version:         0.1.0.0+synopsis:        OpenAPI 3.1 spec generation from acolyte API types+category:        Web+description:+  Generates OpenAPI specifications from the same API type that drives+  the server and client. One type, three interpretations.++license:         BSD-3-Clause+license-file:    LICENSE+author:          Josh Burgess+maintainer:      Josh Burgess <joshburgess.webdev@gmail.com>+homepage:        https://github.com/joshburgess/acolyte+bug-reports:     https://github.com/joshburgess/acolyte/issues+build-type:      Simple++extra-doc-files:+  CHANGELOG.md++library+  exposed-modules:+    Acolyte.OpenApi+    Acolyte.OpenApi.Spec+    Acolyte.OpenApi.Schema+    Acolyte.OpenApi.V2+    Acolyte.OpenApi.V3++  build-depends:+      base                    >= 4.20 && < 5+    , acolyte-core            >= 0.1  && < 0.2+    , aeson                   >= 2.1  && < 2.3+    , bytestring              >= 0.11 && < 0.13+    , text                    >= 2.0  && < 2.2+    , http-types              >= 0.12 && < 0.13+    , containers              >= 0.6  && < 0.8++  hs-source-dirs: src+  default-language: GHC2024+  default-extensions:+    DataKinds+    GADTs+    TypeFamilies+    TypeOperators+    OverloadedStrings+    AllowAmbiguousTypes+    UndecidableInstances+    ConstraintKinds+    ScopedTypeVariables+    MultiParamTypeClasses+    FlexibleInstances+    FlexibleContexts+    StandaloneKindSignatures+    DefaultSignatures+    DeriveGeneric+    StrictData++  ghc-options: -Wall -funbox-strict-fields++test-suite spec+  type: exitcode-stdio-1.0+  main-is: Main.hs+  hs-source-dirs: test+  default-language: GHC2024+  default-extensions:+    DataKinds+    TypeFamilies+    TypeOperators+    OverloadedStrings+    AllowAmbiguousTypes+    ScopedTypeVariables+    DeriveGeneric+    StrictData++  ghc-options: -Wall -rtsopts "-with-rtsopts=-K1K"++  build-depends:+      base                    >= 4.20 && < 5+    , acolyte-openapi          >= 0.1  && < 0.2+    , acolyte-core             >= 0.1  && < 0.2+    , aeson                   >= 2.1  && < 2.3+    , bytestring              >= 0.11 && < 0.13+    , text                    >= 2.0  && < 2.2++source-repository head+  type:     git+  location: https://github.com/joshburgess/acolyte.git
+ src/Acolyte/OpenApi.hs view
@@ -0,0 +1,42 @@+-- | @acolyte-openapi@ — OpenAPI spec generation.+--+-- Supports both Swagger 2.0 and OpenAPI 3.1 from the same API type.+--+-- @+-- -- OpenAPI 3.1 (default)+-- spec3 = generateSpec @MyAPI "My API" "1.0.0"+--+-- -- Swagger 2.0+-- spec2 = generateSwagger @MyAPI "My API" "1.0.0" "localhost:3000" "/"+-- @+module Acolyte.OpenApi+  ( -- * OpenAPI 3.1 (default)+    OpenApiSpec (..)+  , generateSpec++    -- * OpenAPI 3.1 (explicit)+  , OpenApi3Spec (..)+  , generateOpenApi3++    -- * Swagger / OpenAPI 2.0+  , SwaggerSpec (..)+  , generateSwagger++    -- * Shared: per-endpoint+  , EndpointToOperation (..)+  , Operation (..)+  , Parameter (..)++    -- * Shared: API walking+  , ApiToOperations (..)++    -- * Shared: schema+  , Schema (..)+  , schemaToJson+  , ToSchema (..)+  ) where++import Acolyte.OpenApi.Spec+import Acolyte.OpenApi.Schema+import Acolyte.OpenApi.V2+import Acolyte.OpenApi.V3
+ src/Acolyte/OpenApi/Schema.hs view
@@ -0,0 +1,201 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}+-- | JSON Schema derivation for OpenAPI.+--+-- 'ToSchema' produces a JSON Schema object for a type, used in+-- request body and response schemas in the OpenAPI spec.+--+-- For record types, use @deriving Generic@ and the default implementation:+--+-- @+-- data User = User { userName :: Text, userAge :: Int }+--   deriving (Generic)+--+-- instance ToSchema User+-- -- Produces: { "type": "object", "properties": { "userName": { "type": "string" }, "userAge": { "type": "integer" } } }+-- @+module Acolyte.OpenApi.Schema+  ( -- * Schema type+    Schema (..)+  , schemaToJson+    -- * Schema class+  , ToSchema (..)+    -- * Generic derivation helper+  , GToSchema (..)+  , GToSchemaCon (..)+  , genericToSchema+  ) where++import Data.Aeson (Value (..), object, (.=))+import qualified Data.Aeson.Key as Key+import Data.Kind (Type)+import Data.Text (Text)+import qualified Data.Text as T+import Data.Proxy (Proxy (..))+import GHC.Generics+import GHC.TypeLits (KnownSymbol, symbolVal)++import Acolyte.Core.Endpoint (Json)+++-- | A simplified JSON Schema representation.+data Schema = Schema+  { schemaType       :: !Text+  , schemaProperties :: ![(Text, Schema)]+  , schemaItems      :: !(Maybe Schema)+  , schemaRef        :: !(Maybe Text)+  , schemaOneOf      :: !(Maybe [Schema])+  , schemaEnum       :: !(Maybe [Text])+  , schemaNullable   :: !Bool+  } deriving (Show, Eq)+++-- | Convert a schema to an aeson Value.+schemaToJson :: Schema -> Value+schemaToJson s+  | Just ref <- schemaRef s = object $ ["$ref" .= ref] ++ nullableField+  | Just variants <- schemaOneOf s = object $ ["oneOf" .= map schemaToJson variants] ++ nullableField+  | Just values <- schemaEnum s = object $ ["type" .= schemaType s, "enum" .= values] ++ nullableField+  | schemaType s == "array" = object $+      ["type" .= schemaType s]+      ++ maybe [] (\items -> ["items" .= schemaToJson items]) (schemaItems s)+      ++ nullableField+  | schemaType s == "object" && not (null (schemaProperties s)) = object $+      [ "type" .= schemaType s+      , "properties" .= object+          [ Key.fromText k .= schemaToJson v | (k, v) <- schemaProperties s ]+      ] ++ nullableField+  | otherwise = object $ ["type" .= schemaType s] ++ nullableField+  where+    nullableField = if schemaNullable s then ["nullable" .= True] else []+++-- | Derive a JSON Schema for a type.+--+-- For record types with a 'Generic' instance, the default implementation+-- uses 'genericToSchema' to produce an object schema with properties+-- derived from field names:+--+-- @+-- data User = User { userName :: Text, userAge :: Int }+--   deriving (Generic)+--+-- instance ToSchema User+-- @+class ToSchema a where+  toSchema :: Schema+  default toSchema :: (Generic a, GToSchema (Rep a)) => Schema+  toSchema = genericToSchema @a+++-- | Derive a 'ToSchema' instance from a type's 'Generic' representation.+--+-- Produces an object schema with properties extracted from record+-- selectors. Field names become property keys, field types become+-- property schemas (via their own 'ToSchema' instances).+genericToSchema :: forall a. (Generic a, GToSchema (Rep a)) => Schema+genericToSchema = gToSchemaFull @(Rep a)+++-- | Walk a Generic representation to extract (fieldName, schema) pairs.+class GToSchema (f :: Type -> Type) where+  gToSchema :: [(Text, Schema)]+  gToSchemaFull :: Schema+  gToSchemaFull = Schema "object" (gToSchema @f) Nothing Nothing Nothing Nothing False++-- Metadata wrapper (datatype info) — delegate to inner+instance GToSchema f => GToSchema (D1 meta f) where+  gToSchema = gToSchema @f+  gToSchemaFull = gToSchemaFull @f++-- Constructor wrapper — delegate to inner+instance GToSchema f => GToSchema (C1 meta f) where+  gToSchema = gToSchema @f+  gToSchemaFull = gToSchemaFull @f++-- Product: combine left and right fields+instance (GToSchema f, GToSchema g) => GToSchema (f :*: g) where+  gToSchema = gToSchema @f ++ gToSchema @g++-- Record selector with a named field+instance (KnownSymbol name, ToSchema t)+  => GToSchema (S1 ('MetaSel ('Just name) su ss ds) (Rec0 t)) where+    gToSchema = [(T.pack (symbolVal (Proxy @name)), toSchema @t)]++-- No fields (unit constructor)+instance GToSchema U1 where+  gToSchema = []++-- Sum types — produce oneOf schema with tagged variants+instance (GToSchemaCon (f :+: g)) => GToSchema (f :+: g) where+  gToSchema = []+  gToSchemaFull = Schema "object" [] Nothing Nothing (Just (gToSchemaCon @(f :+: g))) Nothing False+++-- ===================================================================+-- Sum type constructor schemas+-- ===================================================================++-- | Per-constructor schema (for oneOf in sum types).+class GToSchemaCon (f :: Type -> Type) where+  gToSchemaCon :: [Schema]++instance (GToSchemaCon f, GToSchemaCon g) => GToSchemaCon (f :+: g) where+  gToSchemaCon = gToSchemaCon @f ++ gToSchemaCon @g++instance (KnownSymbol name, GToSchema f)+  => GToSchemaCon (C1 ('MetaCons name fix rec) f) where+  gToSchemaCon =+    let props = gToSchema @f+        tagProp = ("tag", Schema "string" [] Nothing Nothing Nothing+                    (Just [T.pack (symbolVal (Proxy @name))]) False)+    in [Schema "object" (tagProp : props) Nothing Nothing Nothing Nothing False]+++-- ===================================================================+-- Primitive instances+-- ===================================================================++instance ToSchema Int where+  toSchema = Schema "integer" [] Nothing Nothing Nothing Nothing False++instance ToSchema Integer where+  toSchema = Schema "integer" [] Nothing Nothing Nothing Nothing False++instance ToSchema Double where+  toSchema = Schema "number" [] Nothing Nothing Nothing Nothing False++instance ToSchema Float where+  toSchema = Schema "number" [] Nothing Nothing Nothing Nothing False++instance ToSchema Bool where+  toSchema = Schema "boolean" [] Nothing Nothing Nothing Nothing False++instance ToSchema Text where+  toSchema = Schema "string" [] Nothing Nothing Nothing Nothing False++instance ToSchema String where+  toSchema = Schema "string" [] Nothing Nothing Nothing Nothing False++instance ToSchema () where+  toSchema = Schema "object" [] Nothing Nothing Nothing Nothing False++instance ToSchema a => ToSchema [a] where+  toSchema = Schema "array" [] (Just (toSchema @a)) Nothing Nothing Nothing False++instance ToSchema a => ToSchema (Maybe a) where+  toSchema = (toSchema @a) { schemaNullable = True }++instance (ToSchema a, ToSchema b) => ToSchema (Either a b) where+  toSchema = Schema "object" [] Nothing Nothing (Just [toSchema @a, toSchema @b]) Nothing False++instance ToSchema a => ToSchema (Json a) where+  toSchema = toSchema @a
+ src/Acolyte/OpenApi/Spec.hs view
@@ -0,0 +1,422 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE UndecidableInstances #-}+-- | OpenAPI 3.1 spec generation from API types.+module Acolyte.OpenApi.Spec+  ( -- * Spec generation+    OpenApiSpec (..)+  , generateSpec+    -- * Per-endpoint generation+  , EndpointToOperation (..)+  , Operation (..)+  , Parameter (..)+    -- * API walking+  , ApiToOperations (..)+    -- * Capture name reflection+  , KnownCaptureName (..)+    -- * Helpers+  , opMethodLower+  ) where++import Data.Aeson (Value (..), object, (.=), ToJSON (..))+import qualified Data.Aeson.Key as Key+import Data.Kind (Type)+import Data.Proxy (Proxy (..))+import Data.Text (Text)+import qualified Data.Text as T+import GHC.TypeLits (KnownSymbol, KnownNat, symbolVal, natVal)+import Network.HTTP.Types (Method)++import Acolyte.Core.Method (KnownMethod, methodVal)+import qualified Acolyte.Core.Method as Core+import Acolyte.Core.Path (PathSegment (..))+import Acolyte.Core.Endpoint (Endpoint, NoBody)+import Acolyte.Core.Effect (Requires)+import Data.Typeable (Typeable, typeRep)+import Acolyte.Core.Wrapper+  ( Describe, Description, Named, Versioned, ApiVersion (..)+  , WithParams, QP, WithHeaders, HH+  , ServerStream, ClientStream, BidiStream, RespondsWith+  )+import Acolyte.OpenApi.Schema (Schema (..), ToSchema (..), schemaToJson)+++-- | A complete OpenAPI 3.1 spec.+data OpenApiSpec = OpenApiSpec+  { specTitle   :: !Text+  , specVersion :: !Text+  , specOps     :: ![Operation]+  } deriving (Show)++instance ToJSON OpenApiSpec where+  toJSON spec = object+    [ "openapi" .= ("3.1.0" :: Text)+    , "info" .= object+        [ "title"   .= specTitle spec+        , "version" .= specVersion spec+        ]+    , "paths" .= groupByPath (specOps spec)+    ]+++groupByPath :: [Operation] -> Value+groupByPath ops = object+  [ Key.fromText (opPath op) .= object [Key.fromText (opMethodLower op) .= opToJson op]+  | op <- ops+  ]+++opToJson :: Operation -> Value+opToJson op = object $ concat+  [ case opOperationId op of+      Nothing  -> []+      Just oid -> ["operationId" .= oid]+  , case opSummary op of+      Nothing -> []+      Just s  -> ["summary" .= s]+  , case opDescription op of+      Nothing -> []+      Just d  -> ["description" .= d]+  , [ "responses" .= object+        [ Key.fromText (T.pack (show (opStatusCode op))) .= responseObj ]+    ]+  , if null (opParameters op) then []+    else ["parameters" .= map paramToJson (opParameters op)]+  , case opRequestBody op of+      Nothing -> []+      Just schema ->+        [ "requestBody" .= object+            [ "required" .= True+            , "content" .= object+                [ "application/json" .= object+                    [ "schema" .= schemaToJson schema ]+                ]+            ]+        ]+  ]+  where+    responseObj = case opResponseSchema op of+      Nothing -> object ["description" .= ("Success" :: Text)]+      Just schema -> object+        [ "description" .= ("Success" :: Text)+        , "content" .= object+            [ "application/json" .= object+                [ "schema" .= schemaToJson schema ]+            ]+        ]+++-- | A single API operation.+data Operation = Operation+  { opMethod         :: !Text+  , opPath           :: !Text+  , opOperationId    :: !(Maybe Text)+  , opSummary        :: !(Maybe Text)+  , opDescription    :: !(Maybe Text)+  , opParameters     :: ![Parameter]+  , opStatusCode     :: !Int+  , opResponseSchema :: !(Maybe Schema)+  , opRequestBody    :: !(Maybe Schema)+  } deriving (Show)++-- | Return the operation's HTTP method in lowercase (e.g. @"get"@, @"post"@).+opMethodLower :: Operation -> Text+opMethodLower = T.toLower . opMethod+++-- | An API parameter.+data Parameter = Parameter+  { paramName     :: !Text+  , paramIn       :: !Text+  , paramRequired :: !Bool+  , paramSchema   :: !Schema+  } deriving (Show)++paramToJson :: Parameter -> Value+paramToJson p = object+  [ "name"     .= paramName p+  , "in"       .= paramIn p+  , "required" .= paramRequired p+  , "schema"   .= schemaToJson (paramSchema p)+  ]+++-- ===================================================================+-- Per-endpoint operation generation+-- ===================================================================++-- | Convert an endpoint type into an OpenAPI 'Operation'.+class EndpointToOperation endpoint where+  toOperation :: Operation++-- GET (no request body)+instance (KnownMethod m, ReflectPathOA path, m ~ 'Core.GET, ToSchema resp)+  => EndpointToOperation (Endpoint m path NoBody resp) where+    toOperation = Operation+      { opMethod         = T.pack (show (methodVal @m))+      , opPath           = reflectOAPath @path+      , opOperationId    = Nothing+      , opSummary        = Nothing+      , opDescription    = Nothing+      , opParameters     = reflectOAParams @path+      , opStatusCode     = 200+      , opResponseSchema = Just (toSchema @resp)+      , opRequestBody    = Nothing+      }++-- DELETE (no request body)+instance (ReflectPathOA path, ToSchema resp)+  => EndpointToOperation (Endpoint 'Core.DELETE path NoBody resp) where+    toOperation = Operation+      { opMethod         = "DELETE"+      , opPath           = reflectOAPath @path+      , opOperationId    = Nothing+      , opSummary        = Nothing+      , opDescription    = Nothing+      , opParameters     = reflectOAParams @path+      , opStatusCode     = 200+      , opResponseSchema = Just (toSchema @resp)+      , opRequestBody    = Nothing+      }++-- POST (with request body)+instance (ReflectPathOA path, ToSchema req, ToSchema resp)+  => EndpointToOperation (Endpoint 'Core.POST path req resp) where+    toOperation = Operation+      { opMethod         = "POST"+      , opPath           = reflectOAPath @path+      , opOperationId    = Nothing+      , opSummary        = Nothing+      , opDescription    = Nothing+      , opParameters     = reflectOAParams @path+      , opStatusCode     = 201+      , opResponseSchema = Just (toSchema @resp)+      , opRequestBody    = Just (toSchema @req)+      }++-- PUT (with request body)+instance (ReflectPathOA path, ToSchema req, ToSchema resp)+  => EndpointToOperation (Endpoint 'Core.PUT path req resp) where+    toOperation = Operation+      { opMethod         = "PUT"+      , opPath           = reflectOAPath @path+      , opOperationId    = Nothing+      , opSummary        = Nothing+      , opDescription    = Nothing+      , opParameters     = reflectOAParams @path+      , opStatusCode     = 200+      , opResponseSchema = Just (toSchema @resp)+      , opRequestBody    = Just (toSchema @req)+      }++-- PATCH (with request body)+instance (ReflectPathOA path, ToSchema req, ToSchema resp)+  => EndpointToOperation (Endpoint 'Core.PATCH path req resp) where+    toOperation = Operation+      { opMethod         = "PATCH"+      , opPath           = reflectOAPath @path+      , opOperationId    = Nothing+      , opSummary        = Nothing+      , opDescription    = Nothing+      , opParameters     = reflectOAParams @path+      , opStatusCode     = 200+      , opResponseSchema = Just (toSchema @resp)+      , opRequestBody    = Just (toSchema @req)+      }++-- Requires delegates+instance EndpointToOperation inner+  => EndpointToOperation (Requires e inner) where+    toOperation = toOperation @inner++-- Describe extracts the endpoint summary from the type-level description+instance (KnownSymbol desc, EndpointToOperation inner)+  => EndpointToOperation (Describe desc inner) where+    toOperation =+      let op = toOperation @inner+      in op { opSummary = Just (T.pack (symbolVal (Proxy @desc))) }++-- Description sets the operation description (longer text, distinct from summary)+instance (KnownSymbol desc, EndpointToOperation inner)+  => EndpointToOperation (Description desc inner) where+    toOperation =+      let op = toOperation @inner+      in op { opDescription = Just (T.pack (symbolVal (Proxy @desc))) }++-- WithParams reflects query parameters into the operation+instance (ReflectParams ps, EndpointToOperation inner)+  => EndpointToOperation (WithParams ps inner) where+    toOperation =+      let op = toOperation @inner+      in op { opParameters = opParameters op ++ reflectParams @ps }++-- WithHeaders reflects header parameters into the operation+instance (ReflectHeaders hs, EndpointToOperation inner)+  => EndpointToOperation (WithHeaders hs inner) where+    toOperation =+      let op = toOperation @inner+      in op { opParameters = opParameters op ++ reflectHeaders @hs }++-- ServerStream delegates (streaming marker)+instance EndpointToOperation inner+  => EndpointToOperation (ServerStream inner) where+    toOperation = toOperation @inner++-- ClientStream delegates (streaming marker)+instance EndpointToOperation inner+  => EndpointToOperation (ClientStream inner) where+    toOperation = toOperation @inner++-- BidiStream delegates (streaming marker)+instance EndpointToOperation inner+  => EndpointToOperation (BidiStream inner) where+    toOperation = toOperation @inner++-- RespondsWith extracts the status code from the type-level Nat+instance (KnownNat s, EndpointToOperation inner)+  => EndpointToOperation (RespondsWith s inner) where+    toOperation =+      let op = toOperation @inner+      in op { opStatusCode = fromIntegral (natVal (Proxy @s)) }++-- Named sets operationId from the type-level name+instance (KnownSymbol name, EndpointToOperation inner)+  => EndpointToOperation (Named name inner) where+    toOperation =+      let op = toOperation @inner+      in op { opOperationId = Just (T.pack (symbolVal (Proxy @name))) }++-- Versioned prepends the version prefix to the path+instance (ApiVersion v, EndpointToOperation inner)+  => EndpointToOperation (Versioned v inner) where+    toOperation =+      let op = toOperation @inner+      in op { opPath = "/" <> versionPrefix @v <> opPath op }+++-- ===================================================================+-- Query parameter reflection+-- ===================================================================++-- | Reflect type-level query parameter declarations into runtime Parameter values.+class ReflectParams (ps :: [Type]) where+  reflectParams :: [Parameter]++instance ReflectParams '[] where+  reflectParams = []++instance (KnownSymbol name, ReflectParams rest)+  => ReflectParams (QP name a ': rest) where+    reflectParams = Parameter+      { paramName     = T.pack (symbolVal (Proxy @name))+      , paramIn       = "query"+      , paramRequired = False+      , paramSchema   = Schema "string" [] Nothing Nothing Nothing Nothing False+      } : reflectParams @rest+++-- ===================================================================+-- Header parameter reflection+-- ===================================================================++-- | Reflect type-level header declarations into runtime Parameter values.+class ReflectHeaders (hs :: [Type]) where+  reflectHeaders :: [Parameter]++instance ReflectHeaders '[] where+  reflectHeaders = []++instance (KnownSymbol name, ReflectHeaders rest)+  => ReflectHeaders (HH name a ': rest) where+    reflectHeaders = Parameter+      { paramName     = T.pack (symbolVal (Proxy @name))+      , paramIn       = "header"+      , paramRequired = True+      , paramSchema   = Schema "string" [] Nothing Nothing Nothing Nothing False+      } : reflectHeaders @rest+++-- ===================================================================+-- Capture name reflection+-- ===================================================================++-- | Derive a parameter name for a capture type.+-- Override this for custom names; the default lowercases the type name.+class KnownCaptureName (t :: Type) where+  captureName :: Text++instance {-# OVERLAPPABLE #-} Typeable t => KnownCaptureName t where+  captureName = T.toLower (T.pack (show (typeRep (Proxy @t))))+++-- ===================================================================+-- Path reflection for OpenAPI format+-- ===================================================================++class ReflectPathOA (path :: [PathSegment]) where+  reflectOAPath   :: Text+  reflectOAParams :: [Parameter]++instance ReflectPathOA '[] where+  reflectOAPath   = ""+  reflectOAParams = []++instance (KnownSymbol s, ReflectPathOA rest)+  => ReflectPathOA ('Lit s ': rest) where+    reflectOAPath = "/" <> T.pack (symbolVal (Proxy @s)) <> reflectOAPath @rest+    reflectOAParams = reflectOAParams @rest++instance (KnownCaptureName t, ToSchema t, ReflectPathOA rest)+  => ReflectPathOA ('Capture t ': rest) where+    reflectOAPath = "/{" <> captureName @t <> "}" <> reflectOAPath @rest+    reflectOAParams = Parameter+      { paramName     = captureName @t+      , paramIn       = "path"+      , paramRequired = True+      , paramSchema   = toSchema @t+      } : reflectOAParams @rest++instance (KnownSymbol name, ToSchema t, ReflectPathOA rest)+  => ReflectPathOA ('CaptureNamed name t ': rest) where+    reflectOAPath = "/{" <> T.pack (symbolVal (Proxy @name)) <> "}" <> reflectOAPath @rest+    reflectOAParams = Parameter+      { paramName     = T.pack (symbolVal (Proxy @name))+      , paramIn       = "path"+      , paramRequired = True+      , paramSchema   = toSchema @t+      } : reflectOAParams @rest+++-- ===================================================================+-- Walk an API type list+-- ===================================================================++-- | Walk a promoted list of endpoint types, collecting their 'Operation's.+class ApiToOperations (api :: [Type]) where+  toOperations :: [Operation]++instance ApiToOperations '[] where+  toOperations = []++instance (EndpointToOperation e, ApiToOperations rest)+  => ApiToOperations (e ': rest) where+    toOperations = toOperation @e : toOperations @rest+++-- ===================================================================+-- Top-level spec generation+-- ===================================================================++-- | Generate a complete OpenAPI 3.1 spec from an API type, title, and version.+generateSpec+  :: forall api. ApiToOperations api+  => Text -> Text -> OpenApiSpec+generateSpec title version = OpenApiSpec+  { specTitle   = title+  , specVersion = version+  , specOps     = toOperations @api+  }
+ src/Acolyte/OpenApi/V2.hs view
@@ -0,0 +1,137 @@+-- | Swagger / OpenAPI 2.0 spec rendering.+--+-- Generates a Swagger 2.0 JSON document from the same internal+-- 'Operation' representation that OpenAPI 3.x uses. The type-level+-- API walking is shared; only the JSON format differs.+--+-- @+-- import Acolyte.OpenApi.V2 (generateSwagger)+--+-- spec = generateSwagger @MyAPI "My API" "1.0.0" "localhost" "/api"+-- @+module Acolyte.OpenApi.V2+  ( -- * Swagger 2.0 spec+    SwaggerSpec (..)+  , generateSwagger+  ) where++import Data.Aeson (Value (..), object, (.=), ToJSON (..))+import qualified Data.Aeson.Key as Key+import Data.Kind (Type)+import Data.Text (Text)+import qualified Data.Text as T++import Acolyte.OpenApi.Spec+  ( Operation (..), Parameter (..), ApiToOperations (..)+  , opMethodLower+  )+import Acolyte.OpenApi.Schema (Schema (..), schemaToJson)+++-- | A Swagger 2.0 spec.+data SwaggerSpec = SwaggerSpec+  { swaggerTitle    :: !Text+  , swaggerVersion  :: !Text+  , swaggerHost     :: !Text+  , swaggerBasePath :: !Text+  , swaggerOps      :: ![Operation]+  } deriving (Show)++instance ToJSON SwaggerSpec where+  toJSON spec = object+    [ "swagger" .= ("2.0" :: Text)+    , "info" .= object+        [ "title"   .= swaggerTitle spec+        , "version" .= swaggerVersion spec+        ]+    , "host"     .= swaggerHost spec+    , "basePath" .= swaggerBasePath spec+    , "schemes"  .= (["https", "http"] :: [Text])+    , "consumes" .= (["application/json"] :: [Text])+    , "produces" .= (["application/json"] :: [Text])+    , "paths"    .= swaggerPaths (swaggerOps spec)+    ]+++-- | Group operations by path, Swagger 2.0 format.+swaggerPaths :: [Operation] -> Value+swaggerPaths ops = object+  [ Key.fromText (opPath op) .= object+      [ Key.fromText (opMethodLower op) .= swaggerOperation op ]+  | op <- ops+  ]+++-- | Render a single operation in Swagger 2.0 format.+--+-- Swagger 2.0 differences from OpenAPI 3.x:+-- * Parameters include body params (not a separate requestBody)+-- * Responses use a simpler schema format+-- * No content negotiation per-operation+swaggerOperation :: Operation -> Value+swaggerOperation op = object $ concat+  [ case opOperationId op of+      Nothing  -> []+      Just oid -> ["operationId" .= oid]+  , case opSummary op of+      Nothing -> []+      Just s  -> ["summary" .= s]+  , case opDescription op of+      Nothing -> []+      Just d  -> ["description" .= d]+  , [ "responses" .= object+        [ Key.fromText (T.pack (show (opStatusCode op))) .= responseObj ]+    ]+  , let allParams = map swaggerParam (opParameters op)+          ++ bodyParam (opRequestBody op)+    in if null allParams then []+       else ["parameters" .= allParams]+  ]+  where+    responseObj = case opResponseSchema op of+      Nothing -> object ["description" .= ("Success" :: Text)]+      Just schema -> object+        [ "description" .= ("Success" :: Text)+        , "schema" .= schemaToJson schema+        ]++    bodyParam Nothing = []+    bodyParam (Just schema) =+      [ object+          [ "in"       .= ("body" :: Text)+          , "name"     .= ("body" :: Text)+          , "required" .= True+          , "schema"   .= schemaToJson schema+          ]+      ]+++-- | Render a path/query parameter in Swagger 2.0 format.+swaggerParam :: Parameter -> Value+swaggerParam p = object+  [ "name"     .= paramName p+  , "in"       .= paramIn p+  , "required" .= paramRequired p+  , "type"     .= schemaType (paramSchema p)+  ]+++-- | Generate a Swagger 2.0 spec from an API type.+--+-- @+-- spec = generateSwagger @MyAPI "My API" "1.0.0" "localhost:3000" "/api"+-- @+generateSwagger+  :: forall api. ApiToOperations api+  => Text    -- ^ Title+  -> Text    -- ^ Version+  -> Text    -- ^ Host (e.g., "localhost:3000")+  -> Text    -- ^ Base path (e.g., "/api" or "/")+  -> SwaggerSpec+generateSwagger title version host basePath = SwaggerSpec+  { swaggerTitle    = title+  , swaggerVersion  = version+  , swaggerHost     = host+  , swaggerBasePath = basePath+  , swaggerOps      = toOperations @api+  }
+ src/Acolyte/OpenApi/V3.hs view
@@ -0,0 +1,121 @@+-- | OpenAPI 3.1 spec rendering.+--+-- Generates an OpenAPI 3.1 JSON document from the shared internal+-- 'Operation' representation.+--+-- @+-- import Acolyte.OpenApi.V3 (generateOpenApi3)+--+-- spec = generateOpenApi3 @MyAPI "My API" "1.0.0"+-- @+module Acolyte.OpenApi.V3+  ( -- * OpenAPI 3.1 spec+    OpenApi3Spec (..)+  , generateOpenApi3+  ) where++import Data.Aeson (Value (..), object, (.=), ToJSON (..))+import qualified Data.Aeson.Key as Key+import Data.Kind (Type)+import Data.Text (Text)+import qualified Data.Text as T++import Acolyte.OpenApi.Spec+  ( Operation (..), Parameter (..), ApiToOperations (..)+  , opMethodLower+  )+import Acolyte.OpenApi.Schema (Schema (..), schemaToJson)+++-- | An OpenAPI 3.1 spec.+data OpenApi3Spec = OpenApi3Spec+  { oa3Title   :: !Text+  , oa3Version :: !Text+  , oa3Ops     :: ![Operation]+  } deriving (Show)++instance ToJSON OpenApi3Spec where+  toJSON spec = object+    [ "openapi" .= ("3.1.0" :: Text)+    , "info" .= object+        [ "title"   .= oa3Title spec+        , "version" .= oa3Version spec+        ]+    , "paths" .= oa3Paths (oa3Ops spec)+    ]+++-- | Group operations by path, OpenAPI 3.x format.+oa3Paths :: [Operation] -> Value+oa3Paths ops = object+  [ Key.fromText (opPath op) .= object+      [ Key.fromText (opMethodLower op) .= oa3Operation op ]+  | op <- ops+  ]+++-- | Render a single operation in OpenAPI 3.x format.+--+-- OpenAPI 3.x differences from Swagger 2.0:+-- * requestBody is a separate field (not a body parameter)+-- * Response content uses media type keys+-- * Richer content negotiation support+oa3Operation :: Operation -> Value+oa3Operation op = object $ concat+  [ case opOperationId op of+      Nothing  -> []+      Just oid -> ["operationId" .= oid]+  , case opSummary op of+      Nothing -> []+      Just s  -> ["summary" .= s]+  , case opDescription op of+      Nothing -> []+      Just d  -> ["description" .= d]+  , [ "responses" .= object+        [ Key.fromText (T.pack (show (opStatusCode op))) .= responseObj ]+    ]+  , if null (opParameters op) then []+    else ["parameters" .= map oa3Param (opParameters op)]+  , case opRequestBody op of+      Nothing -> []+      Just schema ->+        [ "requestBody" .= object+            [ "required" .= True+            , "content" .= object+                [ "application/json" .= object+                    [ "schema" .= schemaToJson schema ]+                ]+            ]+        ]+  ]+  where+    responseObj = case opResponseSchema op of+      Nothing -> object ["description" .= ("Success" :: Text)]+      Just schema -> object+        [ "description" .= ("Success" :: Text)+        , "content" .= object+            [ "application/json" .= object+                [ "schema" .= schemaToJson schema ]+            ]+        ]+++-- | Render a parameter in OpenAPI 3.x format.+oa3Param :: Parameter -> Value+oa3Param p = object+  [ "name"     .= paramName p+  , "in"       .= paramIn p+  , "required" .= paramRequired p+  , "schema"   .= schemaToJson (paramSchema p)+  ]+++-- | Generate an OpenAPI 3.1 spec from an API type.+generateOpenApi3+  :: forall api. ApiToOperations api+  => Text -> Text -> OpenApi3Spec+generateOpenApi3 title version = OpenApi3Spec+  { oa3Title   = title+  , oa3Version = version+  , oa3Ops     = toOperations @api+  }
+ test/Main.hs view
@@ -0,0 +1,462 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE TypeApplications #-}+module Main (main) where++import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Aeson as Aeson+import qualified Data.Aeson.KeyMap as KM+import qualified Data.ByteString.Lazy as LBS+import GHC.Generics (Generic)++import Acolyte.Core+import Acolyte.OpenApi+++assert :: String -> Bool -> IO ()+assert label True  = putStrLn $ "  OK: " ++ label+assert label False = error   $ "FAIL: " ++ label+++-- ===================================================================+-- API types+-- ===================================================================++type HealthPath   = '[ 'Lit "health" ]+type UsersPath    = '[ 'Lit "users" ]+type UserByIdPath = '[ 'Lit "users", 'Capture Int ]++type TestAPI =+  '[ Get  HealthPath   Text+   , Get  UsersPath    Text+   , Get  UserByIdPath Text+   , Post UsersPath    Text Text+   ]+++-- ===================================================================+-- Tests+-- ===================================================================++testGenerateSpec :: IO ()+testGenerateSpec = do+  let spec = generateSpec @TestAPI "Test API" "1.0.0"+  assert "spec title" (specTitle spec == "Test API")+  assert "spec version" (specVersion spec == "1.0.0")+  assert "spec has 4 operations" (length (specOps spec) == 4)++testOperations :: IO ()+testOperations = do+  let ops = toOperations @TestAPI+  assert "4 operations" (length ops == 4)++  let op1 = ops !! 0+  assert "op1 method GET" (opMethod op1 == "GET")+  assert "op1 path /health" (opPath op1 == "/health")+  assert "op1 no params" (null (opParameters op1))++  let op3 = ops !! 2+  assert "op3 method GET" (opMethod op3 == "GET")+  assert "op3 path /users/{int}" (opPath op3 == "/users/{int}")+  assert "op3 has path param" (length (opParameters op3) == 1)++  let param = head (opParameters op3)+  assert "param name 'int'" (paramName param == "int")+  assert "param in 'path'" (paramIn param == "path")+  assert "param required" (paramRequired param)++testJsonOutput :: IO ()+testJsonOutput = do+  let spec = generateSpec @TestAPI "Test API" "1.0.0"+      json = Aeson.toJSON spec+  -- Should produce valid JSON+  case json of+    Aeson.Object obj -> do+      assert "has openapi field" (KM.member "openapi" obj)+      assert "has info field" (KM.member "info" obj)+      assert "has paths field" (KM.member "paths" obj)+    _ -> error "FAIL: spec is not a JSON object"++testEndpointToOperation :: IO ()+testEndpointToOperation = do+  let op = toOperation @(Get UserByIdPath Text)+  assert "endpoint op: GET" (opMethod op == "GET")+  assert "endpoint op: /users/{int}" (opPath op == "/users/{int}")+  assert "endpoint op: 1 param" (length (opParameters op) == 1)+  assert "endpoint op: status 200" (opStatusCode op == 200)++  -- POST gets 201+  let op2 = toOperation @(Post UsersPath Text Text)+  assert "POST status 201" (opStatusCode op2 == 201)++testRequiresDelegate :: IO ()+testRequiresDelegate = do+  let op = toOperation @(Requires Auth (Get UserByIdPath Text))+  assert "Requires delegates: GET" (opMethod op == "GET")+  assert "Requires delegates: /users/{int}" (opPath op == "/users/{int}")++testSchema :: IO ()+testSchema = do+  assert "Int schema" (schemaType (toSchema @Int) == "integer")+  assert "Text schema" (schemaType (toSchema @Text) == "string")+  assert "Bool schema" (schemaType (toSchema @Bool) == "boolean")+  assert "[Int] schema" (schemaType (toSchema @[Int]) == "array")+++-- ===================================================================+-- Swagger 2.0 tests+-- ===================================================================++testSwagger :: IO ()+testSwagger = do+  let spec = generateSwagger @TestAPI "Test API" "1.0.0" "localhost:3000" "/api"+      json = Aeson.toJSON spec+  case json of+    Aeson.Object obj -> do+      assert "swagger: has swagger field" (KM.member "swagger" obj)+      assert "swagger: has host field" (KM.member "host" obj)+      assert "swagger: has basePath field" (KM.member "basePath" obj)+      assert "swagger: has paths field" (KM.member "paths" obj)+      assert "swagger: has consumes" (KM.member "consumes" obj)+      -- Verify swagger version+      case KM.lookup "swagger" obj of+        Just (Aeson.String v) -> assert "swagger: version 2.0" (v == "2.0")+        _ -> error "FAIL: swagger field not a string"+    _ -> error "FAIL: swagger spec is not a JSON object"++-- ===================================================================+-- OpenAPI 3.1 explicit tests+-- ===================================================================++testOpenApi3 :: IO ()+testOpenApi3 = do+  let spec = generateOpenApi3 @TestAPI "Test API" "1.0.0"+      json = Aeson.toJSON spec+  case json of+    Aeson.Object obj -> do+      assert "oa3: has openapi field" (KM.member "openapi" obj)+      assert "oa3: has paths field" (KM.member "paths" obj)+      case KM.lookup "openapi" obj of+        Just (Aeson.String v) -> assert "oa3: version 3.1.0" (v == "3.1.0")+        _ -> error "FAIL: openapi field not a string"+    _ -> error "FAIL: openapi3 spec is not a JSON object"+++-- ===================================================================+-- Named endpoint operationId tests+-- ===================================================================++testNamedOperationId :: IO ()+testNamedOperationId = do+  -- Named endpoint produces operationId+  let op = toOperation @(Named "getUser" (Get UserByIdPath Text))+  assert "Named: operationId set" (opOperationId op == Just "getUser")+  assert "Named: method delegated" (opMethod op == "GET")+  assert "Named: path delegated" (opPath op == "/users/{int}")++  -- Unnamed endpoint has no operationId+  let op2 = toOperation @(Get HealthPath Text)+  assert "Unnamed: no operationId" (opOperationId op2 == Nothing)++  -- Named + Describe stacking+  let op3 = toOperation @(Named "health" (Describe "Health check" (Get HealthPath Text)))+  assert "Named+Describe: operationId set" (opOperationId op3 == Just "health")+  assert "Named+Describe: method GET" (opMethod op3 == "GET")++  -- Named + Requires stacking+  let op4 = toOperation @(Named "secureGet" (Requires Auth (Get HealthPath Text)))+  assert "Named+Requires: operationId set" (opOperationId op4 == Just "secureGet")++testNamedApiSpec :: IO ()+testNamedApiSpec = do+  -- Full API with Named endpoints generates operationIds+  let ops = toOperations @'[ Named "listUsers" (Get UsersPath Text)+                            , Named "getUser" (Get UserByIdPath Text)+                            , Named "createUser" (Post UsersPath Text Text)+                            ]+  assert "named API: 3 operations" (length ops == 3)+  assert "named API: op1 id" (opOperationId (ops !! 0) == Just "listUsers")+  assert "named API: op2 id" (opOperationId (ops !! 1) == Just "getUser")+  assert "named API: op3 id" (opOperationId (ops !! 2) == Just "createUser")++  -- JSON output includes operationId+  let spec = generateSpec @'[ Named "health" (Get HealthPath Text) ] "Test" "1.0"+      json = Aeson.toJSON spec+      bs = LBS.toStrict (Aeson.encode json)+  assert "named spec JSON contains operationId" (T.isInfixOf "operationId" (T.pack (show bs)))+++-- ===================================================================+-- Describe test+-- ===================================================================++testDescribe :: IO ()+testDescribe = do+  let op = toOperation @(Describe "Health check" (Get HealthPath Text))+  assert "Describe: summary set" (opSummary op == Just "Health check")+  assert "Describe: method delegated" (opMethod op == "GET")+  assert "Describe: path delegated" (opPath op == "/health")+++-- ===================================================================+-- RespondsWith test+-- ===================================================================++testRespondsWith :: IO ()+testRespondsWith = do+  let op = toOperation @(RespondsWith 204 (Post (At "items") Text Text))+  assert "RespondsWith: status 204" (opStatusCode op == 204)+  assert "RespondsWith: method POST" (opMethod op == "POST")+  assert "RespondsWith: path /items" (opPath op == "/items")+++-- ===================================================================+-- WithParams test+-- ===================================================================++testWithParams :: IO ()+testWithParams = do+  let op = toOperation @(WithParams '[QP "page" Int, QP "limit" Int] (Get (At "users") Text))+  assert "WithParams: 2 query params" (length (opParameters op) == 2)+  assert "WithParams: first param 'page'" (paramName (opParameters op !! 0) == "page")+  assert "WithParams: second param 'limit'" (paramName (opParameters op !! 1) == "limit")+  assert "WithParams: params are query" (all (\p -> paramIn p == "query") (opParameters op))+++-- ===================================================================+-- WithHeaders test+-- ===================================================================++testWithHeaders :: IO ()+testWithHeaders = do+  let op = toOperation @(WithHeaders '[HH "Authorization" Text] (Get (At "users") Text))+  assert "WithHeaders: 1 header param" (length (opParameters op) == 1)+  assert "WithHeaders: header name 'Authorization'" (paramName (head (opParameters op)) == "Authorization")+  assert "WithHeaders: param in 'header'" (paramIn (head (opParameters op)) == "header")+++-- ===================================================================+-- Versioned test+-- ===================================================================++data V1+instance ApiVersion V1 where versionPrefix = "v1"++testVersionedOpenApi :: IO ()+testVersionedOpenApi = do+  let op = toOperation @(Versioned V1 (Get HealthPath Text))+  assert "Versioned: path starts with /v1" (T.isPrefixOf "/v1" (opPath op))+  assert "Versioned: full path /v1/health" (opPath op == "/v1/health")+  assert "Versioned: method delegated" (opMethod op == "GET")+++-- ===================================================================+-- Stacking wrappers test+-- ===================================================================++testStackedWrappers :: IO ()+testStackedWrappers = do+  let op = toOperation @(Named "x" (Describe "y" (WithParams '[QP "p" Int] (Get (At "z") Text))))+  assert "Stacked: operationId set" (opOperationId op == Just "x")+  assert "Stacked: summary set" (opSummary op == Just "y")+  assert "Stacked: has query param" (length (opParameters op) == 1)+  assert "Stacked: param name 'p'" (paramName (head (opParameters op)) == "p")+  assert "Stacked: method GET" (opMethod op == "GET")+  assert "Stacked: path /z" (opPath op == "/z")+++-- ===================================================================+-- Generic ToSchema derivation test+-- ===================================================================++data TestUser = TestUser { userName :: Text, userAge :: Int }+  deriving (Generic)++instance ToSchema TestUser++testGenericSchema :: IO ()+testGenericSchema = do+  let schema = toSchema @TestUser+  assert "Generic: type is object" (schemaType schema == "object")+  assert "Generic: has 2 properties" (length (schemaProperties schema) == 2)+  let props = schemaProperties schema+  assert "Generic: has userName" (any (\(k, _) -> k == "userName") props)+  assert "Generic: has userAge" (any (\(k, _) -> k == "userAge") props)+  case lookup "userName" props of+    Just s  -> assert "Generic: userName is string" (schemaType s == "string")+    Nothing -> error "FAIL: userName property missing"+  case lookup "userAge" props of+    Just s  -> assert "Generic: userAge is integer" (schemaType s == "integer")+    Nothing -> error "FAIL: userAge property missing"+++-- ===================================================================+-- Body schema tests+-- ===================================================================++testBodySchemas :: IO ()+testBodySchemas = do+  -- GET response schema+  let op1 = toOperation @(Get HealthPath Text)+  assert "body: GET has response schema" (opResponseSchema op1 /= Nothing)+  case opResponseSchema op1 of+    Just s  -> assert "body: GET response is string" (schemaType s == "string")+    Nothing -> error "FAIL: no response schema"+  assert "body: GET has no request body" (opRequestBody op1 == Nothing)++  -- POST request + response schemas+  let op2 = toOperation @(Post (At "users") Text Text)+  assert "body: POST has response schema" (opResponseSchema op2 /= Nothing)+  assert "body: POST has request body" (opRequestBody op2 /= Nothing)++  -- Json unwrapping+  let op3 = toOperation @(Get HealthPath (Json [Int]))+  case opResponseSchema op3 of+    Just s  -> assert "body: Json [Int] is array" (schemaType s == "array")+    Nothing -> error "FAIL: no response schema for Json"++  -- Generic type in endpoint+  let op4 = toOperation @(Post (At "users") (Json TestUser) (Json TestUser))+  case opRequestBody op4 of+    Just s  -> assert "body: Generic type in request" (schemaType s == "object")+    Nothing -> error "FAIL: no request body for Generic type"+  case opResponseSchema op4 of+    Just s  -> assert "body: Generic type in response" (length (schemaProperties s) == 2)+    Nothing -> error "FAIL: no response schema for Generic type"+++-- ===================================================================+-- CaptureNamed test+-- ===================================================================++testCaptureNamed :: IO ()+testCaptureNamed = do+  let op = toOperation @(Get (ParamNamed "userId" "users" Int) Text)+  assert "CaptureNamed: path has named param" (opPath op == "/users/{userId}")+  assert "CaptureNamed: param name is userId" (paramName (head (opParameters op)) == "userId")+++-- ===================================================================+-- Description test+-- ===================================================================++testDescription :: IO ()+testDescription = do+  let op = toOperation @(Description "Detailed docs here" (Get HealthPath Text))+  assert "Description: opDescription set" (opDescription op == Just "Detailed docs here")+  assert "Description: summary unset" (opSummary op == Nothing)+  -- Describe + Description stacking+  let op2 = toOperation @(Describe "Short" (Description "Long" (Get HealthPath Text)))+  assert "Describe+Description: summary" (opSummary op2 == Just "Short")+  assert "Describe+Description: description" (opDescription op2 == Just "Long")+++-- ===================================================================+-- Sum type / enum schema test+-- ===================================================================++data Color = Red | Green | Blue deriving (Generic)+instance ToSchema Color++data Shape = Circle { radius :: Double } | Rectangle { width :: Double, height :: Double }+  deriving (Generic)+instance ToSchema Shape++testSumTypeSchema :: IO ()+testSumTypeSchema = do+  -- Sum type with constructors produces oneOf+  let schema = toSchema @Shape+  assert "Sum type: has oneOf" (schemaOneOf schema /= Nothing)+  case schemaOneOf schema of+    Just variants -> assert "Sum type: 2 variants" (length variants == 2)+    Nothing -> error "FAIL: expected oneOf"++  -- Either produces oneOf+  let eitherSchema = toSchema @(Either Text Int)+  assert "Either: has oneOf" (schemaOneOf eitherSchema /= Nothing)+++-- ===================================================================+-- CaptureNamed body schema test+-- ===================================================================++testCaptureNamedBodySchema :: IO ()+testCaptureNamedBodySchema = do+  let op = toOperation @(Post (ParamNamed "userId" "users" Int) (Json Text) (Json Text))+  assert "CaptureNamed POST: has request body" (opRequestBody op /= Nothing)+  assert "CaptureNamed POST: has response schema" (opResponseSchema op /= Nothing)+++main :: IO ()+main = do+  putStrLn "acolyte-openapi tests:"+  putStrLn ""+  putStrLn "Spec generation (default = 3.1):"+  testGenerateSpec+  putStrLn ""+  putStrLn "Operations:"+  testOperations+  putStrLn ""+  putStrLn "JSON output:"+  testJsonOutput+  putStrLn ""+  putStrLn "EndpointToOperation:"+  testEndpointToOperation+  putStrLn ""+  putStrLn "Requires delegation:"+  testRequiresDelegate+  putStrLn ""+  putStrLn "Schema:"+  testSchema+  putStrLn ""+  putStrLn "Swagger 2.0:"+  testSwagger+  putStrLn ""+  putStrLn "OpenAPI 3.1 (explicit):"+  testOpenApi3+  putStrLn ""+  putStrLn "Named endpoint operationId:"+  testNamedOperationId+  putStrLn ""+  putStrLn "Named API spec generation:"+  testNamedApiSpec+  putStrLn ""+  putStrLn "Describe wrapper:"+  testDescribe+  putStrLn ""+  putStrLn "RespondsWith wrapper:"+  testRespondsWith+  putStrLn ""+  putStrLn "WithParams wrapper:"+  testWithParams+  putStrLn ""+  putStrLn "WithHeaders wrapper:"+  testWithHeaders+  putStrLn ""+  putStrLn "Versioned wrapper (OpenAPI):"+  testVersionedOpenApi+  putStrLn ""+  putStrLn "Stacked wrappers:"+  testStackedWrappers+  putStrLn ""+  putStrLn "Generic ToSchema derivation:"+  testGenericSchema+  putStrLn ""+  putStrLn "Body schemas:"+  testBodySchemas+  putStrLn ""+  putStrLn "CaptureNamed:"+  testCaptureNamed+  putStrLn ""+  putStrLn "Description wrapper:"+  testDescription+  putStrLn ""+  putStrLn "Sum type / enum schema:"+  testSumTypeSchema+  putStrLn ""+  putStrLn "CaptureNamed body schema:"+  testCaptureNamedBodySchema+  putStrLn ""+  putStrLn "All acolyte-openapi tests passed."