defaultMessageWidget

yesod-core/ChangeLog.md

@@ -1,3 +1,7 @@
+## 1.4.30
+
+* Add `defaultMessageWidget`
+
 ## 1.4.29
 
 * Exports some internals and fix version bounds [#1318](https://github.com/yesodweb/yesod/pull/1318)

yesod-core/Yesod/Core/Class/Yesod.hs

@@ -319,6 +319,19 @@ class RenderRoute site => Yesod site where
     yesodWithInternalState :: site -> Maybe (Route site) -> (InternalState -> IO a) -> IO a
     yesodWithInternalState _ _ = bracket createInternalState closeInternalState
     {-# INLINE yesodWithInternalState #-}
+
+    -- | Convert a title and HTML snippet into a 'Widget'. Used
+    -- primarily for wrapping up error messages for better display.
+    --
+    -- @since 1.4.30
+    defaultMessageWidget :: Html -> HtmlUrl (Route site) -> WidgetT site IO ()
+    defaultMessageWidget title body = do
+        setTitle title
+        toWidget
+            [hamlet|
+                <h1>#{title}
+                ^{body}
+            |]
 {-# DEPRECATED urlRenderOverride "Use urlParamRenderOverride instead" #-}
 
 -- | Default implementation of 'makeLogger'. Sends to stdout and
@@ -636,11 +649,7 @@ defaultErrorHandler NotFound = selectRep $ do
     provideRep $ defaultLayout $ do
         r <- waiRequest
         let path' = TE.decodeUtf8With TEE.lenientDecode $ W.rawPathInfo r
-        setTitle "Not Found"
+        defaultMessageWidget "Not Found" [hamlet|<p>#{path'}|]
-        toWidget [hamlet|
-            <h1>Not Found
-            <p>#{path'}
-        |]
     provideRep $ return $ object ["message" .= ("Not Found" :: Text)]
 
 -- For API requests.
@@ -648,12 +657,9 @@ defaultErrorHandler NotFound = selectRep $ do
 -- if you specify an authRoute the user will be redirected there and
 -- this page will not be shown.
 defaultErrorHandler NotAuthenticated = selectRep $ do
-    provideRep $ defaultLayout $ do
+    provideRep $ defaultLayout $ defaultMessageWidget
-        setTitle "Not logged in"
+        "Not logged in"
-        toWidget [hamlet|
+        [hamlet|<p style="display:none;">Set the authRoute and the user will be redirected there.|]
-            <h1>Not logged in
-            <p style="display:none;">Set the authRoute and the user will be redirected there.
-        |]
 
     provideRep $ do
         -- 401 *MUST* include a WWW-Authenticate header
@@ -670,20 +676,16 @@ defaultErrorHandler NotAuthenticated = selectRep $ do
         return $ object $ ("message" .= ("Not logged in"::Text)):content
 
 defaultErrorHandler (PermissionDenied msg) = selectRep $ do
-    provideRep $ defaultLayout $ do
+    provideRep $ defaultLayout $ defaultMessageWidget
-        setTitle "Permission Denied"
+        "Permission Denied"
-        toWidget [hamlet|
+        [hamlet|<p>#{msg}|]
-            <h1>Permission denied
-            <p>#{msg}
-        |]
     provideRep $
         return $ object ["message" .= ("Permission Denied. " <> msg)]
 
 defaultErrorHandler (InvalidArgs ia) = selectRep $ do
-    provideRep $ defaultLayout $ do
+    provideRep $ defaultLayout $ defaultMessageWidget
-        setTitle "Invalid Arguments"
+        "Invalid Arguments"
-        toWidget [hamlet|
+        [hamlet|
-            <h1>Invalid Arguments
             <ul>
                 $forall msg <- ia
                     <li>#{msg}
@@ -692,20 +694,14 @@ defaultErrorHandler (InvalidArgs ia) = selectRep $ do
 defaultErrorHandler (InternalError e) = do
     $logErrorS "yesod-core" e
     selectRep $ do
-        provideRep $ defaultLayout $ do
+        provideRep $ defaultLayout $ defaultMessageWidget
-            setTitle "Internal Server Error"
+            "Internal Server Error"
-            toWidget [hamlet|
+            [hamlet|<pre>#{e}|]
-                <h1>Internal Server Error
-                <pre>#{e}
-            |]
         provideRep $ return $ object ["message" .= ("Internal Server Error" :: Text), "error" .= e]
 defaultErrorHandler (BadMethod m) = selectRep $ do
-    provideRep $ defaultLayout $ do
+    provideRep $ defaultLayout $ defaultMessageWidget
-        setTitle"Bad Method"
+        "Method Not Supported"
-        toWidget [hamlet|
+        [hamlet|<p>Method <code>#{S8.unpack m}</code> not supported|]
-            <h1>Method Not Supported
-            <p>Method <code>#{S8.unpack m}</code> not supported
-        |]
     provideRep $ return $ object ["message" .= ("Bad method" :: Text), "method" .= TE.decodeUtf8With TEE.lenientDecode m]
 
 asyncHelper :: (url -> [x] -> Text)

yesod-core/yesod-core.cabal

@@ -1,5 +1,5 @@
 name:            yesod-core
-version:         1.4.29
+version:         1.4.30
 license:         MIT
 license-file:    LICENSE
 author:          Michael Snoyman <michael@snoyman.com>