bal: option to view one commodity per row
This adds the `--commodity-column` option that displays each commodity on a separate line and the commodities themselves as a separate column. The initial design considerations are at simonmichael.hledger.issues.1559 The single-period balance report with `--commodity-column` does not interoperate with custom formats.
This commit is contained in:
Lawrence Wu
Simon Michael
parent
ed7ee7a445
commit
f3c07144a8
@ -152,7 +152,7 @@ import Data.Foldable (toList)
|
||||
import Data.List (find, foldl', intercalate, intersperse, mapAccumL, partition)
|
||||
import Data.List.NonEmpty (NonEmpty(..), nonEmpty)
|
||||
import qualified Data.Map.Strict as M
|
||||
import Data.Maybe (fromMaybe, isNothing)
|
||||
import Data.Maybe (fromMaybe, isNothing, isJust)
|
||||
import Data.Semigroup (Semigroup(..))
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Lazy.Builder as TB
|
||||
@ -175,6 +175,9 @@ data AmountDisplayOpts = AmountDisplayOpts
|
||||
, displayOneLine :: Bool -- ^ Whether to display on one line.
|
||||
, displayMinWidth :: Maybe Int -- ^ Minimum width to pad to
|
||||
, displayMaxWidth :: Maybe Int -- ^ Maximum width to clip to
|
||||
-- | Display amounts in this order (without the commodity symbol) and display
|
||||
-- a 0 in case a corresponding commodity does not exist
|
||||
, displayOrder :: Maybe [CommoditySymbol]
|
||||
} deriving (Show)
|
||||
|
||||
-- | Display Amount and MixedAmount with no colour.
|
||||
@ -186,8 +189,9 @@ noColour = AmountDisplayOpts { displayPrice = True
|
||||
, displayColour = False
|
||||
, displayZeroCommodity = False
|
||||
, displayOneLine = False
|
||||
, displayMinWidth = Nothing
|
||||
, displayMinWidth = Just 0
|
||||
, displayMaxWidth = Nothing
|
||||
, displayOrder = Nothing
|
||||
}
|
||||
|
||||
-- | Display Amount and MixedAmount with no prices.
|
||||
@ -429,14 +433,15 @@ showAmountB :: AmountDisplayOpts -> Amount -> WideBuilder
|
||||
showAmountB _ Amount{acommodity="AUTO"} = mempty
|
||||
showAmountB opts a@Amount{astyle=style} =
|
||||
color $ case ascommodityside style of
|
||||
L -> c' <> space <> quantity' <> price
|
||||
R -> quantity' <> space <> c' <> price
|
||||
L -> showC c' space <> quantity' <> price
|
||||
R -> quantity' <> showC space c' <> price
|
||||
where
|
||||
quantity = showamountquantity a
|
||||
(quantity',c) | amountLooksZero a && not (displayZeroCommodity opts) = (WideBuilder (TB.singleton '0') 1,"")
|
||||
| otherwise = (quantity, quoteCommoditySymbolIfNeeded $ acommodity a)
|
||||
space = if not (T.null c) && ascommodityspaced style then WideBuilder (TB.singleton ' ') 1 else mempty
|
||||
c' = WideBuilder (TB.fromText c) (textWidth c)
|
||||
showC l r = if isJust (displayOrder opts) then mempty else l <> r
|
||||
price = if displayPrice opts then showAmountPrice a else mempty
|
||||
color = if displayColour opts && isNegativeAmount a then colorB Dull Red else id
|
||||
|
||||
@ -820,13 +825,16 @@ showMixedAmountLinesB :: AmountDisplayOpts -> MixedAmount -> [WideBuilder]
|
||||
showMixedAmountLinesB opts@AmountDisplayOpts{displayMaxWidth=mmax,displayMinWidth=mmin} ma =
|
||||
map (adBuilder . pad) elided
|
||||
where
|
||||
astrs = amtDisplayList (wbWidth sep) (showAmountB opts) . amounts $
|
||||
astrs = amtDisplayList (wbWidth sep) (showAmountB opts) . orderedAmounts opts $
|
||||
if displayPrice opts then ma else mixedAmountStripPrices ma
|
||||
sep = WideBuilder (TB.singleton '\n') 0
|
||||
width = maximum $ fromMaybe 0 mmin : map (wbWidth . adBuilder) elided
|
||||
width = maximum $ map (wbWidth . adBuilder) elided
|
||||
|
||||
pad amt = amt{ adBuilder = WideBuilder (TB.fromText $ T.replicate w " ") w <> adBuilder amt }
|
||||
where w = width - wbWidth (adBuilder amt)
|
||||
pad amt
|
||||
| Just mw <- mmin =
|
||||
let w = (max width mw) - wbWidth (adBuilder amt)
|
||||
in amt{ adBuilder = WideBuilder (TB.fromText $ T.replicate w " ") w <> adBuilder amt }
|
||||
| otherwise = amt
|
||||
|
||||
elided = maybe id elideTo mmax astrs
|
||||
elideTo m xs = maybeAppend elisionStr short
|
||||
@ -843,7 +851,7 @@ showMixedAmountOneLineB opts@AmountDisplayOpts{displayMaxWidth=mmax,displayMinWi
|
||||
. max width $ fromMaybe 0 mmin
|
||||
where
|
||||
width = maybe 0 adTotal $ lastMay elided
|
||||
astrs = amtDisplayList (wbWidth sep) (showAmountB opts) . amounts $
|
||||
astrs = amtDisplayList (wbWidth sep) (showAmountB opts) . orderedAmounts opts $
|
||||
if displayPrice opts then ma else mixedAmountStripPrices ma
|
||||
sep = WideBuilder (TB.fromString ", ") 2
|
||||
n = length astrs
|
||||
@ -866,6 +874,15 @@ showMixedAmountOneLineB opts@AmountDisplayOpts{displayMaxWidth=mmax,displayMinWi
|
||||
-- Add the elision strings (if any) to each amount
|
||||
withElided = zipWith (\num amt -> (amt, elisionDisplay Nothing (wbWidth sep) num amt)) [n-1,n-2..0]
|
||||
|
||||
orderedAmounts :: AmountDisplayOpts -> MixedAmount -> [Amount]
|
||||
orderedAmounts AmountDisplayOpts{displayOrder=ord} ma
|
||||
| Just cs <- ord = fmap pad cs
|
||||
| otherwise = as
|
||||
where
|
||||
as = amounts ma
|
||||
pad c = fromMaybe (amountWithCommodity c nullamt) . find ((==) c . acommodity) $ as
|
||||
|
||||
|
||||
data AmountDisplay = AmountDisplay
|
||||
{ adBuilder :: !WideBuilder -- ^ String representation of the Amount
|
||||
, adTotal :: !Int -- ^ Cumulative length of MixedAmount this Amount is part of,
|
||||
|
||||
@ -136,7 +136,7 @@ formatfieldp = do
|
||||
char '('
|
||||
f <- fieldp
|
||||
char ')'
|
||||
return $ FormatField (isJust leftJustified) (parseDec minWidth) (parseDec maxWidth) f
|
||||
return $ FormatField (isJust leftJustified) (parseDec minWidth <|> Just 0) (parseDec maxWidth) f
|
||||
where
|
||||
parseDec s = case s of
|
||||
Just text -> Just m where ((m,_):_) = readDec text
|
||||
@ -175,20 +175,20 @@ tests_StringFormat = tests "StringFormat" [
|
||||
in tests "parseStringFormat" [
|
||||
"" `gives` (defaultStringFormatStyle [])
|
||||
, "D" `gives` (defaultStringFormatStyle [FormatLiteral "D"])
|
||||
, "%(date)" `gives` (defaultStringFormatStyle [FormatField False Nothing Nothing DescriptionField])
|
||||
, "%(total)" `gives` (defaultStringFormatStyle [FormatField False Nothing Nothing TotalField])
|
||||
, "%(date)" `gives` (defaultStringFormatStyle [FormatField False (Just 0) Nothing DescriptionField])
|
||||
, "%(total)" `gives` (defaultStringFormatStyle [FormatField False (Just 0) Nothing TotalField])
|
||||
-- TODO
|
||||
-- , "^%(total)" `gives` (TopAligned [FormatField False Nothing Nothing TotalField])
|
||||
-- , "_%(total)" `gives` (BottomAligned [FormatField False Nothing Nothing TotalField])
|
||||
-- , ",%(total)" `gives` (OneLine [FormatField False Nothing Nothing TotalField])
|
||||
, "Hello %(date)!" `gives` (defaultStringFormatStyle [FormatLiteral "Hello ", FormatField False Nothing Nothing DescriptionField, FormatLiteral "!"])
|
||||
, "%-(date)" `gives` (defaultStringFormatStyle [FormatField True Nothing Nothing DescriptionField])
|
||||
, "Hello %(date)!" `gives` (defaultStringFormatStyle [FormatLiteral "Hello ", FormatField False (Just 0) Nothing DescriptionField, FormatLiteral "!"])
|
||||
, "%-(date)" `gives` (defaultStringFormatStyle [FormatField True (Just 0) Nothing DescriptionField])
|
||||
, "%20(date)" `gives` (defaultStringFormatStyle [FormatField False (Just 20) Nothing DescriptionField])
|
||||
, "%.10(date)" `gives` (defaultStringFormatStyle [FormatField False Nothing (Just 10) DescriptionField])
|
||||
, "%.10(date)" `gives` (defaultStringFormatStyle [FormatField False (Just 0) (Just 10) DescriptionField])
|
||||
, "%20.10(date)" `gives` (defaultStringFormatStyle [FormatField False (Just 20) (Just 10) DescriptionField])
|
||||
, "%20(account) %.10(total)" `gives` (defaultStringFormatStyle [FormatField False (Just 20) Nothing AccountField
|
||||
,FormatLiteral " "
|
||||
,FormatField False Nothing (Just 10) TotalField
|
||||
,FormatField False (Just 0) (Just 10) TotalField
|
||||
])
|
||||
, test "newline not parsed" $ assertLeft $ parseStringFormat "\n"
|
||||
]
|
||||
|
||||
@ -156,6 +156,7 @@ data ReportOpts = ReportOpts {
|
||||
-- whether stdout is an interactive terminal, and the value of
|
||||
-- TERM and existence of NO_COLOR environment variables.
|
||||
,transpose_ :: Bool
|
||||
,commodity_column_:: Bool
|
||||
} deriving (Show)
|
||||
|
||||
instance Default ReportOpts where def = defreportopts
|
||||
@ -193,6 +194,7 @@ defreportopts = ReportOpts
|
||||
, normalbalance_ = Nothing
|
||||
, color_ = False
|
||||
, transpose_ = False
|
||||
, commodity_column_ = False
|
||||
}
|
||||
|
||||
-- | Generate a ReportOpts from raw command-line input, given a day.
|
||||
@ -243,6 +245,7 @@ rawOptsToReportOpts d rawopts =
|
||||
,pretty_tables_ = boolopt "pretty-tables" rawopts
|
||||
,color_ = useColorOnStdout -- a lower-level helper
|
||||
,transpose_ = boolopt "transpose" rawopts
|
||||
,commodity_column_= boolopt "commodity-column" rawopts
|
||||
}
|
||||
|
||||
-- | The result of successfully parsing a ReportOpts on a particular
|
||||
|
||||
@ -41,6 +41,7 @@ module Hledger.Utils.Text
|
||||
-- * wide-character-aware layout
|
||||
WideBuilder(..),
|
||||
wbToText,
|
||||
wbFromText,
|
||||
wbUnpack,
|
||||
textWidth,
|
||||
textTakeWidth,
|
||||
@ -61,7 +62,7 @@ import qualified Data.Text.Lazy.Builder as TB
|
||||
import Hledger.Utils.Test ((@?=), test, tests)
|
||||
import Text.Tabular.AsciiWide
|
||||
(Align(..), Header(..), Properties(..), TableOpts(..), renderRow, textCell)
|
||||
import Text.WideString (WideBuilder(..), wbToText, wbUnpack, charWidth, textWidth)
|
||||
import Text.WideString (WideBuilder(..), wbToText, wbFromText, wbUnpack, charWidth, textWidth)
|
||||
|
||||
|
||||
-- lowercase, uppercase :: String -> String
|
||||
|
||||
@ -10,13 +10,16 @@ module Text.Tabular.AsciiWide
|
||||
, render
|
||||
, renderTable
|
||||
, renderTableB
|
||||
, renderTableByRowsB
|
||||
, renderRow
|
||||
, renderRowB
|
||||
, renderColumns
|
||||
|
||||
, Cell(..)
|
||||
, Align(..)
|
||||
, emptyCell
|
||||
, textCell
|
||||
, textsCell
|
||||
, cellWidth
|
||||
) where
|
||||
|
||||
@ -30,7 +33,7 @@ import qualified Data.Text.Lazy as TL
|
||||
import Data.Text.Lazy.Builder (Builder, fromString, fromText, singleton, toLazyText)
|
||||
import Safe (maximumMay)
|
||||
import Text.Tabular
|
||||
import Text.WideString (WideBuilder(..), textWidth)
|
||||
import Text.WideString (WideBuilder(..), wbFromText, textWidth)
|
||||
|
||||
|
||||
-- | The options to use for rendering a table.
|
||||
@ -60,6 +63,10 @@ emptyCell = Cell TopRight []
|
||||
textCell :: Align -> Text -> Cell
|
||||
textCell a x = Cell a . map (\x -> WideBuilder (fromText x) (textWidth x)) $ if T.null x then [""] else T.lines x
|
||||
|
||||
-- | Create a multi-line cell from the given contents with its natural width.
|
||||
textsCell :: Align -> [Text] -> Cell
|
||||
textsCell a = Cell a . fmap wbFromText
|
||||
|
||||
-- | Return the width of a Cell.
|
||||
cellWidth :: Cell -> Int
|
||||
cellWidth (Cell _ xs) = fromMaybe 0 . maximumMay $ map wbWidth xs
|
||||
@ -86,20 +93,31 @@ renderTableB :: TableOpts -- ^ Options controlling Table rendering
|
||||
-> (a -> Cell) -- ^ Function determining the string and width of a cell
|
||||
-> Table rh ch a
|
||||
-> Builder
|
||||
renderTableB topts@TableOpts{prettyTable=pretty, tableBorders=borders} fr fc f (Table rh ch cells) =
|
||||
renderTableB topts fr fc f = renderTableByRowsB topts (fmap fc) (\(rh, as) -> (fr rh, fmap f as))
|
||||
|
||||
-- | A version of renderTable that operates on rows (including the 'row' of
|
||||
-- column headers) and returns the underlying Builder.
|
||||
renderTableByRowsB :: TableOpts -- ^ Options controlling Table rendering
|
||||
-> ([ch] -> [Cell]) -- ^ Rendering function for column headers
|
||||
-> ((rh, [a]) -> (Cell, [Cell])) -- ^ Rendering function for row and row header
|
||||
-> Table rh ch a
|
||||
-> Builder
|
||||
renderTableByRowsB topts@TableOpts{prettyTable=pretty, tableBorders=borders} fc f (Table rh ch cells) =
|
||||
unlinesB . addBorders $
|
||||
renderColumns topts sizes ch2
|
||||
: bar VM DoubleLine -- +======================================+
|
||||
: renderRs (fmap renderR $ zipHeader [] cellContents rowHeaders)
|
||||
where
|
||||
renderR :: ([Cell], Cell) -> Builder
|
||||
renderR (cs,h) = renderColumns topts sizes $ Group DoubleLine
|
||||
[ Header h
|
||||
, fmap fst $ zipHeader emptyCell cs colHeaders
|
||||
]
|
||||
|
||||
rowHeaders = fmap fr rh
|
||||
colHeaders = fmap fc ch
|
||||
cellContents = map (map f) cells
|
||||
rows = unzip . fmap f $ zip (headerContents rh) cells
|
||||
rowHeaders = fmap fst $ zipHeader emptyCell (fst rows) rh
|
||||
colHeaders = fmap fst $ zipHeader emptyCell (fc $ headerContents ch) ch
|
||||
cellContents = snd rows
|
||||
|
||||
-- ch2 and cell2 include the row and column labels
|
||||
ch2 = Group DoubleLine [Header emptyCell, colHeaders]
|
||||
@ -162,6 +180,7 @@ renderColumns TableOpts{prettyTable=pretty, tableBorders=borders, borderSpaces=s
|
||||
padCell (w, Cell TopRight ls) = map (\x -> fromText (T.replicate (w - wbWidth x) " ") <> wbBuilder x) ls
|
||||
padCell (w, Cell BottomRight ls) = map (\x -> fromText (T.replicate (w - wbWidth x) " ") <> wbBuilder x) ls
|
||||
|
||||
|
||||
-- Pad each cell to have the same number of lines
|
||||
padRow (Cell TopLeft ls) = Cell TopLeft $ ls ++ replicate (nLines - length ls) mempty
|
||||
padRow (Cell TopRight ls) = Cell TopRight $ ls ++ replicate (nLines - length ls) mempty
|
||||
|
||||
@ -8,7 +8,8 @@ module Text.WideString (
|
||||
-- * Text Builders which keep track of length
|
||||
WideBuilder(..),
|
||||
wbUnpack,
|
||||
wbToText
|
||||
wbToText,
|
||||
wbFromText
|
||||
) where
|
||||
|
||||
import Data.Text (Text)
|
||||
@ -33,6 +34,10 @@ instance Monoid WideBuilder where
|
||||
wbToText :: WideBuilder -> Text
|
||||
wbToText = TL.toStrict . TB.toLazyText . wbBuilder
|
||||
|
||||
-- | Convert a WideBuilder to a strict Text.
|
||||
wbFromText :: Text -> WideBuilder
|
||||
wbFromText t = WideBuilder (TB.fromText t) (textWidth t)
|
||||
|
||||
-- | Convert a WideBuilder to a String.
|
||||
wbUnpack :: WideBuilder -> String
|
||||
wbUnpack = TL.unpack . TB.toLazyText . wbBuilder
|
||||
|
||||
@ -244,6 +244,7 @@ module Hledger.Cli.Commands.Balance (
|
||||
balancemode
|
||||
,balance
|
||||
,balanceReportAsText
|
||||
,balanceReportAsCsv
|
||||
,balanceReportItemAsText
|
||||
,multiBalanceReportAsText
|
||||
,multiBalanceReportAsCsv
|
||||
@ -255,14 +256,17 @@ module Hledger.Cli.Commands.Balance (
|
||||
) where
|
||||
|
||||
import Data.Default (def)
|
||||
import Data.List (intersperse, transpose)
|
||||
import Data.Maybe (fromMaybe, maybeToList)
|
||||
import Data.List (intersperse, transpose, foldl', transpose)
|
||||
import qualified Data.Map as M
|
||||
import qualified Data.Set as S
|
||||
import Data.Maybe (fromMaybe)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Lazy as TL
|
||||
import qualified Data.Text.Lazy.Builder as TB
|
||||
import Data.Time (fromGregorian)
|
||||
import System.Console.CmdArgs.Explicit as C
|
||||
import Lucid as L
|
||||
import Safe (headMay, maximumMay)
|
||||
import Text.Tabular.AsciiWide as Tab
|
||||
|
||||
import Hledger
|
||||
@ -306,6 +310,8 @@ balancemode = hledgerCommandMode
|
||||
,flagNone ["percent", "%"] (setboolopt "percent") "express values in percentage of each column's total"
|
||||
,flagNone ["invert"] (setboolopt "invert") "display all amounts with reversed sign"
|
||||
,flagNone ["transpose"] (setboolopt "transpose") "transpose rows and columns"
|
||||
,flagNone ["commodity-column"] (setboolopt "commodity-column")
|
||||
"shows each commodity in its own automatically-generated subaccount, for tidier reports"
|
||||
,outputFormatFlag ["txt","html","csv","json"]
|
||||
,outputFileFlag
|
||||
]
|
||||
@ -385,31 +391,65 @@ balance opts@CliOpts{reportspec_=rspec} j = case balancecalc_ of
|
||||
-- | Render a single-column balance report as CSV.
|
||||
balanceReportAsCsv :: ReportOpts -> BalanceReport -> CSV
|
||||
balanceReportAsCsv opts (items, total) =
|
||||
["account","balance"] :
|
||||
[[accountNameDrop (drop_ opts) a, wbToText $ showMixedAmountB (balanceOpts False opts) b] | (a, _, _, b) <- items]
|
||||
++
|
||||
if no_total_ opts
|
||||
then []
|
||||
else [["total", wbToText $ showMixedAmountB (balanceOpts False opts) total]]
|
||||
("account" : ((if commodity_column_ opts then (:) "commodity" else id) $ "balance" : []))
|
||||
: (concatMap (\(a, _, _, b) -> rows a b) items)
|
||||
++ if no_total_ opts then [] else rows "total" total
|
||||
where
|
||||
rows :: AccountName -> MixedAmount -> [[T.Text]]
|
||||
rows name ma
|
||||
| commodity_column_ opts =
|
||||
fmap (\(k, a) -> [showName name, k, renderAmount . mixedAmount . amountStripPrices $ a])
|
||||
. M.toList . foldl' sumAmounts mempty . amounts $ ma
|
||||
| otherwise = [[showName name, renderAmount ma]]
|
||||
|
||||
showName = accountNameDrop (drop_ opts)
|
||||
renderAmount amt = wbToText $ showMixedAmountB bopts amt
|
||||
where bopts = (balanceOpts False opts){displayOrder = order}
|
||||
order = if commodity_column_ opts then Just (commodities [amt]) else Nothing
|
||||
sumAmounts mp am = M.insertWith (+) (acommodity am) am mp
|
||||
|
||||
-- | Render a single-column balance report as plain text.
|
||||
balanceReportAsText :: ReportOpts -> BalanceReport -> TB.Builder
|
||||
balanceReportAsText opts ((items, total)) =
|
||||
unlinesB lines
|
||||
<> unlinesB (if no_total_ opts then [] else [overline, totalLines])
|
||||
balanceReportAsText opts ((items, total))
|
||||
| not (commodity_column_ opts) =
|
||||
unlinesB lines
|
||||
<> unlinesB (if no_total_ opts then [] else [overline, totalLines])
|
||||
| iscustom = error' "Custom format not supported with --commodity-column" -- PARTIAL:
|
||||
| otherwise = balanceReportAsText' opts ((items, total))
|
||||
where
|
||||
(lines, sizes) = unzip $ map (balanceReportItemAsText opts) items
|
||||
-- abuse renderBalanceReportItem to render the total with similar format
|
||||
(totalLines, _) = renderBalanceReportItem opts ("",0,total)
|
||||
-- with a custom format, extend the line to the full report width;
|
||||
-- otherwise show the usual 20-char line for compatibility
|
||||
overlinewidth = case format_ opts of
|
||||
OneLine ((FormatField _ _ _ TotalField):_) -> 20
|
||||
TopAligned ((FormatField _ _ _ TotalField):_) -> 20
|
||||
BottomAligned ((FormatField _ _ _ TotalField):_) -> 20
|
||||
_ -> sum (map maximum' $ transpose sizes)
|
||||
iscustom = case format_ opts of
|
||||
OneLine ((FormatField _ _ _ TotalField):_) -> False
|
||||
TopAligned ((FormatField _ _ _ TotalField):_) -> False
|
||||
BottomAligned ((FormatField _ _ _ TotalField):_) -> False
|
||||
_ -> True
|
||||
overlinewidth = if iscustom then sum (map maximum' $ transpose sizes) else 20
|
||||
overline = TB.fromText $ T.replicate overlinewidth "-"
|
||||
|
||||
-- | Render a single-column balance report as plain text in commodity-column mode
|
||||
balanceReportAsText' :: ReportOpts -> BalanceReport -> TB.Builder
|
||||
balanceReportAsText' opts ((items, total)) =
|
||||
unlinesB . fmap (renderColumns def{tableBorders=False} sizes . Tab.Group NoLine . fmap Header) $
|
||||
lines ++ concat [[[overline], totalline] | not (no_total_ opts)]
|
||||
where
|
||||
render (_, acctname, depth, amt) =
|
||||
[ Cell TopRight damts
|
||||
, Cell TopLeft (fmap wbFromText cs)
|
||||
, Cell TopLeft (replicate (length damts - 1) mempty ++ [wbFromText dispname]) ]
|
||||
where dopts = (balanceOpts True opts){displayOrder=Just cs}
|
||||
cs = commodities [amt]
|
||||
dispname = T.replicate ((depth - 1) * 2) " " <> acctname
|
||||
damts = showMixedAmountLinesB dopts amt
|
||||
lines = fmap render items
|
||||
totalline = render ("", "", 0, total)
|
||||
sizes = fmap (fromMaybe 0 . maximumMay . map cellWidth) $
|
||||
transpose ([totalline | not (no_total_ opts)] ++ lines)
|
||||
overline = Cell TopLeft . pure . wbFromText . flip T.replicate "-" . fromMaybe 0 $ headMay sizes
|
||||
|
||||
{-
|
||||
:r
|
||||
This implementation turned out to be a bit convoluted but implements the following algorithm for formatting:
|
||||
@ -468,56 +508,64 @@ renderComponent topaligned opts (acctname, depth, total) (FormatField ljust mmin
|
||||
-- The CSV will always include the initial headings row,
|
||||
-- and will include the final totals row unless --no-total is set.
|
||||
multiBalanceReportAsCsv :: ReportOpts -> MultiBalanceReport -> CSV
|
||||
multiBalanceReportAsCsv opts@ReportOpts{average_, row_total_}
|
||||
(PeriodicReport colspans items (PeriodicReportRow _ coltotals tot avg)) =
|
||||
maybetranspose $
|
||||
("account" : map showDateSpan colspans
|
||||
multiBalanceReportAsCsv opts@ReportOpts{..} =
|
||||
(if transpose_ then transpose else id) . uncurry (++) . multiBalanceReportAsCsv' opts
|
||||
|
||||
multiBalanceReportAsCsv' :: ReportOpts -> MultiBalanceReport -> (CSV, CSV)
|
||||
multiBalanceReportAsCsv' opts@ReportOpts{..}
|
||||
(PeriodicReport colspans items tr) =
|
||||
flip (,) totalrows $
|
||||
("account" : ["commodity" | commodity_column_] ++ map showDateSpan colspans
|
||||
++ ["total" | row_total_]
|
||||
++ ["average" | average_]
|
||||
) :
|
||||
[accountNameDrop (drop_ opts) (displayFull a) :
|
||||
map (wbToText . showMixedAmountB (balanceOpts False opts))
|
||||
(amts
|
||||
++ [rowtot | row_total_]
|
||||
++ [rowavg | average_])
|
||||
| PeriodicReportRow a amts rowtot rowavg <- items]
|
||||
++
|
||||
if no_total_ opts
|
||||
then []
|
||||
else ["total" :
|
||||
map (wbToText . showMixedAmountB (balanceOpts False opts)) (
|
||||
coltotals
|
||||
++ [tot | row_total_]
|
||||
++ [avg | average_]
|
||||
)]
|
||||
concatMap (rowAsTexts (accountNameDrop drop_ . prrFullName)) items
|
||||
where
|
||||
maybetranspose | transpose_ opts = transpose
|
||||
| otherwise = id
|
||||
rowAsTexts render row@(PeriodicReportRow _ as rowtot rowavg)
|
||||
| not commodity_column_ = [render row : fmap (wbToText . showMixedAmountB bopts) all]
|
||||
| otherwise =
|
||||
joinNames . zipWith (:) cs -- add symbols and names
|
||||
. transpose -- each row becomes a list of Text quantities
|
||||
. fmap (fmap wbToText . showMixedAmountLinesB bopts{displayOrder=Just cs, displayMinWidth=Nothing})
|
||||
$ all
|
||||
where
|
||||
bopts = balanceOpts False opts
|
||||
cs = commodities $ rowtot : rowavg : as
|
||||
all = as
|
||||
++ [rowtot | row_total_]
|
||||
++ [rowavg | average_]
|
||||
|
||||
joinNames = fmap ((:) (render row))
|
||||
|
||||
totalrows :: [[T.Text]]
|
||||
totalrows
|
||||
| no_total_ = mempty
|
||||
| otherwise = rowAsTexts (const "total") tr
|
||||
|
||||
-- | Render a multi-column balance report as HTML.
|
||||
multiBalanceReportAsHtml :: ReportOpts -> MultiBalanceReport -> Html ()
|
||||
multiBalanceReportAsHtml ropts mbr =
|
||||
let
|
||||
(headingsrow,bodyrows,mtotalsrow) = multiBalanceReportHtmlRows ropts mbr
|
||||
(headingsrow,bodyrows,mtotalsrows) = multiBalanceReportHtmlRows ropts mbr
|
||||
in
|
||||
table_ $ mconcat $
|
||||
[headingsrow]
|
||||
++ bodyrows
|
||||
++ maybeToList mtotalsrow
|
||||
++ mtotalsrows
|
||||
|
||||
-- | Render the HTML table rows for a MultiBalanceReport.
|
||||
-- Returns the heading row, 0 or more body rows, and the totals row if enabled.
|
||||
multiBalanceReportHtmlRows :: ReportOpts -> MultiBalanceReport -> (Html (), [Html ()], Maybe (Html ()))
|
||||
multiBalanceReportHtmlRows :: ReportOpts -> MultiBalanceReport -> (Html (), [Html ()], [Html ()])
|
||||
multiBalanceReportHtmlRows ropts mbr =
|
||||
let
|
||||
headingsrow:rest | transpose_ ropts = error' "Sorry, --transpose with HTML output is not yet supported" -- PARTIAL:
|
||||
| otherwise = multiBalanceReportAsCsv ropts mbr
|
||||
(bodyrows, mtotalsrow) | no_total_ ropts = (rest, Nothing)
|
||||
| otherwise = (init rest, Just $ last rest)
|
||||
-- TODO: should the commodity_column be displayed as a subaccount in this case as well?
|
||||
(headingsrow:bodyrows, mtotalsrows)
|
||||
| transpose_ ropts = error' "Sorry, --transpose with HTML output is not yet supported" -- PARTIAL:
|
||||
| otherwise = multiBalanceReportAsCsv' ropts mbr
|
||||
in
|
||||
(multiBalanceReportHtmlHeadRow ropts headingsrow
|
||||
,map (multiBalanceReportHtmlBodyRow ropts) bodyrows
|
||||
,multiBalanceReportHtmlFootRow ropts <$> mtotalsrow -- TODO pad totals row with zeros when there are
|
||||
,multiBalanceReportHtmlFootRow ropts <$> mtotalsrows -- TODO pad totals row with zeros when there are
|
||||
)
|
||||
|
||||
-- | Render one MultiBalanceReport heading row as a HTML table row.
|
||||
@ -627,7 +675,8 @@ balanceReportAsTable opts@ReportOpts{average_, row_total_, balanceaccum_}
|
||||
(map rowvals items)
|
||||
where
|
||||
totalscolumn = row_total_ && balanceaccum_ `notElem` [Cumulative, Historical]
|
||||
colheadings = map (reportPeriodName balanceaccum_ spans) spans
|
||||
colheadings = ["Commodity" | commodity_column_ opts]
|
||||
++ map (reportPeriodName balanceaccum_ spans) spans
|
||||
++ [" Total" | totalscolumn]
|
||||
++ ["Average" | average_]
|
||||
accts = map renderacct items
|
||||
@ -651,9 +700,28 @@ balanceReportAsTable opts@ReportOpts{average_, row_total_, balanceaccum_}
|
||||
-- unless --no-elide is used.
|
||||
balanceReportTableAsText :: ReportOpts -> Table T.Text T.Text MixedAmount -> TB.Builder
|
||||
balanceReportTableAsText ropts@ReportOpts{..} =
|
||||
Tab.renderTableB def{tableBorders=False, prettyTable=pretty_tables_}
|
||||
(Tab.textCell TopLeft) (Tab.textCell TopRight) $
|
||||
Cell TopRight . pure . showMixedAmountB (balanceOpts True ropts)
|
||||
Tab.renderTableByRowsB def{tableBorders=False, prettyTable=pretty_tables_} renderCh renderRow
|
||||
where
|
||||
renderCh
|
||||
| not commodity_column_ = fmap (Tab.textCell TopRight)
|
||||
| otherwise = zipWith ($) (Tab.textCell TopLeft : repeat (Tab.textCell TopRight))
|
||||
|
||||
renderRow :: (T.Text, [MixedAmount]) -> (Cell, [Cell])
|
||||
renderRow (rh, row)
|
||||
| not commodity_column_ =
|
||||
(Tab.textCell TopLeft rh, fmap (Cell TopRight . pure . showMixedAmountB bopts) row)
|
||||
| otherwise =
|
||||
( Tab.textsCell TopLeft (replicate (length cs) rh)
|
||||
, Tab.textsCell TopLeft cs
|
||||
: fmap (Cell TopRight . showMixedAmountLinesB bopts{displayOrder = Just cs}) row)
|
||||
where
|
||||
bopts = balanceOpts True ropts
|
||||
cs = commodities row
|
||||
|
||||
commodities :: [MixedAmount] -> [CommoditySymbol]
|
||||
commodities = filter (not . T.null) . S.toList
|
||||
. foldl' S.union mempty
|
||||
. fmap (S.fromList . fmap acommodity . amounts)
|
||||
|
||||
-- | Amount display options to use for balance reports
|
||||
balanceOpts :: Bool -> ReportOpts -> AmountDisplayOpts
|
||||
|
||||
@ -297,11 +297,11 @@ compoundBalanceReportAsHtml ropts cbr =
|
||||
subreportrows :: (T.Text, MultiBalanceReport, Bool) -> [Html ()]
|
||||
subreportrows (subreporttitle, mbr, _increasestotal) =
|
||||
let
|
||||
(_,bodyrows,mtotalsrow) = multiBalanceReportHtmlRows ropts mbr
|
||||
(_,bodyrows,mtotalsrows) = multiBalanceReportHtmlRows ropts mbr
|
||||
in
|
||||
[tr_ $ th_ [colspanattr, leftattr] $ toHtml subreporttitle]
|
||||
++ bodyrows
|
||||
++ maybe [] (:[]) mtotalsrow
|
||||
++ mtotalsrows
|
||||
++ [blankrow]
|
||||
|
||||
totalrows | no_total_ ropts || length subreports == 1 = []
|
||||
|
||||
Loading…
Reference in New Issue
Block a user