diff options
author | Vincent Ambo <tazjin@google.com> | 2019-07-02T11·41+0100 |
---|---|---|
committer | Vincent Ambo <tazjin@google.com> | 2019-07-02T11·42+0100 |
commit | 915a2f8464348e024e7d802b63d9f18eabd828e3 (patch) | |
tree | b9cd1489bbee774df32107875bd5760157fb94a2 /services | |
parent | b51a53c936c0a5f9cdd75a911361443c3016c980 (diff) |
fix(tazblog): Ensure build works with MonadFail changes r/8
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.
Diffstat (limited to 'services')
-rw-r--r-- | services/tazblog/src/Server.hs | 20 | ||||
-rw-r--r-- | 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 |