fix(tazblog): Ensure build works with MonadFail changes

This updates some old code that makes assumptions via pattern matching
to instead make assumptions via a Prelude function.

This is known to be safe as it has been running fine for almost a
decade now, but the recent MonadFail changes broke the build.
This commit is contained in:
Vincent Ambo 2019-07-02 12:41:20 +01:00
parent b51a53c936
commit 915a2f8464
2 changed files with 11 additions and 10 deletions

View file

@ -13,6 +13,7 @@ import Data.Text (Text)
import qualified Data.Text as T
import Data.Time
import Happstack.Server hiding (Session)
import Data.Maybe (fromJust)
import Blog
import BlogDB hiding (updateEntry)
@ -136,21 +137,22 @@ entryList acid lang = do
editEntry :: AcidState Blog -> Integer -> ServerPart Response
editEntry acid entryId = do
(Just entry) <- query' acid (GetEntry $ EntryId entryId)
ok $ toResponse $ editPage entry
entry <- query' acid (GetEntry $ EntryId entryId)
ok $ toResponse $ editPage $ fromJust entry
updateEntry :: AcidState Blog -> Integer -> ServerPart Response
updateEntry acid entryId = do
decodeBody tmpPolicy
(Just entry) <- query' acid (GetEntry $ EntryId entryId)
entry <- query' acid (GetEntry $ EntryId entryId)
nTitle <- lookText' "title"
nBtext <- lookText' "btext"
nMtext <- lookText' "mtext"
let newEntry = entry { title = nTitle
, btext = nBtext
, mtext = nMtext}
let newEntry = (fromJust entry)
{ title = nTitle
, btext = nBtext
, mtext = nMtext}
update' acid (UpdateEntry newEntry)
seeOther (concat $ ["/", show $ lang entry, "/", show entryId])
seeOther (concat $ ["/", show $ lang newEntry, "/", show entryId])
(toResponse ())
guardSession :: AcidState Blog -> ServerPartT IO ()
@ -183,7 +185,7 @@ processLogin acid = do
let sId = hashString $ show now
addCookie (MaxAge 43200) (mkCookie "session" $ unpack sId)
addCookie (MaxAge 43200) (mkCookie "sUser" $ T.unpack account)
(Just user) <- query' acid (GetUser $ Username account)
let nSession = Session (T.pack $ unpack sId) user now
user <- query' acid (GetUser $ Username account)
let nSession = Session (T.pack $ unpack sId) (fromJust user) now
update' acid (AddSession nSession)
seeOther ("/admin?do=login" :: Text) (toResponse())

View file

@ -2,7 +2,6 @@ Name: tazblog
Version: 5.1.3
Synopsis: Tazjin's Blog
License: MIT
License-file: LICENSE
Author: Vincent Ambo
Maintainer: tazjin@gmail.com
Category: Web blog