Added custom error page when a blog post cannot be found.

diff --git a/package.yaml b/package.yaml
index fcd487f..5c170d9 100644 (file)
--- a/package.yaml
+++ b/package.yaml
@@ -30,6 +30,7 @@ dependencies:
 - http-media == 0.8.0.0
 - lucid == 2.9.12.1
 - mtl == 2.2.2
+- safe-exceptions == 0.1.7.1
 - servant == 0.18.2
 - servant-lucid == 0.9.0.2
 - servant-server == 0.18.2

diff --git a/src/Html.hs b/src/Html.hs
index a6a2ca8..3ed063a 100644 (file)
--- a/src/Html.hs
+++ b/src/Html.hs
@@ -1,6 +1,7 @@
 module Html where
 
 import ApiTypes
+import Control.Exception.Safe (SomeException)
 import Control.Monad (void)
 import Control.Monad.IO.Class (MonadIO(..), liftIO)
 import Data.List (sort)
@@ -42,6 +43,12 @@ blogListItem theme (blogLink -> (Just file)) = li_ [class_ "blog-link"] $ a_ [hr
 blogLink :: T.Text -> Maybe T.Text
 blogLink = T.stripSuffix markdownExtension
 
+blogNotFound :: (MonadIO m) => Maybe Theme -> BlogId -> SomeException -> m (Html ())
+blogNotFound theme blogId _ = htmlContainer theme $ do
+  div_ [class_ "not-found"] $ do
+    h1_ $ toHtml @T.Text "Blog not found"
+    p_ $ toHtml $ "Blog post " <> T.pack blogId <> " could not found."
+
 siteTitle :: T.Text
 siteTitle = "My Site"
 

diff --git a/src/Server.hs b/src/Server.hs
index 3b7616f..7bf770d 100644 (file)
--- a/src/Server.hs
+++ b/src/Server.hs
@@ -1,6 +1,7 @@
 module Server where
 
 import ApiTypes
+import Control.Exception.Safe (handleAny)
 import Control.Monad ((<=<))
 import Control.Monad.IO.Class (liftIO)
 import Html
@@ -25,7 +26,7 @@ mainPage :: Maybe Theme -> Handler (Html ())
 mainPage = flip blogPost "index"
 
 blogPost :: Maybe Theme -> BlogId -> Handler (Html ())
-blogPost theme = htmlContainer theme . renderBlog <=< findBlogPost
+blogPost theme blogId = handleAny (blogNotFound theme blogId) $ findBlogPost blogId >>= htmlContainer theme . renderBlog
 
 findBlogPost :: BlogId -> Handler T.Text
 findBlogPost = liftIO . T.readFile . (<>) staticPath . flip (<>) (T.unpack markdownExtension)