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
|
||||
|
||||
data Greet = Greet { _msg :: Text }
|
||||
-- | A greet message data type
|
||||
newtype Greet = Greet { msg :: Text }
|
||||
deriving (Generic, Show)
|
||||
|
||||
instance FromJSON 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
|
||||
toCapture _ = DocCapture "name" "name of the person to greet"
|
||||
|
||||
|
@ -49,26 +53,41 @@ instance ToSample Greet where
|
|||
|
||||
-- API specification
|
||||
type TestApi =
|
||||
-- GET /hello/:name?capital={true, false} returns a Greet as JSON
|
||||
"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
|
||||
:<|> "delete" :> Capture "greetid" Text :> Delete
|
||||
|
||||
-- DELETE /greet/:greetid
|
||||
:<|> "greet" :> Capture "greetid" Text :> Delete
|
||||
|
||||
testApi :: Proxy TestApi
|
||||
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 = hello :<|> greet :<|> delete
|
||||
server = helloH :<|> postGreetH :<|> deleteGreetH
|
||||
|
||||
where hello name Nothing = hello name (Just False)
|
||||
hello name (Just False) = return . Greet $ "Hello, " <> name
|
||||
hello name (Just True) = return . Greet . toUpper $ "Hello, " <> name
|
||||
where helloH name Nothing = helloH name (Just False)
|
||||
helloH name (Just False) = return . Greet $ "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
|
||||
|
||||
|
@ -77,23 +96,33 @@ postGreet :: Greet -> BaseUrl -> EitherT String IO Greet
|
|||
deleteGreet :: Text -> BaseUrl -> EitherT String IO ()
|
||||
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 = 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 = docs testApi
|
||||
|
||||
-- Run the server
|
||||
-- Run the server.
|
||||
--
|
||||
-- 'run' comes from Network.Wai.Handler.Warp
|
||||
runTestServer :: Port -> IO ()
|
||||
runTestServer port = run port test
|
||||
|
||||
-- Run some queries against the server
|
||||
-- Put this all to work!
|
||||
main :: IO ()
|
||||
main = do
|
||||
-- we start the server, binding it to port 8001
|
||||
tid <- forkIO $ runTestServer 8001
|
||||
|
||||
-- we tell the client where to find it
|
||||
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 False) uri)
|
||||
let g = Greet "yo"
|
||||
|
@ -101,4 +130,6 @@ main = do
|
|||
print =<< runEitherT (deleteGreet "blah" uri)
|
||||
killThread tid
|
||||
putStrLn "\n---------\n"
|
||||
|
||||
-- we print the markdown docs
|
||||
putStrLn $ markdown docsGreet
|
||||
|
|
|
@ -29,6 +29,7 @@ GET /hello/:name
|
|||
- **Values**: *true, false*
|
||||
- **Description**: Get the greeting message in uppercase (true) or not (false). Default is false.
|
||||
|
||||
|
||||
**Response**:
|
||||
|
||||
- Status code 200
|
||||
|
@ -38,8 +39,8 @@ GET /hello/:name
|
|||
{"msg":"Hello, haskeller!"}
|
||||
```
|
||||
|
||||
DELETE /delete/:greetid
|
||||
-----------------------
|
||||
DELETE /greet/:greetid
|
||||
----------------------
|
||||
|
||||
**Captures**:
|
||||
|
||||
|
|
Loading…
Reference in a new issue