From 915a2f8464348e024e7d802b63d9f18eabd828e3 Mon Sep 17 00:00:00 2001
From: Vincent Ambo <tazjin@google.com>
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(-)

(limited to 'services')

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