web: Add yesod-form-generated AddForm, add GET & POST /add

hledger-web/config/routes

@@ -4,9 +4,6 @@
 /                RootR           GET
 /journal         JournalR        GET
 /register        RegisterR       GET
-/add             AddR            POST
+/add             AddR            GET POST
-/edit            EditR           POST
+/edit            EditR           GET POST
-/import          ImportR         POST
+/import          ImportR         GET POST
-
--- /accounts        AccountsR       GET
--- /api/accounts    AccountsJsonR   GET

hledger-web/hledger-web.cabal

@@ -123,14 +123,12 @@ library
   exposed-modules:
       Application
       Foundation
-      Handler.AddForm
       Handler.AddR
       Handler.Common
       Handler.EditR
       Handler.ImportR
       Handler.JournalR
       Handler.RegisterR
-      Handler.RootR
       Hledger.Web
       Hledger.Web.Main
       Hledger.Web.WebOptions
@@ -138,6 +136,8 @@ library
       Settings
       Settings.Development
       Settings.StaticFiles
+      Widget.AddForm
+      Widget.Common
   other-modules:
       Paths_hledger_web
   ghc-options: -Wall

hledger-web/package.yaml

@@ -118,14 +118,12 @@ library:
   exposed-modules:
   - Application
   - Foundation
-  - Handler.AddForm
   - Handler.AddR
   - Handler.Common
   - Handler.EditR
   - Handler.ImportR
   - Handler.JournalR
   - Handler.RegisterR
-  - Handler.RootR
   - Hledger.Web
   - Hledger.Web.Main
   - Hledger.Web.WebOptions
@@ -133,6 +131,8 @@ library:
   - Settings
   - Settings.Development
   - Settings.StaticFiles
+  - Widget.AddForm
+  - Widget.Common
 
 executables:
   hledger-web:

hledger-web/src/Application.hs

@@ -1,10 +1,10 @@
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 {-# LANGUAGE CPP, OverloadedStrings, TemplateHaskell #-}
 module Application
-    ( makeApplication
+  ( makeApplication
-    , getApplicationDev
+  , getApplicationDev
-    , makeFoundation
+  , makeFoundation
-    ) where
+  ) where
 
 import Import
 
@@ -15,15 +15,13 @@ import Network.HTTP.Client (defaultManagerSettings)
 import Network.HTTP.Conduit (newManager)
 import Yesod.Default.Config
 import Yesod.Default.Main (defaultDevelApp)
-import Yesod.Default.Handlers (getFaviconR, getRobotsR)
 
-import Handler.AddR (postAddR)
+import Handler.AddR (getAddR, postAddR)
-import Handler.EditR (postEditR)
+import Handler.Common (getFaviconR, getRobotsR, getRootR)
-import Handler.ImportR (postImportR)
+import Handler.EditR (getEditR, postEditR)
+import Handler.ImportR (getImportR, postImportR)
 import Handler.JournalR (getJournalR)
 import Handler.RegisterR (getRegisterR)
-import Handler.RootR (getRootR)
-
 import Hledger.Data (Journal, nulljournal)
 import Hledger.Read (readJournalFile)
 import Hledger.Utils (error')
@@ -46,7 +44,7 @@ makeApplication opts' j' conf' = do
     logWare <$> toWaiAppPlain foundation
   where
     logWare | development  = logStdoutDev
-            | serve_ opts'  = logStdout
+            | serve_ opts' = logStdout
             | otherwise    = id
 
 makeFoundation :: AppConfig DefaultEnv Extra -> WebOpts -> IO App

hledger-web/src/Foundation.hs

@@ -6,7 +6,6 @@
 module Foundation where
 
 import Data.IORef (IORef, readIORef, writeIORef)
-import Data.List (isPrefixOf)
 import Data.Maybe (fromMaybe)
 import Data.Text (Text)
 import qualified Data.Text as T
@@ -14,16 +13,15 @@ import Data.Time.Calendar (Day)
 import Network.HTTP.Conduit (Manager)
 import System.FilePath (takeFileName)
 import Text.Blaze (Markup)
-import Text.Blaze.Html.Renderer.String (renderHtml)
 import Text.Hamlet (hamletFile)
 import Yesod
 import Yesod.Static
 import Yesod.Default.Config
 
-import Handler.AddForm
+import Settings (Extra(..), widgetFile)
-import Handler.Common (balanceReportAsHtml)
 import Settings.StaticFiles
-import Settings (widgetFile, Extra (..))
+import Widget.Common (balanceReportAsHtml)
+
 #ifndef DEVELOPMENT
 import Settings (staticDir)
 import Text.Jasmine (minifym)
@@ -87,7 +85,8 @@ instance Yesod App where
 
   defaultLayout widget = do
     master <- getYesod
-    VD{am, here, j, opts, q, qopts, showsidebar} <- getViewData
+    here <- fromMaybe RootR <$> getCurrentRoute
+    VD {am, j, opts, q, qopts, showsidebar} <- getViewData
     msg <- getMessage
 
     let journalcurrent = if here == JournalR then "inacct" else "" :: Text
@@ -152,18 +151,17 @@ instance RenderMessage App FormMessage where
 -- XXX Parameter p - show/hide postings
 
 -- | A bundle of data useful for hledger-web request handlers and templates.
-data ViewData = VD {
+data ViewData = VD
-     opts         :: WebOpts    -- ^ the command-line options at startup
+  { opts         :: WebOpts    -- ^ the command-line options at startup
-    ,here         :: AppRoute   -- ^ the current route
+  , today        :: Day        -- ^ today's date (for queries containing relative dates)
-    ,today        :: Day        -- ^ today's date (for queries containing relative dates)
+  , j            :: Journal    -- ^ the up-to-date parsed unfiltered journal
-    ,j            :: Journal    -- ^ the up-to-date parsed unfiltered journal
+  , q            :: Text       -- ^ the current q parameter, the main query expression
-    ,q            :: Text       -- ^ the current q parameter, the main query expression
+  , m            :: Query      -- ^ a query parsed from the q parameter
-    ,m            :: Query      -- ^ a query parsed from the q parameter
+  , qopts        :: [QueryOpt] -- ^ query options parsed from the q parameter
-    ,qopts        :: [QueryOpt] -- ^ query options parsed from the q parameter
+  , am           :: Query      -- ^ a query parsed from the accounts sidebar query expr ("a" parameter)
-    ,am           :: Query      -- ^ a query parsed from the accounts sidebar query expr ("a" parameter)
+  , aopts        :: [QueryOpt] -- ^ query options parsed from the accounts sidebar query expr
-    ,aopts        :: [QueryOpt] -- ^ query options parsed from the accounts sidebar query expr
+  , showsidebar  :: Bool       -- ^ current showsidebar cookie value
-    ,showsidebar  :: Bool       -- ^ current showsidebar cookie value
+  } deriving (Show)
-    } deriving (Show)
 
 instance Show Text.Blaze.Markup where show _ = "<blaze markup>"
 
@@ -178,7 +176,6 @@ viewdataWithDateAndParams d q a =
       (acctsmatcher, acctsopts) = parseQuery d a
   in VD
      { opts = defwebopts
-     , here = RootR
      , today = d
      , j = nulljournal
      , q = q
@@ -191,22 +188,20 @@ viewdataWithDateAndParams d q a =
 
 -- | Gather data used by handlers and templates in the current request.
 getViewData :: Handler ViewData
-getViewData = getCurrentRoute >>= \case
+getViewData = do
-  Nothing -> return nullviewdata
+  App {appOpts, appJournal = jref} <- getYesod
-  Just here -> do
+  let opts@WebOpts {cliopts_ = copts@CliOpts {reportopts_ = ropts}} = appOpts
-    App {appOpts, appJournal = jref} <- getYesod
+  today <- liftIO getCurrentDay
-    let opts@WebOpts {cliopts_ = copts@CliOpts {reportopts_ = ropts}} = appOpts
+  (j, merr) <- getCurrentJournal jref copts {reportopts_ = ropts {no_elide_ = True}} today
-    today <- liftIO getCurrentDay
+  case merr of
-    (j, merr) <- getCurrentJournal jref copts {reportopts_ = ropts {no_elide_ = True}} today
+    Just err -> setMessage (toHtml err)
-    case merr of
+    Nothing -> pure ()
-      Just err -> setMessage (toHtml err)
+  q <- fromMaybe "" <$> lookupGetParam "q"
-      Nothing -> pure ()
+  a <- fromMaybe "" <$> lookupGetParam "a"
-    q <- fromMaybe "" <$> lookupGetParam "q"
+  showsidebar <- shouldShowSidebar
-    a <- fromMaybe "" <$> lookupGetParam "a"
+  return
-    showsidebar <- shouldShowSidebar
+    (viewdataWithDateAndParams today q a)
-    return
+    {j, opts, showsidebar, today}
-      (viewdataWithDateAndParams today q a)
-      {here, j, opts, showsidebar, today}
 
 -- | Find out if the sidebar should be visible. Show it, unless there is a
 -- showsidebar cookie set to "0", or a ?sidebar=0 query parameter.

hledger-web/src/Handler/AddForm.hs

@@ -1,61 +0,0 @@
--- | Add form data & handler. (The layout and js are defined in
--- Foundation so that the add form can be in the default layout for
--- all views.)
-
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE TemplateHaskell #-}
-
-module Handler.AddForm
-  ( AddForm(..)
-  , addForm
-  , addFormHamlet
-  ) where
-
-import Data.List (sort, nub)
-import Data.Semigroup ((<>))
-import Data.Text (Text)
-import qualified Data.Text as T
-import Data.Time.Calendar
-import Text.Blaze.Internal (preEscapedString)
-import Text.Hamlet (hamletFile)
-import Text.JSON
-import Yesod (HtmlUrl, HandlerSite, RenderMessage)
-import Yesod.Form
-
-import Hledger
-
--- Part of the data required from the add form.
--- Don't know how to handle the variable posting fields with yesod-form yet.
--- XXX Variable postings fields
-data AddForm = AddForm
-    { addFormDate         :: Day
-    , addFormDescription  :: Maybe Text
-    , addFormJournalFile  :: Maybe Text
-    } deriving Show
-
-addForm :: (RenderMessage (HandlerSite m) FormMessage, Monad m) => Day -> Journal -> FormInput m AddForm
-addForm today j = AddForm
-    <$> ireq (checkMMap (pure . validateDate) (T.pack . show) textField) "date"
-    <*> iopt textField "description"
-    <*> iopt (check validateJournalFile textField) "journal"
-  where
-    validateJournalFile :: Text -> Either FormMessage Text
-    validateJournalFile f
-      | T.unpack f `elem` journalFilePaths j = Right f
-      | otherwise = Left $ MsgInvalidEntry $ "the selected journal file \"" <> f <> "\"is unknown"
-    validateDate :: Text -> Either FormMessage Day
-    validateDate s = case fixSmartDateStrEither' today (T.strip s) of
-      Right d  -> Right d
-      Left _   -> Left $ MsgInvalidEntry $ "could not parse date \"" <> s <> "\":"
-
-addFormHamlet :: Journal -> t -> HtmlUrl t
-addFormHamlet j r = $(hamletFile "templates/add-form.hamlet")
- where
-  descriptions = sort $ nub $ tdescription <$> jtxns j
-  accts = journalAccountNamesDeclaredOrImplied j
-  escapeJSSpecialChars = regexReplaceCI "</script>" "<\\/script>" -- #236
-  listToJsonValueObjArrayStr as  = preEscapedString $ escapeJSSpecialChars $ encode $ JSArray $ map (\a -> JSObject $ toJSObject [("value", showJSON a)]) as
-  postingnums = [1..4 :: Int]
-  filepaths = fst <$> jfiles j

hledger-web/src/Handler/AddR.hs

@@ -1,85 +1,38 @@
-{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
 module Handler.AddR
-  ( postAddR
+  ( getAddR
+  , postAddR
   ) where
 
 import Import
 
-import Control.Monad.State.Strict (evalStateT)
-import Data.List (dropWhileEnd, sort)
-import qualified Data.Text as T
-import Data.Void (Void)
-import Safe (headMay)
-import Text.Megaparsec
-import Text.Megaparsec.Char
-
-import Handler.AddForm (AddForm(..), addForm)
-import Handler.Common (showErrors)
-
 import Hledger
 import Hledger.Cli.Commands.Add (appendToJournalFileOrStdout)
+import Widget.AddForm (addForm)
 
-postAddR :: Handler ()
+getAddR :: Handler Html
+getAddR = do
+  VD {j, today} <- getViewData
+  (view, enctype) <- generateFormPost $ addForm j today
+  defaultLayout [whamlet|<div .row><form class="addform form col-xs-12" method=post enctype=#{enctype}>^{view}|]
+
+postAddR :: Handler Html
 postAddR = do
-  VD{today, j} <- getViewData
+  VD{j, today} <- getViewData
-  -- 1. process the fixed fields with yesod-form
+  ((res, view), enctype) <- runFormPost $ addForm j today
-  runInputPostResult (addForm today j) >>= \case
+  case res of
-    FormMissing      -> bail ["there is no form data"]
+    FormMissing -> defaultLayout [whamlet|<div .row><form class="addform form col-xs-12" method=post enctype=#{enctype}>^{view}|]
-    FormFailure errs -> bail errs
+    FormFailure _ -> defaultLayout [whamlet|<div .row><form class="addform form col-xs-12" method=post enctype=#{enctype}>^{view}|]
-    FormSuccess form -> do
+    FormSuccess t -> do
-      let journalfile = maybe (journalFilePath j) T.unpack $ addFormJournalFile form
+      liftIO $ do
-      -- 2. the fixed fields look good; now process the posting fields adhocly,
+        -- XXX(?) move into balanceTransaction
-      -- getting either errors or a balanced transaction
+        ensureJournalFileExists (journalFilePath j)
-      (params,_) <- runRequestBody
+        appendToJournalFileOrStdout (journalFilePath j) (showTransaction $ txnTieKnot t)
-      let acctparams = parseNumberedParameters "account" params
+      setMessage "Transaction added."
-          amtparams  = parseNumberedParameters "amount" params
+      redirect JournalR
-          pnum = length acctparams
-      when (pnum == 0) (bail ["at least one posting must be entered"])
-      when (map fst acctparams /= [1..pnum] || map fst amtparams `notElem` [[1..pnum], [1..pnum-1]])
-        (bail ["the posting parameters are malformed"])
 
-      let eaccts = runParser (accountnamep <* eof) "" . textstrip  . snd <$> acctparams
-          eamts  = runParser (evalStateT (amountp <* eof) mempty) "" . textstrip . snd <$> amtparams
-          (acctErrs, accts) = partitionEithers eaccts
-          (amtErrs, amts')  = partitionEithers eamts
-          amts | length amts' == pnum = amts'
-               | otherwise = amts' ++ [missingamt]
-          errs = T.pack . parseErrorPretty <$> acctErrs ++ amtErrs
-      unless (null errs) (bail errs)
-
-      let etxn = balanceTransaction Nothing $ nulltransaction
-            { tdate = addFormDate form
-            , tdescription = fromMaybe "" $ addFormDescription form
-            , tpostings = (\(ac, am) -> nullposting {paccount = ac, pamount = Mixed [am]}) <$> zip accts amts
-            }
-      case etxn of
-       Left errs' -> bail (fmap T.pack . maybeToList . headMay $ lines errs')
-       Right t -> do
-        -- 3. all fields look good and form a balanced transaction; append it to the file
-        liftIO (appendTransaction journalfile t)
-        setMessage "Transaction added."
-        redirect JournalR
-  where
-    bail :: [Text] -> Handler ()
-    bail xs = showErrors xs >> redirect (JournalR, [("add","1")])
-
-parseNumberedParameters :: Text -> [(Text, Text)] -> [(Int, Text)]
-parseNumberedParameters s =
-  dropWhileEnd (T.null . snd) . sort . mapMaybe parseNum
-  where
-    parseNum :: (Text, Text) -> Maybe (Int, Text)
-    parseNum (k, v) = case parsewith paramnamep k of
-      Left (_ :: ParseError Char Void) -> Nothing
-      Right k' -> Just (k', v)
-    paramnamep = string s *> (read <$> some digitChar) <* eof
-
--- XXX move into balanceTransaction
-appendTransaction :: FilePath -> Transaction -> IO ()
-appendTransaction journalfile t = do
-  ensureJournalFileExists journalfile
-  appendToJournalFileOrStdout journalfile $
-    showTransaction (txnTieKnot t)

hledger-web/src/Handler/Common.hs

@@ -1,111 +1,11 @@
-{-# LANGUAGE CPP, OverloadedStrings, QuasiQuotes, NamedFieldPuns #-}
+module Handler.Common
--- | Common page components and rendering helpers.
+  ( getRootR
--- For global page layout, see Application.hs.
+  , getFaviconR
+  , getRobotsR
+  ) where
 
-module Handler.Common where
+import Import
+import Yesod.Default.Handlers (getFaviconR, getRobotsR)
 
-import Data.Semigroup ((<>))
+getRootR :: Handler Html
-import Data.Text (Text)
+getRootR = redirect JournalR
-import qualified Data.Text as T
-import Data.Time.Calendar (Day, toGregorian)
-import Text.Blaze (ToMarkup)
-import Text.Blaze.Internal (preEscapedString)
-import Yesod
-
-import Settings (manualurl)
-
-import Hledger
-
--- -- | Navigation link, preserving parameters and possibly highlighted.
--- navlink :: ViewData -> String -> AppRoute -> String -> HtmlUrl AppRoute
--- navlink VD{..} s dest title = [hamlet|
--- <a##{s}link.#{style} href=@?{u'} title="#{title}">#{s}
--- |]
---   where u' = (dest, if null q then [] else [("q", pack q)])
---         style | dest == here = "navlinkcurrent"
---               | otherwise    = "navlink" :: Text
-
--- -- | Links to the various journal editing forms.
--- editlinks :: HtmlUrl AppRoute
--- editlinks = [hamlet|
--- <a#editformlink href="#" onclick="return editformToggle(event)" title="Toggle journal edit form">edit
--- \ | #
--- <a#addformlink href="#" onclick="return addformToggle(event)" title="Toggle transaction add form">add
--- <a#importformlink href="#" onclick="return importformToggle(event)" style="display:none;">import transactions
--- |]
-
--- | Link to a topic in the manual.
-helplink :: Text -> Text -> HtmlUrl r
-helplink topic label = [hamlet|<a href=#{u} target=hledgerhelp>#{label}|]
-  where u = manualurl <> if T.null topic then "" else T.cons '#' topic
-
-----------------------------------------------------------------------
--- hledger report renderers
-
--- | Render a "BalanceReport" as html.
-balanceReportAsHtml :: r -> Journal -> [QueryOpt] -> BalanceReport -> HtmlUrl r
-balanceReportAsHtml registerR j qopts (items, total) = [hamlet|
-$forall (acct, adisplay, aindent, abal) <- items
-  <tr .#{inacctClass acct}>
-    <td .acct>
-      <div .ff-wrapper>
-        \#{indent aindent}
-        <a href="@?{acctLink acct}" .#{inacctClass acct}
-           title="Show transactions affecting this account and subaccounts">
-          #{adisplay}
-        $if hasSubs acct
-          <a href="@?{acctOnlyLink acct}" .only .hidden-sm .hidden-xs
-             title="Show transactions affecting this account but not subaccounts">only
-    <td>
-      ^{mixedAmountAsHtml abal}
-<tr .total>
-  <td>
-  <td>
-    ^{mixedAmountAsHtml total}
-|] where
-  l = ledgerFromJournal Any j
-  inacctClass acct = case inAccountQuery qopts of
-    Just m' -> if m' `matchesAccount` acct then "inacct" else ""
-    Nothing -> "" :: Text
-  hasSubs acct = maybe True (not . null . asubs) (ledgerAccount l acct)
-  indent a = preEscapedString $ concat $ replicate (2 + 2 * a) "&nbsp;"
-  acctLink acct = (registerR, [("q", accountQuery acct)])
-  acctOnlyLink acct = (registerR, [("q", accountOnlyQuery acct)])
-
-accountQuery :: AccountName -> Text
-accountQuery = ("inacct:" <>) .  quoteIfSpaced
-
-accountOnlyQuery :: AccountName -> Text
-accountOnlyQuery = ("inacctonly:" <>) . quoteIfSpaced
-
-numberTransactionsReportItems :: [TransactionsReportItem] -> [(Int, Bool, Bool, TransactionsReportItem)]
-numberTransactionsReportItems [] = []
-numberTransactionsReportItems items = number 0 nulldate items
-  where
-    number :: Int -> Day -> [TransactionsReportItem] -> [(Int, Bool, Bool, TransactionsReportItem)]
-    number _ _ [] = []
-    number n prevd (i@(t, _, _, _, _, _):rest) = (n+1, newday, newmonth, i): number (n+1) d rest
-      where
-        d = tdate t
-        newday = d /= prevd
-        newmonth = dm /= prevdm || dy /= prevdy
-        (dy, dm, _) = toGregorian d
-        (prevdy, prevdm, _) = toGregorian prevd
-
-mixedAmountAsHtml :: MixedAmount -> HtmlUrl a
-mixedAmountAsHtml b = [hamlet|
-$forall t <- ts
-  <span .#{c}>#{t}
-  <br>
-|] where
-  ts = lines (showMixedAmountWithoutPrice b)
-  c = case isNegativeMixedAmount b of
-    Just True -> "negative amount" :: Text
-    _         -> "positive amount"
-
-showErrors :: ToMarkup a => [a] -> HandlerFor m ()
-showErrors errs = setMessage [shamlet|
-Errors:<br>
-$forall e <- errs
-  \#{e}<br>
-|]

hledger-web/src/Handler/EditR.hs

@@ -1,46 +1,49 @@
-{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 
 module Handler.EditR
-  ( postEditR
+  ( getEditR
+  , postEditR
   ) where
 
 import Import
 
-import Control.Monad.Trans (lift)
-import Control.Monad.Trans.Except
 import qualified Data.Text as T
-import Text.Printf (printf)
-
-import Handler.Common (showErrors)
 
 import Hledger
 import Hledger.Cli.Utils
 
--- | Handle a post from the journal edit form.
+editForm :: [(FilePath, Text)] -> Markup -> MForm Handler (FormResult (FilePath, Text), Widget)
-postEditR :: Handler ()
+editForm journals = identifyForm "import" $ \extra -> do
-postEditR = runE $ do
+  let files = fst <$> journals
-  VD {j} <- lift getViewData
+  (jRes, jView) <- mreq (selectFieldList ((\x -> (T.pack x, x)) <$> files)) "journal" (listToMaybe files)
-  -- get form input values, or validation errors.
+  (tRes, tView) <- mreq textareaField "text" (Textarea . snd <$> listToMaybe journals)
-  text <- ExceptT $ maybe (Left "No value provided") Right <$> lookupPostParam "text"
+  pure ((,) <$> jRes <*> (unTextarea <$> tRes), [whamlet|
-  journalpath <- ExceptT $ maybe
+    #{extra}
-    (Right . T.pack $ journalFilePath j)
+    <p>
-    (\f ->
+      ^{fvInput jView}<br>
-       if T.unpack f `elem` journalFilePaths j
+      ^{fvInput tView}
-         then Right f
+      <input type=submit value="Introduce myself">
-         else Left "unrecognised journal file path") <$>
+  |])
-    lookupPostParam "journal"
-  -- try to avoid unnecessary backups or saving invalid data
-  let tnew = T.filter (/= '\r') text
 
-  jE <- liftIO $ readJournal def (Just $ T.unpack journalpath) tnew
+getEditR :: Handler Html
-  _ <- ExceptT . pure $ first T.pack jE
+getEditR = do
-  _ <- liftIO $ writeFileWithBackupIfChanged (T.unpack journalpath) tnew
+  VD {j} <- getViewData
-  setMessage $ toHtml (printf "Saved journal %s\n" (show journalpath) :: String)
+  (view, enctype) <- generateFormPost (editForm $ jfiles j)
-  redirect JournalR
+  defaultLayout [whamlet|<form enctype=#{enctype}>^{view}|]
-  where
+
-    runE :: ExceptT Text Handler () -> Handler ()
+postEditR :: Handler Html
-    runE f = runExceptT f >>= \case
+postEditR = do
-      Left e -> showErrors [e] >> redirect JournalR
+  VD {j} <- getViewData
-      Right x -> pure x
+  ((res, view), enctype) <- runFormPost (editForm $ jfiles j)
+  case res of
+    FormMissing -> defaultLayout [whamlet|<form enctype=#{enctype}>^{view}|]
+    FormFailure _ -> defaultLayout [whamlet|<form enctype=#{enctype}>^{view}|]
+    FormSuccess (journalPath, text) -> do
+      -- try to avoid unnecessary backups or saving invalid data
+      _ <- liftIO $ first T.pack <$> readJournal def (Just journalPath) text
+      _ <- liftIO $ writeFileWithBackupIfChanged journalPath text
+      setMessage $ toHtml (printf "Saved journal %s\n" journalPath :: String)
+      redirect JournalR

hledger-web/src/Handler/ImportR.hs

@@ -1,29 +1,36 @@
-{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
 
 module Handler.ImportR
-  ( postImportR
+  ( getImportR
+  , postImportR
   ) where
 
 import Import
 
-import Control.Monad.Trans (lift)
+importForm :: Markup -> MForm Handler (FormResult FileInfo, Widget)
-import Control.Monad.Trans.Except
+importForm = identifyForm "import" $ \extra -> do
+  (res, view) <- mreq fileField "file" Nothing
+  pure (res, [whamlet|
+    #{extra}
+    <p>
+      Hello, my name is #
+      ^{fvInput view}
+      <input type=submit value="Introduce myself">
+  |])
 
-import Handler.Common (showErrors)
+getImportR :: Handler Html
+getImportR = do
+  (view, enctype) <- generateFormPost importForm
+  defaultLayout [whamlet|<form enctype=#{enctype}>^{view}|]
 
 -- | Handle a post from the journal import form.
-postImportR :: Handler ()
+postImportR :: Handler Html
-postImportR = runE $ do
+postImportR = do
-  ((res, _), _) <- lift . runFormPost . renderDivs $ areq fileField "file" Nothing
+  ((res, view), enctype) <- runFormPost importForm
   case res of
-    FormMissing -> throwE ["No file provided"]
+    FormMissing -> defaultLayout [whamlet|<form enctype=#{enctype}>^{view}|]
-    FormFailure es -> throwE es
+    FormFailure _ -> defaultLayout [whamlet|<form enctype=#{enctype}>^{view}|]
     FormSuccess _ -> do
-     setMessage "File uploaded successfully"
+      setMessage "File uploaded successfully"
-     redirect JournalR
+      redirect JournalR
-  where
-    runE :: ExceptT [Text] Handler () -> Handler ()
-    runE f = runExceptT f >>= \case
-      Left e -> showErrors e >> redirect JournalR
-      Right x -> pure x

hledger-web/src/Handler/JournalR.hs

@@ -9,21 +9,17 @@ module Handler.JournalR where
 
 import Import
 
-import Handler.Common (accountQuery, mixedAmountAsHtml)
+import Hledger
-
 import Hledger.Cli.CliOptions
-import Hledger.Data
-import Hledger.Query
-import Hledger.Reports
-import Hledger.Utils
 import Hledger.Web.WebOptions
+import Widget.AddForm (addForm)
+import Widget.Common (accountQuery, mixedAmountAsHtml)
 
 -- | The formatted journal view, with sidebar.
+-- XXX like registerReportAsHtml
 getJournalR :: Handler Html
 getJournalR = do
-  VD{j, m, opts, qopts} <- getViewData
+  VD{j, m, opts, qopts, today} <- getViewData
-  -- XXX like registerReportAsHtml
-
   let title = case inAccount qopts of
         Nothing -> "General Journal"
         Just (a, inclsubs) -> "Transactions in " <> a <> if inclsubs then "" else " (excluding subaccounts)"
@@ -31,6 +27,7 @@ getJournalR = do
       acctlink a = (RegisterR, [("q", accountQuery a)])
       (_, items) = journalTransactionsReport (reportopts_ $ cliopts_ opts) j m
 
+  (addView, addEnctype) <- generateFormPost (addForm j today)
   defaultLayout $ do
     setTitle "journal - hledger-web"
     $(widgetFile "journal")

hledger-web/src/Handler/RegisterR.hs

@@ -10,22 +10,20 @@ module Handler.RegisterR where
 
 import Import
 
-import Data.Time
 import Data.List (intersperse)
 import qualified Data.Text as T
-import Safe (headMay)
 import Text.Hamlet (hamletFile)
 
-import Handler.Common (mixedAmountAsHtml, numberTransactionsReportItems)
-
 import Hledger
 import Hledger.Cli.CliOptions
 import Hledger.Web.WebOptions
+import Widget.AddForm (addForm)
+import Widget.Common (mixedAmountAsHtml, numberTransactionsReportItems)
 
 -- | The main journal/account register view, with accounts sidebar.
 getRegisterR :: Handler Html
 getRegisterR = do
-  VD{j, m, opts, qopts} <- getViewData
+  VD{j, m, opts, qopts, today} <- getViewData
   let (a,inclsubs) = fromMaybe ("all accounts",True) $ inAccount qopts
       s1 = if inclsubs then "" else " (excluding subaccounts)"
       s2 = if m /= Any then ", filtered" else ""
@@ -39,6 +37,7 @@ getRegisterR = do
         | newd = "newday"
         | otherwise = "" :: Text
 
+  (addView, addEnctype) <- generateFormPost (addForm j today)
   defaultLayout $ do
     setTitle "register - hledger-web"
     $(widgetFile "register")
@@ -50,12 +49,12 @@ registerChartHtml percommoditytxnreports = $(hamletFile "templates/chart.hamlet"
  -- have to make sure plot is not called when our container (maincontent)
  -- is hidden, eg with add form toggled
  where
-   charttitle = case maybe "" (fst.snd) $ headMay percommoditytxnreports of
+   charttitle = case maybe "" (fst . snd) $ listToMaybe percommoditytxnreports of
      "" -> ""
      s  -> s <> ":"
    colorForCommodity = fromMaybe 0 . flip lookup commoditiesIndex
    commoditiesIndex = zip (map fst percommoditytxnreports) [0..] :: [(CommoditySymbol,Int)]
-   simpleMixedAmountQuantity = maybe 0 aquantity . headMay . amounts
+   simpleMixedAmountQuantity = maybe 0 aquantity . listToMaybe . amounts
    shownull c = if null c then " " else c
 
 dayToJsTimestamp :: Day -> Integer

hledger-web/src/Handler/RootR.hs

@@ -1,8 +0,0 @@
--- | Site root and misc. handlers.
-
-module Handler.RootR where
-
-import Import
-
-getRootR :: Handler Html
-getRootR = redirect JournalR

hledger-web/src/Import.hs

@@ -7,12 +7,20 @@ import           Prelude              as Import hiding (head, init, last,
                                                  readFile, tail, writeFile)
 import           Yesod                as Import hiding (Route (..))
 
-import           Control.Monad        as Import (when, unless, void)
+import           Control.Arrow        as Import ((&&&))
-import           Data.Bifunctor       as Import (first, second, bimap)
+import           Control.Monad        as Import
-import           Data.Default         as Import (Default(def))
+import           Data.Bifunctor       as Import
-import           Data.Either          as Import (lefts, rights, partitionEithers)
+import           Data.Default         as Import
-import           Data.Maybe           as Import (fromMaybe, maybeToList, mapMaybe, isJust)
+import           Data.Either          as Import
+import           Data.Foldable        as Import
+import           Data.List            as Import (foldl', unfoldr)
+import           Data.Maybe           as Import
 import           Data.Text            as Import (Text)
+import           Data.Time            as Import hiding (parseTime)
+import           Data.Traversable     as Import
+import           Data.Void            as Import (Void)
+import           Text.Blaze           as Import (Markup)
+import           Text.Printf          as Import (printf)
 
 import           Foundation           as Import
 import           Settings             as Import

hledger-web/src/Widget/AddForm.hs

@@ -0,0 +1,115 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+module Widget.AddForm
+  ( addForm
+  ) where
+
+import Control.Monad.State.Strict (evalStateT)
+import Data.Bifunctor (first)
+import Data.List (dropWhileEnd, nub, sort, unfoldr)
+import Data.Maybe (isJust)
+import Data.Semigroup ((<>))
+import Data.Text (Text)
+import qualified Data.Text as T
+import Data.Time (Day)
+import Text.Blaze.Internal (Markup, preEscapedString)
+import Text.JSON
+import Text.Megaparsec (eof, parseErrorPretty, runParser)
+import Yesod
+
+import Hledger
+import Settings (widgetFile)
+
+-- XXX <select> which journal to add to
+
+addForm ::
+     (site ~ HandlerSite m, RenderMessage site FormMessage, MonadHandler m)
+  => Journal
+  -> Day
+  -> Markup
+  -> MForm m (FormResult Transaction, WidgetFor site ())
+addForm j today = identifyForm "add" $ \extra -> do
+  (dateRes, dateView) <- mreq dateField dateFS Nothing
+  (descRes, descView) <- mreq textField descFS Nothing
+  (acctRes, _) <- mreq listField acctFS Nothing
+  (amtRes, _) <- mreq listField amtFS Nothing
+
+  let (msgs', postRes) = case validatePostings <$> acctRes <*> amtRes of
+        FormSuccess (Left es) -> (es, FormFailure ["Postings validation failed"])
+        FormSuccess (Right xs) -> ([], FormSuccess xs)
+        FormMissing -> ([], FormMissing)
+        FormFailure es -> ([], FormFailure es)
+      msgs = zip [(1 :: Int)..] $ msgs' ++ replicate (4 - length msgs') ("", "", Nothing, Nothing)
+
+  let descriptions = sort $ nub $ tdescription <$> jtxns j
+      escapeJSSpecialChars = regexReplaceCI "</script>" "<\\/script>" -- #236
+      listToJsonValueObjArrayStr = preEscapedString . escapeJSSpecialChars .
+        encode . JSArray . fmap (\a -> JSObject $ toJSObject [("value", showJSON a)])
+      journals = fst <$> jfiles j
+
+  pure (makeTransaction <$> dateRes <*> descRes <*> postRes, $(widgetFile "add-form"))
+  where
+
+    makeTransaction date desc postings =
+      nulltransaction {tdate = date, tdescription = desc, tpostings = postings}
+
+    dateFS = FieldSettings "date" Nothing Nothing (Just "date")
+      [("class", "form-control input-lg"), ("placeholder", "Date")]
+    descFS = FieldSettings "desc" Nothing Nothing (Just "description")
+      [("class", "form-control input-lg typeahead"), ("placeholder", "Description"), ("size", "40")]
+    acctFS = FieldSettings "amount" Nothing Nothing (Just "account") []
+    amtFS = FieldSettings "amount" Nothing Nothing (Just "amount") []
+    dateField = checkMMap (pure . validateDate) (T.pack . show) textField
+    validateDate s =
+      first (const ("Invalid date format" :: Text)) $
+      fixSmartDateStrEither' today (T.strip s)
+
+    listField = Field
+      { fieldParse = const . pure . Right . Just . dropWhileEnd T.null
+      , fieldView = error "Don't render using this!"
+      , fieldEnctype = UrlEncoded
+      }
+
+validatePostings :: [Text] -> [Text] -> Either [(Text, Text, Maybe Text, Maybe Text)] [Posting]
+validatePostings a b =
+  case traverse id $ (\(_, _, x) -> x) <$> postings of
+    Left _ -> Left $ foldr catPostings [] postings
+    Right [] -> Left
+      [ ("", "", Just "Missing account", Just "Missing amount")
+      , ("", "", Just "Missing account", Nothing)
+      ]
+    Right [p] -> Left
+      [ (paccount p, T.pack . showMixedAmountWithoutPrice $ pamount p, Nothing, Nothing)
+      , ("", "", Just "Missing account", Nothing)
+      ]
+    Right xs -> Right xs
+  where
+    postings = unfoldr go (True, a, b)
+
+    go (_, x:xs, y:ys) = Just ((x, y, zipPosting (validateAccount x) (validateAmount y)), (True, xs, ys))
+    go (True, x:y:xs, []) = Just ((x, "", zipPosting (validateAccount x) (Left "Missing amount")), (True, y:xs, []))
+    go (True, x:xs, []) = Just ((x, "", zipPosting (validateAccount x) (Right missingamt)), (False, xs, []))
+    go (False, x:xs, []) = Just ((x, "", zipPosting (validateAccount x) (Left "Missing amount")), (False, xs, []))
+    go (_, [], y:ys) = Just (("", y, zipPosting (Left "Missing account") (validateAmount y)), (False, [], ys))
+    go (_, [], []) = Nothing
+
+    zipPosting = zipEither (\acc amt -> nullposting {paccount = acc, pamount = Mixed [amt]})
+
+    catPostings (t, t', Left (e, e')) xs = (t, t', e, e') : xs
+    catPostings (t, t', Right _) xs = (t, t', Nothing, Nothing) : xs
+
+    errorToFormMsg = first (("Invalid value: " <>) . T.pack . parseErrorPretty)
+    validateAccount = errorToFormMsg . runParser (accountnamep <* eof) "" . T.strip
+    validateAmount = errorToFormMsg . runParser (evalStateT (amountp <* eof) mempty) "" . T.strip
+
+-- Modification of Align, from the `these` package
+zipEither :: (a -> a' -> r) -> Either e a -> Either e' a' -> Either (Maybe e, Maybe e') r
+zipEither f a b = case (a, b) of
+  (Right a', Right b') -> Right (f a' b')
+  (Left a', Right _) -> Left (Just a', Nothing)
+  (Right _, Left b') -> Left (Nothing, Just b')
+  (Left a', Left b') -> Left (Just a', Just b')

hledger-web/src/Widget/Common.hs

@@ -0,0 +1,92 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+
+module Widget.Common
+  ( accountQuery
+  , accountOnlyQuery
+  , balanceReportAsHtml
+  , helplink
+  , mixedAmountAsHtml
+  , numberTransactionsReportItems
+  ) where
+
+import Data.Foldable (for_)
+import Data.List (mapAccumL)
+import Data.Semigroup ((<>))
+import Data.Text (Text)
+import qualified Data.Text as T
+import Data.Time.Calendar (Day, toGregorian)
+import Text.Blaze
+import qualified Text.Blaze.Html5 as H
+import qualified Text.Blaze.Html5.Attributes as A
+import Text.Blaze.Internal (preEscapedString)
+import Yesod
+
+import Hledger
+import Settings (manualurl)
+
+-- | Link to a topic in the manual.
+helplink :: Text -> Text -> HtmlUrl r
+helplink topic label _ = H.a ! A.href u ! A.target "hledgerhelp" $ toHtml label
+  where u = textValue $ manualurl <> if T.null topic then "" else T.cons '#' topic
+
+-- | Render a "BalanceReport" as html.
+balanceReportAsHtml :: r -> Journal -> [QueryOpt] -> BalanceReport -> HtmlUrl r
+balanceReportAsHtml registerR j qopts (items, total) = [hamlet|
+$forall (acct, adisplay, aindent, abal) <- items
+  <tr .#{inacctClass acct}>
+    <td .acct>
+      <div .ff-wrapper>
+        \#{indent aindent}
+        <a href="@?{acctLink acct}" .#{inacctClass acct}
+           title="Show transactions affecting this account and subaccounts">
+          #{adisplay}
+        $if hasSubs acct
+          <a href="@?{acctOnlyLink acct}" .only .hidden-sm .hidden-xs
+             title="Show transactions affecting this account but not subaccounts">only
+    <td>
+      ^{mixedAmountAsHtml abal}
+<tr .total>
+  <td>
+  <td>
+    ^{mixedAmountAsHtml total}
+|] where
+  l = ledgerFromJournal Any j
+  inacctClass acct = case inAccountQuery qopts of
+    Just m' -> if m' `matchesAccount` acct then "inacct" else ""
+    Nothing -> "" :: Text
+  hasSubs acct = maybe True (not . null . asubs) (ledgerAccount l acct)
+  indent a = preEscapedString $ concat $ replicate (2 + 2 * a) "&nbsp;"
+  acctLink acct = (registerR, [("q", accountQuery acct)])
+  acctOnlyLink acct = (registerR, [("q", accountOnlyQuery acct)])
+
+accountQuery :: AccountName -> Text
+accountQuery = ("inacct:" <>) .  quoteIfSpaced
+
+accountOnlyQuery :: AccountName -> Text
+accountOnlyQuery = ("inacctonly:" <>) . quoteIfSpaced
+
+numberTransactionsReportItems :: [TransactionsReportItem] -> [(Int, Bool, Bool, TransactionsReportItem)]
+numberTransactionsReportItems = snd . mapAccumL number (0, nulldate)
+  where
+    number :: (Int, Day) -> TransactionsReportItem -> ((Int, Day), (Int, Bool, Bool, TransactionsReportItem))
+    number (!n, !prevd) i@(t, _, _, _, _, _) = ((n', d), (n', newday, newmonth, i))
+      where
+        n' = n + 1
+        d = tdate t
+        newday = d /= prevd
+        newmonth = dm /= prevdm || dy /= prevdy
+        (dy, dm, _) = toGregorian d
+        (prevdy, prevdm, _) = toGregorian prevd
+
+mixedAmountAsHtml :: MixedAmount -> HtmlUrl a
+mixedAmountAsHtml b _ =
+  for_ (lines (showMixedAmountWithoutPrice b)) $ \t -> do
+    H.span ! A.class_ c $ toHtml t
+    H.br
+  where
+    c = case isNegativeMixedAmount b of
+      Just True -> "negative amount"
+      _ -> "positive amount"

hledger-web/static/hledger.js

@@ -78,10 +78,9 @@ function registerChart($container, series) {
         position: 'sw'
       },
       grid: {
-        markings:
+        markings: function () {
-         function (axes) {
           var now = Date.now();
-          var markings = [
+          return [
             {
               xaxis: { to: now }, // past
               yaxis: { to: 0 },   // <0
@@ -103,7 +102,6 @@ function registerChart($container, series) {
               lineWidth:1
             },
           ];
-          return markings;
         },
         hoverable: true,
         autoHighlight: true,
@@ -127,15 +125,16 @@ function registerChart($container, series) {
 }
 
 function registerChartClick(ev, pos, item) {
-  if (item) {
+  if (!item) {
-    targetselector = '#'+item.series.data[item.dataIndex][5];
+    return;
-    $target = $(targetselector);
+  }
-    if ($target.length) {
+  var targetselector = '#' + item.series.data[item.dataIndex][5];
-      window.location.hash = targetselector;
+  var $target = $(targetselector);
-      $('html, body').animate({
+  if ($target.length) {
-        scrollTop: $target.offset().top
+    window.location.hash = targetselector;
-      }, 1000);
+    $('html, body').animate({
-    }
+      scrollTop: $target.offset().top
+    }, 1000);
   }
 }
 
@@ -192,9 +191,8 @@ function addformAddPosting() {
   // clear and renumber the field, add keybindings
   $acctinput
     .val('')
-    .prop('id','account'+(num+1))
+    .prop('name', 'account')
-    .prop('name','account'+(num+1))
+    .prop('placeholder', 'Account ' + (num + 1));
-    .prop('placeholder','Account '+(num+1));
   //lastrow.find('input') // not :last this time
   $acctinput
     .bind('keydown', 'ctrl+shift+=', addformAddPosting)
@@ -203,9 +201,8 @@ function addformAddPosting() {
 
   $amntinput
     .val('')
-    .prop('id','amount'+(num+1))
+    .prop('name','amount')
-    .prop('name','amount'+(num+1))
+    .prop('placeholder','Amount ' + (num + 1))
-    .prop('placeholder','Amount '+(num+1))
     .keypress(addformAddPosting);
 
   $acctinput
@@ -241,47 +238,3 @@ function sidebarToggle() {
   $('#spacer').toggleClass('col-md-4 col-sm-4 col-any-0');
   $.cookie('showsidebar', $('#sidebar-menu').hasClass('col-any-0') ? '0' : '1');
 }
-
-//----------------------------------------------------------------------
-// MISC
-
-function enableTypeahead($el, suggester) {
-  return $el.typeahead(
-    {
-      highlight: true
-    },
-    {
-      source: suggester.ttAdapter()
-    }
-  );
-}
-
-// function journalSelect(ev) {
-//   var textareas = $('textarea', $('form#editform'));
-//   for (i=0; i<textareas.length; i++) {
-//     textareas[i].style.display = 'none';
-//     textareas[i].disabled = true;
-//   }
-//   var targ = getTarget(ev);
-//   if (targ.value) {
-//     var journalid = targ.value+'_textarea';
-//     var textarea = document.getElementById(journalid);
-//   }
-//   else {
-//     var textarea = textareas[0];
-//   }
-//   textarea.style.display = 'block';
-//   textarea.disabled = false;
-//   return true;
-// }
-
-// // Get the current event's target in a robust way.
-// // http://www.quirksmode.org/js/events_properties.html
-// function getTarget(ev) {
-//   var targ;
-//   if (!ev) var ev = window.event;
-//   if (ev.target) targ = ev.target;
-//   else if (ev.srcElement) targ = ev.srcElement;
-//   if (targ.nodeType == 3) targ = targ.parentNode;
-//   return targ;
-// }

hledger-web/templates/add-form.hamlet

@@ -1,6 +1,5 @@
 <script>
   jQuery(document).ready(function() {
-    /* set up typeahead fields */
     descriptionsSuggester = new Bloodhound({
       local:#{listToJsonValueObjArrayStr descriptions},
       limit:100,
@@ -10,53 +9,62 @@
     descriptionsSuggester.initialize();
 
     accountsSuggester = new Bloodhound({
-      local:#{listToJsonValueObjArrayStr accts},
+      local:#{listToJsonValueObjArrayStr (journalAccountNamesDeclaredOrImplied j)},
       limit:100,
       datumTokenizer: function(d) { return [d.value]; },
       queryTokenizer: function(q) { return [q]; }
-      /*
-        datumTokenizer: Bloodhound.tokenizers.obj.whitespace('value'),
-        datumTokenizer: Bloodhound.tokenizers.whitespace(d.value)
-        queryTokenizer: Bloodhound.tokenizers.whitespace
-      */
     });
     accountsSuggester.initialize();
 
-    enableTypeahead(jQuery('input#description'), descriptionsSuggester);
+    jQuery('input[name=description]').typeahead({ highlight: true }, { source: descriptionsSuggester.ttAdapter() });
-    enableTypeahead(jQuery('input#account1, input#account2, input#account3, input#account4'), accountsSuggester);
+    jQuery('input[name=account]').typeahead({ highlight: true }, { source: accountsSuggester.ttAdapter() });
   });
+^{extra}
 
-<form#addform action=@{r} method=POST .form>
+<div .form-group>
- <div .form-group>
   <div .row>
-   <div .col-md-3 .col-xs-6 .col-sm-6>
+    <div .col-md-3 .col-xs-6 .col-sm-6 :isJust (fvErrors dateView):.has-error>
-    <div #dateWrap .input-group .date>
+      <div #dateWrap .form-group.input-group.date>
-     <input #date required lang=en name=date .form-control .input-lg placeholder="Date" >
+        ^{fvInput dateView}
-     <div .input-group-addon>
+        <div .input-group-addon>
-      <span .glyphicon .glyphicon-th>
+          <span .glyphicon .glyphicon-th>
-   <div .col-md-9 .col-xs-6 .col-sm-6>
+      $maybe err <- fvErrors dateView
-    <input #description required .typeahead .form-control .input-lg type=text size=40 name=description placeholder="Description">
+        <span .help-block .error-block>#{err}
+    <div .col-md-9 .col-xs-6 .col-sm-6 :isJust (fvErrors descView):.has-error>
+      <div .form-group>
+        ^{fvInput descView}
+      $maybe err <- fvErrors descView
+        <span .help-block .error-block>#{err}
+  <div .row>
+    <div .col-md-3 .col-xs-6 .col-sm-6>
+    <div .col-md-9 .col-xs-6 .col-sm-6>
 
- <div .account-postings>
+<div .account-postings>
-  $forall n <- postingnums
+  $forall (n, (acc, amt, accE, amtE)) <- msgs
-   <div .form-group .row .account-group #grp#{n}>
+    <div .form-group .row .account-group #grp#{n}>
-    <div .col-md-8 .col-xs-8 .col-sm-8>
+      <div .col-md-8 .col-xs-8 .col-sm-8 :isJust accE:.has-error>
-     <input #account#{n} .account-input.form-control.input-lg.typeahead type=text name=account#{n} placeholder="Account #{n}">
+        <input .account-input.form-control.input-lg.typeahead type=text
-    <div .col-md-4 .col-xs-4 .col-sm-4>
+          name=account placeholder="Account #{n}" value="#{acc}">
-     <input #amount#{n} .amount-input.form-control.input-lg type=text name=amount#{n} placeholder="Amount#{n}">
+        $maybe err <- accE
+          <span .help-block .error-block>_{err}
+      <div .col-md-4 .col-xs-4 .col-sm-4 :isJust amtE:.has-error>
+        <input .amount-input.form-control.input-lg type=text
+          name=amount placeholder="Amount #{n}" value="#{amt}">
+        $maybe err <- amtE
+          <span .help-block .error-block>_{err}
 
- <div .col-md-8 .col-xs-8 .col-sm-8>
+<div .row>
- <div .col-md-4 .col-xs-4 .col-sm-4>
+  <div .col-md-8 .col-xs-8 .col-sm-8>
-  <button type=submit .btn .btn-default .btn-lg name=submit>add
+  <div .col-md-4 .col-xs-4 .col-sm-4>
- $if length filepaths > 1
+    <button type=submit .btn .btn-default .btn-lg name=submit>add
+
+$if length journals > 1
   <br>
   <span .input-lg>to:
-   <select #journalselect .form-control.input-lg name=journal onchange="/*journalSelect(event)*/"  style="width:auto; display:inline-block;">
+    <select #journalselect .form-control.input-lg name=journal style="width:auto; display:inline-block;">
-    $forall p <- filepaths
+      $forall p <- journals
-     <option value=#{p}>#{p}
+        <option value=#{p}>#{p}
-
+<span .small style="padding-left:2em;">
- <span style="padding-left:2em;">
+  Enter a value in the last field for
-  <span .small>
-    Enter a value in the last field for
     <a href="#" onclick="addformAddPosting(); return false;">more
     (or ctrl +, ctrl -)

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

@@ -29,7 +29,7 @@ $newline never
             <div .row .row-offcanvas .row-offcanvas-left>
               ^{pageBody pc}
             <footer>
-                #{extraCopyright $ appExtra $ settings master}
+              #{extraCopyright $ appExtra $ settings master}
 
         $maybe analytics <- extraAnalytics $ appExtra $ settings master
             <script>
@@ -47,61 +47,3 @@ $newline never
             <script>
                 window.attachEvent('onload',function(){CFInstall.check({mode:'overlay'})})
         \<![endif]-->
-
-        <div .modal.fade #helpmodal tabindex="-1" role="dialog" aria-labelledby="helpLabel" aria-hidden="true">
-          <div .modal-dialog .modal-lg>
-            <div .modal-content>
-              <div .modal-header>
-                <button type="button" .close data-dismiss="modal" aria-hidden="true">&times;
-                <h3 .modal-title #helpLabel>Help
-              <div .modal-body>
-                <div .row>
-                  <div .col-xs-6>
-                    <p>
-                      <b>Keyboard shortcuts
-                      <ul>
-                        <li> <code>h</code> or maybe <code>?</code> - view this help (escape or click to exit)
-                        <li> <code>j</code> - go to the Journal view (home)
-                        <li> <code>a</code> - add a transaction (escape to cancel)
-                        <li> <code>s</code> - toggle sidebar
-                        <li> <code>f</code> - focus search form ("find")
-                    <p>
-                      <b>General
-                      <ul>
-                        <li> The Journal view shows general journal entries, representing zero-sum movements of money (or other commodity) between hierarchical accounts
-                        <li> The sidebar shows the resulting accounts and their final balances
-                        <li> Parent account balances include subaccount balances
-                        <li> Multiple currencies in balances are displayed one above the other
-                        <li> Click account name links to see transactions affecting that account, with running balance
-                        <li> Click date links to see journal entries on that date
-                  <div .col-xs-6>
-                    <p>
-                      <b>Search
-                      <ul>
-                        <li> <code>acct:REGEXP</code> - filter on to/from account
-                        <li> <code>desc:REGEXP</code> - filter on description
-                        <li> <code>date:PERIODEXP</code>, <code>date2:PERIODEXP</code> - filter on date or secondary date
-                        <li> <code>code:REGEXP</code> - filter on transaction's code (eg check number)
-                        <li> <code>status:*</code>, <code>status:!</code>, <code>status:</code> - filter on transaction's cleared status (cleared, pending, uncleared)
-                        <!-- <li> <code>empty:BOOL</code> - filter on whether amount is zero -->
-                        <li> <code>amt:N</code>, <code>amt:&lt;N</code>, <code>amt:&gt;N</code> - filter on the unsigned amount magnitude. Or with a sign before N, filter on the signed value. (Single-commodity amounts only.)
-                        <li> <code>cur:REGEXP</code> - filter on the currency/commodity symbol (must match all of it). Dollar sign must be written as <code>\$</code>
-                        <li> <code>tag:NAME</code>, <code>tag:NAME=REGEX</code> - filter on tag name, or tag name and value
-                        <!-- <li> <code>depth:N</code> - filter out accounts below this depth -->
-                        <li> <code>real:BOOL</code> - filter on postings' real/virtual-ness
-                        <li> Enclose search patterns containing spaces in single or double quotes
-                        <li> Prepend <code>not:</code> to negate a search term
-                        <li> Multiple search terms on different fields are AND'ed, multiple search terms on the same field are OR'ed
-                        <li> These search terms also work with command-line hledger
-
-        <div .modal #addmodal tabindex="-1" role="dialog" aria-labelledby="addLabel" aria-hidden="true">
-          <div .modal-dialog .modal-lg>
-            <div .modal-content>
-              <div .modal-header>
-                <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}
-                ^{addFormHamlet j AddR}

hledger-web/templates/default-layout.hamlet

@@ -1,6 +1,5 @@
 $maybe m <- msg
-  $if not (isPrefixOf "Errors" (renderHtml m))
+  <div #message .alert-primary>#{m}
-    <div #message>#{m}
 
 <div#spacer .col-xs-2.#{topShowsm}.#{topShowmd}>
   <h1>
@@ -21,7 +20,7 @@ $maybe m <- msg
     ^{accounts}
 
 <div #main-content .col-xs-12.#{mainShowmd}.#{mainShowsm}>
-  <div#searchformdiv .row>
+  <div .row>
     <form#searchform .form-inline method=GET>
       <div .form-group .col-md-12 .col-sm-12 .col-xs-12>
         <div #searchbar .input-group>
@@ -36,3 +35,49 @@ $maybe m <- msg
             <button .btn .btn-default type=button data-toggle="modal" data-target="#helpmodal"
                title="Show search and general help">?
   ^{widget}
+
+<div .modal.fade #helpmodal tabindex="-1" role="dialog" aria-labelledby="helpLabel" aria-hidden="true">
+  <div .modal-dialog .modal-lg>
+    <div .modal-content>
+      <div .modal-header>
+        <button type="button" .close data-dismiss="modal" aria-hidden="true">&times;
+        <h3 .modal-title #helpLabel>Help
+      <div .modal-body>
+        <div .row>
+          <div .col-xs-6>
+            <p>
+              <b>Keyboard shortcuts
+              <ul>
+                <li> <code>h</code> or maybe <code>?</code> - view this help (escape or click to exit)
+                <li> <code>j</code> - go to the Journal view (home)
+                <li> <code>a</code> - add a transaction (escape to cancel)
+                <li> <code>s</code> - toggle sidebar
+                <li> <code>f</code> - focus search form ("find")
+            <p>
+              <b>General
+              <ul>
+                <li> The Journal view shows general journal entries, representing zero-sum movements of money (or other commodity) between hierarchical accounts
+                <li> The sidebar shows the resulting accounts and their final balances
+                <li> Parent account balances include subaccount balances
+                <li> Multiple currencies in balances are displayed one above the other
+                <li> Click account name links to see transactions affecting that account, with running balance
+                <li> Click date links to see journal entries on that date
+          <div .col-xs-6>
+            <p>
+              <b>Search
+              <ul>
+                <li> <code>acct:REGEXP</code> - filter on to/from account
+                <li> <code>desc:REGEXP</code> - filter on description
+                <li> <code>date:PERIODEXP</code>, <code>date2:PERIODEXP</code> - filter on date or secondary date
+                <li> <code>code:REGEXP</code> - filter on transaction's code (eg check number)
+                <li> <code>status:*</code>, <code>status:!</code>, <code>status:</code> - filter on transaction's cleared status (cleared, pending, uncleared)
+                <!-- <li> <code>empty:BOOL</code> - filter on whether amount is zero -->
+                <li> <code>amt:N</code>, <code>amt:&lt;N</code>, <code>amt:&gt;N</code> - filter on the unsigned amount magnitude. Or with a sign before N, filter on the signed value. (Single-commodity amounts only.)
+                <li> <code>cur:REGEXP</code> - filter on the currency/commodity symbol (must match all of it). Dollar sign must be written as <code>\$</code>
+                <li> <code>tag:NAME</code>, <code>tag:NAME=REGEX</code> - filter on tag name, or tag name and value
+                <!-- <li> <code>depth:N</code> - filter out accounts below this depth -->
+                <li> <code>real:BOOL</code> - filter on postings' real/virtual-ness
+                <li> Enclose search patterns containing spaces in single or double quotes
+                <li> Prepend <code>not:</code> to negate a search term
+                <li> Multiple search terms on different fields are AND'ed, multiple search terms on the same field are OR'ed
+                <li> These search terms also work with command-line hledger

hledger-web/templates/edit-form.hamlet

@@ -2,13 +2,13 @@
   <h2#contenttitle>Edit journal
   <table.form>
     $if length (jfiles j) > 1
-     <tr>
+      <tr>
-       <td colspan=2>
+        <td colspan=2>
-         Editing ^{journalselect (fmap (T.unpack . snd) (jfiles j))}
+          Editing ^{journalselect (fmap (T.unpack . snd) (jfiles j))}
     <tr>
       <td colspan=2>
         <!-- XXX textarea ids are unquoted journal file paths here, not valid html -->
-         $forall f <- jfiles j
+        $forall f <- jfiles j
           <textarea id=#{fst f}_textarea name=text rows=25 cols=80 style=display:none; disabled=disabled>
             \#{snd f}
     <tr#addbuttonrow>
@@ -18,7 +18,5 @@
       <td>
         <span.help>
           Are you sure ? This will overwrite the journal. #
-        <input type=hidden name=action value=edit>
+        <input type=submit name=submit value="save">
-        <input type=submit name=submit value="save journal">
-        \ or #
         <a href="#" onclick="return editformToggle(event)">cancel

hledger-web/templates/import-form.hamlet

@@ -3,7 +3,5 @@
   <tr>
    <td>
     <input type=file name=file>
-    <input type=hidden name=action value=import>
     <input type=submit name=submit value="import from file">
-    \ or #
     <a href="#" onclick="return importformToggle(event)">cancel

hledger-web/templates/journal.hamlet

@@ -30,3 +30,13 @@
               #{elideAccountName 40 acc}
           <td .amount .nonhead style="text-align:right;">
             ^{mixedAmountAsHtml amt}
+
+<div .modal #addmodal tabindex="-1" role="dialog" aria-labelledby="addLabel" aria-hidden="true">
+  <div .modal-dialog .modal-lg>
+    <div .modal-content>
+      <div .modal-header>
+        <button type="button" .close data-dismiss="modal" aria-hidden="true">&times;
+        <h3 .modal-title #addLabel>Add a transaction
+      <div .modal-body>
+        <form#addform.form action=@{AddR} method=POST enctype=#{addEnctype}>
+          ^{addView}

hledger-web/templates/register.hamlet

@@ -30,3 +30,13 @@
             $if not split || not (isZeroMixedAmount amt)
               \^{mixedAmountAsHtml amt}
           <td .balance style="text-align:right;">^{mixedAmountAsHtml bal}
+
+<div .modal #addmodal tabindex="-1" role="dialog" aria-labelledby="addLabel" aria-hidden="true">
+  <div .modal-dialog .modal-lg>
+    <div .modal-content>
+      <div .modal-header>
+        <button type="button" .close data-dismiss="modal" aria-hidden="true">&times;
+        <h3 .modal-title #addLabel>Add a transaction
+      <div .modal-body>
+        <form#addform.form action=@{AddR} method=POST enctype=#{addEnctype}>
+          ^{addView}