From 1a8887973439c5a98f7545cae88f437dcd5c484b Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Mon, 13 Jun 2011 19:49:34 +0000 Subject: [PATCH] web: more account register fixes; heading shows "Balance" or "Total" appropriately --- .../web/templates/registerreport.hamlet | 2 +- hledger-web/Handlers.hs | 42 ++++++----- hledger/Hledger/Cli/Register.hs | 74 +++++++++++++------ 3 files changed, 73 insertions(+), 45 deletions(-) diff --git a/hledger-web/.hledger/web/templates/registerreport.hamlet b/hledger-web/.hledger/web/templates/registerreport.hamlet index d8f54a600..b848407d3 100644 --- a/hledger-web/.hledger/web/templates/registerreport.hamlet +++ b/hledger-web/.hledger/web/templates/registerreport.hamlet @@ -4,7 +4,7 @@ Description Account Amount - Balance + #{balancelabel} $forall i <- numbered items ^{itemAsHtml vd i} diff --git a/hledger-web/Handlers.hs b/hledger-web/Handlers.hs index cd6f9ef10..274c0b9df 100644 --- a/hledger-web/Handlers.hs +++ b/hledger-web/Handlers.hs @@ -61,9 +61,9 @@ postJournalR = handlePost -- | The main register view, with accounts sidebar. getRegisterR :: Handler RepHtml getRegisterR = do - vd@VD{opts=opts,m=m,j=j} <- getViewData + vd@VD{opts=opts,j=j} <- getViewData let sidecontent = balanceReportAsHtml opts vd{q=""} $ balanceReport opts nullfilterspec j - maincontent = registerReportAsHtml opts vd $ accountOrJournalRegisterReport opts m j + maincontent = registerReportAsHtml opts vd $ accountOrJournalRegisterReport vd j editform' = editform vd defaultLayout $ do setTitle "hledger-web register" @@ -86,19 +86,19 @@ postJournalOnlyR = handlePost -- | A simple postings view, like hledger register (with editing.) getRegisterOnlyR :: Handler RepHtml getRegisterOnlyR = do - vd@VD{opts=opts,m=m,j=j} <- getViewData + vd@VD{opts=opts,j=j} <- getViewData defaultLayout $ do setTitle "hledger-web register only" - addHamlet $ registerReportAsHtml opts vd $ accountOrJournalRegisterReport opts m j + addHamlet $ registerReportAsHtml opts vd $ accountOrJournalRegisterReport vd j postRegisterOnlyR :: Handler RepPlain postRegisterOnlyR = handlePost -- temporary helper - use the new account register report when in:ACCT is specified. -accountOrJournalRegisterReport :: [Opt] -> Matcher -> Journal -> RegisterReport -accountOrJournalRegisterReport opts m j = - case matcherInAccount m of Just a -> accountRegisterReport opts j m a - Nothing -> registerReport opts nullfilterspec $ filterJournalPostings2 m j +accountOrJournalRegisterReport :: ViewData -> Journal -> RegisterReport +accountOrJournalRegisterReport VD{opts=opts,m=m,qopts=qopts} j = + case inAccount qopts of Just a -> accountRegisterReport opts j m a + Nothing -> registerReport opts nullfilterspec $ filterJournalPostings2 m j -- | A simple accounts view, like hledger balance. If the Accept header -- specifies json, returns the chart of accounts as json. @@ -126,10 +126,10 @@ accountUrl a = "inacct:" ++ quoteIfSpaced a -- (accountNameToAccountRegex a) -- | Render a balance report as HTML. balanceReportAsHtml :: [Opt] -> ViewData -> BalanceReport -> Hamlet AppRoute -balanceReportAsHtml _ vd@VD{here=here,q=q,m=m,j=j} (items,total) = $(Settings.hamletFile "balancereport") +balanceReportAsHtml _ vd@VD{here=here,q=q,m=m,qopts=qopts,j=j} (items,total) = $(Settings.hamletFile "balancereport") where filtering = not $ null q - inacct = matcherInAccount m -- headMay $ filter (m `matchesInAccount`) $ journalAccountNames j + inacct = inAccount qopts itemAsHtml :: ViewData -> BalanceReportItem -> Hamlet AppRoute itemAsHtml VD{here=here,q=q} (acct, adisplay, aindent, abal) = $(Settings.hamletFile "balancereportitem") where @@ -152,7 +152,7 @@ journalReportAsHtml _ vd items = $(Settings.hamletFile "journalreport") -- | Render a register report as HTML. registerReportAsHtml :: [Opt] -> ViewData -> RegisterReport -> Hamlet AppRoute -registerReportAsHtml _ vd items = $(Settings.hamletFile "registerreport") +registerReportAsHtml _ vd (balancelabel,items) = $(Settings.hamletFile "registerreport") where itemAsHtml :: ViewData -> (Int, RegisterReportItem) -> Hamlet AppRoute itemAsHtml VD{here=here} (n, (ds, posting, b)) = $(Settings.hamletFile "registerreportitem") @@ -385,13 +385,14 @@ nulltemplate = [$hamlet||] -- | A bundle of data useful for handlers and their templates. data ViewData = VD { - opts :: [Opt] -- ^ command-line options at startup - ,q :: String -- ^ current q (query) parameter - ,m :: Matcher -- ^ a search/filter expression based on the above - ,j :: Journal -- ^ the up-to-date parsed unfiltered 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 + opts :: [Opt] -- ^ command-line options at startup + ,q :: String -- ^ current q parameter (the query expression for filtering transactions) + ,m :: Matcher -- ^ a matcher parsed from the query expr + ,qopts :: [QueryOpt] -- ^ query options parsed from the query expr + ,j :: Journal -- ^ the up-to-date parsed unfiltered 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 } mkvd :: ViewData @@ -399,6 +400,7 @@ mkvd = VD { opts = [] ,q = "" ,m = MatchAny + ,qopts = [] ,j = nulljournal ,today = ModifiedJulianDay 0 ,here = RootR @@ -415,8 +417,8 @@ getViewData = do Just here' <- getCurrentRoute today <- liftIO getCurrentDay q <- getParameter "q" - let m = parseMatcher today q - return mkvd{opts=opts, q=q, m=m, j=j, today=today, here=here', msg=msg} + let (m,qopts) = parseQuery today q + return mkvd{opts=opts, q=q, m=m, qopts=qopts, j=j, today=today, here=here', msg=msg} where -- | 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 diff --git a/hledger/Hledger/Cli/Register.hs b/hledger/Hledger/Cli/Register.hs index e4cb99166..c12ec145b 100644 --- a/hledger/Hledger/Cli/Register.hs +++ b/hledger/Hledger/Cli/Register.hs @@ -37,7 +37,10 @@ import Hledger.Utils.UTF8 (putStr) -- | 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 +-- And also some heading info. +type RegisterReport = (String -- a possibly null label for the running balance column + ,[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 @@ -53,7 +56,7 @@ register opts args j = do -- | Render a register report as plain text suitable for console output. registerReportAsText :: [Opt] -> RegisterReport -> String -registerReportAsText opts = unlines . map (registerReportItemAsText opts) +registerReportAsText opts = unlines . map (registerReportItemAsText opts) . snd -- | Render one register report line item as plain text. Eg: -- @ @@ -84,7 +87,7 @@ showPostingWithBalanceForVty showtxninfo p b = registerReportItemAsText [] $ mki -- ledger's register command; for an account-specific register see -- accountRegisterReport. registerReport :: [Opt] -> FilterSpec -> Journal -> RegisterReport -registerReport opts fspec j = postingsToRegisterReportItems ps nullposting startbal (+) +registerReport opts fspec j = (totallabel,postingsToRegisterReportItems ps nullposting startbal (+)) where ps | interval == NoInterval = displayableps | otherwise = summarisePostingsByInterval interval depth empty filterspan displayableps @@ -100,30 +103,53 @@ registerReport opts fspec j = postingsToRegisterReportItems ps nullposting start (interval, depth, empty) = (intervalFromOpts opts, depthFromOpts opts, Empty `elem` opts) -- | Get an account register report with the specified options for this --- journal. An account register report is like a postings register report --- except it is focussed on one account only, it shows the other postings --- in the transactions for this account, and it shows the accurate --- historic balance for this account. --- Does not yet handle reporting intervals. +-- journal. An account register report is like the traditional account +-- register seen in bank statements and personal finance programs. It is +-- focussed on one account only; it shows this account's transactions' +-- postings to other accounts; and if there is no transaction filtering in +-- effect other than a start date, it shows a historically-accurate +-- running balance for this account. Once additional filters are applied, +-- the running balance reverts to a running total starting at 0. +-- +-- Does not handle reporting intervals. +-- accountRegisterReport :: [Opt] -> Journal -> Matcher -> AccountName -> RegisterReport -accountRegisterReport _ j m a = postingsToRegisterReportItems ps nullposting startbal (-) +accountRegisterReport opts j m a = (label, postingsToRegisterReportItems displayps nullposting startbal (-)) where - ps = displayps - -- ps | interval == NoInterval = displayps - -- | otherwise = summarisePostingsByInterval interval depth empty filterspan displayps + -- displayps' | interval == NoInterval = displayps + -- | otherwise = summarisePostingsByInterval interval depth empty filterspan displayps + + -- transactions affecting this account a' = accountNameToAccountOnlyRegex a - -- XXX priorps and displayps not right due to inacct: still in matcher - -- postings to display: this account's transactions' "other" postings, filtered - -- same matcher used on transactions then again on postings, ok I think - ts = filter (matchesTransaction (MatchInAcct True a')) $ jtxns j - displaymatcher = (MatchAnd [MatchAcct False a', m]) - displayps = filter (matchesPosting displaymatcher) $ transactionsPostings ts - -- starting balance: sum of this account's unfiltered postings prior to the specified start date, if any - priormatcher = case matcherStartDate m of - Nothing -> MatchNone - d -> MatchAnd [MatchDate True (DateSpan Nothing d), MatchAcct True a'] - priorps = filter (matchesPosting priormatcher) $ journalPostings j - startbal = sumPostings priorps + thisacctmatcher = MatchAcct True a' + ts = filter (matchesTransaction thisacctmatcher) $ jtxns j + + -- all postings in these transactions + ps = transactionsPostings ts + + -- starting balance: if we are filtering by a start date and nothing else + -- else, the sum of postings to this account before it; otherwise zero. + (startbal,label) | matcherIsNull m = (nullmixedamt,balancelabel) + | matcherIsStartDateOnly effective m = (sumPostings priorps,balancelabel) + | otherwise = (nullmixedamt,totallabel) + where + priorps = -- ltrace "priorps" $ + filter (matchesPosting + (-- ltrace "priormatcher" $ + MatchAnd [thisacctmatcher, tostartdatematcher])) ps + tostartdatematcher = MatchDate True (DateSpan Nothing startdate) + startdate = matcherStartDate effective m + effective = Effective `elem` opts + + -- postings to display: this account's transactions' "other" postings, with any additional filter applied + -- XXX would be better to collapse multiple postings from one txn into one (expandable) "split" item + displayps = -- ltrace "displayps" $ + filter (matchesPosting $ + -- ltrace "displaymatcher" $ + (MatchAnd [negateMatcher thisacctmatcher, m])) ps + +totallabel = "Total" +balancelabel = "Balance" -- | Generate register report line items. postingsToRegisterReportItems :: [Posting] -> Posting -> MixedAmount -> (MixedAmount -> MixedAmount -> MixedAmount) -> [RegisterReportItem]