web: Handler.BalanceR: new handler that serves balance and multi-peri…

…od balance reports as HTML pages

Journal page contains links to those reports.

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

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)
 

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

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) $

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

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

hledger-web/package.yaml

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

hledger-web/templates/default-layout.hamlet

@@ -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">

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
 
+<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>