mirror of
https://github.com/simonmichael/hledger.git
synced 2024-10-06 19:07:27 +03:00
web: Handler.BalanceR: new handler that serves balance and multi-period balance reports as HTML pages
Journal page contains links to those reports.
This commit is contained in:
parent
110b63161f
commit
80af57a902
@ -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
|
||||
|
@ -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
62
hledger-web/Hledger/Web/Handler/BalanceR.hs
Normal 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
|
@ -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) $
|
||||
|
@ -5,6 +5,7 @@
|
||||
/ RootR GET
|
||||
/journal JournalR GET
|
||||
/register RegisterR GET
|
||||
/balance BalanceR GET
|
||||
/add AddR GET POST PUT
|
||||
|
||||
/manage ManageR GET
|
||||
|
@ -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
|
||||
|
@ -123,6 +123,7 @@ library:
|
||||
- http-conduit
|
||||
- http-client
|
||||
- http-types
|
||||
- lucid
|
||||
- megaparsec >=7.0.0 && <9.7
|
||||
- mtl >=2.2.1
|
||||
- network
|
||||
|
@ -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">
|
||||
|
@ -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>
|
||||
|
Loading…
Reference in New Issue
Block a user