From 234d6a82a203fb5d883db0ac45c4ecf19b0f8f71 Mon Sep 17 00:00:00 2001 From: Henning Thielemann Date: Sat, 7 Sep 2024 10:33:41 +0200 Subject: [PATCH 1/5] 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 366dc96d811..b4015d143fa 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 70c16574e35..18f82b10128 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 12887e1f5fc..7d299b222d8 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 6c3a0e583f6..538fc199462 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 bf9bbd73307..843f75190c3 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 26f6494fd5b..9eaa6438118 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" From 10415980b45e4c4a86758801eb1936ade931d19d Mon Sep 17 00:00:00 2001 From: Henning Thielemann Date: Wed, 25 Sep 2024 11:34:37 +0200 Subject: [PATCH 2/5] cli: Commands.Balance.multiBalanceReportAsSpreadsheet: add date query anchors to period headers --- hledger/Hledger/Cli/Commands/Balance.hs | 69 ++++++++++++++----- hledger/Hledger/Cli/CompoundBalanceCommand.hs | 3 +- 2 files changed, 54 insertions(+), 18 deletions(-) diff --git a/hledger/Hledger/Cli/Commands/Balance.hs b/hledger/Hledger/Cli/Commands/Balance.hs index 843f75190c3..4d9dc1444ef 100644 --- a/hledger/Hledger/Cli/Commands/Balance.hs +++ b/hledger/Hledger/Cli/Commands/Balance.hs @@ -259,6 +259,7 @@ module Hledger.Cli.Commands.Balance ( ,multiBalanceReportTableAsText ,multiBalanceReportAsSpreadsheet ,addTotalBorders + ,simpleDateSpanCell ,RowClass(..) -- ** Tests ,tests_Balance @@ -583,6 +584,30 @@ headerCell text = (Ods.cellBorder deflt) {Ods.borderBottom = Ods.DoubleLine} } +headerDateSpanCell :: Maybe Text -> DateSpan -> Ods.Cell Ods.NumLines Text +headerDateSpanCell base spn = + let prd = showDateSpan spn in + (headerCell prd) { + Ods.cellAnchor = + foldMap (\url -> url <> "register?q=date:" <> prd) base + } + +simpleDateSpanCell :: DateSpan -> Ods.Cell Ods.NumLines Text +simpleDateSpanCell = Ods.defaultCell . showDateSpan + +dateSpanCell :: + (Ods.Lines border) => Maybe Text -> Text -> DateSpan -> Ods.Cell border Text +dateSpanCell base acct spn = + let prd = showDateSpan spn in + (Ods.defaultCell prd) { + Ods.cellAnchor = + foldMap + (\url -> url <> + "register?q=inacct:" <> quoteIfSpaced acct <> + " date:" <> prd) + base + } + addTotalBorders :: [[Ods.Cell border text]] -> [[Ods.Cell Ods.NumLines text]] addTotalBorders = zipWith @@ -718,21 +743,26 @@ multiBalanceReportAsSpreadsheetHelper ishtml opts@ReportOpts{..} (PeriodicReport LayoutBare -> headerCell "commodity" : dateHeaders _ -> dateHeaders dateHeaders = - map (headerCell . showDateSpan) colspans ++ + map (headerDateSpanCell balance_base_url_) colspans ++ [hCell "rowtotal" "total" | row_total_] ++ [hCell "rowaverage" "average" | average_] - fullRowAsTexts row = map (anchorCell:) $ rowAsText Value row - where anchorCell = - let name = prrFullName row in - setAccountAnchor balance_base_url_ name $ - accountCell $ accountNameDrop drop_ name + fullRowAsTexts row = + map (anchorCell:) $ + rowAsText Value (dateSpanCell balance_base_url_ acctName) row + where acctName = prrFullName row + anchorCell = + setAccountAnchor balance_base_url_ acctName $ + accountCell $ accountNameDrop drop_ acctName totalrows | no_total_ = [] - | ishtml = zipWith (:) (accountCell totalRowHeadingHtml : repeat Ods.emptyCell) $ rowAsText Total tr - | otherwise = map (accountCell totalRowHeadingCsv :) $ rowAsText Total tr - rowAsText rc = + | ishtml = zipWith (:) (accountCell totalRowHeadingHtml : repeat Ods.emptyCell) $ + rowAsText Total simpleDateSpanCell tr + | otherwise = map (accountCell totalRowHeadingCsv :) $ + rowAsText Total simpleDateSpanCell tr + rowAsText rc dsCell = let fmt = if ishtml then oneLineNoCostFmt else machineFmt - in map (map (fmap wbToText)) . multiBalanceRowAsCellBuilders fmt opts colspans rc + in map (map (fmap wbToText)) . + multiBalanceRowAsCellBuilders fmt opts colspans rc dsCell -- | Render a multi-column balance report as HTML. @@ -867,10 +897,11 @@ multiBalanceReportAsTable opts@ReportOpts{summary_only_, average_, row_total_, b multiBalanceRowAsCellBuilders :: AmountFormat -> ReportOpts -> [DateSpan] -> - RowClass -> PeriodicReportRow a MixedAmount -> + RowClass -> (DateSpan -> Ods.Cell Ods.NumLines Text) -> + PeriodicReportRow a MixedAmount -> [[Ods.Cell Ods.NumLines WideBuilder]] multiBalanceRowAsCellBuilders bopts ReportOpts{..} colspans - rc (PeriodicReportRow _ as rowtot rowavg) = + rc renderDateSpanCell (PeriodicReportRow _acct as rowtot rowavg) = case layout_ of LayoutWide width -> [fmap (cellFromMixedAmount bopts{displayMaxWidth=width}) clsamts] LayoutTall -> paddedTranspose Ods.emptyCell @@ -897,9 +928,11 @@ multiBalanceRowAsCellBuilders bopts ReportOpts{..} colspans clsamts = (if not summary_only_ then classified else []) ++ [(rowTotalClass rc, rowtot) | totalscolumn && not (null as)] ++ [(rowAverageClass rc, rowavg) | average_ && not (null as)] - addDateColumns spn@(DateSpan s e) = (wbCell (showDateSpan spn) :) - . (wbDate (maybe "" showEFDate s) :) - . (wbDate (maybe "" (showEFDate . modifyEFDay (addDays (-1))) e) :) + addDateColumns spn@(DateSpan s e) remCols = + (wbFromText <$> renderDateSpanCell spn) : + wbDate (maybe "" showEFDate s) : + wbDate (maybe "" (showEFDate . modifyEFDay (addDays (-1))) e) : + remCols paddedTranspose :: a -> [[a]] -> [[a]] paddedTranspose _ [] = [[]] @@ -919,12 +952,14 @@ multiBalanceRowAsCellBuilders bopts ReportOpts{..} colspans multiBalanceRowAsText :: ReportOpts -> PeriodicReportRow a MixedAmount -> [[WideBuilder]] multiBalanceRowAsText opts = rawTableContent . - multiBalanceRowAsCellBuilders oneLineNoCostFmt{displayColour=color_ opts} opts [] Value + multiBalanceRowAsCellBuilders oneLineNoCostFmt{displayColour=color_ opts} opts [] + Value simpleDateSpanCell multiBalanceRowAsCsvText :: ReportOpts -> [DateSpan] -> PeriodicReportRow a MixedAmount -> [[T.Text]] multiBalanceRowAsCsvText opts colspans = map (map (wbToText . Ods.cellContent)) . - multiBalanceRowAsCellBuilders machineFmt opts colspans Value + multiBalanceRowAsCellBuilders machineFmt opts colspans + Value simpleDateSpanCell -- Budget reports diff --git a/hledger/Hledger/Cli/CompoundBalanceCommand.hs b/hledger/Hledger/Cli/CompoundBalanceCommand.hs index 9eaa6438118..61283393740 100644 --- a/hledger/Hledger/Cli/CompoundBalanceCommand.hs +++ b/hledger/Hledger/Cli/CompoundBalanceCommand.hs @@ -366,7 +366,8 @@ compoundBalanceReportAsHtml ropts cbr = totalrows = if no_total_ ropts || length subreports == 1 then [] else - multiBalanceRowAsCellBuilders oneLineNoCostFmt ropts colspans Total totalrow + multiBalanceRowAsCellBuilders oneLineNoCostFmt ropts colspans + Total simpleDateSpanCell totalrow -- make a table of rendered lines of the report totals row & map (map (fmap wbToText)) & zipWith (:) (Spr.defaultCell "Net:" : repeat Spr.emptyCell) From 1af3877e416b5c91da37d8a575d1d278c057fe95 Mon Sep 17 00:00:00 2001 From: Henning Thielemann Date: Sat, 28 Sep 2024 19:43:24 +0200 Subject: [PATCH 3/5] cli: Command.Balance: pass command-line query to HTML and FODS hyperlinks --- hledger/Hledger/Cli/Commands/Balance.hs | 51 ++++++++++++++++--------- 1 file changed, 32 insertions(+), 19 deletions(-) diff --git a/hledger/Hledger/Cli/Commands/Balance.hs b/hledger/Hledger/Cli/Commands/Balance.hs index 4d9dc1444ef..6e0addd7674 100644 --- a/hledger/Hledger/Cli/Commands/Balance.hs +++ b/hledger/Hledger/Cli/Commands/Balance.hs @@ -584,27 +584,41 @@ headerCell text = (Ods.cellBorder deflt) {Ods.borderBottom = Ods.DoubleLine} } -headerDateSpanCell :: Maybe Text -> DateSpan -> Ods.Cell Ods.NumLines Text -headerDateSpanCell base spn = +registerQueryUrl :: [Text] -> Text +registerQueryUrl query = + "register?q=" <> + T.intercalate "+" (map quoteIfSpaced $ filter (not . T.null) query) + +-- cf. Web.Widget.Common +removeDates :: [Text] -> [Text] +removeDates = + filter (\term_ -> + not $ T.isPrefixOf "date:" term_ || T.isPrefixOf "date2:" term_) + +replaceDate :: Text -> [Text] -> [Text] +replaceDate prd query = "date:"<>prd : removeDates query + +headerDateSpanCell :: + Maybe Text -> [Text] -> DateSpan -> Ods.Cell Ods.NumLines Text +headerDateSpanCell base query spn = let prd = showDateSpan spn in (headerCell prd) { Ods.cellAnchor = - foldMap (\url -> url <> "register?q=date:" <> prd) base + foldMap (<> registerQueryUrl (replaceDate prd query)) base } simpleDateSpanCell :: DateSpan -> Ods.Cell Ods.NumLines Text simpleDateSpanCell = Ods.defaultCell . showDateSpan dateSpanCell :: - (Ods.Lines border) => Maybe Text -> Text -> DateSpan -> Ods.Cell border Text -dateSpanCell base acct spn = + (Ods.Lines border) => + Maybe Text -> [Text] -> Text -> DateSpan -> Ods.Cell border Text +dateSpanCell base query acct spn = let prd = showDateSpan spn in (Ods.defaultCell prd) { Ods.cellAnchor = foldMap - (\url -> url <> - "register?q=inacct:" <> quoteIfSpaced acct <> - " date:" <> prd) + (<> registerQueryUrl ("inacct:"<>acct : replaceDate prd query)) base } @@ -621,13 +635,11 @@ 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 = + Maybe Text -> [Text] -> Text -> Ods.Cell border text -> Ods.Cell border text +setAccountAnchor base query acct cell = cell {Ods.cellAnchor = - foldMap - (\url -> url <> "register?q=inacct:" <> quoteIfSpaced acct) - base} + foldMap (<> registerQueryUrl ("inacct:"<>acct : query)) base} -- | Render a single-column balance report as FODS. @@ -652,7 +664,8 @@ balanceReportAsSpreadsheet opts (items, total) = rows rc name ma = let accountCell = setAccountAnchor - (guard (rc==Value) >> balance_base_url_ opts) name $ + (guard (rc==Value) >> balance_base_url_ opts) + (querystring_ opts) name $ cell $ accountNameDrop (drop_ opts) name in case layout_ opts of LayoutBare -> @@ -743,15 +756,15 @@ multiBalanceReportAsSpreadsheetHelper ishtml opts@ReportOpts{..} (PeriodicReport LayoutBare -> headerCell "commodity" : dateHeaders _ -> dateHeaders dateHeaders = - map (headerDateSpanCell balance_base_url_) colspans ++ + map (headerDateSpanCell balance_base_url_ querystring_) colspans ++ [hCell "rowtotal" "total" | row_total_] ++ [hCell "rowaverage" "average" | average_] fullRowAsTexts row = map (anchorCell:) $ - rowAsText Value (dateSpanCell balance_base_url_ acctName) row + rowAsText Value (dateSpanCell balance_base_url_ querystring_ acctName) row where acctName = prrFullName row anchorCell = - setAccountAnchor balance_base_url_ acctName $ + setAccountAnchor balance_base_url_ querystring_ acctName $ accountCell $ accountNameDrop drop_ acctName totalrows | no_total_ = [] @@ -1279,8 +1292,8 @@ budgetReportAsSpreadsheet joinNames = map (accountCell :) accountCell = let name = render row in - setAccountAnchor (guard (rc==Value) >> balance_base_url_) name $ - cell name + setAccountAnchor (guard (rc==Value) >> balance_base_url_) + querystring_ name (cell name) -- tests From 67c8a6ece10053bb3c301b86e301db5ecdce0921 Mon Sep 17 00:00:00 2001 From: Henning Thielemann Date: Fri, 13 Sep 2024 18:54:53 +0200 Subject: [PATCH 4/5] doc: Commands/Balance.md: document hyperlinks and --base-url --- hledger/Hledger/Cli/Commands/Balance.md | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/hledger/Hledger/Cli/Commands/Balance.md b/hledger/Hledger/Cli/Commands/Balance.md index 147c5414800..509e825db17 100644 --- a/hledger/Hledger/Cli/Commands/Balance.md +++ b/hledger/Hledger/Cli/Commands/Balance.md @@ -385,6 +385,19 @@ $ hledger bal -% cur:\\$ $ hledger bal -% cur:€ ``` +### Hyperlinks + +The HTML and FODS output formats support hyperlinks to `hledger-web`'s +Register pages for every account and period. +E.g. if your `hledger-web` server is reachable +under the URL `http://localhost:5000/` +then you might run the `balance` command +with the extra option `--base-url=http://localhost:5000/`. +The export function will not add any slash +in order to support relative hyperreferences. +Thus it is important that you add the trailing slash to the URL yourselves, +where needed. + ### Multi-period balance report With a [report interval](#report-intervals) (set by the `-D/--daily`, From 35f27094818e61702c83ca8faec1dd85729dbb9b Mon Sep 17 00:00:00 2001 From: Henning Thielemann Date: Sat, 28 Sep 2024 20:54:46 +0200 Subject: [PATCH 5/5] cli: Commands.Balance.registerQueryUrl: correctly escape URL using modern-uri package --- hledger/Hledger/Cli/Commands/Balance.hs | 13 +++++++++++-- hledger/hledger.cabal | 1 + hledger/package.yaml | 1 + 3 files changed, 13 insertions(+), 2 deletions(-) diff --git a/hledger/Hledger/Cli/Commands/Balance.hs b/hledger/Hledger/Cli/Commands/Balance.hs index 6e0addd7674..00a0d9663a5 100644 --- a/hledger/Hledger/Cli/Commands/Balance.hs +++ b/hledger/Hledger/Cli/Commands/Balance.hs @@ -238,6 +238,7 @@ Currently, empty cells show 0. {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE QuasiQuotes #-} module Hledger.Cli.Commands.Balance ( -- ** balance command @@ -283,6 +284,8 @@ import Data.Time (addDays, fromGregorian) import System.Console.CmdArgs.Explicit as C (flagNone, flagReq, flagOpt) import Lucid as L hiding (value_) import Safe (headMay, maximumMay) +import qualified Text.URI as Uri +import qualified Text.URI.QQ as UriQQ import Text.Tabular.AsciiWide (Header(..), Align(..), Properties(..), Cell(..), Table(..), TableOpts(..), cellWidth, concatTables, renderColumns, renderRowB, renderTableByRowsB, textCell) @@ -586,8 +589,14 @@ headerCell text = registerQueryUrl :: [Text] -> Text registerQueryUrl query = - "register?q=" <> - T.intercalate "+" (map quoteIfSpaced $ filter (not . T.null) query) + Uri.render $ + [UriQQ.uri|register|] { + Uri.uriQuery = + [Uri.QueryParam [UriQQ.queryKey|q|] $ + fromMaybe (error "register URI query construction failed") $ + Uri.mkQueryValue $ T.unwords $ + map quoteIfSpaced $ filter (not . T.null) query] + } -- cf. Web.Widget.Common removeDates :: [Text] -> [Text] diff --git a/hledger/hledger.cabal b/hledger/hledger.cabal index 4c140b0c180..f0131020b37 100644 --- a/hledger/hledger.cabal +++ b/hledger/hledger.cabal @@ -172,6 +172,7 @@ library , math-functions >=0.3.3.0 , megaparsec >=7.0.0 && <9.7 , microlens >=0.4 + , modern-uri >=0.3 , mtl >=2.2.1 , process , regex-tdfa diff --git a/hledger/package.yaml b/hledger/package.yaml index 8613a893876..7c80d137871 100644 --- a/hledger/package.yaml +++ b/hledger/package.yaml @@ -205,6 +205,7 @@ library: - Diff >=0.2 - hashable >=1.2.4 - lucid + - modern-uri >=0.3 executables: hledger: