Integrate MultiVerb into the servant packages

.readthedocs.yml

@@ -0,0 +1,23 @@
+# Read the Docs configuration file for Sphinx projects
+# See https://docs.readthedocs.io/en/stable/config-file/v2.html for details
+
+# Required
+version: 2
+
+# Set the OS, Python version and other tools you might need
+build:
+  os: ubuntu-22.04
+  tools:
+    python: "3.12"
+    # You can also specify other tool versions:
+    # nodejs: "20"
+    # rust: "1.70"
+    # golang: "1.20"
+
+# Build documentation in the "docs/" directory with Sphinx
+sphinx:
+  configuration: docs/conf.py
+  # You can configure Sphinx to use a different builder, for instance use the dirhtml builder for simpler URLs
+  # builder: "dirhtml"
+  # Fail on all warnings to avoid broken references
+  # fail_on_warning: true

cabal.project

@@ -87,3 +87,7 @@ allow-newer: openapi3:hashable
 -- http2-5.3.3 is blacklisted, force http2-5.3.2 or http2-5.3.4
 constraints:
   http2 ==5.3.2 || ==5.3.4
+
+package HsOpenSSL
+  -- Fix compilation with GCC >= 14
+  ghc-options: -optc-Wno-incompatible-pointer-types

doc/conf.py

@@ -39,7 +39,12 @@
 # The suffix(es) of source filenames.
 # You can specify multiple suffix as a list of string:
 #
-source_suffix = ['.rst', '.md', '.lhs']
+source_suffix = {
+    '.rst': 'restructuredtext',
+    '.md': 'markdown',
+    '.lhs': 'markdown',
+}
+
 
 # The master toctree document.
 master_doc = 'index'
@@ -63,7 +68,7 @@
 #
 # This is also used if you do content translation via gettext catalogs.
 # Usually you set "language" from the command line for these cases.
-language = None
+language = 'en'
 
 # List of patterns, relative to source directory, that match files and
 # directories to ignore when looking for source files.
@@ -166,6 +171,4 @@
 
 # -- Markdown -------------------------------------------------------------
 
-source_parsers = {
-    '.lhs': CommonMarkParser,
-}
+extensions.append('recommonmark')

doc/cookbook/basic-streaming/Streaming.lhs

@@ -123,7 +123,7 @@ main = do
                     go !acc (S.Yield _ s) = go (acc + 1) s
         _ -> do
             putStrLn "Try:"
-            putStrLn "cabal new-run cookbook-basic-streaming server"
-            putStrLn "cabal new-run cookbook-basic-streaming client 10"
+            putStrLn "cabal run cookbook-basic-streaming server"
+            putStrLn "cabal run cookbook-basic-streaming client 10"
             putStrLn "time curl -H 'Accept: application/json' localhost:8000/slow/5"
 ```

doc/cookbook/file-upload/FileUpload.lhs

@@ -113,7 +113,7 @@ main = withSocketsDo . bracket (forkIO startServer) killThread $ \_threadid -> d
 If you run this, you should get:
 
 ``` bash
-$ cabal new-build cookbook-file-upload
+$ cabal build cookbook-file-upload
 [...]
 $ dist-newstyle/build/x86_64-linux/ghc-8.2.1/cookbook-file-upload-0.1/x/cookbook-file-upload/build/cookbook-file-upload/cookbook-file-upload
 Inputs:

doc/cookbook/generic/Generic.lhs

@@ -107,7 +107,7 @@ main = do
         ("run-custom-monad":_) -> do
             putStrLn "Starting cookbook-generic with a custom monad at http://localhost:8000"
             run 8000 (appMyMonad AppCustomState)
-        _ -> putStrLn "To run, pass 'run' argument: cabal new-run cookbook-generic run"
+        _ -> putStrLn "To run, pass 'run' argument: cabal run cookbook-generic run"
 ```
 
 ## Using generics together with a custom monad

doc/cookbook/index.rst

@@ -28,6 +28,7 @@ you name it!
   using-free-client/UsingFreeClient.lhs
   custom-errors/CustomErrors.lhs
   uverb/UVerb.lhs
+  multiverb/MultiVerb.lhs
   basic-auth/BasicAuth.lhs
   basic-streaming/Streaming.lhs
   jwt-and-basic-auth/JWTAndBasicAuth.lhs

doc/cookbook/multiverb/MultiVerb.lhs

@@ -0,0 +1,223 @@
+# MultiVerb: Powerful endpoint types
+
+`MultiVerb` allows you to represent an API endpoint with multiple response types, status codes and headers.
+
+## Preliminaries
+
+```haskell
+{-# LANGUAGE GHC2021 #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE DerivingVia #-}
+
+import GHC.Generics
+import Generics.SOP qualified as GSOP
+import Network.Wai.Handler.Warp as Warp
+
+import Servant.API
+import Servant.API.MultiVerb
+import Servant.Server
+import Servant.Server.Generic
+```
+
+## Writing an endpoint
+
+Let us create an endpoint that captures an 'Int' and has the following logic:
+
+* If the number is negative, we return status code 400 and an empty body;
+* If the number is even, we return a 'Bool' in the response body;
+* If the number is odd, we return another 'Int' in the response body.
+
+
+Let us list all possible HTTP responses:
+```haskell
+
+type Responses =
+  '[ RespondEmpty 400 "Negative"
+   , Respond 200 "Odd number" Int
+   , Respond 200 "Even number" Bool
+   ]
+```
+
+Let us create the return type:
+
+```haskell
+data Result
+  = NegativeNumber
+  | Odd Int
+  | Even Bool
+  deriving stock (Generic)
+  deriving (AsUnion Responses)
+    via GenericAsUnion Responses Result
+
+instance GSOP.Generic Result
+```
+
+These deriving statements above tie together the responses and the return values, and the order in which they are defined matters.
+For instance, if `Even` and `Odd` had switched places in the definition of `Result`, this would provoke an error:
+
+```
+• No instance for ‘AsConstructor
+    ((:) @Type Int ('[] @Type)) (Respond 200 "Even number" Bool)’
+        arising from the 'deriving' clause of a data type declaration
+```
+
+(_If you would prefer to write an intance of 'AsUnion' by yourself, read more in Annex 1 “Implementing AsUnion manually” section._)
+
+Finally, let us write our endpoint description:
+
+```haskell
+type MultipleChoicesInt =
+  Capture "int" Int
+  :> MultiVerb
+    'GET
+    '[JSON]
+    Responses
+    Result
+```
+
+## Integration in a routing table
+
+We want to integrate our endpoint into a wider routing table with another
+endpoint: `version`, which returns the version of the API
+
+```haskell
+data Routes mode = Routes
+  { choicesRoutes :: mode :- "choices" :> Choices
+  , version :: mode :- "version" :> Get '[JSON] Int
+  }
+  deriving stock (Generic)
+```
+
+```haskell
+type Choices = NamedRoutes Choices'
+data Choices' mode = Choices'
+  { choices :: mode :- MultipleChoicesInt
+  }
+  deriving stock (Generic)
+
+choicesServer :: Choices' AsServer
+choicesServer =
+  Choices'
+    { choices = choicesHandler
+    }
+
+routesServer :: Routes AsServer
+routesServer =
+  Routes
+    { choicesRoutes = choicesServer
+    , version = versionHandler
+    }
+
+choicesHandler :: Int -> Handler Result
+choicesHandler parameter =
+  if parameter < 0
+  then pure NegativeNumber
+  else
+    if even parameter
+    then pure $ Odd 3
+    else pure $ Even True
+
+versionHandler :: Handler Int
+versionHandler = pure 1
+```
+
+We can now plug everything together:
+
+
+```haskell
+main :: IO ()
+main = do
+  putStrLn "Starting server on http://localhost:5000"
+  let server = genericServe routesServer
+  Warp.run 5000 server
+```
+
+Now let us run the server and observe how it behaves:
+
+```
+$ http http://localhost:5000/version
+HTTP/1.1 200 OK
+Content-Type: application/json;charset=utf-8
+Date: Thu, 29 Aug 2024 14:22:20 GMT
+Server: Warp/3.4.1
+Transfer-Encoding: chunked
+
+1
+```
+
+
+```
+$ http http://localhost:5000/choices/3
+HTTP/1.1 200 OK
+Content-Type: application/json;charset=utf-8
+Date: Thu, 29 Aug 2024 14:22:30 GMT
+Server: Warp/3.4.1
+Transfer-Encoding: chunked
+
+true
+```
+
+```
+$ http http://localhost:5000/choices/2
+HTTP/1.1 200 OK
+Content-Type: application/json;charset=utf-8
+Date: Thu, 29 Aug 2024 14:22:33 GMT
+Server: Warp/3.4.1
+Transfer-Encoding: chunked
+
+3
+```
+
+```
+$ http http://localhost:5000/choices/-432
+HTTP/1.1 400 Bad Request
+Date: Thu, 29 Aug 2024 14:22:41 GMT
+Server: Warp/3.4.1
+Transfer-Encoding: chunked
+```
+
+This is the end of t
+
+## Annex 1: Implementing AsUnion manually
+
+Should you need to implement `AsUnion` manually, here is how to do it. `AsUnion` relies on 
+two methods, `toUnion` and  `fromUnion`. They respectively encode your response type to, and decode it from, an inductive type that resembles a [Peano number](https://wiki.haskell.org/Peano_numbers).
+
+Let's see it in action, with explanations below:
+
+```haskell
+instance => AsUnion MultipleChoicesIntResponses MultipleChoicesIntResult where
+  toUnion NegativeNumber = Z (I ())
+  toUnion (Even b)    = S (Z (I b))
+  toUnion (Odd i)  = S (S (Z (I i)))
+
+  fromUnion       (Z (I ())) = NegativeNumber
+  fromUnion    (S (Z (I b))) = Even b
+  fromUnion (S (S (Z (I i)))) = Odd i
+  fromUnion (S (S (S x))) = case x of {}
+```
+
+### Encoding our data to a Union
+
+Let's see how the implementation of `toUnion` works:
+
+In the first equation for `toUnion`, `NegativeNumber` gets translated by `toUnion` into `Z (I ())`.
+`I` is the constructor that holds a value. Here it is holds no meaningful value, because `NegativeNumber` does not have any argument.
+In the tradition of Peano numbers, we start with the `Z`, for Zero.
+
+Then `Even`, which holds a value, `b`, must then be encoded. Following Zero is its Successor, so we wrap the `Z` within a `S` constructor.
+Since it has one argument, we can store it in the `I` constructor.
+
+The pattern repeats with `Odd`, which hole a value (`i`) too. We add a `S`uccessor constructor to the previous encoding, 
+and we store the value inside `I`.
+
+### Decoding the Union
+
+Since every member of our sum type was encoded to a unique form as an inductive data structure, we can decode them quite easily:
+
+* `Z (I ())` is our `NegativeNumber` constructor;
+* `(S (Z (I b)))` is `Even` with `b`;
+* `(S (S (Z (I i))))` is `Odd` with `i`.
+
+Finally, the last equation of `fromUnion` is here to satisfy GHC's pattern checker. It does not serve any functional purpose.

doc/cookbook/multiverb/multiverb.cabal

@@ -0,0 +1,34 @@
+cabal-version:       3.0
+name:                cookbook-multiverb
+version:             0.0.1
+synopsis:            MultiVerb cookbook
+homepage:            http://docs.servant.dev/
+license:             BSD-3-Clause
+license-file:        ../../../servant/LICENSE
+author:              Servant Contributors
+maintainer:          [email protected]
+category:            Servant
+build-type:          Simple
+
+executable cookbook-multiverb
+  main-is:             MultiVerb.lhs
+  build-depends:       base <  5 
+                     , aeson >= 2.2
+                     , aeson-pretty >= 0.8.8
+                     , async
+                     , http-client
+                     , mtl
+                     , servant
+                     , servant-client
+                     , generics-sop
+                     , sop-core
+                     , servant-server
+                     , servant-swagger
+                     , string-conversions
+                     , swagger2
+                     , wai
+                     , warp
+  default-language: Haskell2010
+  ghc-options:         -Wall -pgmL markdown-unlit
+  build-tool-depends:  markdown-unlit:markdown-unlit
+

doc/cookbook/testing/Testing.lhs

@@ -175,7 +175,7 @@ businessLogicSpec =
 Let's run our tests and see what happens:
 
 ```
-$ cabal new-test all
+$ cabal test all
 POST /user
   should create a user with a high enough ID
   should fail with a too-small ID FAILED [1]
@@ -364,7 +364,7 @@ Out of the box, `hspec-wai` provides a lot of useful tools for us to run tests
 against our application. What happens when we run these tests?
 
 ```
-$ cabal new-test all
+$ cabal test all
 ...
 
 GET /docs