git.iko.soy/typeable/servant
on master help sign in
introduce InvalidBody as the 'stickiest' route mismatch reason. code review changes too, to close #14 close #11 close #10
commit9ade9a43f30a18767de5364e34a0dc462ef09723 authorAlp Mestanogullari <alpmestan@gmail.com> dateTue 28 Oct 2014, 16:50 (12 years ago) parent812922d
2 files changed+16−9
compare with master
unifiedsplit
src/Servant/API/Union.hs+3−5 src/Servant/Server.hs+13−4
src/Servant/API/Union.hs+3−5
@@ -16,11 +16,9 @@ instance (HasServer a, HasServer b) => HasServer (a :<|> b) where
1616 type Server (a :<|> b) = Server a :<|> Server b
1717 route Proxy (a :<|> b) request respond =
1818 route pa a request $ \ mResponse ->
19− case isMismatch mResponse of
20− True -> route pb b request $ \mResponse' ->
21− respond (mResponse <> mResponse')
22− False -> respond mResponse
23−
19+ if isMismatch mResponse
20+ then route pb b request $ \mResponse' -> respond (mResponse <> mResponse')
21+ else respond mResponse
2422
2523 where pa = Proxy :: Proxy a
2624 pb = Proxy :: Proxy b
src/Servant/Server.hs+13−4
@@ -27,6 +27,8 @@ toApplication ra request respond = do
2727 respond $ responseLBS notFound404 [] "not found"
2828 routingRespond (Left WrongMethod) =
2929 respond $ responseLBS methodNotAllowed405 [] "method not allowed"
30+ routingRespond (Left InvalidBody) =
31+ respond $ responseLBS badRequest400 [] "Invalid JSON in request body"
3032 routingRespond (Right response) =
3133 respond response
3234
@@ -34,18 +36,25 @@ toApplication ra request respond = do
3436data RouteMismatch =
3537 NotFound -- ^ the usual "not found" error
3638 | WrongMethod -- ^ a more informative "you just got the HTTP method wrong" error
39+ | InvalidBody -- ^ an even more informative "you json request body wasn't valid" error
3740 deriving (Eq, Show)
3841
3942-- |
4043-- @
41−-- 'NotFound' <> x = x
42−-- 'WrongMethod' <> _ = 'WrongMethod'
44+-- > mempty = NotFound
45+-- >
46+-- > NotFound `mappend` x = x
47+-- > WrongMethod `mappend` InvalidBody = InvalidBody
48+-- > WrongMethod `mappend` _ = WrongMethod
49+-- > InvalidBody `mappend` _ = InvalidBody
4350-- @
4451instance Monoid RouteMismatch where
4552 mempty = NotFound
4653
47− NotFound `mappend` x = x
48− WrongMethod `mappend` _ = WrongMethod
54+ NotFound `mappend` x = x
55+ WrongMethod `mappend` InvalidBody = InvalidBody
56+ WrongMethod `mappend` _ = WrongMethod
57+ InvalidBody `mappend` _ = InvalidBody
4958
5059-- | A wrapper around @'Either' 'RouteMismatch' a@.
5160newtype RouteResult a =