From 8b1bf02af843ef603a746191e87504ed89d02763 Mon Sep 17 00:00:00 2001 From: "Julian K. Arni" Date: Wed, 27 Jan 2016 22:28:58 +0100 Subject: [PATCH] Remove bird-tracks --- doc/tutorial/api-type.lhs | 136 +++--- doc/tutorial/client.lhs | 158 +++--- doc/tutorial/docs.lhs | 186 +++---- doc/tutorial/javascript.lhs | 208 ++++---- doc/tutorial/server.lhs | 938 +++++++++++++++++++----------------- 5 files changed, 886 insertions(+), 740 deletions(-) diff --git a/doc/tutorial/api-type.lhs b/doc/tutorial/api-type.lhs index 7b49ec8a..fbf42644 100644 --- a/doc/tutorial/api-type.lhs +++ b/doc/tutorial/api-type.lhs @@ -6,13 +6,15 @@ toc: true The source for this tutorial section is a literate haskell file, so first we need to have some language extensions and imports: -> {-# LANGUAGE DataKinds #-} -> {-# LANGUAGE TypeOperators #-} -> -> module ApiType where -> -> import Data.Text -> import Servant.API +``` haskell +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeOperators #-} + +module ApiType where + +import Data.Text +import Servant.API +``` Consider the following informal specification of an API: @@ -29,14 +31,16 @@ getting some client libraries, and documentation (and in the future, who knows How would we describe it with servant? As mentioned earlier, an endpoint description is a good old Haskell **type**: -> type UserAPI = "users" :> QueryParam "sortby" SortBy :> Get '[JSON] [User] -> -> data SortBy = Age | Name -> -> data User = User { -> name :: String, -> age :: Int -> } +``` haskell +type UserAPI = "users" :> QueryParam "sortby" SortBy :> Get '[JSON] [User] + +data SortBy = Age | Name + +data User = User { + name :: String, + age :: Int +} +``` Let's break that down: @@ -61,8 +65,10 @@ equivalent to `/`, but sometimes it just lets you chain another combinator. We can also describe APIs with multiple endpoints by using the `:<|>` combinators. Here's an example: -> type UserAPI2 = "users" :> "list-all" :> Get '[JSON] [User] -> :<|> "list-all" :> "users" :> Get '[JSON] [User] +``` haskell +type UserAPI2 = "users" :> "list-all" :> Get '[JSON] [User] + :<|> "list-all" :> "users" :> Get '[JSON] [User] +``` *servant* provides a fair amount of combinators out-of-the-box, but you can always write your own when you need it. Here's a quick overview of all the @@ -78,9 +84,11 @@ As you've already seen, you can use type-level strings (enabled with the `DataKinds` language extension) for static path fragments. Chaining them amounts to `/`-separating them in a URL. -> type UserAPI3 = "users" :> "list-all" :> "now" :> Get '[JSON] [User] -> -- describes an endpoint reachable at: -> -- /users/list-all/now +``` haskell +type UserAPI3 = "users" :> "list-all" :> "now" :> Get '[JSON] [User] + -- describes an endpoint reachable at: + -- /users/list-all/now +``` `Delete`, `Get`, `Patch`, `Post` and `Put` ------------------------------------------ @@ -99,8 +107,10 @@ data Put (contentTypes :: [*]) a An endpoint ends with one of the 5 combinators above (unless you write your own). Examples: -> type UserAPI4 = "users" :> Get '[JSON] [User] -> :<|> "admins" :> Get '[JSON] [User] +``` haskell +type UserAPI4 = "users" :> Get '[JSON] [User] + :<|> "admins" :> Get '[JSON] [User] +``` `Capture` --------- @@ -127,13 +137,15 @@ class, which the captured value must be an instance of. Examples: -> type UserAPI5 = "user" :> Capture "userid" Integer :> Get '[JSON] User -> -- equivalent to 'GET /user/:userid' -> -- except that we explicitly say that "userid" -> -- must be an integer -> -> :<|> "user" :> Capture "userid" Integer :> Delete '[] () -> -- equivalent to 'DELETE /user/:userid' +``` haskell +type UserAPI5 = "user" :> Capture "userid" Integer :> Get '[JSON] User + -- equivalent to 'GET /user/:userid' + -- except that we explicitly say that "userid" + -- must be an integer + + :<|> "user" :> Capture "userid" Integer :> Delete '[] () + -- equivalent to 'DELETE /user/:userid' +``` `QueryParam`, `QueryParams`, `QueryFlag`, `MatrixParam`, `MatrixParams` and `MatrixFlag` ---------------------------------------------------------------------------------------- @@ -179,11 +191,13 @@ data MatrixFlag (sym :: Symbol) Examples: -> type UserAPI6 = "users" :> QueryParam "sortby" SortBy :> Get '[JSON] [User] -> -- equivalent to 'GET /users?sortby={age, name}' -> -> :<|> "users" :> MatrixParam "sortby" SortBy :> Get '[JSON] [User] -> -- equivalent to 'GET /users;sortby={age, name}' +``` haskell +type UserAPI6 = "users" :> QueryParam "sortby" SortBy :> Get '[JSON] [User] + -- equivalent to 'GET /users?sortby={age, name}' + + :<|> "users" :> MatrixParam "sortby" SortBy :> Get '[JSON] [User] + -- equivalent to 'GET /users;sortby={age, name}' +``` Again, your handlers don't have to deserialize these things (into, for example, a `SortBy`). *servant* takes care of it. @@ -212,17 +226,19 @@ data ReqBody (contentTypes :: [*]) a Examples: -> type UserAPI7 = "users" :> ReqBody '[JSON] User :> Post '[JSON] User -> -- - equivalent to 'POST /users' with a JSON object -> -- describing a User in the request body -> -- - returns a User encoded in JSON -> -> :<|> "users" :> Capture "userid" Integer -> :> ReqBody '[JSON] User -> :> Put '[JSON] User -> -- - equivalent to 'PUT /users/:userid' with a JSON -> -- object describing a User in the request body -> -- - returns a User encoded in JSON +``` haskell +type UserAPI7 = "users" :> ReqBody '[JSON] User :> Post '[JSON] User + -- - equivalent to 'POST /users' with a JSON object + -- describing a User in the request body + -- - returns a User encoded in JSON + + :<|> "users" :> Capture "userid" Integer + :> ReqBody '[JSON] User + :> Put '[JSON] User + -- - equivalent to 'PUT /users/:userid' with a JSON + -- object describing a User in the request body + -- - returns a User encoded in JSON +``` Request `Header`s ----------------- @@ -243,7 +259,9 @@ Here's an example where we declare that an endpoint makes use of the `User-Agent` header which specifies the name of the software/library used by the client to send the request. -> type UserAPI8 = "users" :> Header "User-Agent" Text :> Get '[JSON] [User] +``` haskell +type UserAPI8 = "users" :> Header "User-Agent" Text :> Get '[JSON] [User] +``` Content types ------------- @@ -257,7 +275,9 @@ Four content-types are provided out-of-the-box by the core *servant* package: reason you wanted one of your endpoints to make your user data available under those 4 formats, you would write the API type as below: -> type UserAPI9 = "users" :> Get '[JSON, PlainText, FormUrlEncoded, OctetStream] [User] +``` haskell +type UserAPI9 = "users" :> Get '[JSON, PlainText, FormUrlEncoded, OctetStream] [User] +``` We also provide an HTML content-type, but since there's no single library that everyone uses, we decided to release 2 packages, *servant-lucid* and @@ -281,7 +301,9 @@ data Headers (ls :: [*]) a If you want to describe an endpoint that returns a "User-Count" header in each response, you could write it as below: -> type UserAPI10 = "users" :> Get '[JSON] (Headers '[Header "User-Count" Integer] [User]) +``` haskell +type UserAPI10 = "users" :> Get '[JSON] (Headers '[Header "User-Count" Integer] [User]) +``` Interoperability with other WAI `Application`s: `Raw` ----------------------------------------------------- @@ -290,14 +312,16 @@ Finally, we also include a combinator named `Raw` that can be used for two reaso - You want to serve static files from a given directory. In that case you can just say: -> type UserAPI11 = "users" :> Get '[JSON] [User] -> -- a /users endpoint -> -> :<|> Raw -> -- requests to anything else than /users -> -- go here, where the server will try to -> -- find a file with the right name -> -- at the right path +``` haskell +type UserAPI11 = "users" :> Get '[JSON] [User] + -- a /users endpoint + + :<|> Raw + -- requests to anything else than /users + -- go here, where the server will try to + -- find a file with the right name + -- at the right path +``` - You more generally want to plug a [WAI `Application`](http://hackage.haskell.org/package/wai) into your webservice. Static file serving is a specific example of that. The API type would look the diff --git a/doc/tutorial/client.lhs b/doc/tutorial/client.lhs index f557c413..9571ec8c 100644 --- a/doc/tutorial/client.lhs +++ b/doc/tutorial/client.lhs @@ -11,75 +11,85 @@ and friends. By *derive*, we mean that there's no code generation involved, the The source for this tutorial section is a literate haskell file, so first we need to have some language extensions and imports: -> {-# LANGUAGE DataKinds #-} -> {-# LANGUAGE DeriveGeneric #-} -> {-# LANGUAGE TypeOperators #-} -> -> module Client where -> -> import Control.Monad.Trans.Either -> import Data.Aeson -> import Data.Proxy -> import GHC.Generics -> import Servant.API -> import Servant.Client +``` haskell +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE TypeOperators #-} + +module Client where + +import Control.Monad.Trans.Either +import Data.Aeson +import Data.Proxy +import GHC.Generics +import Servant.API +import Servant.Client +``` Also, we need examples for some domain specific data types: -> data Position = Position -> { x :: Int -> , y :: Int -> } deriving (Show, Generic) -> -> instance FromJSON Position -> -> newtype HelloMessage = HelloMessage { msg :: String } -> deriving (Show, Generic) -> -> instance FromJSON HelloMessage -> -> data ClientInfo = ClientInfo -> { clientName :: String -> , clientEmail :: String -> , clientAge :: Int -> , clientInterestedIn :: [String] -> } deriving Generic -> -> instance ToJSON ClientInfo -> -> data Email = Email -> { from :: String -> , to :: String -> , subject :: String -> , body :: String -> } deriving (Show, Generic) -> -> instance FromJSON Email +``` haskell +data Position = Position + { x :: Int + , y :: Int + } deriving (Show, Generic) + +instance FromJSON Position + +newtype HelloMessage = HelloMessage { msg :: String } + deriving (Show, Generic) + +instance FromJSON HelloMessage + +data ClientInfo = ClientInfo + { clientName :: String + , clientEmail :: String + , clientAge :: Int + , clientInterestedIn :: [String] + } deriving Generic + +instance ToJSON ClientInfo + +data Email = Email + { from :: String + , to :: String + , subject :: String + , body :: String + } deriving (Show, Generic) + +instance FromJSON Email +``` Enough chitchat, let's see an example. Consider the following API type from the previous section: -> type API = "position" :> Capture "x" Int :> Capture "y" Int :> Get '[JSON] Position -> :<|> "hello" :> QueryParam "name" String :> Get '[JSON] HelloMessage -> :<|> "marketing" :> ReqBody '[JSON] ClientInfo :> Post '[JSON] Email +``` haskell +type API = "position" :> Capture "x" Int :> Capture "y" Int :> Get '[JSON] Position + :<|> "hello" :> QueryParam "name" String :> Get '[JSON] HelloMessage + :<|> "marketing" :> ReqBody '[JSON] ClientInfo :> Post '[JSON] Email +``` What we are going to get with *servant-client* here is 3 functions, one to query each endpoint: -> position :: Int -- ^ value for "x" -> -> Int -- ^ value for "y" -> -> EitherT ServantError IO Position -> -> hello :: Maybe String -- ^ an optional value for "name" -> -> EitherT ServantError IO HelloMessage -> -> marketing :: ClientInfo -- ^ value for the request body -> -> EitherT ServantError IO Email +``` haskell +position :: Int -- ^ value for "x" + -> Int -- ^ value for "y" + -> EitherT ServantError IO Position + +hello :: Maybe String -- ^ an optional value for "name" + -> EitherT ServantError IO HelloMessage + +marketing :: ClientInfo -- ^ value for the request body + -> EitherT ServantError IO Email +``` Each function makes available as an argument any value that the response may depend on, as evidenced in the API type. How do we get these functions? Just give a `Proxy` to your API and a host to make the requests to: -> api :: Proxy API -> api = Proxy -> -> position :<|> hello :<|> marketing = client api (BaseUrl Http "localhost" 8081) +``` haskell +api :: Proxy API +api = Proxy + +position :<|> hello :<|> marketing = client api (BaseUrl Http "localhost" 8081) +``` As you can see in the code above, we just "pattern match our way" to these functions. If we try to derive less or more functions than there are endpoints in the API, we obviously get an error. The `BaseUrl` value there is just: @@ -101,22 +111,24 @@ data BaseUrl = BaseUrl That's it. Let's now write some code that uses our client functions. -> queries :: EitherT ServantError IO (Position, HelloMessage, Email) -> queries = do -> pos <- position 10 10 -> msg <- hello (Just "servant") -> em <- marketing (ClientInfo "Alp" "alp@foo.com" 26 ["haskell", "mathematics"]) -> return (pos, msg, em) -> -> run :: IO () -> run = do -> res <- runEitherT queries -> case res of -> Left err -> putStrLn $ "Error: " ++ show err -> Right (pos, msg, em) -> do -> print pos -> print msg -> print em +``` haskell +queries :: EitherT ServantError IO (Position, HelloMessage, Email) +queries = do + pos <- position 10 10 + msg <- hello (Just "servant") + em <- marketing (ClientInfo "Alp" "alp@foo.com" 26 ["haskell", "mathematics"]) + return (pos, msg, em) + +run :: IO () +run = do + res <- runEitherT queries + case res of + Left err -> putStrLn $ "Error: " ++ show err + Right (pos, msg, em) -> do + print pos + print msg + print em +``` You can now run `dist/build/tutorial/tutorial 8` (the server) and `dist/build/t8-main/t8-main` (the client) to see them both in action. diff --git a/doc/tutorial/docs.lhs b/doc/tutorial/docs.lhs index 2b85b9fa..1ae4570e 100644 --- a/doc/tutorial/docs.lhs +++ b/doc/tutorial/docs.lhs @@ -6,89 +6,99 @@ toc: true The source for this tutorial section is a literate haskell file, so first we need to have some language extensions and imports: -> {-# LANGUAGE DataKinds #-} -> {-# LANGUAGE DeriveGeneric #-} -> {-# LANGUAGE FlexibleInstances #-} -> {-# LANGUAGE MultiParamTypeClasses #-} -> {-# LANGUAGE OverloadedStrings #-} -> {-# LANGUAGE TypeOperators #-} -> {-# OPTIONS_GHC -fno-warn-orphans #-} -> -> module Docs where -> -> import Data.ByteString.Lazy (ByteString) -> import Data.Proxy -> import Data.Text.Lazy.Encoding (encodeUtf8) -> import Data.Text.Lazy (pack) -> import Network.HTTP.Types -> import Network.Wai -> import Servant.API -> import Servant.Docs -> import Servant.Server +``` haskell +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeOperators #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module Docs where + +import Data.ByteString.Lazy (ByteString) +import Data.Proxy +import Data.Text.Lazy.Encoding (encodeUtf8) +import Data.Text.Lazy (pack) +import Network.HTTP.Types +import Network.Wai +import Servant.API +import Servant.Docs +import Servant.Server +``` And we'll import some things from one of our earlier modules ([Serving an API](/tutorial/server.html)): -> import Server (Email(..), ClientInfo(..), Position(..), HelloMessage(..), -> server3, emailForClient) +``` haskell +import Server (Email(..), ClientInfo(..), Position(..), HelloMessage(..), + server3, emailForClient) +``` Like client function generation, documentation generation amounts to inspecting the API type and extracting all the data we need to then present it in some format to users of your API. This time however, we have to assist *servant*. While it is able to deduce a lot of things about our API, it can't magically come up with descriptions of the various pieces of our APIs that are human-friendly and explain what's going on "at the business-logic level". A good example to study for documentation generation is our webservice with the `/position`, `/hello` and `/marketing` endpoints from earlier: -> type ExampleAPI = "position" :> Capture "x" Int :> Capture "y" Int :> Get '[JSON] Position -> :<|> "hello" :> QueryParam "name" String :> Get '[JSON] HelloMessage -> :<|> "marketing" :> ReqBody '[JSON] ClientInfo :> Post '[JSON] Email -> -> exampleAPI :: Proxy ExampleAPI -> exampleAPI = Proxy +``` haskell +type ExampleAPI = "position" :> Capture "x" Int :> Capture "y" Int :> Get '[JSON] Position + :<|> "hello" :> QueryParam "name" String :> Get '[JSON] HelloMessage + :<|> "marketing" :> ReqBody '[JSON] ClientInfo :> Post '[JSON] Email + +exampleAPI :: Proxy ExampleAPI +exampleAPI = Proxy +``` While *servant* can see e.g. that there are 3 endpoints and that the response bodies will be in JSON, it doesn't know what influence the captures, parameters, request bodies and other combinators have on the webservice. This is where some manual work is required. For every capture, request body, response body, query param, we have to give some explanations about how it influences the response, what values are possible and the likes. Here's how it looks like for the parameters we have above. -> instance ToCapture (Capture "x" Int) where -> toCapture _ = -> DocCapture "x" -- name -> "(integer) position on the x axis" -- description -> -> instance ToCapture (Capture "y" Int) where -> toCapture _ = -> DocCapture "y" -- name -> "(integer) position on the y axis" -- description -> -> instance ToSample Position Position where -> toSample _ = Just (Position 3 14) -- example of output -> -> instance ToParam (QueryParam "name" String) where -> toParam _ = -> DocQueryParam "name" -- name -> ["Alp", "John Doe", "..."] -- example of values (not necessarily exhaustive) -> "Name of the person to say hello to." -- description -> Normal -- Normal, List or Flag -> -> instance ToSample HelloMessage HelloMessage where -> toSamples _ = -> [ ("When a value is provided for 'name'", HelloMessage "Hello, Alp") -> , ("When 'name' is not specified", HelloMessage "Hello, anonymous coward") -> ] -> -- mutliple examples to display this time -> -> ci :: ClientInfo -> ci = ClientInfo "Alp" "alp@foo.com" 26 ["haskell", "mathematics"] -> -> instance ToSample ClientInfo ClientInfo where -> toSample _ = Just ci -> -> instance ToSample Email Email where -> toSample _ = Just (emailForClient ci) +``` haskell +instance ToCapture (Capture "x" Int) where + toCapture _ = + DocCapture "x" -- name + "(integer) position on the x axis" -- description + +instance ToCapture (Capture "y" Int) where + toCapture _ = + DocCapture "y" -- name + "(integer) position on the y axis" -- description + +instance ToSample Position Position where + toSample _ = Just (Position 3 14) -- example of output + +instance ToParam (QueryParam "name" String) where + toParam _ = + DocQueryParam "name" -- name + ["Alp", "John Doe", "..."] -- example of values (not necessarily exhaustive) + "Name of the person to say hello to." -- description + Normal -- Normal, List or Flag + +instance ToSample HelloMessage HelloMessage where + toSamples _ = + [ ("When a value is provided for 'name'", HelloMessage "Hello, Alp") + , ("When 'name' is not specified", HelloMessage "Hello, anonymous coward") + ] + -- mutliple examples to display this time + +ci :: ClientInfo +ci = ClientInfo "Alp" "alp@foo.com" 26 ["haskell", "mathematics"] + +instance ToSample ClientInfo ClientInfo where + toSample _ = Just ci + +instance ToSample Email Email where + toSample _ = Just (emailForClient ci) +``` Types that are used as request or response bodies have to instantiate the `ToSample` typeclass which lets you specify one or more examples of values. `Capture`s and `QueryParam`s have to instantiate their respective `ToCapture` and `ToParam` classes and provide a name and some information about the concrete meaning of that argument, as illustrated in the code above. With all of this, we can derive docs for our API. -> apiDocs :: API -> apiDocs = docs exampleAPI +``` haskell +apiDocs :: API +apiDocs = docs exampleAPI +``` `API` is a type provided by *servant-docs* that stores all the information one needs about a web API in order to generate documentation in some format. Out of the box, *servant-docs* only provides a pretty documentation printer that outputs [Markdown](http://en.wikipedia.org/wiki/Markdown), but the [servant-pandoc](http://hackage.haskell.org/package/servant-pandoc) package can be used to target many useful formats. @@ -192,33 +202,37 @@ That lets us see what our API docs look down in markdown, by looking at `markdow However, we can also add one or more introduction sections to the document. We just need to tweak the way we generate `apiDocs`. We will also convert the content to a lazy `ByteString` since this is what *wai* expects for `Raw` endpoints. -> docsBS :: ByteString -> docsBS = encodeUtf8 -> . pack -> . markdown -> $ docsWithIntros [intro] exampleAPI -> -> where intro = DocIntro "Welcome" ["This is our super webservice's API.", "Enjoy!"] +``` haskell +docsBS :: ByteString +docsBS = encodeUtf8 + . pack + . markdown + $ docsWithIntros [intro] exampleAPI + + where intro = DocIntro "Welcome" ["This is our super webservice's API.", "Enjoy!"] +``` `docsWithIntros` just takes an additional parameter, a list of `DocIntro`s that must be displayed before any endpoint docs. We can now serve the API *and* the API docs with a simple server. -> type DocsAPI = ExampleAPI :<|> Raw -> -> api :: Proxy DocsAPI -> api = Proxy -> -> server :: Server DocsAPI -> server = Server.server3 :<|> serveDocs -> -> where serveDocs _ respond = -> respond $ responseLBS ok200 [plain] docsBS -> -> plain = ("Content-Type", "text/plain") -> -> app :: Application -> app = serve api server +``` haskell +type DocsAPI = ExampleAPI :<|> Raw + +api :: Proxy DocsAPI +api = Proxy + +server :: Server DocsAPI +server = Server.server3 :<|> serveDocs + + where serveDocs _ respond = + respond $ responseLBS ok200 [plain] docsBS + + plain = ("Content-Type", "text/plain") + +app :: Application +app = serve api server +``` And if you spin up this server with `dist/build/tutorial/tutorial 10` and go to anywhere else than `/position`, `/hello` and `/marketing`, you will see the API docs in markdown. This is because `serveDocs` is attempted if the 3 other endpoints don't match and systematically succeeds since its definition is to just return some fixed bytestring with the `text/plain` content type. diff --git a/doc/tutorial/javascript.lhs b/doc/tutorial/javascript.lhs index 33b4f73b..9098fe8d 100644 --- a/doc/tutorial/javascript.lhs +++ b/doc/tutorial/javascript.lhs @@ -22,117 +22,131 @@ query your API. The source for this tutorial section is a literate haskell file, so first we need to have some language extensions and imports: -> {-# LANGUAGE DataKinds #-} -> {-# LANGUAGE DeriveGeneric #-} -> {-# LANGUAGE OverloadedStrings #-} -> {-# LANGUAGE TypeOperators #-} -> -> module Javascript where -> -> import Control.Monad.IO.Class -> import Data.Aeson -> import Data.Proxy -> import Data.Text (Text) -> import qualified Data.Text as T -> import GHC.Generics -> import Language.Javascript.JQuery -> import Network.Wai -> import Servant -> import Servant.JQuery -> import System.Random +``` haskell +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeOperators #-} + +module Javascript where + +import Control.Monad.IO.Class +import Data.Aeson +import Data.Proxy +import Data.Text (Text) +import qualified Data.Text as T +import GHC.Generics +import Language.Javascript.JQuery +import Network.Wai +import Servant +import Servant.JQuery +import System.Random +``` Now let's have the API type(s) and the accompanying datatypes. -> type API = "point" :> Get '[JSON] Point -> :<|> "books" :> QueryParam "q" Text :> Get '[JSON] (Search Book) -> -> type API' = API :<|> Raw -> -> data Point = Point -> { x :: Double -> , y :: Double -> } deriving Generic -> -> instance ToJSON Point -> -> data Search a = Search -> { query :: Text -> , results :: [a] -> } deriving Generic -> -> mkSearch :: Text -> [a] -> Search a -> mkSearch = Search -> -> instance ToJSON a => ToJSON (Search a) -> -> data Book = Book -> { author :: Text -> , title :: Text -> , year :: Int -> } deriving Generic -> -> instance ToJSON Book -> -> book :: Text -> Text -> Int -> Book -> book = Book +``` haskell +type API = "point" :> Get '[JSON] Point + :<|> "books" :> QueryParam "q" Text :> Get '[JSON] (Search Book) + +type API' = API :<|> Raw + +data Point = Point + { x :: Double + , y :: Double + } deriving Generic + +instance ToJSON Point + +data Search a = Search + { query :: Text + , results :: [a] + } deriving Generic + +mkSearch :: Text -> [a] -> Search a +mkSearch = Search + +instance ToJSON a => ToJSON (Search a) + +data Book = Book + { author :: Text + , title :: Text + , year :: Int + } deriving Generic + +instance ToJSON Book + +book :: Text -> Text -> Int -> Book +book = Book +``` We need a "book database". For the purpose of this guide, let's restrict ourselves to the following books. -> books :: [Book] -> books = -> [ book "Paul Hudak" "The Haskell School of Expression: Learning Functional Programming through Multimedia" 2000 -> , book "Bryan O'Sullivan, Don Stewart, and John Goerzen" "Real World Haskell" 2008 -> , book "Miran Lipovača" "Learn You a Haskell for Great Good!" 2011 -> , book "Graham Hutton" "Programming in Haskell" 2007 -> , book "Simon Marlow" "Parallel and Concurrent Programming in Haskell" 2013 -> , book "Richard Bird" "Introduction to Functional Programming using Haskell" 1998 -> ] +``` haskell +books :: [Book] +books = + [ book "Paul Hudak" "The Haskell School of Expression: Learning Functional Programming through Multimedia" 2000 + , book "Bryan O'Sullivan, Don Stewart, and John Goerzen" "Real World Haskell" 2008 + , book "Miran Lipovača" "Learn You a Haskell for Great Good!" 2011 + , book "Graham Hutton" "Programming in Haskell" 2007 + , book "Simon Marlow" "Parallel and Concurrent Programming in Haskell" 2013 + , book "Richard Bird" "Introduction to Functional Programming using Haskell" 1998 + ] +``` Now, given an optional search string `q`, we want to perform a case insensitive search in that list of books. We're obviously not going to try and implement the best possible algorithm, this is out of scope for this tutorial. The following simple linear scan will do, given how small our list is. -> searchBook :: Monad m => Maybe Text -> m (Search Book) -> searchBook Nothing = return (mkSearch "" books) -> searchBook (Just q) = return (mkSearch q books') -> -> where books' = filter (\b -> q' `T.isInfixOf` T.toLower (author b) -> || q' `T.isInfixOf` T.toLower (title b) -> ) -> books -> q' = T.toLower q +``` haskell +searchBook :: Monad m => Maybe Text -> m (Search Book) +searchBook Nothing = return (mkSearch "" books) +searchBook (Just q) = return (mkSearch q books') + + where books' = filter (\b -> q' `T.isInfixOf` T.toLower (author b) + || q' `T.isInfixOf` T.toLower (title b) + ) + books + q' = T.toLower q +``` We also need an endpoint that generates random points `(x, y)` with `-1 <= x,y <= 1`. The code below uses [random](http://hackage.haskell.org/package/random)'s `System.Random`. -> randomPoint :: MonadIO m => m Point -> randomPoint = liftIO . getStdRandom $ \g -> -> let (rx, g') = randomR (-1, 1) g -> (ry, g'') = randomR (-1, 1) g' -> in (Point rx ry, g'') +``` haskell +randomPoint :: MonadIO m => m Point +randomPoint = liftIO . getStdRandom $ \g -> + let (rx, g') = randomR (-1, 1) g + (ry, g'') = randomR (-1, 1) g' + in (Point rx ry, g'') +``` If we add static file serving, our server is now complete. -> api :: Proxy API -> api = Proxy -> -> api' :: Proxy API' -> api' = Proxy -> -> server :: Server API -> server = randomPoint -> :<|> searchBook -> -> server' :: Server API' -> server' = server -> :<|> serveDirectory "tutorial/t9" -> -> app :: Application -> app = serve api' server' +``` haskell +api :: Proxy API +api = Proxy + +api' :: Proxy API' +api' = Proxy + +server :: Server API +server = randomPoint + :<|> searchBook + +server' :: Server API' +server' = server + :<|> serveDirectory "tutorial/t9" + +app :: Application +app = serve api' server' +``` Why two different API types, proxies and servers though? Simply because we don't want to generate javascript functions for the `Raw` part of our API type, so we need a `Proxy` for our API type `API'` without its `Raw` endpoint. Very similarly to how one can derive haskell functions, we can derive the javascript with just a simple function call to `jsForAPI` from `Servant.JQuery`. -> apiJS :: String -> apiJS = jsForAPI api +``` haskell +apiJS :: String +apiJS = jsForAPI api +``` This `String` contains 2 Javascript functions: @@ -161,11 +175,13 @@ function getbooks(q, onSuccess, onError) Right before starting up our server, we will need to write this `String` to a file, say `api.js`, along with a copy of the *jQuery* library, as provided by the [js-jquery](http://hackage.haskell.org/package/js-jquery) package. -> writeJSFiles :: IO () -> writeJSFiles = do -> writeFile "getting-started/gs9/api.js" apiJS -> jq <- readFile =<< Language.Javascript.JQuery.file -> writeFile "getting-started/gs9/jq.js" jq +``` haskell +writeJSFiles :: IO () +writeJSFiles = do + writeFile "getting-started/gs9/api.js" apiJS + jq <- readFile =<< Language.Javascript.JQuery.file + writeFile "getting-started/gs9/jq.js" jq +``` And we're good to go. Start the server with `dist/build/tutorial/tutorial 9` and go to `http://localhost:8081/`. Start typing in the name of one of the authors in our database or part of a book title, and check out how long it takes to approximate π using the method mentioned above. diff --git a/doc/tutorial/server.lhs b/doc/tutorial/server.lhs index 411ec1fb..29ca6cb8 100644 --- a/doc/tutorial/server.lhs +++ b/doc/tutorial/server.lhs @@ -34,39 +34,41 @@ Equipped with some basic knowledge about the way we represent API, let's now wri The source for this tutorial section is a literate haskell file, so first we need to have some language extensions and imports: -> {-# LANGUAGE DataKinds #-} -> {-# LANGUAGE DeriveGeneric #-} -> {-# LANGUAGE FlexibleInstances #-} -> {-# LANGUAGE GeneralizedNewtypeDeriving #-} -> {-# LANGUAGE MultiParamTypeClasses #-} -> {-# LANGUAGE OverloadedStrings #-} -> {-# LANGUAGE ScopedTypeVariables #-} -> {-# LANGUAGE TypeOperators #-} -> -> module Server where -> -> import Control.Monad.IO.Class -> import Control.Monad.Reader -> import Control.Monad.Trans.Either -> import Data.Aeson -> import Data.Aeson.Types -> import Data.Attoparsec.ByteString -> import Data.ByteString (ByteString) -> import Data.Int -> import Data.List -> import Data.String.Conversions -> import Data.Time.Calendar -> import GHC.Generics -> import Lucid -> import Network.HTTP.Media ((//), (/:)) -> import Network.Wai -> import Network.Wai.Handler.Warp -> import Servant -> import System.Directory -> import Text.Blaze -> import Text.Blaze.Html.Renderer.Utf8 -> import qualified Data.Aeson.Parser -> import qualified Text.Blaze.Html +``` haskell +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeOperators #-} + +module Server where + +import Control.Monad.IO.Class +import Control.Monad.Reader +import Control.Monad.Trans.Either +import Data.Aeson +import Data.Aeson.Types +import Data.Attoparsec.ByteString +import Data.ByteString (ByteString) +import Data.Int +import Data.List +import Data.String.Conversions +import Data.Time.Calendar +import GHC.Generics +import Lucid +import Network.HTTP.Media ((//), (/:)) +import Network.Wai +import Network.Wai.Handler.Warp +import Servant +import System.Directory +import Text.Blaze +import Text.Blaze.Html.Renderer.Utf8 +import qualified Data.Aeson.Parser +import qualified Text.Blaze.Html +``` ``` haskell ignore {-# LANGUAGE TypeFamilies #-} @@ -76,7 +78,9 @@ need to have some language extensions and imports: We will write a server that will serve the following API. -> type UserAPI1 = "users" :> Get '[JSON] [User] +``` haskell +type UserAPI1 = "users" :> Get '[JSON] [User] +``` Here's what we would like to see when making a GET request to `/users`. @@ -88,22 +92,26 @@ Here's what we would like to see when making a GET request to `/users`. Now let's define our `User` data type and write some instances for it. -> data User = User -> { name :: String -> , age :: Int -> , email :: String -> , registration_date :: Day -> } deriving (Eq, Show, Generic) -> -> instance ToJSON User +``` haskell +data User = User + { name :: String + , age :: Int + , email :: String + , registration_date :: Day + } deriving (Eq, Show, Generic) + +instance ToJSON User +``` Nothing funny going on here. But we now can define our list of two users. -> users1 :: [User] -> users1 = -> [ User "Isaac Newton" 372 "isaac@newton.co.uk" (fromGregorian 1683 3 1) -> , User "Albert Einstein" 136 "ae@mc2.org" (fromGregorian 1905 12 1) -> ] +``` haskell +users1 :: [User] +users1 = + [ User "Isaac Newton" 372 "isaac@newton.co.uk" (fromGregorian 1683 3 1) + , User "Albert Einstein" 136 "ae@mc2.org" (fromGregorian 1905 12 1) + ] +``` Let's also write our API type. @@ -129,27 +137,33 @@ HTTP method combinator used for the corresponding endpoint. In our case, it means we must provide a handler of type `EitherT ServantErr IO [User]`. Well, we have a monad, let's just `return` our list: -> server1 :: Server UserAPI1 -> server1 = return users1 +``` haskell +server1 :: Server UserAPI1 +server1 = return users1 +``` That's it. Now we can turn `server` into an actual webserver using [wai](http://hackage.haskell.org/package/wai) and [warp](http://hackage.haskell.org/package/warp): -> userAPI :: Proxy UserAPI1 -> userAPI = Proxy -> -> -- 'serve' comes from servant and hands you a WAI Application, -> -- which you can think of as an "abstract" web application, -> -- not yet a webserver. -> app1 :: Application -> app1 = serve userAPI server1 +``` haskell +userAPI :: Proxy UserAPI1 +userAPI = Proxy + +-- 'serve' comes from servant and hands you a WAI Application, +-- which you can think of as an "abstract" web application, +-- not yet a webserver. +app1 :: Application +app1 = serve userAPI server1 +``` The `userAPI` bit is, alas, boilerplate (we need it to guide type inference). But that's about as much boilerplate as you get. And we're done! Let's run our webservice on the port 8081. -> main :: IO () -> main = run 8081 app1 +``` haskell +main :: IO () +main = run 8081 app1 +``` You can put this all into a file or just grab [servant's repo](http://github.com/haskell-servant/servant) and look at the @@ -170,29 +184,35 @@ More endpoints What if we want more than one endpoint? Let's add `/albert` and `/isaac` to view the corresponding users encoded in JSON. -> type UserAPI2 = "users" :> Get '[JSON] [User] -> :<|> "albert" :> Get '[JSON] User -> :<|> "isaac" :> Get '[JSON] User +``` haskell +type UserAPI2 = "users" :> Get '[JSON] [User] + :<|> "albert" :> Get '[JSON] User + :<|> "isaac" :> Get '[JSON] User +``` And let's adapt our code a bit. -> isaac :: User -> isaac = User "Isaac Newton" 372 "isaac@newton.co.uk" (fromGregorian 1683 3 1) -> -> albert :: User -> albert = User "Albert Einstein" 136 "ae@mc2.org" (fromGregorian 1905 12 1) -> -> users2 :: [User] -> users2 = [isaac, albert] +``` haskell +isaac :: User +isaac = User "Isaac Newton" 372 "isaac@newton.co.uk" (fromGregorian 1683 3 1) + +albert :: User +albert = User "Albert Einstein" 136 "ae@mc2.org" (fromGregorian 1905 12 1) + +users2 :: [User] +users2 = [isaac, albert] +``` Now, just like we separate the various endpoints in `UserAPI` with `:<|>`, we are going to separate the handlers with `:<|>` too! They must be provided in the same order as the one they appear in in the API type. -> server2 :: Server UserAPI2 -> server2 = return users2 -> :<|> return albert -> :<|> return isaac +``` haskell +server2 :: Server UserAPI2 +server2 = return users2 + :<|> return albert + :<|> return isaac +``` And that's it! You can run this example with `dist/build/tutorial/tutorial 2` and check out the data available @@ -211,70 +231,74 @@ decoding/encoding data from/to JSON. Never. We are going to use the following data types and functions to implement a server for `API`. -> type API = "position" :> Capture "x" Int :> Capture "y" Int :> Get '[JSON] Position -> :<|> "hello" :> QueryParam "name" String :> Get '[JSON] HelloMessage -> :<|> "marketing" :> ReqBody '[JSON] ClientInfo :> Post '[JSON] Email -> -> data Position = Position -> { x :: Int -> , y :: Int -> } deriving Generic -> -> instance ToJSON Position -> -> newtype HelloMessage = HelloMessage { msg :: String } -> deriving Generic -> -> instance ToJSON HelloMessage -> -> data ClientInfo = ClientInfo -> { clientName :: String -> , clientEmail :: String -> , clientAge :: Int -> , clientInterestedIn :: [String] -> } deriving Generic -> -> instance FromJSON ClientInfo -> instance ToJSON ClientInfo -> -> data Email = Email -> { from :: String -> , to :: String -> , subject :: String -> , body :: String -> } deriving Generic -> -> instance ToJSON Email -> -> emailForClient :: ClientInfo -> Email -> emailForClient c = Email from' to' subject' body' -> -> where from' = "great@company.com" -> to' = clientEmail c -> subject' = "Hey " ++ clientName c ++ ", we miss you!" -> body' = "Hi " ++ clientName c ++ ",\n\n" -> ++ "Since you've recently turned " ++ show (clientAge c) -> ++ ", have you checked out our latest " -> ++ intercalate ", " (clientInterestedIn c) -> ++ " products? Give us a visit!" +``` haskell +type API = "position" :> Capture "x" Int :> Capture "y" Int :> Get '[JSON] Position + :<|> "hello" :> QueryParam "name" String :> Get '[JSON] HelloMessage + :<|> "marketing" :> ReqBody '[JSON] ClientInfo :> Post '[JSON] Email + +data Position = Position + { x :: Int + , y :: Int + } deriving Generic + +instance ToJSON Position + +newtype HelloMessage = HelloMessage { msg :: String } + deriving Generic + +instance ToJSON HelloMessage + +data ClientInfo = ClientInfo + { clientName :: String + , clientEmail :: String + , clientAge :: Int + , clientInterestedIn :: [String] + } deriving Generic + +instance FromJSON ClientInfo +instance ToJSON ClientInfo + +data Email = Email + { from :: String + , to :: String + , subject :: String + , body :: String + } deriving Generic + +instance ToJSON Email + +emailForClient :: ClientInfo -> Email +emailForClient c = Email from' to' subject' body' + + where from' = "great@company.com" + to' = clientEmail c + subject' = "Hey " ++ clientName c ++ ", we miss you!" + body' = "Hi " ++ clientName c ++ ",\n\n" + ++ "Since you've recently turned " ++ show (clientAge c) + ++ ", have you checked out our latest " + ++ intercalate ", " (clientInterestedIn c) + ++ " products? Give us a visit!" +``` We can implement handlers for the three endpoints: -> server3 :: Server API -> server3 = position -> :<|> hello -> :<|> marketing -> -> where position :: Int -> Int -> EitherT ServantErr IO Position -> position x y = return (Position x y) -> -> hello :: Maybe String -> EitherT ServantErr IO HelloMessage -> hello mname = return . HelloMessage $ case mname of -> Nothing -> "Hello, anonymous coward" -> Just n -> "Hello, " ++ n -> -> marketing :: ClientInfo -> EitherT ServantErr IO Email -> marketing clientinfo = return (emailForClient clientinfo) +``` haskell +server3 :: Server API +server3 = position + :<|> hello + :<|> marketing + + where position :: Int -> Int -> EitherT ServantErr IO Position + position x y = return (Position x y) + + hello :: Maybe String -> EitherT ServantErr IO HelloMessage + hello mname = return . HelloMessage $ case mname of + Nothing -> "Hello, anonymous coward" + Just n -> "Hello, " ++ n + + marketing :: ClientInfo -> EitherT ServantErr IO Email + marketing clientinfo = return (emailForClient clientinfo) +``` Did you see that? The types for your handlers changed to be just what we needed! In particular: @@ -337,29 +361,31 @@ decoded to provides a `FromText` instance, it will Just Work. *servant* provides a decent number of instances, but here are some examples of defining your own. -> -- A typical enumeration -> data Direction -> = Up -> | Down -> | Left -> | Right -> -> instance FromText Direction where -> -- requires {-# LANGUAGE OverloadedStrings #-} -> fromText "up" = Just Up -> fromText "down" = Just Down -> fromText "left" = Just Server.Left -> fromText "right" = Just Server.Right -> fromText _ = Nothing -> -> instance ToText Direction where -> toText Up = "up" -> toText Down = "down" -> toText Server.Left = "left" -> toText Server.Right = "right" -> -> newtype UserId = UserId Int64 -> deriving (FromText, ToText) +``` haskell +-- A typical enumeration +data Direction + = Up + | Down + | Left + | Right + +instance FromText Direction where + -- requires {-# LANGUAGE OverloadedStrings #-} + fromText "up" = Just Up + fromText "down" = Just Down + fromText "left" = Just Server.Left + fromText "right" = Just Server.Right + fromText _ = Nothing + +instance ToText Direction where + toText Up = "up" + toText Down = "down" + toText Server.Left = "left" + toText Server.Right = "right" + +newtype UserId = UserId Int64 + deriving (FromText, ToText) +``` or writing the instances by hand: @@ -464,10 +490,12 @@ our own little function around *aeson* and *attoparsec* that allows any type of JSON value at the toplevel of a "JSON document". Here's the definition in case you are curious. -> eitherDecodeLenient :: FromJSON a => ByteString -> Either String a -> eitherDecodeLenient input = do -> v :: Value <- parseOnly (Data.Aeson.Parser.value <* endOfInput) (cs input) -> parseEither parseJSON v +``` haskell +eitherDecodeLenient :: FromJSON a => ByteString -> Either String a +eitherDecodeLenient input = do + v :: Value <- parseOnly (Data.Aeson.Parser.value <* endOfInput) (cs input) + parseEither parseJSON v +``` This function is exactly what we need for our `MimeUnrender` instance. @@ -492,7 +520,9 @@ or [lucid](http://hackage.haskell.org/package/lucid). The best option for *servant* is obviously to support both (and hopefully other templating solutions!). -> data HTMLLucid +``` haskell +data HTMLLucid +``` Once again, the data type is just there as a symbol for the encoding/decoding functions, except that this time we will only worry about encoding since @@ -500,8 +530,10 @@ functions, except that this time we will only worry about encoding since Both packages also have the same `Accept` instance for their `HTMLLucid` type. -> instance Accept HTMLLucid where -> contentType _ = "text" // "html" /: ("charset", "utf-8") +``` haskell +instance Accept HTMLLucid where + contentType _ = "text" // "html" /: ("charset", "utf-8") +``` Note that this instance uses the `(/:)` operator from *http-media* which lets us specify additional information about a content-type, like the charset here. @@ -512,31 +544,35 @@ then write that to a `ByteString`. For *lucid*: -> instance ToHtml a => MimeRender HTMLLucid a where -> mimeRender _ = renderBS . toHtml -> -> -- let's also provide an instance for lucid's -> -- 'Html' wrapper. -> instance MimeRender HTMLLucid (Html a) where -> mimeRender _ = renderBS +``` haskell +instance ToHtml a => MimeRender HTMLLucid a where + mimeRender _ = renderBS . toHtml + +-- let's also provide an instance for lucid's +-- 'Html' wrapper. +instance MimeRender HTMLLucid (Html a) where + mimeRender _ = renderBS +``` For *blaze-html*: -> -- For this tutorial to compile 'HTMLLucid' and 'HTMLBlaze' have to be -> -- distinct. Usually you would stick to one html rendering library and then -> -- you can go with one 'HTML' type. -> data HTMLBlaze -> -> instance Accept HTMLBlaze where -> contentType _ = "text" // "html" /: ("charset", "utf-8") -> -> instance ToMarkup a => MimeRender HTMLBlaze a where -> mimeRender _ = renderHtml . Text.Blaze.Html.toHtml -> -> -- while we're at it, just like for lucid we can -> -- provide an instance for rendering blaze's 'Html' type -> instance MimeRender HTMLBlaze Text.Blaze.Html.Html where -> mimeRender _ = renderHtml +``` haskell +-- For this tutorial to compile 'HTMLLucid' and 'HTMLBlaze' have to be +-- distinct. Usually you would stick to one html rendering library and then +-- you can go with one 'HTML' type. +data HTMLBlaze + +instance Accept HTMLBlaze where + contentType _ = "text" // "html" /: ("charset", "utf-8") + +instance ToMarkup a => MimeRender HTMLBlaze a where + mimeRender _ = renderHtml . Text.Blaze.Html.toHtml + +-- while we're at it, just like for lucid we can +-- provide an instance for rendering blaze's 'Html' type +instance MimeRender HTMLBlaze Text.Blaze.Html.Html where + mimeRender _ = renderHtml +``` Both [servant-blaze](http://hackage.haskell.org/package/servant-blaze) and [servant-lucid](http://hackage.haskell.org/package/servant-lucid) let you use @@ -548,59 +584,67 @@ content type in action. First off, imports and pragmas as usual. We will be serving the following API: -> type PersonAPI = "persons" :> Get '[JSON, HTMLLucid] [Person] +``` haskell +type PersonAPI = "persons" :> Get '[JSON, HTMLLucid] [Person] +``` where `Person` is defined as follows: -> data Person = Person -> { firstName :: String -> , lastName :: String -> } deriving Generic -- for the JSON instance -> -> instance ToJSON Person +``` haskell +data Person = Person + { firstName :: String + , lastName :: String + } deriving Generic -- for the JSON instance + +instance ToJSON Person +``` Now, let's teach *lucid* how to render a `Person` as a row in a table, and then a list of `Person`s as a table with a row per person. -> -- HTML serialization of a single person -> instance ToHtml Person where -> toHtml person = -> tr_ $ do -> td_ (toHtml $ firstName person) -> td_ (toHtml $ lastName person) -> -> -- do not worry too much about this -> toHtmlRaw = toHtml -> -> -- HTML serialization of a list of persons -> instance ToHtml [Person] where -> toHtml persons = table_ $ do -> tr_ $ do -> th_ "first name" -> th_ "last name" -> -> -- this just calls toHtml on each person of the list -> -- and concatenates the resulting pieces of HTML together -> foldMap toHtml persons -> -> toHtmlRaw = toHtml +``` haskell +-- HTML serialization of a single person +instance ToHtml Person where + toHtml person = + tr_ $ do + td_ (toHtml $ firstName person) + td_ (toHtml $ lastName person) + + -- do not worry too much about this + toHtmlRaw = toHtml + +-- HTML serialization of a list of persons +instance ToHtml [Person] where + toHtml persons = table_ $ do + tr_ $ do + th_ "first name" + th_ "last name" + + -- this just calls toHtml on each person of the list + -- and concatenates the resulting pieces of HTML together + foldMap toHtml persons + + toHtmlRaw = toHtml +``` We create some `Person` values and serve them as a list: -> persons :: [Person] -> persons = -> [ Person "Isaac" "Newton" -> , Person "Albert" "Einstein" -> ] -> -> personAPI :: Proxy PersonAPI -> personAPI = Proxy -> -> server4 :: Server PersonAPI -> server4 = return persons -> -> app2 :: Application -> app2 = serve personAPI server4 +``` haskell +persons :: [Person] +persons = + [ Person "Isaac" "Newton" + , Person "Albert" "Einstein" + ] + +personAPI :: Proxy PersonAPI +personAPI = Proxy + +server4 :: Server PersonAPI +server4 = return persons + +app2 :: Application +app2 = serve personAPI server4 +``` And we're good to go. You can run this example with `dist/build/tutorial/tutorial 4`. @@ -666,18 +710,20 @@ class Monad m => MonadIO m where Obviously, the `IO` monad provides a `MonadIO` instance. Hence for any type `e`, `EitherT e IO` has a `MonadIO` instance. So if you want to run any kind of IO computation in your handlers, just use `liftIO`: -> type IOAPI1 = "myfile.txt" :> Get '[JSON] FileContent -> -> newtype FileContent = FileContent -> { content :: String } -> deriving Generic -> -> instance ToJSON FileContent -> -> server5 :: Server IOAPI1 -> server5 = do -> filecontent <- liftIO (readFile "myfile.txt") -> return (FileContent filecontent) +``` haskell +type IOAPI1 = "myfile.txt" :> Get '[JSON] FileContent + +newtype FileContent = FileContent + { content :: String } + deriving Generic + +instance ToJSON FileContent + +server5 :: Server IOAPI1 +server5 = do + filecontent <- liftIO (readFile "myfile.txt") + return (FileContent filecontent) +``` Failing, through `ServantErr` ----------------------------- @@ -701,23 +747,27 @@ Many standard values are provided out of the box by the `Servant.Server` module. If you want to use these values but add a body or some headers, just use record update syntax: -> failingHandler :: EitherT ServantErr IO () -> failingHandler = left myerr -> -> where myerr :: ServantErr -> myerr = err503 { errBody = "Sorry dear user." } +``` haskell +failingHandler :: EitherT ServantErr IO () +failingHandler = left myerr + + where myerr :: ServantErr + myerr = err503 { errBody = "Sorry dear user." } +``` Here's an example where we return a customised 404-Not-Found error message in the response body if "myfile.txt" isn't there: -> server6 :: Server IOAPI1 -> server6 = do -> exists <- liftIO (doesFileExist "myfile.txt") -> if exists -> then liftIO (readFile "myfile.txt") >>= return . FileContent -> else left custom404Err -> -> where custom404Err = err404 { errBody = "myfile.txt just isn't there, please leave this server alone." } +``` haskell +server6 :: Server IOAPI1 +server6 = do + exists <- liftIO (doesFileExist "myfile.txt") + if exists + then liftIO (readFile "myfile.txt") >>= return . FileContent + else left custom404Err + + where custom404Err = err404 { errBody = "myfile.txt just isn't there, please leave this server alone." } +``` Let's run this server (`dist/build/tutorial/tutorial 5`) and query it, first without the file and then with the file. @@ -758,10 +808,12 @@ Response headers To add headers to your response, use [addHeader](http://hackage.haskell.org/package/servant-0.4.4/docs/Servant-API-ResponseHeaders.html). Note that this changes the type of your API, as we can see in the following example: -> type MyHandler = Get '[JSON] (Headers '[Header "X-An-Int" Int] User) -> -> myHandler :: Server MyHandler -> myHandler = return $ addHeader 1797 albert +``` haskell +type MyHandler = Get '[JSON] (Headers '[Header "X-An-Int" Int] User) + +myHandler :: Server MyHandler +myHandler = return $ addHeader 1797 albert +``` Serving static files @@ -786,18 +838,24 @@ getting-started. The API type will be the following. -> type CodeAPI = "code" :> Raw +``` haskell +type CodeAPI = "code" :> Raw +``` And the server: -> codeAPI :: Proxy CodeAPI -> codeAPI = Proxy +``` haskell +codeAPI :: Proxy CodeAPI +codeAPI = Proxy +``` -> server7 :: Server CodeAPI -> server7 = serveDirectory "tutorial" -> -> app3 :: Application -> app3 = serve codeAPI server7 +``` haskell +server7 :: Server CodeAPI +server7 = serveDirectory "tutorial" + +app3 :: Application +app3 = serve codeAPI server7 +``` This server will match any request whose path starts with `/code` and will look for a file at the path described by the rest of the request path, inside the *tutorial/* directory of the path you run the program from. @@ -903,18 +961,22 @@ Nested APIs Let's see how you can define APIs in a modular way, while avoiding repetition. Consider this simple example: -> type UserAPI3 = -- view the user with given userid, in JSON -> Capture "userid" Int :> Get '[JSON] User -> -> :<|> -- delete the user with given userid. empty response -> Capture "userid" Int :> Delete '[] () +``` haskell +type UserAPI3 = -- view the user with given userid, in JSON + Capture "userid" Int :> Get '[JSON] User + + :<|> -- delete the user with given userid. empty response + Capture "userid" Int :> Delete '[] () +``` We can instead factor out the `userid`: -> type UserAPI4 = Capture "userid" Int :> -> ( Get '[JSON] User -> :<|> Delete '[] () -> ) +``` haskell +type UserAPI4 = Capture "userid" Int :> + ( Get '[JSON] User + :<|> Delete '[] () + ) +``` However, you have to be aware that this has an effect on the type of the corresponding `Server`: @@ -930,146 +992,158 @@ Server UserAPI4 = Int -> ( EitherT ServantErr IO User In the first case, each handler receives the *userid* argument. In the latter, the whole `Server` takes the *userid* and has handlers that are just computations in `EitherT`, with no arguments. In other words: -> server8 :: Server UserAPI3 -> server8 = getUser :<|> deleteUser -> -> where getUser :: Int -> EitherT ServantErr IO User -> getUser _userid = error "..." -> -> deleteUser :: Int -> EitherT ServantErr IO () -> deleteUser _userid = error "..." -> -> -- notice how getUser and deleteUser -> -- have a different type! no argument anymore, -> -- the argument directly goes to the whole Server -> server9 :: Server UserAPI4 -> server9 userid = getUser userid :<|> deleteUser userid -> -> where getUser :: Int -> EitherT ServantErr IO User -> getUser = error "..." -> -> deleteUser :: Int -> EitherT ServantErr IO () -> deleteUser = error "..." +``` haskell +server8 :: Server UserAPI3 +server8 = getUser :<|> deleteUser + + where getUser :: Int -> EitherT ServantErr IO User + getUser _userid = error "..." + + deleteUser :: Int -> EitherT ServantErr IO () + deleteUser _userid = error "..." + +-- notice how getUser and deleteUser +-- have a different type! no argument anymore, +-- the argument directly goes to the whole Server +server9 :: Server UserAPI4 +server9 userid = getUser userid :<|> deleteUser userid + + where getUser :: Int -> EitherT ServantErr IO User + getUser = error "..." + + deleteUser :: Int -> EitherT ServantErr IO () + deleteUser = error "..." +``` Note that there's nothing special about `Capture` that lets you "factor it out": this can be done with any combinator. Here are a few examples of APIs with a combinator factored out for which we can write a perfectly valid `Server`. -> -- we just factor out the "users" path fragment -> type API1 = "users" :> -> ( Get '[JSON] [User] -- user listing -> :<|> Capture "userid" Int :> Get '[JSON] User -- view a particular user -> ) -> -> -- we factor out the Request Body -> type API2 = ReqBody '[JSON] User :> -> ( Get '[JSON] User -- just display the same user back, don't register it -> :<|> Post '[JSON] () -- register the user. empty response -> ) -> -> -- we factor out a Header -> type API3 = Header "Authorization" Token :> -> ( Get '[JSON] SecretData -- get some secret data, if authorized -> :<|> ReqBody '[JSON] SecretData :> Post '[] () -- add some secret data, if authorized -> ) -> -> newtype Token = Token ByteString -> newtype SecretData = SecretData ByteString +``` haskell +-- we just factor out the "users" path fragment +type API1 = "users" :> + ( Get '[JSON] [User] -- user listing + :<|> Capture "userid" Int :> Get '[JSON] User -- view a particular user + ) + +-- we factor out the Request Body +type API2 = ReqBody '[JSON] User :> + ( Get '[JSON] User -- just display the same user back, don't register it + :<|> Post '[JSON] () -- register the user. empty response + ) + +-- we factor out a Header +type API3 = Header "Authorization" Token :> + ( Get '[JSON] SecretData -- get some secret data, if authorized + :<|> ReqBody '[JSON] SecretData :> Post '[] () -- add some secret data, if authorized + ) + +newtype Token = Token ByteString +newtype SecretData = SecretData ByteString +``` This approach lets you define APIs modularly and assemble them all into one big API type only at the end. -> type UsersAPI = -> Get '[JSON] [User] -- list users -> :<|> ReqBody '[JSON] User :> Post '[] () -- add a user -> :<|> Capture "userid" Int :> -> ( Get '[JSON] User -- view a user -> :<|> ReqBody '[JSON] User :> Put '[] () -- update a user -> :<|> Delete '[] () -- delete a user -> ) -> -> usersServer :: Server UsersAPI -> usersServer = getUsers :<|> newUser :<|> userOperations -> -> where getUsers :: EitherT ServantErr IO [User] -> getUsers = error "..." -> -> newUser :: User -> EitherT ServantErr IO () -> newUser = error "..." -> -> userOperations userid = -> viewUser userid :<|> updateUser userid :<|> deleteUser userid -> -> where -> viewUser :: Int -> EitherT ServantErr IO User -> viewUser = error "..." -> -> updateUser :: Int -> User -> EitherT ServantErr IO () -> updateUser = error "..." -> -> deleteUser :: Int -> EitherT ServantErr IO () -> deleteUser = error "..." +``` haskell +type UsersAPI = + Get '[JSON] [User] -- list users + :<|> ReqBody '[JSON] User :> Post '[] () -- add a user + :<|> Capture "userid" Int :> + ( Get '[JSON] User -- view a user + :<|> ReqBody '[JSON] User :> Put '[] () -- update a user + :<|> Delete '[] () -- delete a user + ) -> type ProductsAPI = -> Get '[JSON] [Product] -- list products -> :<|> ReqBody '[JSON] Product :> Post '[] () -- add a product -> :<|> Capture "productid" Int :> -> ( Get '[JSON] Product -- view a product -> :<|> ReqBody '[JSON] Product :> Put '[] () -- update a product -> :<|> Delete '[] () -- delete a product -> ) -> -> data Product = Product { productId :: Int } -> -> productsServer :: Server ProductsAPI -> productsServer = getProducts :<|> newProduct :<|> productOperations -> -> where getProducts :: EitherT ServantErr IO [Product] -> getProducts = error "..." -> -> newProduct :: Product -> EitherT ServantErr IO () -> newProduct = error "..." -> -> productOperations productid = -> viewProduct productid :<|> updateProduct productid :<|> deleteProduct productid -> -> where -> viewProduct :: Int -> EitherT ServantErr IO Product -> viewProduct = error "..." -> -> updateProduct :: Int -> Product -> EitherT ServantErr IO () -> updateProduct = error "..." -> -> deleteProduct :: Int -> EitherT ServantErr IO () -> deleteProduct = error "..." +usersServer :: Server UsersAPI +usersServer = getUsers :<|> newUser :<|> userOperations -> type CombinedAPI = "users" :> UsersAPI -> :<|> "products" :> ProductsAPI -> -> server10 :: Server CombinedAPI -> server10 = usersServer :<|> productsServer + where getUsers :: EitherT ServantErr IO [User] + getUsers = error "..." + + newUser :: User -> EitherT ServantErr IO () + newUser = error "..." + + userOperations userid = + viewUser userid :<|> updateUser userid :<|> deleteUser userid + + where + viewUser :: Int -> EitherT ServantErr IO User + viewUser = error "..." + + updateUser :: Int -> User -> EitherT ServantErr IO () + updateUser = error "..." + + deleteUser :: Int -> EitherT ServantErr IO () + deleteUser = error "..." +``` + +``` haskell +type ProductsAPI = + Get '[JSON] [Product] -- list products + :<|> ReqBody '[JSON] Product :> Post '[] () -- add a product + :<|> Capture "productid" Int :> + ( Get '[JSON] Product -- view a product + :<|> ReqBody '[JSON] Product :> Put '[] () -- update a product + :<|> Delete '[] () -- delete a product + ) + +data Product = Product { productId :: Int } + +productsServer :: Server ProductsAPI +productsServer = getProducts :<|> newProduct :<|> productOperations + + where getProducts :: EitherT ServantErr IO [Product] + getProducts = error "..." + + newProduct :: Product -> EitherT ServantErr IO () + newProduct = error "..." + + productOperations productid = + viewProduct productid :<|> updateProduct productid :<|> deleteProduct productid + + where + viewProduct :: Int -> EitherT ServantErr IO Product + viewProduct = error "..." + + updateProduct :: Int -> Product -> EitherT ServantErr IO () + updateProduct = error "..." + + deleteProduct :: Int -> EitherT ServantErr IO () + deleteProduct = error "..." +``` + +``` haskell +type CombinedAPI = "users" :> UsersAPI + :<|> "products" :> ProductsAPI + +server10 :: Server CombinedAPI +server10 = usersServer :<|> productsServer +``` Finally, we can realize the user and product APIs are quite similar and abstract that away: -> -- API for values of type 'a' -> -- indexed by values of type 'i' -> type APIFor a i = -> Get '[JSON] [a] -- list 'a's -> :<|> ReqBody '[JSON] a :> Post '[] () -- add an 'a' -> :<|> Capture "id" i :> -> ( Get '[JSON] a -- view an 'a' given its "identifier" of type 'i' -> :<|> ReqBody '[JSON] a :> Put '[] () -- update an 'a' -> :<|> Delete '[] () -- delete an 'a' -> ) -> -> -- Build the appropriate 'Server' -> -- given the handlers of the right type. -> serverFor :: EitherT ServantErr IO [a] -- handler for listing of 'a's -> -> (a -> EitherT ServantErr IO ()) -- handler for adding an 'a' -> -> (i -> EitherT ServantErr IO a) -- handler for viewing an 'a' given its identifier of type 'i' -> -> (i -> a -> EitherT ServantErr IO ()) -- updating an 'a' with given id -> -> (i -> EitherT ServantErr IO ()) -- deleting an 'a' given its id -> -> Server (APIFor a i) -> serverFor = error "..." -> -- implementation left as an exercise. contact us on IRC -> -- or the mailing list if you get stuck! +``` haskell +-- API for values of type 'a' +-- indexed by values of type 'i' +type APIFor a i = + Get '[JSON] [a] -- list 'a's + :<|> ReqBody '[JSON] a :> Post '[] () -- add an 'a' + :<|> Capture "id" i :> + ( Get '[JSON] a -- view an 'a' given its "identifier" of type 'i' + :<|> ReqBody '[JSON] a :> Put '[] () -- update an 'a' + :<|> Delete '[] () -- delete an 'a' + ) + +-- Build the appropriate 'Server' +-- given the handlers of the right type. +serverFor :: EitherT ServantErr IO [a] -- handler for listing of 'a's + -> (a -> EitherT ServantErr IO ()) -- handler for adding an 'a' + -> (i -> EitherT ServantErr IO a) -- handler for viewing an 'a' given its identifier of type 'i' + -> (i -> a -> EitherT ServantErr IO ()) -- updating an 'a' with given id + -> (i -> EitherT ServantErr IO ()) -- deleting an 'a' given its id + -> Server (APIFor a i) +serverFor = error "..." +-- implementation left as an exercise. contact us on IRC +-- or the mailing list if you get stuck! +``` Using another monad for your handlers ===================================== @@ -1112,28 +1186,32 @@ computation by supplying it with a `String`, like `"hi"`. We get an `a` out from that and can then just `return` it into `EitherT`. We can then just wrap that function with the `Nat` constructor to make it have the fancier type. -> readerToEither' :: forall a. Reader String a -> EitherT ServantErr IO a -> readerToEither' r = return (runReader r "hi") -> -> readerToEither :: Reader String :~> EitherT ServantErr IO -> readerToEither = Nat readerToEither' +``` haskell +readerToEither' :: forall a. Reader String a -> EitherT ServantErr IO a +readerToEither' r = return (runReader r "hi") + +readerToEither :: Reader String :~> EitherT ServantErr IO +readerToEither = Nat readerToEither' +``` We can write some simple webservice with the handlers running in `Reader String`. -> type ReaderAPI = "a" :> Get '[JSON] Int -> :<|> "b" :> Get '[JSON] String -> -> readerAPI :: Proxy ReaderAPI -> readerAPI = Proxy -> -> readerServerT :: ServerT ReaderAPI (Reader String) -> readerServerT = a :<|> b -> -> where a :: Reader String Int -> a = return 1797 -> -> b :: Reader String String -> b = ask +``` haskell +type ReaderAPI = "a" :> Get '[JSON] Int + :<|> "b" :> Get '[JSON] String + +readerAPI :: Proxy ReaderAPI +readerAPI = Proxy + +readerServerT :: ServerT ReaderAPI (Reader String) +readerServerT = a :<|> b + + where a :: Reader String Int + a = return 1797 + + b :: Reader String String + b = ask +``` We unfortunately can't use `readerServerT` as an argument of `serve`, because `serve` wants a `Server ReaderAPI`, i.e., with handlers running in `EitherT @@ -1150,11 +1228,13 @@ and `n` and a `ServerT someapi m`, and returns a `ServerT someapi n`. In our case, we can wrap up our little webservice by using `enter readerToEither` on our handlers. -> readerServer :: Server ReaderAPI -> readerServer = enter readerToEither readerServerT -> -> app4 :: Application -> app4 = serve readerAPI readerServer +``` haskell +readerServer :: Server ReaderAPI +readerServer = enter readerToEither readerServerT + +app4 :: Application +app4 = serve readerAPI readerServer +``` And we can indeed see this webservice in action by running `dist/build/tutorial/tutorial 7`.