document the example some more with some tweaks. push the correspinding updated generated docs too
This commit is contained in:
parent
d36f27a5be
commit
9923d1773e
2 changed files with 48 additions and 16 deletions
|
@ -25,12 +25,16 @@ import Servant.Server
|
||||||
|
|
||||||
-- * Example
|
-- * Example
|
||||||
|
|
||||||
data Greet = Greet { _msg :: Text }
|
-- | A greet message data type
|
||||||
|
newtype Greet = Greet { msg :: Text }
|
||||||
deriving (Generic, Show)
|
deriving (Generic, Show)
|
||||||
|
|
||||||
instance FromJSON Greet
|
instance FromJSON Greet
|
||||||
instance ToJSON Greet
|
instance ToJSON Greet
|
||||||
|
|
||||||
|
-- We add some useful annotations to our captures,
|
||||||
|
-- query parameters and request body to make the docs
|
||||||
|
-- really helpful.
|
||||||
instance ToCapture (Capture "name" Text) where
|
instance ToCapture (Capture "name" Text) where
|
||||||
toCapture _ = DocCapture "name" "name of the person to greet"
|
toCapture _ = DocCapture "name" "name of the person to greet"
|
||||||
|
|
||||||
|
@ -49,26 +53,41 @@ instance ToSample Greet where
|
||||||
|
|
||||||
-- API specification
|
-- API specification
|
||||||
type TestApi =
|
type TestApi =
|
||||||
|
-- GET /hello/:name?capital={true, false} returns a Greet as JSON
|
||||||
"hello" :> Capture "name" Text :> QueryParam "capital" Bool :> Get Greet
|
"hello" :> Capture "name" Text :> QueryParam "capital" Bool :> Get Greet
|
||||||
|
|
||||||
|
-- POST /greet with a Greet as JSON in the request body,
|
||||||
|
-- returns a Greet as JSON
|
||||||
:<|> "greet" :> ReqBody Greet :> Post Greet
|
:<|> "greet" :> ReqBody Greet :> Post Greet
|
||||||
:<|> "delete" :> Capture "greetid" Text :> Delete
|
|
||||||
|
-- DELETE /greet/:greetid
|
||||||
|
:<|> "greet" :> Capture "greetid" Text :> Delete
|
||||||
|
|
||||||
testApi :: Proxy TestApi
|
testApi :: Proxy TestApi
|
||||||
testApi = Proxy
|
testApi = Proxy
|
||||||
|
|
||||||
-- Server-side handlers
|
-- Server-side handlers.
|
||||||
|
--
|
||||||
|
-- There's one handler per endpoint, which, just like in the type
|
||||||
|
-- that represents the API, are glued together using :<|>.
|
||||||
|
--
|
||||||
|
-- Each handler runs in the 'EitherT (Int, String) IO' monad.
|
||||||
server :: Server TestApi
|
server :: Server TestApi
|
||||||
server = hello :<|> greet :<|> delete
|
server = helloH :<|> postGreetH :<|> deleteGreetH
|
||||||
|
|
||||||
where hello name Nothing = hello name (Just False)
|
where helloH name Nothing = helloH name (Just False)
|
||||||
hello name (Just False) = return . Greet $ "Hello, " <> name
|
helloH name (Just False) = return . Greet $ "Hello, " <> name
|
||||||
hello name (Just True) = return . Greet . toUpper $ "Hello, " <> name
|
helloH name (Just True) = return . Greet . toUpper $ "Hello, " <> name
|
||||||
|
|
||||||
greet = return
|
postGreetH greet = return greet
|
||||||
|
|
||||||
delete _ = return ()
|
deleteGreetH _ = return ()
|
||||||
|
|
||||||
-- Client-side query functions
|
-- Client-side querying functions
|
||||||
|
--
|
||||||
|
-- They're all derived automatically from the type, and glued together
|
||||||
|
-- with :<|> just like in the type and for the server handlers, except
|
||||||
|
-- that we don't have to implement them!
|
||||||
clientApi :: Client TestApi
|
clientApi :: Client TestApi
|
||||||
clientApi = client testApi
|
clientApi = client testApi
|
||||||
|
|
||||||
|
@ -77,23 +96,33 @@ postGreet :: Greet -> BaseUrl -> EitherT String IO Greet
|
||||||
deleteGreet :: Text -> BaseUrl -> EitherT String IO ()
|
deleteGreet :: Text -> BaseUrl -> EitherT String IO ()
|
||||||
getGreet :<|> postGreet :<|> deleteGreet = clientApi
|
getGreet :<|> postGreet :<|> deleteGreet = clientApi
|
||||||
|
|
||||||
-- Turn the server into a WAI app
|
-- Turn the server into a WAI app. 'serve' is provided by servant,
|
||||||
|
-- more precisely by the Servant.Server module.
|
||||||
test :: Application
|
test :: Application
|
||||||
test = serve testApi server
|
test = serve testApi server
|
||||||
|
|
||||||
-- Documentation
|
-- Generate the data that lets us have API docs. This
|
||||||
|
-- is derived from the type as well as from
|
||||||
|
-- the 'ToCapture', 'ToParam' and 'ToSample' instances from above.
|
||||||
docsGreet :: API
|
docsGreet :: API
|
||||||
docsGreet = docs testApi
|
docsGreet = docs testApi
|
||||||
|
|
||||||
-- Run the server
|
-- Run the server.
|
||||||
|
--
|
||||||
|
-- 'run' comes from Network.Wai.Handler.Warp
|
||||||
runTestServer :: Port -> IO ()
|
runTestServer :: Port -> IO ()
|
||||||
runTestServer port = run port test
|
runTestServer port = run port test
|
||||||
|
|
||||||
-- Run some queries against the server
|
-- Put this all to work!
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = do
|
main = do
|
||||||
|
-- we start the server, binding it to port 8001
|
||||||
tid <- forkIO $ runTestServer 8001
|
tid <- forkIO $ runTestServer 8001
|
||||||
|
|
||||||
|
-- we tell the client where to find it
|
||||||
let uri = BaseUrl Http "localhost" 8001
|
let uri = BaseUrl Http "localhost" 8001
|
||||||
|
|
||||||
|
-- we run a couple of requests against the server
|
||||||
print =<< runEitherT (getGreet "alp" (Just True) uri)
|
print =<< runEitherT (getGreet "alp" (Just True) uri)
|
||||||
print =<< runEitherT (getGreet "alp" (Just False) uri)
|
print =<< runEitherT (getGreet "alp" (Just False) uri)
|
||||||
let g = Greet "yo"
|
let g = Greet "yo"
|
||||||
|
@ -101,4 +130,6 @@ main = do
|
||||||
print =<< runEitherT (deleteGreet "blah" uri)
|
print =<< runEitherT (deleteGreet "blah" uri)
|
||||||
killThread tid
|
killThread tid
|
||||||
putStrLn "\n---------\n"
|
putStrLn "\n---------\n"
|
||||||
|
|
||||||
|
-- we print the markdown docs
|
||||||
putStrLn $ markdown docsGreet
|
putStrLn $ markdown docsGreet
|
||||||
|
|
|
@ -29,6 +29,7 @@ GET /hello/:name
|
||||||
- **Values**: *true, false*
|
- **Values**: *true, false*
|
||||||
- **Description**: Get the greeting message in uppercase (true) or not (false). Default is false.
|
- **Description**: Get the greeting message in uppercase (true) or not (false). Default is false.
|
||||||
|
|
||||||
|
|
||||||
**Response**:
|
**Response**:
|
||||||
|
|
||||||
- Status code 200
|
- Status code 200
|
||||||
|
@ -38,8 +39,8 @@ GET /hello/:name
|
||||||
{"msg":"Hello, haskeller!"}
|
{"msg":"Hello, haskeller!"}
|
||||||
```
|
```
|
||||||
|
|
||||||
DELETE /delete/:greetid
|
DELETE /greet/:greetid
|
||||||
-----------------------
|
----------------------
|
||||||
|
|
||||||
**Captures**:
|
**Captures**:
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue