@@ -16,18 +16,18 @@ import Data.IORef (newIORef, readIORef, writeIORef)
1616import Data.List (unfoldr)
1717import Data.Maybe (catMaybes, fromMaybe)
1818import Data.Monoid (Monoid, mempty, mappend)
19−import Data.Proxy (Proxy(Proxy))
2019import Data.String (fromString)
2120import Data.String.Conversions (cs, (<>))
2221import Data.Text.Encoding (decodeUtf8, encodeUtf8)
2322import Data.Text (Text)
2423import qualified Data.Text as T
24+import Data.Typeable
2525import GHC.TypeLits (KnownSymbol, symbolVal)
2626import Network.HTTP.Types hiding (Header)
2727import Network.Wai (Response, Request, ResponseReceived, Application, pathInfo, requestBody,
2828 strictRequestBody, lazyRequestBody, requestHeaders, requestMethod,
2929 rawQueryString, responseLBS)
30−import Servant.API (QueryParams, QueryParam, QueryFlag, MatrixParams, MatrixParam, MatrixFlag, ReqBody, Header, Capture, Get, Delete, Put, Post, Raw, (:>), (:<|>)(..))
30+import Servant.API (QueryParams, QueryParam, QueryFlag, MatrixParams, MatrixParam, MatrixFlag, ReqBody, Header, Capture, Get, Delete, Put, Post, Patch, Raw, (:>), (:<|>)(..))
3131import Servant.Common.Text (FromText, fromText)
3232
3333data ReqBodyState = Uncalled
@@ -363,6 +363,33 @@ instance ToJSON a => HasServer (Put a) where
363363
364364 | otherwise = respond $ failWith NotFound
365365
366+-- | When implementing the handler for a 'Patch' endpoint,
367+-- just like for 'Servant.API.Delete.Delete', 'Servant.API.Get.Get'
368+-- and 'Servant.API.Put.Put', the handler code runs in the
369+-- @EitherT (Int, String) IO@ monad, where the 'Int' represents
370+-- the status code and the 'String' a message, returned in case of
371+-- failure. You can quite handily use 'Control.Monad.Trans.EitherT.left'
372+-- to quickly fail if some conditions are not met.
373+--
374+-- If successfully returning a value, we just require that its type has
375+-- a 'ToJSON' instance and servant takes care of encoding it for you,
376+-- yielding status code 201 along the way.
377+instance (Typeable a, ToJSON a) => HasServer (Patch a) where
378+ type Server (Patch a) = EitherT (Int, String) IO a
379+
380+ route Proxy action request respond
381+ | pathIsEmpty request && requestMethod request == methodPost = do
382+ e <- runEitherT action
383+ respond . succeedWith $ case e of
384+ Right out -> case cast out of
385+ Nothing -> responseLBS status200 [("Content-Type", "application/json")] (encode out)
386+ Just () -> responseLBS status204 [] ""
387+ Left (status, message) ->
388+ responseLBS (mkStatus status (cs message)) [] (cs message)
389+ | pathIsEmpty request && requestMethod request /= methodPost =
390+ respond $ failWith WrongMethod
391+ | otherwise = respond $ failWith NotFound
392+
366393-- | If you use @'QueryParam' "author" Text@ in one of the endpoints for your API,
367394-- this automatically requires your server-side handler to be a function
368395-- that takes an argument of type @'Maybe' 'Text'@.