Skip to content

Commit

Permalink
Cookbook
Browse files Browse the repository at this point in the history
  • Loading branch information
theophile-scrive committed Sep 23, 2024
1 parent 3a0cf72 commit 8217d24
Show file tree
Hide file tree
Showing 13 changed files with 301 additions and 39 deletions.
23 changes: 23 additions & 0 deletions .readthedocs.yml
Original file line number Diff line number Diff line change
@@ -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
13 changes: 8 additions & 5 deletions doc/conf.py
Original file line number Diff line number Diff line change
Expand Up @@ -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'
Expand All @@ -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.
Expand Down Expand Up @@ -166,6 +171,4 @@

# -- Markdown -------------------------------------------------------------

source_parsers = {
'.lhs': CommonMarkParser,
}
extensions.append('recommonmark')
4 changes: 2 additions & 2 deletions doc/cookbook/basic-streaming/Streaming.lhs
Original file line number Diff line number Diff line change
Expand Up @@ -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"
```
22 changes: 0 additions & 22 deletions doc/cookbook/cabal.project

This file was deleted.

Empty file removed doc/cookbook/cabal.project.local
Empty file.
2 changes: 1 addition & 1 deletion doc/cookbook/file-upload/FileUpload.lhs
Original file line number Diff line number Diff line change
Expand Up @@ -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:
Expand Down
2 changes: 1 addition & 1 deletion doc/cookbook/generic/Generic.lhs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
1 change: 1 addition & 0 deletions doc/cookbook/index.rst
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
223 changes: 223 additions & 0 deletions doc/cookbook/multiverb/MultiVerb.lhs
Original file line number Diff line number Diff line change
@@ -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.
34 changes: 34 additions & 0 deletions doc/cookbook/multiverb/multiverb.cabal
Original file line number Diff line number Diff line change
@@ -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

4 changes: 2 additions & 2 deletions doc/cookbook/testing/Testing.lhs
Original file line number Diff line number Diff line change
Expand Up @@ -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]
Expand Down Expand Up @@ -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
Expand Down
Loading

0 comments on commit 8217d24

Please sign in to comment.