git.iko.soy/typeable/servant
on master help sign in
add client, server and docs support for the DELETE HTTP method
commit97d4133eb1a1d5ccbe858c96c1b67d3a0048e633 authorAlp Mestanogullari <alpmestan@gmail.com> dateTue 28 Oct 2014, 09:14 (12 years ago) parent4ebc494
6 files changed+75−3
compare with master
unifiedsplit
example/greet.hs+11−2 servant.cabal+1 src/Servant.hs+2 src/Servant/API.hs+2 src/Servant/API/Delete.hs+58 src/Servant/Docs.hs+1−1
example/greet.hs+11−2
@@ -34,6 +34,9 @@ instance ToJSON Greet
3434instance ToCapture (Capture "name" Text) where
3535 toCapture _ = DocCapture "name" "name of the person to greet"
3636
37+instance ToCapture (Capture "greetid" Text) where
38+ toCapture _ = DocCapture "greetid" "identifier of the greet msg to remove"
39+
3740instance ToParam (GetParam "capital" Bool) where
3841 toParam _ =
3942 DocGetParam "capital"
@@ -49,13 +52,14 @@ instance ToSample Greet where
4952type TestApi =
5053 "hello" :> Capture "name" Text :> GetParam "capital" Bool :> Get Greet
5154 :<|> "greet" :> RQBody Greet :> Post Greet
55+ :<|> "delete" :> Capture "greetid" Text :> Delete
5256
5357testApi :: Proxy TestApi
5458testApi = Proxy
5559
5660-- Server-side handlers
5761server :: Server TestApi
58−server = hello :<|> greet
62+server = hello :<|> greet :<|> delete
5963
6064 where hello name Nothing = hello name (Just False)
6165 hello name (Just False) = return . Greet $ "Hello, " <> name
@@ -63,18 +67,22 @@ server = hello :<|> greet
6367
6468 greet = return
6569
70+ delete _ = return ()
71+
6672-- Client-side query functions
6773clientApi :: Client TestApi
6874clientApi = client testApi
6975
7076getGreet :: Text -> Maybe Bool -> URI -> EitherT String IO Greet
7177postGreet :: Greet -> URI -> EitherT String IO Greet
72−getGreet :<|> postGreet = clientApi
78+deleteGreet :: Text -> URI -> EitherT String IO ()
79+getGreet :<|> postGreet :<|> deleteGreet = clientApi
7380
7481-- Turn the server into a WAI app
7582test :: Application
7683test = serve testApi server
7784
85+-- Documentation
7886docsGreet :: API
7987docsGreet = docs testApi
8088
@@ -91,6 +99,7 @@ main = do
9199 print =<< runEitherT (getGreet "alp" (Just False) uri)
92100 let g = Greet "yo"
93101 print =<< runEitherT (postGreet g uri)
102+ print =<< runEitherT (deleteGreet "blah" uri)
94103 killThread tid
95104 putStrLn "\n---------\n"
96105 printMarkdown docsGreet
servant.cabal+1
@@ -21,6 +21,7 @@ library
2121 Servant.Text
2222 Servant.API
2323 Servant.API.Capture
24+ Servant.API.Delete
2425 Servant.API.Get
2526 Servant.API.GetParam
2627 Servant.API.Post
src/Servant.hs+2
@@ -1,11 +1,13 @@
11module Servant
22 ( module Servant.API
33 , module Servant.Client
4+ , module Servant.Docs
45 , module Servant.Server
56 , module Servant.Text
67 ) where
78
89import Servant.API
910import Servant.Client
11+import Servant.Docs
1012import Servant.Server
1113import Servant.Text
src/Servant/API.hs+2
@@ -1,5 +1,6 @@
11module Servant.API
22 ( module Servant.API.Capture
3+ , module Servant.API.Delete
34 , module Servant.API.Get
45 , module Servant.API.GetParam
56 , module Servant.API.Post
@@ -9,6 +10,7 @@ module Servant.API
910 ) where
1011
1112import Servant.API.Capture
13+import Servant.API.Delete
1214import Servant.API.Get
1315import Servant.API.GetParam
1416import Servant.API.Post
src/Servant/API/Delete.hsnew file+58
@@ -0,0 +1,58 @@
1+{-# LANGUAGE TypeFamilies #-}
2+{-# LANGUAGE OverloadedStrings #-}
3+{-# LANGUAGE ScopedTypeVariables #-}
4+module Servant.API.Delete where
5+
6+import Control.Monad
7+import Control.Monad.IO.Class
8+import Control.Monad.Trans.Either
9+import Data.Proxy
10+import Data.String.Conversions
11+import Network.HTTP.Types
12+import Network.URI
13+import Network.Wai
14+import Servant.Client
15+import Servant.Docs
16+import Servant.Server
17+
18+import qualified Network.HTTP.Client as Client
19+
20+-- | Endpoint for DELETE requests.
21+data Delete
22+
23+instance HasServer Delete where
24+ type Server Delete = EitherT (Int, String) IO ()
25+
26+ route Proxy action _globalPathInfo request respond
27+ | null (pathInfo request) && requestMethod request == methodDelete = do
28+ e <- runEitherT action
29+ respond $ Just $ case e of
30+ Right () ->
31+ responseLBS status204 [] ""
32+ Left (status, message) ->
33+ responseLBS (mkStatus status (cs message)) [] (cs message)
34+ | otherwise = respond Nothing
35+
36+instance HasClient Delete where
37+ type Client Delete = URI -> EitherT String IO ()
38+
39+ clientWithRoute Proxy req uri = do
40+ partialRequest <- liftIO $ reqToRequest req uri
41+
42+ let request = partialRequest { Client.method = methodDelete
43+ }
44+
45+ innerResponse <- liftIO . __withGlobalManager $ \ manager ->
46+ Client.httpLbs request manager
47+
48+ when (Client.responseStatus innerResponse /= status204) $
49+ left ("HTTP DELETE request failed with status: " ++ show (Client.responseStatus innerResponse))
50+
51+instance HasDocs Delete where
52+ docsFor Proxy (endpoint, action) =
53+ single endpoint' action'
54+
55+ where endpoint' = endpoint & method .~ DocDELETE
56+
57+ action' = action & response.respBody .~ Nothing
58+ & response.respStatus .~ 204
src/Servant/Docs.hs+1−1
@@ -398,6 +398,6 @@ printMarkdown = imapM_ printEndpoint
398398 putStrLn $ ""
399399 putStrLn $ " - Status code " ++ show (resp ^. respStatus)
400400 resp ^. respBody &
401− maybe (putStrLn " - No response body")
401+ maybe (putStrLn " - No response body\n")
402402 (\b -> putStrLn " - Response body as below." >> jsonStr b)
403403