web: cleanup, fixes; migration to yesod 0.8 and filesystem templates is complete

hledger-web/.hledger/web/static/hledger.js

@@ -14,7 +14,7 @@ function filterformToggle() {
  var e = document.getElementById('editform');
  var f = document.getElementById('filterform');
  var i = document.getElementById('importform');
- var t = document.getElementById('transactions');
+ var c = document.getElementById('maincontent');
  var alink = document.getElementById('addformlink');
  var elink = document.getElementById('editformlink');
  var flink = document.getElementById('filterformlink');
@@ -37,7 +37,7 @@ function addformToggle(ev) {
  var e = document.getElementById('editform');
  var f = document.getElementById('filterform');
  var i = document.getElementById('importform');
- var t = document.getElementById('transactions');
+ var c = document.getElementById('maincontent');
  var alink = document.getElementById('addformlink');
  var elink = document.getElementById('editformlink');
  var flink = document.getElementById('filterformlink');
@@ -54,7 +54,7 @@ function addformToggle(ev) {
    if (a) a.style.display = 'block';
    if (e) e.style.display = 'none';
    if (i) i.style.display = 'none';
-   if (t) t.style.display = 'none';
+   if (c) c.style.display = 'none';
  } else {
    if (alink) alink.style['font-weight'] = 'normal';
    if (elink) elink.style['font-weight'] = 'normal';
@@ -62,7 +62,7 @@ function addformToggle(ev) {
    if (a) a.style.display = 'none';
    if (e) e.style.display = 'none';
    if (i) i.style.display = 'none';
-   if (t) t.style.display = 'block';
+   if (c) c.style.display = 'block';
  }
  return false;
 }
@@ -73,7 +73,7 @@ function editformToggle(ev) {
  var ej = document.getElementById('journalselect');
  var f = document.getElementById('filterform');
  var i = document.getElementById('importform');
- var t = document.getElementById('transactions');
+ var c = document.getElementById('maincontent');
  var alink = document.getElementById('addformlink');
  var elink = document.getElementById('editformlink');
  var flink = document.getElementById('filterformlink');
@@ -89,7 +89,7 @@ function editformToggle(ev) {
   if (rlink) rlink.style['font-weight'] = 'normal';
   if (a) a.style.display = 'none';
   if (i) i.style.display = 'none';
-  if (t) t.style.display = 'none';
+  if (c) c.style.display = 'none';
   if (e) e.style.display = 'block';
   editformJournalSelect(ev);
  } else {
@@ -99,7 +99,7 @@ function editformToggle(ev) {
   if (a) a.style.display = 'none';
   if (e) e.style.display = 'none';
   if (i) i.style.display = 'none';
-  if (t) t.style.display = 'block';
+  if (c) c.style.display = 'block';
  }
  return false;
 }
@@ -133,7 +133,7 @@ function importformToggle(ev) {
  var e = document.getElementById('editform');
  var f = document.getElementById('filterform');
  var i = document.getElementById('importform');
- var t = document.getElementById('transactions');
+ var c = document.getElementById('maincontent');
  var alink = document.getElementById('addformlink');
  var elink = document.getElementById('editformlink');
  var flink = document.getElementById('filterformlink');
@@ -150,7 +150,7 @@ function importformToggle(ev) {
    if (a) a.style.display = 'none';
    if (e) e.style.display = 'none';
    if (i) i.style.display = 'block';
-   if (t) t.style.display = 'none';
+   if (c) c.style.display = 'none';
  } else {
    if (alink) alink.style['font-weight'] = 'normal';
    if (elink) elink.style['font-weight'] = 'normal';
@@ -158,7 +158,7 @@ function importformToggle(ev) {
    if (a) a.style.display = 'none';
    if (e) e.style.display = 'none';
    if (i) i.style.display = 'none';
-   if (t) t.style.display = 'block';
+   if (c) c.style.display = 'block';
  }
  return false;
 }

hledger-web/.hledger/web/static/style.css

@@ -1,10 +1,3 @@
-/* LOCAL:
-hledger-web executables built in this repo will include these local styles
-when generating the web support files
-*/
-body { border-top: thin solid red; }
-/* END LOCAL */
-
 /* hledger web ui styles */
 
 /*------------------------------------------------------------------------------------------*/
@@ -25,7 +18,7 @@ body                                                                 { backgroun
 /* .journalreport td                                                    { border-color:thin solid #eee; } see below */
 
 .negative                                                            { color:#800; }
-#messages                                                            { color:red; background-color:#fee; }
+#message                                                             { color:red; background-color:#fee; }
 #addform input.textinput, #addform .dhx_combo_input, .dhx_combo_list { background-color:#eee; }
 #editform textarea                                                   { background-color:#eee; }
 
@@ -54,20 +47,19 @@ input.textinput, .dhx_combo_input, .dhx_combo_list { font-size:small; }
 /* 3. layout */
 
 body                        { margin:0; }
+#content                    { padding:1em 0 0 0.5em; }
 
-#navbar                     { padding:2px; }
+#topbar                     { padding:2px; }
 .topleftlink                { float:left; margin-right:1em; padding:2px; }
 .toprightlink               { float:right; margin-left:1em; padding:2px; }
-#navbar h1                  { display:inline-block; vertical-align:top; margin:0; }
+#topbar h1                  { display:inline-block; vertical-align:top; margin:0; }
 #journalinfo                { vertical-align:middle; margin:0; }
-/* #navbar                  { padding:4px; border-bottom:2px solid #ddd; } */
+/* #topbar                  { padding:4px; border-bottom:2px solid #ddd; } */
 
-#messages                   { margin:0.5em;}
+#message                    { margin:0.5em;}
 .help                       { font-style: italic; }
 .helprow td                 { padding-bottom:8px; }
 
-#content                    { padding:4px; }
-
 #sidebar { float:left; padding-right:1em; margin-bottom:5em; }
 
 #main { overflow:auto; border-left:thin solid #ded; padding-left:1em; }
@@ -109,8 +101,8 @@ table.registerreport        { border-spacing:0; }
 .registerreport td          { padding-bottom:0.2em; }
 .registerreport .date       { white-space:nowrap; }
 .firstposting td            { }
-#accountsheading            { font-weight:bold; white-space:nowrap; margin-bottom:1em; }
+#accountsheading            { white-space:nowrap; margin-bottom:1em; }
-#showmoreaccounts           { }
+#showmoreaccounts           { font-weight:bold; }
 
 
 #addform input.textinput, #addform .dhx_combo_input, .dhx_combo_list   { padding:4px; }

hledger-web/.hledger/web/templates/accountsheading.hamlet

@@ -1,4 +1,4 @@
-                      <span#accountsheading
+<div#accountsheading
  accounts
  \ #
  ^{showlinks}

hledger-web/.hledger/web/templates/accountsheadinglinksmore.hamlet

@@ -1,3 +1,2 @@
 \ | #
 <a href=@?{parenturl}>show more &uarr;
-                              |]

hledger-web/.hledger/web/templates/addform.hamlet

@@ -38,11 +38,11 @@
        <td
        <td
         <span.help>#{deschelp}
-   ^{postingfields td 1}
+   ^{postingfields vd 1}
-   ^{postingfields td 2}
+   ^{postingfields vd 2}
    <tr#addbuttonrow
     <td colspan=4
      <input type=hidden name=action value=add
      <input type=submit name=submit value="add transaction"
      $if manyfiles
-      \ to: ^{journalselect $ files $ j td}
+      \ to: ^{journalselect $ files $ j vd}

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

@@ -11,7 +11,4 @@
   <script type=text/javascript src=@{StaticR hledger_js}
   <link rel=stylesheet type=text/css media=all href=@{StaticR style_css}
  <body
-     $maybe msg <- mmsg
-         <div #message>#{msg}
-  <div#content
   ^{pageBody pc}

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

@@ -1,17 +0,0 @@
-!!!
-<html
- <head
-  <title>#{title'}
-  <meta http-equiv=Content-Type content=#{metacontent}
-  <script type=text/javascript src=@{StaticR jquery_js}
-  <script type=text/javascript src=@{StaticR jquery_url_js}
-  <script type=text/javascript src=@{StaticR dhtmlxcommon_js}
-  <script type=text/javascript src=@{StaticR dhtmlxcombo_js}
-  <script type=text/javascript src=@{StaticR hledger_js}
-  <link rel=stylesheet type=text/css media=all href=@{StaticR style_css}
- <body
-  ^{navbar td}
-  <div#messages>#{m}
-  <div#content
-   ^{content}
-|]

hledger-web/.hledger/web/templates/homepage.cassius

@@ -1,4 +0,0 @@
-h1
-    text-align: center
-h2##{h2id}
-    color: #990

hledger-web/.hledger/web/templates/homepage.hamlet

@@ -1,2 +0,0 @@
-<h1>Hello
-<h2 ##{h2id}>You could have Javascript enabled.

hledger-web/.hledger/web/templates/homepage.julius

@@ -1,3 +0,0 @@
-window.onload = function(){
-    document.getElementById("#{h2id}").innerHTML = "<i>Added from JavaScript.</i>";
-}

hledger-web/.hledger/web/templates/journal.hamlet

@@ -1,10 +1,12 @@
+^{topbar vd}
+<div#content
  <div#sidebar
   ^{sidecontent}
  <div#main.journal
-     ^{navlinks td}
+  ^{navlinks vd}
-     <div#transactions
+  <div#maincontent
-      ^{filterform td}
+   ^{filterform vd}
    ^{maincontent}
-     ^{addform td}
+  ^{addform vd}
-     ^{editform'}
+  ^{editform vd}
   ^{importform}

hledger-web/.hledger/web/templates/journalonly.hamlet

@@ -1,6 +1,7 @@
 <div.journal
  ^{editlinks}
- <div#transactions
+ <div#maincontent
-  ^{txns}
+  ^{maincontent}
- ^{addform td}
+ ^{addform vd}
- ^{editform'}
+ ^{editform vd}
+ ^{importform}

hledger-web/.hledger/web/templates/navbar.hamlet

@@ -1,9 +0,0 @@
- <div#navbar
-  <a.topleftlink href=#{hledgerorgurl}
-   hledger-web
-   <br />
-   #{version}
-  <a.toprightlink href=#{manualurl} target=hledgerhelp>manual
-  <h1>#{title}
-  \ #
-  <span#journaldesc>#{desc}

hledger-web/.hledger/web/templates/register.hamlet

@@ -1,10 +1,12 @@
+^{topbar vd}
+<div#content
  <div#sidebar
   ^{sidecontent}
-  <div#main.journal
+ <div#main.register
-   ^{navlinks td}
+  ^{navlinks vd}
-   <div#transactions
+  <div#maincontent
-    ^{filterform td}
+   ^{filterform vd}
    ^{maincontent}
-   ^{addform td}
+  ^{addform vd}
-   ^{editform'}
+  ^{editform vd}
   ^{importform}

hledger-web/.hledger/web/templates/registeronly.hamlet

@@ -0,0 +1,7 @@
+<div.register
+ ^{editlinks}
+ <div#maincontent
+  ^{maincontent}
+ ^{addform vd}
+ ^{editform vd}
+ ^{importform}

hledger-web/.hledger/web/templates/topbar.hamlet

@@ -0,0 +1,11 @@
+<div#topbar
+ <a.topleftlink href=#{hledgerorgurl}
+  hledger-web
+  <br />
+  #{version}
+ <a.toprightlink href=#{manualurl} target=hledgerhelp>manual
+ <h1>#{title}
+ \ #
+ <span#journaldesc>#{desc}
+$maybe m <- msg
+ <div#message>#{m}

hledger-web/App.hs

@@ -75,7 +75,7 @@ instance Yesod App where
     approot = appRoot
 
     defaultLayout widget = do
-        mmsg <- return (Nothing :: Maybe String) -- getMessage  -- XXX let getHandlerData get it
+        -- mmsg <- getMessage
         pc <- widgetToPageContent $ do
             widget
             addCassius $(Settings.cassiusFile "default-layout")

hledger-web/Handlers.hs

@@ -1,4 +1,10 @@
 {-# LANGUAGE TemplateHaskell, QuasiQuotes, OverloadedStrings #-}
+{-
+
+hledger-web's request handlers, and helpers.
+
+-}
+
 module Handlers where
 
 import Control.Applicative ((<$>), (<*>))
@@ -31,87 +37,91 @@ import Hledger.Utils
 
 import App
 import Settings
-import StaticFiles
 
 
-----------------------------------------------------------------------
--- handlers/views
-----------------------------------------------------------------------
-
--- Some default handlers that ship with the Yesod site template. You will
--- very rarely need to modify this.
 getFaviconR :: Handler ()
 getFaviconR = sendFile "image/x-icon" $ Settings.staticdir </> "favicon.ico"
 
 getRobotsR :: Handler RepPlain
 getRobotsR = return $ RepPlain $ toContent ("User-agent: *" :: ByteString)
 
-----------------------------------------------------------------------
-
 getRootR :: Handler RepHtml
 getRootR = redirect RedirectTemporary defaultroute where defaultroute = JournalR
 
 ----------------------------------------------------------------------
+-- main views
 
 -- | The main journal view, with accounts sidebar.
 getJournalR :: Handler RepHtml
 getJournalR = do
-  (a, p, opts, fspec, j, msg, here) <- getHandlerData
+  vd@VD{opts=opts,fspec=fspec,j=j} <- getViewData
-  today <- liftIO getCurrentDay
+  let sidecontent = balanceReportAsHtml opts vd $ balanceReport opts fspec j
-  -- app <- getYesod
+      maincontent = journalReportAsHtml opts vd $ journalReport opts fspec j
-  -- t <- liftIO $ getCurrentLocalTime
+      editform' = editform vd
-  let -- args = appArgs app
-      -- fspec' = optsToFilterSpec opts args t
-      sidecontent = balanceReportAsHtml opts td $ balanceReport opts fspec j
-      maincontent = journalReportAsHtml opts td $ journalReport opts fspec j
-      td = mktd{here=here, title="hledger journal", msg=msg, a=a, p=p, j=j, today=today}
-      editform' = editform td
   defaultLayout $ do
       setTitle "hledger-web journal"
       addHamlet $(Settings.hamletFile "journal")
 
 postJournalR :: Handler RepPlain
-postJournalR = postJournalOnlyR
+postJournalR = handlePost
-
-----------------------------------------------------------------------
 
 -- | The main register view, with accounts sidebar.
 getRegisterR :: Handler RepHtml
 getRegisterR = do
-  (a, p, opts, fspec, j, msg, here) <- getHandlerData
+  vd@VD{opts=opts,fspec=fspec,j=j} <- getViewData
-  today <- liftIO getCurrentDay
+  let sidecontent = balanceReportAsHtml opts vd $ balanceReport opts fspec j
-  -- app <- getYesod
+      maincontent = registerReportAsHtml opts vd $ registerReport opts fspec j
-  -- t <- liftIO $ getCurrentLocalTime
+      editform' = editform vd
-  let -- args = appArgs app
-      -- opts' = Empty:opts
-      -- fspec' = optsToFilterSpec opts' args t
-      sidecontent = balanceReportAsHtml opts td $ balanceReport opts fspec j
-      maincontent = registerReportAsHtml opts td $ registerReport opts fspec j
-      td = mktd{here=here, title="hledger register", msg=msg, a=a, p=p, j=j, today=today}
-      editform' = editform td
   defaultLayout $ do
       setTitle "hledger-web register"
       addHamlet $(Settings.hamletFile "register")
 
 postRegisterR :: Handler RepPlain
-postRegisterR = postJournalOnlyR
+postRegisterR = handlePost
 
-----------------------------------------------------------------------
+-- | A simple journal view, like hledger print (with editing.)
+getJournalOnlyR :: Handler RepHtml
+getJournalOnlyR = do
+  vd@VD{opts=opts,fspec=fspec,j=j} <- getViewData
+  defaultLayout $ do
+      setTitle "hledger-web journal only"
+      addHamlet $ journalReportAsHtml opts vd $ journalReport opts fspec j
+
+postJournalOnlyR :: Handler RepPlain
+postJournalOnlyR = handlePost
+
+-- | A simple postings view, like hledger register (with editing.)
+getRegisterOnlyR :: Handler RepHtml
+getRegisterOnlyR = do
+  vd@VD{opts=opts,fspec=fspec,j=j} <- getViewData
+  defaultLayout $ do
+      setTitle "hledger-web register only"
+      addHamlet $ registerReportAsHtml opts vd $ registerReport opts fspec j
+
+postRegisterOnlyR :: Handler RepPlain
+postRegisterOnlyR = handlePost
 
 -- | A simple accounts view, like hledger balance.
 getAccountsOnlyR :: Handler RepHtml
 getAccountsOnlyR = do
-  (a, p, opts, fspec, j, msg, here) <- getHandlerData
+  vd@VD{opts=opts,fspec=fspec,j=j} <- getViewData
-  today <- liftIO getCurrentDay
-  let td = mktd{here=here, title="hledger accounts", msg=msg, a=a, p=p, j=j, today=today}
   defaultLayout $ do
       setTitle "hledger-web accounts"
-      addHamlet $ balanceReportAsHtml opts td $ balanceReport opts fspec j
+      addHamlet $ balanceReportAsHtml opts vd $ balanceReport opts fspec j
+
+-- helpers
 
 -- | Render a balance report as HTML.
-balanceReportAsHtml :: [Opt] -> TemplateData -> BalanceReport -> Hamlet AppRoute
+balanceReportAsHtml :: [Opt] -> ViewData -> BalanceReport -> Hamlet AppRoute
-balanceReportAsHtml _ td@TD{here=here,a=a,p=p} (items,total) = $(Settings.hamletFile "balancereport")
+balanceReportAsHtml _ vd@VD{here=here,a=a,p=p} (items,total) = $(Settings.hamletFile "balancereport")
  where
+   itemAsHtml' = itemAsHtml vd
+   itemAsHtml :: ViewData -> BalanceReportItem -> Hamlet AppRoute
+   itemAsHtml VD{p=p} (acct, adisplay, adepth, abal) = $(Settings.hamletFile "balancereportitem")
+     where
+       indent = preEscapedString $ concat $ replicate (2 * adepth) "&nbsp;"
+       acctpat = accountNameToAccountRegex acct
+       pparam = if null p then "" else "&p="++p
    accountsheading = $(Settings.hamletFile "accountsheading")
        where
          filteringaccts = not $ null a
@@ -128,109 +138,27 @@ balanceReportAsHtml _ td@TD{here=here,a=a,p=p} (items,total) = $(Settings.hamlet
                     then $(Settings.hamletFile "accountsheadinglinksall")
                     else nulltemplate
              where allurl = (here, [("p",pack p)])
-   itemAsHtml' = itemAsHtml td
-   itemAsHtml :: TemplateData -> BalanceReportItem -> Hamlet AppRoute
-   itemAsHtml TD{p=p} (acct, adisplay, adepth, abal) = $(Settings.hamletFile "balancereportitem")
-     where
-       indent = preEscapedString $ concat $ replicate (2 * adepth) "&nbsp;"
-       acctpat = accountNameToAccountRegex acct
-       pparam = if null p then "" else "&p="++p
-
-accountNameToAccountRegex :: String -> String
-accountNameToAccountRegex "" = ""
-accountNameToAccountRegex a = printf "^%s(:|$)" a
-
-accountRegexToAccountName :: String -> String
-accountRegexToAccountName = gsubRegexPR "^\\^(.*?)\\(:\\|\\$\\)$" "\\1"
-
-isAccountRegex  :: String -> Bool
-isAccountRegex s = take 1 s == "^" && (take 5 $ reverse s) == ")$|:("
-
-----------------------------------------------------------------------
-
--- | A simple journal view, like hledger print (with editing.)
-getJournalOnlyR :: Handler RepHtml
-getJournalOnlyR = do
-  (a, p, opts, fspec, j, msg, here) <- getHandlerData
-  today <- liftIO getCurrentDay
-  let td = mktd{here=here, title="hledger journal", msg=msg, a=a, p=p, j=j, today=today}
-      editform' = editform td
-      txns = journalReportAsHtml opts td $ journalReport opts fspec j
-  defaultLayout $ do
-      setTitle "hledger-web journal only"
-      addHamlet $(Settings.hamletFile "journalonly")
 
 -- | Render a journal report as HTML.
-journalReportAsHtml :: [Opt] -> TemplateData -> JournalReport -> Hamlet AppRoute
+journalReportAsHtml :: [Opt] -> ViewData -> JournalReport -> Hamlet AppRoute
-journalReportAsHtml _ td items = $(Settings.hamletFile "journalreport")
+journalReportAsHtml _ vd items = $(Settings.hamletFile "journalreport")
  where
    number = zip [1..]
-   itemAsHtml' = itemAsHtml td
+   itemAsHtml' = itemAsHtml vd
-   itemAsHtml :: TemplateData -> (Int, JournalReportItem) -> Hamlet AppRoute
+   itemAsHtml :: ViewData -> (Int, JournalReportItem) -> Hamlet AppRoute
    itemAsHtml _ (n, t) = $(Settings.hamletFile "journalreportitem")
      where
        evenodd = if even n then "even" else "odd" :: String
        txn = trimnl $ showTransaction t where trimnl = reverse . dropWhile (=='\n') . reverse
 
-addform :: TemplateData -> Hamlet AppRoute
-addform td = $(Settings.hamletFile "addform")
- where
-  -- datehelplink = helplink "dates" "..."
-  datehelp = "eg: 2010/7/20" :: String
-  deschelp = "eg: supermarket (optional)" :: String
-  date = "today" :: String
-  descriptions = sort $ nub $ map tdescription $ jtxns $ j td
-  manyfiles = (length $ files $ j td) > 1
-
-postingfields :: TemplateData -> Int -> Hamlet AppRoute
-postingfields TD{j=j} n = $(Settings.hamletFile "postingfields")
- where
-  numbered = (++ show n)
-  acctvar = numbered "account"
-  amtvar = numbered "amount"
-  acctnames = sort $ journalAccountNamesUsed j
-  (acctlabel, accthelp, amtfield, amthelp)
-       | n == 1     = ("To account"
-                     ,"eg: expenses:food"
-                     ,$(Settings.hamletFile "postingfieldsamount")
-                     ,"eg: $6"
-                     )
-       | otherwise = ("From account" :: String
-                     ,"eg: assets:bank:checking" :: String
-                     ,nulltemplate
-                     ,"" :: String
-                     )
-
-editform :: TemplateData -> Hamlet AppRoute
-editform TD{j=j} = $(Settings.hamletFile "editform")
-  where
-    manyfiles = (length $ files j) > 1
-    formathelp = helplink "file-format" "file format help"
-
-journalselect :: [(FilePath,String)] -> Hamlet AppRoute
-journalselect journalfiles = $(Settings.hamletFile "journalselect")
-
-importform :: Hamlet AppRoute
-importform = $(Settings.hamletFile "importform")
-
-----------------------------------------------------------------------
-
--- | A simple postings view, like hledger register.
-getRegisterOnlyR :: Handler RepHtml
-getRegisterOnlyR = do
-  (a, p, opts, fspec, j, msg, here) <- getHandlerData
-  today <- liftIO getCurrentDay
-  let td = mktd{here=here, title="hledger register", msg=msg, a=a, p=p, j=j, today=today}
-  hamletToRepHtml $ hledgerLayout td $ registerReportAsHtml opts td $ registerReport opts fspec j
-
 -- | Render a register report as HTML.
-registerReportAsHtml :: [Opt] -> TemplateData -> RegisterReport -> Hamlet AppRoute
+registerReportAsHtml :: [Opt] -> ViewData -> RegisterReport -> Hamlet AppRoute
-registerReportAsHtml _ td items = $(Settings.hamletFile "registerreport")
+registerReportAsHtml _ vd items = $(Settings.hamletFile "registerreport")
  where
    number = zip [1..]
-   itemAsHtml' = itemAsHtml td
+   itemAsHtml' = itemAsHtml vd
-   itemAsHtml :: TemplateData -> (Int, RegisterReportItem) -> Hamlet AppRoute
+   itemAsHtml :: ViewData -> (Int, RegisterReportItem) -> Hamlet AppRoute
-   itemAsHtml TD{here=here,p=p} (n, (ds, posting, b)) = $(Settings.hamletFile "registerreportitem")
+   itemAsHtml VD{here=here,p=p} (n, (ds, posting, b)) = $(Settings.hamletFile "registerreportitem")
      where
        evenodd = if even n then "even" else "odd" :: String
        (firstposting, date, desc) = case ds of Just (da, de) -> ("firstposting", show da, de)
@@ -244,18 +172,19 @@ mixedAmountAsHtml b = preEscapedString $ addclass $ intercalate "<br>" $ lines $
           c = case isNegativeMixedAmount b of Just True -> "negative amount"
                                               _         -> "positive amount"
 
-postJournalOnlyR :: Handler RepPlain
+-- | Handle a post from any of the edit forms.
-postJournalOnlyR = do
+handlePost :: Handler RepPlain
+handlePost = do
   action <- runFormPost' $ maybeStringInput "action"
-  case action of Just "edit"   -> postEditForm
+  case action of Just "add"    -> handleAdd
-                 Just "import" -> postImportForm
+                 Just "edit"   -> handleEdit
-                 _             -> postAddForm
+                 Just "import" -> handleImport
+                 _             -> invalidArgs [pack "invalid action"]
 
--- | Handle a journal add form post.
+-- | Handle a post from the transaction add form.
-postAddForm :: Handler RepPlain
+handleAdd :: Handler RepPlain
-postAddForm = do
+handleAdd = do
-  (_, _, _, _, j, _, _) <- getHandlerData
+  VD{j=j,today=today} <- getViewData
-  today <- liftIO getCurrentDay
   -- get form input values. M means a Maybe value.
   (dateM, descM, acct1M, amt1M, acct2M, amt2M, journalM) <- runFormPost'
     $ (,,,,,,)
@@ -309,10 +238,10 @@ postAddForm = do
     setMessage $ toHtml $ (printf "Added transaction:\n%s" (show t') :: String)
     redirect RedirectTemporary RegisterR
 
--- | Handle a journal edit form post.
+-- | Handle a post from the journal edit form.
-postEditForm :: Handler RepPlain
+handleEdit :: Handler RepPlain
-postEditForm = do
+handleEdit = do
-  (_, _, _, _, j, _, _) <- getHandlerData
+  VD{j=j} <- getViewData
   -- get form input values, or validation errors.
   -- getRequest >>= liftIO (reqRequestBody req) >>= mtrace
   (textM, journalM) <- runFormPost'
@@ -357,9 +286,9 @@ postEditForm = do
           redirect RedirectTemporary JournalR)
        jE
 
--- | Handle an import page post.
+-- | Handle post from the journal import form.
-postImportForm :: Handler RepPlain
+handleImport :: Handler RepPlain
-postImportForm = do
+handleImport = do
   setMessage "can't handle file upload yet"
   redirect RedirectTemporary JournalR
   -- -- get form input values, or basic validation errors. E means an Either value.
@@ -376,36 +305,39 @@ postImportForm = do
   --    redirect RedirectTemporary JournalR
 
 ----------------------------------------------------------------------
--- common templates, helpers, utilities
+-- | Other view components.
-----------------------------------------------------------------------
-
--- | Wrap a template with the standard hledger web ui page layout.
-hledgerLayout :: TemplateData -> Hamlet AppRoute -> Hamlet AppRoute
-hledgerLayout td@TD{title=basetitle, msg=msg, p=p, j=j, today=today} content =
- $(Settings.hamletFile "hledger-layout")
- where title' = basetitle ++ " - " ++ journaltitle
-       (journaltitle, _) = journalTitleDesc j p today
-       metacontent = "text/html; charset=utf-8" :: String
-       m = fromMaybe "" msg
 
 -- | Global toolbar/heading area.
-navbar :: TemplateData -> Hamlet AppRoute
+topbar :: ViewData -> Hamlet AppRoute
-navbar TD{p=p,j=j,today=today} = $(Settings.hamletFile "navbar")
+topbar VD{p=p,j=j,msg=msg,today=today} = $(Settings.hamletFile "topbar")
-  where (title, desc) = journalTitleDesc j p today
-
--- | Links to the main views.
-navlinks :: TemplateData -> Hamlet AppRoute
-navlinks td = $(Settings.hamletFile "navlinks")
   where
-   accountsjournallink  = navlink td "journal" JournalR
+    (title, desc) = journalTitleDesc j p today
-   accountsregisterlink = navlink td "register" RegisterR
+
-   navlink :: TemplateData -> String -> AppRoute -> Hamlet AppRoute
+-- | Generate a title and description for the given journal, period
-   navlink TD{here=here,a=a,p=p} s dest = $(Settings.hamletFile "navlink")
+-- expression, and date.
+journalTitleDesc :: Journal -> String -> Day -> (String, String)
+journalTitleDesc j p today = (title, desc)
+  where
+    title = printf "%s" (takeFileName $ journalFilePath j) :: String
+    desc  = printf "%s" (showspan span) :: String
+    span = either (const $ DateSpan Nothing Nothing) snd (parsePeriodExpr today p)
+    showspan (DateSpan Nothing Nothing) = ""
+    showspan s = " (" ++ dateSpanAsText s ++ ")"
+
+-- | Links to navigate between the main views.
+navlinks :: ViewData -> Hamlet AppRoute
+navlinks vd = $(Settings.hamletFile "navlinks")
+ where
+   accountsjournallink  = navlink vd "journal" JournalR
+   accountsregisterlink = navlink vd "register" RegisterR
+   navlink :: ViewData -> String -> AppRoute -> Hamlet AppRoute
+   navlink VD{here=here,a=a,p=p} s dest = $(Settings.hamletFile "navlink")
     where u = (dest, concat [(if null a then [] else [("a", pack a)])
                             ,(if null p then [] else [("p", pack p)])])
           style | dest == here = "navlinkcurrent"
                 | otherwise    = "navlink" :: Text
 
+-- | Links to the various journal editing forms.
 editlinks :: Hamlet AppRoute
 editlinks = $(Settings.hamletFile "editlinks")
 
@@ -415,8 +347,8 @@ helplink topic label = $(Settings.hamletFile "helplink")
     where u = manualurl ++ if null topic then "" else '#':topic
 
 -- | Form controlling journal filtering parameters.
-filterform :: TemplateData -> Hamlet AppRoute
+filterform :: ViewData -> Hamlet AppRoute
-filterform TD{here=here,a=a,p=p} = $(Settings.hamletFile "filterform")
+filterform VD{here=here,a=a,p=p} = $(Settings.hamletFile "filterform")
  where
   ahelp = helplink "filter-patterns" "?"
   phelp = helplink "period-expressions" "?"
@@ -430,58 +362,90 @@ filterform TD{here=here,a=a,p=p} = $(Settings.hamletFile "filterform")
   stopfilteringperiod = if filteringperiod then $(Settings.hamletFile "filterformclear") else nulltemplate
       where u = (here, if filtering then [("a", pack a)] else [])
 
+-- | Add transaction form.
+addform :: ViewData -> Hamlet AppRoute
+addform vd = $(Settings.hamletFile "addform")
+ where
+  datehelp = "eg: 2010/7/20" :: String
+  deschelp = "eg: supermarket (optional)" :: String
+  date = "today" :: String
+  descriptions = sort $ nub $ map tdescription $ jtxns $ j vd
+  manyfiles = (length $ files $ j vd) > 1
+  postingfields VD{j=j} n = $(Settings.hamletFile "postingfields")
+   where
+    numbered = (++ show n)
+    acctvar = numbered "account"
+    amtvar = numbered "amount"
+    acctnames = sort $ journalAccountNamesUsed j
+    (acctlabel, accthelp, amtfield, amthelp)
+       | n == 1     = ("To account"
+                     ,"eg: expenses:food"
+                     ,$(Settings.hamletFile "postingfieldsamount")
+                     ,"eg: $6"
+                     )
+       | otherwise = ("From account" :: String
+                     ,"eg: assets:bank:checking" :: String
+                     ,nulltemplate
+                     ,"" :: String
+                     )
+
+-- | Edit journal form.
+editform :: ViewData -> Hamlet AppRoute
+editform VD{j=j} = $(Settings.hamletFile "editform")
+  where
+    manyfiles = (length $ files j) > 1
+    formathelp = helplink "file-format" "file format help"
+
+-- | Import journal form.
+importform :: Hamlet AppRoute
+importform = $(Settings.hamletFile "importform")
+
+journalselect :: [(FilePath,String)] -> Hamlet AppRoute
+journalselect journalfiles = $(Settings.hamletFile "journalselect")
+
+----------------------------------------------------------------------
+-- utilities
+
 nulltemplate :: Hamlet AppRoute
 nulltemplate = [$hamlet||]
 
--- | Generate a title and description for the given journal, period
+-- | A bundle of data useful for handlers and their templates.
--- expression, and date.
+data ViewData = VD {
-journalTitleDesc :: Journal -> String -> Day -> (String, String)
+     opts  :: [Opt]       -- ^ command-line options at startup
-journalTitleDesc j p today = (title, desc)
+    ,a     :: String      -- ^ current a parameter (a hledger account/description filter pattern)
-  where
+    ,p     :: String      -- ^ current p parameter (a hledger period expression)
-    title = printf "%s" (takeFileName $ journalFilePath j) :: String
+    ,fspec :: FilterSpec  -- ^ a journal filter specification based on the above
-    desc  = printf "%s" (showspan span) :: String
+    ,j     :: Journal     -- ^ an up-to-date parsed journal
-    span = either (const $ DateSpan Nothing Nothing) snd (parsePeriodExpr today p)
-    showspan (DateSpan Nothing Nothing) = ""
-    showspan s = " (" ++ dateSpanAsText s ++ ")"
-
--- | A bundle of useful data passed to templates.
-data TemplateData = TD {
-     here         :: AppRoute -- ^ the current page's route
-    ,title        :: String             -- ^ page's title
-    ,msg          :: Maybe Html         -- ^ transient message
-    ,a            :: String             -- ^ a (acct/desc filter pattern) parameter
-    ,p            :: String             -- ^ p (period expression) parameter
-    ,j            :: Journal            -- ^ the current journal
     ,today :: Day         -- ^ the current day
+    ,here  :: AppRoute    -- ^ the current route
+    ,msg   :: Maybe Html  -- ^ the current UI message if any, possibly from the current request
     }
 
-mktd :: TemplateData
+mkvd :: ViewData
-mktd = TD {
+mkvd = VD {
-      here = RootR
+      opts  = []
-     ,title = "hledger"
-     ,msg = Nothing
      ,a     = ""
      ,p     = ""
+     ,fspec = nullfilterspec
      ,j     = nulljournal
      ,today = ModifiedJulianDay 0
+     ,here  = RootR
+     ,msg   = Nothing
      }
 
--- | Gather the data useful for a hledger web request handler, including:
+-- | Gather data useful for a hledger-web request handler and its templates.
--- initial command-line options, current a and p query string values, a
+getViewData :: Handler ViewData
--- journal filter specification based on the above and the current time,
+getViewData = do
--- an up-to-date parsed journal, the current route, and the current ui
--- message if any.
-getHandlerData :: Handler (String, String, [Opt], FilterSpec, Journal, Maybe Html, AppRoute)
-getHandlerData = do
   Just here'          <- getCurrentRoute
-  (a, p, opts, fspec) <- getReportParameters
+  (a, p, opts, fspec) <- getCurrentParameters
-  (j, err) <- getLatestJournal opts
+  (j, err)            <- getCurrentJournal opts
-  msg <- getMessage' err
+  msg                 <- getMessageOr err
-  return (a, p, opts, fspec, j, msg, here')
+  today               <- liftIO getCurrentDay
+  return mkvd{opts=opts, a=a, p=p, fspec=fspec, j=j, today=today, here=here', msg=msg}
     where
       -- | Get current report parameters for this request.
-      getReportParameters :: Handler (String, String, [Opt], FilterSpec)
+      getCurrentParameters :: Handler (String, String, [Opt], FilterSpec)
-      getReportParameters = do
+      getCurrentParameters = do
           app <- getYesod
           t <- liftIO $ getCurrentLocalTime
           a <- fromMaybe "" <$> lookupGetParam "a"
@@ -492,18 +456,11 @@ getHandlerData = do
               fspec = optsToFilterSpec opts args t
           return (a', p', opts, fspec)
 
-      -- | Quote-sensitive words, ie don't split on spaces which are inside quotes.
-      words' :: String -> [String]
-      words' = fromparse . parsewith ((quotedPattern <|> pattern) `sepBy` many1 spacenonewline)
-          where
-            pattern = many (noneOf " \n\r\"")
-            quotedPattern = between (oneOf "'\"") (oneOf "'\"") $ many $ noneOf "'\""
-
       -- | Update our copy of the journal if the file changed. If there is an
       -- error while reloading, keep the old one and return the error, and set a
       -- ui message.
-      getLatestJournal :: [Opt] -> Handler (Journal, Maybe String)
+      getCurrentJournal :: [Opt] -> Handler (Journal, Maybe String)
-      getLatestJournal opts = do
+      getCurrentJournal opts = do
         j <- liftIO $ fromJust `fmap` getValue "hledger" "journal"
         (jE, changed) <- liftIO $ journalReloadIfChanged opts j
         if not changed
@@ -514,8 +471,26 @@ getHandlerData = do
                 Left e  -> do setMessage $ "error while reading" {- ++ ": " ++ e-}
                               return (j, Just e)
 
-      -- | Helper to work around a yesod feature (can't set and get a message in the same request.)
+-- | Get the message set by the last request, or the newer message provided, if any.
-      getMessage' :: Maybe String -> Handler (Maybe Html)
+getMessageOr :: Maybe String -> Handler (Maybe Html)
-      getMessage' newmsgstr = do
+getMessageOr mnewmsg = do
   oldmsg <- getMessage
-        return $ maybe oldmsg (Just . toHtml) newmsgstr
+  return $ maybe oldmsg (Just . toHtml) mnewmsg
+
+accountNameToAccountRegex :: String -> String
+accountNameToAccountRegex "" = ""
+accountNameToAccountRegex a = printf "^%s(:|$)" a
+
+accountRegexToAccountName :: String -> String
+accountRegexToAccountName = gsubRegexPR "^\\^(.*?)\\(:\\|\\$\\)$" "\\1"
+
+isAccountRegex  :: String -> Bool
+isAccountRegex s = take 1 s == "^" && (take 5 $ reverse s) == ")$|:("
+
+-- | Quote-aware version of words - don't split on spaces which are inside quotes.
+words' :: String -> [String]
+words' = fromparse . parsewith ((quotedPattern <|> pattern) `sepBy` many1 spacenonewline)
+    where
+      pattern = many (noneOf " \n\r\"")
+      quotedPattern = between (oneOf "'\"") (oneOf "'\"") $ many $ noneOf "'\""
+

hledger-web/routes

@@ -5,4 +5,5 @@
 /journal         JournalR       GET POST
 /register        RegisterR      GET POST
 /journalonly     JournalOnlyR   GET POST
+/registeronly    RegisterOnlyR  GET POST
 /accountsonly    AccountsOnlyR  GET