git.iko.soy/servant
on 85acead help sign in
servant/src/Servant/API/Put.hs
54 lines 1.6 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.Client
19-- | Endpoint for PUT requests.
20data Put a
21 deriving Typeable
23instance ToJSON a => HasServer (Put a) where
24 type Server (Put a) = EitherT (Int, String) IO a
26 route Proxy action request respond
27 | null (pathInfo request) && requestMethod request == methodPut = do
28 e <- runEitherT action
29 respond . succeedWith $ case e of
30 Right out ->
31 responseLBS ok200 [("Content-Type", "application/json")] (encode out)
32 Left (status, message) ->
33 responseLBS (mkStatus status (cs message)) [] (cs message)
34 | null (pathInfo request) && requestMethod request /= methodPut =
35 respond $ failWith WrongMethod
37 | otherwise = respond $ failWith NotFound
39instance FromJSON a => HasClient (Put a) where
40 type Client (Put a) = BaseUrl -> EitherT String IO a
42 clientWithRoute Proxy req host =
43 performRequest methodPut req 200 host
45instance ToSample a => HasDocs (Put a) where
46 docsFor Proxy (endpoint, action) =
47 single endpoint' action'
49 where endpoint' = endpoint & method .~ DocPUT
51 action' = action & response.respBody .~ toSample p
52 & response.respStatus .~ 200
54 p = Proxy :: Proxy a