web: add links to accounts in register transactions
This commit is contained in:
		
							parent
							
								
									26ab750620
								
							
						
					
					
						commit
						ac96bcfdf0
					
				| @ -8,7 +8,7 @@ | |||||||
| 
 | 
 | ||||||
| module Hledger.Web.Handler.RegisterR where | module Hledger.Web.Handler.RegisterR where | ||||||
| 
 | 
 | ||||||
| import Data.List (intersperse) | import Data.List (intersperse, nub, partition) | ||||||
| import qualified Data.Text as T | import qualified Data.Text as T | ||||||
| import Text.Hamlet (hamletFile) | import Text.Hamlet (hamletFile) | ||||||
| 
 | 
 | ||||||
| @ -17,7 +17,7 @@ import Hledger.Cli.CliOptions | |||||||
| import Hledger.Web.Import | import Hledger.Web.Import | ||||||
| import Hledger.Web.WebOptions | import Hledger.Web.WebOptions | ||||||
| import Hledger.Web.Widget.AddForm (addModal) | import Hledger.Web.Widget.AddForm (addModal) | ||||||
| import Hledger.Web.Widget.Common (mixedAmountAsHtml) | import Hledger.Web.Widget.Common (accountQuery, mixedAmountAsHtml) | ||||||
| 
 | 
 | ||||||
| -- | The main journal/account register view, with accounts sidebar. | -- | The main journal/account register view, with accounts sidebar. | ||||||
| getRegisterR :: Handler Html | getRegisterR :: Handler Html | ||||||
| @ -32,12 +32,37 @@ getRegisterR = do | |||||||
| 
 | 
 | ||||||
|   let ropts = reportopts_ (cliopts_ opts) |   let ropts = reportopts_ (cliopts_ opts) | ||||||
|       acctQuery = fromMaybe Any (inAccountQuery qopts) |       acctQuery = fromMaybe Any (inAccountQuery qopts) | ||||||
|  |       acctlink acc = (RegisterR, [("q", accountQuery acc)]) | ||||||
|  |       otherTransAccounts = | ||||||
|  |           zip ("" : repeat (","::T.Text)) . | ||||||
|  |           preferReal . otherTransactionAccounts m acctQuery | ||||||
|       r@(balancelabel,items) = accountTransactionsReport ropts j m acctQuery |       r@(balancelabel,items) = accountTransactionsReport ropts j m acctQuery | ||||||
|       balancelabel' = if isJust (inAccount qopts) then balancelabel else "Total" |       balancelabel' = if isJust (inAccount qopts) then balancelabel else "Total" | ||||||
|   defaultLayout $ do |   defaultLayout $ do | ||||||
|     setTitle "register - hledger-web" |     setTitle "register - hledger-web" | ||||||
|     $(widgetFile "register") |     $(widgetFile "register") | ||||||
| 
 | 
 | ||||||
|  | -- cf. Hledger.Reports.AccountTransactionsReport.accountTransactionsReportItems | ||||||
|  | otherTransactionAccounts :: Query -> Query -> Transaction -> [Posting] | ||||||
|  | otherTransactionAccounts reportq thisacctq torig | ||||||
|  |     -- no current account ? summarise all matched postings | ||||||
|  |     | thisacctq == None  = reportps | ||||||
|  |     -- only postings to current account ? summarise those | ||||||
|  |     | null otheraccts    = thisacctps | ||||||
|  |     -- summarise matched postings to other account(s) | ||||||
|  |     | otherwise          = otheracctps | ||||||
|  |     where | ||||||
|  |       reportps = tpostings $ filterTransactionPostings reportq torig | ||||||
|  |       (thisacctps, otheracctps) = partition (matchesPosting thisacctq) reportps | ||||||
|  |       otheraccts = nub $ map paccount otheracctps | ||||||
|  | 
 | ||||||
|  | -- cf. Hledger.Reports.AccountTransactionsReport.summarisePostingAccounts | ||||||
|  | preferReal :: [Posting] -> [Posting] | ||||||
|  | preferReal ps | ||||||
|  |     | null realps = ps | ||||||
|  |     | otherwise   = realps | ||||||
|  |     where realps = filter isReal ps | ||||||
|  | 
 | ||||||
| -- | Generate javascript/html for a register balance line chart based on | -- | Generate javascript/html for a register balance line chart based on | ||||||
| -- the provided "TransactionsReportItem"s. | -- the provided "TransactionsReportItem"s. | ||||||
| registerChartHtml :: [(CommoditySymbol, (String, [TransactionsReportItem]))] -> HtmlUrl AppRoute | registerChartHtml :: [(CommoditySymbol, (String, [TransactionsReportItem]))] -> HtmlUrl AppRoute | ||||||
|  | |||||||
| @ -18,7 +18,7 @@ | |||||||
|           #{balancelabel'} |           #{balancelabel'} | ||||||
| 
 | 
 | ||||||
|     <tbody> |     <tbody> | ||||||
|       $forall (torig, tacct, split, acct, amt, bal) <- items |       $forall (torig, tacct, split, _acct, amt, bal) <- items | ||||||
|         <tr ##{tindex torig} title="#{showTransaction torig}" style="vertical-align:top;"> |         <tr ##{tindex torig} title="#{showTransaction torig}" style="vertical-align:top;"> | ||||||
|           <td .date> |           <td .date> | ||||||
|             <a href="@{JournalR}#transaction-#{tindex torig}"> |             <a href="@{JournalR}#transaction-#{tindex torig}"> | ||||||
| @ -26,7 +26,10 @@ | |||||||
|           <td> |           <td> | ||||||
|             #{textElideRight 30 (tdescription tacct)} |             #{textElideRight 30 (tdescription tacct)} | ||||||
|           <td .account> |           <td .account> | ||||||
|             #{elideRight 40 acct} |             $forall (comma, Posting { paccount = acc }) <- otherTransAccounts torig | ||||||
|  |               #{comma} | ||||||
|  |               <a href="@?{acctlink acc}##{tindex torig}" title="#{acc}"> | ||||||
|  |                 #{accountSummarisedName acc} | ||||||
|           <td .amount style="text-align:right; white-space:nowrap;"> |           <td .amount style="text-align:right; white-space:nowrap;"> | ||||||
|             $if not split || not (isZeroMixedAmount amt) |             $if not split || not (isZeroMixedAmount amt) | ||||||
|               ^{mixedAmountAsHtml amt} |               ^{mixedAmountAsHtml amt} | ||||||
|  | |||||||
		Loading…
	
		Reference in New Issue
	
	Block a user