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