hledger-lib 1.23 → 1.24

raw patch · 29 files changed

+626/−564 lines, 29 filesdep +doclayoutdep −base-compat-batteriesdep ~safePVP ok

version bump matches the API change (PVP)

Dependencies added: doclayout

Dependencies removed: base-compat-batteries

Dependency ranges changed: safe

API changes (from Hackage documentation)

Files

• CHANGES.md +32/−0
• Hledger/Data/AccountName.hs +2/−1
• Hledger/Data/Amount.hs +6/−10
• Hledger/Data/Balancing.hs +1/−1
• Hledger/Data/Dates.hs +2/−4
• Hledger/Data/Journal.hs +19/−7
• Hledger/Data/Posting.hs +154/−16
• Hledger/Data/StringFormat.hs +0/−2
• Hledger/Data/Transaction.hs +7/−155
• Hledger/Query.hs +1/−1
• Hledger/Read/Common.hs +12/−15
• Hledger/Read/CsvReader.hs +21/−25
• Hledger/Read/JournalReader.hs +15/−3
• Hledger/Read/TimeclockReader.hs +0/−2
• Hledger/Read/TimedotReader.hs +17/−14
• Hledger/Reports/AccountTransactionsReport.hs +22/−16
• Hledger/Reports/BudgetReport.hs +22/−23
• Hledger/Reports/MultiBalanceReport.hs +62/−48
• Hledger/Reports/PostingsReport.hs +11/−23
• Hledger/Reports/ReportOptions.hs +165/−105
• Hledger/Reports/ReportTypes.hs +21/−6
• Hledger/Utils.hs +6/−0
• Hledger/Utils/Debug.hs +5/−1
• Hledger/Utils/String.hs +5/−1
• Hledger/Utils/Text.hs +4/−4
• Text/Megaparsec/Custom.hs +0/−3
• Text/Tabular/AsciiWide.hs +2/−2
• Text/WideString.hs +2/−66
• hledger-lib.cabal +10/−10

@@ -9,6 +9,38 @@ Internal/api/developer-ish changes in the hledger-lib (and hledger) packages. For user-visible changes, see the hledger package changelog. +# 1.24 2021-12-01++Improvements++- The Semigroup instance of PeriodicReportRow and PeriodicReport now+  preserves the first prrName, rather than the second.+  (Stephen Morgan)++- PeriodicReport and PeriodicReportRow now have Bifunctor instances.+  (Stephen Morgan)++- Move posting rendering functions into Hledger.Data.Posting.+  This produces slightly different output for showPosting, in particular+  it no longer displays the transaction date. However, this has been+  marked as ‘for debugging only’ for a while.+  (Stephen Morgan)++- Drop postingDateOrDate2, transactionDateOrDate2; rename+  whichDateFromOpts to whichDate. (#1731)++- Added new helper functions journalValueAndFilterPostings(With) to make+  valuation and filtration less error prone.+  (Stephen Morgan)++- Avoid deprecation warnings with safe 0.3.18+. +  (Stephen Morgan)++- Drop base-compat-batteries dependency. +  (Stephen Morgan)++- Allow megaparsec 9.2.+ # 1.23 2021-09-21  - Require base >=4.11, prevent red squares on Hackage's build matrix.

@@ -46,6 +46,7 @@ import Data.Text (Text) import qualified Data.Text as T import Data.Tree (Tree(..))+import Text.DocLayout (realLength)  import Hledger.Data.Types import Hledger.Utils@@ -186,7 +187,7 @@       where         elideparts :: Int -> [Text] -> [Text] -> [Text]         elideparts width done ss-          | textWidth (accountNameFromComponents $ done++ss) <= width = done++ss+          | realLength (accountNameFromComponents $ done++ss) <= width = done++ss           | length ss > 1 = elideparts width (done++[textTakeWidth 2 $ head ss]) (tail ss)           | otherwise = done++ss 

@@ -171,7 +171,7 @@ import Hledger.Data.Types import Hledger.Utils (colorB) import Hledger.Utils.Text (textQuoteIfNeeded)-import Text.WideString (WideBuilder(..), textWidth, wbToText, wbUnpack)+import Text.WideString (WideBuilder(..), wbFromText, wbToText, wbUnpack)   -- A 'Commodity' is a symbol representing a currency or some other kind of@@ -244,7 +244,7 @@     abs a@Amount{aquantity=q}    = a{aquantity=abs q}     signum a@Amount{aquantity=q} = a{aquantity=signum q}     fromInteger i                = nullamt{aquantity=fromInteger i}-    negate a                     = transformAmount negate a+    negate                       = transformAmount negate     (+)                          = similarAmountsOp (+)     (-)                          = similarAmountsOp (-)     (*)                          = similarAmountsOp (*)@@ -469,14 +469,13 @@ showAmountB _ Amount{acommodity="AUTO"} = mempty showAmountB opts a@Amount{astyle=style} =     color $ case ascommodityside style of-      L -> showC c' space <> quantity' <> price-      R -> quantity' <> showC space c' <> price+      L -> showC (wbFromText c) space <> quantity' <> price+      R -> quantity' <> showC space (wbFromText c) <> price   where     quantity = showamountquantity a     (quantity',c) | amountLooksZero a && not (displayZeroCommodity opts) = (WideBuilder (TB.singleton '0') 1,"")                   | otherwise = (quantity, quoteCommoditySymbolIfNeeded $ acommodity a)     space = if not (T.null c) && ascommodityspaced style then WideBuilder (TB.singleton ' ') 1 else mempty-    c' = WideBuilder (TB.fromText c) (textWidth c)     showC l r = if isJust (displayOrder opts) then mempty else l <> r     price = if displayPrice opts then showAmountPrice a else mempty     color = if displayColour opts && isNegativeAmount a then colorB Dull Red else id@@ -914,12 +913,9 @@     withElided = zipWith (\num amt -> (amt, elisionDisplay Nothing (wbWidth sep) num amt)) [n-1,n-2..0]  orderedAmounts :: AmountDisplayOpts -> MixedAmount -> [Amount]-orderedAmounts AmountDisplayOpts{displayOrder=ord} ma-  | Just cs <- ord = fmap pad cs-  | otherwise = as+orderedAmounts dopts = maybe id (mapM pad) (displayOrder dopts) . amounts   where-    as = amounts ma-    pad c = fromMaybe (amountWithCommodity c nullamt) . find ((==) c . acommodity) $ as+    pad c = fromMaybe (amountWithCommodity c nullamt) . find ((c==) . acommodity)   data AmountDisplay = AmountDisplay

@@ -508,7 +508,7 @@                      oldbalothercommodities <- filterMixedAmount ((acommodity baamount /=) . acommodity) <$> getRunningBalanceB acc                      return $ maAddAmount oldbalothercommodities baamount       diff <- (if bainclusive then setInclusiveRunningBalanceB else setRunningBalanceB) acc newbal-      let p' = p{pamount=diff, poriginal=Just $ originalPosting p}+      let p' = p{pamount=filterMixedAmount (not . amountIsZero) diff, poriginal=Just $ originalPosting p}       whenM (R.reader bsAssrt) $ checkBalanceAssertionB p' newbal       return p' 

@@ -79,18 +79,16 @@ ) where -import Prelude ()-import "base-compat-batteries" Prelude.Compat hiding (fail)-import qualified "base-compat-batteries" Control.Monad.Fail.Compat as Fail (MonadFail, fail)+import qualified Control.Monad.Fail as Fail (MonadFail, fail) import Control.Applicative (liftA2) import Control.Applicative.Permutations import Control.Monad (guard, unless)-import "base-compat-batteries" Data.List.Compat import Data.Char (digitToInt, isDigit, ord) import Data.Default (def) import Data.Foldable (asum) import Data.Function (on) import Data.Functor (($>))+import Data.List (elemIndex, group, sort, sortBy) import Data.Maybe (catMaybes, fromMaybe, isJust, mapMaybe) import Data.Ord (comparing) import qualified Data.Set as Set

@@ -92,7 +92,7 @@   samplejournal,   samplejournalMaybeExplicit,   tests_Journal-)+,journalLeafAccountNamesDeclared) where  import Control.Applicative ((<|>))@@ -313,6 +313,11 @@ journalAccountNamesDeclared :: Journal -> [AccountName] journalAccountNamesDeclared = nubSort . map fst . jdeclaredaccounts +-- | Sorted unique account names declared by account directives in this journal,+-- which have no children.+journalLeafAccountNamesDeclared :: Journal -> [AccountName]+journalLeafAccountNamesDeclared = treeLeaves . accountNameTreeFrom . journalAccountNamesDeclared+ -- | Sorted unique account names declared by account directives or posted to -- by transactions in this journal. journalAccountNamesDeclaredOrUsed :: Journal -> [AccountName]@@ -521,19 +526,26 @@ filterJournalRelatedPostings :: Query -> Journal -> Journal filterJournalRelatedPostings q j@Journal{jtxns=ts} = j{jtxns=map (filterTransactionRelatedPostings q) ts} --- | Within each posting's amount, keep only the parts matching the query.+-- | Within each posting's amount, keep only the parts matching the query, and+-- remove any postings with all amounts removed. -- This can leave unbalanced transactions. filterJournalAmounts :: Query -> Journal -> Journal filterJournalAmounts q j@Journal{jtxns=ts} = j{jtxns=map (filterTransactionAmounts q) ts} --- | Filter out all parts of this transaction's amounts which do not match the query.+-- | Filter out all parts of this transaction's amounts which do not match the+-- query, and remove any postings with all amounts removed. -- This can leave the transaction unbalanced. filterTransactionAmounts :: Query -> Transaction -> Transaction-filterTransactionAmounts q t@Transaction{tpostings=ps} = t{tpostings=map (filterPostingAmount q) ps}+filterTransactionAmounts q t@Transaction{tpostings=ps} = t{tpostings=mapMaybe (filterPostingAmount q) ps} --- | Filter out all parts of this posting's amount which do not match the query.-filterPostingAmount :: Query -> Posting -> Posting-filterPostingAmount q p@Posting{pamount=as} = p{pamount=filterMixedAmount (q `matchesAmount`) as}+-- | Filter out all parts of this posting's amount which do not match the query, and remove the posting+-- if this removes all amounts.+filterPostingAmount :: Query -> Posting -> Maybe Posting+filterPostingAmount q p@Posting{pamount=as}+  | null newamt = Nothing+  | otherwise   = Just p{pamount=Mixed newamt}+  where+    Mixed newamt = filterMixedAmount (q `matchesAmount`) as  filterTransactionPostings :: Query -> Transaction -> Transaction filterTransactionPostings q t@Transaction{tpostings=ps} = t{tpostings=filter (q `matchesPosting`) ps}

@@ -42,6 +42,7 @@   -- * date operations   postingDate,   postingDate2,+  postingDateOrDate2,   isPostingInDateSpan,   isPostingInDateSpan',   -- * account name operations@@ -61,8 +62,12 @@   sumPostings,   -- * rendering   showPosting,+  showPostingLines,+  postingAsLines,+  postingsAsLines,+  showAccountName,+  renderCommentLines,   -- * misc.-  showComment,   postingTransformAmount,   postingApplyValuation,   postingToCost,@@ -71,6 +76,7 @@ where  import Control.Monad (foldM)+import Data.Default (def) import Data.Foldable (asum) import qualified Data.Map as M import Data.Maybe (fromMaybe, isJust)@@ -79,14 +85,19 @@ import qualified Data.Set as S import Data.Text (Text) import qualified Data.Text as T+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Builder as TB import Data.Time.Calendar (Day)-import Safe (headDef)+import Safe (headDef, maximumBound)+import Text.DocLayout (realLength) +import Text.Tabular.AsciiWide+ import Hledger.Utils import Hledger.Data.Types import Hledger.Data.Amount import Hledger.Data.AccountName-import Hledger.Data.Dates (nulldate, showDate, spanContainsDate)+import Hledger.Data.Dates (nulldate, spanContainsDate) import Hledger.Data.Valuation  @@ -152,28 +163,150 @@ balassertTotInc :: Amount -> Maybe BalanceAssertion balassertTotInc amt = Just $ nullassertion{baamount=amt, batotal=True, bainclusive=True} +-- | Render a balance assertion, as the =[=][*] symbol and expected amount.+showBalanceAssertion :: BalanceAssertion -> WideBuilder+showBalanceAssertion ba =+    singleton '=' <> eq <> ast <> singleton ' ' <> showAmountB def{displayZeroCommodity=True} (baamount ba)+  where+    eq  = if batotal ba     then singleton '=' else mempty+    ast = if bainclusive ba then singleton '*' else mempty+    singleton c = WideBuilder (TB.singleton c) 1+ -- Get the original posting, if any. originalPosting :: Posting -> Posting originalPosting p = fromMaybe p $ poriginal p --- XXX once rendered user output, but just for debugging now; clean up showPosting :: Posting -> String-showPosting p@Posting{paccount=a,pamount=amt,ptype=t} =-    T.unpack $ textConcatTopPadded [showDate (postingDate p) <> " ", showaccountname a <> " ", showamt, showComment $ pcomment p]+showPosting p = T.unpack . T.unlines $ postingsAsLines False [p]++-- | Render a posting, at the appropriate width for aligning with+-- its siblings if any. Used by the rewrite command.+showPostingLines :: Posting -> [Text]+showPostingLines p = first3 $ postingAsLines False False maxacctwidth maxamtwidth p   where-    ledger3ishlayout = False-    acctnamewidth = if ledger3ishlayout then 25 else 22-    showaccountname = fitText (Just acctnamewidth) Nothing False False . bracket . elideAccountName width-    (bracket,width) = case t of-                        BalancedVirtualPosting -> (wrap "[" "]", acctnamewidth-2)-                        VirtualPosting         -> (wrap "(" ")", acctnamewidth-2)-                        _                      -> (id,acctnamewidth)-    showamt = wbToText $ showMixedAmountB noColour{displayMinWidth=Just 12} amt+    linesWithWidths = map (postingAsLines False False maxacctwidth maxamtwidth) . maybe [p] tpostings $ ptransaction p+    maxacctwidth = maximumBound 0 $ map second3 linesWithWidths+    maxamtwidth  = maximumBound 0 $ map third3 linesWithWidths +-- | Given a transaction and its postings, render the postings, suitable+-- for `print` output. Normally this output will be valid journal syntax which+-- hledger can reparse (though it may include no-longer-valid balance assertions).+--+-- Explicit amounts are shown, any implicit amounts are not.+--+-- Postings with multicommodity explicit amounts are handled as follows:+-- if onelineamounts is true, these amounts are shown on one line,+-- comma-separated, and the output will not be valid journal syntax.+-- Otherwise, they are shown as several similar postings, one per commodity.+--+-- The output will appear to be a balanced transaction.+-- Amounts' display precisions, which may have been limited by commodity+-- directives, will be increased if necessary to ensure this.+--+-- Posting amounts will be aligned with each other, starting about 4 columns+-- beyond the widest account name (see postingAsLines for details).+postingsAsLines :: Bool -> [Posting] -> [Text]+postingsAsLines onelineamounts ps = concatMap first3 linesWithWidths+  where+    linesWithWidths = map (postingAsLines False onelineamounts maxacctwidth maxamtwidth) ps+    maxacctwidth = maximumBound 0 $ map second3 linesWithWidths+    maxamtwidth  = maximumBound 0 $ map third3 linesWithWidths -showComment :: Text -> Text-showComment t = if T.null t then "" else "  ;" <> t+-- | Render one posting, on one or more lines, suitable for `print` output.+-- There will be an indented account name, plus one or more of status flag,+-- posting amount, balance assertion, same-line comment, next-line comments.+--+-- If the posting's amount is implicit or if elideamount is true, no amount is shown.+--+-- If the posting's amount is explicit and multi-commodity, multiple similar+-- postings are shown, one for each commodity, to help produce parseable journal syntax.+-- Or if onelineamounts is true, such amounts are shown on one line, comma-separated+-- (and the output will not be valid journal syntax).+--+-- By default, 4 spaces (2 if there's a status flag) are shown between+-- account name and start of amount area, which is typically 12 chars wide+-- and contains a right-aligned amount (so 10-12 visible spaces between+-- account name and amount is typical).+-- When given a list of postings to be aligned with, the whitespace will be+-- increased if needed to match the posting with the longest account name.+-- This is used to align the amounts of a transaction's postings.+--+-- Also returns the account width and amount width used.+postingAsLines :: Bool -> Bool -> Int -> Int -> Posting -> ([Text], Int, Int)+postingAsLines elideamount onelineamounts acctwidth amtwidth p =+    (concatMap (++ newlinecomments) postingblocks, thisacctwidth, thisamtwidth)+  where+    -- This needs to be converted to strict Text in order to strip trailing+    -- spaces. This adds a small amount of inefficiency, and the only difference+    -- is whether there are trailing spaces in print (and related) reports. This+    -- could be removed and we could just keep everything as a Text Builder, but+    -- would require adding trailing spaces to 42 failing tests.+    postingblocks = [map T.stripEnd . T.lines . TL.toStrict $+                       render [ textCell BottomLeft statusandaccount+                              , textCell BottomLeft "  "+                              , Cell BottomLeft [pad amt]+                              , Cell BottomLeft [assertion]+                              , textCell BottomLeft samelinecomment+                              ]+                    | amt <- shownAmounts]+    render = renderRow def{tableBorders=False, borderSpaces=False} . Group NoLine . map Header+    pad amt = WideBuilder (TB.fromText $ T.replicate w " ") w <> amt+      where w = max 12 amtwidth - wbWidth amt  -- min. 12 for backwards compatibility +    assertion = maybe mempty ((WideBuilder (TB.singleton ' ') 1 <>).showBalanceAssertion) $ pbalanceassertion p+    -- pad to the maximum account name width, plus 2 to leave room for status flags, to keep amounts aligned+    statusandaccount = lineIndent . fitText (Just $ 2 + acctwidth) Nothing False True $ pstatusandacct p+    thisacctwidth = realLength $ pacctstr p++    pacctstr p' = showAccountName Nothing (ptype p') (paccount p')+    pstatusandacct p' = pstatusprefix p' <> pacctstr p'+    pstatusprefix p' = case pstatus p' of+        Unmarked -> ""+        s        -> T.pack (show s) <> " "++    -- currently prices are considered part of the amount string when right-aligning amounts+    -- Since we will usually be calling this function with the knot tied between+    -- amtwidth and thisamtwidth, make sure thisamtwidth does not depend on+    -- amtwidth at all.+    shownAmounts+      | elideamount = [mempty]+      | otherwise   = showMixedAmountLinesB noColour{displayOneLine=onelineamounts} $ pamount p+    thisamtwidth = maximumBound 0 $ map wbWidth shownAmounts++    (samelinecomment, newlinecomments) =+      case renderCommentLines (pcomment p) of []   -> ("",[])+                                              c:cs -> (c,cs)++-- | Show an account name, clipped to the given width if any, and+-- appropriately bracketed/parenthesised for the given posting type.+showAccountName :: Maybe Int -> PostingType -> AccountName -> Text+showAccountName w = fmt+  where+    fmt RegularPosting         = maybe id T.take w+    fmt VirtualPosting         = wrap "(" ")" . maybe id (T.takeEnd . subtract 2) w+    fmt BalancedVirtualPosting = wrap "[" "]" . maybe id (T.takeEnd . subtract 2) w++-- | Render a transaction or posting's comment as indented, semicolon-prefixed comment lines.+-- The first line (unless empty) will have leading space, subsequent lines will have a larger indent.+renderCommentLines :: Text -> [Text]+renderCommentLines t =+  case T.lines t of+    []      -> []+    [l]     -> [commentSpace $ comment l]        -- single-line comment+    ("":ls) -> "" : map (lineIndent . comment) ls  -- multi-line comment with empty first line+    (l:ls)  -> commentSpace (comment l) : map (lineIndent . comment) ls+  where+    comment = ("; "<>)++-- | Prepend a suitable indent for a posting (or transaction/posting comment) line.+lineIndent :: Text -> Text+lineIndent = ("    "<>)++-- | Prepend the space required before a same-line comment.+commentSpace :: Text -> Text+commentSpace = ("  "<>)++ isReal :: Posting -> Bool isReal p = ptype p == RegularPosting @@ -219,6 +352,11 @@                 , pdate p                 , tdate <$> ptransaction p                 ]++-- | Get a posting's primary or secondary date, as specified.+postingDateOrDate2 :: WhichDate -> Posting -> Day+postingDateOrDate2 PrimaryDate   = postingDate+postingDateOrDate2 SecondaryDate = postingDate2  -- | Get a posting's status. This is cleared or pending if those are -- explicitly set on the posting, otherwise the status of its parent

@@ -17,8 +17,6 @@         , tests_StringFormat         ) where -import Prelude ()-import "base-compat-batteries" Prelude.Compat import Numeric (readDec) import Data.Char (isPrint) import Data.Default (Default(..))

@@ -18,7 +18,6 @@ , txnTieKnot , txnUntieKnot   -- * operations-, showAccountName , hasRealPostings , realPostings , assignmentPostings@@ -34,6 +33,7 @@   -- nonzerobalanceerror   -- * date operations , transactionDate2+, transactionDateOrDate2   -- * transaction description parts , transactionPayee , transactionNote@@ -41,14 +41,11 @@   -- * rendering , showTransaction , showTransactionOneLineAmounts-  -- showPostingLine-, showPostingLines , transactionFile   -- * tests , tests_Transaction ) where -import Data.Default (Default(..)) import Data.Maybe (fromMaybe) import Data.Text (Text) import qualified Data.Text as T@@ -56,7 +53,6 @@ import qualified Data.Text.Lazy.Builder as TB import Data.Time.Calendar (Day, fromGregorian) import qualified Data.Map as M-import Safe (maximumDef)  import Hledger.Utils import Hledger.Data.Types@@ -64,7 +60,6 @@ import Hledger.Data.Posting import Hledger.Data.Amount import Hledger.Data.Valuation-import Text.Tabular.AsciiWide   nulltransaction :: Transaction@@ -154,154 +149,6 @@                                               c:cs -> (c,cs)     newline = TB.singleton '\n' --- | Render a transaction or posting's comment as indented, semicolon-prefixed comment lines.--- The first line (unless empty) will have leading space, subsequent lines will have a larger indent.-renderCommentLines :: Text -> [Text]-renderCommentLines t =-  case T.lines t of-    []      -> []-    [l]     -> [commentSpace $ comment l]        -- single-line comment-    ("":ls) -> "" : map (lineIndent . comment) ls  -- multi-line comment with empty first line-    (l:ls)  -> commentSpace (comment l) : map (lineIndent . comment) ls-  where-    comment = ("; "<>)---- | Given a transaction and its postings, render the postings, suitable--- for `print` output. Normally this output will be valid journal syntax which--- hledger can reparse (though it may include no-longer-valid balance assertions).------ Explicit amounts are shown, any implicit amounts are not.------ Postings with multicommodity explicit amounts are handled as follows:--- if onelineamounts is true, these amounts are shown on one line,--- comma-separated, and the output will not be valid journal syntax.--- Otherwise, they are shown as several similar postings, one per commodity.------ The output will appear to be a balanced transaction.--- Amounts' display precisions, which may have been limited by commodity--- directives, will be increased if necessary to ensure this.------ Posting amounts will be aligned with each other, starting about 4 columns--- beyond the widest account name (see postingAsLines for details).-postingsAsLines :: Bool -> [Posting] -> [Text]-postingsAsLines onelineamounts ps = concatMap first3 linesWithWidths-  where-    linesWithWidths = map (postingAsLines False onelineamounts maxacctwidth maxamtwidth) ps-    maxacctwidth = maximumDef 0 $ map second3 linesWithWidths-    maxamtwidth  = maximumDef 0 $ map third3 linesWithWidths---- | Render one posting, on one or more lines, suitable for `print` output.--- There will be an indented account name, plus one or more of status flag,--- posting amount, balance assertion, same-line comment, next-line comments.------ If the posting's amount is implicit or if elideamount is true, no amount is shown.------ If the posting's amount is explicit and multi-commodity, multiple similar--- postings are shown, one for each commodity, to help produce parseable journal syntax.--- Or if onelineamounts is true, such amounts are shown on one line, comma-separated--- (and the output will not be valid journal syntax).------ By default, 4 spaces (2 if there's a status flag) are shown between--- account name and start of amount area, which is typically 12 chars wide--- and contains a right-aligned amount (so 10-12 visible spaces between--- account name and amount is typical).--- When given a list of postings to be aligned with, the whitespace will be--- increased if needed to match the posting with the longest account name.--- This is used to align the amounts of a transaction's postings.------ Also returns the account width and amount width used.-postingAsLines :: Bool -> Bool -> Int -> Int -> Posting -> ([Text], Int, Int)-postingAsLines elideamount onelineamounts acctwidth amtwidth p =-    (concatMap (++ newlinecomments) postingblocks, thisacctwidth, thisamtwidth)-  where-    -- This needs to be converted to strict Text in order to strip trailing-    -- spaces. This adds a small amount of inefficiency, and the only difference-    -- is whether there are trailing spaces in print (and related) reports. This-    -- could be removed and we could just keep everything as a Text Builder, but-    -- would require adding trailing spaces to 42 failing tests.-    postingblocks = [map T.stripEnd . T.lines . TL.toStrict $-                       render [ textCell BottomLeft statusandaccount-                              , textCell BottomLeft "  "-                              , Cell BottomLeft [pad amt]-                              , Cell BottomLeft [assertion]-                              , textCell BottomLeft samelinecomment-                              ]-                    | amt <- shownAmounts]-    render = renderRow def{tableBorders=False, borderSpaces=False} . Group NoLine . map Header-    pad amt = WideBuilder (TB.fromText $ T.replicate w " ") w <> amt-      where w = max 12 amtwidth - wbWidth amt  -- min. 12 for backwards compatibility--    assertion = maybe mempty ((WideBuilder (TB.singleton ' ') 1 <>).showBalanceAssertion) $ pbalanceassertion p-    -- pad to the maximum account name width, plus 2 to leave room for status flags, to keep amounts aligned-    statusandaccount = lineIndent . fitText (Just $ 2 + acctwidth) Nothing False True $ pstatusandacct p-    thisacctwidth = textWidth $ pacctstr p--    pacctstr p' = showAccountName Nothing (ptype p') (paccount p')-    pstatusandacct p' = pstatusprefix p' <> pacctstr p'-    pstatusprefix p' = case pstatus p' of-        Unmarked -> ""-        s        -> T.pack (show s) <> " "--    -- currently prices are considered part of the amount string when right-aligning amounts-    -- Since we will usually be calling this function with the knot tied between-    -- amtwidth and thisamtwidth, make sure thisamtwidth does not depend on-    -- amtwidth at all.-    shownAmounts-      | elideamount = [mempty]-      | otherwise   = showMixedAmountLinesB noColour{displayOneLine=onelineamounts} $ pamount p-    thisamtwidth = maximumDef 0 $ map wbWidth shownAmounts--    (samelinecomment, newlinecomments) =-      case renderCommentLines (pcomment p) of []   -> ("",[])-                                              c:cs -> (c,cs)---- | Render a balance assertion, as the =[=][*] symbol and expected amount.-showBalanceAssertion :: BalanceAssertion -> WideBuilder-showBalanceAssertion BalanceAssertion{..} =-    singleton '=' <> eq <> ast <> singleton ' ' <> showAmountB def{displayZeroCommodity=True} baamount-  where-    eq  = if batotal     then singleton '=' else mempty-    ast = if bainclusive then singleton '*' else mempty-    singleton c = WideBuilder (TB.singleton c) 1---- | Render a posting, simply. Used in balance assertion errors.--- showPostingLine p =---   lineIndent $---   if pstatus p == Cleared then "* " else "" ++  -- XXX show !---   showAccountName Nothing (ptype p) (paccount p) ++---   "    " ++---   showMixedAmountOneLine (pamount p) ++---   assertion---   where---     -- XXX extract, handle ==---     assertion = maybe "" ((" = " ++) . showAmountWithZeroCommodity . baamount) $ pbalanceassertion p---- | Render a posting, at the appropriate width for aligning with--- its siblings if any. Used by the rewrite command.-showPostingLines :: Posting -> [Text]-showPostingLines p = first3 $ postingAsLines False False maxacctwidth maxamtwidth p-  where-    linesWithWidths = map (postingAsLines False False maxacctwidth maxamtwidth) . maybe [p] tpostings $ ptransaction p-    maxacctwidth = maximumDef 0 $ map second3 linesWithWidths-    maxamtwidth  = maximumDef 0 $ map third3 linesWithWidths---- | Prepend a suitable indent for a posting (or transaction/posting comment) line.-lineIndent :: Text -> Text-lineIndent = ("    "<>)---- | Prepend the space required before a same-line comment.-commentSpace :: Text -> Text-commentSpace = ("  "<>)---- | Show an account name, clipped to the given width if any, and--- appropriately bracketed/parenthesised for the given posting type.-showAccountName :: Maybe Int -> PostingType -> AccountName -> Text-showAccountName w = fmt-  where-    fmt RegularPosting         = maybe id T.take w-    fmt VirtualPosting         = wrap "(" ")" . maybe id (T.takeEnd . subtract 2) w-    fmt BalancedVirtualPosting = wrap "[" "]" . maybe id (T.takeEnd . subtract 2) w- hasRealPostings :: Transaction -> Bool hasRealPostings = not . null . realPostings @@ -320,9 +167,14 @@ transactionsPostings :: [Transaction] -> [Posting] transactionsPostings = concatMap tpostings --- Get a transaction's secondary date, defaulting to the primary date.+-- Get a transaction's secondary date, or the primary date if there is none. transactionDate2 :: Transaction -> Day transactionDate2 t = fromMaybe (tdate t) $ tdate2 t++-- Get a transaction's primary or secondary date, as specified.+transactionDateOrDate2 :: WhichDate -> Transaction -> Day+transactionDateOrDate2 PrimaryDate   = tdate+transactionDateOrDate2 SecondaryDate = transactionDate2  -- | Ensure a transaction's postings refer back to it, so that eg -- relatedPostings works right.

@@ -479,7 +479,7 @@ queryDateSpan :: Bool -> Query -> DateSpan queryDateSpan secondary (Or qs)  = spansUnion     $ map (queryDateSpan secondary) qs queryDateSpan secondary (And qs) = spansIntersect $ map (queryDateSpan secondary) qs-queryDateSpan False (Date span)  = span+queryDateSpan _     (Date span)  = span queryDateSpan True (Date2 span)  = span queryDateSpan _ _                = nulldatespan 

@@ -119,10 +119,8 @@ where  --- ** imports-import Prelude ()-import "base-compat-batteries" Prelude.Compat hiding (fail, readFile) import Control.Applicative.Permutations (runPermutation, toPermutationWithDefault)-import qualified "base-compat-batteries" Control.Monad.Fail.Compat as Fail (fail)+import qualified Control.Monad.Fail as Fail (fail) import Control.Monad.Except (ExceptT(..), liftEither, runExceptT, throwError) import Control.Monad.State.Strict hiding (fail) import Data.Bifunctor (bimap, second)@@ -130,8 +128,8 @@ import Data.Decimal (DecimalRaw (Decimal), Decimal) import Data.Either (lefts, rights) import Data.Function ((&))-import Data.Functor ((<&>))-import "base-compat-batteries" Data.List.Compat+import Data.Functor ((<&>), ($>))+import Data.List (find, genericReplicate) import Data.List.NonEmpty (NonEmpty(..)) import Data.Maybe (catMaybes, fromMaybe, isJust, listToMaybe) import qualified Data.Map as M@@ -357,7 +355,7 @@ -- | Check that all the journal's transactions have payees declared with -- payee directives, returning an error message otherwise. journalCheckPayeesDeclared :: Journal -> Either String ()-journalCheckPayeesDeclared j = sequence_ $ map checkpayee $ jtxns j+journalCheckPayeesDeclared j = mapM_ checkpayee (jtxns j)   where     checkpayee t       | p `elem` ps = Right ()@@ -373,7 +371,7 @@ -- | Check that all the journal's postings are to accounts declared with -- account directives, returning an error message otherwise. journalCheckAccountsDeclared :: Journal -> Either String ()-journalCheckAccountsDeclared j = sequence_ $ map checkacct $ journalPostings j+journalCheckAccountsDeclared j = mapM_ checkacct (journalPostings j)   where     checkacct Posting{paccount,ptransaction}       | paccount `elem` as = Right ()@@ -391,7 +389,7 @@ -- by commodity directives, returning an error message otherwise. journalCheckCommoditiesDeclared :: Journal -> Either String () journalCheckCommoditiesDeclared j =-  sequence_ $ map checkcommodities $ journalPostings j+  mapM_ checkcommodities (journalPostings j)   where     checkcommodities Posting{..} =       case mfirstundeclaredcomm of@@ -421,7 +419,7 @@ getDecimalMarkStyle :: JournalParser m (Maybe AmountStyle) getDecimalMarkStyle = do   Journal{jparsedecimalmark} <- get-  let mdecmarkStyle = maybe Nothing (\c -> Just $ amountstyle{asdecimalpoint=Just c}) jparsedecimalmark+  let mdecmarkStyle = (\c -> Just $ amountstyle{asdecimalpoint=Just c}) =<< jparsedecimalmark   return mdecmarkStyle  setDefaultCommodityAndStyle :: (CommoditySymbol,AmountStyle) -> JournalParser m ()@@ -861,7 +859,7 @@ -- | Parse a minus or plus sign followed by zero or more spaces, -- or nothing, returning a function that negates or does nothing. signp :: Num a => TextParser m (a -> a)-signp = ((char '-' *> pure negate <|> char '+' *> pure id) <* skipNonNewlineSpaces) <|> pure id+signp = ((char '-' $> negate <|> char '+' $> id) <* skipNonNewlineSpaces) <|> pure id  commoditysymbolp :: TextParser m CommoditySymbol commoditysymbolp =@@ -880,7 +878,7 @@   -- https://www.ledger-cli.org/3.0/doc/ledger3.html#Virtual-posting-costs   parenthesised <- option False $ char '(' >> pure True   char '@'-  totalPrice <- char '@' *> pure True <|> pure False+  totalPrice <- char '@' $> True <|> pure False   when parenthesised $ void $ char ')'    lift skipNonNewlineSpaces@@ -1289,8 +1287,7 @@  commenttagsp :: TextParser m [Tag] commenttagsp = do-  tagName <- fmap (last . T.split isSpace)-            $ takeWhileP Nothing (\c -> c /= ':' && c /= '\n')+  tagName <- (last . T.split isSpace) <$> takeWhileP Nothing (\c -> c /= ':' && c /= '\n')   atColon tagName <|> pure [] -- if not ':', then either '\n' or EOF    where@@ -1366,8 +1363,8 @@ postingcommentp mYear = do   (commentText, (tags, dateTags)) <-     followingcommentp' (commenttagsanddatesp mYear)-  let mdate  = fmap snd $ find ((=="date") .fst) dateTags-      mdate2 = fmap snd $ find ((=="date2").fst) dateTags+  let mdate  = snd <$> find ((=="date") .fst) dateTags+      mdate2 = snd <$> find ((=="date2").fst) dateTags   pure (commentText, tags, mdate, mdate2) {-# INLINABLE postingcommentp #-} 

@@ -37,8 +37,6 @@ where  --- ** imports-import Prelude ()-import "base-compat-batteries" Prelude.Compat hiding (fail) import Control.Applicative        (liftA2) import Control.Exception          (IOException, handle, throw) import Control.Monad              (unless, when)@@ -49,7 +47,7 @@ import Control.Monad.Trans.Class  (lift) import Data.Char                  (toLower, isDigit, isSpace, isAlphaNum, isAscii, ord) import Data.Bifunctor             (first)-import "base-compat-batteries" Data.List.Compat+import Data.List (elemIndex, foldl', intersperse, mapAccumL, nub, sortBy) import Data.Maybe (catMaybes, fromMaybe, isJust) import Data.MemoUgly (memo) import Data.Ord (comparing)@@ -788,7 +786,7 @@ parseCsv separator filePath csvdata =   case filePath of     "-" -> parseCassava separator "(stdin)" <$> T.getContents-    _   -> return $ parseCassava separator filePath csvdata+    _   -> return $ if T.null csvdata then Right mempty else parseCassava separator filePath csvdata  parseCassava :: Char -> FilePath -> Text -> Either String CSV parseCassava separator path content =@@ -998,33 +996,31 @@                           ]      -- if any of the numbered field names are present, discard all the unnumbered ones-    assignments' | any isnumbered assignments = filter isnumbered assignments-                 | otherwise                  = assignments+    discardUnnumbered xs = if null numbered then xs else numbered       where-        isnumbered (f,_) = T.any isDigit f+        numbered = filter (T.any isDigit . fst) xs -    -- if there's more than one value and only some are zeros, discard the zeros-    assignments''-      | length assignments' > 1 && not (null nonzeros) = nonzeros-      | otherwise                                      = assignments'-      where nonzeros = filter (not . mixedAmountLooksZero . snd) assignments'+    -- discard all zero amounts, unless all amounts are zero, in which case discard all but the first+    discardExcessZeros xs = if null nonzeros then take 1 xs else nonzeros+      where+        nonzeros = filter (not . mixedAmountLooksZero . snd) xs -  in case -- dbg0 ("amounts for posting "++show n)-          assignments'' of-      [] -> Nothing-      [(f,a)] | "-out" `T.isSuffixOf` f -> Just (maNegate a)  -- for -out fields, flip the sign-                                                              -- XXX unless it's already negative ? back compat issues / too confusing ?-      [(_,a)] -> Just a-      fs      -> error' . T.unpack . T.unlines $ [  -- PARTIAL:-         "multiple non-zero amounts or multiple zero amounts assigned,"+    -- for -out fields, flip the sign  XXX unless it's already negative ? back compat issues / too confusing ?+    negateIfOut f = if "-out" `T.isSuffixOf` f then maNegate else id++  in case discardExcessZeros $ discardUnnumbered assignments of+      []      -> Nothing+      [(f,a)] -> Just $ negateIfOut f a+      fs      -> error' . T.unpack . T.unlines $  -- PARTIAL:+        ["multiple non-zero amounts assigned,"         ,"please ensure just one. (https://hledger.org/csv.html#amount)"         ,"  " <> showRecord record         ,"  for posting: " <> T.pack (show n)-        ]-        ++ ["  assignment: " <> f <> " " <>-             fromMaybe "" (hledgerField rules record f) <>-             "\t=> value: " <> wbToText (showMixedAmountB noColour a) -- XXX not sure this is showing all the right info-           | (f,a) <- fs]+        ] +++        ["  assignment: " <> f <> " " <>+          fromMaybe "" (hledgerField rules record f) <>+          "\t=> value: " <> wbToText (showMixedAmountB noColour a) -- XXX not sure this is showing all the right info+        | (f,a) <- fs]  -- | Figure out the expected balance (assertion or assignment) specified for posting N, -- if any (and its parse position).

@@ -71,9 +71,7 @@ where  --- ** imports--- import qualified Prelude (fail)--- import "base-compat-batteries" Prelude.Compat hiding (fail, readFile)-import qualified "base-compat-batteries" Control.Monad.Fail.Compat as Fail (fail)+import qualified Control.Monad.Fail as Fail (fail) import qualified Control.Exception as C import Control.Monad (forM_, when, void) import Control.Monad.IO.Class (MonadIO, liftIO)@@ -248,6 +246,7 @@    ,defaultcommoditydirectivep    ,commodityconversiondirectivep    ,ignoredpricecommoditydirectivep+   ,decimalmarkdirectivep    ]   ) <?> "directive" @@ -319,6 +318,7 @@       jparsedefaultyear      = jparsedefaultyear j       ,jparsedefaultcommodity = jparsedefaultcommodity j       ,jparseparentaccounts   = jparseparentaccounts j+      ,jparsedecimalmark      = jparsedecimalmark j       ,jparsealiases          = jparsealiases j       ,jcommodities           = jcommodities j       -- ,jparsetransactioncount = jparsetransactioncount j@@ -598,6 +598,18 @@   char '='   lift skipNonNewlineSpaces   amountp+  lift restofline+  return ()++-- | Read a valid decimal mark from the decimal-mark directive e.g+--+-- decimal-mark ,+decimalmarkdirectivep :: JournalParser m ()+decimalmarkdirectivep = do+  string "decimal-mark" <?> "decimal mark"+  lift skipNonNewlineSpaces1+  mark <- satisfy isDecimalMark+  modify' $ \j -> j{jparsedecimalmark=Just mark}   lift restofline   return () 

@@ -57,8 +57,6 @@ where  --- ** imports-import           Prelude ()-import "base-compat-batteries" Prelude.Compat import           Control.Monad import           Control.Monad.Except (ExceptT) import           Control.Monad.State.Strict

@@ -40,8 +40,6 @@ where  --- ** imports-import Prelude ()-import "base-compat-batteries" Prelude.Compat import Control.Monad import Control.Monad.Except (ExceptT) import Control.Monad.State.Strict@@ -173,21 +171,26 @@   lift $ optional $ choice [orgheadingprefixp, skipNonNewlineSpaces1]   a <- modifiedaccountnamep   lift skipNonNewlineSpaces-  hours <-+  hrs <-     try (lift followingcommentp >> return 0)     <|> (durationp <*          (try (lift followingcommentp) <|> (newline >> return "")))-  let t = nulltransaction{-        tsourcepos = (pos, pos),-        tstatus    = Cleared,-        tpostings  = [-          nullposting{paccount=a-                     ,pamount=mixedAmount . amountSetPrecision (Precision 2) $ num hours  -- don't assume hours; do set precision to 2-                     ,ptype=VirtualPosting-                     ,ptransaction=Just t-                     }-          ]-        }+  mcs <- getDefaultCommodityAndStyle+  let +    (c,s) = case mcs of+      Just (defc,defs) -> (defc, defs{asprecision=max (asprecision defs) (Precision 2)})+      _ -> ("", amountstyle{asprecision=Precision 2})+    t = nulltransaction{+          tsourcepos = (pos, pos),+          tstatus    = Cleared,+          tpostings  = [+            nullposting{paccount=a+                      ,pamount=mixedAmount $ nullamt{acommodity=c, aquantity=hrs, astyle=s}+                      ,ptype=VirtualPosting+                      ,ptransaction=Just t+                      }+            ]+          }   lift $ traceparse' "entryp"   return t 

@@ -103,8 +103,9 @@         periodq = Date . periodAsDateSpan $ period_ ropts     amtq = filterQuery queryIsCurOrAmt $ _rsQuery rspec     queryIsCurOrAmt q = queryIsSym q || queryIsAmt q+    wd = whichDate ropts -    -- Note that within this functions, we are only allowed limited+    -- Note that within this function, we are only allowed limited     -- transformation of the transaction postings: this is due to the need to     -- pass the original transactions into accountTransactionsReportItem.     -- Generally, we either include a transaction in full, or not at all.@@ -112,6 +113,8 @@     -- - filter them by the account query if any,     -- - discard amounts not matched by the currency and amount query if any,     -- - then apply valuation if any.+    -- Additional reportq filtering, such as date filtering, happens down in +    -- accountTransactionsReportItem, which discards transactions with no matched postings.     acctJournal =           ptraceAtWith 5 (("ts3:\n"++).pshowTransactions.jtxns)         -- maybe convert these transactions to cost or value@@ -149,7 +152,7 @@       -- sort by the transaction's register date, then index, for accurate starting balance       . ptraceAtWith 5 (("ts4:\n"++).pshowTransactions.map snd)       . sortBy (comparing (Down . fst) <> comparing (Down . tindex . snd))-      . map (\t -> (transactionRegisterDate reportq thisacctq t, t))+      . map (\t -> (transactionRegisterDate wd reportq thisacctq t, t))       $ jtxns acctJournal  pshowTransactions :: [Transaction] -> String@@ -160,9 +163,8 @@ -- which account to use as the focus, a starting balance, and a sign-setting -- function. -- Each transaction is accompanied by the date that should be shown for it--- in the report, which is not necessarily the transaction date; it is--- the earliest of the posting dates which match both thisacctq and reportq,--- otherwise the transaction's date if there are no matching postings.+-- in the report. This is not necessarily the transaction date - see+-- transactionRegisterDate. accountTransactionsReportItems :: Query -> Query -> MixedAmount -> (MixedAmount -> MixedAmount)                                -> [(Day, Transaction)] -> [AccountTransactionsReportItem] accountTransactionsReportItems reportq thisacctq bal signfn =@@ -176,7 +178,7 @@     | null reportps = (bal, Nothing)  -- no matched postings in this transaction, skip it     | otherwise     = (b, Just (torig, tacct{tdate=d}, numotheraccts > 1, otheracctstr, a, b))     where-      tacct@Transaction{tpostings=reportps} = filterTransactionPostings reportq torig+      tacct@Transaction{tpostings=reportps} = filterTransactionPostings reportq torig  -- TODO needs to consider --date2, #1731       (thisacctps, otheracctps) = partition (matchesPosting thisacctq) reportps       numotheraccts = length $ nub $ map paccount otheracctps       otheracctstr | thisacctq == None  = summarisePostingAccounts reportps     -- no current account ? summarise all matched postings@@ -185,16 +187,20 @@       a = signfn . maNegate $ sumPostings thisacctps       b = bal `maPlus` a --- | What is the transaction's date in the context of a particular account--- (specified with a query) and report query, as in an account register ?--- It's normally the transaction's general date, but if any posting(s)--- matched by the report query and affecting the matched account(s) have--- their own earlier dates, it's the earliest of these dates.--- Secondary transaction/posting dates are ignored.-transactionRegisterDate :: Query -> Query -> Transaction -> Day-transactionRegisterDate reportq thisacctq t-  | null thisacctps = tdate t-  | otherwise       = minimum $ map postingDate thisacctps+-- TODO needs checking, cf #1731+-- | What date should be shown for a transaction in an account register report ?+-- This will be in context of a particular account (the "this account" query)+-- and any additional report query. It could be:+--+-- - if postings are matched by both thisacctq and reportq, the earliest of those+--   matched postings' dates (or their secondary dates if --date2 was used)+--+-- - the transaction date, or its secondary date if --date2 was used.+--+transactionRegisterDate :: WhichDate -> Query -> Query -> Transaction -> Day+transactionRegisterDate wd reportq thisacctq t+  | not $ null thisacctps = minimum $ map (postingDateOrDate2 wd) thisacctps+  | otherwise             = transactionDateOrDate2 wd t   where     reportps   = tpostings $ filterTransactionPostings reportq t     thisacctps = filter (matchesPosting thisacctq) reportps

@@ -38,7 +38,7 @@ import qualified Data.Text.Lazy.Builder as TB --import System.Console.CmdArgs.Explicit as C --import Lucid as L-import Text.Tabular.AsciiWide as Tab+import qualified Text.Tabular.AsciiWide as Tab  import Hledger.Data import Hledger.Utils@@ -230,18 +230,18 @@            <> ":"  -- | Build a 'Table' from a multi-column balance report.-budgetReportAsTable :: ReportOpts -> BudgetReport -> Table Text Text WideBuilder+budgetReportAsTable :: ReportOpts -> BudgetReport -> Tab.Table Text Text WideBuilder budgetReportAsTable   ReportOpts{..}   (PeriodicReport spans items tr) =     maybetransposetable $     addtotalrow $-    Table-      (Tab.Group NoLine $ map Header accts)-      (Tab.Group NoLine $ map Header colheadings)+    Tab.Table+      (Tab.Group Tab.NoLine $ map Tab.Header accts)+      (Tab.Group Tab.NoLine $ map Tab.Header colheadings)       rows   where-    colheadings = ["Commodity" | commodity_column_]+    colheadings = ["Commodity" | commodity_layout_ == CommodityBare]                   ++ map (reportPeriodName balanceaccum_ spans) spans                   ++ ["  Total" | row_total_]                   ++ ["Average" | average_]@@ -255,16 +255,16 @@      addtotalrow       | no_total_ = id-      | otherwise = let rh = Tab.Group NoLine . replicate (length totalrows) $ Header ""-                        ch = Header [] -- ignored-                     in (flip (concatTables SingleLine) $ Table rh ch totalrows)+      | otherwise = let rh = Tab.Group Tab.NoLine . replicate (length totalrows) $ Tab.Header ""+                        ch = Tab.Header [] -- ignored+                     in (flip (Tab.concatTables Tab.SingleLine) $ Tab.Table rh ch totalrows)      maybetranspose       | transpose_ = transpose       | otherwise  = id      maybetransposetable-      | transpose_ = \(Table rh ch vals) -> Table ch rh (transpose vals)+      | transpose_ = \(Tab.Table rh ch vals) -> Tab.Table ch rh (transpose vals)       | otherwise  = id      (accts, rows, totalrows) = (accts, prependcs itemscs (padcells texts), prependcs trcs (padtr trtexts))@@ -283,24 +283,23 @@         padcells = maybetranspose . fmap (fmap (uncurry paddisplaycell) . zip widths)   . maybetranspose         padtr    = maybetranspose . fmap (fmap (uncurry paddisplaycell) . zip trwidths) . maybetranspose -        -- commodities are shown with the amounts without `commodity-column`+        -- commodities are shown with the amounts without `commodity_layout_ == CommodityBare`         prependcs cs-          | commodity_column_ = zipWith (:) cs-          | otherwise = id+          | commodity_layout_ /= CommodityBare = id+          | otherwise = zipWith (:) cs      rowToBudgetCells (PeriodicReportRow _ as rowtot rowavg) = as         ++ [rowtot | row_total_ && not (null as)]         ++ [rowavg | average_   && not (null as)] -    -- functions for displaying budget cells depending on `commodity-column` flag+    -- functions for displaying budget cells depending on `commodity-layout_` option     rowfuncs :: [CommoditySymbol] -> (BudgetShowMixed, BudgetPercBudget)-    rowfuncs cs-      | not commodity_column_ =-          ( pure . showMixedAmountB oneLine{displayColour=color_, displayMaxWidth=Just 32}-          , \a -> pure . percentage a)-      | otherwise =-          ( showMixedAmountLinesB noPrice{displayOrder=Just cs, displayMinWidth=Nothing, displayColour=color_}-          , \a b -> fmap (percentage' a b) cs)+    rowfuncs cs = case commodity_layout_ of+      CommodityWide width ->+           ( pure . showMixedAmountB oneLine{displayColour=color_, displayMaxWidth=width}+           , \a -> pure . percentage a)+      _ -> ( showMixedAmountLinesB noPrice{displayOrder=Just cs, displayMinWidth=Nothing, displayColour=color_}+           , \a b -> fmap (percentage' a b) cs)      showrow :: [BudgetCell] -> [(WideBuilder, BudgetDisplayRow)]     showrow row =@@ -408,7 +407,7 @@    -- heading row   ("Account" :-  ["Commodity" | commodity_column_ ]+  ["Commodity" | commodity_layout_ == CommodityBare ]    ++ concatMap (\span -> [showDateSpan span, "budget"]) colspans    ++ concat [["Total"  ,"budget"] | row_total_]    ++ concat [["Average","budget"] | average_]@@ -428,7 +427,7 @@                -> PeriodicReportRow a BudgetCell                -> [[Text]]     rowAsTexts render row@(PeriodicReportRow _ as (rowtot,budgettot) (rowavg, budgetavg))-      | not commodity_column_ = [render row : fmap showNorm all]+      | commodity_layout_ /= CommodityBare = [render row : fmap showNorm all]       | otherwise =             joinNames . zipWith (:) cs  -- add symbols and names           . transpose                   -- each row becomes a list of Text quantities

@@ -1,5 +1,6 @@ {-# LANGUAGE FlexibleInstances   #-} {-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE NamedFieldPuns   #-} {-# LANGUAGE RecordWildCards     #-} {-# LANGUAGE ScopedTypeVariables #-} {-|@@ -26,7 +27,6 @@   getPostingsByColumn,   getPostings,   startingPostings,-  startingBalancesFromPostings,   generateMultiBalanceReport,   balanceReportTableAsText, @@ -122,8 +122,8 @@      -- The matched accounts with a starting balance. All of these should appear     -- in the report, even if they have no postings during the report period.-    startbals = dbg5 "startbals" . startingBalancesFromPostings rspec j priceoracle-                                 $ startingPostings rspec j priceoracle reportspan+    startbals = dbg5 "startbals" $+      startingBalances rspec j priceoracle $ startingPostings rspec j priceoracle reportspan      -- Generate and postprocess the report, negating balances and taking percentages if needed     report = dbg4 "multiBalanceReportWith" $@@ -159,16 +159,18 @@             ( cbcsubreporttitle             -- Postprocess the report, negating balances and taking percentages if needed             , cbcsubreporttransform $-                generateMultiBalanceReport rspec{_rsReportOpts=ropts} j priceoracle colps' startbals'+                generateMultiBalanceReport rspecsub j priceoracle colps' startbals'             , cbcsubreportincreasestotal             )           where-            -- Filter the column postings according to each subreport+            -- Add a restriction to this subreport to the report query.+            -- XXX in non-thorough way, consider updateReportSpec ?+            q = cbcsubreportquery j+            ropts = cbcsubreportoptions $ _rsReportOpts rspec+            rspecsub = rspec{_rsReportOpts=ropts, _rsQuery=And [q, _rsQuery rspec]}+            -- Starting balances and column postings specific to this subreport.+            startbals' = startingBalances rspecsub j priceoracle $ filter (matchesPosting q) startps             colps'     = map (second $ filter (matchesPosting q)) colps-            -- We need to filter historical postings directly, rather than their accumulated balances. (#1698)-            startbals' = startingBalancesFromPostings rspec j priceoracle $ filter (matchesPosting q) startps-            ropts      = cbcsubreportoptions $ _rsReportOpts rspec-            q          = cbcsubreportquery j      -- Sum the subreport totals by column. Handle these cases:     -- - no subreports@@ -183,10 +185,12 @@      cbr = CompoundPeriodicReport "" (map fst colps) subreports overalltotals --- | Calculate starting balances from postings, if needed for -H.-startingBalancesFromPostings :: ReportSpec -> Journal -> PriceOracle -> [Posting]+-- XXX seems refactorable+-- | Calculate accounts' balances on the report start date, from these postings+-- which should be all postings before that date, and possibly also from account declarations.+startingBalances :: ReportSpec -> Journal -> PriceOracle -> [Posting]                              -> HashMap AccountName Account-startingBalancesFromPostings rspec j priceoracle ps =+startingBalances rspec j priceoracle ps =     M.findWithDefault nullacct emptydatespan       <$> calculateReportMatrix rspec j priceoracle mempty [(emptydatespan, ps)] @@ -244,46 +248,55 @@     ps = dbg5 "getPostingsByColumn" $ getPostings rspec j priceoracle     -- The date spans to be included as report columns.     colspans = dbg3 "colspans" $ splitSpan (interval_ $ _rsReportOpts rspec) reportspan-    getDate = case whichDateFromOpts (_rsReportOpts rspec) of-        PrimaryDate   -> postingDate-        SecondaryDate -> postingDate2+    getDate = postingDateOrDate2 (whichDate (_rsReportOpts rspec))  -- | Gather postings matching the query within the report period. getPostings :: ReportSpec -> Journal -> PriceOracle -> [Posting]-getPostings rspec@ReportSpec{_rsQuery=query,_rsReportOpts=ropts} j priceoracle =-    journalPostings .-    valueJournal .-    filterJournalAmounts symq $      -- remove amount parts excluded by cur:-    filterJournalPostings reportq j  -- remove postings not matched by (adjusted) query+getPostings rspec@ReportSpec{_rsQuery=query, _rsReportOpts=ropts} j priceoracle =+    journalPostings $ journalValueAndFilterPostingsWith rspec' j priceoracle   where-    symq = dbg3 "symq" . filterQuery queryIsSym $ dbg3 "requested q" query+    rspec' = rspec{_rsQuery=depthless, _rsReportOpts = ropts'}+    ropts' = if isJust (valuationAfterSum ropts)+        then ropts{value_=Nothing, cost_=NoCost}  -- If we're valuing after the sum, don't do it now+        else ropts+     -- The user's query with no depth limit, and expanded to the report span     -- if there is one (otherwise any date queries are left as-is, which     -- handles the hledger-ui+future txns case above).-    reportq = dbg3 "reportq" $ depthless query-    depthless = dbg3 "depthless" . filterQuery (not . queryIsDepth)-    valueJournal j' | isJust (valuationAfterSum ropts) = j'-                    | otherwise = journalApplyValuationFromOptsWith rspec j' priceoracle-+    depthless = dbg3 "depthless" $ filterQuery (not . queryIsDepth) query --- | Given a set of postings, eg for a single report column, gather--- the accounts that have postings and calculate the change amount for--- each. Accounts and amounts will be depth-clipped appropriately if--- a depth limit is in effect.-acctChangesFromPostings :: ReportSpec -> [Posting] -> HashMap ClippedAccountName Account-acctChangesFromPostings ReportSpec{_rsQuery=query,_rsReportOpts=ropts} ps =-    HM.fromList [(aname a, a) | a <- as]+-- | From set of postings, eg for a single report column, calculate the balance change in each account. +-- Accounts and amounts will be depth-clipped appropriately if a depth limit is in effect.+--+-- When --declared is used, accounts which have been declared with an account directive+-- are also included, with a 0 balance change. But only leaf accounts, since non-leaf+-- empty declared accounts are less useful in reports. This is primarily for hledger-ui.+acctChanges :: ReportSpec -> Journal -> [Posting] -> HashMap ClippedAccountName Account+acctChanges ReportSpec{_rsQuery=query,_rsReportOpts=ReportOpts{accountlistmode_, declared_}} j ps =+  HM.fromList [(aname a, a) | a <- accts]   where-    as = filterAccounts . drop 1 $ accountsFromPostings ps-    filterAccounts = case accountlistmode_ ropts of-        ALTree -> filter ((depthq `matchesAccount`) . aname)      -- exclude deeper balances-        ALFlat -> clipAccountsAndAggregate (queryDepth depthq) .  -- aggregate deeper balances at the depth limit.-                      filter ((0<) . anumpostings)-    depthq = dbg3 "depthq" $ filterQuery queryIsDepth query+    -- With --declared, add the query-matching declared accounts+    -- (as dummy postings so they are processed like the rest).+    -- This function is used for calculating both pre-start changes and column changes,+    -- and the declared accounts are really only needed for the former, +    -- but it's harmless to have them in the column changes as well.+    ps' = ps ++ if declared_ then declaredacctps else []+      where +        declaredacctps = +          [nullposting{paccount=n} | n <- journalLeafAccountNamesDeclared j+                                   , acctq `matchesAccount` n]+          where acctq  = dbg3 "acctq" $ filterQuery queryIsAcct query +    filterbydepth = case accountlistmode_ of+      ALTree -> filter ((depthq `matchesAccount`) . aname)    -- a tree - just exclude deeper accounts+      ALFlat -> clipAccountsAndAggregate (queryDepth depthq)  -- a list - aggregate deeper accounts at the depth limit+                . filter ((0<) . anumpostings)                -- and exclude empty parent accounts+      where depthq = dbg3 "depthq" $ filterQuery queryIsDepth query++    accts = filterbydepth $ drop 1 $ accountsFromPostings ps'+ -- | Gather the account balance changes into a regular matrix, then -- accumulate and value amounts, as specified by the report options.--- -- Makes sure all report columns have an entry. calculateReportMatrix :: ReportSpec -> Journal -> PriceOracle                       -> HashMap ClippedAccountName Account@@ -313,15 +326,15 @@         startingBalance = HM.lookupDefault nullacct name startbals         valuedStart = avalue (DateSpan Nothing historicalDate) startingBalance -    -- Transpose to get each account's balance changes across all columns, then-    -- pad with zeros-    allchanges     = ((<>zeros) <$> acctchanges) <> (zeros <$ startbals)-    acctchanges    = dbg5 "acctchanges" . addElided $ transposeMap colacctchanges-    colacctchanges = dbg5 "colacctchanges" $ map (second $ acctChangesFromPostings rspec) colps+    -- In each column, get each account's balance changes+    colacctchanges = dbg5 "colacctchanges" $ map (second $ acctChanges rspec j) colps :: [(DateSpan, HashMap ClippedAccountName Account)]+    -- Transpose it to get each account's balance changes across all columns+    acctchanges = dbg5 "acctchanges" $ transposeMap colacctchanges :: HashMap AccountName (Map DateSpan Account)+    -- Fill out the matrix with zeros in empty cells+    allchanges = ((<>zeros) <$> acctchanges) <> (zeros <$ startbals)      avalue = acctApplyBoth . mixedAmountApplyValuationAfterSumFromOptsWith ropts j priceoracle     acctApplyBoth f a = a{aibalance = f $ aibalance a, aebalance = f $ aebalance a}-    addElided = if queryDepth (_rsQuery rspec) == Just 0 then HM.insert "..." zeros else id     historicalDate = minimumMay $ mapMaybe spanStart colspans     zeros = M.fromList [(span, nullacct) | span <- colspans]     colspans = map fst colps@@ -573,14 +586,15 @@     Tab.renderTableByRowsB def{Tab.tableBorders=False, Tab.prettyTable=pretty_} renderCh renderRow   where     renderCh-      | not commodity_column_ || transpose_ = fmap (Tab.textCell Tab.TopRight)+      | commodity_layout_ /= CommodityBare || transpose_ = fmap (Tab.textCell Tab.TopRight)       | otherwise = zipWith ($) (Tab.textCell Tab.TopLeft : repeat (Tab.textCell Tab.TopRight))      renderRow (rh, row)-      | not commodity_column_ || transpose_ =+      | commodity_layout_ /= CommodityBare || transpose_ =           (Tab.textCell Tab.TopLeft rh, fmap (Tab.Cell Tab.TopRight . pure) row)       | otherwise =           (Tab.textCell Tab.TopLeft rh, zipWith ($) (Tab.Cell Tab.TopLeft : repeat (Tab.Cell Tab.TopRight)) (fmap pure row))+   -- tests

@@ -64,7 +64,7 @@ postingsReport rspec@ReportSpec{_rsReportOpts=ropts@ReportOpts{..}} j = items     where       reportspan  = reportSpanBothDates j rspec-      whichdate   = whichDateFromOpts ropts+      whichdate   = whichDate ropts       mdepth      = queryDepth $ _rsQuery rspec       multiperiod = interval_ /= NoInterval @@ -113,29 +113,23 @@ -- A helper for the postings report. matchedPostingsBeforeAndDuring :: ReportSpec -> Journal -> DateSpan -> ([Posting],[Posting]) matchedPostingsBeforeAndDuring rspec@ReportSpec{_rsReportOpts=ropts,_rsQuery=q} j reportspan =-  dbg5 "beforeps, duringps" $ span (beforestartq `matchesPosting`) beforeandduringps+    dbg5 "beforeps, duringps" $ span (beforestartq `matchesPosting`) beforeandduringps   where     beforestartq = dbg3 "beforestartq" $ dateqtype $ DateSpan Nothing $ spanStart reportspan-    beforeandduringps =-      dbg5 "ps4" $ sortOn sortdate $                                          -- sort postings by date or date2-      dbg5 "ps3" $ (if invert_ ropts then map negatePostingAmount else id) $  -- with --invert, invert amounts-                   journalPostings $-                   journalApplyValuationFromOpts rspec $                      -- convert to cost and apply valuation-      dbg5 "ps2" $ filterJournalAmounts symq $                                -- remove amount parts which the query's cur: terms would exclude-      dbg5 "ps1" $ filterJournal beforeandduringq j                           -- filter postings by the query, with no start date or depth limit+    beforeandduringps = +        sortOn (postingDateOrDate2 (whichDate ropts))            -- sort postings by date or date2+      . (if invert_ ropts then map negatePostingAmount else id)  -- with --invert, invert amounts+      . journalPostings+      $ journalValueAndFilterPostings rspec{_rsQuery=beforeandduringq} j +    -- filter postings by the query, with no start date or depth limit     beforeandduringq = dbg4 "beforeandduringq" $ And [depthless $ dateless q, beforeendq]       where         depthless  = filterQuery (not . queryIsDepth)         dateless   = filterQuery (not . queryIsDateOrDate2)         beforeendq = dateqtype $ DateSpan Nothing $ spanEnd reportspan -    sortdate = if date2_ ropts then postingDate2 else postingDate-    filterJournal = if related_ ropts then filterJournalRelatedPostings else filterJournalPostings  -- with -r, replace each posting with its sibling postings-    symq = dbg4 "symq" $ filterQuery queryIsSym q-    dateqtype-      | queryIsDate2 dateq || (queryIsDate dateq && date2_ ropts) = Date2-      | otherwise = Date+    dateqtype = if queryIsDate2 dateq || (queryIsDate dateq && date2_ ropts) then Date2 else Date       where         dateq = dbg4 "dateq" $ filterQuery queryIsDateOrDate2 $ dbg4 "q" q  -- XXX confused by multiple date:/date2: ? @@ -160,15 +154,12 @@ -- the transaction description. mkpostingsReportItem :: Bool -> Bool -> WhichDate -> Maybe Period -> Posting -> MixedAmount -> PostingsReportItem mkpostingsReportItem showdate showdesc wd mperiod p b =-  (if showdate then Just date else Nothing+  (if showdate then Just $ postingDateOrDate2 wd p else Nothing   ,mperiod   ,if showdesc then tdescription <$> ptransaction p else Nothing   ,p   ,b   )-  where-    date = case wd of PrimaryDate   -> postingDate p-                      SecondaryDate -> postingDate2 p  -- | Convert a list of postings into summary postings, one per interval, -- aggregated to the specified depth if any.@@ -178,13 +169,10 @@     concatMap (\(s,ps) -> summarisePostingsInDateSpan s wd mdepth showempty ps)     -- Group postings into their columns. We try to be efficient, since     -- there can possibly be a very large number of intervals (cf #1683)-    . groupByDateSpan showempty getDate colspans+    . groupByDateSpan showempty (postingDateOrDate2 wd) colspans   where     -- The date spans to be included as report columns.     colspans = splitSpan interval reportspan-    getDate = case wd of-        PrimaryDate   -> postingDate-        SecondaryDate -> postingDate2  -- | Given a date span (representing a report interval) and a list of -- postings within it, aggregate the postings into one summary posting per

@@ -26,6 +26,7 @@   BalanceAccumulation(..),   AccountListMode(..),   ValuationType(..),+  CommodityLayout(..),   defreportopts,   rawOptsToReportOpts,   defreportspec,@@ -38,7 +39,9 @@   tree_,   reportOptsToggleStatus,   simplifyStatuses,-  whichDateFromOpts,+  whichDate,+  journalValueAndFilterPostings,+  journalValueAndFilterPostingsWith,   journalApplyValuationFromOpts,   journalApplyValuationFromOptsWith,   mixedAmountApplyValuationAfterSumFromOptsWith,@@ -59,17 +62,18 @@ ) where -import Control.Applicative (Const(..), (<|>))-import Control.Monad ((<=<), join)+import Control.Applicative (Const(..), (<|>), liftA2)+import Control.Monad ((<=<), guard, join)+import Data.Char (toLower) import Data.Either (fromRight) import Data.Either.Extra (eitherToMaybe) import Data.Functor.Identity (Identity(..))-import Data.List.Extra (nubSort)+import Data.List.Extra (find, isPrefixOf, nubSort) import Data.Maybe (fromMaybe, mapMaybe) import qualified Data.Text as T import Data.Time.Calendar (Day, addDays) import Data.Default (Default(..))-import Safe (headMay, lastDef, lastMay, maximumMay)+import Safe (headMay, lastDef, lastMay, maximumMay, readMay)  import Text.Megaparsec.Custom @@ -105,47 +109,53 @@  instance Default AccountListMode where def = ALFlat +data CommodityLayout = CommodityWide (Maybe Int)+                     | CommodityTall+                     | CommodityBare+  deriving (Eq, Show)+ -- | Standard options for customising report filtering and output. -- Most of these correspond to standard hledger command-line options -- or query arguments, but not all. Some are used only by certain -- commands, as noted below. data ReportOpts = ReportOpts {      -- for most reports:-     period_         :: Period-    ,interval_       :: Interval-    ,statuses_       :: [Status]  -- ^ Zero, one, or two statuses to be matched-    ,cost_           :: Costing  -- ^ Should we convert amounts to cost, when present?-    ,value_          :: Maybe ValuationType  -- ^ What value should amounts be converted to ?-    ,infer_prices_   :: Bool      -- ^ Infer market prices from transactions ?-    ,depth_          :: Maybe Int-    ,date2_          :: Bool-    ,empty_          :: Bool-    ,no_elide_       :: Bool-    ,real_           :: Bool-    ,format_         :: StringFormat-    ,pretty_         :: Bool-    ,querystring_    :: [T.Text]+     period_           :: Period+    ,interval_         :: Interval+    ,statuses_         :: [Status]  -- ^ Zero, one, or two statuses to be matched+    ,cost_             :: Costing  -- ^ Should we convert amounts to cost, when present?+    ,value_            :: Maybe ValuationType  -- ^ What value should amounts be converted to ?+    ,infer_prices_     :: Bool      -- ^ Infer market prices from transactions ?+    ,depth_            :: Maybe Int+    ,date2_            :: Bool+    ,empty_            :: Bool+    ,no_elide_         :: Bool+    ,real_             :: Bool+    ,format_           :: StringFormat+    ,pretty_           :: Bool+    ,querystring_      :: [T.Text]     ---    ,average_        :: Bool+    ,average_          :: Bool     -- for posting reports (register)-    ,related_        :: Bool+    ,related_          :: Bool     -- for account transactions reports (aregister)-    ,txn_dates_      :: Bool+    ,txn_dates_        :: Bool     -- for balance reports (bal, bs, cf, is)-    ,balancecalc_    :: BalanceCalculation  -- ^ What to calculate in balance report cells-    ,balanceaccum_   :: BalanceAccumulation -- ^ How to accumulate balance report values over time-    ,budgetpat_      :: Maybe T.Text  -- ^ A case-insensitive description substring-                                      --   to select periodic transactions for budget reports.-                                      --   (Not a regexp, nor a full hledger query, for now.)-    ,accountlistmode_ :: AccountListMode-    ,drop_           :: Int-    ,row_total_      :: Bool-    ,no_total_       :: Bool-    ,show_costs_     :: Bool  -- ^ Whether to show costs for reports which normally don't show them-    ,sort_amount_    :: Bool-    ,percent_        :: Bool-    ,invert_         :: Bool  -- ^ if true, flip all amount signs in reports-    ,normalbalance_  :: Maybe NormalSign+    ,balancecalc_      :: BalanceCalculation  -- ^ What to calculate in balance report cells+    ,balanceaccum_     :: BalanceAccumulation -- ^ How to accumulate balance report values over time+    ,budgetpat_        :: Maybe T.Text  -- ^ A case-insensitive description substring+                                        --   to select periodic transactions for budget reports.+                                        --   (Not a regexp, nor a full hledger query, for now.)+    ,accountlistmode_  :: AccountListMode+    ,drop_             :: Int+    ,declared_         :: Bool  -- ^ Include accounts declared but not yet posted to ?+    ,row_total_        :: Bool+    ,no_total_         :: Bool+    ,show_costs_       :: Bool  -- ^ Show costs for reports which normally don't show them ?+    ,sort_amount_      :: Bool+    ,percent_          :: Bool+    ,invert_           :: Bool  -- ^ Flip all amount signs in reports ?+    ,normalbalance_    :: Maybe NormalSign       -- ^ This can be set when running balance reports on a set of accounts       --   with the same normal balance type (eg all assets, or all incomes).       -- - It helps --sort-amount know how to sort negative numbers@@ -153,51 +163,52 @@       -- - It helps compound balance report commands (is, bs etc.) do       --   sign normalisation, converting normally negative subreports to       --   normally positive for a more conventional display.-    ,color_          :: Bool+    ,color_            :: Bool       -- ^ Whether to use ANSI color codes in text output.       --   Influenced by the --color/colour flag (cf CliOptions),       --   whether stdout is an interactive terminal, and the value of       --   TERM and existence of NO_COLOR environment variables.-    ,transpose_      :: Bool-    ,commodity_column_:: Bool+    ,transpose_        :: Bool+    ,commodity_layout_ :: CommodityLayout  } deriving (Show)  instance Default ReportOpts where def = defreportopts  defreportopts :: ReportOpts defreportopts = ReportOpts-    { period_          = PeriodAll-    , interval_        = NoInterval-    , statuses_        = []-    , cost_            = NoCost-    , value_           = Nothing-    , infer_prices_    = False-    , depth_           = Nothing-    , date2_           = False-    , empty_           = False-    , no_elide_        = False-    , real_            = False-    , format_          = def-    , pretty_          = False-    , querystring_     = []-    , average_         = False-    , related_         = False-    , txn_dates_       = False-    , balancecalc_     = def-    , balanceaccum_    = def-    , budgetpat_       = Nothing-    , accountlistmode_ = ALFlat-    , drop_            = 0-    , row_total_       = False-    , no_total_        = False-    , show_costs_      = False-    , sort_amount_     = False-    , percent_         = False-    , invert_          = False-    , normalbalance_   = Nothing-    , color_           = False-    , transpose_       = False-    , commodity_column_ = False+    { period_           = PeriodAll+    , interval_         = NoInterval+    , statuses_         = []+    , cost_             = NoCost+    , value_            = Nothing+    , infer_prices_     = False+    , depth_            = Nothing+    , date2_            = False+    , empty_            = False+    , no_elide_         = False+    , real_             = False+    , format_           = def+    , pretty_           = False+    , querystring_      = []+    , average_          = False+    , related_          = False+    , txn_dates_        = False+    , balancecalc_      = def+    , balanceaccum_     = def+    , budgetpat_        = Nothing+    , accountlistmode_  = ALFlat+    , drop_             = 0+    , declared_         = False+    , row_total_        = False+    , no_total_         = False+    , show_costs_       = False+    , sort_amount_      = False+    , percent_          = False+    , invert_           = False+    , normalbalance_    = Nothing+    , color_            = False+    , transpose_        = False+    , commodity_layout_ = CommodityWide Nothing     }  -- | Generate a ReportOpts from raw command-line input, given a day.@@ -220,37 +231,38 @@             Just (Left err) -> usageError $ "could not parse format option: " ++ err      in defreportopts-          {period_      = periodFromRawOpts d rawopts-          ,interval_    = intervalFromRawOpts rawopts-          ,statuses_    = statusesFromRawOpts rawopts-          ,cost_        = costing-          ,value_       = valuation-          ,infer_prices_ = boolopt "infer-market-prices" rawopts-          ,depth_       = maybeposintopt "depth" rawopts-          ,date2_       = boolopt "date2" rawopts-          ,empty_       = boolopt "empty" rawopts-          ,no_elide_    = boolopt "no-elide" rawopts-          ,real_        = boolopt "real" rawopts-          ,format_      = format-          ,querystring_ = querystring-          ,average_     = boolopt "average" rawopts-          ,related_     = boolopt "related" rawopts-          ,txn_dates_   = boolopt "txn-dates" rawopts-          ,balancecalc_ = balancecalcopt rawopts-          ,balanceaccum_ = balanceaccumopt rawopts-          ,budgetpat_   = maybebudgetpatternopt rawopts-          ,accountlistmode_ = accountlistmodeopt rawopts-          ,drop_        = posintopt "drop" rawopts-          ,row_total_   = boolopt "row-total" rawopts-          ,no_total_    = boolopt "no-total" rawopts-          ,show_costs_  = boolopt "show-costs" rawopts-          ,sort_amount_ = boolopt "sort-amount" rawopts-          ,percent_     = boolopt "percent" rawopts-          ,invert_      = boolopt "invert" rawopts-          ,pretty_      = pretty-          ,color_       = useColorOnStdout -- a lower-level helper-          ,transpose_   = boolopt "transpose" rawopts-          ,commodity_column_= boolopt "commodity-column" rawopts+          {period_           = periodFromRawOpts d rawopts+          ,interval_         = intervalFromRawOpts rawopts+          ,statuses_         = statusesFromRawOpts rawopts+          ,cost_             = costing+          ,value_            = valuation+          ,infer_prices_     = boolopt "infer-market-prices" rawopts+          ,depth_            = maybeposintopt "depth" rawopts+          ,date2_            = boolopt "date2" rawopts+          ,empty_            = boolopt "empty" rawopts+          ,no_elide_         = boolopt "no-elide" rawopts+          ,real_             = boolopt "real" rawopts+          ,format_           = format+          ,querystring_      = querystring+          ,average_          = boolopt "average" rawopts+          ,related_          = boolopt "related" rawopts+          ,txn_dates_        = boolopt "txn-dates" rawopts+          ,balancecalc_      = balancecalcopt rawopts+          ,balanceaccum_     = balanceaccumopt rawopts+          ,budgetpat_        = maybebudgetpatternopt rawopts+          ,accountlistmode_  = accountlistmodeopt rawopts+          ,drop_             = posintopt "drop" rawopts+          ,declared_         = boolopt "declared" rawopts+          ,row_total_        = boolopt "row-total" rawopts+          ,no_total_         = boolopt "no-total" rawopts+          ,show_costs_       = boolopt "show-costs" rawopts+          ,sort_amount_      = boolopt "sort-amount" rawopts+          ,percent_          = boolopt "percent" rawopts+          ,invert_           = boolopt "invert" rawopts+          ,pretty_           = pretty+          ,color_            = useColorOnStdout -- a lower-level helper+          ,transpose_        = boolopt "transpose" rawopts+          ,commodity_layout_ = commoditylayoutopt rawopts           }  -- | The result of successfully parsing a ReportOpts on a particular@@ -325,6 +337,27 @@       CalcValueChange -> Just PerPeriod       _               -> Nothing +commoditylayoutopt :: RawOpts -> CommodityLayout+commoditylayoutopt rawopts = fromMaybe (CommodityWide Nothing) $ layout <|> column+  where+    layout = parse <$> maybestringopt "layout" rawopts+    column = CommodityBare <$ guard (boolopt "commodity-column" rawopts)++    parse opt = maybe err snd $ guard (not $ null s) *> find (isPrefixOf s . fst) checkNames+      where+        checkNames = [ ("wide", CommodityWide w)+                     , ("tall", CommodityTall)+                     , ("bare", CommodityBare)+                     ]+        -- For `--layout=elided,n`, elide to the given width+        (s,n) = break (==',') $ map toLower opt+        w = case drop 1 n of+              "" -> Nothing+              c | Just w <- readMay c -> Just w+              _ -> usageError "width in --layout=wide,WIDTH must be an integer"++        err = usageError "--layout's argument should be \"wide[,WIDTH]\", \"tall\", or \"bare\""+ -- Get the period specified by any -b/--begin, -e/--end and/or -p/--period -- options appearing in the command line. -- Its bounds are the rightmost begin date specified by a -b or -p, and@@ -484,8 +517,8 @@ postingDateFn ReportOpts{..} = if date2_ then postingDate2 else postingDate  -- | Report which date we will report on based on --date2.-whichDateFromOpts :: ReportOpts -> WhichDate-whichDateFromOpts ReportOpts{..} = if date2_ then SecondaryDate else PrimaryDate+whichDate :: ReportOpts -> WhichDate+whichDate ReportOpts{..} = if date2_ then SecondaryDate else PrimaryDate  -- | Legacy-compatible convenience aliases for accountlistmode_. tree_ :: ReportOpts -> Bool@@ -498,6 +531,31 @@ -- depthFromOpts :: ReportOpts -> Int -- depthFromOpts opts = min (fromMaybe 99999 $ depth_ opts) (queryDepth $ queryFromOpts nulldate opts) +-- | Convert a 'Journal''s amounts to cost and/or to value (see+-- 'journalApplyValuationFromOpts'), and filter by the 'ReportSpec' 'Query'.+--+-- We make sure to first filter by amt: and cur: terms, then value the+-- 'Journal', then filter by the remaining terms.+journalValueAndFilterPostings :: ReportSpec -> Journal -> Journal+journalValueAndFilterPostings rspec j = journalValueAndFilterPostingsWith rspec j priceoracle+  where priceoracle = journalPriceOracle (infer_prices_ $ _rsReportOpts rspec) j++-- | Like 'journalValueAndFilterPostings', but takes a 'PriceOracle' as an argument.+journalValueAndFilterPostingsWith :: ReportSpec -> Journal -> PriceOracle -> Journal+journalValueAndFilterPostingsWith rspec@ReportSpec{_rsQuery=q, _rsReportOpts=ropts} j =+    -- Filter by the remainder of the query+      filterJournal reportq+    -- Apply valuation and costing+    . journalApplyValuationFromOptsWith rspec+    -- Filter by amount and currency, so it matches pre-valuation/costing+      (if queryIsNull amtsymq then j else filterJournalAmounts amtsymq j)+  where+    -- with -r, replace each posting with its sibling postings+    filterJournal = if related_ ropts then filterJournalRelatedPostings else filterJournalPostings+    amtsymq = dbg3 "amtsymq" $ filterQuery queryIsAmtOrSym q+    reportq = dbg3 "reportq" $ filterQuery (not . queryIsAmtOrSym) q+    queryIsAmtOrSym = liftA2 (||) queryIsAmt queryIsSym+ -- | Convert this journal's postings' amounts to cost and/or to value, if specified -- by options (-B/--cost/-V/-X/--value etc.). Strip prices if not needed. This -- should be the main stop for performing costing and valuation. The exception is@@ -524,7 +582,9 @@      -- Find the end of the period containing this posting     periodEnd  = addDays (-1) . fromMaybe err . mPeriodEnd . postingDate-    mPeriodEnd = spanEnd <=< latestSpanContaining (historical : spans)+    mPeriodEnd = case interval_ ropts of+        NoInterval -> const . spanEnd $ reportSpan j rspec+        _          -> spanEnd <=< latestSpanContaining (historical : spans)     historical = DateSpan Nothing $ spanStart =<< headMay spans     spans = splitSpan (interval_ ropts) $ reportSpanBothDates j rspec     styles = journalCommodityStyles j

@@ -29,9 +29,11 @@ , prrFullName , prrDisplayName , prrDepth+, prrAdd ) where  import Data.Aeson (ToJSON(..))+import Data.Bifunctor (Bifunctor(..)) import Data.Decimal (Decimal) import Data.Maybe (mapMaybe) import Data.Text (Text)@@ -86,6 +88,9 @@   , prTotals :: PeriodicReportRow () b   -- The grand totals row.   } deriving (Show, Functor, Generic, ToJSON) +instance Bifunctor PeriodicReport where+  bimap f g pr = pr{prRows = map (bimap f g) $ prRows pr, prTotals = fmap g $ prTotals pr}+ data PeriodicReportRow a b =   PeriodicReportRow   { prrName    :: a    -- An account name.@@ -94,13 +99,23 @@   , prrAverage :: b    -- The average of this row's values.   } deriving (Show, Functor, Generic, ToJSON) +instance Bifunctor PeriodicReportRow where+  first f prr = prr{prrName = f $ prrName prr}+  second = fmap+ instance Semigroup b => Semigroup (PeriodicReportRow a b) where-  (PeriodicReportRow _ amts1 t1 a1) <> (PeriodicReportRow n2 amts2 t2 a2) =-      PeriodicReportRow n2 (sumPadded amts1 amts2) (t1 <> t2) (a1 <> a2)-    where-      sumPadded (a:as) (b:bs) = (a <> b) : sumPadded as bs-      sumPadded as     []     = as-      sumPadded []     bs     = bs+  (<>) = prrAdd++-- | Add two 'PeriodicReportRows', preserving the name of the first.+prrAdd :: Semigroup b => PeriodicReportRow a b -> PeriodicReportRow a b -> PeriodicReportRow a b+prrAdd (PeriodicReportRow n1 amts1 t1 a1) (PeriodicReportRow _ amts2 t2 a2) =+    PeriodicReportRow n1 (zipWithPadded (<>) amts1 amts2) (t1 <> t2) (a1 <> a2)++-- | Version of 'zipWith' which will not end on the shortest list, but will copy the rest of the longer list.+zipWithPadded :: (a -> a -> a) -> [a] -> [a] -> [a]+zipWithPadded f (a:as) (b:bs) = f a b : zipWithPadded f as bs+zipWithPadded _ as     []     = as+zipWithPadded _ []     bs     = bs  -- | Figure out the overall date span of a PeriodicReport periodicReportSpan :: PeriodicReport a b -> DateSpan

@@ -59,6 +59,7 @@ import Hledger.Utils.String import Hledger.Utils.Text import Hledger.Utils.Test+import Data.Tree (foldTree, Tree)   -- tuples@@ -116,6 +117,11 @@   where     split es = let (first,rest) = break (x==) es                in first : splitAtElement x rest++-- trees++treeLeaves :: Tree a -> [a]+treeLeaves = foldTree (\a bs -> (if null bs then (a:) else id) $ concat bs)  -- text 

@@ -93,7 +93,7 @@   ,module Debug.Trace   ,useColorOnStdout   ,useColorOnStderr-  )+  ,dlog) where  import           Control.Monad (when)@@ -304,6 +304,10 @@                             --     | otherwise     = ls                         -- in trace (s++":"++nlorspace++intercalate "\n" ls') a                         in trace p a++-- | Log a pretty-printed showable value to "./debug.log". Uses unsafePerformIO.+dlog :: Show a => a -> a+dlog x = unsafePerformIO $ appendFile "debug.log" (pshow x ++ "\n") >> return x  -- "dbg" would clash with megaparsec. -- | Pretty-print a label and the showable value to the console, then return it.

@@ -42,7 +42,7 @@  import Hledger.Utils.Parse import Hledger.Utils.Regex (toRegex', regexReplace)-import Text.WideString (charWidth, strWidth)+import Text.DocLayout (charWidth, realLength)   -- | Take elements from the end of a list.@@ -173,6 +173,10 @@ -- adding ANSI escape sequences, but is being kept around for now. strWidthAnsi :: String -> Int strWidthAnsi = strWidth . stripAnsi++-- | Alias for 'realLength'.+strWidth :: String -> Int+strWidth = realLength  -- | Strip ANSI escape sequences from a string. --

@@ -43,7 +43,6 @@   wbToText,   wbFromText,   wbUnpack,-  textWidth,   textTakeWidth,   -- * Reading   readDecimal,@@ -58,12 +57,13 @@ import qualified Data.Text as T import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Builder as TB+import Text.DocLayout (charWidth, realLength)  import Test.Tasty (testGroup) import Test.Tasty.HUnit ((@?=), testCase) import Text.Tabular.AsciiWide   (Align(..), Header(..), Properties(..), TableOpts(..), renderRow, textCell)-import Text.WideString (WideBuilder(..), wbToText, wbFromText, wbUnpack, charWidth, textWidth)+import Text.WideString (WideBuilder(..), wbToText, wbFromText, wbUnpack)   -- lowercase, uppercase :: String -> String@@ -206,7 +206,7 @@     clip s =       case mmaxwidth of         Just w-          | textWidth s > w ->+          | realLength s > w ->             if rightside               then textTakeWidth (w - T.length ellipsis) s <> ellipsis               else ellipsis <> T.reverse (textTakeWidth (w - T.length ellipsis) $ T.reverse s)@@ -224,7 +224,7 @@               else T.replicate (w - sw) " " <> s           | otherwise -> s         Nothing -> s-      where sw = textWidth s+      where sw = realLength s  -- | Double-width-character-aware string truncation. Take as many -- characters as possible from a string without exceeding the

@@ -47,9 +47,6 @@ ) where -import Prelude ()-import "base-compat-batteries" Prelude.Compat hiding (readFile)- import Control.Monad.Except import Control.Monad.State.Strict (StateT, evalStateT) import qualified Data.List.NonEmpty as NE

@@ -35,7 +35,7 @@ import Data.Text.Lazy.Builder (Builder, fromString, fromText, singleton, toLazyText) import Safe (maximumMay) import Text.Tabular-import Text.WideString (WideBuilder(..), wbFromText, textWidth)+import Text.WideString (WideBuilder(..), wbFromText)   -- | The options to use for rendering a table.@@ -63,7 +63,7 @@  -- | Create a single-line cell from the given contents with its natural width. textCell :: Align -> Text -> Cell-textCell a x = Cell a . map (\x -> WideBuilder (fromText x) (textWidth x)) $ if T.null x then [""] else T.lines x+textCell a x = Cell a . map wbFromText $ if T.null x then [""] else T.lines x  -- | Create a multi-line cell from the given contents with its natural width. textsCell :: Align -> [Text] -> Cell

@@ -1,10 +1,6 @@ -- | Calculate the width of String and Text, being aware of wide characters.  module Text.WideString (-  -- * wide-character-aware layout-  strWidth,-  textWidth,-  charWidth,   -- * Text Builders which keep track of length   WideBuilder(..),   wbUnpack,@@ -13,9 +9,9 @@   ) where  import Data.Text (Text)-import qualified Data.Text as T import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Builder as TB+import Text.DocLayout (realLength)   -- | Helper for constructing Builders while keeping track of text width.@@ -36,68 +32,8 @@  -- | Convert a strict Text to a WideBuilder. wbFromText :: Text -> WideBuilder-wbFromText t = WideBuilder (TB.fromText t) (textWidth t)+wbFromText t = WideBuilder (TB.fromText t) (realLength t)  -- | Convert a WideBuilder to a String. wbUnpack :: WideBuilder -> String wbUnpack = TL.unpack . TB.toLazyText . wbBuilder----- | Calculate the render width of a string, considering--- wide characters (counted as double width)-strWidth :: String -> Int-strWidth = foldr (\a b -> charWidth a + b) 0---- | Calculate the render width of a string, considering--- wide characters (counted as double width)-textWidth :: Text -> Int-textWidth = T.foldr (\a b -> charWidth a + b) 0---- from Pandoc (copyright John MacFarlane, GPL)--- see also http://unicode.org/reports/tr11/#Description---- | Get the designated render width of a character: 0 for a combining--- character, 1 for a regular character, 2 for a wide character.--- (Wide characters are rendered as exactly double width in apps and--- fonts that support it.) (From Pandoc.)-charWidth :: Char -> Int-charWidth c-    | c <  '\x0300'                    = 1-    | c >= '\x0300' && c <= '\x036F'   = 0  -- combining-    | c >= '\x0370' && c <= '\x10FC'   = 1-    | c >= '\x1100' && c <= '\x115F'   = 2-    | c >= '\x1160' && c <= '\x11A2'   = 1-    | c >= '\x11A3' && c <= '\x11A7'   = 2-    | c >= '\x11A8' && c <= '\x11F9'   = 1-    | c >= '\x11FA' && c <= '\x11FF'   = 2-    | c >= '\x1200' && c <= '\x2328'   = 1-    | c >= '\x2329' && c <= '\x232A'   = 2-    | c >= '\x232B' && c <= '\x2E31'   = 1-    | c >= '\x2E80' && c <= '\x303E'   = 2-    | c == '\x303F'                    = 1-    | c >= '\x3041' && c <= '\x3247'   = 2-    | c >= '\x3248' && c <= '\x324F'   = 1 -- ambiguous-    | c >= '\x3250' && c <= '\x4DBF'   = 2-    | c >= '\x4DC0' && c <= '\x4DFF'   = 1-    | c >= '\x4E00' && c <= '\xA4C6'   = 2-    | c >= '\xA4D0' && c <= '\xA95F'   = 1-    | c >= '\xA960' && c <= '\xA97C'   = 2-    | c >= '\xA980' && c <= '\xABF9'   = 1-    | c >= '\xAC00' && c <= '\xD7FB'   = 2-    | c >= '\xD800' && c <= '\xDFFF'   = 1-    | c >= '\xE000' && c <= '\xF8FF'   = 1 -- ambiguous-    | c >= '\xF900' && c <= '\xFAFF'   = 2-    | c >= '\xFB00' && c <= '\xFDFD'   = 1-    | c >= '\xFE00' && c <= '\xFE0F'   = 1 -- ambiguous-    | c >= '\xFE10' && c <= '\xFE19'   = 2-    | c >= '\xFE20' && c <= '\xFE26'   = 1-    | c >= '\xFE30' && c <= '\xFE6B'   = 2-    | c >= '\xFE70' && c <= '\xFEFF'   = 1-    | c >= '\xFF01' && c <= '\xFF60'   = 2-    | c >= '\xFF61' && c <= '\x16A38'  = 1-    | c >= '\x1B000' && c <= '\x1B001' = 2-    | c >= '\x1D000' && c <= '\x1F1FF' = 1-    | c >= '\x1F200' && c <= '\x1F251' = 2-    | c >= '\x1F300' && c <= '\x1F773' = 1-    | c >= '\x20000' && c <= '\x3FFFD' = 2-    | otherwise                        = 1

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           hledger-lib-version:        1.23+version:        1.24 synopsis:       A reusable library providing the core functionality of hledger description:    A reusable library containing hledger's core functionality.                 This is used by most hledger* packages so that they support the same@@ -100,7 +100,6 @@     , ansi-terminal >=0.9     , array     , base >=4.11 && <4.16-    , base-compat-batteries >=0.10.1 && <0.12     , blaze-markup >=0.5.1     , bytestring     , call-stack@@ -110,18 +109,19 @@     , containers >=0.5.9     , data-default >=0.5     , directory+    , doclayout ==0.3.*     , extra >=1.6.3     , file-embed >=0.0.10     , filepath     , hashtables >=1.2.3.1-    , megaparsec >=7.0.0 && <9.2+    , megaparsec >=7.0.0 && <9.3     , microlens >=0.4     , microlens-th >=0.4     , mtl >=2.2.1     , parser-combinators >=0.4.0     , pretty-simple >4 && <5     , regex-tdfa-    , safe >=0.2+    , safe >=0.3.18     , tabular >=0.2     , tasty >=1.2.3     , tasty-hunit >=0.10.0.2@@ -150,7 +150,6 @@     , ansi-terminal >=0.9     , array     , base >=4.11 && <4.16-    , base-compat-batteries >=0.10.1 && <0.12     , blaze-markup >=0.5.1     , bytestring     , call-stack@@ -160,19 +159,20 @@     , containers >=0.5.9     , data-default >=0.5     , directory+    , doclayout ==0.3.*     , doctest >=0.18.1     , extra >=1.6.3     , file-embed >=0.0.10     , filepath     , hashtables >=1.2.3.1-    , megaparsec >=7.0.0 && <9.2+    , megaparsec >=7.0.0 && <9.3     , microlens >=0.4     , microlens-th >=0.4     , mtl >=2.2.1     , parser-combinators >=0.4.0     , pretty-simple >4 && <5     , regex-tdfa-    , safe >=0.2+    , safe >=0.3.18     , tabular >=0.2     , tasty >=1.2.3     , tasty-hunit >=0.10.0.2@@ -203,7 +203,6 @@     , ansi-terminal >=0.9     , array     , base >=4.11 && <4.16-    , base-compat-batteries >=0.10.1 && <0.12     , blaze-markup >=0.5.1     , bytestring     , call-stack@@ -213,19 +212,20 @@     , containers >=0.5.9     , data-default >=0.5     , directory+    , doclayout ==0.3.*     , extra >=1.6.3     , file-embed >=0.0.10     , filepath     , hashtables >=1.2.3.1     , hledger-lib-    , megaparsec >=7.0.0 && <9.2+    , megaparsec >=7.0.0 && <9.3     , microlens >=0.4     , microlens-th >=0.4     , mtl >=2.2.1     , parser-combinators >=0.4.0     , pretty-simple >4 && <5     , regex-tdfa-    , safe >=0.2+    , safe >=0.3.18     , tabular >=0.2     , tasty >=1.2.3     , tasty-hunit >=0.10.0.2