web: more web and report refactoring, and a html register report

Hledger/Cli/Commands/Add.hs

@@ -10,7 +10,7 @@ where
 import Hledger.Data
 import Hledger.Read.Journal (someamount)
 import Hledger.Cli.Options
-import Hledger.Cli.Commands.Register (showRegisterReport)
+import Hledger.Cli.Commands.Register (registerReport, registerReportAsText)
 #if __GLASGOW_HASKELL__ <= 610
 import Prelude hiding (putStr, putStrLn, getLine, appendFile)
 import System.IO.UTF8
@@ -160,7 +160,7 @@ registerFromString :: String -> IO String
 registerFromString s = do
   now <- getCurrentLocalTime
   l <- readJournalWithOpts [] s
-  return $ showRegisterReport opts (optsToFilterSpec opts [] now) l
+  return $ registerReportAsText opts $ registerReport opts (optsToFilterSpec opts [] now) l
     where opts = [Empty]
 
 -- | Return a similarity measure, from 0 to 1, for two strings.

Hledger/Cli/Commands/Balance.hs

@@ -95,8 +95,14 @@ balance report:
 
 -}
 
-module Hledger.Cli.Commands.Balance
+module Hledger.Cli.Commands.Balance (
-where
+  balance
+ ,BalanceReport
+ ,BalanceReportItem
+ ,balanceReport
+ ,balanceReportAsText
+ -- ,tests_Balance
+) where
 import Hledger.Data.Utils
 import Hledger.Data.Types
 import Hledger.Data.Amount
@@ -110,7 +116,7 @@ import System.IO.UTF8
 #endif
 
 
--- | The data for a balance report.
+-- | A balance report is a chart of accounts with balances, and their grand total.
 type BalanceReport = ([BalanceReportItem] -- ^ line items, one per account
                      ,MixedAmount         -- ^ total balance of all accounts
                      )
@@ -126,24 +132,29 @@ type BalanceReportItem = (AccountName  -- ^ full account name
 balance :: [Opt] -> [String] -> Journal -> IO ()
 balance opts args j = do
   t <- getCurrentLocalTime
-  putStr $ showBalanceReport opts $ balanceReport opts (optsToFilterSpec opts args t) j
+  putStr $ balanceReportAsText opts $ balanceReport opts (optsToFilterSpec opts args t) j
 
 -- | Render a balance report as plain text suitable for console output.
-showBalanceReport :: [Opt] -> BalanceReport -> String
+balanceReportAsText :: [Opt] -> BalanceReport -> String
-showBalanceReport opts (items,total) = acctsstr ++ totalstr
+balanceReportAsText opts (items,total) =
+    unlines $
+            map (balanceReportItemAsText opts) items
+            ++
+            if NoTotal `elem` opts
+             then []
+             else ["--------------------"
+                  ,padleft 20 $ showMixedAmountWithoutPrice total
+                  ]
+
+-- | Render one balance report line item as plain text.
+balanceReportItemAsText :: [Opt] -> BalanceReportItem -> String
+balanceReportItemAsText opts (a, adisplay, adepth, abal) = concatTopPadded [amt, "  ", name]
     where
-      acctsstr = unlines $ map showitem items
+      amt = padleft 20 $ showMixedAmountWithoutPrice abal
-      totalstr | NoTotal `elem` opts = ""
+      name | Flat `elem` opts = accountNameDrop (dropFromOpts opts) a
-               | otherwise = printf "--------------------\n%s\n" $ padleft 20 $ showMixedAmountWithoutPrice total
+           | otherwise        = depthspacer ++ adisplay
-      -- | Render one balance report line item as plain text.
+      depthspacer = replicate (indentperlevel * adepth) ' '
-      showitem :: BalanceReportItem -> String
+      indentperlevel = 2
-      showitem (a, adisplay, adepth, abal) = concatTopPadded [amt, "  ", name]
-          where
-            amt = padleft 20 $ showMixedAmountWithoutPrice abal
-            name | Flat `elem` opts = accountNameDrop (dropFromOpts opts) a
-                 | otherwise        = depthspacer ++ adisplay
-            depthspacer = replicate (indentperlevel * adepth) ' '
-            indentperlevel = 2
 
 -- | Get a balance report with the specified options for this journal.
 balanceReport :: [Opt] -> FilterSpec -> Journal -> BalanceReport
@@ -157,11 +168,13 @@ balanceReport opts filterspec j = (items, total)
       l = journalToLedger filterspec j
       -- | Get data for one balance report line item.
       mkitem :: AccountName -> BalanceReportItem
-      mkitem a = (a, adisplay, adepth, abal)
+      mkitem a = (a, adisplay, indent, abal)
           where
-            adisplay = accountNameFromComponents $ reverse (map accountLeafName ps) ++ [accountLeafName a]
+            adisplay | Flat `elem` opts = a
+                     | otherwise = accountNameFromComponents $ reverse (map accountLeafName ps) ++ [accountLeafName a]
                 where ps = takeWhile boring parents where boring = not . (`elem` interestingparents)
-            adepth = length interestingparents
+            indent | Flat `elem` opts = 0
+                   | otherwise = length interestingparents
             interestingparents = filter (`elem` interestingaccts) parents
             parents = parentAccountNames a
             abal | Flat `elem` opts = exclusiveBalance acct

Hledger/Cli/Commands/Register.hs

@@ -7,8 +7,11 @@ A ledger-compatible @register@ command.
 
 module Hledger.Cli.Commands.Register (
   register
- ,showRegisterReport
+ ,RegisterReport
- ,showPostingWithBalance
+ ,RegisterReportItem
+ ,registerReport
+ ,registerReportAsText
+ ,showPostingWithBalanceForVty
  ,tests_Register
 ) where
 
@@ -22,24 +25,80 @@ import System.IO.UTF8
 import Text.ParserCombinators.Parsec
 
 
+-- | A register report is a list of postings to an account or set of
+-- accounts, with a running total. Postings may be actual postings, or
+-- virtual postings aggregated over a reporting interval.
+type RegisterReport = [RegisterReportItem] -- ^ line items, one per posting
+
+-- | The data for a single register report line item, representing one posting.
+type RegisterReportItem = (Maybe (Day, String) -- ^ transaction date and description if this is the first posting
+                          ,Posting             -- ^ the posting
+                          ,MixedAmount         -- ^ balance so far
+                          )
+
 -- | Print a register report.
 register :: [Opt] -> [String] -> Journal -> IO ()
 register opts args j = do
   t <- getCurrentLocalTime
-  putStr $ showRegisterReport opts (optsToFilterSpec opts args t) j
+  putStr $ registerReportAsText opts $ registerReport opts (optsToFilterSpec opts args t) j
 
--- | Generate the register report, which is a list of postings with transaction
+-- | Render a register report as plain text suitable for console output.
--- info and a running balance.
+registerReportAsText :: [Opt] -> RegisterReport -> String
-showRegisterReport :: [Opt] -> FilterSpec -> Journal -> String
+registerReportAsText opts = unlines . map (registerReportItemAsText opts)
-showRegisterReport opts filterspec j = showPostingsWithBalance ps nullposting startbal
+
+-- | Render one register report line item as plain text. Eg:
+-- @
+-- date (10)  description (20)     account (22)            amount (11)  balance (12)
+-- DDDDDDDDDD dddddddddddddddddddd aaaaaaaaaaaaaaaaaaaaaa  AAAAAAAAAAA AAAAAAAAAAAA
+-- ^ displayed for first postings^
+--   only, otherwise blank
+-- @
+registerReportItemAsText :: [Opt] -> RegisterReportItem -> String
+registerReportItemAsText _ (dd, p, b) = concatTopPadded [datedesc, pstr, " ", bal]
+    where
+      datedesc = case dd of Nothing -> replicate datedescwidth ' '
+                            Just (da, de) -> printf "%s %s " date desc
+                                where
+                                  date = showDate da
+                                  desc = printf ("%-"++(show descwidth)++"s") $ elideRight descwidth de :: String
+          where
+            descwidth = datedescwidth - datewidth - 2
+            datedescwidth = 32
+            datewidth = 10
+      pstr = showPostingForRegister p
+      bal = padleft 12 (showMixedAmountOrZeroWithoutPrice b)
+
+showPostingWithBalanceForVty showtxninfo p b = registerReportItemAsText [] $ mkitem showtxninfo p b
+
+-- | Get a register report with the specified options for this journal.
+registerReport :: [Opt] -> FilterSpec -> Journal -> RegisterReport
+registerReport opts fspec j = getitems ps nullposting startbal
     where
       ps | interval == NoInterval = displayableps
-         | otherwise             = summarisePostings interval depth empty filterspan displayableps
+         | otherwise              = summarisePostings interval depth empty filterspan displayableps
+      (precedingps, displayableps, _) =
+          postingsMatchingDisplayExpr (displayExprFromOpts opts) $ journalPostings $ filterJournalPostings fspec j
       startbal = sumPostings precedingps
-      (precedingps,displayableps,_) =
-          postingsMatchingDisplayExpr (displayExprFromOpts opts) $ journalPostings $ filterJournalPostings filterspec j
       (interval, depth, empty) = (intervalFromOpts opts, depthFromOpts opts, Empty `elem` opts)
-      filterspan = datespan filterspec
+      filterspan = datespan fspec
+
+-- | Generate register report line items.
+getitems :: [Posting] -> Posting -> MixedAmount -> [RegisterReportItem]
+getitems [] _ _ = []
+getitems (p:ps) pprev b = i:(getitems ps p b')
+    where
+      i = mkitem isfirst p b'
+      isfirst = ptransaction p /= ptransaction pprev
+      b' = b + pamount p
+
+-- | Generate one register report line item, from a flag indicating
+-- whether to include transaction info, a posting, and the current running
+-- balance.
+mkitem :: Bool -> Posting -> MixedAmount -> RegisterReportItem
+mkitem False p b = (Nothing, p, b)
+mkitem True p b = (ds, p, b)
+    where ds = case ptransaction p of Just (Transaction{tdate=da,tdescription=de}) -> Just (da,de)
+                                      Nothing -> Just (nulldate,"")
 
 -- | Convert a list of postings into summary postings, one per interval.
 summarisePostings :: Interval -> Maybe Int -> Bool -> DateSpan -> [Posting] -> [Posting]
@@ -124,40 +183,6 @@ summarisePostingsInDateSpan (DateSpan b e) depth showempty ps
       balancetoshowfor a =
           (if isclipped a then inclbalof else exclbalof) (if null a then "top" else a)
 
-{- |
-Show postings one per line, plus transaction info for the first posting of
-each transaction, and a running balance. Eg:
-
-@
-date (10)  description (20)     account (22)            amount (11)  balance (12)
-DDDDDDDDDD dddddddddddddddddddd aaaaaaaaaaaaaaaaaaaaaa  AAAAAAAAAAA AAAAAAAAAAAA
-                                aaaaaaaaaaaaaaaaaaaaaa  AAAAAAAAAAA AAAAAAAAAAAA
-@
--}
-showPostingsWithBalance :: [Posting] -> Posting -> MixedAmount -> String
-showPostingsWithBalance [] _ _ = ""
-showPostingsWithBalance (p:ps) pprev bal = this ++ showPostingsWithBalance ps p bal'
-    where
-      this = showPostingWithBalance isfirst p bal'
-      isfirst = ptransaction p /= ptransaction pprev
-      bal' = bal + pamount p
-
--- | Show one posting and running balance, with or without transaction info.
-showPostingWithBalance :: Bool -> Posting -> MixedAmount -> String
-showPostingWithBalance withtxninfo p b = concatTopPadded [txninfo, pstr, " ", bal] ++ "\n"
-    where
-      ledger3ishlayout = False
-      datedescwidth = if ledger3ishlayout then 34 else 32
-      txninfo = if withtxninfo then printf "%s %s " date desc else replicate datedescwidth ' '
-      date = showDate da
-      datewidth = 10
-      descwidth = datedescwidth - datewidth - 2
-      desc = printf ("%-"++(show descwidth)++"s") $ elideRight descwidth de :: String
-      pstr = showPostingForRegister p
-      bal = padleft 12 (showMixedAmountOrZeroWithoutPrice b)
-      (da,de) = case ptransaction p of Just (Transaction{tdate=da',tdescription=de'}) -> (da',de')
-                                       Nothing -> (nulldate,"")
-
 tests_Register :: Test
 tests_Register = TestList [
 

Hledger/Cli/Commands/Vty.hs

@@ -229,8 +229,8 @@ resetTrailAndEnter t scr a = enter t scr (aargs a) $ clearLocs a
 updateData :: LocalTime -> AppState -> AppState
 updateData t a@AppState{aopts=opts,ajournal=j} =
     case screen a of
-      BalanceScreen  -> a{abuf=lines $ showBalanceReport opts $ balanceReport opts fspec j}
+      BalanceScreen  -> a{abuf=lines $ balanceReportAsText opts $ balanceReport opts fspec j}
-      RegisterScreen -> a{abuf=lines $ showRegisterReport opts fspec j}
+      RegisterScreen -> a{abuf=lines $ registerReportAsText opts $ registerReport opts fspec j}
       PrintScreen    -> a{abuf=lines $ showTransactions fspec j}
     where fspec = optsToFilterSpec opts (currentArgs a) t
 
@@ -289,7 +289,7 @@ currentTransaction a@AppState{ajournal=j,abuf=buf} = ptransaction p
     where
       p = headDef nullposting $ filter ismatch $ journalPostings j
       ismatch p = postingDate p == parsedate (take 10 datedesc)
-                  && take 70 (showPostingWithBalance False p nullmixedamt) == (datedesc ++ acctamt)
+                  && take 70 (showPostingWithBalanceForVty False p nullmixedamt) == (datedesc ++ acctamt)
       datedesc = take 32 $ fromMaybe "" $ find (not . (" " `isPrefixOf`)) $ headDef "" rest : reverse above
       acctamt = drop 32 $ headDef "" rest
       (above,rest) = splitAt y buf

Hledger/Cli/Commands/Web.hs

@@ -115,114 +115,155 @@ getStyleCss = do
     sendFile "text/css" $ dir </> "style.css"
 
 getIndexPage :: Handler HledgerWebApp ()
-getIndexPage = redirect RedirectTemporary JournalPage
+getIndexPage = redirect RedirectTemporary BalancePage
+
+-- | Gather all the stuff we want for a typical hledger web request handler.
+getHandlerParameters :: Handler HledgerWebApp
+                       (String, String, [Opt], FilterSpec, Journal, Maybe (Html ()), HledgerWebAppRoute)
+getHandlerParameters = do
+  Just here <- getCurrentRoute
+  (a, p, opts, fspec) <- getReportParameters
+  (j, err) <- getLatestJournal opts
+  msg <- getMessage' err
+  return (a, p, opts, fspec, j, msg, here)
+    where
+      -- | Get current report parameters for this request.
+      getReportParameters :: Handler HledgerWebApp (String, String, [Opt], FilterSpec)
+      getReportParameters = do
+          app <- getYesod
+          t <- liftIO $ getCurrentLocalTime
+          a <- fromMaybe "" <$> lookupGetParam "a"
+          p <- fromMaybe "" <$> lookupGetParam "p"
+          let opts = appOpts app ++ [Period p]
+              args = appArgs app ++ [a]
+              fspec = optsToFilterSpec opts args t
+          return (a, p, opts, fspec)
+
+      -- | 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 HledgerWebApp (Journal, Maybe String)
+      getLatestJournal opts = do
+        j <- liftIO $ fromJust `fmap` getValue "hledger" "journal"
+        (jE, changed) <- liftIO $ journalReloadIfChanged opts j
+        if not changed
+         then return (j,Nothing)
+         else case jE of
+                Right j' -> do liftIO $ putValue "hledger" "journal" j'
+                               return (j',Nothing)
+                Left e  -> do setMessage $ string "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.)
+      getMessage' :: Maybe String -> Handler HledgerWebApp (Maybe (Html ()))
+      getMessage' newmsgstr = do
+        oldmsg <- getMessage
+        return $ maybe oldmsg (Just . string) newmsgstr
+
+-- renderLatestJournalWith :: ([Opt] -> FilterSpec -> Journal -> Html ()) -> Handler HledgerWebApp RepHtml
+-- renderLatestJournalWith reportHtml = do
+--   (a, p, opts, fspec, j, msg, here) <- getHandlerParameters
+--   let td' = td{here=here, title="hledger", msg=msg, a=a, p=p, content=reportHtml opts fspec j}
+--   hamletToRepHtml $ pageLayout td'
 
 getJournalPage :: Handler HledgerWebApp RepHtml
-getJournalPage = withLatestJournalRender (const showTransactions)
+getJournalPage = do
+  (a, p, _, fspec, j, msg, here) <- getHandlerParameters
+  let td' = td{here=here, title="hledger", msg=msg, a=a, p=p, content=
+                     stringToPre $ showTransactions fspec j
+              }
+  hamletToRepHtml $ pageLayout td'
 
-getRegisterPage :: Handler HledgerWebApp RepHtml
-getRegisterPage = withLatestJournalRender showRegisterReport
-
-withLatestJournalRender :: ([Opt] -> FilterSpec -> Journal -> String) -> Handler HledgerWebApp RepHtml
-withLatestJournalRender reportfn = do
-    app <- getYesod
-    t <- liftIO $ getCurrentLocalTime
-    a <- fromMaybe "" <$> lookupGetParam "a"
-    p <- fromMaybe "" <$> lookupGetParam "p"
-    let opts = appOpts app ++ [Period p]
-        args = appArgs app ++ [a]
-        fspec = optsToFilterSpec opts args t
-    -- reload journal if changed, displaying any error as a message
-    j <- liftIO $ fromJust `fmap` getValue "hledger" "journal"
-    (jE, changed) <- liftIO $ journalReloadIfChanged opts j
-    let (j', err) = either (\e -> (j,e)) (\j -> (j,"")) jE
-    when (changed && null err) $ liftIO $ putValue "hledger" "journal" j'
-    if (changed && not (null err)) then setMessage $ string "error while reading"
-                                 else return ()
-    -- run the specified report using this request's params
-    let s = reportfn opts fspec j'
-    -- render the standard template
-    msg' <- getMessage
-    -- XXX work around a bug, can't get the message we set above
-    let msg = if null err then msg' else Just $ string $ printf "Error while reading %s" (filepath j')
-    Just here <- getCurrentRoute
-    hamletToRepHtml $ pageLayout td{here=here, title="hledger", msg=msg, a=a, p=p, content=stringToPre s}
-
--- XXX duplication of withLatestJournalRender
-getEditPage :: Handler HledgerWebApp RepHtml
-getEditPage = do
-    -- app <- getYesod
-    -- t <- liftIO $ getCurrentLocalTime
-    a <- fromMaybe "" <$> lookupGetParam "a"
-    p <- fromMaybe "" <$> lookupGetParam "p"
-        -- opts = appOpts app ++ [Period p]
-        -- args = appArgs app ++ [a]
-        -- fspec = optsToFilterSpec opts args t
-    -- reload journal's text, without parsing, if changed
-    j <- liftIO $ fromJust `fmap` getValue "hledger" "journal"
-    changed <- liftIO $ journalFileIsNewer j
-    -- XXX readFile may throw an error
-    s <- liftIO $ if changed then readFile (filepath j) else return (jtext j)
-    -- render the page
-    msg <- getMessage
-    Just here <- getCurrentRoute
-     -- XXX mucking around to squeeze editform into pageLayout
-    let td' = td{here=here, title="hledger", msg=msg, a=a, p=p, content=(editform td') show, contentplain=s}
-    hamletToRepHtml $ pageLayout td'
-
--- XXX duplication of withLatestJournalRender
 getBalancePage :: Handler HledgerWebApp RepHtml
 getBalancePage = do
-    app <- getYesod
+  (a, p, opts, fspec, j, msg, here) <- getHandlerParameters
-    t <- liftIO $ getCurrentLocalTime
+  let td' = td{here=here, title="hledger", msg=msg, a=a, p=p, content=
-    a <- fromMaybe "" <$> lookupGetParam "a"
+                     balanceReportAsHtml opts td' $ balanceReport opts fspec j
-    p <- fromMaybe "" <$> lookupGetParam "p"
+              }
-    let opts = appOpts app ++ [Period p]
+  hamletToRepHtml $ pageLayout td'
-        args = appArgs app ++ [a]
-        fspec = optsToFilterSpec opts args t
-    -- reload journal if changed, displaying any error as a message
-    j <- liftIO $ fromJust `fmap` getValue "hledger" "journal"
-    (jE, changed) <- liftIO $ journalReloadIfChanged opts j
-    let (j', err) = either (\e -> (j,e)) (\j -> (j,"")) jE
-    when (changed && null err) $ liftIO $ putValue "hledger" "journal" j'
-    if (changed && not (null err)) then setMessage $ string "error while reading"
-                                 else return ()
-    Just here <- getCurrentRoute
-    msg' <- getMessage
-    -- XXX work around a misfeature, can't get a message we just set in this request
-    let msg = if null err then msg' else Just $ string $ printf "Error while reading %s" (filepath j')
-    -- run and render the report
-    let td' = td{here=here, title="hledger", msg=msg, a=a, p=p
-                ,content=(balanceReportToHtml opts td' $ balanceReport opts fspec j')}
-    hamletToRepHtml $ pageLayout td'
 
 -- | Render a balance report as HTML.
-balanceReportToHtml :: [Opt] -> TemplateData -> BalanceReport -> Html ()
+balanceReportAsHtml :: [Opt] -> TemplateData -> BalanceReport -> Html ()
-balanceReportToHtml _ td (items,total) = [$hamlet|
+balanceReportAsHtml _ td (items,total) = [$hamlet|
-%table
+%table.balancereport
  $forall items i
-  ^itemToHtml' i^
+  %tr.itemrule
- %tr
+   %td!colspan=2
-  %td!colspan=2!style="border-top:1px black solid;"
+  ^itemAsHtml' i^
+ %tr.totalrule
+  %td!colspan=2
  %tr
   %td
-  %td!align=right $mixedAmountToHtml.total$
+  %td!align=right $mixedAmountAsHtml.total$
 |] id
  where
-   itemToHtml' = itemToHtml td
+   itemAsHtml' = itemAsHtml td
-   itemToHtml :: TemplateData -> BalanceReportItem -> Hamlet String
+   itemAsHtml :: TemplateData -> BalanceReportItem -> Hamlet String
-   itemToHtml TD{p=p} (a, adisplay, adepth, abal) = [$hamlet|
+   itemAsHtml TD{p=p} (a, adisplay, adepth, abal) = [$hamlet|
-     %tr
+     %tr.item
-      %td
+      %td.account
        $indent$
        %a!href=$aurl$ $adisplay$
-      %td!align=right $mixedAmountToHtml.abal$
+      %td.balance!align=right $mixedAmountAsHtml.abal$
      |] where
        indent = preEscapedString $ concat $ replicate (2 * adepth) "&nbsp;"
        aurl = printf "../register?a=^%s%s" a p' :: String
        p' = if null p then "" else printf "&p=%s" p
 
-mixedAmountToHtml = intercalate ", " . lines . show
+--mixedAmountAsHtml = intercalate ", " . lines . show
+mixedAmountAsHtml = preEscapedString . intercalate "<br>" . lines . show
+
+getRegisterPage :: Handler HledgerWebApp RepHtml
+getRegisterPage = do
+  (a, p, opts, fspec, j, msg, here) <- getHandlerParameters
+  let td' = td{here=here, title="hledger", msg=msg, a=a, p=p, content=
+                     registerReportAsHtml opts td' $ registerReport opts fspec j
+              }
+  hamletToRepHtml $ pageLayout td'
+
+-- | Render a register report as HTML.
+registerReportAsHtml :: [Opt] -> TemplateData -> RegisterReport -> Html ()
+registerReportAsHtml _ td items = [$hamlet|
+%table.registerreport
+ $forall items i
+  %tr.itemrule
+   %td!colspan=5
+  ^itemAsHtml' i^
+|] id
+ where
+   itemAsHtml' = itemAsHtml td
+   itemAsHtml :: TemplateData -> RegisterReportItem -> Hamlet String
+   itemAsHtml TD{p=p} (ds, posting, b) = [$hamlet|
+     %tr.item
+      %td.date $date$
+      %td.description $desc$
+      %td.account
+       %a!href=$aurl$ $acct$
+      %td.amount!align=right $mixedAmountAsHtml.pamount.posting$
+      %td.balance!align=right $mixedAmountAsHtml.b$
+     |] where
+       (date, desc) = case ds of Just (da, de) -> (show da, de)
+                                 Nothing -> ("", "")
+       acct = paccount posting
+       aurl = printf "../register?a=^%s%s" acct p' :: String
+       p' = if null p then "" else printf "&p=%s" p
+
+queryStringFromAP a p = if null ap then "" else "?" ++ ap
+    where
+      ap = intercalate "&" [a',p']
+      a' = if null a then "" else printf "&a=%s" a
+      p' = if null p then "" else printf "&p=%s" p
+
+getEditPage :: Handler HledgerWebApp RepHtml
+getEditPage = do
+  (a, p, _, _, _, msg, here) <- getHandlerParameters
+  -- reload journal's text without parsing, if changed
+  j <- liftIO $ fromJust `fmap` getValue "hledger" "journal"
+  changed <- liftIO $ journalFileIsNewer j
+  s <- liftIO $ if changed then readFile (filepath j) else return (jtext j) -- XXX readFile may throw an error
+  let td' = td{here=here, title="hledger", msg=msg, a=a, p=p, 
+                     content=(editform td') show, contentplain=s} -- XXX provide both to squeeze editform into pageLayout
+  hamletToRepHtml $ pageLayout td'
 
 postJournalPage :: Handler HledgerWebApp RepPlain
 postJournalPage = do

Hledger/Cli/Tests.hs

@@ -109,7 +109,7 @@ tests = TestList [
    let (opts,args) `gives` es = do 
         l <- samplejournalwithopts opts args
         t <- getCurrentLocalTime
-        showBalanceReport opts (balanceReport opts (optsToFilterSpec opts args t) l) `is` unlines es
+        balanceReportAsText opts (balanceReport opts (optsToFilterSpec opts args t) l) `is` unlines es
    in TestList
    [
 
@@ -245,7 +245,7 @@ tests = TestList [
              ,"  c:d                   "
              ]) >>= either error return
       let j' = journalCanonicaliseAmounts $ journalConvertAmountsToCost j -- enable cost basis adjustment
-      showBalanceReport [] (balanceReport [] nullfilterspec j') `is`
+      balanceReportAsText [] (balanceReport [] nullfilterspec j') `is`
        unlines
         ["                $500  a:b"
         ,"               $-500  c:d"
@@ -260,7 +260,7 @@ tests = TestList [
               ,"  test:a  1"
               ,"  test:b"
               ])
-      showBalanceReport [] (balanceReport [] nullfilterspec l) `is`
+      balanceReportAsText [] (balanceReport [] nullfilterspec l) `is`
        unlines
         ["                   1  test:a"
         ,"                  -1  test:b"
@@ -458,7 +458,7 @@ tests = TestList [
    "register report with no args" ~:
    do 
     l <- samplejournal
-    showRegisterReport [] (optsToFilterSpec [] [] t1) l `is` unlines
+    (registerReportAsText [] $ registerReport [] (optsToFilterSpec [] [] t1) l) `is` unlines
      ["2008/01/01 income               assets:bank:checking             $1           $1"
      ,"                                income:salary                   $-1            0"
      ,"2008/06/01 gift                 assets:bank:checking             $1           $1"
@@ -476,7 +476,7 @@ tests = TestList [
    do 
     let opts = [Cleared]
     l <- readJournalWithOpts opts sample_journal_str
-    showRegisterReport opts (optsToFilterSpec opts [] t1) l `is` unlines
+    (registerReportAsText opts $ registerReport opts (optsToFilterSpec opts [] t1) l) `is` unlines
      ["2008/06/03 eat & shop           expenses:food                    $1           $1"
      ,"                                expenses:supplies                $1           $2"
      ,"                                assets:cash                     $-2            0"
@@ -488,7 +488,7 @@ tests = TestList [
    do 
     let opts = [UnCleared]
     l <- readJournalWithOpts opts sample_journal_str
-    showRegisterReport opts (optsToFilterSpec opts [] t1) l `is` unlines
+    (registerReportAsText opts $ registerReport opts (optsToFilterSpec opts [] t1) l) `is` unlines
      ["2008/01/01 income               assets:bank:checking             $1           $1"
      ,"                                income:salary                   $-1            0"
      ,"2008/06/01 gift                 assets:bank:checking             $1           $1"
@@ -508,19 +508,19 @@ tests = TestList [
         ,"  e  1"
         ,"  f"
         ]
-    registerdates (showRegisterReport [] (optsToFilterSpec [] [] t1) l) `is` ["2008/01/01","2008/02/02"]
+    registerdates (registerReportAsText [] $ registerReport [] (optsToFilterSpec [] [] t1) l) `is` ["2008/01/01","2008/02/02"]
 
   ,"register report with account pattern" ~:
    do
     l <- samplejournal
-    showRegisterReport [] (optsToFilterSpec [] ["cash"] t1) l `is` unlines
+    (registerReportAsText [] $ registerReport [] (optsToFilterSpec [] ["cash"] t1) l) `is` unlines
      ["2008/06/03 eat & shop           assets:cash                     $-2          $-2"
      ]
 
   ,"register report with account pattern, case insensitive" ~:
    do 
     l <- samplejournal
-    showRegisterReport [] (optsToFilterSpec [] ["cAsH"] t1) l `is` unlines
+    (registerReportAsText [] $ registerReport [] (optsToFilterSpec [] ["cAsH"] t1) l) `is` unlines
      ["2008/06/03 eat & shop           assets:cash                     $-2          $-2"
      ]
 
@@ -528,7 +528,7 @@ tests = TestList [
    do 
     l <- samplejournal
     let gives displayexpr = 
-            (registerdates (showRegisterReport opts (optsToFilterSpec opts [] t1) l) `is`)
+            (registerdates (registerReportAsText opts $ registerReport opts (optsToFilterSpec opts [] t1) l) `is`)
                 where opts = [Display displayexpr]
     "d<[2008/6/2]"  `gives` ["2008/01/01","2008/06/01"]
     "d<=[2008/6/2]" `gives` ["2008/01/01","2008/06/01","2008/06/02"]
@@ -541,7 +541,7 @@ tests = TestList [
     l <- samplejournal
     let periodexpr `gives` dates = do
           l' <- samplejournalwithopts opts []
-          registerdates (showRegisterReport opts (optsToFilterSpec opts [] t1) l') `is` dates
+          registerdates (registerReportAsText opts $ registerReport opts (optsToFilterSpec opts [] t1) l') `is` dates
               where opts = [Period periodexpr]
     ""     `gives` ["2008/01/01","2008/06/01","2008/06/02","2008/06/03","2008/12/31"]
     "2008" `gives` ["2008/01/01","2008/06/01","2008/06/02","2008/06/03","2008/12/31"]
@@ -550,7 +550,7 @@ tests = TestList [
     "monthly" `gives` ["2008/01/01","2008/06/01","2008/12/01"]
     "quarterly" `gives` ["2008/01/01","2008/04/01","2008/10/01"]
     let opts = [Period "yearly"]
-    showRegisterReport opts (optsToFilterSpec opts [] t1) l `is` unlines
+    (registerReportAsText opts $ registerReport opts (optsToFilterSpec opts [] t1) l) `is` unlines
      ["2008/01/01 - 2008/12/31         assets:bank:saving               $1           $1"
      ,"                                assets:cash                     $-2          $-1"
      ,"                                expenses:food                    $1            0"
@@ -560,9 +560,9 @@ tests = TestList [
      ,"                                liabilities:debts                $1            0"
      ]
     let opts = [Period "quarterly"]
-    registerdates (showRegisterReport opts (optsToFilterSpec opts [] t1) l) `is` ["2008/01/01","2008/04/01","2008/10/01"]
+    registerdates (registerReportAsText opts $ registerReport opts (optsToFilterSpec opts [] t1) l) `is` ["2008/01/01","2008/04/01","2008/10/01"]
     let opts = [Period "quarterly",Empty]
-    registerdates (showRegisterReport opts (optsToFilterSpec opts [] t1) l) `is` ["2008/01/01","2008/04/01","2008/07/01","2008/10/01"]
+    registerdates (registerReportAsText opts $ registerReport opts (optsToFilterSpec opts [] t1) l) `is` ["2008/01/01","2008/04/01","2008/07/01","2008/10/01"]
 
   ]
 
@@ -570,7 +570,7 @@ tests = TestList [
    do 
     l <- samplejournal
     let opts = [Depth "2"]
-    showRegisterReport opts (optsToFilterSpec opts [] t1) l `is` unlines
+    (registerReportAsText opts $ registerReport opts (optsToFilterSpec opts [] t1) l) `is` unlines
      ["2008/01/01 income               income:salary                   $-1          $-1"
      ,"2008/06/01 gift                 income:gifts                    $-1          $-2"
      ,"2008/06/03 eat & shop           expenses:food                    $1          $-1"
@@ -586,7 +586,7 @@ tests = TestList [
   ,"unicode in balance layout" ~: do
     l <- readJournalWithOpts []
       "2009/01/01 * медвежья шкура\n  расходы:покупки  100\n  актив:наличные\n"
-    showBalanceReport [] (balanceReport [] (optsToFilterSpec [] [] t1) l) `is` unlines
+    balanceReportAsText [] (balanceReport [] (optsToFilterSpec [] [] t1) l) `is` unlines
       ["                -100  актив:наличные"
       ,"                 100  расходы:покупки"
       ,"--------------------"
@@ -596,7 +596,7 @@ tests = TestList [
   ,"unicode in register layout" ~: do
     l <- readJournalWithOpts []
       "2009/01/01 * медвежья шкура\n  расходы:покупки  100\n  актив:наличные\n"
-    showRegisterReport [] (optsToFilterSpec [] [] t1) l `is` unlines
+    (registerReportAsText [] $ registerReport [] (optsToFilterSpec [] [] t1) l) `is` unlines
       ["2009/01/01 медвежья шкура       расходы:покупки                 100          100"
       ,"                                актив:наличные                 -100            0"]
 

data/web/style.css

@@ -25,3 +25,16 @@ body { font-family: "helvetica","arial", "sans serif"; margin:0; }
 
 /* for -fweb610 */
 #hledgerorglink, #helplink { float:right; margin-left:1em; }
+
+/* .balancereport { font-size:small; } */
+.balancereport tr { vertical-align:top; }
+/* .itemrule td { border-top:thin solid #ddd; } */
+.totalrule td { border-top:thin solid black; }
+
+.registerreport { font-size:small; }
+.registerreport tr { vertical-align:top; }
+.registerreport .date { white-space:nowrap; }
+/* .registerreport .description { font-size:small; } */
+.registerreport .account { white-space:nowrap; }
+.registerreport .amount { white-space:nowrap; }
+.registerreport .balance { white-space:nowrap; }