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.
This commit is contained in:
Henning Thielemann
Simon Michael
parent
8744a0687c
commit
499c626e48
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -314,9 +314,16 @@ formatCell cell =
|
||||
(cellContent cell)
|
||||
_ -> "office:value-type='string'"
|
||||
|
||||
anchor text =
|
||||
if T.null $ Spr.cellAnchor cell
|
||||
then text
|
||||
else printf "<text:a xlink:href='%s'>%s</text:a>"
|
||||
(escape $ T.unpack $ Spr.cellAnchor cell) text
|
||||
|
||||
in
|
||||
printf "<table:table-cell%s %s>" style valueType :
|
||||
printf "<text:p>%s</text:p>" (escape $ T.unpack $ cellContent cell) :
|
||||
printf "<text:p>%s</text:p>"
|
||||
(anchor $ escape $ T.unpack $ cellContent cell) :
|
||||
"</table:table-cell>" :
|
||||
[]
|
||||
|
||||
|
||||
@ -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
|
||||
}
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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"
|
||||
|
||||
Loading…
Reference in New Issue
Block a user