git.iko.soy/servant
on af00035 help sign in
servant/src/Servant/API/Put.hs
55 lines 1.7 kB history raw
1{-# LANGUAGE TypeFamilies #-}
2{-# LANGUAGE OverloadedStrings #-}
3{-# LANGUAGE ScopedTypeVariables #-}
4{-# LANGUAGE DeriveDataTypeable #-}
5module Servant.API.Put where
7import Control.Monad.Trans.Either
8import Data.Aeson
9import Data.Proxy
10import Data.String.Conversions
11import Data.Typeable
12import Network.HTTP.Types
13import Network.Wai
14import Servant.Client
15import Servant.Docs
16import Servant.Server
17import Servant.Utils.BaseUrl
18import Servant.Utils.Req
20-- | Endpoint for PUT requests.
21data Put a
22 deriving Typeable
24instance ToJSON a => HasServer (Put a) where
25 type Server (Put a) = EitherT (Int, String) IO a
27 route Proxy action request respond
28 | null (pathInfo request) && requestMethod request == methodPut = do
29 e <- runEitherT action
30 respond . succeedWith $ case e of
31 Right out ->
32 responseLBS ok200 [("Content-Type", "application/json")] (encode out)
33 Left (status, message) ->
34 responseLBS (mkStatus status (cs message)) [] (cs message)
35 | null (pathInfo request) && requestMethod request /= methodPut =
36 respond $ failWith WrongMethod
38 | otherwise = respond $ failWith NotFound
40instance FromJSON a => HasClient (Put a) where
41 type Client (Put a) = BaseUrl -> EitherT String IO a
43 clientWithRoute Proxy req host =
44 performRequest methodPut req 200 host
46instance ToSample a => HasDocs (Put a) where
47 docsFor Proxy (endpoint, action) =
48 single endpoint' action'
50 where endpoint' = endpoint & method .~ DocPUT
52 action' = action & response.respBody .~ toSample p
53 & response.respStatus .~ 200
55 p = Proxy :: Proxy a