eved 0.0.2.1 → 0.0.3.0

raw patch · 2 files changed

+37/−19 lines, 2 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• eved.cabal +1/−1
• src/Web/Eved/Server.hs +36/−18

@@ -1,5 +1,5 @@ name:                eved-version:             0.0.2.1+version:             0.0.3.0 synopsis:            A value level web framework description:         A value level web framework in the style of servant homepage:            https://github.com/foxhound-systems/eved#readme

@@ -47,8 +47,23 @@ newtype EvedServerT m a = EvedServerT     { unEvedServerT :: (forall a. m a -> IO a) -> [Text] -> RequestData a -> Application } -server :: (forall a. m a -> IO a) -> a -> EvedServerT m a -> Application-server nt handlers api req resp =+simpleServer :: a -> EvedServerT IO a -> Application+simpleServer =+    server id++server :: (forall a. m a -> IO a)+       -> a+       -> EvedServerT m a+       -> Application+server = hoistServerWithErrorHandler defaultErrorHandler++hoistServerWithErrorHandler+        :: (SomeException -> ServerError)+        -> (forall a. m a -> IO a)+        -> a+        -> EvedServerT m a+        -> Application+hoistServerWithErrorHandler errorHandler nt handlers api req resp =     unEvedServerT api nt (List.dropWhileEnd (== "") (pathInfo req)) (PureRequestData handlers) req resp         `catch` (\case             PathError -> resp $ responseLBS notFound404 [] "Not Found"@@ -58,7 +73,8 @@             NoAcceptMatchError -> resp $ responseLBS notAcceptable406 [] "Not Acceptable"             NoMethodMatchError -> resp $ responseLBS methodNotAllowed405 [] "Method Not Allowed")         `catch` (resp . serverErrorToResponse)-        `catch` (\(UserApplicationError err) -> resp $ serverErrorToResponse $ defaultErrorHandler err)+        `catch` (\(UserApplicationError err) -> resp $ serverErrorToResponse err)+        `catch` (\(UserApplicationError err) -> resp $ serverErrorToResponse $ errorHandler err)  data RoutingError     = PathError@@ -152,21 +168,23 @@                           let ctype = NE.head ctypes                           in pure (NE.head $ CT.mediaTypes ctype, CT.toContentType ctype) -        (rHeaders, rBody) <- renderContent <$>-            case action of-                BodyRequestData fn -> do-                    reqBody <- lazyRequestBody req-                    case fn reqBody of-                        Right res ->-                            nt res `catch` (\(SomeException e) -> throwIO $ UserApplicationError e)-                        Left err ->-                            throwIO $ ServerError-                              { errorStatus = badRequest400-                              , errorBody = LBS.fromStrict $ encodeUtf8 err-                              , errorHeaders = []-                              }-                PureRequestData a ->-                    nt a `catch` (\(SomeException e) -> throwIO $ UserApplicationError e)+        (rHeaders, rBody) <-+                    renderContent <$>+                        case action of+                            BodyRequestData fn -> do+                                reqBody <- lazyRequestBody req+                                case fn reqBody of+                                    Right res ->+                                        nt res+                                    Left err ->+                                        throwIO $ ServerError+                                          { errorStatus = badRequest400+                                          , errorBody = LBS.fromStrict $ encodeUtf8 err+                                          , errorHeaders = []+                                          }+                            PureRequestData a ->+                                nt a+               `catch` (\(SomeException e) -> throwIO $ UserApplicationError e)          resp $ responseLBS status ((hContentType, renderHeader ctype):rHeaders) rBody