Skip to content

Support for MultiVerb #59

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
wants to merge 8 commits into
base: master
Choose a base branch
from
Open

Support for MultiVerb #59

Show file tree
Hide file tree
Changes from 1 commit
Commits
Show all changes
8 commits
Select commit Hold shift + click to select a range
0ac4728
Support for MultiVerb
tchoutri May 22, 2025
c22c184
Update example/src/Todo.hs
tchoutri May 22, 2025
c7bc3a0
Update src/Servant/OpenApi/Internal.hs
tchoutri May 22, 2025
6ad0adc
use writeSwaggerJSON to update the golden test
tchoutri May 22, 2025
4005975
Review remarks
tchoutri May 22, 2025
cc93a74
Fence the MultiVerb support code behind CPP for servant
tchoutri May 22, 2025
9b2a862
re-generate haskell-ci
tchoutri May 22, 2025
6ef4632
Remove source-repository-package
tchoutri Jun 5, 2025
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
10 changes: 10 additions & 0 deletions cabal.project
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -2,3 +2,13 @@ packages:
servant-openapi3.cabal,
example/example.cabal
tests: true

source-repository-package
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I suppose this PR should be merged after official Hackage release of Servant 0.20.3?

Copy link
Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Yes, or at least servant-openapi3 should be released after the official Hackage release. :)

type: git
location: https://github.com/haskell-servant/servant
tag: servant-0.20.3.0
subdir:
./servant
./servant-server
./servant-client
./servant-client-core
1 change: 1 addition & 0 deletions example/example.cabal
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -41,6 +41,7 @@ library
, openapi3
, text
, time
, generics-sop
default-language: Haskell2010

executable swagger-server
Expand Down
30 changes: 29 additions & 1 deletion example/src/Todo.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -4,6 +4,7 @@
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DerivingVia #-}
module Todo where

import Control.Lens
Expand All @@ -18,6 +19,8 @@ import Data.Typeable (Typeable)
import GHC.Generics
import Servant
import Servant.OpenApi
import qualified Generics.SOP as GSOP
import Servant.API.MultiVerb

todoAPI :: Proxy TodoAPI
todoAPI = Proxy
Expand All @@ -28,7 +31,7 @@ type TodoAPI
:<|> "todo" :> ReqBody '[JSON] Todo :> Post '[JSON] TodoId
:<|> "todo" :> Capture "id" TodoId :> Get '[JSON] Todo
:<|> "todo" :> Capture "id" TodoId :> ReqBody '[JSON] Todo :> Put '[JSON] TodoId

:<|> "todo" :> "choices" :> MultipleChoicesInt
-- | API for serving @swagger.json@.
type SwaggerAPI = "swagger.json" :> Get '[JSON] OpenApi

Expand Down Expand Up @@ -71,3 +74,28 @@ server = return todoSwagger :<|> error "not implemented"
-- | Output generated @swagger.json@ file for the @'TodoAPI'@.
writeSwaggerJSON :: IO ()
writeSwaggerJSON = BL8.writeFile "example/swagger.json" (encodePretty todoSwagger)

type MultiResponses =
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

By the way, I liked UVerb better :/

We have this helper type:

newtype UVerbT xs m a
  = UVerbT { unUVerbT :: ExceptT (Union xs) m a }
  deriving newtype (Functor, Applicative, Monad, MonadTrans)

deriving newtype instance MonadReader r m => MonadReader r (UVerbT xs m)

instance MonadError e m => MonadError e (UVerbT xs m) where
  throwError = lift . throwError
  catchError (UVerbT act) h = UVerbT $ ExceptT $
    runExceptT act `catchError` (runExceptT . unUVerbT . h)

runUVerbT :: (Monad m, HasStatus x, IsMember x xs) => UVerbT xs m x -> m (Union xs)
runUVerbT (UVerbT act) = either id id <$> runExceptT (act >>= respond)

throwUVerb :: (Monad m, HasStatus x, IsMember x xs) => x -> UVerbT xs m a
throwUVerb = UVerbT . ExceptT . fmap Left . respond

Copy link
Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I can understand, but MultiVerb lifts a lot of limitations of UVerb, like haskell-servant/servant#1369. Maybe we can get further using the former.

Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Oh, I see.

I've never had a need for this

'[ RespondEmpty 400 "Negative"
, Respond 200 "Even number" Bool
, Respond 200 "Odd number" Int
]

-- All possible return types
data MultiResult
= NegativeNumber
| Even Bool
| Odd Int
deriving stock (Generic)
deriving (AsUnion MultiResponses)
via GenericAsUnion MultiResponses MultiResult

instance GSOP.Generic MultiResult

type MultipleChoicesInt =
Capture "int" Int
:> MultiVerb
'GET
'[JSON]
MultiResponses
MultiResult
Loading
Loading