lib, cli: Move CompoundBalanceReport into ReportTypes, compoundReportWith into MultiBalanceReport, share postings amongst subreports.
This commit is contained in:
parent
d09a90b38b
commit
604868cea5
@ -16,6 +16,10 @@ module Hledger.Reports.MultiBalanceReport (
|
||||
multiBalanceReport,
|
||||
multiBalanceReportWith,
|
||||
balanceReportFromMultiBalanceReport,
|
||||
|
||||
CompoundBalanceReport,
|
||||
compoundBalanceReportWith,
|
||||
|
||||
tableAsText,
|
||||
|
||||
sortAccountItemsLike,
|
||||
@ -28,6 +32,7 @@ where
|
||||
import Control.Monad (guard)
|
||||
import Data.Foldable (toList)
|
||||
import Data.List (sortBy, transpose)
|
||||
import Data.List.NonEmpty (NonEmpty(..))
|
||||
import Data.HashMap.Strict (HashMap)
|
||||
import qualified Data.HashMap.Strict as HM
|
||||
import Data.Map (Map)
|
||||
@ -37,6 +42,7 @@ import Data.Ord (comparing)
|
||||
#if !(MIN_VERSION_base(4,11,0))
|
||||
import Data.Semigroup ((<>))
|
||||
#endif
|
||||
import Data.Semigroup (sconcat)
|
||||
import Data.Time.Calendar (Day, addDays, fromGregorian)
|
||||
import Safe (headDef, headMay, lastMay)
|
||||
import Text.Tabular as T
|
||||
@ -70,10 +76,13 @@ import Hledger.Reports.ReportTypes
|
||||
|
||||
type MultiBalanceReport = PeriodicReport DisplayName MixedAmount
|
||||
type MultiBalanceReportRow = PeriodicReportRow DisplayName MixedAmount
|
||||
type CompoundBalanceReport = CompoundPeriodicReport DisplayName MixedAmount
|
||||
|
||||
-- type alias just to remind us which AccountNames might be depth-clipped, below.
|
||||
type ClippedAccountName = AccountName
|
||||
|
||||
|
||||
|
||||
-- | Generate a multicolumn balance report for the matched accounts,
|
||||
-- showing the change of balance, accumulated balance, or historical balance
|
||||
-- in each of the specified periods. Does not support tree-mode boring parent eliding.
|
||||
@ -109,6 +118,49 @@ multiBalanceReportWith ropts q j priceoracle = report
|
||||
-- Postprocess the report, negating balances and taking percentages if needed
|
||||
report = dbg' "report" $ generateMultiBalanceReport ropts' reportq j priceoracle reportspan colspans colps
|
||||
|
||||
compoundBalanceReportWith :: ReportOpts -> Query -> Journal -> PriceOracle
|
||||
-> [CBCSubreportSpec]
|
||||
-> CompoundBalanceReport
|
||||
compoundBalanceReportWith ropts q j priceoracle subreportspecs = cbr
|
||||
where
|
||||
-- Queries, report/column dates.
|
||||
ropts' = dbg "ropts'" $ setDefaultAccountListMode ALFlat ropts
|
||||
reportspan = dbg "reportspan" $ calculateReportSpan ropts' q j
|
||||
reportq = dbg "reportq" $ makeReportQuery ropts' reportspan q
|
||||
|
||||
-- Group postings into their columns.
|
||||
colps = dbg'' "colps" $ getPostingsByColumn ropts'{empty_=True} reportq j reportspan
|
||||
colspans = dbg "colspans" $ M.keys colps
|
||||
|
||||
-- Filter the column postings according to each subreport
|
||||
subreportcolps = map filterSubreport subreportspecs
|
||||
where filterSubreport sr = filter (matchesPosting $ cbcsubreportquery sr j) <$> colps
|
||||
|
||||
subreports = zipWith generateSubreport subreportspecs subreportcolps
|
||||
where
|
||||
generateSubreport CBCSubreportSpec{..} colps' =
|
||||
( cbcsubreporttitle
|
||||
-- Postprocess the report, negating balances and taking percentages if needed
|
||||
, prNormaliseSign cbcsubreportnormalsign $
|
||||
generateMultiBalanceReport ropts'' reportq j priceoracle reportspan colspans colps'
|
||||
, cbcsubreportincreasestotal
|
||||
)
|
||||
where
|
||||
ropts'' = ropts'{normalbalance_=Just cbcsubreportnormalsign}
|
||||
|
||||
-- Sum the subreport totals by column. Handle these cases:
|
||||
-- - no subreports
|
||||
-- - empty subreports, having no subtotals (#588)
|
||||
-- - subreports with a shorter subtotals row than the others
|
||||
overalltotals = case subreports of
|
||||
[] -> PeriodicReportRow () [] nullmixedamt nullmixedamt
|
||||
(r:rs) -> sconcat $ fmap subreportTotal (r:|rs)
|
||||
where
|
||||
subreportTotal (_, sr, increasestotal) =
|
||||
(if increasestotal then id else prrNegate) $ prTotals sr
|
||||
|
||||
cbr = CompoundPeriodicReport "" colspans subreports overalltotals
|
||||
|
||||
|
||||
-- | Calculate the span of the report to be generated.
|
||||
setDefaultAccountListMode :: AccountListMode -> ReportOpts -> ReportOpts
|
||||
|
||||
@ -1,8 +1,9 @@
|
||||
{- |
|
||||
New common report types, used by the BudgetReport for now, perhaps all reports later.
|
||||
-}
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE DeriveAnyClass #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
|
||||
module Hledger.Reports.ReportTypes
|
||||
( PeriodicReport(..)
|
||||
@ -17,10 +18,14 @@ module Hledger.Reports.ReportTypes
|
||||
, periodicReportSpan
|
||||
, prNegate
|
||||
, prNormaliseSign
|
||||
|
||||
, prMapName
|
||||
, prMapMaybeName
|
||||
|
||||
, prrNegate
|
||||
|
||||
, CompoundPeriodicReport(..)
|
||||
, CBCSubreportSpec(..)
|
||||
|
||||
, DisplayName(..)
|
||||
, flatDisplayName
|
||||
, treeDisplayName
|
||||
@ -33,8 +38,12 @@ module Hledger.Reports.ReportTypes
|
||||
import Data.Aeson
|
||||
import Data.Decimal
|
||||
import Data.Maybe (mapMaybe)
|
||||
#if !(MIN_VERSION_base(4,11,0))
|
||||
import Data.Semigroup (Semigroup(..))
|
||||
#endif
|
||||
import GHC.Generics (Generic)
|
||||
import Hledger.Data
|
||||
import Hledger.Query (Query)
|
||||
|
||||
type Percentage = Decimal
|
||||
|
||||
@ -89,6 +98,14 @@ data PeriodicReportRow a b =
|
||||
, prrAverage :: b -- The average of this row's values.
|
||||
} deriving (Show, Generic, ToJSON)
|
||||
|
||||
instance Num b => Semigroup (PeriodicReportRow a b) where
|
||||
(PeriodicReportRow _ amts1 t1 a1) <> (PeriodicReportRow n2 amts2 t2 a2) =
|
||||
PeriodicReportRow n2 (sumPadded amts1 amts2) (t1 + t2) (a1 + a2)
|
||||
where
|
||||
sumPadded (a:as) (b:bs) = (a + b) : sumPadded as bs
|
||||
sumPadded as [] = as
|
||||
sumPadded [] bs = bs
|
||||
|
||||
-- | Figure out the overall date span of a PeridicReport
|
||||
periodicReportSpan :: PeriodicReport a b -> DateSpan
|
||||
periodicReportSpan (PeriodicReport [] _ _) = DateSpan Nothing Nothing
|
||||
@ -103,10 +120,12 @@ prNormaliseSign _ = id
|
||||
-- | Flip the sign of all amounts in a PeriodicReport.
|
||||
prNegate :: Num b => PeriodicReport a b -> PeriodicReport a b
|
||||
prNegate (PeriodicReport colspans rows totalsrow) =
|
||||
PeriodicReport colspans (map rowNegate rows) (rowNegate totalsrow)
|
||||
where
|
||||
rowNegate (PeriodicReportRow name amts tot avg) =
|
||||
PeriodicReportRow name (map negate amts) (-tot) (-avg)
|
||||
PeriodicReport colspans (map prrNegate rows) (prrNegate totalsrow)
|
||||
|
||||
-- | Flip the sign of all amounts in a PeriodicReportRow.
|
||||
prrNegate :: Num b => PeriodicReportRow a b -> PeriodicReportRow a b
|
||||
prrNegate (PeriodicReportRow name amts tot avg) =
|
||||
PeriodicReportRow name (map negate amts) (-tot) (-avg)
|
||||
|
||||
-- | Map a function over the row names.
|
||||
prMapName :: (a -> b) -> PeriodicReport a c -> PeriodicReport b c
|
||||
@ -127,6 +146,36 @@ prrMapMaybeName f row = case f $ prrName row of
|
||||
Just a -> Just row{prrName = a}
|
||||
|
||||
|
||||
-- | A compound balance report has:
|
||||
--
|
||||
-- * an overall title
|
||||
--
|
||||
-- * the period (date span) of each column
|
||||
--
|
||||
-- * one or more named, normal-positive multi balance reports,
|
||||
-- with columns corresponding to the above, and a flag indicating
|
||||
-- whether they increased or decreased the overall totals
|
||||
--
|
||||
-- * a list of overall totals for each column, and their grand total and average
|
||||
--
|
||||
-- It is used in compound balance report commands like balancesheet,
|
||||
-- cashflow and incomestatement.
|
||||
data CompoundPeriodicReport a b = CompoundPeriodicReport
|
||||
{ cbrTitle :: String
|
||||
, cbrDates :: [DateSpan]
|
||||
, cbrSubreports :: [(String, PeriodicReport a b, Bool)]
|
||||
, cbrTotals :: PeriodicReportRow () b
|
||||
} deriving (Show, Generic, ToJSON)
|
||||
|
||||
-- | Description of one subreport within a compound balance report.
|
||||
data CBCSubreportSpec = CBCSubreportSpec
|
||||
{ cbcsubreporttitle :: String
|
||||
, cbcsubreportquery :: Journal -> Query
|
||||
, cbcsubreportnormalsign :: NormalSign
|
||||
, cbcsubreportincreasestotal :: Bool
|
||||
}
|
||||
|
||||
|
||||
-- | A full name, display name, and depth for an account.
|
||||
data DisplayName = DisplayName
|
||||
{ displayFull :: AccountName
|
||||
|
||||
@ -8,7 +8,6 @@ like balancesheet, cashflow, and incomestatement.
|
||||
|
||||
module Hledger.Cli.CompoundBalanceCommand (
|
||||
CompoundBalanceCommandSpec(..)
|
||||
,CBCSubreportSpec(..)
|
||||
,compoundBalanceCommandMode
|
||||
,compoundBalanceCommand
|
||||
) where
|
||||
@ -49,36 +48,6 @@ data CompoundBalanceCommandSpec = CompoundBalanceCommandSpec {
|
||||
-- this report shows (overrides command line flags)
|
||||
}
|
||||
|
||||
-- | Description of one subreport within a compound balance report.
|
||||
data CBCSubreportSpec = CBCSubreportSpec {
|
||||
cbcsubreporttitle :: String
|
||||
,cbcsubreportquery :: Journal -> Query
|
||||
,cbcsubreportnormalsign :: NormalSign
|
||||
,cbcsubreportincreasestotal :: Bool
|
||||
}
|
||||
|
||||
-- | A compound balance report has:
|
||||
--
|
||||
-- * an overall title
|
||||
--
|
||||
-- * the period (date span) of each column
|
||||
--
|
||||
-- * one or more named, normal-positive multi balance reports,
|
||||
-- with columns corresponding to the above, and a flag indicating
|
||||
-- whether they increased or decreased the overall totals
|
||||
--
|
||||
-- * a list of overall totals for each column, and their grand total and average
|
||||
--
|
||||
-- It is used in compound balance report commands like balancesheet,
|
||||
-- cashflow and incomestatement.
|
||||
type CompoundBalanceReport =
|
||||
( String
|
||||
, [DateSpan]
|
||||
, [(String, MultiBalanceReport, Bool)]
|
||||
, ([MixedAmount], MixedAmount, MixedAmount)
|
||||
)
|
||||
|
||||
|
||||
-- | Generate a cmdargs option-parsing mode from a compound balance command
|
||||
-- specification.
|
||||
compoundBalanceCommandMode :: CompoundBalanceCommandSpec -> Mode RawOpts
|
||||
@ -147,46 +116,6 @@ compoundBalanceCommand CompoundBalanceCommandSpec{..} opts@CliOpts{reportopts_=r
|
||||
-- make a CompoundBalanceReport.
|
||||
-- For efficiency, generate a price oracle here and reuse it with each subreport.
|
||||
priceoracle = journalPriceOracle infer_value_ j
|
||||
subreports =
|
||||
map (\CBCSubreportSpec{..} ->
|
||||
(cbcsubreporttitle
|
||||
,prNormaliseSign cbcsubreportnormalsign $ -- <- convert normal-negative to normal-positive
|
||||
compoundBalanceSubreport ropts' userq j priceoracle cbcsubreportquery cbcsubreportnormalsign
|
||||
,cbcsubreportincreasestotal
|
||||
))
|
||||
cbcqueries
|
||||
|
||||
subtotalrows =
|
||||
[(prrAmounts $ prTotals report, increasesoveralltotal)
|
||||
| (_, report, increasesoveralltotal) <- subreports
|
||||
]
|
||||
|
||||
-- Sum the subreport totals by column. Handle these cases:
|
||||
-- - no subreports
|
||||
-- - empty subreports, having no subtotals (#588)
|
||||
-- - subreports with a shorter subtotals row than the others
|
||||
overalltotals = case subtotalrows of
|
||||
[] -> ([], nullmixedamt, nullmixedamt)
|
||||
rs ->
|
||||
let
|
||||
numcols = maximum $ map (length.fst) rs -- partial maximum is ok, rs is non-null
|
||||
paddedsignedsubtotalrows =
|
||||
[map (if increasesoveralltotal then id else negate) $ -- maybe flip the signs
|
||||
take numcols $ as ++ repeat nullmixedamt -- pad short rows with zeros
|
||||
| (as,increasesoveralltotal) <- rs
|
||||
]
|
||||
coltotals = foldl' (zipWith (+)) zeros paddedsignedsubtotalrows -- sum the columns
|
||||
where zeros = replicate numcols nullmixedamt
|
||||
grandtotal = sum coltotals
|
||||
grandavg | null coltotals = nullmixedamt
|
||||
| otherwise = fromIntegral (length coltotals) `divideMixedAmount` grandtotal
|
||||
in
|
||||
(coltotals, grandtotal, grandavg)
|
||||
|
||||
colspans =
|
||||
case subreports of
|
||||
(_, PeriodicReport ds _ _, _):_ -> ds
|
||||
[] -> []
|
||||
|
||||
title =
|
||||
cbctitle
|
||||
@ -201,11 +130,11 @@ compoundBalanceCommand CompoundBalanceCommandSpec{..} opts@CliOpts{reportopts_=r
|
||||
-- column heading(s) (not the date span of the transactions).
|
||||
-- Also the dates should not be simplified (it should show
|
||||
-- "2008/01/01-2008/12/31", not "2008").
|
||||
titledatestr
|
||||
| balancetype == HistoricalBalance = showEndDates enddates
|
||||
| otherwise = showDateSpan requestedspan
|
||||
titledatestr = case balancetype of
|
||||
HistoricalBalance -> showEndDates enddates
|
||||
_ -> showDateSpan requestedspan
|
||||
where
|
||||
enddates = map (addDays (-1)) $ catMaybes $ map spanEnd colspans -- these spans will always have a definite end date
|
||||
enddates = map (addDays (-1)) . mapMaybe spanEnd $ cbrDates cbr -- these spans will always have a definite end date
|
||||
requestedspan = queryDateSpan date2_ userq `spanDefaultsFrom` journalDateSpan date2_ j
|
||||
|
||||
-- when user overrides, add an indication to the report title
|
||||
@ -226,12 +155,9 @@ compoundBalanceCommand CompoundBalanceCommandSpec{..} opts@CliOpts{reportopts_=r
|
||||
Nothing -> ""
|
||||
where
|
||||
multiperiod = interval_ /= NoInterval
|
||||
cbr =
|
||||
(title
|
||||
,colspans
|
||||
,subreports
|
||||
,overalltotals
|
||||
)
|
||||
|
||||
cbr' = compoundBalanceReportWith ropts' userq j priceoracle cbcqueries
|
||||
cbr = cbr'{cbrTitle=title}
|
||||
|
||||
-- render appropriately
|
||||
writeOutput opts $
|
||||
@ -254,30 +180,6 @@ showEndDates es = case es of
|
||||
where
|
||||
showdate = show
|
||||
|
||||
-- | Run one subreport for a compound balance command in multi-column mode.
|
||||
-- This returns a MultiBalanceReport.
|
||||
compoundBalanceSubreport :: ReportOpts -> Query -> Journal -> PriceOracle -> (Journal -> Query) -> NormalSign -> MultiBalanceReport
|
||||
compoundBalanceSubreport ropts@ReportOpts{..} userq j priceoracle subreportqfn subreportnormalsign = r'
|
||||
where
|
||||
-- force --empty to ensure same columns in all sections
|
||||
ropts' = ropts { empty_=True, normalbalance_=Just subreportnormalsign }
|
||||
-- run the report
|
||||
q = And [subreportqfn j, userq]
|
||||
r@(PeriodicReport dates rows totals) = multiBalanceReportWith ropts' q j priceoracle
|
||||
-- if user didn't specify --empty, now remove the all-zero rows, unless they have non-zero subaccounts
|
||||
-- in this report
|
||||
r' | empty_ = r
|
||||
| otherwise = PeriodicReport dates rows' totals
|
||||
where
|
||||
nonzeroaccounts =
|
||||
dbg5 "nonzeroaccounts" $
|
||||
mapMaybe (\(PeriodicReportRow act amts _ _) ->
|
||||
if not (all mixedAmountLooksZero amts) then Just (displayFull act) else Nothing) rows
|
||||
rows' = filter (not . emptyRow) rows
|
||||
where
|
||||
emptyRow (PeriodicReportRow act amts _ _) =
|
||||
all mixedAmountLooksZero amts && not (any (displayFull act `isAccountNamePrefixOf`) nonzeroaccounts)
|
||||
|
||||
-- | Render a compound balance report as plain text suitable for console output.
|
||||
{- Eg:
|
||||
Balance Sheet
|
||||
@ -299,9 +201,10 @@ Balance Sheet
|
||||
|
||||
-}
|
||||
compoundBalanceReportAsText :: ReportOpts -> CompoundBalanceReport -> String
|
||||
compoundBalanceReportAsText ropts (title, _colspans, subreports, (coltotals, grandtotal, grandavg)) =
|
||||
title ++ "\n\n" ++
|
||||
balanceReportTableAsText ropts bigtable'
|
||||
compoundBalanceReportAsText ropts
|
||||
(CompoundPeriodicReport title _colspans subreports (PeriodicReportRow _ coltotals grandtotal grandavg)) =
|
||||
title ++ "\n\n" ++
|
||||
balanceReportTableAsText ropts bigtable'
|
||||
where
|
||||
bigtable =
|
||||
case map (subreportAsTable ropts) subreports of
|
||||
@ -337,7 +240,7 @@ concatTables (Table hLeft hTop dat) (Table hLeft' _ dat') =
|
||||
-- subreport title row, and an overall title row, one headings row, and an
|
||||
-- optional overall totals row is added.
|
||||
compoundBalanceReportAsCsv :: ReportOpts -> CompoundBalanceReport -> CSV
|
||||
compoundBalanceReportAsCsv ropts (title, colspans, subreports, (coltotals, grandtotal, grandavg)) =
|
||||
compoundBalanceReportAsCsv ropts (CompoundPeriodicReport title colspans subreports (PeriodicReportRow _ coltotals grandtotal grandavg)) =
|
||||
addtotals $
|
||||
padRow title :
|
||||
("Account" :
|
||||
@ -376,7 +279,7 @@ compoundBalanceReportAsCsv ropts (title, colspans, subreports, (coltotals, grand
|
||||
compoundBalanceReportAsHtml :: ReportOpts -> CompoundBalanceReport -> Html ()
|
||||
compoundBalanceReportAsHtml ropts cbr =
|
||||
let
|
||||
(title, colspans, subreports, (coltotals, grandtotal, grandavg)) = cbr
|
||||
CompoundPeriodicReport title colspans subreports (PeriodicReportRow _ coltotals grandtotal grandavg) = cbr
|
||||
colspanattr = colspan_ $ TS.pack $ show $
|
||||
1 + length colspans + (if row_total_ ropts then 1 else 0) + (if average_ ropts then 1 else 0)
|
||||
leftattr = style_ "text-align:left"
|
||||
|
||||
@ -96,26 +96,25 @@ hledger -f sample.journal balancesheet -p 'monthly in 2008' --tree
|
||||
>>>
|
||||
Balance Sheet 2008-01-31..2008-12-31
|
||||
|
||||
|| 2008-01-31 2008-02-29 2008-03-31 2008-04-30 2008-05-31 2008-06-30 2008-07-31 2008-08-31 2008-09-30 2008-10-31 2008-11-30 2008-12-31
|
||||
==============++================================================================================================================================================
|
||||
Assets ||
|
||||
--------------++------------------------------------------------------------------------------------------------------------------------------------------------
|
||||
assets || $1 $1 $1 $1 $1 0 0 0 0 0 0 $-1
|
||||
bank || $1 $1 $1 $1 $1 $2 $2 $2 $2 $2 $2 $1
|
||||
checking || $1 $1 $1 $1 $1 $1 $1 $1 $1 $1 $1 0
|
||||
saving || 0 0 0 0 0 $1 $1 $1 $1 $1 $1 $1
|
||||
cash || 0 0 0 0 0 $-2 $-2 $-2 $-2 $-2 $-2 $-2
|
||||
--------------++------------------------------------------------------------------------------------------------------------------------------------------------
|
||||
|| $1 $1 $1 $1 $1 0 0 0 0 0 0 $-1
|
||||
==============++================================================================================================================================================
|
||||
Liabilities ||
|
||||
--------------++------------------------------------------------------------------------------------------------------------------------------------------------
|
||||
liabilities || 0 0 0 0 0 0 0 0 0 0 0 $-1
|
||||
debts || 0 0 0 0 0 0 0 0 0 0 0 $-1
|
||||
--------------++------------------------------------------------------------------------------------------------------------------------------------------------
|
||||
|| 0 0 0 0 0 0 0 0 0 0 0 $-1
|
||||
==============++================================================================================================================================================
|
||||
Net: || $1 $1 $1 $1 $1 0 0 0 0 0 0 0
|
||||
|| 2008-01-31 2008-02-29 2008-03-31 2008-04-30 2008-05-31 2008-06-30 2008-07-31 2008-08-31 2008-09-30 2008-10-31 2008-11-30 2008-12-31
|
||||
===================++================================================================================================================================================
|
||||
Assets ||
|
||||
-------------------++------------------------------------------------------------------------------------------------------------------------------------------------
|
||||
assets || $1 $1 $1 $1 $1 0 0 0 0 0 0 $-1
|
||||
bank || $1 $1 $1 $1 $1 $2 $2 $2 $2 $2 $2 $1
|
||||
checking || $1 $1 $1 $1 $1 $1 $1 $1 $1 $1 $1 0
|
||||
saving || 0 0 0 0 0 $1 $1 $1 $1 $1 $1 $1
|
||||
cash || 0 0 0 0 0 $-2 $-2 $-2 $-2 $-2 $-2 $-2
|
||||
-------------------++------------------------------------------------------------------------------------------------------------------------------------------------
|
||||
|| $1 $1 $1 $1 $1 0 0 0 0 0 0 $-1
|
||||
===================++================================================================================================================================================
|
||||
Liabilities ||
|
||||
-------------------++------------------------------------------------------------------------------------------------------------------------------------------------
|
||||
liabilities:debts || 0 0 0 0 0 0 0 0 0 0 0 $-1
|
||||
-------------------++------------------------------------------------------------------------------------------------------------------------------------------------
|
||||
|| 0 0 0 0 0 0 0 0 0 0 0 $-1
|
||||
===================++================================================================================================================================================
|
||||
Net: || $1 $1 $1 $1 $1 0 0 0 0 0 0 0
|
||||
>>>= 0
|
||||
|
||||
# 4. monthly balancesheet with average column and without overall totals row.
|
||||
@ -150,8 +149,7 @@ Balance Sheet 2017-01-01
|
||||
=============++============
|
||||
Assets ||
|
||||
-------------++------------
|
||||
assets || 1
|
||||
b || 1
|
||||
assets:b || 1
|
||||
-------------++------------
|
||||
|| 1
|
||||
=============++============
|
||||
|
||||
@ -48,13 +48,11 @@ Balance Sheet 2018-01-01
|
||||
=============++============
|
||||
Assets ||
|
||||
-------------++------------
|
||||
b || 3
|
||||
bb || 3
|
||||
b:bb || 3
|
||||
=============++============
|
||||
Liabilities ||
|
||||
-------------++------------
|
||||
asset || -1
|
||||
a || -1
|
||||
asset:a || -1
|
||||
b || -2
|
||||
|
||||
# TODO
|
||||
|
||||
Loading…
Reference in New Issue
Block a user