From 499c626e4804d80d42d79e0ce4ae00e0562e12cd Mon Sep 17 00:00:00 2001 From: Henning Thielemann Date: Sat, 7 Sep 2024 10:33:41 +0200 Subject: [PATCH] lib: Write.Spreadsheet: support for anchors in HTML and FODS export cli: Commands.Balance: new option --base-url It adds hledger-web-compatible hyperlinks to account names. --- hledger-lib/Hledger/Reports/ReportOptions.hs | 3 ++ hledger-lib/Hledger/Write/Html.hs | 8 +++- hledger-lib/Hledger/Write/Ods.hs | 9 ++++- hledger-lib/Hledger/Write/Spreadsheet.hs | 6 ++- hledger/Hledger/Cli/Commands/Balance.hs | 39 ++++++++++++++----- hledger/Hledger/Cli/CompoundBalanceCommand.hs | 1 + 6 files changed, 52 insertions(+), 14 deletions(-) diff --git a/hledger-lib/Hledger/Reports/ReportOptions.hs b/hledger-lib/Hledger/Reports/ReportOptions.hs index 366dc96d8..b4015d143 100644 --- a/hledger-lib/Hledger/Reports/ReportOptions.hs +++ b/hledger-lib/Hledger/Reports/ReportOptions.hs @@ -140,6 +140,7 @@ data ReportOpts = ReportOpts { ,no_elide_ :: Bool ,real_ :: Bool ,format_ :: StringFormat + ,balance_base_url_ :: Maybe T.Text ,pretty_ :: Bool ,querystring_ :: [T.Text] -- @@ -199,6 +200,7 @@ defreportopts = ReportOpts , no_elide_ = False , real_ = False , format_ = def + , balance_base_url_ = Nothing , pretty_ = False , querystring_ = [] , average_ = False @@ -255,6 +257,7 @@ rawOptsToReportOpts d rawopts = ,no_elide_ = boolopt "no-elide" rawopts ,real_ = boolopt "real" rawopts ,format_ = format + ,balance_base_url_ = T.pack <$> maybestringopt "base-url" rawopts ,querystring_ = querystring ,average_ = boolopt "average" rawopts ,related_ = boolopt "related" rawopts diff --git a/hledger-lib/Hledger/Write/Html.hs b/hledger-lib/Hledger/Write/Html.hs index 70c16574e..18f82b101 100644 --- a/hledger-lib/Hledger/Write/Html.hs +++ b/hledger-lib/Hledger/Write/Html.hs @@ -37,6 +37,10 @@ formatRow = Lucid.tr_ . traverse_ formatCell formatCell :: (Lines border) => Cell border (Lucid.Html ()) -> Lucid.Html () formatCell cell = let str = cellContent cell in + let content = + if Text.null $ cellAnchor cell + then str + else Lucid.a_ [Lucid.href_ $ cellAnchor cell] str in let border field access = map (field<>) $ borderLines $ access $ cellBorder cell in let leftBorder = border "border-left:" Spr.borderLeft in @@ -51,7 +55,7 @@ formatCell cell = map Lucid.class_ $ filter (not . Text.null) [Spr.textFromClass $ cellClass cell] in case cellStyle cell of - Head -> Lucid.th_ (style++class_) str + Head -> Lucid.th_ (style++class_) content Body emph -> let align = case cellType cell of @@ -62,7 +66,7 @@ formatCell cell = case emph of Item -> id Total -> Lucid.b_ - in Lucid.td_ (style++align++class_) $ withEmph str + in Lucid.td_ (style++align++class_) $ withEmph content class (Spr.Lines border) => Lines border where diff --git a/hledger-lib/Hledger/Write/Ods.hs b/hledger-lib/Hledger/Write/Ods.hs index 12887e1f5..7d299b222 100644 --- a/hledger-lib/Hledger/Write/Ods.hs +++ b/hledger-lib/Hledger/Write/Ods.hs @@ -314,9 +314,16 @@ formatCell cell = (cellContent cell) _ -> "office:value-type='string'" + anchor text = + if T.null $ Spr.cellAnchor cell + then text + else printf "%s" + (escape $ T.unpack $ Spr.cellAnchor cell) text + in printf "" style valueType : - printf "%s" (escape $ T.unpack $ cellContent cell) : + printf "%s" + (anchor $ escape $ T.unpack $ cellContent cell) : "" : [] diff --git a/hledger-lib/Hledger/Write/Spreadsheet.hs b/hledger-lib/Hledger/Write/Spreadsheet.hs index 6c3a0e583..538fc1994 100644 --- a/hledger-lib/Hledger/Write/Spreadsheet.hs +++ b/hledger-lib/Hledger/Write/Spreadsheet.hs @@ -87,13 +87,14 @@ data Cell border text = cellType :: Type, cellBorder :: Border border, cellStyle :: Style, + cellAnchor :: Text, cellClass :: Class, cellContent :: text } instance Functor (Cell border) where - fmap f (Cell typ border style class_ content) = - Cell typ border style class_ $ f content + fmap f (Cell typ border style anchor class_ content) = + Cell typ border style anchor class_ $ f content defaultCell :: (Lines border) => text -> Cell border text defaultCell text = @@ -101,6 +102,7 @@ defaultCell text = cellType = TypeString, cellBorder = noBorder, cellStyle = Body Item, + cellAnchor = mempty, cellClass = Class mempty, cellContent = text } diff --git a/hledger/Hledger/Cli/Commands/Balance.hs b/hledger/Hledger/Cli/Commands/Balance.hs index bf9bbd733..843f75190 100644 --- a/hledger/Hledger/Cli/Commands/Balance.hs +++ b/hledger/Hledger/Cli/Commands/Balance.hs @@ -265,6 +265,7 @@ module Hledger.Cli.Commands.Balance ( ) where import Control.Arrow (second, (***)) +import Control.Monad (guard) import Data.Decimal (roundTo) import Data.Default (def) import Data.Function (on) @@ -337,6 +338,7 @@ balancemode = hledgerCommandMode ,flagNone ["no-total","N"] (setboolopt "no-total") "omit the final total row" ,flagNone ["no-elide"] (setboolopt "no-elide") "don't squash boring parent accounts (in tree mode)" ,flagReq ["format"] (\s opts -> Right $ setopt "format" s opts) "FORMATSTR" "use this custom line format (in simple reports)" + ,flagReq ["base-url"] (\s opts -> Right $ setopt "base-url" s opts) "URLPREFIX" "add anchors to table cells with resepct to this base URL" ,flagNone ["sort-amount","S"] (setboolopt "sort-amount") "sort by amount instead of account code/name (in flat mode). With multiple columns, sorts by the row total, or by row average if that is displayed." ,flagNone ["percent", "%"] (setboolopt "percent") "express values in percentage of each column's total" ,flagNone ["invert"] (setboolopt "invert") "display all amounts with reversed sign" @@ -593,6 +595,15 @@ addTotalBorders = rawTableContent :: [[Ods.Cell border text]] -> [[text]] rawTableContent = map (map Ods.cellContent) +setAccountAnchor :: + Maybe Text -> Text -> Ods.Cell border text -> Ods.Cell border text +setAccountAnchor base acct cell = + cell + {Ods.cellAnchor = + foldMap + (\url -> url <> "register?q=inacct:" <> quoteIfSpaced acct) + base} + -- | Render a single-column balance report as FODS. balanceReportAsSpreadsheet :: @@ -613,16 +624,20 @@ balanceReportAsSpreadsheet opts (items, total) = rows :: RowClass -> AccountName -> MixedAmount -> [[Ods.Cell Ods.NumLines Text]] - rows rc name ma = case layout_ opts of + rows rc name ma = + let accountCell = + setAccountAnchor + (guard (rc==Value) >> balance_base_url_ opts) name $ + cell $ accountNameDrop (drop_ opts) name in + case layout_ opts of LayoutBare -> map (\a -> - [showName name, + [accountCell, cell $ acommodity a, renderAmount rc $ mixedAmount a]) . amounts $ mixedAmountStripCosts ma - _ -> [[showName name, renderAmount rc ma]] + _ -> [[accountCell, renderAmount rc ma]] - showName = cell . accountNameDrop (drop_ opts) renderAmount rc mixedAmt = wbToText <$> cellFromMixedAmount bopts (amountClass rc, mixedAmt) where @@ -706,9 +721,11 @@ multiBalanceReportAsSpreadsheetHelper ishtml opts@ReportOpts{..} (PeriodicReport map (headerCell . showDateSpan) colspans ++ [hCell "rowtotal" "total" | row_total_] ++ [hCell "rowaverage" "average" | average_] - fullRowAsTexts row = - map (accountCell (showName row) :) $ rowAsText Value row - where showName = accountNameDrop drop_ . prrFullName + fullRowAsTexts row = map (anchorCell:) $ rowAsText Value row + where anchorCell = + let name = prrFullName row in + setAccountAnchor balance_base_url_ name $ + accountCell $ accountNameDrop drop_ name totalrows | no_total_ = [] | ishtml = zipWith (:) (accountCell totalRowHeadingHtml : repeat Ods.emptyCell) $ rowAsText Total tr @@ -1207,7 +1224,7 @@ budgetReportAsSpreadsheet -> PeriodicReportRow a BudgetCell -> [[Ods.Cell Ods.NumLines Text]] rowAsTexts rc render row@(PeriodicReportRow _ as (rowtot,budgettot) (rowavg, budgetavg)) - | layout_ /= LayoutBare = [cell (render row) : map showNorm vals] + | layout_ /= LayoutBare = [accountCell : map showNorm vals] | otherwise = joinNames . zipWith (:) (map cell cs) -- add symbols and names . transpose -- each row becomes a list of Text quantities @@ -1224,7 +1241,11 @@ budgetReportAsSpreadsheet (budgetAverageClass rc, budgetavg)] | average_] - joinNames = map (cell (render row) :) + joinNames = map (accountCell :) + accountCell = + let name = render row in + setAccountAnchor (guard (rc==Value) >> balance_base_url_) name $ + cell name -- tests diff --git a/hledger/Hledger/Cli/CompoundBalanceCommand.hs b/hledger/Hledger/Cli/CompoundBalanceCommand.hs index 94af5e7db..6b77dc605 100644 --- a/hledger/Hledger/Cli/CompoundBalanceCommand.hs +++ b/hledger/Hledger/Cli/CompoundBalanceCommand.hs @@ -91,6 +91,7 @@ compoundBalanceCommandMode CompoundBalanceCommandSpec{..} = ,flagNone ["no-total","N"] (setboolopt "no-total") "omit the final total row" ,flagNone ["no-elide"] (setboolopt "no-elide") "don't squash boring parent accounts (in tree mode)" ,flagReq ["format"] (\s opts -> Right $ setopt "format" s opts) "FORMATSTR" "use this custom line format (in simple reports)" + ,flagReq ["base-url"] (\s opts -> Right $ setopt "base-url" s opts) "URLPREFIX" "add anchors to table cells with resepct to this base URL" ,flagNone ["sort-amount","S"] (setboolopt "sort-amount") "sort by amount instead of account code/name" ,flagNone ["percent", "%"] (setboolopt "percent") "express values in percentage of each column's total" ,flagReq ["layout"] (\s opts -> Right $ setopt "layout" s opts) "ARG"