Merge branch 'master' into fix-matchgroups

Author: simonmichael

Justfile

@@ -1,5 +1,5 @@
 #!/usr/bin/env stack
-{- stack script --resolver nightly-2023-10-13 --compile
+{- stack script --resolver nightly-2024-02-28 --compile
    --extra-include-dirs /Library/Developer/CommandLineTools/SDKs/MacOSX12.1.sdk/usr/include/ffi
    --package base-prelude
    --package directory

Shake.hs

@@ -97,7 +97,7 @@ module Hledger.Data.Amount (
   amountSetPrecisionMax,
   withPrecision,
   amountSetFullPrecision,
-  amountSetFullPrecisionOr,
+  amountSetFullPrecisionUpTo,
   amountInternalPrecision,
   amountDisplayPrecision,
   defaultMaxPrecision,
@@ -159,6 +159,7 @@ module Hledger.Data.Amount (
   wbUnpack,
   mixedAmountSetPrecision,
   mixedAmountSetFullPrecision,
+  mixedAmountSetFullPrecisionUpTo,
   mixedAmountSetPrecisionMin,
   mixedAmountSetPrecisionMax,
 
@@ -453,24 +454,26 @@ amountSetFullPrecision a = amountSetPrecision p a
 
 
 -- | We often want to display "infinite decimal" amounts rounded to some readable
--- number of digits, while still displaying amounts with a large "non infinite" number
--- of decimal digits (eg, 100 or 200 digits) in full.
+-- number of digits, while still displaying amounts with a large but "non infinite"
+-- number of decimal digits (eg 10 or 100 or 200 digits) in full.
 -- This helper is like amountSetFullPrecision, but with some refinements:
--- 1. If the internal precision is the maximum (255), indicating an infinite decimal, 
--- the display precision is set to a smaller hard-coded default (8).
--- 2. A maximum display precision can be specified, setting a hard upper limit.
+--
+-- 1. A maximum display precision can be specified, setting a hard upper limit.
+--
+-- 2. If no limit is specified, and the internal precision is the maximum (255),
+-- indicating an infinite decimal, display precision is set to a smaller default (8).
+--
 -- This function always sets an explicit display precision (ie, Precision n).
-amountSetFullPrecisionOr :: Maybe Word8 -> Amount -> Amount
-amountSetFullPrecisionOr mmaxp a = amountSetPrecision (Precision p2) a
+--
+amountSetFullPrecisionUpTo :: Maybe Word8 -> Amount -> Amount
+amountSetFullPrecisionUpTo mmaxp a = amountSetPrecision (Precision p) a
   where
-    p1 = if -- dbg0 "maxdigits" $
-            amountHasMaxDigits a then defaultMaxPrecision else max disp intp
-      -- & dbg0 "p1"
+    p = case mmaxp of
+      Just maxp -> min maxp $ max disp intp
+      Nothing   -> if amountHasMaxDigits a then defaultMaxPrecision else max disp intp
       where
-        intp = amountInternalPrecision a
         disp = amountDisplayPrecision a
-    p2 = maybe p1 (min p1) mmaxp
-      -- & dbg0 "p2"
+        intp = amountInternalPrecision a
 
 -- | The fallback display precision used when showing amounts
 -- representing an infinite decimal.
@@ -1228,6 +1231,14 @@ mixedAmountSetPrecision p = mapMixedAmountUnsafe (amountSetPrecision p)
 mixedAmountSetFullPrecision :: MixedAmount -> MixedAmount
 mixedAmountSetFullPrecision = mapMixedAmountUnsafe amountSetFullPrecision
 
+-- | In each component amount, increase the display precision sufficiently
+-- to render it exactly if possible, but not more than the given max precision,
+-- and if no max precision is given and the amount has infinite decimals,
+-- limit display precision to a hard-coded smaller number (8).
+-- See amountSetFullPrecisionUpTo.
+mixedAmountSetFullPrecisionUpTo :: Maybe Word8 -> MixedAmount -> MixedAmount
+mixedAmountSetFullPrecisionUpTo mmaxp = mapMixedAmountUnsafe (amountSetFullPrecisionUpTo mmaxp)
+
 -- | In each component amount, ensure the display precision is at least the given value.
 -- Makes all amounts have an explicit Precision.
 mixedAmountSetPrecisionMin :: Word8 -> MixedAmount -> MixedAmount

hledger-lib/Hledger/Data/Amount.hs

@@ -131,11 +131,17 @@ transactionCheckBalanced BalancingOpts{commodity_styles_} t = errs
         rmsg
           | rsumok        = ""
           | not rsignsok  = "The real postings all have the same sign. Consider negating some of them."
-          | otherwise     = "The real postings' sum should be 0 but is: " ++ showMixedAmountOneLineWithoutCost False rsumcost
+          | otherwise     = "The real postings' sum should be 0 but is: " ++
+              (showMixedAmountWith oneLineNoCostFmt{displayCost=True, displayZeroCommodity=True} $
+              mixedAmountSetFullPrecisionUpTo Nothing $ mixedAmountSetFullPrecision
+              rsumcost)
         bvmsg
           | bvsumok       = ""
           | not bvsignsok = "The balanced virtual postings all have the same sign. Consider negating some of them."
-          | otherwise     = "The balanced virtual postings' sum should be 0 but is: " ++ showMixedAmountOneLineWithoutCost False bvsumcost
+          | otherwise     = "The balanced virtual postings' sum should be 0 but is: " ++
+              (showMixedAmountWith oneLineNoCostFmt{displayCost=True, displayZeroCommodity=True} $
+              mixedAmountSetFullPrecisionUpTo Nothing $ mixedAmountSetFullPrecision
+              bvsumcost)
 
 -- | Legacy form of transactionCheckBalanced.
 isTransactionBalanced :: BalancingOpts -> Transaction -> Bool

hledger-lib/Hledger/Data/Balancing.hs

@@ -63,6 +63,7 @@ module Hledger.Data.Dates (
   spanIntersect,
   spansIntersect,
   spanDefaultsFrom,
+  spanExtend,
   spanUnion,
   spansUnion,
   daysSpan,
@@ -314,8 +315,8 @@ groupByDateSpan showempty date colspans =
   where
     groupByCols []     _  = []
     groupByCols (c:cs) [] = if showempty then (c, []) : groupByCols cs [] else []
-    groupByCols (c:cs) ps = (c, map snd matches) : groupByCols cs later
-      where (matches, later) = span ((spanEnd c >) . Just . fst) ps
+    groupByCols (c:cs) ps = (c, map snd colps) : groupByCols cs laterps
+      where (colps, laterps) = span ((spanEnd c >) . Just . fst) ps
 
     beforeStart = maybe (const False) (>) $ spanStart =<< headMay colspans
 
@@ -324,40 +325,82 @@ spansIntersect [] = nulldatespan
 spansIntersect [d] = d
 spansIntersect (d:ds) = d `spanIntersect` (spansIntersect ds)
 
+-- | Calculate the union of a number of datespans.
+spansUnion [] = nulldatespan
+spansUnion [d] = d
+spansUnion (d:ds) = d `spanUnion` (spansUnion ds)
+
 -- | Calculate the intersection of two datespans.
 --
 -- For non-intersecting spans, gives an empty span beginning on the second's start date:
 -- >>> DateSpan (Just $ Flex $ fromGregorian 2018 01 01) (Just $ Flex $ fromGregorian 2018 01 03) `spanIntersect` DateSpan (Just $ Flex $ fromGregorian 2018 01 03) (Just $ Flex $ fromGregorian 2018 01 05)
 -- DateSpan 2018-01-03..2018-01-02
-spanIntersect (DateSpan b1 e1) (DateSpan b2 e2) = DateSpan b e
-    where
-      b = latest b1 b2
-      e = earliest e1 e2
+spanIntersect (DateSpan b1 e1) (DateSpan b2 e2) = DateSpan (laterDefinite b1 b2) (earlierDefinite e1 e2)
 
 -- | Fill any unspecified dates in the first span with the dates from
--- the second one. Sort of a one-way spanIntersect.
+-- the second one (if specified there). Sort of a one-way spanIntersect.
 spanDefaultsFrom (DateSpan a1 b1) (DateSpan a2 b2) = DateSpan a b
     where a = if isJust a1 then a1 else a2
           b = if isJust b1 then b1 else b2
 
--- | Calculate the union of a number of datespans.
-spansUnion [] = nulldatespan
-spansUnion [d] = d
-spansUnion (d:ds) = d `spanUnion` (spansUnion ds)
-
 -- | Calculate the union of two datespans.
-spanUnion (DateSpan b1 e1) (DateSpan b2 e2) = DateSpan b e
-    where
-      b = earliest b1 b2
-      e = latest e1 e2
-
-latest d Nothing = d
-latest Nothing d = d
-latest (Just d1) (Just d2) = Just $ max d1 d2
-
-earliest d Nothing = d
-earliest Nothing d = d
-earliest (Just d1) (Just d2) = Just $ min d1 d2
+-- If either span is open-ended, the union will be too.
+--
+-- >>> ys2024 = fromGregorian 2024 01 01
+-- >>> ys2025 = fromGregorian 2025 01 01
+-- >>> to2024 = DateSpan Nothing               (Just $ Exact ys2024)
+-- >>> in2024 = DateSpan (Just $ Exact ys2024) (Just $ Exact ys2025)
+-- >>> spanUnion to2024 in2024
+-- DateSpan ..2024-12-31
+-- >>> spanUnion in2024 to2024
+-- DateSpan ..2024-12-31
+spanUnion (DateSpan b1 e1) (DateSpan b2 e2) = DateSpan (earlier b1 b2) (later e1 e2)
+
+-- | Extend the first span to include any definite end dates of the second.
+-- Unlike spanUnion, open ends in the second are ignored.
+-- If the first span was open-ended, it still will be after being extended.
+--
+-- >>> ys2024 = fromGregorian 2024 01 01
+-- >>> ys2025 = fromGregorian 2025 01 01
+-- >>> to2024 = DateSpan Nothing               (Just $ Exact ys2024)
+-- >>> all2024 = DateSpan (Just $ Exact ys2024) (Just $ Exact ys2025)
+-- >>> partof2024 = DateSpan (Just $ Exact $ fromGregorian 2024 03 01) (Just $ Exact $ fromGregorian 2024 09 01)
+-- >>> spanExtend to2024 all2024
+-- DateSpan 2024
+-- >>> spanExtend all2024 to2024
+-- DateSpan 2024
+-- >>> spanExtend partof2024 all2024
+-- DateSpan 2024
+-- >>> spanExtend all2024 partof2024
+-- DateSpan 2024
+--
+spanExtend (DateSpan b1 e1) (DateSpan b2 e2) = DateSpan (earlierDefinite b1 b2) (laterDefinite e1 e2)
+
+-- | Pick the earlier of two DateSpan starts, treating Nothing as infinitely early.
+-- An Exact and Flex with the same date are considered equal; the first argument wins.
+earlier :: Maybe EFDay -> Maybe EFDay -> Maybe EFDay
+earlier = min
+
+-- | Pick the later of two DateSpan starts, treating Nothing as infinitely late.
+-- An Exact and Flex with the same date are considered equal; the second argument wins.
+later :: Maybe EFDay -> Maybe EFDay -> Maybe EFDay
+later _ Nothing = Nothing
+later Nothing _ = Nothing
+later d1 d2     = max d1 d2
+
+-- | Pick the earlier of two DateSpan ends that is a definite date (if any).
+-- An Exact and Flex with the same date are considered equal; the first argument wins.
+earlierDefinite :: Maybe EFDay -> Maybe EFDay -> Maybe EFDay
+earlierDefinite d1 Nothing = d1
+earlierDefinite Nothing d2 = d2
+earlierDefinite d1 d2      = min d1 d2
+
+-- | Pick the later of two DateSpan ends that is a definite date (if any).
+-- An Exact and Flex with the same date are considered equal; the second argument wins.
+laterDefinite :: Maybe EFDay -> Maybe EFDay -> Maybe EFDay
+laterDefinite d1 Nothing = d1
+laterDefinite Nothing d2 = d2
+laterDefinite d1 d2      = max d1 d2
 
 -- | Calculate the minimal DateSpan containing all of the given Days (in the
 -- usual exclusive-end-date sense: beginning on the earliest, and ending on

hledger-lib/Hledger/Data/Dates.hs

@@ -115,7 +115,7 @@ amountPriceDirectiveFromCost :: Day -> Amount -> Maybe PriceDirective
 amountPriceDirectiveFromCost d amt@Amount{acommodity=fromcomm, aquantity=n} = case acost amt of
     Just (UnitCost u)           -> Just $ pd{pdamount=u}
     Just (TotalCost t) | n /= 0 -> Just $ pd{pdamount=u}
-      where u = amountSetFullPrecisionOr Nothing $ divideAmount n t
+      where u = amountSetFullPrecisionUpTo Nothing $ divideAmount n t
     _                            -> Nothing
   where
     pd = PriceDirective{pddate = d, pdcommodity = fromcomm, pdamount = nullamt}
@@ -209,7 +209,7 @@ amountValueAtDate priceoracle styles mto d a =
       -- set the display precision to match the internal precision (showing all digits),
       -- unnormalised (don't strip trailing zeros);
       -- but if it looks like an infinite decimal, limit the precision to 8.
-      & amountSetFullPrecisionOr Nothing
+      & amountSetFullPrecisionUpTo Nothing
       & dbg9With (lbl "calculated value".showAmount)
 
 -- | Calculate the gain of each component amount, that is the difference

hledger-lib/Hledger/Data/Valuation.hs

@@ -696,7 +696,7 @@ reportSpanHelper bothdates j ReportSpec{_rsQuery=query, _rsReportOpts=ropts} =
         _              -> Nothing
     -- If the requested span is open-ended, close it using the journal's start and end dates.
     -- This can still be the null (open) span if the journal is empty.
-    requestedspan' = dbg3 "requestedspan'" $ requestedspan `spanDefaultsFrom` (journalspan `spanUnion` pricespan)
+    requestedspan' = dbg3 "requestedspan'" $ requestedspan `spanDefaultsFrom` (journalspan `spanExtend` pricespan)
     -- The list of interval spans enclosing the requested span.
     -- This list can be empty if the journal was empty,
     -- or if hledger-ui has added its special date:-tomorrow to the query

hledger-lib/Hledger/Reports/ReportOptions.hs

@@ -341,9 +341,11 @@ This is very useful when reconciling. A good workflow is to have
 your bank's online register open in a browser window, for reference;
 the journal file open in an editor window;
 and hledger-ui in watch mode in a terminal window, eg:
+
 ```cli
 $ hledger-ui --watch --register checking -C
 ```
+
 As you mark things cleared in the editor,
 you can see the effect immediately without having to context switch.
 This leaves more mental bandwidth for your accounting.

hledger-ui/hledger-ui.m4.md

@@ -95,7 +95,7 @@ accountOnlyQuery = ("inacctonly:" <>) . quoteIfSpaced
 
 mixedAmountAsHtml :: MixedAmount -> HtmlUrl a
 mixedAmountAsHtml b _ =
-  for_ (lines (showMixedAmountWithoutCost False b)) $ \t -> do
+  for_ (lines (showMixedAmountWith noCostFmt{displayZeroCommodity=True} b)) $ \t -> do
     H.span ! A.class_ c $ toHtml t
     H.br
   where

hledger-web/Hledger/Web/Widget/Common.hs

@@ -129,6 +129,12 @@ Query options and arguments may be used to set an initial filter,
 which although not shown in the UI, will restrict the data shown,
 in addition to any search query entered in the UI.
 
+Note that hledger-web shows accounts with zero balances by default, like `hledger-ui` (and unlike `hledger`).
+Using the `-E/--empty` flag at startup will hide them.
+
+If you see accounts which appear to have a zero balance, but cannot be hidden with `-E`:
+these have a mixed-cost balance which looks like zero when costs are hidden.
+Currently hledger-web does not show costs at all.
 
 ## General help options