document the example some more with some tweaks. push the correspinding updated generated docs too

This commit is contained in:
Alp Mestanogullari 2014-11-25 18:13:18 +01:00
parent d36f27a5be
commit 9923d1773e
2 changed files with 48 additions and 16 deletions

View file

@ -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

View file

@ -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**: