From 915a2f8464348e024e7d802b63d9f18eabd828e3 Mon Sep 17 00:00:00 2001 From: Vincent Ambo Date: Tue, 2 Jul 2019 12:41:20 +0100 Subject: 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. --- services/tazblog/src/Server.hs | 20 +++++++++++--------- services/tazblog/tazblog.cabal | 1 - 2 files changed, 11 insertions(+), 10 deletions(-) diff --git a/services/tazblog/src/Server.hs b/services/tazblog/src/Server.hs index c025be009a2e..c05e3afb195e 100644 --- a/services/tazblog/src/Server.hs +++ b/services/tazblog/src/Server.hs @@ -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()) diff --git a/services/tazblog/tazblog.cabal b/services/tazblog/tazblog.cabal index 3ca9d373b277..4e784f49b1b5 100644 --- a/services/tazblog/tazblog.cabal +++ b/services/tazblog/tazblog.cabal @@ -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 -- cgit 1.4.1