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

bal/bs/bse/cf/is: basic HTML output

Browse Source
This commit is contained in:
Simon Michael 2018-01-14 18:09:50 -08:00
parent 73ba78f092
commit 02516ef987
7 changed files with 138 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
hledger/Hledger/Cli/CliOptions.hs
View File

@ -161,7 +161,7 @@ reportflags = [
-- | Common output-related flags: --output-file, --output-format...
outputflags = [outputFormatFlag, outputFileFlag]
outputFormatFlag = flagReq ["output-format","O"] (\s opts -> Right $ setopt "output-format" s opts) "FMT" "select the output format. Supported formats:\ntxt, csv."
outputFormatFlag = flagReq ["output-format","O"] (\s opts -> Right $ setopt "output-format" s opts) "FMT" "select the output format. Supported formats:\ntxt, csv, html."
outputFileFlag = flagReq ["output-file","o"] (\s opts -> Right $ setopt "output-file" s opts) "FILE" "write output to FILE. A file extension matching one of the above formats selects that format."
argsFlag :: FlagHelp -> Arg RawOpts
@ -524,6 +524,7 @@ defaultOutputFormat = "txt"
outputFormats =
[defaultOutputFormat] ++
["csv"
,"html"
]
-- | Get the output format from the --output-format option,

92
hledger/Hledger/Cli/Commands/Balance.hs
View File

@ -233,6 +233,8 @@ Currently, empty cells show 0.
-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ExtendedDefaultRules #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Hledger.Cli.Commands.Balance (
balancemode
@ -241,6 +243,8 @@ module Hledger.Cli.Commands.Balance (
,balanceReportItemAsText
,multiBalanceReportAsText
,multiBalanceReportAsCsv
,multiBalanceReportAsHtml
,multiBalanceReportHtmlRows
,renderBalanceReportTable
,balanceReportAsTable
,tests_Hledger_Cli_Commands_Balance
@ -249,10 +253,11 @@ module Hledger.Cli.Commands.Balance (
import Data.List (intercalate, nub)
import Data.Maybe
import qualified Data.Map as Map
-- import Data.Monoid
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import System.Console.CmdArgs.Explicit as C
import Data.Decimal (roundTo)
import Lucid as L
import Text.CSV
import Test.HUnit
import Text.Printf (printf)
@ -320,8 +325,9 @@ balance opts@CliOpts{rawopts_=rawopts,reportopts_=ropts} j = do
in singleBalanceReport ropts' (queryFromOpts d ropts) j
| otherwise = balanceReport ropts (queryFromOpts d ropts) j
render = case format of
"csv" -> \ropts r -> (++ "\n") $ printCSV $ balanceReportAsCsv ropts r
_ -> balanceReportAsText
"csv" -> \ropts r -> (++ "\n") $ printCSV $ balanceReportAsCsv ropts r
"html" -> \_ _ -> error' "Sorry, HTML output is not yet implemented for this kind of report." -- TODO
_ -> balanceReportAsText
writeOutput opts $ render ropts report
_ | boolopt "budget" rawopts -> do
@ -332,14 +338,16 @@ balance opts@CliOpts{rawopts_=rawopts,reportopts_=ropts} j = do
render = case format of
-- XXX: implement csv rendering
"csv" -> (++ "\n") . printCSV . multiBalanceReportAsCsv ropts
"html" -> const $ error' "Sorry, HTML output is not yet implemented for this kind of report." -- TODO
_ -> multiBalanceReportWithBudgetAsText ropts budgetReport
writeOutput opts $ render report
| otherwise -> do
let report = multiBalanceReport ropts (queryFromOpts d ropts) j
render = case format of
"csv" -> (++ "\n") . printCSV . multiBalanceReportAsCsv ropts
_ -> multiBalanceReportAsText ropts
"csv" -> (++ "\n") . printCSV . multiBalanceReportAsCsv ropts
"html" -> (++ "\n") . TL.unpack . L.renderText . multiBalanceReportAsHtml ropts
_ -> multiBalanceReportAsText ropts
writeOutput opts $ render report
-- | Re-map account names to closet parent with periodic transaction from budget.
@ -503,17 +511,19 @@ renderComponent1 opts (acctname, depth, total) (FormatField ljust min max field)
TotalField -> fitStringMulti min max True False $ ((intercalate ", " . map strip . lines) (showamt total))
where
showamt | color_ opts = cshowMixedAmountWithoutPrice
| otherwise = showMixedAmountWithoutPrice
| otherwise = showMixedAmountWithoutPrice
_ -> ""
-- multi-column balance reports
-- | Render a multi-column balance report as CSV.
-- 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 (MultiBalanceReport (colspans, items, (coltotals,tot,avg))) =
("account" : map showDateSpan colspans
++ (if row_total_ opts then ["total"] else [])
++ (if average_ opts then ["average"] else [])
("Account" : map showDateSpan colspans
++ (if row_total_ opts then ["Total"] else [])
++ (if average_ opts then ["Average"] else [])
) :
[T.unpack a :
map showMixedAmountOneLineWithoutPrice
@ -524,13 +534,49 @@ multiBalanceReportAsCsv opts (MultiBalanceReport (colspans, items, (coltotals,to
++
if no_total_ opts
then []
else [["totals"]
else [["Total:"]
++ map showMixedAmountOneLineWithoutPrice (
coltotals
++ (if row_total_ opts then [tot] else [])
++ (if average_ opts then [avg] else [])
)]
-- | Render a multi-column balance report as HTML.
multiBalanceReportAsHtml :: ReportOpts -> MultiBalanceReport -> Html ()
multiBalanceReportAsHtml ropts mbr =
let
(headingsrow,bodyrows,mtotalsrow) = multiBalanceReportHtmlRows ropts mbr
in
table_ $ mconcat $
[headingsrow]
++ bodyrows
++ maybe [] (:[]) mtotalsrow
-- | 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 ropts mbr =
let
headingsrow:rest = multiBalanceReportAsCsv ropts mbr
(bodyrows, mtotalsrow) | no_total_ ropts = (rest, Nothing)
| otherwise = (init rest, Just $ last rest)
in
(thRow headingsrow
,map multiBalanceReportHtmlBodyRow bodyrows
,thRow <$> mtotalsrow
)
-- | Render one MultiBalanceReport data row as a HTML table row.
multiBalanceReportHtmlBodyRow :: [String] -> Html ()
multiBalanceReportHtmlBodyRow [] = mempty -- shouldn't happen
multiBalanceReportHtmlBodyRow (acct:amts) =
tr_ $ mconcat $
td_ (toHtml acct) :
[td_ [style_ "text-align:right"] (toHtml amt) | amt <- amts]
thRow :: [String] -> Html ()
thRow = tr_ . mconcat . map (th_ . toHtml)
-- | Render a multi-column balance report as plain text suitable for console output.
multiBalanceReportAsText :: ReportOpts -> MultiBalanceReport -> String
multiBalanceReportAsText opts r =
@ -559,16 +605,16 @@ multiBalanceReportWithBudgetAsText opts budget r =
CumulativeChange -> "Ending balances (cumulative)"
HistoricalBalance -> "Ending balances (historical)"
showcell (real, Nothing) = showamt real
showcell (real, Just budget) =
showcell (real, Just budget) =
case percentage real budget of
Just pct -> printf "%s [%s%% of %s]" (showamt real) (show $ roundTo 0 pct) (showamt budget)
Nothing -> printf "%s [%s]" (showamt real) (showamt budget)
percentage real budget =
-- percentage of budget consumed is always computed in the cost basis
case (toCost real, toCost budget) of
(Mixed [a1], Mixed [a2])
(Mixed [a1], Mixed [a2])
| isReallyZeroAmount a1 -> Just 0 -- if there are no postings, we consumed 0% of budget
| acommodity a1 == acommodity a2 && aquantity a2 /= 0 ->
| acommodity a1 == acommodity a2 && aquantity a2 /= 0 ->
Just $ 100 * aquantity a1 / aquantity a2
_ -> Nothing
where
@ -582,11 +628,11 @@ multiBalanceReportWithBudgetAsText opts budget r =
-- Both of these are satisfied by construction of budget report and process of rolling up
-- account names.
combine (Table l t d) (Table l' t' d') = Table l t combinedRows
where
where
-- For all accounts that are present in the budget, zip real amounts with budget amounts
combinedRows = [ combineRow row budgetRow
combinedRows = [ combineRow row budgetRow
| (acct, row) <- zip (headerContents l) d
, let budgetRow =
, let budgetRow =
if acct == "" then [] -- "" is totals row
else fromMaybe [] $ Map.lookup acct budgetAccts
]
@ -594,26 +640,26 @@ multiBalanceReportWithBudgetAsText opts budget r =
-- Headers for budget row will always be a sublist of headers of row
combineRow r br =
let reportRow = zip (headerContents t) r
budgetRow = Map.fromList $ zip (headerContents t') br
findBudgetVal hdr = Map.lookup hdr budgetRow
budgetRow = Map.fromList $ zip (headerContents t') br
findBudgetVal hdr = Map.lookup hdr budgetRow
in map (\(hdr, val) -> (val, findBudgetVal hdr)) reportRow
budgetAccts = Map.fromList $ zip (headerContents l') d'
-- | Given a table representing a multi-column balance report (for example,
-- made using 'balanceReportAsTable'), render it in a format suitable for
-- console output.
renderBalanceReportTable :: ReportOpts -> Table String String MixedAmount -> String
renderBalanceReportTable ropts =
renderBalanceReportTable ropts =
renderBalanceReportTable' ropts showamt
where
showamt | color_ ropts = cshowMixedAmountOneLineWithoutPrice
| otherwise = showMixedAmountOneLineWithoutPrice
renderBalanceReportTable' :: ReportOpts -> (a -> String) -> Table String String a -> String
renderBalanceReportTable' (ReportOpts { pretty_tables_ = pretty}) showCell =
renderBalanceReportTable' (ReportOpts { pretty_tables_ = pretty}) showCell =
unlines
. addtrailingblank
. trimborder
. trimborder
. lines
. render pretty id id showCell
. align

5
hledger/Hledger/Cli/Commands/Print.hs
View File

@ -59,8 +59,9 @@ printEntries opts@CliOpts{reportopts_=ropts} j = do
let q = queryFromOpts d ropts
fmt = outputFormatFromOpts opts
(render, ropts') = case fmt of
"csv" -> ((++"\n") . printCSV . entriesReportAsCsv, ropts{accountlistmode_=ALFlat})
_ -> (entriesReportAsText opts, ropts)
"csv" -> ((++"\n") . printCSV . entriesReportAsCsv, ropts{accountlistmode_=ALFlat})
"html" -> (const $ error' "Sorry, HTML output is not yet implemented for this kind of report.", ropts{accountlistmode_=ALFlat}) -- TODO
_ -> (entriesReportAsText opts, ropts)
writeOutput opts $ render $ entriesReport ropts' q j
entriesReportAsText :: CliOpts -> EntriesReport -> String

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

@ -61,8 +61,9 @@ register :: CliOpts -> Journal -> IO ()
register opts@CliOpts{reportopts_=ropts} j = do
d <- getCurrentDay
let fmt = outputFormatFromOpts opts
render | fmt=="csv" = const ((++"\n") . printCSV . postingsReportAsCsv)
| otherwise = postingsReportAsText
render | fmt=="csv" = const ((++"\n") . printCSV . postingsReportAsCsv)
| fmt=="html" = const $ error' "Sorry, HTML output is not yet implemented for this kind of report." -- TODO
| otherwise = postingsReportAsText
writeOutput opts $ render opts $ postingsReport ropts (queryFromOpts d ropts) j
postingsReportAsCsv :: PostingsReport -> CSV

61
hledger/Hledger/Cli/CompoundBalanceCommand.hs
View File

@ -15,9 +15,12 @@ module Hledger.Cli.CompoundBalanceCommand (
import Data.List (intercalate, foldl')
import Data.Maybe (fromMaybe)
import Data.Monoid (Sum(..), (<>))
import qualified Data.Text
import qualified Data.Text.Lazy as TL
import Data.Tuple.HT (uncurry3)
import System.Console.CmdArgs.Explicit as C
import Text.CSV
import Lucid as L
import Text.Tabular as T
import Hledger
@ -181,8 +184,9 @@ compoundBalanceCommand CompoundBalanceCommandSpec{..} opts@CliOpts{command_=cmd,
-- render appropriately
writeOutput opts $
case format of
"csv" -> printCSV (compoundBalanceReportAsCsv ropts cbr) ++ "\n"
_ -> compoundBalanceReportAsText ropts' cbr
"csv" -> printCSV (compoundBalanceReportAsCsv ropts cbr) ++ "\n"
"html" -> (++ "\n") $ TL.unpack $ L.renderText $ compoundBalanceReportAsHtml ropts cbr
_ -> compoundBalanceReportAsText ropts' cbr
-- | Run one subreport for a compound balance command in single-column mode.
-- Currently this returns the plain text rendering of the subreport, and its total.
@ -347,4 +351,55 @@ compoundBalanceReportAsCsv ropts (title, colspans, subreports, (coltotals, grand
++ (if row_total_ ropts then [grandtotal] else [])
++ (if average_ ropts then [grandavg] else [])
)
])
])
-- | Render a compound balance report as HTML.
compoundBalanceReportAsHtml :: ReportOpts -> CompoundBalanceReport -> Html ()
compoundBalanceReportAsHtml ropts cbr =
let
(title, colspans, subreports, (coltotals, grandtotal, grandavg)) = cbr
colspanattr = colspan_ $ Data.Text.pack $ show $ length colspans + 1
leftattr = style_ "text-align:left"
blankrow = tr_ $ td_ [colspanattr] $ toHtmlRaw ("&nbsp;"::String)
titlerows =
[tr_ $ th_ [colspanattr, leftattr] $ toHtml title]
++ [thRow $
"" :
map showDateSpan colspans
++ (if row_total_ ropts then ["Total"] else [])
++ (if average_ ropts then ["Average"] else [])
]
-- Make rows for a subreport: its title row, not the headings row,
-- the data rows, any totals row, and a blank row for whitespace.
subreportrows :: (String, MultiBalanceReport) -> [Html ()]
subreportrows (subreporttitle, mbr) =
let
(_,bodyrows,mtotalsrow) = multiBalanceReportHtmlRows ropts mbr
in
[tr_ $ th_ [colspanattr, leftattr] $ toHtml subreporttitle]
++ bodyrows
++ maybe [] (:[]) mtotalsrow
++ [blankrow]
totalrows | no_total_ ropts || length subreports == 1 = []
| otherwise =
[thRow $
"Grand Total:" :
map showMixedAmountOneLineWithoutPrice (
coltotals
++ (if row_total_ ropts then [grandtotal] else [])
++ (if average_ ropts then [grandavg] else [])
)
]
in
table_ $ mconcat $
titlerows
++ [blankrow]
++ concatMap subreportrows subreports
++ totalrows
thRow :: [String] -> Html ()
thRow = tr_ . mconcat . map (th_ . toHtml)

3
hledger/hledger.cabal
View File

@ -2,7 +2,7 @@
--
-- see: https://github.com/sol/hpack
--
-- hash: b3929eebc33ec5bd2e240d49c003aba48ddc1d4f0e9a09ca2e8161d531bd9fb3
-- hash: cb1407ac28a973e8fc74c9e78c06c2c29715873a64eb4586417cf02d12bfa60f
name: hledger
version: 1.5.99
@ -97,6 +97,7 @@ library
, haskeline >=0.6
, here
, hledger-lib >=1.5.99 && <1.6
, lucid
, megaparsec >=5.0
, mtl
, mtl-compat

1
hledger/package.yaml
View File

@ -138,6 +138,7 @@ library:
- hashable >=1.2.4
- haskeline >=0.6
- HUnit
- lucid
- mtl
- mtl-compat
- old-time