web: stay in add form when there are errors

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|
      <table style="width:100%;">
       <tr#descriptionrow>
        <td>
-        <input #date        .typeahead .form-control .input-lg type=text size=15 name=date placeholder="Date" value=#{date}>
+        <input #date        .typeahead .form-control .input-lg type=text size=15 name=date placeholder="Date" value=#{defdate}>
        <td>
         <input #description .typeahead .form-control .input-lg type=text size=40 name=description placeholder="Description">
    $forall n <- postingnums
@@ -344,7 +344,7 @@ addform _ vd@VD{..} = [hamlet|
      Tab in last field for <a .small href="#" onclick="addformAddPosting(); return false;">more</a> (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

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|<span>Transaction added.|]
+        return True
 
-  redirect (JournalR) -- , [("add","1")])
+  if ok then redirect JournalR else redirect (JournalR, [("add","1")])

hledger-web/Handler/Common.hs

@@ -55,8 +55,6 @@ topbar VD{..} = [hamlet|
 <nav class="navbar" role="navigation">
  <div#topbar>
   <h1>#{title}
- $maybe m' <- msg
-  <div#message>#{m'}
 |]
   where
     title = takeFileName $ journalFilePath j

hledger-web/static/hledger.js

@@ -6,7 +6,7 @@
 $(document).ready(function() {
 
   // show add form if ?add=1
-  if ($.url.param('add')) { addformShow(); }
+  if ($.url.param('add')) { addformShow(showmsg=true); }
 
   // sidebar account hover handlers
   $('#sidebar td a').mouseenter(function(){ $(this).parent().addClass('mouseover'); });
@@ -126,8 +126,8 @@ function registerChartClick(ev, pos, item) {
 //----------------------------------------------------------------------
 // ADD FORM
 
-function addformShow() {
-  addformReset();
+function addformShow(showmsg=false) {
+  addformReset(showmsg);
   $('#addmodal')
     .on('shown.bs.modal', function (e) {
       addformFocus();
@@ -136,13 +136,14 @@ function addformShow() {
 }
 
 // Make sure the add form is empty and clean for display.
-function addformReset() {
+function addformReset(showmsg=false) {
   if ($('form#addform').length > 0) {
+    if (!showmsg) $('div#message').html('');
     $('form#addform')[0].reset();
-    $('input#date').val('today');
     // reset typehead state (though not fetched completions)
     $('.typeahead').typeahead('val', '');
     $('.tt-dropdown-menu').hide();
+    $('input#date').val('today');
   }
 }
 

hledger-web/templates/default-layout-wrapper.hamlet

@@ -100,4 +100,7 @@ $newline never
                 <button type="button" .close data-dismiss="modal" aria-hidden="true">&times;
                 <h3 .modal-title #addLabel>Add a transaction
               <div .modal-body>
+                $maybe m <- msg
+                  $if isPrefixOf "Errors" (renderHtml m)
+                    <div #message>#{m}
                 ^{addform staticRootUrl vd}

hledger-web/templates/default-layout.hamlet

@@ -1,3 +1,4 @@
-$maybe msg <- mmsg
-    <div #message>#{msg}
+$maybe m <- msg
+  $if not $ isPrefixOf "Errors" (renderHtml m)
+    <div #message>#{m}
 ^{widget}