diff --git a/hledger-web/Hledger/Web/App.hs b/hledger-web/Hledger/Web/App.hs index e55162b52..2969966fb 100644 --- a/hledger-web/Hledger/Web/App.hs +++ b/hledger-web/Hledger/Web/App.hs @@ -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 diff --git a/hledger-web/Hledger/Web/Application.hs b/hledger-web/Hledger/Web/Application.hs index 9a0d7fe32..2d758f01e 100644 --- a/hledger-web/Hledger/Web/Application.hs +++ b/hledger-web/Hledger/Web/Application.hs @@ -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) diff --git a/hledger-web/Hledger/Web/Handler/BalanceR.hs b/hledger-web/Hledger/Web/Handler/BalanceR.hs new file mode 100644 index 000000000..937485a3f --- /dev/null +++ b/hledger-web/Hledger/Web/Handler/BalanceR.hs @@ -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 diff --git a/hledger-web/Hledger/Web/Handler/JournalR.hs b/hledger-web/Hledger/Web/Handler/JournalR.hs index c1d63e1c4..b29db163d 100644 --- a/hledger-web/Hledger/Web/Handler/JournalR.hs +++ b/hledger-web/Hledger/Web/Handler/JournalR.hs @@ -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) $ diff --git a/hledger-web/config/routes b/hledger-web/config/routes index 5640e409c..2f0eff245 100644 --- a/hledger-web/config/routes +++ b/hledger-web/config/routes @@ -5,6 +5,7 @@ / RootR GET /journal JournalR GET /register RegisterR GET +/balance BalanceR GET /add AddR GET POST PUT /manage ManageR GET diff --git a/hledger-web/hledger-web.cabal b/hledger-web/hledger-web.cabal index 876973912..b10ef7c3b 100644 --- a/hledger-web/hledger-web.cabal +++ b/hledger-web/hledger-web.cabal @@ -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 diff --git a/hledger-web/package.yaml b/hledger-web/package.yaml index c0baad255..6304d713d 100644 --- a/hledger-web/package.yaml +++ b/hledger-web/package.yaml @@ -123,6 +123,7 @@ library: - http-conduit - http-client - http-types + - lucid - megaparsec >=7.0.0 && <9.7 - mtl >=2.2.1 - network diff --git a/hledger-web/templates/default-layout.hamlet b/hledger-web/templates/default-layout.hamlet index 82c9db499..4d665c9a9 100644 --- a/hledger-web/templates/default-layout.hamlet +++ b/hledger-web/templates/default-layout.hamlet @@ -19,6 +19,8 @@ $if elem ViewPermission perms + $maybe period <- maybePeriod +
$if not (T.null qparam) diff --git a/hledger-web/templates/journal.hamlet b/hledger-web/templates/journal.hamlet index e3c1b61be..61bc28bd0 100644 --- a/hledger-web/templates/journal.hamlet +++ b/hledger-web/templates/journal.hamlet @@ -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 +

+ Report: + Balance + Yearly + Quarterly + Monthly + Weekly + Daily +