Show a 404 when a nonexistant page is accessed
This commit is contained in:
parent
a0beb7cc6b
commit
a8147c2461
|
@ -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,7 +51,15 @@ main = do
|
|||
Db.query conn "SELECT * FROM Posts WHERE page=?" (Db.Only (id_ :: Int))
|
||||
:: S.ActionT IO [Post.Post]
|
||||
|
||||
let title = "Thread page " ++ (show id_)
|
||||
page = Thread.render id_ posts userMap
|
||||
case posts of
|
||||
[] -> do
|
||||
S.setStatus Status.status404
|
||||
|
||||
S.html $ toStrict (renderMarkup (Materialize.render (Text.pack title) page))
|
||||
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
|
||||
|
||||
S.html $ toStrict (renderMarkup (Materialize.render (Text.pack title) page))
|
||||
|
|
|
@ -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
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue