Show a 404 when a nonexistant page is accessed

web/src/Main.hs

@@ -8,6 +8,7 @@ import qualified Data.Map                             as Map
 import qualified Data.Text                            as Text
 import           Data.Text.Lazy                       (toStrict)
 import qualified Database.SQLite.Simple               as Db
+import qualified Network.HTTP.Types.Status            as Status
 import qualified Network.Wai.Middleware.RequestLogger as RequestLogger
 import qualified Network.Wai.Middleware.Static        as Static
 import           Text.Blaze.Renderer.Text
@@ -15,6 +16,7 @@ import           Web.Spock                            ((<//>))
 import qualified Web.Spock                            as S
 import qualified Within.DBMemorial.Post               as Post
 import qualified Within.DBMemorial.User               as User
+import qualified Within.DBMemorial.Views.Error        as ErrorView
 import qualified Within.DBMemorial.Views.Materialize  as Materialize
 import qualified Within.DBMemorial.Views.Thread       as Thread
 
@@ -49,6 +51,14 @@ main = do
                 Db.query conn "SELECT * FROM Posts WHERE page=?" (Db.Only (id_ :: Int))
                     :: S.ActionT IO [Post.Post]
 
+            case posts of
+                [] -> do
+                    S.setStatus Status.status404
+
+                    let page = ErrorView.render ("no data for page number " ++ (show id_))
+
+                    S.html $ toStrict $ (renderMarkup (Materialize.render (Text.pack ("Can't find page " ++ (show id_))) page))
+                _ -> do
                     let title = "Thread page " ++ (show id_)
                         page = Thread.render id_ posts userMap
 

web/src/Within/DBMemorial/Views/Error.hs

@@ -0,0 +1,15 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Within.DBMemorial.Views.Error where
+
+import           Text.Blaze.Html
+import           Text.Blaze.Html5            as H hiding (map)
+import           Text.Blaze.Html5.Attributes as A
+
+render :: String -> Html
+render why = do
+    H.div ! A.class_ "card red darken-3" $ do
+        H.div ! A.class_ "card-content white-text center user-card" $ do
+            H.h1 ! A.class_ "center text-orange" $ "404"
+            H.p $                 "Sorry! We couldn't find any data. If this isn't meant to be seen, please let the maintainers know:"
+            H.pre $ H.toHtml why

web/time-wasting-thread-memorial.cabal

@@ -70,6 +70,7 @@ executable time-wasting-thread-memorial
                      , containers >=0.5.0.0
                      , transformers >=0.4.3.0
                      , clay >=0.10.1
+                     , http-types >=0.8.6
 
   -- Directories containing source files.
   hs-source-dirs:      src