web: balance sheet, income statement, and cashflow pages, and one linking scheme

hledger-lib/Hledger/Data/Dates.hs

@@ -46,6 +46,7 @@ module Hledger.Data.Dates (
   showDateSpanAbbrev,
   showDateSpanAbbrevWith,
   showDateSpanFull,
+  showDateSpanForQuery,
   elapsedSeconds,
   prevday,
   periodexprp,
@@ -170,6 +171,38 @@ showDateSpanFull (DateSpan mb me) =
     start = maybe "" (formatTime defaultTimeLocale "%F" . fromEFDay) mb
     end   = maybe "" (formatTime defaultTimeLocale "%F" . addDays (-1) . fromEFDay) me
 
+-- | Render a datespan as a period expression that parses back to the
+-- same span, for a date: query term or a period parameter. Standard
+-- calendar periods take their compact form (2025, 2025Q1, 2025-01,
+-- 2025-01-15); any other span is written out with its exclusive end
+-- date, which is how the period expression syntax reads one
+-- (2025-01-13..2025-01-20); open ends stay open (2025-01-01..,
+-- ..2025-02-01); the unbounded span is "".
+--
+-- 'showDateSpan' is for display: it prints inclusive end dates and ISO
+-- week names, which a query would read as a day short or not at all.
+--
+-- >>> showDateSpanForQuery $ DateSpan (Just $ Exact $ fromGregorian 2025 1 1) (Just $ Exact $ fromGregorian 2026 1 1)
+-- "2025"
+-- >>> showDateSpanForQuery $ DateSpan (Just $ Exact $ fromGregorian 2025 1 13) (Just $ Exact $ fromGregorian 2025 1 20)
+-- "2025-01-13..2025-01-20"
+-- >>> showDateSpanForQuery $ DateSpan (Just $ Exact $ fromGregorian 2025 1 15) (Just $ Exact $ fromGregorian 2025 2 15)
+-- "2025-01-15..2025-02-15"
+-- >>> showDateSpanForQuery $ DateSpan (Just $ Exact $ fromGregorian 2025 1 1) Nothing
+-- "2025-01-01.."
+-- >>> showDateSpanForQuery $ DateSpan Nothing (Just $ Exact $ fromGregorian 2025 2 1)
+-- "..2025-02-01"
+-- >>> showDateSpanForQuery nulldatespan
+-- ""
+showDateSpanForQuery :: DateSpan -> Text
+showDateSpanForQuery spn = case dateSpanAsPeriod spn of
+  WeekPeriod b      -> T.pack $ iso b <> ".." <> iso (addDays 7 b)
+  PeriodBetween b e -> T.pack $ iso b <> ".." <> iso e
+  PeriodTo e        -> T.pack $ ".." <> iso e
+  PeriodAll         -> ""
+  p                 -> showPeriod p  -- a day, month, quarter, or year, or an open end
+  where iso = formatTime defaultTimeLocale "%F"
+
 -- | Get the current local date.
 getCurrentDay :: IO Day
 getCurrentDay = localDay . zonedTimeToLocalTime <$> getZonedTime

hledger-lib/Hledger/Reports/AccountTransactionsReport.hs

@@ -10,8 +10,10 @@ module Hledger.Reports.AccountTransactionsReport (
   AccountTransactionsReport,
   AccountTransactionsReportItem,
   accountTransactionsReport,
+  accountTransactionsReportWithStart,
   accountTransactionsReportItems,
   transactionRegisterDate,
+  transactionRegisterDateExtra,
   triOrigTransaction,
   triDate,
   triAmount,
@@ -23,12 +25,13 @@ module Hledger.Reports.AccountTransactionsReport (
 )
 where
 
+import Data.Foldable (asum)
 import Data.List (mapAccumR, nub, partition, sortBy)
 import Data.List.Extra (nubSort)
-import Data.Maybe (catMaybes)
+import Data.Maybe (catMaybes, fromMaybe)
 import Data.Ord (Down(..), comparing)
 import Data.Text qualified as T
-import Data.Time.Calendar (Day)
+import Data.Time.Calendar (Day, fromGregorian)
 
 import Hledger.Data
 import Hledger.Query
@@ -99,7 +102,15 @@ triCommodityAmount c = filterMixedAmountByCommodity c  . triAmount
 triCommodityBalance c = filterMixedAmountByCommodity c  . triBalance
 
 accountTransactionsReport :: ReportSpec -> Journal -> Query -> AccountTransactionsReport
-accountTransactionsReport rspec@ReportSpec{_rsReportOpts=ropts} j thisacctq = items
+accountTransactionsReport rspec j = snd . accountTransactionsReportWithStart rspec j
+
+-- | The account transactions report, and the balance its running total
+-- starts from: zero, or, with historical balances and a start date in
+-- the query, the sum of the account's postings before that date (with
+-- --average, their average per transaction). A register can show the
+-- latter as a balance brought forward.
+accountTransactionsReportWithStart :: ReportSpec -> Journal -> Query -> (MixedAmount, AccountTransactionsReport)
+accountTransactionsReportWithStart rspec@ReportSpec{_rsReportOpts=ropts} j thisacctq = (startbal, items)
   where
     -- A depth limit should not affect the account transactions report; it should show all transactions in/below this account.
     -- Queries on currency or amount are also ignored at this stage; they are handled earlier, before valuation.
@@ -157,19 +168,23 @@ accountTransactionsReport rspec@ReportSpec{_rsReportOpts=ropts} j thisacctq = it
         numpriorts = length priorpss
         priorsum = sumPostings $ concat priorpss
         priorq = dbg5 "priorq" $ And [thisacctq, tostartdateq, datelessreportq]
-        tostartdateq =
-          case mstartdate of
-            Just _  -> Date (DateSpan Nothing (Exact <$> mstartdate))
-            Nothing -> None  -- no start date specified, there are no prior postings
-        mstartdate = queryStartDate (date2_ ropts) reportq
+        -- The postings before the report start, by whichever kind of date
+        -- the query's start date is: the report's kind if it has one,
+        -- else the other, so that a date2: term selects the prior postings
+        -- by secondary date as it selects the report's postings.
+        -- With no start date, there are no prior postings.
+        tostartdateq = fromMaybe None $ asum [cutoff (date2_ ropts), cutoff (not $ date2_ ropts)]
+        cutoff secondary =
+          (if secondary then Date2 else Date) . DateSpan Nothing . Just . Exact
+            <$> queryStartDate secondary reportq
         datelessreportq = filterQuery (not . queryIsDateOrDate2) reportq
 
     items =
         accountTransactionsReportItems reportq thisacctq (registerRunningCalculationFn ropts) startnum startbal maNegate (journalAccountType j)
       -- sort by the transaction's register date, then index, for accurate starting balance
       . dbg5With (("ts4:\n"++).pshowTransactions.map snd)
       . sortBy (comparing (Down . fst) <> comparing (Down . tindex . snd))
-      . map (\t -> (transactionRegisterDate wd reportq thisacctq t, t))
+      . map (\t -> (transactionRegisterDateExtra (journalAccountType j) wd reportq thisacctq t, t))
       . map (if invert_ ropts then (\t -> t{tpostings = map postingNegateMainAmount $ tpostings t}) else id)
       $ jtxns acctJournal
 
@@ -227,11 +242,17 @@ accountTransactionsReportItem reportq thisacctq runningcalc signfn accttypefn (i
 -- - the transaction date, or its secondary date if --date2 was used.
 --
 transactionRegisterDate :: WhichDate -> Query -> Query -> Transaction -> Day
-transactionRegisterDate wd reportq thisacctq t
+transactionRegisterDate = transactionRegisterDateExtra (const Nothing)
+
+-- | Like 'transactionRegisterDate', but given the accounts' types, so
+-- that a type: term in the report query matches postings here as it
+-- does in the report itself.
+transactionRegisterDateExtra :: (AccountName -> Maybe AccountType) -> WhichDate -> Query -> Query -> Transaction -> Day
+transactionRegisterDateExtra accttypefn wd reportq thisacctq t
   | not $ null thisacctps = minimum $ map (postingDateOrDate2 wd) thisacctps
   | otherwise             = transactionDateOrDate2 wd t
   where
-    reportps   = tpostings $ filterTransactionPostings reportq t
+    reportps   = tpostings $ filterTransactionPostingsExtra accttypefn reportq t
     thisacctps = filter (matchesPosting thisacctq) reportps
 
 -- -- | Generate a short readable summary of some postings, like
@@ -290,4 +311,30 @@ filterAccountTransactionsReportByCommodity comm =
 -- tests
 
 tests_AccountTransactionsReport = testGroup "AccountTransactionsReport" [
+  testCase "accountTransactionsReportWithStart" $ do
+    let checking = Acct $ toRegex' "assets:bank:checking"
+        fromJune = Date $ DateSpan (Just $ Exact $ fromGregorian 2008 6 1) Nothing
+        rspec accum = defreportspec{_rsQuery=fromJune, _rsReportOpts=defreportopts{balanceaccum_=accum}}
+        (histstart, histitems) = accountTransactionsReportWithStart (rspec Historical) samplejournal checking
+        (start, items) = accountTransactionsReportWithStart (rspec PerPeriod) samplejournal checking
+    -- with historical balances, the running balance starts from the postings before the start date
+    showMixedAmount histstart @?= "$1.00"
+    map (showMixedAmount . triBalance) histitems @?= ["$1.00", "$2.00", "$1.00", "$2.00"]
+    -- otherwise from zero
+    showMixedAmount start @?= "0"
+    map (showMixedAmount . triBalance) items @?= ["0", "$1.00", "0", "$1.00"]
+    -- a date2: start date counts too, by secondary date (here the same days)
+    let fromJune2 = Date2 $ DateSpan (Just $ Exact $ fromGregorian 2008 6 1) Nothing
+        (histstart2, _) = accountTransactionsReportWithStart (rspec Historical){_rsQuery=fromJune2} samplejournal checking
+    showMixedAmount histstart2 @?= "$1.00"
+
+ ,testCase "transactionRegisterDateExtra" $ do
+    let t = nulltransaction{tdate=fromGregorian 2008 1 1, tpostings=[
+              ("assets:bank:checking" `post` usd 1){pdate=Just $ fromGregorian 2008 1 5}
+             ,"income:salary" `post` usd (-1)]}
+        checking = Acct $ toRegex' "assets:bank:checking"
+        assettypes a = if "assets" `T.isPrefixOf` a then Just Asset else Nothing
+    -- a type: term in the report query matches the posting only when the account types are known
+    transactionRegisterDate PrimaryDate (Type [Asset]) checking t @?= fromGregorian 2008 1 1
+    transactionRegisterDateExtra assettypes PrimaryDate (Type [Asset]) checking t @?= fromGregorian 2008 1 5
  ]

hledger-lib/Hledger/Write/Html.hs

@@ -4,7 +4,7 @@ hledger-web's pages are made of.
 
 They render "Hledger.Write.Spreadsheet" tables as HTML tables: the CLI's
 @-O html@ output uses 'styledTableHtml' and 'titledTableHtml', and
-hledger-web's report pages use 'formatRow' inside their own table markup.
+hledger-web's report pages use 'formatCell' inside their own table markup.
 blaze's text renderer writes everything on one line, so for human readability
 we inject raw newlines between elements (see 'nl').
 -}
@@ -97,7 +97,10 @@ formatCell cell =
     let content =
             if Text.null $ cellAnchor cell
                 then str
-                else (H.a ! A.href (H.textValue $ cellAnchor cell)) str in
+                else foldl (!) H.a
+                        (A.href (H.textValue $ cellAnchor cell) :
+                         [A.title (H.textValue $ cellTitle cell) | not $ Text.null $ cellTitle cell])
+                        str in
     -- Mark date cells with a "date" class, so eg wrapping within dates
     -- can be prevented with css; borders are classes too.
     let class_ =
@@ -190,6 +193,10 @@ tests_Hledger_Write_Html = testGroup "Write.Html" [
       @?= "<td align=\"right\"><span class=\"amount\">$1</span>, <span class=\"amount\">2 €</span></td>"
     -- links, totals, borders
     cell (str "a") {cellAnchor = "register?q=a&b"} @?= "<td><a href=\"register?q=a&amp;b\">a</a></td>"
+    cell (str "a") {cellAnchor = "register?q=a", cellTitle = "Show \"a\""}
+      @?= "<td><a href=\"register?q=a\" title=\"Show &quot;a&quot;\">a</a></td>"
+    -- a title without an anchor has nothing to describe
+    cell (str "a") {cellTitle = "t"} @?= "<td>a</td>"
     cell (str "Total:") {cellStyle = Body Total, cellBorder = Spr.noBorder {Spr.borderTop = Spr.DoubleLine}}
       @?= "<td class=\"border-top-double\"><b>Total:</b></td>"
     cell (Spr.headerCell "h" :: Cell Spr.NumLines Text) {cellClass = Spr.Class "account", cellBorder = Spr.noBorder {Spr.borderBottom = Spr.SingleLine}}

hledger-lib/Hledger/Write/Spreadsheet.hs

@@ -149,6 +149,10 @@ data Cell border text =
         cellStyle :: Style,
         cellSpan :: Span,
         cellAnchor :: Text,
+        -- | A whole-phrase description of where 'cellAnchor' leads, for
+        -- writers that can attach one to a link (HTML's title attribute).
+        -- Ignored when there is no anchor.
+        cellTitle :: Text,
         cellClass :: Class,
         -- | The cell content split into parts to be joined with ", ":
         -- individual amounts of a multi-commodity amount, for writers
@@ -159,8 +163,8 @@ data Cell border text =
     }
 
 instance Functor (Cell border) where
-    fmap f (Cell typ border style span anchor class_ parts content) =
-        Cell typ border style span anchor class_ (map f parts) (f content)
+    fmap f (Cell typ border style span anchor title class_ parts content) =
+        Cell typ border style span anchor title class_ (map f parts) (f content)
 
 defaultCell :: (Lines border) => text -> Cell border text
 defaultCell text =
@@ -170,6 +174,7 @@ defaultCell text =
         cellStyle = Body Item,
         cellSpan = NoSpan,
         cellAnchor = mempty,
+        cellTitle = mempty,
         cellClass = Class mempty,
         cellParts = [],
         cellContent = text