simonmichael/hledger
1
1
Fork 0
mirror of https://github.com/simonmichael/hledger.git synced 2024-10-04 01:50:50 +03:00
Code Issues Projects Releases Wiki Activity

Merge e9712fde15 into 5591be7724

Browse Source
This commit is contained in:
thielema 2024-10-01 10:41:47 +00:00 committed by GitHub
commit 2cc7e2a01b
No known key found for this signature in database
GPG Key ID: B5690EEEBB952194
10 changed files with 133 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
hledger-web/Hledger/Web/App.hs
View File

@ -144,6 +144,8 @@ instance Yesod App where
}
rspec' = rspec{_rsQuery=q,_rsReportOpts=ropts'}
maybePeriod <- lookupGetParam "period"
hideEmptyAccts <- if empty_ ropts
then return True
else (== Just "1") . lookup "hideemptyaccts" . reqCookies <$> getRequest

1
hledger-web/Hledger/Web/Application.hs
View File

@ -28,6 +28,7 @@ import Hledger.Web.Handler.EditR
import Hledger.Web.Handler.UploadR
import Hledger.Web.Handler.JournalR
import Hledger.Web.Handler.RegisterR
import Hledger.Web.Handler.BalanceR
import Hledger.Web.Import
import Hledger.Web.WebOptions (WebOpts(serve_,serve_api_), corsPolicy)

62
hledger-web/Hledger/Web/Handler/BalanceR.hs Normal file
View File

@ -0,0 +1,62 @@
-- | /balance handlers.
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
module Hledger.Web.Handler.BalanceR where
import Hledger
import Hledger.Cli.CliOptions
import Hledger.Write.Html.Blaze (printHtml)
import Hledger.Web.Import
import Hledger.Web.WebOptions
import qualified Hledger.Cli.Commands.Balance as Balance
import qualified Hledger.Query as Query
import Text.Megaparsec.Error (errorBundlePretty)
import qualified Text.Blaze.Html4.Strict as Blaze
import qualified Data.Text as Text
import qualified Yesod
-- | The balance or multi-period balance view, with sidebar.
getBalanceR :: Handler Html
getBalanceR = do
checkServerSideUiEnabled
VD{j, q, qparam, opts, today} <- getViewData
require ViewPermission
let title :: Text
title = "Balance Report" <> if q /= Any then ", filtered" else ""
rspecOrig = reportspec_ $ cliopts_ opts
ropts =
(_rsReportOpts rspecOrig) {
balance_base_url_ = Just "",
querystring_ = Query.words'' queryprefixes qparam
}
rspec =
rspecOrig {
_rsQuery = filterQuery (not . queryIsDepth) q,
_rsReportOpts = ropts
}
defaultLayout $ do
mperiod <- lookupGetParam "period"
case mperiod of
Nothing -> do
setTitle "balance - hledger-web"
Yesod.toWidget .
(Blaze.h2 (Blaze.toHtml title) >>) .
printHtml . map (map (fmap Blaze.toHtml)) .
Balance.balanceReportAsSpreadsheet ropts $
balanceReport rspec j
Just perStr -> do
setTitle "multibalance - hledger-web"
case parsePeriodExpr today perStr of
Left msg -> Yesod.toWidget $ Text.pack $ errorBundlePretty msg
Right (per_,_) ->
Yesod.toWidget .
(Blaze.h2 (Blaze.toHtml title) >>) .
printHtml . map (map (fmap Blaze.toHtml)) .
snd . Balance.multiBalanceReportAsSpreadsheet ropts $
let rspec' = rspec{_rsReportOpts = ropts{interval_ = per_}} in
multiBalanceReport rspec' j

5
hledger-web/Hledger/Web/Handler/JournalR.hs
View File

@ -16,6 +16,8 @@ import Hledger.Web.Widget.Common
(accountQuery, mixedAmountAsHtml,
transactionFragment, replaceInacct)
import qualified Data.Text as Text
-- | The formatted journal view, with sidebar.
getJournalR :: Handler Html
getJournalR = do
@ -27,6 +29,9 @@ getJournalR = do
Just (a, inclsubs) -> "Transactions in " <> a <> if inclsubs then "" else " (excluding subaccounts)"
title' = title <> if q /= Any then ", filtered" else ""
acctlink a = (RegisterR, [("q", replaceInacct qparam $ accountQuery a)])
qparamOpt = if Text.null qparam then [] else [("q",qparam)]
ballink = (BalanceR, qparamOpt)
multiballink per_ = (BalanceR, ("period",per_) : qparamOpt)
rspec = (reportspec_ $ cliopts_ opts){_rsQuery = filterQuery (not . queryIsDepth) q}
items = reverse $
styleAmounts (journalCommodityStylesWith HardRounding j) $

1
hledger-web/config/routes
View File

@ -5,6 +5,7 @@
/ RootR GET
/journal JournalR GET
/register RegisterR GET
/balance BalanceR GET
/add AddR GET POST PUT
/manage ManageR GET

2
hledger-web/hledger-web.cabal
View File

@ -143,6 +143,7 @@ library
other-modules:
Hledger.Web.App
Hledger.Web.Handler.AddR
Hledger.Web.Handler.BalanceR
Hledger.Web.Handler.EditR
Hledger.Web.Handler.JournalR
Hledger.Web.Handler.MiscR
@ -184,6 +185,7 @@ library
, http-client
, http-conduit
, http-types
, lucid
, megaparsec >=7.0.0 && <9.7
, mtl >=2.2.1
, network

1
hledger-web/package.yaml
View File

@ -123,6 +123,7 @@ library:
- http-conduit
- http-client
- http-types
- lucid
- megaparsec >=7.0.0 && <9.7
- mtl >=2.2.1
- network

2
hledger-web/templates/default-layout.hamlet
View File

@ -19,6 +19,8 @@ $if elem ViewPermission perms
<form#searchform.input-group method=GET>
<input .form-control name=q value=#{qparam} placeholder="Search"
title="Enter hledger search patterns to filter the data below">
$maybe period <- maybePeriod
<input hidden name=period value=#{period}>
<div .input-group-btn>
$if not (T.null qparam)
<a href=@{here} .btn .btn-default title="Clear search terms">

14
hledger-web/templates/journal.hamlet
View File

@ -6,6 +6,20 @@ $if elem AddPermission perms
data-toggle="modal" data-target="#addmodal" title="Add a new transaction to the journal">
Add a transaction
<p>
Report:
<a href=@?{ballink} title="Show balance report">Balance
<a href=@?{multiballink "yearly"}
title="Show daily multi-period balance report">Yearly
<a href=@?{multiballink "quarterly"}
title="Show daily multi-period balance report">Quarterly
<a href=@?{multiballink "monthly"}
title="Show daily multi-period balance report">Monthly
<a href=@?{multiballink "weekly"}
title="Show daily multi-period balance report">Weekly
<a href=@?{multiballink "daily"}
title="Show daily multi-period balance report">Daily
<div .table-responsive>
<table .transactionsreport .table .table-condensed>
<thead>

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

@ -692,9 +692,10 @@ balanceReportAsSpreadsheet ::
balanceReportAsSpreadsheet opts (items, total) =
(if transpose_ opts then Ods.transpose else id) $
headers :
concatMap (\(a, _, _, b) -> rows Value a b) items ++
concatMap (rows Value) items ++
if no_total_ opts then []
else addTotalBorders $ rows Total totalRowHeadingSpreadsheet total
else addTotalBorders $
rows Total (totalRowHeadingSpreadsheet, totalRowHeadingSpreadsheet, 0, total)
where
cell = Ods.defaultCell
headers =
@ -703,14 +704,14 @@ balanceReportAsSpreadsheet opts (items, total) =
LayoutBare -> ["commodity", "balance"]
_ -> ["balance"]
rows ::
RowClass -> AccountName ->
MixedAmount -> [[Ods.Cell Ods.NumLines Text]]
rows rc name ma =
RowClass -> BalanceReportItem ->
[[Ods.Cell Ods.NumLines Text]]
rows rc (name, dispName, dep, ma) =
let accountCell =
setAccountAnchor
(guard (rc==Value) >> balance_base_url_ opts)
(querystring_ opts) name $
cell $ accountNameDrop (drop_ opts) name in
cell $ renderBalanceAcct opts nbsp (name, dispName, dep) in
addRowSpanHeader accountCell $
case layout_ opts of
LayoutBare ->
@ -807,7 +808,7 @@ multiBalanceReportAsSpreadsheetHelper ishtml opts@ReportOpts{..} (PeriodicReport
where acctName = prrFullName row
anchorCell =
setAccountAnchor balance_base_url_ querystring_ acctName $
accountCell $ accountNameDrop drop_ acctName
accountCell $ renderPeriodicAcct opts nbsp row
totalrows =
if no_total_
then []
@ -1052,7 +1053,7 @@ budgetReportAsText ropts@ReportOpts{..} budgetr = TB.toLazyText $
-- | Build a 'Table' from a multi-column balance report.
budgetReportAsTable :: ReportOpts -> BudgetReport -> Table Text Text WideBuilder
budgetReportAsTable ReportOpts{..} (PeriodicReport spans items totrow) =
budgetReportAsTable ropts@ReportOpts{..} (PeriodicReport spans items totrow) =
maybetransposetable $
addtotalrow $
Table
@ -1158,17 +1159,10 @@ budgetReportAsTable ReportOpts{..} (PeriodicReport spans items totrow) =
shownitems =
map (\i ->
let
addacctcolumn = map (\(cs, cvals) -> (renderacct i, cs, cvals))
addacctcolumn = map (\(cs, cvals) -> (renderPeriodicAcct ropts " " i, cs, cvals))
isunbudgetedrow = displayFull (prrName i) == unbudgetedAccountName
in addacctcolumn $ showrow isunbudgetedrow $ rowToBudgetCells i)
items
where
-- FIXME. Have to check explicitly for which to render here, since
-- budgetReport sets accountlistmode to ALTree. Find a principled way to do
-- this.
renderacct row = case accountlistmode_ of
ALTree -> T.replicate ((prrDepth row - 1)*2) " " <> prrDisplayName row
ALFlat -> accountNameDrop (drop_) $ prrFullName row
(totrowcs, totrowtexts) = unzip $ concat showntotrow
where
@ -1277,7 +1271,7 @@ budgetReportAsCsv ropts report
budgetReportAsSpreadsheet ::
ReportOpts -> BudgetReport -> [[Ods.Cell Ods.NumLines Text]]
budgetReportAsSpreadsheet
ReportOpts{..}
ropts@ReportOpts{..}
(PeriodicReport colspans items totrow)
= (if transpose_ then Ods.transpose else id) $
@ -1291,14 +1285,18 @@ budgetReportAsSpreadsheet
) :
-- account rows
concatMap (rowAsTexts Value prrFullName) items
concatMap (\row -> rowAsTexts Value (accountCell row) row) items
-- totals row
++ addTotalBorders
(concat [ rowAsTexts Total (const totalRowHeadingBudgetCsv) totrow | not no_total_ ])
(concat [ rowAsTexts Total (cell totalRowHeadingBudgetCsv) totrow | not no_total_ ])
where
cell = Ods.defaultCell
accountCell row =
let name = prrFullName row in
setAccountAnchor (balance_base_url_) querystring_ name $
cell $ renderPeriodicAcct ropts nbsp row
{-
ToDo: The chosen HTML cell class names are not put in stone.
If you find you need more systematic names,
@ -1310,16 +1308,18 @@ budgetReportAsSpreadsheet
maybe Ods.emptyCell (fmap wbToText . curry (cellFromMixedAmount oneLineNoCostFmt) cls) mval
rowAsTexts :: RowClass
-> (PeriodicReportRow a BudgetCell -> Text)
-> Ods.Cell Ods.NumLines Text
-> PeriodicReportRow a BudgetCell
-> [[Ods.Cell Ods.NumLines Text]]
rowAsTexts rc render row@(PeriodicReportRow _ as (rowtot,budgettot) (rowavg, budgetavg))
| layout_ /= LayoutBare = [accountCell : map showNorm vals]
| otherwise =
joinNames . zipWith (:) (map cell cs) -- add symbols and names
rowAsTexts rc acctCell (PeriodicReportRow _ as (rowtot,budgettot) (rowavg, budgetavg)) =
addRowSpanHeader acctCell $
case layout_ of
LayoutBare ->
zipWith (:) (map cell cs) -- add symbols
. transpose -- each row becomes a list of Text quantities
. map (map (fmap wbToText) . cellsFromMixedAmount dopts . second (fromMaybe nullmixedamt))
$ vals
_ -> [map showNorm vals]
where
cs = S.toList . mconcat . map maCommodities $ mapMaybe snd vals
dopts = oneLineNoCostFmt{displayCommodity=layout_ /= LayoutBare, displayCommodityOrder=Just cs, displayMinWidth=Nothing}
@ -1331,11 +1331,25 @@ budgetReportAsSpreadsheet
(budgetAverageClass rc, budgetavg)]
| average_]
joinNames = map (accountCell :)
accountCell =
let name = render row in
setAccountAnchor (guard (rc==Value) >> balance_base_url_)
querystring_ name (cell name)
nbsp :: Text
nbsp = "\160"
renderBalanceAcct ::
ReportOpts -> Text -> (AccountName, AccountName, Int) -> Text
renderBalanceAcct opts space (fullName, displayName, dep) =
case accountlistmode_ opts of
ALTree -> T.replicate ((dep - 1)*2) space <> displayName
ALFlat -> accountNameDrop (drop_ opts) fullName
-- FIXME. Have to check explicitly for which to render here, since
-- budgetReport sets accountlistmode to ALTree. Find a principled way to do
-- this.
renderPeriodicAcct ::
ReportOpts -> Text -> PeriodicReportRow DisplayName a -> Text
renderPeriodicAcct opts space row =
renderBalanceAcct opts space
(prrFullName row, prrDisplayName row, prrDepth row)
-- tests