Fix JsonView OpenAPI docs after rebase

Author: vincentcombey-design

Guide/view.markdown

@@ -462,7 +462,7 @@ document.addEventListener('ihp:unload', () => {
 
 ## JSON
 
-Views that are rendered by calling the [`render`](https://ihp.digitallyinduced.com/api-docs/IHP-Controller-Render.html#v:render) function can also respond with JSON.
+Views that are rendered by calling the [`renderHtmlOrJson`](https://ihp.digitallyinduced.com/api-docs/IHP-Controller-Render.html#v:renderHtmlOrJson) function can respond with either HTML or JSON based on the request `Accept` header.
 
 Let's say we have a normal HTML view that renders all posts for our blog app:
 
@@ -491,7 +491,7 @@ instance View IndexView where
     |]
 ```
 
-We can add a JSON output for all blog posts by defining a typed [`JsonResponse`](https://ihp.digitallyinduced.com/api-docs/IHP-ViewSupport.html#t:View) payload and implementing [`jsonTyped`](https://ihp.digitallyinduced.com/api-docs/IHP-ViewSupport.html#v:jsonTyped):
+We can add a JSON output for all blog posts by defining a typed [`JsonResponse`](https://ihp.digitallyinduced.com/api-docs/IHP-ViewSupport.html#t:JsonView) payload and implementing [`jsonTyped`](https://ihp.digitallyinduced.com/api-docs/IHP-ViewSupport.html#v:jsonTyped) in a `JsonView` instance:
 
 ```haskell
 {-# LANGUAGE DeriveGeneric #-}
@@ -515,6 +515,7 @@ instance View IndexView where
         ...
     |]
 
+instance JsonView IndexView where
     type JsonResponse IndexView = [PostPayload]
 
     jsonTyped IndexView { .. } =
@@ -528,6 +529,14 @@ instance View IndexView where
 
 In the above code, [`jsonTyped`](https://ihp.digitallyinduced.com/api-docs/IHP-ViewSupport.html#v:jsonTyped) has access to all arguments passed to the view, but returns a normal Haskell value instead of raw `Value`. IHP then turns that into JSON automatically using [`toJSON`](https://ihp.digitallyinduced.com/api-docs/IHP-ViewPrelude.html#v:toJSON).
 
+In the controller, use [`renderHtmlOrJson`](https://ihp.digitallyinduced.com/api-docs/IHP-Controller-Render.html#v:renderHtmlOrJson) instead of `render` for actions that should serve both formats:
+
+```haskell
+action PostsAction = do
+    posts <- query @Post |> fetch
+    renderHtmlOrJson IndexView { .. }
+```
+
 The full `Index` View for our `PostsController` looks like this:
 
 ```haskell
@@ -573,6 +582,7 @@ instance View IndexView where
         </div>
     |]
 
+instance JsonView IndexView where
     type JsonResponse IndexView = [PostPayload]
 
     jsonTyped IndexView { .. } =
@@ -593,7 +603,7 @@ renderPost post = [hsx|
 |]
 ```
 
-You can still override [`json`](https://ihp.digitallyinduced.com/api-docs/IHP-ViewSupport.html#v:json) directly for backwards compatibility. The typed `JsonResponse` / `jsonTyped` style is preferred because it is also the representation used by IHP's OpenAPI support.
+You can still override [`json`](https://ihp.digitallyinduced.com/api-docs/IHP-ViewSupport.html#v:json) directly in `JsonView` for backwards compatibility. The typed `JsonResponse` / `jsonTyped` style is preferred because it is also the representation used by IHP's OpenAPI support.
 
 ### Getting JSON responses
 
@@ -641,6 +651,7 @@ instance ToSchema PostPayload
 instance View IndexView where
     html IndexView { .. } = [hsx|...|]
 
+instance JsonView IndexView where
     type JsonResponse IndexView = [PostPayload]
     jsonTyped IndexView { .. } = posts |> map (\post -> PostPayload { id = post.id, title = post.title })
 

ihp/IHP/RouterSupport.hs

@@ -98,7 +98,6 @@ import GHC.TypeLits
 import GHC.TypeLits as T
 import IHP.Controller.Context
 import IHP.Controller.Param
-import IHP.Controller.Response (ResponseException(..))
 import IHP.ControllerSupport
 import IHP.ErrorController qualified as ErrorController
 import IHP.FrameworkConfig
@@ -229,6 +228,7 @@ actionDocFor ::
     forall actionName view controller.
     ( KnownSymbol actionName
     , ViewSupport.View view
+    , ViewSupport.JsonView view
     , Typeable.Typeable view
     , JSON.ToJSON (ViewSupport.JsonResponse view)
     , ToSchema (ViewSupport.JsonResponse view)
@@ -254,6 +254,7 @@ actionDocForRequestBody ::
     ( KnownSymbol actionName
     , HasOpenApiRequestBody controller actionName
     , ViewSupport.View view
+    , ViewSupport.JsonView view
     , Typeable.Typeable view
     , JSON.ToJSON (ViewSupport.JsonResponse view)
     , ToSchema (ViewSupport.JsonResponse view)
@@ -550,16 +551,16 @@ openApiRenderExpectationKey :: Vault.Key DocumentedRenderExpectation
 openApiRenderExpectationKey = unsafePerformIO Vault.newKey
 {-# NOINLINE openApiRenderExpectationKey #-}
 
-throwOpenApiRenderMismatch :: Text -> IO a
+throwOpenApiRenderMismatch :: (?request :: Request, ?respond :: Respond) => Text -> IO a
 throwOpenApiRenderMismatch message =
-    Exception.throwIO
-        (ResponseException (responseLBS status500 [(hContentType, "text/plain")] (cs message)))
+    respondAndExit (responseLBS status500 [(hContentType, "text/plain")] (cs message))
 {-# INLINE throwOpenApiRenderMismatch #-}
 
 validateOpenApiRenderedView
     :: forall view.
         ( Typeable.Typeable view
         , ?request :: Request
+        , ?respond :: Respond
         )
     => view
     -> JSON.Value

ihp/Test/Test/OpenApiSupportSpec.hs

@@ -98,6 +98,7 @@ instance ToSchema CreateSessionRequest
 instance View BandView where
     html BandView{..} = [hsx||]
 
+instance JsonView BandView where
     type JsonResponse BandView = BandPayload
 
     jsonTyped BandView{..} =
@@ -110,6 +111,7 @@ instance View BandView where
 instance View LegacyJsonView where
     html LegacyJsonView = [hsx||]
 
+instance JsonView LegacyJsonView where
     json LegacyJsonView =
         JSON.object
             [ "legacy" JSON..= True
@@ -118,6 +120,7 @@ instance View LegacyJsonView where
 instance View WrongJsonShapeView where
     html WrongJsonShapeView{..} = [hsx||]
 
+instance JsonView WrongJsonShapeView where
     type JsonResponse WrongJsonShapeView = BandPayload
 
     jsonTyped WrongJsonShapeView{..} =
@@ -135,6 +138,7 @@ instance View WrongJsonShapeView where
 instance View DocumentedCustomPathView where
     html DocumentedCustomPathView{..} = [hsx||]
 
+instance JsonView DocumentedCustomPathView where
     type JsonResponse DocumentedCustomPathView = BandPayload
 
     jsonTyped DocumentedCustomPathView{..} =
@@ -147,6 +151,7 @@ instance View DocumentedCustomPathView where
 instance View AckView where
     html AckView = [hsx||]
 
+instance JsonView AckView where
     type JsonResponse AckView = AckPayload
 
     jsonTyped AckView = AckPayload{ok = True}