slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

lib,cli: Use Text Builder for Account Transaction Reports.

Browse Source
This commit is contained in:
Stephen Morgan 2020-10-27 20:00:12 +11:00
parent b9dbed6713
commit 5752f1c5cb
5 changed files with 70 additions and 81 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
hledger-lib/Hledger/Reports/AccountTransactionsReport.hs
View File

@ -18,6 +18,7 @@ where
import Data.List import Data.List
import Data.Ord import Data.Ord
import Data.Maybe import Data.Maybe
import Data.Text (Text)
import qualified Data.Text as T import qualified Data.Text as T
import Data.Time.Calendar import Data.Time.Calendar
@ -74,7 +75,7 @@ type AccountTransactionsReportItem =
Transaction -- the transaction, unmodified Transaction -- the transaction, unmodified
,Transaction -- the transaction, as seen from the current account ,Transaction -- the transaction, as seen from the current account
,Bool -- is this a split (more than one posting to other accounts) ? ,Bool -- is this a split (more than one posting to other accounts) ?
,String -- a display string describing the other account(s), if any ,Text -- a display string describing the other account(s), if any
,MixedAmount -- the amount posted to the current account(s) (or total amount posted) ,MixedAmount -- the amount posted to the current account(s) (or total amount posted)
,MixedAmount -- the register's running total or the current account(s)'s historical balance, after this transaction ,MixedAmount -- the register's running total or the current account(s)'s historical balance, after this transaction
) )
@ -216,9 +217,9 @@ transactionRegisterDate reportq thisacctq t
-- | Generate a simplified summary of some postings' accounts. -- | Generate a simplified summary of some postings' accounts.
-- To reduce noise, if there are both real and virtual postings, show only the real ones. -- To reduce noise, if there are both real and virtual postings, show only the real ones.
summarisePostingAccounts :: [Posting] -> String summarisePostingAccounts :: [Posting] -> Text
summarisePostingAccounts ps = summarisePostingAccounts ps =
(intercalate ", " . map (T.unpack . accountSummarisedName) . nub . map paccount) displayps -- XXX pack T.intercalate ", " . map accountSummarisedName . nub $ map paccount displayps
where where
realps = filter isReal ps realps = filter isReal ps
displayps | null realps = ps displayps | null realps = ps

3
hledger-lib/Hledger/Reports/TransactionsReport.hs
View File

@ -23,6 +23,7 @@ where
import Data.List import Data.List
import Data.List.Extra (nubSort) import Data.List.Extra (nubSort)
import Data.Text (Text)
import Data.Ord import Data.Ord
import Hledger.Data import Hledger.Data
@ -45,7 +46,7 @@ type TransactionsReport = (String -- label for the balance col
type TransactionsReportItem = (Transaction -- the original journal transaction, unmodified type TransactionsReportItem = (Transaction -- the original journal transaction, unmodified
,Transaction -- the transaction as seen from a particular account, with postings maybe filtered ,Transaction -- the transaction as seen from a particular account, with postings maybe filtered
,Bool -- is this a split, ie more than one other account posting ,Bool -- is this a split, ie more than one other account posting
,String -- a display string describing the other account(s), if any ,Text -- a display string describing the other account(s), if any
,MixedAmount -- the amount posted to the current account(s) by the filtered postings (or total amount posted) ,MixedAmount -- the amount posted to the current account(s) by the filtered postings (or total amount posted)
,MixedAmount -- the running total of item amounts, starting from zero; ,MixedAmount -- the running total of item amounts, starting from zero;
-- or with --historical, the running total including items -- or with --historical, the running total including items

5
hledger-ui/Hledger/UI/RegisterScreen.hs
View File

@ -14,7 +14,6 @@ where
import Control.Monad import Control.Monad
import Control.Monad.IO.Class (liftIO) import Control.Monad.IO.Class (liftIO)
import Data.List import Data.List
import Data.List.Split (splitOn)
#if !(MIN_VERSION_base(4,11,0)) #if !(MIN_VERSION_base(4,11,0))
import Data.Monoid ((<>)) import Data.Monoid ((<>))
#endif #endif
@ -92,9 +91,7 @@ rsInit d reset ui@UIState{aopts=_uopts@UIOpts{cliopts_=CliOpts{reportspec_=rspec
RegisterScreenItem{rsItemDate = showDate $ transactionRegisterDate q thisacctq t RegisterScreenItem{rsItemDate = showDate $ transactionRegisterDate q thisacctq t
,rsItemStatus = tstatus t ,rsItemStatus = tstatus t
,rsItemDescription = T.unpack $ tdescription t ,rsItemDescription = T.unpack $ tdescription t
,rsItemOtherAccounts = case splitOn ", " otheracctsstr of ,rsItemOtherAccounts = T.unpack otheracctsstr
[s] -> s
ss -> intercalate ", " ss
-- _ -> "<split>" -- should do this if accounts field width < 30 -- _ -> "<split>" -- should do this if accounts field width < 30
,rsItemChangeAmount = showMixedOneLine showAmountWithoutPrice Nothing (Just 32) False change ,rsItemChangeAmount = showMixedOneLine showAmountWithoutPrice Nothing (Just 32) False change
,rsItemBalanceAmount = showMixedOneLine showAmountWithoutPrice Nothing (Just 32) False bal ,rsItemBalanceAmount = showMixedOneLine showAmountWithoutPrice Nothing (Just 32) False bal

84
hledger/Hledger/Cli/Commands/Aregister.hs
View File

@ -19,18 +19,17 @@ module Hledger.Cli.Commands.Aregister (
,tests_Aregister ,tests_Aregister
) where ) where
import Data.Aeson (toJSON) import Data.List (intersperse)
import Data.Aeson.Text (encodeToLazyText) import Data.Maybe (fromMaybe, isJust)
import Data.List
import Data.Maybe
#if !(MIN_VERSION_base(4,11,0)) #if !(MIN_VERSION_base(4,11,0))
import Data.Semigroup ((<>)) import Data.Semigroup ((<>))
#endif #endif
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Builder as TB
import Data.Time (addDays) import Data.Time (addDays)
import Safe (headDef) import Safe (headDef)
import System.Console.CmdArgs.Explicit import System.Console.CmdArgs.Explicit (flagNone, flagReq)
import Hledger.Read.CsvReader (CSV, CsvRecord, printCSV) import Hledger.Read.CsvReader (CSV, CsvRecord, printCSV)
import Hledger import Hledger
@ -113,14 +112,14 @@ aregister opts@CliOpts{rawopts_=rawopts,reportspec_=rspec} j = do
items' = (if empty_ ropts then id else filter (not . mixedAmountLooksZero . fifth6)) $ items' = (if empty_ ropts then id else filter (not . mixedAmountLooksZero . fifth6)) $
reverse items reverse items
-- select renderer -- select renderer
render | fmt=="json" = (++"\n") . T.unpack . TL.toStrict . encodeToLazyText . toJSON render | fmt=="txt" = accountTransactionsReportAsText opts reportq thisacctq
| fmt=="csv" = (++"\n") . printCSV . accountTransactionsReportAsCsv reportq thisacctq | fmt=="csv" = TL.pack . printCSV . accountTransactionsReportAsCsv reportq thisacctq
| fmt=="txt" = accountTransactionsReportAsText opts reportq thisacctq | fmt=="json" = toJsonText
| otherwise = const $ error' $ unsupportedOutputFormatError fmt -- PARTIAL: | otherwise = error' $ unsupportedOutputFormatError fmt -- PARTIAL:
where where
fmt = outputFormatFromOpts opts fmt = outputFormatFromOpts opts
writeOutput opts $ render (balancelabel,items') writeOutputLazyText opts $ render (balancelabel,items')
accountTransactionsReportAsCsv :: Query -> Query -> AccountTransactionsReport -> CSV accountTransactionsReportAsCsv :: Query -> Query -> AccountTransactionsReport -> CSV
accountTransactionsReportAsCsv reportq thisacctq (_,is) = accountTransactionsReportAsCsv reportq thisacctq (_,is) =
@ -131,7 +130,7 @@ accountTransactionsReportItemAsCsvRecord :: Query -> Query -> AccountTransaction
accountTransactionsReportItemAsCsvRecord accountTransactionsReportItemAsCsvRecord
reportq thisacctq reportq thisacctq
(t@Transaction{tindex,tcode,tdescription}, _, _issplit, otheracctsstr, change, balance) (t@Transaction{tindex,tcode,tdescription}, _, _issplit, otheracctsstr, change, balance)
= [idx,date,code,desc,otheracctsstr,amt,bal] = [idx,date,code,desc,T.unpack otheracctsstr,amt,bal]
where where
idx = show tindex idx = show tindex
date = showDate $ transactionRegisterDate reportq thisacctq t date = showDate $ transactionRegisterDate reportq thisacctq t
@ -141,20 +140,20 @@ accountTransactionsReportItemAsCsvRecord
bal = showMixedAmountOneLineWithoutPrice False balance bal = showMixedAmountOneLineWithoutPrice False balance
-- | Render a register report as plain text suitable for console output. -- | Render a register report as plain text suitable for console output.
accountTransactionsReportAsText :: CliOpts -> Query -> Query -> AccountTransactionsReport -> String accountTransactionsReportAsText :: CliOpts -> Query -> Query -> AccountTransactionsReport -> TL.Text
accountTransactionsReportAsText accountTransactionsReportAsText copts reportq thisacctq (_balancelabel, items)
copts@CliOpts{reportspec_=ReportSpec{rsOpts=ReportOpts{no_elide_}}} reportq thisacctq (_balancelabel,items) = TB.toLazyText . mconcat . intersperse (TB.fromText "\n") $
= unlines $ title : title :
map (accountTransactionsReportItemAsText copts reportq thisacctq amtwidth balwidth) items map (accountTransactionsReportItemAsText copts reportq thisacctq amtwidth balwidth) items
where where
amtwidth = maximumStrict $ 12 : map (snd . showamt . itemamt) items amtwidth = maximumStrict $ 12 : map (snd . showamt . itemamt) items
balwidth = maximumStrict $ 12 : map (snd . showamt . itembal) items balwidth = maximumStrict $ 12 : map (snd . showamt . itembal) items
showamt = showMixedOneLine showAmountWithoutPrice (Just 12) mmax False -- color_ showamt = showMixedOneLine showAmountWithoutPrice (Just 12) mmax False -- color_
where mmax = if no_elide_ then Nothing else Just 32 where mmax = if no_elide_ . rsOpts . reportspec_ $ copts then Nothing else Just 32
itemamt (_,_,_,_,a,_) = a itemamt (_,_,_,_,a,_) = a
itembal (_,_,_,_,_,a) = a itembal (_,_,_,_,_,a) = a
-- show a title indicating which account was picked, which can be confusing otherwise -- show a title indicating which account was picked, which can be confusing otherwise
title = T.unpack $ maybe "" (("Transactions in "<>).(<>" and subaccounts:")) macct title = maybe mempty (\s -> foldMap TB.fromText ["Transactions in ", s, " and subaccounts:"]) macct
where where
-- XXX temporary hack ? recover the account name from the query -- XXX temporary hack ? recover the account name from the query
macct = case filterQuery queryIsAcct thisacctq of macct = case filterQuery queryIsAcct thisacctq of
@ -173,41 +172,34 @@ accountTransactionsReportAsText
-- Returns a string which can be multi-line, eg if the running balance -- Returns a string which can be multi-line, eg if the running balance
-- has multiple commodities. -- has multiple commodities.
-- --
accountTransactionsReportItemAsText :: CliOpts -> Query -> Query -> Int -> Int -> AccountTransactionsReportItem -> String accountTransactionsReportItemAsText :: CliOpts -> Query -> Query -> Int -> Int -> AccountTransactionsReportItem -> TB.Builder
accountTransactionsReportItemAsText accountTransactionsReportItemAsText
copts@CliOpts{reportspec_=ReportSpec{rsOpts=ReportOpts{color_}}} copts@CliOpts{reportspec_=ReportSpec{rsOpts=ReportOpts{color_}}}
reportq thisacctq preferredamtwidth preferredbalwidth reportq thisacctq preferredamtwidth preferredbalwidth
(t@Transaction{tdescription}, _, _issplit, otheracctsstr, change, balance) (t@Transaction{tdescription}, _, _issplit, otheracctsstr, change, balance) =
-- Transaction -- the transaction, unmodified -- Transaction -- the transaction, unmodified
-- Transaction -- the transaction, as seen from the current account -- Transaction -- the transaction, as seen from the current account
-- Bool -- is this a split (more than one posting to other accounts) ? -- Bool -- is this a split (more than one posting to other accounts) ?
-- String -- a display string describing the other account(s), if any -- String -- a display string describing the other account(s), if any
-- MixedAmount -- the amount posted to the current account(s) (or total amount posted) -- MixedAmount -- the amount posted to the current account(s) (or total amount posted)
-- MixedAmount -- the register's running total or the current account(s)'s historical balance, after this transaction -- MixedAmount -- the register's running total or the current account(s)'s historical balance, after this transaction
foldMap TB.fromText . concat . intersperse (["\n"]) $
= intercalate "\n" $ [ fitText (Just datewidth) (Just datewidth) True True date
concat [fitString (Just datewidth) (Just datewidth) True True date , " "
," " , fitText (Just descwidth) (Just descwidth) True True tdescription
,fitString (Just descwidth) (Just descwidth) True True desc , " "
," " , fitText (Just acctwidth) (Just acctwidth) True True accts
,fitString (Just acctwidth) (Just acctwidth) True True accts , " "
," " , amtfirstline
,amtfirstline , " "
," " , balfirstline
,balfirstline
] ]
: :
[concat [spacer [ [ spacer, a, " ", b ] | (a,b) <- zip amtrest balrest ]
,a
," "
,b
]
| (a,b) <- zip amtrest balrest
]
where where
-- calculate widths -- calculate widths
(totalwidth,mdescwidth) = registerWidthsFromOpts copts (totalwidth,mdescwidth) = registerWidthsFromOpts copts
(datewidth, date) = (10, showDate $ transactionRegisterDate reportq thisacctq t) (datewidth, date) = (10, T.pack . showDate $ transactionRegisterDate reportq thisacctq t)
(amtwidth, balwidth) (amtwidth, balwidth)
| shortfall <= 0 = (preferredamtwidth, preferredbalwidth) | shortfall <= 0 = (preferredamtwidth, preferredbalwidth)
| otherwise = (adjustedamtwidth, adjustedbalwidth) | otherwise = (adjustedamtwidth, adjustedbalwidth)
@ -221,24 +213,22 @@ accountTransactionsReportItemAsText
remaining = totalwidth - (datewidth + 1 + 2 + amtwidth + 2 + balwidth) remaining = totalwidth - (datewidth + 1 + 2 + amtwidth + 2 + balwidth)
(descwidth, acctwidth) = (w, remaining - 2 - w) (descwidth, acctwidth) = (w, remaining - 2 - w)
where where w = fromMaybe ((remaining - 2) `div` 2) mdescwidth
w = fromMaybe ((remaining - 2) `div` 2) mdescwidth
-- gather content -- gather content
desc = T.unpack tdescription
accts = -- T.unpack $ elideAccountName acctwidth $ T.pack accts = -- T.unpack $ elideAccountName acctwidth $ T.pack
otheracctsstr otheracctsstr
amt = fst $ showMixed showAmountWithoutPrice (Just amtwidth) (Just balwidth) color_ change amt = T.pack . fst $ showMixed showAmountWithoutPrice (Just amtwidth) (Just balwidth) color_ change
bal = fst $ showMixed showAmountWithoutPrice (Just balwidth) (Just balwidth) color_ balance bal = T.pack . fst $ showMixed showAmountWithoutPrice (Just balwidth) (Just balwidth) color_ balance
-- alternate behaviour, show null amounts as 0 instead of blank -- alternate behaviour, show null amounts as 0 instead of blank
-- amt = if null amt' then "0" else amt' -- amt = if null amt' then "0" else amt'
-- bal = if null bal' then "0" else bal' -- bal = if null bal' then "0" else bal'
(amtlines, ballines) = (lines amt, lines bal) (amtlines, ballines) = (T.lines amt, T.lines bal)
(amtlen, ballen) = (length amtlines, length ballines) (amtlen, ballen) = (length amtlines, length ballines)
numlines = max 1 (max amtlen ballen) numlines = max 1 (max amtlen ballen)
(amtfirstline:amtrest) = take numlines $ amtlines ++ repeat (replicate amtwidth ' ') -- posting amount is top-aligned (amtfirstline:amtrest) = take numlines $ amtlines ++ repeat "" -- posting amount is top-aligned
(balfirstline:balrest) = take numlines $ replicate (numlines - ballen) (replicate balwidth ' ') ++ ballines -- balance amount is bottom-aligned (balfirstline:balrest) = take numlines $ replicate (numlines - ballen) "" ++ ballines -- balance amount is bottom-aligned
spacer = replicate (totalwidth - (amtwidth + 2 + balwidth)) ' ' spacer = T.replicate (totalwidth - (amtwidth + 2 + balwidth)) " "
-- tests -- tests

2
hledger/Hledger/Cli/Commands/Register.hs
View File

@ -129,7 +129,7 @@ postingsReportItemAsText :: CliOpts -> Int -> Int -> PostingsReportItem -> TB.Bu
postingsReportItemAsText opts preferredamtwidth preferredbalwidth (mdate, menddate, mdesc, p, b) = postingsReportItemAsText opts preferredamtwidth preferredbalwidth (mdate, menddate, mdesc, p, b) =
-- use elide*Width to be wide-char-aware -- use elide*Width to be wide-char-aware
-- trace (show (totalwidth, datewidth, descwidth, acctwidth, amtwidth, balwidth)) $ -- trace (show (totalwidth, datewidth, descwidth, acctwidth, amtwidth, balwidth)) $
foldMap mconcat . intersperse ([TB.fromText "\n"]) . map (map TB.fromText) $ foldMap TB.fromText . concat . intersperse (["\n"]) $
[ fitText (Just datewidth) (Just datewidth) True True date [ fitText (Just datewidth) (Just datewidth) True True date
, " " , " "
, fitText (Just descwidth) (Just descwidth) True True desc , fitText (Just descwidth) (Just descwidth) True True desc