diff --git a/hledger-web/Foundation.hs b/hledger-web/Foundation.hs index 04dcc1be7..3ea63d38d 100644 --- a/hledger-web/Foundation.hs +++ b/hledger-web/Foundation.hs @@ -25,6 +25,7 @@ import Settings (staticRoot, widgetFile, Extra (..)) import Settings (staticDir) import Text.Jasmine (minifym) #endif +import Text.Blaze.Html.Renderer.String (renderHtml) import Text.Hamlet (hamletFile) import Hledger.Web.Options @@ -104,7 +105,7 @@ instance Yesod App where defaultLayout widget = do master <- getYesod - mmsg <- getMessage + vd@VD{..} <- getViewData -- We break up the default layout into two components: -- default-layout is the contents of the body tag, and @@ -140,7 +141,6 @@ instance Yesod App where $(widgetFile "default-layout") staticRootUrl <- (staticRoot . settings) <$> getYesod - vd@VD{..} <- getViewData withUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet") -- This is done to provide an optimization for serving static files from @@ -232,8 +232,9 @@ getViewData :: Handler ViewData getViewData = do app <- getYesod let opts@WebOpts{cliopts_=copts@CliOpts{reportopts_=ropts}} = appOpts app - (j, err) <- getCurrentJournal app copts{reportopts_=ropts{no_elide_=True}} - msg <- getMessageOr err + (j, merr) <- getCurrentJournal app copts{reportopts_=ropts{no_elide_=True}} + lastmsg <- getLastMessage + let msg = maybe lastmsg (Just . toHtml) merr Just here <- getCurrentRoute today <- liftIO getCurrentDay q <- getParameterOrNull "q" @@ -275,11 +276,10 @@ getViewData = do getParameterOrNull :: String -> Handler String getParameterOrNull p = unpack `fmap` fromMaybe "" <$> lookupGetParam (pack p) --- | Get the message set by the last request, or the newer message provided, if any. -getMessageOr :: Maybe String -> Handler (Maybe Html) -getMessageOr mnewmsg = do - oldmsg <- getMessage - return $ maybe oldmsg (Just . toHtml) mnewmsg +-- | Get the message that was set by the last request, in a +-- referentially transparent manner (allowing multiple reads). +getLastMessage :: Handler (Maybe Html) +getLastMessage = cached getMessage -- add form dialog, part of the default template @@ -334,7 +334,7 @@ addform _ vd@VD{..} = [hamlet|
| - + | $forall n <- postingnums @@ -344,7 +344,7 @@ addform _ vd@VD{..} = [hamlet| Tab in last field for more (or ctrl +, ctrl -) |] where - date = "today" :: String + defdate = "today" :: String dates = ["today","yesterday","tomorrow"] :: [String] descriptions = sort $ nub $ map tdescription $ jtxns j accts = sort $ journalAccountNamesUsed j diff --git a/hledger-web/Handler/AddForm.hs b/hledger-web/Handler/AddForm.hs index 0de317b75..ed829e20a 100644 --- a/hledger-web/Handler/AddForm.hs +++ b/hledger-web/Handler/AddForm.hs @@ -61,9 +61,9 @@ postAddForm = do <*> iopt textField "description" <*> iopt (check validateJournalFile textField) "journal" - case formresult of - FormMissing -> showErrors ["there is no form data"::String] - FormFailure errs -> showErrors errs + ok <- case formresult of + FormMissing -> showErrors ["there is no form data"::String] >> return False + FormFailure errs -> showErrors errs >> return False FormSuccess dat -> do let AddForm{ addFormDate =date @@ -107,7 +107,7 @@ postAddForm = do ,tpostings=[nullposting{paccount=acct, pamount=Mixed [amt]} | (acct,amt) <- zip accts amts] }) case etxn of - Left errs -> showErrors errs + Left errs -> showErrors errs >> return False Right t -> do -- 3. all fields look good and form a balanced transaction; append it to the file liftIO $ do ensureJournalFileExists journalfile @@ -116,5 +116,6 @@ postAddForm = do txnTieKnot -- XXX move into balanceTransaction t setMessage [shamlet|Transaction added.|] + return True - redirect (JournalR) -- , [("add","1")]) + if ok then redirect JournalR else redirect (JournalR, [("add","1")]) diff --git a/hledger-web/Handler/Common.hs b/hledger-web/Handler/Common.hs index d09b751ec..9a1d06784 100644 --- a/hledger-web/Handler/Common.hs +++ b/hledger-web/Handler/Common.hs @@ -55,8 +55,6 @@ topbar VD{..} = [hamlet| |