hledger-lib 1.32.3 → 1.33

raw patch · 35 files changed

+2547/−3766 lines, 35 filesdep −doctestdep ~Globdep ~basedep ~safePVP ok

version bump matches the API change (PVP)

Dependencies removed: doctest

Dependency ranges changed: Glob, base, safe

API changes (from Hackage documentation)

Files

• CHANGES.md +49/−5
• Hledger/Data/Account.hs +5/−5
• Hledger/Data/AccountName.hs +1/−1
• Hledger/Data/Amount.hs +238/−225
• Hledger/Data/Balancing.hs +28/−18
• Hledger/Data/Dates.hs +67/−24
• Hledger/Data/Errors.hs +2/−2
• Hledger/Data/Journal.hs +6/−6
• Hledger/Data/JournalChecks.hs +16/−9
• Hledger/Data/JournalChecks/Uniqueleafnames.hs +9/−4
• Hledger/Data/Json.hs +2/−2
• Hledger/Data/Ledger.hs +1/−1
• Hledger/Data/Posting.hs +17/−19
• Hledger/Data/Transaction.hs +6/−6
• Hledger/Data/TransactionModifier.hs +4/−3
• Hledger/Data/Types.hs +67/−30
• Hledger/Data/Valuation.hs +5/−5
• Hledger/Query.hs +91/−49
• Hledger/Read.hs +13/−9
• Hledger/Read/Common.hs +47/−36
• Hledger/Read/CsvReader.hs +8/−8
• Hledger/Read/JournalReader.hs +37/−19
• Hledger/Read/RulesReader.hs +1553/−3028
• Hledger/Read/TimeclockReader.hs +1/−1
• Hledger/Read/TimedotReader.hs +1/−1
• Hledger/Reports/AccountTransactionsReport.hs +1/−1
• Hledger/Reports/BudgetReport.hs +231/−165
• Hledger/Reports/MultiBalanceReport.hs +9/−7
• Hledger/Reports/PostingsReport.hs +2/−2
• Hledger/Reports/ReportOptions.hs +1/−1
• Hledger/Reports/ReportTypes.hs +15/−2
• Hledger/Utils/IO.hs +3/−2
• Hledger/Utils/Parse.hs +2/−1
• Hledger/Utils/String.hs +4/−3
• hledger-lib.cabal +5/−66

@@ -1,19 +1,63 @@ <!--- _ _ _     -| (_) |__  -| | | '_ \ + _ _ _+| (_) |__+| | | '_ \ | | | |_) |-|_|_|_.__/ -           +|_|_|_.__/+ Breaking changes  Fixes  Improvements ++++++ --> Internal/api/developer-ish changes in the hledger-lib (and hledger) packages. For user-visible changes, see the hledger package changelog.++# 1.33 2024-04-18++Breaking changes++Fixes++- Require process 1.6.19.0+ to avoid any vulnerabilities on Windows from+  [HSEC-2024-0003](https://haskell.github.io/security-advisories/advisory/HSEC-2024-0003.html).+  This has also required disabling this package's doctest test suite for the moment.++- A potential Glob/filemanip package conflict in Hledger.Utils.IO now prevented,+  avoiding build failures.+++Improvements++- hledger can now be built with GHC 9.8.+- hledger now requires safe >=0.3.20.+- fix spanUnion with open-ended dates; add spanExtend [#2177]+- move readFileStrictly from hledger to Hledger.Utils.IO+- rename/improve amountSetFullPrecisionUpTo; add mixedAmountSetFullPrecisionUpTo+- rename Amount's aprice -> acost+- rename AmountPrice, UnitPrice, TotalPrice -> AmountCost, UnitCost, TotalCost+- showAmountWithoutPrice             -> showAmountWithoutCost+- mixedAmountStripPrices             -> mixedAmountStripCosts+- showMixedAmountWithoutPrice        -> showMixedAmountWithoutCost+- showMixedAmountOneLineWithoutPrice -> showMixedAmountOneLineWithoutCost+- rename amountStripPrices           -> amountStripCost, etc+- rename AmountDisplayOpts -> AmountFormat; add a new flag for symbol display+- rename noColour          -> defaultFmt+- rename noCost            -> noCostFmt+- rename oneLine           -> oneLineFmt+- rename csvDisplay        -> machineFmt+- distinguish oneLineFmt and oneLineNoCostFmt; add fullZeroFmt+- matchedPostingsBeforeAndDuring: improve debug output++  # 1.32.3 2024-01-28 

@@ -52,8 +52,8 @@                        aname                        (if aboring then "y" else "n" :: String)                        anumpostings-                       (wbUnpack $ showMixedAmountB noColour aebalance)-                       (wbUnpack $ showMixedAmountB noColour aibalance)+                       (wbUnpack $ showMixedAmountB defaultFmt aebalance)+                       (wbUnpack $ showMixedAmountB defaultFmt aibalance)  instance Eq Account where   (==) a b = aname a == aname b -- quick equality test for speed@@ -243,7 +243,7 @@     sortSubs = case normalsign of         NormallyPositive -> sortOn (\a -> (Down $ amt a, aname a))         NormallyNegative -> sortOn (\a -> (amt a, aname a))-    amt = mixedAmountStripPrices . aibalance+    amt = mixedAmountStripCosts . aibalance  -- | Add extra info for this account derived from the Journal's -- account directives, if any (comment, tags, declaration order..).@@ -303,6 +303,6 @@  showAccountDebug a = printf "%-25s %4s %4s %s"                      (aname a)-                     (wbUnpack . showMixedAmountB noColour $ aebalance a)-                     (wbUnpack . showMixedAmountB noColour $ aibalance a)+                     (wbUnpack . showMixedAmountB defaultFmt $ aebalance a)+                     (wbUnpack . showMixedAmountB defaultFmt $ aibalance a)                      (if aboring a then "b" else " " :: String)

@@ -311,7 +311,7 @@         elideparts :: Int -> [Text] -> [Text] -> [Text]         elideparts w done ss           | realLength (accountNameFromComponents $ done++ss) <= w = done++ss-          | length ss > 1 = elideparts w (done++[textTakeWidth 2 $ head ss]) (tail ss)+          | length ss > 1 = elideparts w (done++[textTakeWidth 2 $ headErr ss]) (tailErr ss)  -- PARTIAL headErr, tailErr will succeed because length > 1           | otherwise = done++ss  -- | Keep only the first n components of an account name, where n

@@ -12,13 +12,13 @@   0 @ -It may also have an assigned 'Price', representing this amount's per-unit+It may also have an 'AmountCost', representing this amount's per-unit or total cost in a different commodity. If present, this is rendered like so:  @-  EUR 2 \@ $1.50  (unit price)-  EUR 2 \@\@ $3   (total price)+  EUR 2 \@ $1.50  (unit cost)+  EUR 2 \@\@ $3   (total cost) @  A 'MixedAmount' is zero or more simple amounts, so can represent multiple@@ -31,12 +31,11 @@ @  A mixed amount is always \"normalised\", it has no more than one amount-in each commodity and price. When calling 'amounts' it will have no zero+in each commodity and cost. When calling 'amounts' it will have no zero amounts, or just a single zero amount and no other amounts.  Limited arithmetic with simple and mixed amounts is supported, best used-with similar amounts since it mostly ignores assigned prices and commodity-exchange rates.+with similar amounts since it mostly ignores costss and commodity exchange rates.  -} @@ -78,25 +77,27 @@   amountStylesSetRounding,   amountUnstyled,   -- ** rendering-  AmountDisplayOpts(..),-  noColour,-  noCost,-  oneLine,-  csvDisplay,-  showAmountB,+  AmountFormat(..),+  defaultFmt,+  fullZeroFmt,+  noCostFmt,+  oneLineFmt,+  oneLineNoCostFmt,+  machineFmt,   showAmount,   showAmountWith,-  showAmountCostB,+  showAmountB,+  showAmountsCostB,   cshowAmount,   showAmountWithZeroCommodity,   showAmountDebug,-  showAmountWithoutPrice,+  showAmountWithoutCost,   amountSetPrecision,   amountSetPrecisionMin,   amountSetPrecisionMax,   withPrecision,   amountSetFullPrecision,-  amountSetFullPrecisionOr,+  amountSetFullPrecisionUpTo,   amountInternalPrecision,   amountDisplayPrecision,   defaultMaxPrecision,@@ -122,7 +123,7 @@   filterMixedAmountByCommodity,   mapMixedAmount,   unifyMixedAmount,-  mixedAmountStripPrices,+  mixedAmountStripCosts,   -- ** arithmetic   mixedAmountCost,   maNegate,@@ -148,8 +149,8 @@   showMixedAmountWith,   showMixedAmountOneLine,   showMixedAmountDebug,-  showMixedAmountWithoutPrice,-  showMixedAmountOneLineWithoutPrice,+  showMixedAmountWithoutCost,+  showMixedAmountOneLineWithoutCost,   showMixedAmountElided,   showMixedAmountWithZeroCommodity,   showMixedAmountB,@@ -158,6 +159,7 @@   wbUnpack,   mixedAmountSetPrecision,   mixedAmountSetFullPrecision,+  mixedAmountSetFullPrecisionUpTo,   mixedAmountSetPrecisionMin,   mixedAmountSetPrecisionMax, @@ -217,10 +219,10 @@   | T.any isNonsimpleCommodityChar s = "\"" <> s <> "\""   | otherwise = s ---- | Options for the display of Amount and MixedAmount.--- (ee also Types.AmountStyle.-data AmountDisplayOpts = AmountDisplayOpts+-- | Formatting options available when displaying Amounts and MixedAmounts.+-- Similar to "AmountStyle" but lower level, not attached to amounts or commodities, and can override it in some ways.+-- See also hledger manual > "Amount formatting, parseability", which speaks of human, hledger, and machine output.+data AmountFormat = AmountFormat   { displayCommodity        :: Bool       -- ^ Whether to display commodity symbols.   , displayZeroCommodity    :: Bool       -- ^ Whether to display commodity symbols for zero Amounts.   , displayCommodityOrder   :: Maybe [CommoditySymbol]@@ -237,17 +239,17 @@   , displayColour           :: Bool       -- ^ Whether to ansi-colourise negative Amounts.   } deriving (Show) --- | By default, display Amount and MixedAmount using @noColour@ amount display options.-instance Default AmountDisplayOpts where def = noColour+-- | By default, display amounts using @defaultFmt@ amount display options.+instance Default AmountFormat where def = defaultFmt  -- | Display amounts without colour, and with various other defaults.-noColour :: AmountDisplayOpts-noColour = AmountDisplayOpts {+defaultFmt :: AmountFormat+defaultFmt = AmountFormat {     displayCommodity        = True   , displayZeroCommodity    = False   , displayCommodityOrder   = Nothing   , displayDigitGroups      = True-  , displayForceDecimalMark   = False+  , displayForceDecimalMark = False   , displayOneLine          = False   , displayMinWidth         = Just 0   , displayMaxWidth         = Nothing@@ -255,18 +257,26 @@   , displayColour           = False   } --- | Display Amount and MixedAmount with no prices.-noCost :: AmountDisplayOpts-noCost = def{displayCost=False}+-- | Like defaultFmt but show zero amounts with commodity symbol and styling, like non-zero amounts.+fullZeroFmt :: AmountFormat+fullZeroFmt = defaultFmt{displayZeroCommodity=True} --- | Display Amount and MixedAmount on one line with no prices.-oneLine :: AmountDisplayOpts-oneLine = def{displayOneLine=True, displayCost=False}+-- | Like defaultFmt but don't show costs.+noCostFmt :: AmountFormat+noCostFmt = defaultFmt{displayCost=False} --- | Display Amount and MixedAmount in a form suitable for CSV output.-csvDisplay :: AmountDisplayOpts-csvDisplay = oneLine{displayDigitGroups=False}+-- | Like defaultFmt but display all amounts on one line.+oneLineFmt :: AmountFormat+oneLineFmt = defaultFmt{displayOneLine=True} +-- | Like noCostFmt but display all amounts on one line.+oneLineNoCostFmt :: AmountFormat+oneLineNoCostFmt = noCostFmt{displayOneLine=True}++-- | A (slightly more) machine-readable amount format; like oneLineNoCostFmt but don't show digit group marks.+machineFmt :: AmountFormat+machineFmt = oneLineNoCostFmt{displayDigitGroups=False}+ ------------------------------------------------------------------------------- -- Amount arithmetic @@ -282,7 +292,7 @@ -- | The empty simple amount - a zero with no commodity symbol or cost -- and the default amount display style. nullamt :: Amount-nullamt = Amount{acommodity="", aquantity=0, aprice=Nothing, astyle=amountstyle}+nullamt = Amount{acommodity="", aquantity=0, acost=Nothing, astyle=amountstyle}  -- | A special amount used as a marker, meaning -- "no explicit amount provided here, infer it when needed".@@ -299,15 +309,15 @@ eur n = nullamt{acommodity="€", aquantity=roundTo 2 n, astyle=amountstyle{asprecision=Precision 2}} gbp n = nullamt{acommodity="£", aquantity=roundTo 2 n, astyle=amountstyle{asprecision=Precision 2}} per n = nullamt{acommodity="%", aquantity=n,           astyle=amountstyle{asprecision=Precision 1, ascommodityside=R, ascommodityspaced=True}}-amt `at` priceamt = amt{aprice=Just $ UnitPrice priceamt}-amt @@ priceamt = amt{aprice=Just $ TotalPrice priceamt}+amt `at` costamt = amt{acost=Just $ UnitCost costamt}+amt @@ costamt = amt{acost=Just $ TotalCost costamt}  -- | Apply a binary arithmetic operator to two amounts, which should -- be in the same commodity if non-zero (warning, this is not checked). -- A zero result keeps the commodity of the second amount. -- The result's display style is that of the second amount, with -- precision set to the highest of either amount.--- Prices are ignored and discarded.+-- Costs are ignored and discarded. -- Remember: the caller is responsible for ensuring both amounts have the same commodity. similarAmountsOp :: (Quantity -> Quantity -> Quantity) -> Amount -> Amount -> Amount similarAmountsOp op Amount{acommodity=_,  aquantity=q1, astyle=AmountStyle{asprecision=p1}}@@ -318,41 +328,42 @@   --  otherwise = error "tried to do simple arithmetic with amounts in different commodities"  -- | Convert an amount to the specified commodity, ignoring and discarding--- any assigned prices and assuming an exchange rate of 1.+-- any costs and assuming an exchange rate of 1. amountWithCommodity :: CommoditySymbol -> Amount -> Amount-amountWithCommodity c a = a{acommodity=c, aprice=Nothing}+amountWithCommodity c a = a{acommodity=c, acost=Nothing} --- | Convert a amount to its "cost" or "selling price" in another commodity,--- using its attached transaction price if it has one.  Notes:+-- | Convert a amount to its total cost in another commodity,+-- using its attached cost amount if it has one.  Notes: ----- - price amounts must be MixedAmounts with exactly one component Amount+-- - cost amounts must be MixedAmounts with exactly one component Amount --   (or there will be a runtime error XXX) ----- - price amounts should be positive in the Journal+-- - cost amounts should be positive in the Journal --   (though this is currently not enforced)+-- amountCost :: Amount -> Amount-amountCost a@Amount{aquantity=q, aprice=mp} =+amountCost a@Amount{aquantity=q, acost=mp} =     case mp of       Nothing                                  -> a-      Just (UnitPrice  p@Amount{aquantity=pq}) -> p{aquantity=pq * q}-      Just (TotalPrice p@Amount{aquantity=pq}) -> p{aquantity=pq}+      Just (UnitCost  p@Amount{aquantity=pq}) -> p{aquantity=pq * q}+      Just (TotalCost p@Amount{aquantity=pq}) -> p{aquantity=pq} --- | Strip all prices from an Amount+-- | Strip all costs from an Amount amountStripCost :: Amount -> Amount-amountStripCost a = a{aprice=Nothing}+amountStripCost a = a{acost=Nothing} --- | Apply a function to an amount's quantity (and its total price, if it has one).+-- | Apply a function to an amount's quantity (and its total cost, if it has one). transformAmount :: (Quantity -> Quantity) -> Amount -> Amount-transformAmount f a@Amount{aquantity=q,aprice=p} = a{aquantity=f q, aprice=f' <$> p}+transformAmount f a@Amount{aquantity=q,acost=p} = a{aquantity=f q, acost=f' <$> p}   where-    f' (TotalPrice a1@Amount{aquantity=pq}) = TotalPrice a1{aquantity = f pq}+    f' (TotalCost a1@Amount{aquantity=pq}) = TotalCost a1{aquantity = f pq}     f' p' = p'  -- | Divide an amount's quantity (and total cost, if any) by some number. divideAmount :: Quantity -> Amount -> Amount divideAmount n = transformAmount (/n) --- | Multiply an amount's quantity (and its total price, if it has one) by a constant.+-- | Multiply an amount's quantity (and its total cost, if it has one) by a constant. multiplyAmount :: Quantity -> Amount -> Amount multiplyAmount n = transformAmount (*n) @@ -361,7 +372,7 @@ invertAmount :: Amount -> Amount invertAmount a@Amount{aquantity=q} = a{aquantity=1/q} --- | Is this amount negative ? The price is ignored.+-- | Is this amount negative ? The cost is ignored. isNegativeAmount :: Amount -> Bool isNegativeAmount Amount{aquantity=q} = q < 0 @@ -372,26 +383,26 @@     NaturalPrecision -> q     Precision p      -> roundTo p q --- | Apply a test to both an Amount and its total price, if it has one.-testAmountAndTotalPrice :: (Amount -> Bool) -> Amount -> Bool-testAmountAndTotalPrice f amt = case aprice amt of-    Just (TotalPrice price) -> f amt && f price+-- | Apply a test to both an Amount and its total cost, if it has one.+testAmountAndTotalCost :: (Amount -> Bool) -> Amount -> Bool+testAmountAndTotalCost f amt = case acost amt of+    Just (TotalCost cost) -> f amt && f cost     _                       -> f amt --- | Do this Amount and (and its total price, if it has one) appear to be zero+-- | Do this Amount and (and its total cost, if it has one) appear to be zero -- when rendered with its display precision ? -- The display precision should usually have a specific value here; -- if unset, it will be treated like NaturalPrecision. amountLooksZero :: Amount -> Bool-amountLooksZero = testAmountAndTotalPrice looksZero+amountLooksZero = testAmountAndTotalCost looksZero   where     looksZero Amount{aquantity=Decimal e q, astyle=AmountStyle{asprecision=p}} = case p of         Precision d      -> if e > d then abs q <= 5*10^(e-d-1) else q == 0         NaturalPrecision -> q == 0 --- | Is this Amount (and its total price, if it has one) exactly zero, ignoring its display precision ?+-- | Is this Amount (and its total cost, if it has one) exactly zero, ignoring its display precision ? amountIsZero :: Amount -> Bool-amountIsZero = testAmountAndTotalPrice (\Amount{aquantity=Decimal _ q} -> q == 0)+amountIsZero = testAmountAndTotalCost (\Amount{aquantity=Decimal _ q} -> q == 0)  -- | Does this amount's internal Decimal representation have the -- maximum number of digits, suggesting that it probably is@@ -443,24 +454,26 @@   -- | We often want to display "infinite decimal" amounts rounded to some readable--- number of digits, while still displaying amounts with a large "non infinite" number--- of decimal digits (eg, 100 or 200 digits) in full.+-- number of digits, while still displaying amounts with a large but "non infinite"+-- number of decimal digits (eg 10 or 100 or 200 digits) in full. -- This helper is like amountSetFullPrecision, but with some refinements:--- 1. If the internal precision is the maximum (255), indicating an infinite decimal, --- the display precision is set to a smaller hard-coded default (8).--- 2. A maximum display precision can be specified, setting a hard upper limit.+--+-- 1. A maximum display precision can be specified, setting a hard upper limit.+--+-- 2. If no limit is specified, and the internal precision is the maximum (255),+-- indicating an infinite decimal, display precision is set to a smaller default (8).+-- -- This function always sets an explicit display precision (ie, Precision n).-amountSetFullPrecisionOr :: Maybe Word8 -> Amount -> Amount-amountSetFullPrecisionOr mmaxp a = amountSetPrecision (Precision p2) a+--+amountSetFullPrecisionUpTo :: Maybe Word8 -> Amount -> Amount+amountSetFullPrecisionUpTo mmaxp a = amountSetPrecision (Precision p) a   where-    p1 = if -- dbg0 "maxdigits" $-            amountHasMaxDigits a then defaultMaxPrecision else max disp intp-      -- & dbg0 "p1"+    p = case mmaxp of+      Just maxp -> min maxp $ max disp intp+      Nothing   -> if amountHasMaxDigits a then defaultMaxPrecision else max disp intp       where-        intp = amountInternalPrecision a         disp = amountDisplayPrecision a-    p2 = maybe p1 (min p1) mmaxp-      -- & dbg0 "p2"+        intp = amountInternalPrecision a  -- | The fallback display precision used when showing amounts -- representing an infinite decimal.@@ -517,15 +530,15 @@   -- except that costs' precision is never changed (costs are often recorded inexactly,   -- so we don't want to imply greater precision than they were recorded with).   -- If no style is found for an amount, it is left unchanged.-  styleAmounts styles a@Amount{aquantity=qty, acommodity=comm, astyle=oldstyle, aprice=mcost0} =-    a{astyle=newstyle, aprice=mcost1}+  styleAmounts styles a@Amount{aquantity=qty, acommodity=comm, astyle=oldstyle, acost=mcost0} =+    a{astyle=newstyle, acost=mcost1}     where       newstyle = mknewstyle False qty oldstyle comm         mcost1 = case mcost0 of         Nothing -> Nothing-        Just (UnitPrice  ca@Amount{aquantity=cq, astyle=cs, acommodity=ccomm}) -> Just $ UnitPrice  ca{astyle=mknewstyle True cq cs ccomm}-        Just (TotalPrice ca@Amount{aquantity=cq, astyle=cs, acommodity=ccomm}) -> Just $ TotalPrice ca{astyle=mknewstyle True cq cs ccomm}+        Just (UnitCost  ca@Amount{aquantity=cq, astyle=cs, acommodity=ccomm}) -> Just $ UnitCost  ca{astyle=mknewstyle True cq cs ccomm}+        Just (TotalCost ca@Amount{aquantity=cq, astyle=cs, acommodity=ccomm}) -> Just $ TotalCost ca{astyle=mknewstyle True cq cs ccomm}        mknewstyle :: Bool -> Quantity -> AmountStyle -> CommoditySymbol -> AmountStyle       mknewstyle iscost oldq olds com =@@ -595,12 +608,13 @@     HardRounding -> news{asprecision=if iscost then oldp else newp}     AllRounding  -> news --- | Set this amount style's rounding strategy when being applied to amounts.+-- | Set this amount style's rounding strategy when it is being applied to amounts. amountStyleSetRounding :: Rounding -> AmountStyle -> AmountStyle amountStyleSetRounding r as = as{asrounding=r} +-- | Set these amount styles' rounding strategy when they are being applied to amounts. amountStylesSetRounding :: Rounding -> M.Map CommoditySymbol AmountStyle -> M.Map CommoditySymbol AmountStyle-amountStylesSetRounding r = M.map (amountStyleSetRounding r) +amountStylesSetRounding r = M.map (amountStyleSetRounding r)  -- | Default amount style amountstyle = AmountStyle L False Nothing (Just '.') (Precision 0) NoRounding@@ -619,52 +633,41 @@  -- Amount rendering -showAmountCostB :: Amount -> WideBuilder-showAmountCostB amt = case aprice amt of+-- Show an amount's cost as @ UNITCOST or @@ TOTALCOST (builder version).+showAmountsCostB :: Amount -> WideBuilder+showAmountsCostB amt = case acost amt of     Nothing              -> mempty-    Just (UnitPrice  pa) -> WideBuilder (TB.fromString " @ ")  3 <> showAmountB noColour{displayZeroCommodity=True} pa-    Just (TotalPrice pa) -> WideBuilder (TB.fromString " @@ ") 4 <> showAmountB noColour{displayZeroCommodity=True} (sign pa)+    Just (UnitCost  pa) -> WideBuilder (TB.fromString " @ ")  3 <> showAmountB defaultFmt{displayZeroCommodity=True} pa+    Just (TotalCost pa) -> WideBuilder (TB.fromString " @@ ") 4 <> showAmountB defaultFmt{displayZeroCommodity=True} (sign pa)   where sign = if aquantity amt < 0 then negate else id -showAmountCostDebug :: Maybe AmountPrice -> String+showAmountCostDebug :: Maybe AmountCost -> String showAmountCostDebug Nothing                = ""-showAmountCostDebug (Just (UnitPrice pa))  = " @ "  ++ showAmountDebug pa-showAmountCostDebug (Just (TotalPrice pa)) = " @@ " ++ showAmountDebug pa+showAmountCostDebug (Just (UnitCost pa))  = " @ "  ++ showAmountDebug pa+showAmountCostDebug (Just (TotalCost pa)) = " @@ " ++ showAmountDebug pa --- | Get the string representation of an amount, based on its--- commodity's display settings. String representations equivalent to--- zero are converted to just \"0\". The special "missing" amount is--- displayed as the empty string.------ > showAmount = wbUnpack . showAmountB noColour+-- | Render an amount using its display style and the default amount format.+-- Zero-equivalent amounts  are shown as just \"0\".+-- The special "missing" amount is shown as the empty string. showAmount :: Amount -> String-showAmount = wbUnpack . showAmountB noColour+showAmount = wbUnpack . showAmountB defaultFmt --- | Like showAmount but uses the given amount display options.-showAmountWith :: AmountDisplayOpts -> Amount -> String+-- | Like showAmount but uses the given amount format.+showAmountWith :: AmountFormat -> Amount -> String showAmountWith fmt = wbUnpack . showAmountB fmt --- | General function to generate a WideBuilder for an Amount, according the--- supplied AmountDisplayOpts. This is the main function to use for showing--- Amounts, constructing a builder; it can then be converted to a Text with--- wbToText, or to a String with wbUnpack.--- Some special cases:------ * The special "missing" amount is displayed as the empty string. ------ * If an amount is showing digit group separators but no decimal places,---   we force showing a decimal mark (with nothing after it) to make---   it easier to parse correctly.----showAmountB :: AmountDisplayOpts -> Amount -> WideBuilder+-- | Render an amount using its display style and the given amount format, as a builder for efficiency.+-- (This can be converted to a Text with wbToText or to a String with wbUnpack).+-- The special "missing" amount is displayed as the empty string. +showAmountB :: AmountFormat -> Amount -> WideBuilder showAmountB _ Amount{acommodity="AUTO"} = mempty showAmountB-  AmountDisplayOpts{displayCommodity, displayZeroCommodity, displayDigitGroups+  AmountFormat{displayCommodity, displayZeroCommodity, displayDigitGroups                    ,displayForceDecimalMark, displayCost, displayColour}   a@Amount{astyle=style} =     color $ case ascommodityside style of-      L -> (if displayCommodity then wbFromText comm <> space else mempty) <> quantity' <> price-      R -> quantity' <> (if displayCommodity then space <> wbFromText comm else mempty) <> price+      L -> (if displayCommodity then wbFromText comm <> space else mempty) <> quantity' <> cost+      R -> quantity' <> (if displayCommodity then space <> wbFromText comm else mempty) <> cost   where     color = if displayColour && isNegativeAmount a then colorB Dull Red else id     quantity = showAmountQuantity displayForceDecimalMark $@@ -673,7 +676,7 @@       | amountLooksZero a && not displayZeroCommodity = (WideBuilder (TB.singleton '0') 1, "")       | otherwise = (quantity, quoteCommoditySymbolIfNeeded $ acommodity a)     space = if not (T.null comm) && ascommodityspaced style then WideBuilder (TB.singleton ' ') 1 else mempty-    price = if displayCost then showAmountCostB a else mempty+    cost = if displayCost then showAmountsCostB a else mempty  -- | Colour version. For a negative amount, adds ANSI codes to change the colour, -- currently to hard-coded red.@@ -682,17 +685,17 @@ cshowAmount :: Amount -> String cshowAmount = wbUnpack . showAmountB def{displayColour=True} --- | Get the string representation of an amount, without any \@ price.+-- | Get the string representation of an amount, without any \@ cost. ----- > showAmountWithoutPrice = wbUnpack . showAmountB noCost-showAmountWithoutPrice :: Amount -> String-showAmountWithoutPrice = wbUnpack . showAmountB noCost+-- > showAmountWithoutCost = wbUnpack . showAmountB noCostFmt+showAmountWithoutCost :: Amount -> String+showAmountWithoutCost = wbUnpack . showAmountB noCostFmt  -- | Like showAmount, but show a zero amount's commodity if it has one. ----- > showAmountWithZeroCommodity = wbUnpack . showAmountB noColour{displayZeryCommodity=True}+-- > showAmountWithZeroCommodity = wbUnpack . showAmountB defaultFmt{displayZeryCommodity=True} showAmountWithZeroCommodity :: Amount -> String-showAmountWithZeroCommodity = wbUnpack . showAmountB noColour{displayZeroCommodity=True}+showAmountWithZeroCommodity = wbUnpack . showAmountB defaultFmt{displayZeroCommodity=True}  -- | Get a string representation of an amount for debugging, -- appropriate to the current debug level. 9 shows maximum detail.@@ -700,7 +703,7 @@ showAmountDebug Amount{acommodity="AUTO"} = "(missing)" showAmountDebug Amount{..} =       "Amount {acommodity=" ++ show acommodity ++ ", aquantity=" ++ show aquantity-   ++ ", aprice=" ++ showAmountCostDebug aprice ++ ", astyle=" ++ show astyle ++ "}"+   ++ ", acost=" ++ showAmountCostDebug acost ++ ", astyle=" ++ show astyle ++ "}"  -- | Get a Text Builder for the string representation of the number part of of an amount, -- using the display settings from its commodity. Also returns the width of the number.@@ -765,10 +768,10 @@  -- | Calculate the key used to store an Amount within a MixedAmount. amountKey :: Amount -> MixedAmountKey-amountKey amt@Amount{acommodity=c} = case aprice amt of-    Nothing             -> MixedAmountKeyNoPrice    c-    Just (TotalPrice p) -> MixedAmountKeyTotalPrice c (acommodity p)-    Just (UnitPrice  p) -> MixedAmountKeyUnitPrice  c (acommodity p) (aquantity p)+amountKey amt@Amount{acommodity=c} = case acost amt of+    Nothing             -> MixedAmountKeyNoCost    c+    Just (TotalCost p) -> MixedAmountKeyTotalCost c (acommodity p)+    Just (UnitCost  p) -> MixedAmountKeyUnitCost  c (acommodity p) (aquantity p)  -- | The empty mixed amount. nullmixedamt :: MixedAmount@@ -797,21 +800,21 @@ -- | Add an Amount to a MixedAmount, normalising the result. -- Amounts with different costs are kept separate. maAddAmount :: MixedAmount -> Amount -> MixedAmount-maAddAmount (Mixed ma) a = Mixed $ M.insertWith sumSimilarAmountsUsingFirstPrice (amountKey a) a ma+maAddAmount (Mixed ma) a = Mixed $ M.insertWith sumSimilarAmountsUsingFirstCost (amountKey a) a ma  -- | Add a collection of Amounts to a MixedAmount, normalising the result. -- Amounts with different costs are kept separate. maAddAmounts :: Foldable t => MixedAmount -> t Amount -> MixedAmount maAddAmounts = foldl' maAddAmount --- | Negate mixed amount's quantities (and total prices, if any).+-- | Negate mixed amount's quantities (and total costs, if any). maNegate :: MixedAmount -> MixedAmount maNegate = transformMixedAmount negate  -- | Sum two MixedAmount, keeping the cost of the first if any. -- Amounts with different costs are kept separate (since 2021). maPlus :: MixedAmount -> MixedAmount -> MixedAmount-maPlus (Mixed as) (Mixed bs) = Mixed $ M.unionWith sumSimilarAmountsUsingFirstPrice as bs+maPlus (Mixed as) (Mixed bs) = Mixed $ M.unionWith sumSimilarAmountsUsingFirstCost as bs  -- | Subtract a MixedAmount from another. -- Amounts with different costs are kept separate.@@ -823,15 +826,15 @@ maSum :: Foldable t => t MixedAmount -> MixedAmount maSum = foldl' maPlus nullmixedamt --- | Divide a mixed amount's quantities (and total prices, if any) by a constant.+-- | Divide a mixed amount's quantities (and total costs, if any) by a constant. divideMixedAmount :: Quantity -> MixedAmount -> MixedAmount divideMixedAmount n = transformMixedAmount (/n) --- | Multiply a mixed amount's quantities (and total prices, if any) by a constant.+-- | Multiply a mixed amount's quantities (and total costs, if any) by a constant. multiplyMixedAmount :: Quantity -> MixedAmount -> MixedAmount multiplyMixedAmount n = transformMixedAmount (*n) --- | Apply a function to a mixed amount's quantities (and its total prices, if it has any).+-- | Apply a function to a mixed amount's quantities (and its total costs, if it has any). transformMixedAmount :: (Quantity -> Quantity) -> MixedAmount -> MixedAmount transformMixedAmount f = mapMixedAmountUnsafe (transformAmount f) @@ -843,7 +846,7 @@ -- Ie when normalised, are all individual commodity amounts negative ? isNegativeMixedAmount :: MixedAmount -> Maybe Bool isNegativeMixedAmount m =-  case amounts $ mixedAmountStripPrices m of+  case amounts $ mixedAmountStripCosts m of     []  -> Just False     [a] -> Just $ isNegativeAmount a     as | all isNegativeAmount as -> Just True@@ -875,7 +878,7 @@ -- | Get a mixed amount's component amounts, with some cleanups. -- The following descriptions are old and possibly wrong: ----- * amounts in the same commodity are combined unless they have different prices or total prices+-- * amounts in the same commodity are combined unless they have different costs or total costs -- -- * multiple zero amounts, all with the same non-null commodity, are replaced by just the last of them, preserving the commodity and amount style (all but the last zero amount are discarded) --@@ -921,8 +924,8 @@ -- | Get a mixed amount's component amounts without normalising zero and missing -- amounts. This is used for JSON serialisation, so the order is important. In -- particular, we want the Amounts given in the order of the MixedAmountKeys,--- i.e. lexicographically first by commodity, then by price commodity, then by--- unit price from most negative to most positive.+-- i.e. lexicographically first by commodity, then by cost commodity, then by+-- unit cost from most negative to most positive. amountsRaw :: MixedAmount -> [Amount] amountsRaw (Mixed ma) = toList ma @@ -946,31 +949,31 @@       | otherwise                           = Nothing  -- | Sum same-commodity amounts in a lossy way, applying the first--- price to the result and discarding any other prices. Only used as a+-- cost to the result and discarding any other costs. Only used as a -- rendering helper.-sumSimilarAmountsUsingFirstPrice :: Amount -> Amount -> Amount-sumSimilarAmountsUsingFirstPrice a b = (a + b){aprice=p}+sumSimilarAmountsUsingFirstCost :: Amount -> Amount -> Amount+sumSimilarAmountsUsingFirstCost a b = (a + b){acost=p}   where-    p = case (aprice a, aprice b) of-        (Just (TotalPrice ap), Just (TotalPrice bp))-          -> Just . TotalPrice $ ap{aquantity = aquantity ap + aquantity bp }-        _ -> aprice a---- -- | Sum same-commodity amounts. If there were different prices, set--- -- the price to a special marker indicating "various". Only used as a--- -- rendering helper.--- sumSimilarAmountsNotingPriceDifference :: [Amount] -> Amount--- sumSimilarAmountsNotingPriceDifference [] = nullamt--- sumSimilarAmountsNotingPriceDifference as = undefined+    p = case (acost a, acost b) of+        (Just (TotalCost ap), Just (TotalCost bp))+          -> Just . TotalCost $ ap{aquantity = aquantity ap + aquantity bp }+        _ -> acost a  -- | Filter a mixed amount's component amounts by a predicate. filterMixedAmount :: (Amount -> Bool) -> MixedAmount -> MixedAmount filterMixedAmount p (Mixed ma) = Mixed $ M.filter p ma --- | Return an unnormalised MixedAmount containing exactly one Amount--- with the specified commodity and the quantity of that commodity--- found in the original. NB if Amount's quantity is zero it will be--- discarded next time the MixedAmount gets normalised.+-- | Return an unnormalised MixedAmount containing just the amounts in the+-- requested commodity from the original mixed amount.+--+-- The result will contain at least one Amount of the requested commodity,+-- even if the original mixed amount did not (with quantity zero in that case,+-- and this would be discarded when the mixed amount is next normalised).+--+-- The result can contain more than one Amount of the requested commodity,+-- eg because there were several with different costs,+-- or simply because the original mixed amount was was unnormalised.+-- filterMixedAmountByCommodity :: CommoditySymbol -> MixedAmount -> MixedAmount filterMixedAmountByCommodity c (Mixed ma)   | M.null ma' = mixedAmount nullamt{acommodity=c}@@ -982,25 +985,24 @@ mapMixedAmount f (Mixed ma) = mixed . map f $ toList ma  -- | Apply a transform to a mixed amount's component 'Amount's, which does not--- affect the key of the amount (i.e. doesn't change the commodity, price--- commodity, or unit price amount). This condition is not checked.+-- affect the key of the amount (i.e. doesn't change the commodity, cost+-- commodity, or unit cost amount). This condition is not checked. mapMixedAmountUnsafe :: (Amount -> Amount) -> MixedAmount -> MixedAmount mapMixedAmountUnsafe f (Mixed ma) = Mixed $ M.map f ma  -- Use M.map instead of fmap to maintain strictness --- | Convert all component amounts to cost/selling price where--- possible (see amountCost).+-- | Convert all component amounts to cost where possible (see amountCost). mixedAmountCost :: MixedAmount -> MixedAmount mixedAmountCost (Mixed ma) =-    foldl' (\m a -> maAddAmount m (amountCost a)) (Mixed noPrices) withPrices-  where (noPrices, withPrices) = M.partition (isNothing . aprice) ma+    foldl' (\m a -> maAddAmount m (amountCost a)) (Mixed noCosts) withCosts+  where (noCosts, withCosts) = M.partition (isNothing . acost) ma  -- -- | MixedAmount derived Eq instance in Types.hs doesn't know that we -- -- want $0 = EUR0 = 0. Yet we don't want to drag all this code over there. -- -- For now, use this when cross-commodity zero equality is important. -- mixedAmountEquals :: MixedAmount -> MixedAmount -> Bool -- mixedAmountEquals a b = amounts a' == amounts b' || (mixedAmountLooksZero a' && mixedAmountLooksZero b')---     where a' = mixedAmountStripPrices a---           b' = mixedAmountStripPrices b+--     where a' = mixedAmountStripCosts a+--           b' = mixedAmountStripCosts b  -- Mixed amount styles @@ -1035,54 +1037,48 @@  -- Mixed amount rendering --- | Get the string representation of a mixed amount, after--- normalising it to one amount per commodity. Assumes amounts have--- no or similar prices, otherwise this can show misleading prices.------ > showMixedAmount = wbUnpack . showMixedAmountB noColour++-- | Render a mixed amount using its amount display styles and the default amount format,+-- after normalising it (to at most one amount in each of its commodities).+-- See showMixedAmountB for special cases. showMixedAmount :: MixedAmount -> String-showMixedAmount = wbUnpack . showMixedAmountB noColour+showMixedAmount = wbUnpack . showMixedAmountB defaultFmt --- | Like showMixedAmount but uses the given amount display options.+-- | Like showMixedAmount but uses the given amount format. -- See showMixedAmountB for special cases.-showMixedAmountWith :: AmountDisplayOpts -> MixedAmount -> String+showMixedAmountWith :: AmountFormat -> MixedAmount -> String showMixedAmountWith fmt = wbUnpack . showMixedAmountB fmt  -- | Get the one-line string representation of a mixed amount (also showing any costs).------ > showMixedAmountOneLine = wbUnpack . showMixedAmountB oneLine+-- See showMixedAmountB for special cases. showMixedAmountOneLine :: MixedAmount -> String-showMixedAmountOneLine = wbUnpack . showMixedAmountB oneLine{displayCost=True}+showMixedAmountOneLine = wbUnpack . showMixedAmountB oneLineNoCostFmt{displayCost=True}  -- | Like showMixedAmount, but zero amounts are shown with their -- commodity if they have one.------ > showMixedAmountWithZeroCommodity = wbUnpack . showMixedAmountB noColour{displayZeroCommodity=True}+-- See showMixedAmountB for special cases. showMixedAmountWithZeroCommodity :: MixedAmount -> String-showMixedAmountWithZeroCommodity = wbUnpack . showMixedAmountB noColour{displayZeroCommodity=True}+showMixedAmountWithZeroCommodity = wbUnpack . showMixedAmountB defaultFmt{displayZeroCommodity=True} --- | Get the string representation of a mixed amount, without showing any transaction prices.+-- | Get the string representation of a mixed amount, without showing any costs. -- With a True argument, adds ANSI codes to show negative amounts in red.------ > showMixedAmountWithoutPrice c = wbUnpack . showMixedAmountB noCost{displayColour=c}-showMixedAmountWithoutPrice :: Bool -> MixedAmount -> String-showMixedAmountWithoutPrice c = wbUnpack . showMixedAmountB noCost{displayColour=c}+-- See showMixedAmountB for special cases.+showMixedAmountWithoutCost :: Bool -> MixedAmount -> String+showMixedAmountWithoutCost c = wbUnpack . showMixedAmountB noCostFmt{displayColour=c}  -- | Get the one-line string representation of a mixed amount, but without--- any \@ prices.+-- any \@ costs. -- With a True argument, adds ANSI codes to show negative amounts in red.------ > showMixedAmountOneLineWithoutPrice c = wbUnpack . showMixedAmountB oneLine{displayColour=c}-showMixedAmountOneLineWithoutPrice :: Bool -> MixedAmount -> String-showMixedAmountOneLineWithoutPrice c = wbUnpack . showMixedAmountB oneLine{displayColour=c}+-- See showMixedAmountB for special cases.+showMixedAmountOneLineWithoutCost :: Bool -> MixedAmount -> String+showMixedAmountOneLineWithoutCost c = wbUnpack . showMixedAmountB oneLineNoCostFmt{displayColour=c} --- | Like showMixedAmountOneLineWithoutPrice, but show at most the given width,+-- | Like showMixedAmountOneLineWithoutCost, but show at most the given width, -- with an elision indicator if there are more. -- With a True argument, adds ANSI codes to show negative amounts in red.------ > showMixedAmountElided w c = wbUnpack . showMixedAmountB oneLine{displayColour=c, displayMaxWidth=Just w}+-- See showMixedAmountB for special cases. showMixedAmountElided :: Int -> Bool -> MixedAmount -> String-showMixedAmountElided w c = wbUnpack . showMixedAmountB oneLine{displayColour=c, displayMaxWidth=Just w}+showMixedAmountElided w c = wbUnpack . showMixedAmountB oneLineNoCostFmt{displayColour=c, displayMaxWidth=Just w}  -- | Get an unambiguous string representation of a mixed amount for debugging. showMixedAmountDebug :: MixedAmount -> String@@ -1090,19 +1086,28 @@                        | otherwise       = "Mixed [" ++ as ++ "]"     where as = intercalate "\n       " $ map showAmountDebug $ amounts m --- | General function to generate a WideBuilder for a MixedAmount, according to the--- supplied AmountDisplayOpts. This is the main function to use for showing--- MixedAmounts, constructing a builder; it can then be converted to a Text with--- wbToText, or to a String with wbUnpack.+-- | Render a mixed amount using its amount display styles and the given amount format,+-- as a builder for efficiency.+-- (This can be converted to a Text with wbToText or to a String with wbUnpack). --+-- Warning: this (and its showMixedAmount aliases above) basically assumes amounts have no costs.+-- It can show misleading costs or not show costs which are there.+-- -- If a maximum width is given then:+-- -- - If displayed on one line, it will display as many Amounts as can --   fit in the given width, and further Amounts will be elided. There --   will always be at least one amount displayed, even if this will --   exceed the requested maximum width.+-- -- - If displayed on multiple lines, any Amounts longer than the --   maximum width will be elided.-showMixedAmountB :: AmountDisplayOpts -> MixedAmount -> WideBuilder+--+-- Zero-equivalent amounts  are shown as just \"0\".+--+-- The special "missing" amount is shown as the empty string (?).+--+showMixedAmountB :: AmountFormat -> MixedAmount -> WideBuilder showMixedAmountB opts ma     | displayOneLine opts = showMixedAmountOneLineB opts ma     | otherwise           = WideBuilder (wbBuilder . mconcat $ intersperse sep ls) width@@ -1114,12 +1119,12 @@ -- | Helper for showMixedAmountB (and postingAsLines, ...) to show a list of Amounts on multiple lines. -- This returns the list of WideBuilders: one for each Amount, and padded/elided to the appropriate width. -- This does not honour displayOneLine; all amounts will be displayed as if displayOneLine were False.-showMixedAmountLinesB :: AmountDisplayOpts -> MixedAmount -> [WideBuilder]-showMixedAmountLinesB opts@AmountDisplayOpts{displayMaxWidth=mmax,displayMinWidth=mmin} ma =+showMixedAmountLinesB :: AmountFormat -> MixedAmount -> [WideBuilder]+showMixedAmountLinesB opts@AmountFormat{displayMaxWidth=mmax,displayMinWidth=mmin} ma =     map (adBuilder . pad) elided   where     astrs = amtDisplayList (wbWidth sep) (showAmountB opts) . orderedAmounts opts $-              if displayCost opts then ma else mixedAmountStripPrices ma+              if displayCost opts then ma else mixedAmountStripCosts ma     sep   = WideBuilder (TB.singleton '\n') 0     width = maximum $ map (wbWidth . adBuilder) elided @@ -1138,14 +1143,14 @@ -- | Helper for showMixedAmountB to deal with single line displays. This does not -- honour displayOneLine: all amounts will be displayed as if displayOneLine -- were True.-showMixedAmountOneLineB :: AmountDisplayOpts -> MixedAmount -> WideBuilder-showMixedAmountOneLineB opts@AmountDisplayOpts{displayMaxWidth=mmax,displayMinWidth=mmin} ma =+showMixedAmountOneLineB :: AmountFormat -> MixedAmount -> WideBuilder+showMixedAmountOneLineB opts@AmountFormat{displayMaxWidth=mmax,displayMinWidth=mmin} ma =     WideBuilder (wbBuilder . pad . mconcat . intersperse sep $ map adBuilder elided)     . max width $ fromMaybe 0 mmin   where     width  = maybe 0 adTotal $ lastMay elided     astrs  = amtDisplayList (wbWidth sep) (showAmountB opts) . orderedAmounts opts $-               if displayCost opts then ma else mixedAmountStripPrices ma+               if displayCost opts then ma else mixedAmountStripCosts ma     sep    = WideBuilder (TB.fromString ", ") 2     n      = length astrs @@ -1170,8 +1175,8 @@ -- Get a mixed amount's component amounts with a bit of cleanup, -- optionally preserving multiple zeros in different commodities, -- optionally sorting them according to a commodity display order.-orderedAmounts :: AmountDisplayOpts -> MixedAmount -> [Amount]-orderedAmounts AmountDisplayOpts{displayZeroCommodity=preservezeros, displayCommodityOrder=mcommodityorder} =+orderedAmounts :: AmountFormat -> MixedAmount -> [Amount]+orderedAmounts AmountFormat{displayZeroCommodity=preservezeros, displayCommodityOrder=mcommodityorder} =   if preservezeros then amountsPreservingZeros else amounts   <&> maybe id (mapM findfirst) mcommodityorder  -- maybe sort them (somehow..)   where@@ -1226,6 +1231,14 @@ mixedAmountSetFullPrecision :: MixedAmount -> MixedAmount mixedAmountSetFullPrecision = mapMixedAmountUnsafe amountSetFullPrecision +-- | In each component amount, increase the display precision sufficiently+-- to render it exactly if possible, but not more than the given max precision,+-- and if no max precision is given and the amount has infinite decimals,+-- limit display precision to a hard-coded smaller number (8).+-- See amountSetFullPrecisionUpTo.+mixedAmountSetFullPrecisionUpTo :: Maybe Word8 -> MixedAmount -> MixedAmount+mixedAmountSetFullPrecisionUpTo mmaxp = mapMixedAmountUnsafe (amountSetFullPrecisionUpTo mmaxp)+ -- | In each component amount, ensure the display precision is at least the given value. -- Makes all amounts have an explicit Precision. mixedAmountSetPrecisionMin :: Word8 -> MixedAmount -> MixedAmount@@ -1236,11 +1249,11 @@ mixedAmountSetPrecisionMax :: Word8 -> MixedAmount -> MixedAmount mixedAmountSetPrecisionMax p = mapMixedAmountUnsafe (amountSetPrecisionMax p) --- | Remove all prices from a MixedAmount.-mixedAmountStripPrices :: MixedAmount -> MixedAmount-mixedAmountStripPrices (Mixed ma) =-    foldl' (\m a -> maAddAmount m a{aprice=Nothing}) (Mixed noPrices) withPrices-  where (noPrices, withPrices) = M.partition (isNothing . aprice) ma+-- | Remove all costs from a MixedAmount.+mixedAmountStripCosts :: MixedAmount -> MixedAmount+mixedAmountStripCosts (Mixed ma) =+    foldl' (\m a -> maAddAmount m a{acost=Nothing}) (Mixed noCosts) withCosts+  where (noCosts, withCosts) = M.partition (isNothing . acost) ma   -------------------------------------------------------------------------------@@ -1251,9 +1264,9 @@       testCase "amountCost" $ do        amountCost (eur 1) @?= eur 1-       amountCost (eur 2){aprice=Just $ UnitPrice $ usd 2} @?= usd 4-       amountCost (eur 1){aprice=Just $ TotalPrice $ usd 2} @?= usd 2-       amountCost (eur (-1)){aprice=Just $ TotalPrice $ usd (-2)} @?= usd (-2)+       amountCost (eur 2){acost=Just $ UnitCost $ usd 2} @?= usd 4+       amountCost (eur 1){acost=Just $ TotalCost $ usd 2} @?= usd 2+       amountCost (eur (-1)){acost=Just $ TotalCost $ usd (-2)} @?= usd (-2)      ,testCase "amountLooksZero" $ do        assertBool "" $ amountLooksZero nullamt@@ -1261,9 +1274,9 @@      ,testCase "negating amounts" $ do        negate (usd 1) @?= (usd 1){aquantity= -1}-       let b = (usd 1){aprice=Just $ UnitPrice $ eur 2} in negate b @?= b{aquantity= -1}+       let b = (usd 1){acost=Just $ UnitCost $ eur 2} in negate b @?= b{aquantity= -1} -    ,testCase "adding amounts without prices" $ do+    ,testCase "adding amounts without costs" $ do        (usd 1.23 + usd (-1.23)) @?= usd 0        (usd 1.23 + usd (-1.23)) @?= usd 0        (usd (-1.23) + usd (-1.23)) @?= usd (-2.46)@@ -1296,7 +1309,7 @@         ])         @?= mixedAmount (usd 0 `withPrecision` Precision 3) -    ,testCase "adding mixed amounts with total prices" $ do+    ,testCase "adding mixed amounts with total costs" $ do       maSum (map mixedAmount         [usd 1 @@ eur 1         ,usd (-2) @@ eur 1@@ -1310,27 +1323,27 @@        showMixedAmount nullmixedamt @?= "0"        showMixedAmount missingmixedamt @?= "" -    ,testCase "showMixedAmountWithoutPrice" $ do+    ,testCase "showMixedAmountWithoutCost" $ do       let a = usd 1 `at` eur 2-      showMixedAmountWithoutPrice False (mixedAmount (a)) @?= "$1.00"-      showMixedAmountWithoutPrice False (mixed [a, -a]) @?= "0"+      showMixedAmountWithoutCost False (mixedAmount (a)) @?= "$1.00"+      showMixedAmountWithoutCost False (mixed [a, -a]) @?= "0"      ,testGroup "amounts" [        testCase "a missing amount overrides any other amounts" $         amounts (mixed [usd 1, missingamt]) @?= [missingamt]-      ,testCase "unpriced same-commodity amounts are combined" $+      ,testCase "costless same-commodity amounts are combined" $         amounts (mixed [usd 0, usd 2]) @?= [usd 2]-      ,testCase "amounts with same unit price are combined" $+      ,testCase "amounts with same unit cost are combined" $         amounts (mixed [usd 1 `at` eur 1, usd 1 `at` eur 1]) @?= [usd 2 `at` eur 1]-      ,testCase "amounts with different unit prices are not combined" $+      ,testCase "amounts with different unit costs are not combined" $         amounts (mixed [usd 1 `at` eur 1, usd 1 `at` eur 2]) @?= [usd 1 `at` eur 1, usd 1 `at` eur 2]-      ,testCase "amounts with total prices are combined" $+      ,testCase "amounts with total costs are combined" $         amounts (mixed [usd 1 @@ eur 1, usd 1 @@ eur 1]) @?= [usd 2 @@ eur 2]     ] -    ,testCase "mixedAmountStripPrices" $ do-       amounts (mixedAmountStripPrices nullmixedamt) @?= [nullamt]-       assertBool "" $ mixedAmountLooksZero $ mixedAmountStripPrices+    ,testCase "mixedAmountStripCosts" $ do+       amounts (mixedAmountStripCosts nullmixedamt) @?= [nullamt]+       assertBool "" $ mixedAmountLooksZero $ mixedAmountStripCosts         (mixed [usd 10                ,usd 10 @@ eur 7                ,usd (-10)

@@ -46,6 +46,7 @@ import qualified Data.Text as T import Data.Time.Calendar (fromGregorian) import qualified Data.Map as M+import Safe (headErr) import Text.Printf (printf)  import Hledger.Utils@@ -104,7 +105,7 @@     -- convert this posting's amount to cost,     -- without getting confused by redundant costs/equity postings     postingBalancingAmount p-      | "_price-matched" `elem` map fst (ptags p) = mixedAmountStripPrices $ pamount p+      | "_price-matched" `elem` map fst (ptags p) = mixedAmountStripCosts $ pamount p       | otherwise                                 = mixedAmountCost $ pamount p      -- transaction balancedness is checked at each commodity's display precision@@ -130,11 +131,17 @@         rmsg           | rsumok        = ""           | not rsignsok  = "The real postings all have the same sign. Consider negating some of them."-          | otherwise     = "The real postings' sum should be 0 but is: " ++ showMixedAmountOneLineWithoutPrice False rsumcost+          | otherwise     = "The real postings' sum should be 0 but is: " +++              (showMixedAmountWith oneLineNoCostFmt{displayCost=True, displayZeroCommodity=True} $+              mixedAmountSetFullPrecisionUpTo Nothing $ mixedAmountSetFullPrecision+              rsumcost)         bvmsg           | bvsumok       = ""           | not bvsignsok = "The balanced virtual postings all have the same sign. Consider negating some of them."-          | otherwise     = "The balanced virtual postings' sum should be 0 but is: " ++ showMixedAmountOneLineWithoutPrice False bvsumcost+          | otherwise     = "The balanced virtual postings' sum should be 0 but is: " +++              (showMixedAmountWith oneLineNoCostFmt{displayCost=True, displayZeroCommodity=True} $+              mixedAmountSetFullPrecisionUpTo Nothing $ mixedAmountSetFullPrecision+              bvsumcost)  -- | Legacy form of transactionCheckBalanced. isTransactionBalanced :: BalancingOpts -> Transaction -> Bool@@ -339,7 +346,7 @@     inferFromAndTo = case sumamounts of       [a,b] | noprices, oppositesigns -> asum $ map orderIfMatches pcommodities         where-          noprices      = all (isNothing . aprice) sumamounts+          noprices      = all (isNothing . acost) sumamounts           oppositesigns = signum (aquantity a) /= signum (aquantity b)           orderIfMatches x | x == acommodity a = Just (a,b)                            | x == acommodity b = Just (b,a)@@ -351,18 +358,18 @@     -- then set its cost based on the ratio between fromamount and toamount.     infercost (fromamount, toamount) p         | [a] <- amounts (pamount p), ptype p == pt, acommodity a == acommodity fromamount-            = p{ pamount   = mixedAmount a{aprice=Just conversionprice}+            = p{ pamount   = mixedAmount a{acost=Just conversionprice}                   & dbg9With (lbl "inferred cost".showMixedAmountOneLine)                , poriginal = Just $ originalPosting p }         | otherwise = p       where-        -- If only one Amount in the posting list matches fromamount we can use TotalPrice.+        -- If only one Amount in the posting list matches fromamount we can use TotalCost.         -- Otherwise divide the conversion equally among the Amounts by using a unit price.         conversionprice = case filter (== acommodity fromamount) pcommodities of-            [_] -> TotalPrice $ negate toamount-            _   -> UnitPrice  $ negate unitprice `withPrecision` unitprecision+            [_] -> TotalCost $ negate toamount+            _   -> UnitCost  $ negate unitcost `withPrecision` unitprecision -        unitprice     = aquantity fromamount `divideAmount` toamount+        unitcost     = aquantity fromamount `divideAmount` toamount         unitprecision = case (asprecision $ astyle fromamount, asprecision $ astyle toamount) of             (Precision a, Precision b) -> Precision . max 2 $ saturatedAdd a b             _                          -> NaturalPrecision@@ -539,8 +546,8 @@ balanceTransactionAndCheckAssertionsB :: Either Posting Transaction -> Balancing s () balanceTransactionAndCheckAssertionsB (Left p@Posting{}) =   -- Update the account's running balance and check the balance assertion if any.-  -- Note, cost is ignored when checking balance assertions, currently.-  void . addAmountAndCheckAssertionB $ postingStripPrices p+  -- Cost is ignored when checking balance assertions currently.+  void $ addAmountAndCheckAssertionB $ postingStripCosts p balanceTransactionAndCheckAssertionsB (Right t@Transaction{tpostings=ps}) = do   -- make sure we can handle the balance assignments   mapM_ checkIllegalBalanceAssignmentB ps@@ -670,7 +677,7 @@         "%s\n",         "Balance assertion failed in %s",         "%s at this point, %s, ignoring costs,",-        "the expected balance is:        %s",+        "the asserted balance is:        %s",         "but the calculated balance is:  %s",         "(difference: %s)",         "To troubleshoot, check this account's running balance with assertions disabled, eg:",@@ -682,9 +689,12 @@       acct  -- asserted account       (if istotal then "Across all commodities" else "In commodity " <> assertedcommstr)  -- asserted commodity or all commodities ?       (if isinclusive then "including subaccounts" else "excluding subaccounts" :: String)  -- inclusive or exclusive balance asserted ?-      (pad assertedstr)  -- asserted amount, without cost-      (pad actualstr)    -- actual amount, without cost-        -- <> " (with costs: " <> T.pack (showMixedAmountWith fmt actualcommbal) <> ")" -- debugging+      (pad assertedstr  -- asserted amount, without cost+        <> if debugLevel >= 2 then " (with cost:  " <> T.pack (showAmountWith fmt assertedcommbal) <> ")" else ""+      )+      (pad actualstr    -- actual amount, without cost+        <> if debugLevel >= 2 then " (with costs: " <> T.pack (showMixedAmountWith fmt actualcommbal) <> ")" else ""+      )       diffstr  -- their difference       (acct ++ if isinclusive then "" else "$")  -- query matching the account(s) postings       (if istotal then "" else (" cur:" ++ quoteForCommandLine (T.unpack assertedcomm)))  -- query matching the commodity(ies)@@ -695,7 +705,7 @@         pos = baposition ass         (_,_,_,ex) = makeBalanceAssertionErrorExcerpt p         assertedcommstr = if T.null assertedcomm then "\"\"" else assertedcomm-        fmt = oneLine{displayZeroCommodity=True}+        fmt = oneLineFmt{displayZeroCommodity=True}         assertedstr = showAmountWith fmt assertedcommbalcostless         actualstr   = showAmountWith fmt actualcommbalcostless         diffstr     = showAmountWith fmt $ assertedcommbalcostless - actualcommbalcostless@@ -831,7 +841,7 @@                 [posting {paccount = "a", pamount = mixedAmount (usd 1)}, posting {paccount = "b", pamount = missingmixedamt}])) @?=           Right (mixedAmount $ usd (-1))         ,testCase "conversion price is inferred" $-          (pamount . head . tpostings <$>+          (pamount . headErr . tpostings <$>  -- PARTIAL headErr succeeds because non-null postings list            balanceTransaction defbalancingopts              (Transaction                 0@@ -1023,7 +1033,7 @@               transaction (fromGregorian 2019 01 01) [ vpost' "a" missingamt (balassert (num 1)) ]             ]}       assertRight ej-      case ej of Right j -> (jtxns j & head & tpostings & head & pamount & amountsRaw) @?= [num 1]+      case ej of Right j -> (jtxns j & headErr & tpostings & headErr & pamount & amountsRaw) @?= [num 1]  -- PARTIAL headErrs succeed because non-null txns & postings lists given                  Left _  -> error' "balance-assignment test: shouldn't happen"      ,testCase "same-day-1" $ do

@@ -63,6 +63,7 @@   spanIntersect,   spansIntersect,   spanDefaultsFrom,+  spanExtend,   spanUnion,   spansUnion,   daysSpan,@@ -105,7 +106,7 @@ import Data.Time.Calendar.OrdinalDate (fromMondayStartWeek, mondayStartWeek) import Data.Time.Clock (UTCTime, diffUTCTime) import Data.Time.LocalTime (getZonedTime, localDay, zonedTimeToLocalTime)-import Safe (headMay, lastMay, maximumMay, minimumMay)+import Safe (headErr, headMay, lastMay, maximumMay, minimumMay) import Text.Megaparsec import Text.Megaparsec.Char (char, char', digitChar, string, string') import Text.Megaparsec.Char.Lexer (decimal, signed)@@ -314,8 +315,8 @@   where     groupByCols []     _  = []     groupByCols (c:cs) [] = if showempty then (c, []) : groupByCols cs [] else []-    groupByCols (c:cs) ps = (c, map snd matches) : groupByCols cs later-      where (matches, later) = span ((spanEnd c >) . Just . fst) ps+    groupByCols (c:cs) ps = (c, map snd colps) : groupByCols cs laterps+      where (colps, laterps) = span ((spanEnd c >) . Just . fst) ps      beforeStart = maybe (const False) (>) $ spanStart =<< headMay colspans @@ -324,41 +325,83 @@ spansIntersect [d] = d spansIntersect (d:ds) = d `spanIntersect` (spansIntersect ds) +-- | Calculate the union of a number of datespans.+spansUnion [] = nulldatespan+spansUnion [d] = d+spansUnion (d:ds) = d `spanUnion` (spansUnion ds)+ -- | Calculate the intersection of two datespans. -- -- For non-intersecting spans, gives an empty span beginning on the second's start date: -- >>> DateSpan (Just $ Flex $ fromGregorian 2018 01 01) (Just $ Flex $ fromGregorian 2018 01 03) `spanIntersect` DateSpan (Just $ Flex $ fromGregorian 2018 01 03) (Just $ Flex $ fromGregorian 2018 01 05) -- DateSpan 2018-01-03..2018-01-02-spanIntersect (DateSpan b1 e1) (DateSpan b2 e2) = DateSpan b e-    where-      b = latest b1 b2-      e = earliest e1 e2+spanIntersect (DateSpan b1 e1) (DateSpan b2 e2) = DateSpan (laterDefinite b1 b2) (earlierDefinite e1 e2)  -- | Fill any unspecified dates in the first span with the dates from--- the second one. Sort of a one-way spanIntersect.+-- the second one (if specified there). Sort of a one-way spanIntersect. spanDefaultsFrom (DateSpan a1 b1) (DateSpan a2 b2) = DateSpan a b     where a = if isJust a1 then a1 else a2           b = if isJust b1 then b1 else b2 --- | Calculate the union of a number of datespans.-spansUnion [] = nulldatespan-spansUnion [d] = d-spansUnion (d:ds) = d `spanUnion` (spansUnion ds)- -- | Calculate the union of two datespans.-spanUnion (DateSpan b1 e1) (DateSpan b2 e2) = DateSpan b e-    where-      b = earliest b1 b2-      e = latest e1 e2+-- If either span is open-ended, the union will be too.+--+-- >>> ys2024 = fromGregorian 2024 01 01+-- >>> ys2025 = fromGregorian 2025 01 01+-- >>> to2024 = DateSpan Nothing               (Just $ Exact ys2024)+-- >>> in2024 = DateSpan (Just $ Exact ys2024) (Just $ Exact ys2025)+-- >>> spanUnion to2024 in2024+-- DateSpan ..2024-12-31+-- >>> spanUnion in2024 to2024+-- DateSpan ..2024-12-31+spanUnion (DateSpan b1 e1) (DateSpan b2 e2) = DateSpan (earlier b1 b2) (later e1 e2) -latest d Nothing = d-latest Nothing d = d-latest (Just d1) (Just d2) = Just $ max d1 d2+-- | Extend the first span to include any definite end dates of the second.+-- Unlike spanUnion, open ends in the second are ignored.+-- If the first span was open-ended, it still will be after being extended.+--+-- >>> ys2024 = fromGregorian 2024 01 01+-- >>> ys2025 = fromGregorian 2025 01 01+-- >>> to2024 = DateSpan Nothing               (Just $ Exact ys2024)+-- >>> all2024 = DateSpan (Just $ Exact ys2024) (Just $ Exact ys2025)+-- >>> partof2024 = DateSpan (Just $ Exact $ fromGregorian 2024 03 01) (Just $ Exact $ fromGregorian 2024 09 01)+-- >>> spanExtend to2024 all2024+-- DateSpan 2024+-- >>> spanExtend all2024 to2024+-- DateSpan 2024+-- >>> spanExtend partof2024 all2024+-- DateSpan 2024+-- >>> spanExtend all2024 partof2024+-- DateSpan 2024+--+spanExtend (DateSpan b1 e1) (DateSpan b2 e2) = DateSpan (earlierDefinite b1 b2) (laterDefinite e1 e2) -earliest d Nothing = d-earliest Nothing d = d-earliest (Just d1) (Just d2) = Just $ min d1 d2+-- | Pick the earlier of two DateSpan starts, treating Nothing as infinitely early.+-- An Exact and Flex with the same date are considered equal; the first argument wins.+earlier :: Maybe EFDay -> Maybe EFDay -> Maybe EFDay+earlier = min +-- | Pick the later of two DateSpan starts, treating Nothing as infinitely late.+-- An Exact and Flex with the same date are considered equal; the second argument wins.+later :: Maybe EFDay -> Maybe EFDay -> Maybe EFDay+later _ Nothing = Nothing+later Nothing _ = Nothing+later d1 d2     = max d1 d2++-- | Pick the earlier of two DateSpan ends that is a definite date (if any).+-- An Exact and Flex with the same date are considered equal; the first argument wins.+earlierDefinite :: Maybe EFDay -> Maybe EFDay -> Maybe EFDay+earlierDefinite d1 Nothing = d1+earlierDefinite Nothing d2 = d2+earlierDefinite d1 d2      = min d1 d2++-- | Pick the later of two DateSpan ends that is a definite date (if any).+-- An Exact and Flex with the same date are considered equal; the second argument wins.+laterDefinite :: Maybe EFDay -> Maybe EFDay -> Maybe EFDay+laterDefinite d1 Nothing = d1+laterDefinite Nothing d2 = d2+laterDefinite d1 d2      = max d1 d2+ -- | Calculate the minimal DateSpan containing all of the given Days (in the -- usual exclusive-end-date sense: beginning on the earliest, and ending on -- the day after the latest).@@ -900,7 +943,7 @@                          show wday <> " in " <> show (weekdays ++ weekdayabbrevs)  weekdaysp :: TextParser m [Int]-weekdaysp = fmap head . group . sort <$> sepBy1 weekday (string' ",")+weekdaysp = fmap headErr . group . sort <$> sepBy1 weekday (string' ",")  -- PARTIAL headErr will succeed because of sepBy1  -- | Parse a period expression, specifying a date span and optionally -- a reporting interval. Requires a reference "today" date for

@@ -21,7 +21,7 @@ import qualified Data.Text as T  import Hledger.Data.Transaction (showTransaction)-import Hledger.Data.Posting (postingStripPrices)+import Hledger.Data.Posting (postingStripCosts) import Hledger.Data.Types import Hledger.Utils import Data.Maybe@@ -121,7 +121,7 @@         (SourcePos f tl _) = fst $ tsourcepos t         -- p had cost removed in balanceTransactionAndCheckAssertionsB,         -- must remove them from t's postings too (#2083)-        mpindex = transactionFindPostingIndex ((==p).postingStripPrices) t+        mpindex = transactionFindPostingIndex ((==p).postingStripCosts) t         errrelline = case mpindex of           Nothing -> 0           Just pindex ->

@@ -913,7 +913,7 @@ --         fixmixedamount = mapMixedAmount fixamount --         fixamount = fixprice --         fixprice a@Amount{price=Just _} = a---         fixprice a@Amount{commodity=c} = a{price=maybe Nothing (Just . UnitPrice) $ journalPriceDirectiveFor j d c}+--         fixprice a@Amount{commodity=c} = a{price=maybe Nothing (Just . UnitCost) $ journalPriceDirectiveFor j d c}  -- -- | Get the price for a commodity on the specified day from the price database, if known. -- -- Does only one lookup step, ie will not look up the price of a price.@@ -980,10 +980,10 @@  -- -- | Get this amount's commodity and any commodities referenced in its price. -- amountCommodities :: Amount -> [CommoditySymbol]--- amountCommodities Amount{acommodity=c,aprice=p} =+-- amountCommodities Amount{acommodity=c,acost=p} = --     case p of Nothing -> [c]---               Just (UnitPrice ma)  -> c:(concatMap amountCommodities $ amounts ma)---               Just (TotalPrice ma) -> c:(concatMap amountCommodities $ amounts ma)+--               Just (UnitCost ma)  -> c:(concatMap amountCommodities $ amounts ma)+--               Just (TotalCost ma) -> c:(concatMap amountCommodities $ amounts ma)  -- | Get an ordered list of amounts in this journal which can -- influence canonical amount display styles. Those amounts are, in@@ -993,7 +993,7 @@ -- * posting amounts in transactions (in parse order) -- * the amount in the final default commodity (D) directive ----- Transaction price amounts (posting amounts' aprice field) are not included.+-- Transaction price amounts (posting amounts' acost field) are not included. -- journalStyleInfluencingAmounts :: Journal -> [Amount] journalStyleInfluencingAmounts j =@@ -1033,7 +1033,7 @@ -- * posting amounts in transactions (in parse order) -- -- Transaction price amounts, which may be embedded in posting amounts--- (the aprice field), are left intact but not traversed/processed.+-- (the acost field), are left intact but not traversed/processed. -- -- traverseJournalAmounts :: Applicative f => (Amount -> f Amount) -> Journal -> f Journal -- traverseJournalAmounts f j =

@@ -198,16 +198,23 @@       ])  -- | Tag names which have special significance to hledger.+-- Keep synced with check-tags.test and hledger manual > Special tags. builtinTags = [-   "type"  -- declares an account's type-  ,"t"     -- generated by timedot letters notation-  -- optionally generated on periodic transactions and auto postings-  ,"generated-transaction"-  ,"generated-posting"-  -- used internally, not shown (but queryable)-  ,"_generated-transaction"-  ,"_generated-posting"-  ,"_conversion-matched"+   "date"                   -- overrides a posting's date+  ,"date2"                  -- overrides a posting's secondary date+  ,"type"                   -- declares an account's type+  ,"t"                      -- appears on postings generated by timedot letters+  ,"assert"                 -- appears on txns generated by close --assert+  ,"retain"                 -- appears on txns generated by close --retain+  ,"start"                  -- appears on txns generated by close --migrate/--close/--open/--assign+  ,"generated-transaction"  -- with --verbose-tags, appears on generated periodic txns+  ,"generated-posting"      -- with --verbose-tags, appears on generated auto postings+  ,"modified"               -- with --verbose-tags, appears on txns which have had auto postings added+  -- hidden tags used internally (and also queryable):+  ,"_generated-transaction" -- always exists on generated periodic txns+  ,"_generated-posting"     -- always exists on generated auto postings+  ,"_modified"              -- always exists on txns which have had auto postings added+  ,"_conversion-matched"    -- exists on postings which have been matched with a nearby @/@@ cost notation   ]  -- | In each tranaction, check that any conversion postings occur in adjacent pairs.

@@ -9,6 +9,7 @@ import Data.List (groupBy, sortBy) import Data.Text (Text) import qualified Data.Text as T+import Safe (headErr) import Text.Printf (printf)  import Hledger.Data.AccountName (accountLeafName)@@ -55,10 +56,14 @@  finddupes :: (Ord leaf, Eq full) => [(leaf, full)] -> [(leaf, [full])] finddupes leafandfullnames = zip dupLeafs dupAccountNames-  where dupLeafs = map (fst . head) d-        dupAccountNames = map (map snd) d-        d = dupes' leafandfullnames-        dupes' = filter ((> 1) . length)+  where+    dupAccountNames = map (map snd) dupes+    dupLeafs = case dupes of+      [] -> []+      _  -> map (fst . headErr) dupes  -- PARTIAL headErr succeeds because of pattern+    dupes = fnddupes leafandfullnames+      where+        fnddupes = filter ((> 1) . length)           . groupBy ((==) `on` fst)           . sortBy (compare `on` fst) 

@@ -102,7 +102,7 @@   toEncoding = toEncoding . amountsRaw  instance ToJSON BalanceAssertion-instance ToJSON AmountPrice+instance ToJSON AmountCost instance ToJSON MarketPrice instance ToJSON PostingType @@ -208,7 +208,7 @@   parseJSON = fmap (mixed :: [Amount] -> MixedAmount) . parseJSON  instance FromJSON BalanceAssertion-instance FromJSON AmountPrice+instance FromJSON AmountCost instance FromJSON MarketPrice instance FromJSON PostingType instance FromJSON Posting

@@ -80,7 +80,7 @@  -- | List a ledger's top-level accounts (the ones below the root), in tree order. ledgerTopAccounts :: Ledger -> [Account]-ledgerTopAccounts = asubs . head . laccounts+ledgerTopAccounts = asubs . headDef nullacct . laccounts  -- | List a ledger's bottom-level (subaccount-less) accounts, in tree order. ledgerLeafAccounts :: Ledger -> [Account]

@@ -36,7 +36,7 @@   postingAllTags,   transactionAllTags,   relatedPostings,-  postingStripPrices,+  postingStripCosts,   postingApplyAliases,   postingApplyCommodityStyles,   postingStyleAmounts,@@ -188,7 +188,7 @@ -- | 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)+    singleton '=' <> eq <> ast <> singleton ' ' <> showAmountB def{displayZeroCommodity=True, displayForceDecimalMark=True} (baamount ba)   where     eq  = if batotal ba     then singleton '=' else mempty     ast = if bainclusive ba then singleton '*' else mempty@@ -292,7 +292,7 @@     shownAmounts       | elideamount = [mempty]       | otherwise   = showMixedAmountLinesB displayopts $ pamount p-        where displayopts = noColour{+        where displayopts = defaultFmt{           displayZeroCommodity=True, displayForceDecimalMark=True, displayOneLine=onelineamounts           }     thisamtwidth = maximumBound 0 $ map wbWidth shownAmounts@@ -361,7 +361,7 @@       | elideamount = [mempty]       | otherwise   = showMixedAmountLinesB displayopts a'         where-          displayopts = noColour{ displayZeroCommodity=True, displayForceDecimalMark=True }+          displayopts = defaultFmt{ displayZeroCommodity=True, displayForceDecimalMark=True }           a' = mapMixedAmount amountToBeancount $ pamount p     thisamtwidth = maximumBound 0 $ map wbWidth shownAmounts @@ -386,7 +386,7 @@ -- in a way that Beancount can read: forces the commodity symbol to the right, -- converts a few currency symbols to names, capitalises all letters. amountToBeancount :: Amount -> BeancountAmount-amountToBeancount a@Amount{acommodity=c,astyle=s,aprice=mp} = a{acommodity=c', astyle=s', aprice=mp'}+amountToBeancount a@Amount{acommodity=c,astyle=s,acost=mp} = a{acommodity=c', astyle=s', acost=mp'}   -- https://beancount.github.io/docs/beancount_language_syntax.html#commodities-currencies   where     c' = T.toUpper $@@ -398,8 +398,8 @@     s' = s{ascommodityside=R, ascommodityspaced=True}     mp' = costToBeancount <$> mp       where-        costToBeancount (TotalPrice amt) = TotalPrice $ amountToBeancount amt-        costToBeancount (UnitPrice  amt) = UnitPrice  $ amountToBeancount amt+        costToBeancount (TotalCost amt) = TotalCost $ amountToBeancount amt+        costToBeancount (UnitCost  amt) = UnitCost  $ amountToBeancount amt  -- | Like showAccountName for Beancount journal format. -- Calls accountNameToBeancount first.@@ -451,8 +451,8 @@ sumPostings = foldl' (\amt p -> maPlus amt $ pamount p) nullmixedamt  -- | Strip all prices from a Posting.-postingStripPrices :: Posting -> Posting-postingStripPrices = postingTransformAmount mixedAmountStripPrices+postingStripCosts :: Posting -> Posting+postingStripCosts = postingTransformAmount mixedAmountStripCosts  -- | Get a posting's (primary) date - it's own primary date if specified, -- otherwise the parent transaction's primary date, or the null date if@@ -543,20 +543,20 @@   | "_conversion-matched" `elem` map fst (ptags p) && nocosts = Nothing   | otherwise = Just $ postingTransformAmount mixedAmountCost p   where-    nocosts = (not . any (isJust . aprice) . amountsRaw) $ pamount p+    nocosts = (not . any (isJust . acost) . amountsRaw) $ pamount p --- | Generate inferred equity postings from a 'Posting' using transaction prices.--- Make sure not to generate equity postings when there are already matched--- conversion postings.+-- | Generate inferred equity postings from a 'Posting''s costs.+-- Make sure not to duplicate them when matching ones exist already. postingAddInferredEquityPostings :: Bool -> Text -> Posting -> [Posting] postingAddInferredEquityPostings verbosetags equityAcct p     | "_price-matched" `elem` map fst (ptags p) = [p]-    | otherwise = taggedPosting : concatMap conversionPostings priceAmounts+    | otherwise = taggedPosting : concatMap conversionPostings costs   where+    costs = filter (isJust . acost) . amountsRaw $ pamount p     taggedPosting-      | null priceAmounts = p-      | otherwise         = p{ ptags = ("_price-matched","") : ptags p }-    conversionPostings amt = case aprice amt of+      | null costs = p+      | otherwise  = p{ ptags = ("_price-matched","") : ptags p }+    conversionPostings amt = case acost amt of         Nothing -> []         Just _  -> [ cp{ paccount = accountPrefix <> amtCommodity                        , pamount = mixedAmount . negate $ amountStripCost amt@@ -580,8 +580,6 @@         accountPrefix = mconcat [ equityAcct, ":", T.intercalate "-" $ sort [amtCommodity, costCommodity], ":"]         -- Take the commodity of an amount and collapse consecutive spaces to a single space         commodity = T.unwords . filter (not . T.null) . T.words . acommodity--    priceAmounts = filter (isJust . aprice) . amountsRaw $ pamount p  -- | Make a market price equivalent to this posting's amount's unit -- price, if any.

@@ -387,13 +387,13 @@     -- with the matching amount which must be present in another non-conversion posting.     costfulPostingIfMatchesBothAmounts :: Amount -> Amount -> Posting -> Maybe Posting     costfulPostingIfMatchesBothAmounts a1 a2 costfulp = do-        a@Amount{aprice=Just _} <- postingSingleAmount costfulp+        a@Amount{acost=Just _} <- postingSingleAmount costfulp         if            | dbgamtmatch 1 a1 a (amountsMatch (-a1) a)  &&  dbgcostmatch 2 a2 a (amountsMatch a2 (amountCost a)) -> Just costfulp            | dbgamtmatch 2 a2 a (amountsMatch (-a2) a)  &&  dbgcostmatch 1 a1 a (amountsMatch a1 (amountCost a)) -> Just costfulp            | otherwise -> Nothing            where-            dbgamtmatch  n a b = dbg7 ("conversion posting "     <>show n<>" "<>showAmount a<>" balances amount "<>showAmountWithoutPrice b <>" of costful posting "<>showAmount b<>" at precision "<>dbgShowAmountPrecision a<>" ?")+            dbgamtmatch  n a b = dbg7 ("conversion posting "     <>show n<>" "<>showAmount a<>" balances amount "<>showAmountWithoutCost b <>" of costful posting "<>showAmount b<>" at precision "<>dbgShowAmountPrecision a<>" ?")             dbgcostmatch n a b = dbg7 ("and\nconversion posting "<>show n<>" "<>showAmount a<>" matches cost "   <>showAmount (amountCost b)<>" of costful posting "<>showAmount b<>" at precision "<>dbgShowAmountPrecision a<>" ?")       -- Add a cost to a posting if it matches (negative) one of the@@ -401,7 +401,7 @@     addCostIfMatchesOneAmount :: Amount -> Amount -> Posting -> Maybe (Posting, Amount)     addCostIfMatchesOneAmount a1 a2 p = do         a <- postingSingleAmount p-        let newp cost = p{pamount = mixedAmount a{aprice = Just $ TotalPrice cost}}+        let newp cost = p{pamount = mixedAmount a{acost = Just $ TotalCost cost}}         if            | amountsMatch (-a1) a -> Just (newp a2, a2)            | amountsMatch (-a2) a -> Just (newp a1, a1)@@ -409,8 +409,8 @@      -- Get the single-commodity costless amount from a conversion posting, or raise an error.     conversionPostingAmountNoCost p = case postingSingleAmount p of-        Just a@Amount{aprice=Nothing} -> Right a-        Just Amount{aprice=Just _} -> Left $ annotateWithPostings [p] "Conversion postings must not have a cost:"+        Just a@Amount{acost=Nothing} -> Right a+        Just Amount{acost=Just _} -> Left $ annotateWithPostings [p] "Conversion postings must not have a cost:"         Nothing                    -> Left $ annotateWithPostings [p] "Conversion postings must have a single-commodity amount:"      -- Do these amounts look the same when compared at the first's display precision ?@@ -457,7 +457,7 @@       | check          = Left "Conversion postings must occur in adjacent pairs"       | otherwise      = Right ((cs, (ps, np:os)), Nothing)     isConversion p = paccount p `elem` conversionaccts-    hasCost p = isJust $ aprice =<< postingSingleAmount p+    hasCost p = isJust $ acost =<< postingSingleAmount p  -- | Get a posting's amount if it is single-commodity. postingSingleAmount :: Posting -> Maybe Amount

@@ -19,6 +19,7 @@ import Data.Maybe (catMaybes) import qualified Data.Text as T import Data.Time.Calendar (Day)+import Safe (headDef) import Hledger.Data.Types import Hledger.Data.Amount import Hledger.Data.Dates@@ -127,11 +128,11 @@         Just n  -> \p ->           -- Multiply the old posting's amount by the posting rule's multiplier.           let-            pramount = dbg6 "pramount" . head . amountsRaw $ pamount pr+            pramount = dbg6 "pramount" . headDef nullamt . amountsRaw $ pamount pr             matchedamount = dbg6 "matchedamount" . filterMixedAmount (symq `matchesAmount`) $ pamount p             -- Handle a matched amount with a total price carefully so as to keep the transaction balanced (#928).             -- Approach 1: convert to a unit price and increase the display precision slightly-            -- Mixed as = dbg6 "multipliedamount" $ n `multiplyMixedAmount` mixedAmountTotalPriceToUnitPrice matchedamount+            -- Mixed as = dbg6 "multipliedamount" $ n `multiplyMixedAmount` mixedAmountTotalCostToUnitCost matchedamount             -- Approach 2: multiply the total price (keeping it positive) as well as the quantity             as = dbg6 "multipliedamount" $ multiplyMixedAmount n matchedamount           in@@ -140,7 +141,7 @@               -- TODO multipliers with commodity symbols are not yet a documented feature.               -- For now: in addition to multiplying the quantity, it also replaces the               -- matched amount's commodity, display style, and price with those of the posting rule.-              c  -> mapMixedAmount (\a -> a{acommodity = c, astyle = astyle pramount, aprice = aprice pramount}) as+              c  -> mapMixedAmount (\a -> a{acommodity = c, astyle = astyle pramount, acost = acost pramount}) as  postingRuleMultiplier :: TMPostingRule -> Maybe Quantity postingRuleMultiplier tmpr = case amountsRaw . pamount $ tmprPosting tmpr of

@@ -171,7 +171,7 @@   | Revenue   | Expense   | Cash  -- ^ a subtype of Asset - liquid assets to show in cashflow report-  | Conversion -- ^ a subtype of Equity - account in which to generate conversion postings for transaction prices+  | Conversion -- ^ a subtype of Equity - account with which to balance commodity conversions   deriving (Eq,Ord,Generic)  instance Show AccountType where@@ -246,12 +246,20 @@ -- | An amount's per-unit or total cost/selling price in another -- commodity, as recorded in the journal entry eg with @ or @@. -- "Cost", formerly AKA "transaction price". The amount is always positive.-data AmountPrice = UnitPrice !Amount | TotalPrice !Amount+data AmountCost = UnitCost !Amount | TotalCost !Amount   deriving (Eq,Ord,Generic,Show) --- | Every Amount has one of these, influencing how the amount is displayed.--- Also, each Commodity can have one, which can be applied to its amounts for consistent display.--- See also Amount.AmountDisplayOpts.+-- | Display styles for amounts - things which can be detected during parsing, such as+-- commodity side and spacing, digit group marks, decimal mark, number of decimal digits etc.+-- Every "Amount" has an AmountStyle.+-- After amounts are parsed from the input, for each "Commodity" a standard style is inferred+-- and then used when displaying amounts in that commodity.+-- Related to "AmountFormat" but higher level.+--+-- See also:+-- - hledger manual > Commodity styles+-- - hledger manual > Amounts+-- - hledger manual > Commodity display style data AmountStyle = AmountStyle {   ascommodityside   :: !Side,                     -- ^ show the symbol on the left or the right ?   ascommodityspaced :: !Bool,                     -- ^ show a space between symbol and quantity ?@@ -261,7 +269,7 @@   asrounding        :: !Rounding                  -- ^ "rounding strategy" - kept here for convenience, for now:                                                   --   when displaying an amount, it is ignored,                                                   --   but when applying this style to another amount, it determines -                                                  --   how hard we should try to adjust the amount's display precision.+                                                  --   how hard we should try to adjust that amount's display precision. } deriving (Eq,Ord,Read,Generic)  instance Show AmountStyle where@@ -312,7 +320,7 @@       acommodity  :: !CommoditySymbol,     -- commodity symbol, or special value "AUTO"       aquantity   :: !Quantity,            -- numeric quantity, or zero in case of "AUTO"       astyle      :: !AmountStyle,-      aprice      :: !(Maybe AmountPrice)  -- ^ the (fixed, transaction-specific) price for this amount, if any+      acost       :: !(Maybe AmountCost)  -- ^ the (fixed, transaction-specific) cost in another commodity of this amount, if any     } deriving (Eq,Ord,Generic,Show)  -- | Types with this class have one or more amounts,@@ -350,41 +358,41 @@     go ((_,x):xs) [] = compareQuantities (Just x) Nothing  <> go xs []     go [] ((_,y):ys) = compareQuantities Nothing  (Just y) <> go [] ys     go []         [] = EQ-    compareQuantities = comparing (maybe 0 aquantity) <> comparing (maybe 0 totalprice)-    totalprice x = case aprice x of-                        Just (TotalPrice p) -> aquantity p+    compareQuantities = comparing (maybe 0 aquantity) <> comparing (maybe 0 totalcost)+    totalcost x = case acost x of+                        Just (TotalCost p) -> aquantity p                         _                   -> 0  -- | Stores the CommoditySymbol of the Amount, along with the CommoditySymbol of--- the price, and its unit price if being used.+-- the cost, and its unit cost if being used. data MixedAmountKey-  = MixedAmountKeyNoPrice    !CommoditySymbol-  | MixedAmountKeyTotalPrice !CommoditySymbol !CommoditySymbol-  | MixedAmountKeyUnitPrice  !CommoditySymbol !CommoditySymbol !Quantity+  = MixedAmountKeyNoCost   !CommoditySymbol+  | MixedAmountKeyTotalCost !CommoditySymbol !CommoditySymbol+  | MixedAmountKeyUnitCost  !CommoditySymbol !CommoditySymbol !Quantity   deriving (Eq,Generic,Show)  -- | We don't auto-derive the Ord instance because it would give an undesired ordering. -- We want the keys to be sorted lexicographically: -- (1) By the primary commodity of the amount.--- (2) By the commodity of the price, with no price being first.--- (3) By the unit price, from most negative to most positive, with total prices--- before unit prices.+-- (2) By the commodity of the cost, with no cost being first.+-- (3) By the unit cost, from most negative to most positive, with total costs+-- before unit costs. -- For example, we would like the ordering to give--- MixedAmountKeyNoPrice "X" < MixedAmountKeyTotalPrice "X" "Z" < MixedAmountKeyNoPrice "Y"+-- MixedAmountKeyNoCost "X" < MixedAmountKeyTotalCost "X" "Z" < MixedAmountKeyNoCost "Y" instance Ord MixedAmountKey where-  compare = comparing commodity <> comparing pCommodity <> comparing pPrice+  compare = comparing commodity <> comparing pCommodity <> comparing pCost     where-      commodity (MixedAmountKeyNoPrice    c)     = c-      commodity (MixedAmountKeyTotalPrice c _)   = c-      commodity (MixedAmountKeyUnitPrice  c _ _) = c+      commodity (MixedAmountKeyNoCost    c)     = c+      commodity (MixedAmountKeyTotalCost c _)   = c+      commodity (MixedAmountKeyUnitCost  c _ _) = c -      pCommodity (MixedAmountKeyNoPrice    _)      = Nothing-      pCommodity (MixedAmountKeyTotalPrice _ pc)   = Just pc-      pCommodity (MixedAmountKeyUnitPrice  _ pc _) = Just pc+      pCommodity (MixedAmountKeyNoCost    _)      = Nothing+      pCommodity (MixedAmountKeyTotalCost _ pc)   = Just pc+      pCommodity (MixedAmountKeyUnitCost  _ pc _) = Just pc -      pPrice (MixedAmountKeyNoPrice    _)     = Nothing-      pPrice (MixedAmountKeyTotalPrice _ _)   = Nothing-      pPrice (MixedAmountKeyUnitPrice  _ _ q) = Just q+      pCost (MixedAmountKeyNoCost    _)     = Nothing+      pCost (MixedAmountKeyTotalCost _ _)   = Nothing+      pCost (MixedAmountKeyUnitCost  _ _ q) = Just q  data PostingType = RegularPosting | VirtualPosting | BalancedVirtualPosting                    deriving (Eq,Show,Generic)@@ -439,7 +447,7 @@       ptransaction      :: Maybe Transaction,       -- ^ this posting's parent transaction (co-recursive types).                                                     --   Tying this knot gets tedious, Maybe makes it easier/optional.       poriginal         :: Maybe Posting            -- ^ When this posting has been transformed in some way-                                                    --   (eg its amount or price was inferred, or the account name was+                                                    --   (eg its amount or cost was inferred, or the account name was                                                     --   changed by a pivot or budget report), this references the original                                                     --   untransformed posting (which will have Nothing in this field).     } deriving (Generic)@@ -614,9 +622,38 @@ -- The data is partial, and list fields are in reverse order. type ParsedJournal = Journal +-- | One of the standard *-separated value file types known by hledger,+data SepFormat +  = Csv  -- comma-separated+  | Tsv  -- tab-separated+  | Ssv  -- semicolon-separated+  deriving Eq+ -- | The id of a data format understood by hledger, eg @journal@ or @csv@. -- The --output-format option selects one of these for output.-type StorageFormat = String+data StorageFormat +  = Rules +  | Journal' +  | Ledger' +  | Timeclock +  | Timedot +  | Sep SepFormat +  deriving Eq++instance Show SepFormat where+  show Csv = "csv"+  show Ssv = "ssv"+  show Tsv = "tsv"++instance Show StorageFormat where+  show Rules = "rules"+  show Journal' = "journal"+  show Ledger' = "ledger"+  show Timeclock = "timeclock"+  show Timedot = "timedot"+  show (Sep Csv) = "csv"+  show (Sep Ssv) = "ssv"+  show (Sep Tsv) = "tsv"  -- | Extra information found in a payee directive. data PayeeDeclarationInfo = PayeeDeclarationInfo {

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

@@ -82,7 +82,7 @@ import Data.Text (Text) import qualified Data.Text as T import Data.Time.Calendar (Day, fromGregorian )-import Safe (readDef, readMay, maximumByMay, maximumMay, minimumMay)+import Safe (headErr, readDef, readMay, maximumByMay, maximumMay, minimumMay) import Text.Megaparsec (between, noneOf, sepBy, try, (<?>), notFollowedBy) import Text.Megaparsec.Char (char, string, string') @@ -123,15 +123,15 @@  instance Default Query where def = Any --- | Construct a payee tag+-- | Construct a query for the payee: tag payeeTag :: Maybe Text -> Either RegexError Query payeeTag = fmap (Tag (toRegexCI' "payee")) . maybe (pure Nothing) (fmap Just . toRegexCI) --- | Construct a note tag+-- | Construct a query for the note: tag noteTag :: Maybe Text -> Either RegexError Query noteTag = fmap (Tag (toRegexCI' "note")) . maybe (pure Nothing) (fmap Just . toRegexCI) --- | Construct a generated-transaction tag+-- | Construct a query for the generated-transaction: tag generatedTransactionTag :: Query generatedTransactionTag = Tag (toRegexCI' "generated-transaction") Nothing @@ -201,11 +201,11 @@ parseQueryList d termstrs = do   eterms <- mapM (parseQueryTerm d) termstrs   let (pats, optss) = unzip eterms-      q = combineQueryList pats+      q = combineQueriesByType pats   Right (q, concat optss) -combineQueryList :: [Query] -> Query-combineQueryList pats = q+combineQueriesByType :: [Query] -> Query+combineQueriesByType pats = q   where     (descpats, pats') = partition queryIsDesc pats     (acctpats, pats'') = partition queryIsAcct pats'@@ -324,10 +324,12 @@ -- prefix-operator "NOT e" is always parsed before "e AND e", "e AND e" before "e OR e", -- and "e OR e" before "e e". ----- The space-separation operator is left as it was the default before the introduction of--- boolean operators. It takes the behaviour defined in the interpretQueryList function,--- whereas the NOT, OR, and AND operators simply wrap a list of queries with the associated---+-- The "space" operator still works as it did before the introduction of boolean operators:+-- it combines terms according to their types, using parseQueryList.+-- Whereas the new NOT, OR, and AND operators work uniformly for all term types.+-- There is an exception: queries being OR'd may not specify a date period,+-- because that can produce multiple, possibly disjoint, report periods and result sets,+-- and we don't have report semantics worked out for it yet. (#2178) -- -- The result of this function is either an error encountered during parsing of the -- expression or the combined query and query options.@@ -337,50 +339,90 @@ -- -- >>> parseBooleanQuery nulldate "expenses:dining AND desc:a OR desc:b" -- Right (Or [And [Acct (RegexpCI "expenses:dining"),Desc (RegexpCI "a")],Desc (RegexpCI "b")],[])+-- parseBooleanQuery :: Day -> T.Text -> Either String (Query,[QueryOpt])-parseBooleanQuery d t = either (Left . ("failed to parse query:" <>) . customErrorBundlePretty) Right $ parsewith spacedQueriesP t+parseBooleanQuery d t =+  either (Left . ("failed to parse query:" <>) . customErrorBundlePretty) Right $+    parsewith spacedExprsP t+   where-    regexP       :: SimpleTextParser T.Text-    regexP       = choice'-      [ stripquotes . T.pack <$> between (char '\'') (char '\'') (many $ noneOf ("'" :: [Char])),-        stripquotes . T.pack <$> between (char '"') (char '"') (many $ noneOf ("\"" :: [Char])),-        T.pack <$> (notFollowedBy keywordSpaceP >> (many $ noneOf (") \n\r" :: [Char]))) ]-    queryPrefixP :: SimpleTextParser T.Text-    queryPrefixP = (string "not:" <> (fromMaybe "" <$> optional queryPrefixP))-               <|> choice' (string <$> queryprefixes)-               <?> "query prefix"-    queryTermP   :: SimpleTextParser (Query, [QueryOpt])-    queryTermP   = do-      prefix <- optional queryPrefixP-      queryRegex <- regexP+    -- Our "boolean queries" are compound query expressions built with a hierarchy of combinators.+    -- At the top level we have one or more query expressions separated by space.+    -- These are combined in the default way according to their types (see combineQueriesByType).+    spacedExprsP :: SimpleTextParser (Query, [QueryOpt])+    spacedExprsP = combineWith combineQueriesByType <$> orExprsP `sepBy` skipNonNewlineSpaces1 -      case parseQueryTerm d (fromMaybe "" prefix <> queryRegex) of-        Right q  -> return q-        Left err -> error' err+      where+        combineWith :: ([Query] -> Query) -> [(Query, [QueryOpt])] -> (Query, [QueryOpt])+        combineWith f res =+          let (qs, qoptss) = unzip res+              qoptss'      = concat qoptss+          in case qs of+              []     -> (Any,                  qoptss')+              (q:[]) -> (simplifyQuery q,      qoptss')+              _      -> (simplifyQuery $ f qs, qoptss') -    keywordSpaceP :: SimpleTextParser T.Text-    keywordSpaceP = choice' (string' <$> ["not ", "and ", "or "])+        -- Containing query expressions separated by "or".+        -- If there's more than one, make sure none contains a "date:".+        orExprsP :: SimpleTextParser (Query, [QueryOpt])+        orExprsP = do+          exprs <- andExprsP `sepBy` (try $ skipNonNewlineSpaces >> string' "or" >> skipNonNewlineSpaces1)+          if ( length exprs > 1+            && (any (/=Any) $ map (filterQuery queryIsDateOrDate2 . fst) exprs))+          then fail "sorry, using date: in OR expressions is not supported."+          else return $ combineWith Or exprs -    parQueryP,notQueryP :: SimpleTextParser (Query, [QueryOpt])-    parQueryP = between (char '(' >> skipNonNewlineSpaces)-                        (try $ skipNonNewlineSpaces >> char ')')-                        spacedQueriesP-            <|> queryTermP-    notQueryP = (maybe id (\_ (q, qopts) -> (Not q, qopts)) <$> optional (try $ string' "not" >> notFollowedBy (char ':') >> skipNonNewlineSpaces1)) <*> parQueryP+          where+            -- Containing query expressions separated by "and".+            andExprsP :: SimpleTextParser (Query, [QueryOpt])+            andExprsP = combineWith And <$> maybeNotExprP `sepBy` (try $ skipNonNewlineSpaces >> string' "and" >> skipNonNewlineSpaces1) -    andQueriesP,orQueriesP,spacedQueriesP :: SimpleTextParser (Query, [QueryOpt])-    andQueriesP    = nArityOp And <$> notQueryP `sepBy` (try $ skipNonNewlineSpaces >> string' "and" >> skipNonNewlineSpaces1)-    orQueriesP     = nArityOp Or <$> andQueriesP `sepBy` (try $ skipNonNewlineSpaces >> string' "or" >> skipNonNewlineSpaces1)-    spacedQueriesP = nArityOp combineQueryList <$> orQueriesP `sepBy` skipNonNewlineSpaces1+              where+                -- Containing query expressions optionally preceded by "not".+                maybeNotExprP :: SimpleTextParser (Query, [QueryOpt])+                maybeNotExprP = (maybe id (\_ (q, qopts) -> (Not q, qopts)) <$>+                  optional (try $ string' "not" >> notFollowedBy (char ':') >> skipNonNewlineSpaces1)) <*> termOrParenthesisedExprP -    nArityOp       :: ([Query] -> Query) -> [(Query, [QueryOpt])] -> (Query, [QueryOpt])-    nArityOp f res = let (qs, qoptss) = unzip res-                         qoptss'      = concat qoptss-                      in case qs of-                         []     -> (Any, qoptss')-                         (q:[]) -> (simplifyQuery q, qoptss')-                         _      -> (simplifyQuery $ f qs, qoptss')+                  where+                    -- Each of which is a parenthesised query expression or a single query term.+                    termOrParenthesisedExprP :: SimpleTextParser (Query, [QueryOpt])+                    termOrParenthesisedExprP = +                      between (char '(' >> skipNonNewlineSpaces) (try $ skipNonNewlineSpaces >> char ')') spacedExprsP+                      <|> queryTermP +                      where+                        -- A simple query term: foo, acct:foo, desc:foo, payee:foo etc.+                        queryTermP :: SimpleTextParser (Query, [QueryOpt])+                        queryTermP = do+                          prefix <- optional queryPrefixP+                          arg <- queryArgP+                          case parseQueryTerm d (fromMaybe "" prefix <> arg) of+                            Right q  -> return q+                            Left err -> error' err++                          where+                            -- One of the query prefixes: acct:, desc:, payee: etc (plus zero or more not: prefixes).+                            queryPrefixP :: SimpleTextParser T.Text+                            queryPrefixP =+                              (string "not:" <> (fromMaybe "" <$> optional queryPrefixP))+                              <|> choice' (string <$> queryprefixes)+                              <?> "query prefix"++                            -- A query term's argument, the part after the prefix:+                            -- any text enclosed in single quotes or double quotes,+                            -- or any text up to the next space, closing parenthesis, or end of line,+                            -- if it is not one of the keywords "not", "and", "or".+                            queryArgP :: SimpleTextParser T.Text+                            queryArgP = choice'+                              [ stripquotes . T.pack <$> between (char '\'') (char '\'') (many $ noneOf ("'" :: [Char])),+                                stripquotes . T.pack <$> between (char '"') (char '"') (many $ noneOf ("\"" :: [Char])),+                                T.pack <$> (notFollowedBy keywordP >> (many $ noneOf (") \n\r" :: [Char]))) ]++                              where+                                -- Any of the combinator keywords used above (not/and/or), terminated by a space.+                                keywordP :: SimpleTextParser T.Text+                                keywordP = choice' (string' <$> ["not ", "and ", "or "])+ -- | Parse the argument of an amt query term ([OP][SIGN]NUM), to an -- OrdPlus and a Quantity, or if parsing fails, an error message. OP -- can be <=, <, >=, >, or = . NUM can be a simple integer or decimal.@@ -494,14 +536,14 @@   where     simplify (And []) = Any     simplify (And [q]) = simplify q-    simplify (And qs) | same qs = simplify $ head qs+    simplify (And qs) | same qs = simplify $ headErr qs  -- PARTIAL headErr succeeds because pattern ensures non-null qs                       | None `elem` qs = None                       | all queryIsDate qs = Date $ spansIntersect $ mapMaybe queryTermDateSpan qs                       | otherwise = And $ map simplify dateqs ++ map simplify otherqs                       where (dateqs, otherqs) = partition queryIsDate $ filter (/=Any) qs     simplify (Or []) = Any     simplify (Or [q]) = simplifyQuery q-    simplify (Or qs) | same qs = simplify $ head qs+    simplify (Or qs) | same qs = simplify $ headErr qs  -- PARTIAL headErr succeeds because pattern ensures non-null qs                      | Any `elem` qs = Any                      -- all queryIsDate qs = Date $ spansUnion $ mapMaybe queryTermDateSpan qs  ?                      | otherwise = Or $ map simplify $ filter (/=None) qs

@@ -140,7 +140,7 @@ import qualified Data.Text as T import qualified Data.Text.IO as T import Data.Time (Day)-import Safe (headDef)+import Safe (headDef, headMay) import System.Directory (doesFileExist, getHomeDirectory) import System.Environment (getEnv) import System.Exit (exitFailure)@@ -184,8 +184,12 @@ -- determine a home directory). defaultJournalPath :: IO String defaultJournalPath = do-  s <- envJournalPath-  if null s then defpath else return s+  p <- envJournalPath+  if null p+  then defpath+  else do+    ps <- expandGlob "." p `C.catch` (\(_::C.IOException) -> return [])+    maybe defpath return $ headMay ps     where       envJournalPath =         getEnv journalEnvVar@@ -331,16 +335,16 @@ orDieTrying :: MonadIO m => ExceptT String m a -> m a orDieTrying a = either (liftIO . fail) return =<< runExceptT a --- | If the specified journal file does not exist (and is not "-"),--- give a helpful error and quit.+-- | If the specified journal file does not exist (and is not "-"), give a helpful error and quit.+-- (Using "journal file" generically here; it could be in any of hledger's supported formats.) requireJournalFileExists :: FilePath -> IO () requireJournalFileExists "-" = return () requireJournalFileExists f = do   exists <- doesFileExist f-  unless exists $ do  -- XXX might not be a journal file-    hPutStr stderr $ "The hledger journal file \"" <> f <> "\" was not found.\n"+  unless exists $ do+    hPutStr stderr $ "The hledger data file \"" <> f <> "\" was not found.\n"     hPutStr stderr "Please create it first, eg with \"hledger add\" or a text editor.\n"-    hPutStr stderr "Or, specify an existing journal file with -f or LEDGER_FILE.\n"+    hPutStr stderr "Or, specify an existing data file with -f or $LEDGER_FILE.\n"     exitFailure  -- | Ensure there is a journal file at the given path, creating an empty one if needed.@@ -348,7 +352,7 @@ -- which could cause data loss (see 'isWindowsUnsafeDotPath'). ensureJournalFileExists :: FilePath -> IO () ensureJournalFileExists f = do-  when (os/="mingw32" && isWindowsUnsafeDotPath f) $ do+  when (os=="mingw32" && isWindowsUnsafeDotPath f) $ do     hPutStr stderr $ "Part of file path \"" <> show f <> "\"\n ends with a dot, which is unsafe on Windows; please use a different path.\n"     exitFailure   exists <- doesFileExist f

@@ -190,7 +190,7 @@     ,rParser :: MonadIO m => ErroringJournalParser m ParsedJournal     } -instance Show (Reader m) where show r = rFormat r ++ " reader"+instance Show (Reader m) where show r = show (rFormat r) ++ " reader"  -- | Parse an InputOpts from a RawOpts and a provided date. -- This will fail with a usage error if the forecast period expression cannot be parsed.@@ -517,41 +517,39 @@     sep <- datesepchar <?> "date separator"     d2 <- decimal <?> "month or day"     case d1 of-         Left y  -> fullDate startOffset y sep d2-         Right m -> partialDate startOffset mYear m sep d2+      Left y  -> fullDate startOffset y sep d2+      Right m -> partialDate startOffset mYear m d2     <?> "full or partial date"   where     fullDate :: Int -> Year -> Char -> Month -> TextParser m Day-    fullDate startOffset year sep1 month = do+    fullDate startOffset year sep month = do       sep2 <- satisfy isDateSepChar <?> "date separator"       day <- decimal <?> "day"       endOffset <- getOffset-      let dateStr = show year ++ [sep1] ++ show month ++ [sep2] ++ show day--      when (sep1 /= sep2) $ customFailure $ parseErrorAtRegion startOffset endOffset $-        "This date is malformed because the separators are different.\n"-        ++"Please use consistent separators."-+      when (sep /= sep2) $ +        customFailure $ parseErrorAtRegion startOffset endOffset $+          "This date has different separators, please use consistent separators."       case fromGregorianValid year month day of-        Nothing -> customFailure $ parseErrorAtRegion startOffset endOffset $-                     "This date is invalid, please correct it: " ++ dateStr+        Nothing -> +          customFailure $ parseErrorAtRegion startOffset endOffset $+            "This is not a valid date, please fix it."         Just date -> pure $! date -    partialDate :: Int -> Maybe Year -> Month -> Char -> MonthDay -> TextParser m Day-    partialDate startOffset myr month sep day = do+    partialDate :: Int -> Maybe Year -> Month -> MonthDay -> TextParser m Day+    partialDate startOffset myr month day = do       endOffset <- getOffset       case myr of         Just year ->           case fromGregorianValid year month day of-            Nothing -> customFailure $ parseErrorAtRegion startOffset endOffset $-                        "This date is invalid, please correct it: " ++ dateStr+            Nothing -> +              customFailure $ parseErrorAtRegion startOffset endOffset $+                "This is not a valid date, please fix it."             Just date -> pure $! date-          where dateStr = show year ++ [sep] ++ show month ++ [sep] ++ show day -        Nothing -> customFailure $ parseErrorAtRegion startOffset endOffset $-          "The partial date "++dateStr++" can not be parsed because the current year is unknown.\n"-          ++"Consider making it a full date, or add a default year directive.\n"-          where dateStr = show month ++ [sep] ++ show day+        Nothing ->+          customFailure $ parseErrorAtRegion startOffset endOffset $+            "This partial date can not be parsed because the current year is unknown.\n"+            ++"Please make it a full date, or add a default year directive."  {-# INLINABLE datep' #-} @@ -776,7 +774,7 @@           <*> toPermutationWithDefault Nothing (Just <$> lotcostp <* spaces)           <*> toPermutationWithDefault Nothing (Just <$> lotdatep <* spaces)           <*> toPermutationWithDefault Nothing (Just <$> lotnotep <* spaces)-  pure $ amt { aprice = mcost }+  pure $ amt { acost = mcost }  -- An amount with optional cost, but no cost basis. amountnobasisp :: JournalParser m Amount@@ -787,7 +785,7 @@   amt <- simpleamountp False   spaces   mprice <- optional $ costp amt <* spaces-  pure $ amt { aprice = mprice }+  pure $ amt { acost = mprice }  -- An amount with no cost or cost basis. -- A flag indicates whether we are parsing a multiplier amount;@@ -817,7 +815,7 @@     let numRegion = (offBeforeNum, offAfterNum)     (q,prec,mdec,mgrps) <- lift $ interpretNumber numRegion suggestedStyle ambiguousRawNum mExponent     let s = amountstyle{ascommodityside=L, ascommodityspaced=commodityspaced, asprecision=prec, asdecimalmark=mdec, asdigitgroups=mgrps}-    return nullamt{acommodity=c, aquantity=sign (sign2 q), astyle=s, aprice=Nothing}+    return nullamt{acommodity=c, aquantity=sign (sign2 q), astyle=s, acost=Nothing}    -- An amount with commodity symbol on the right or no commodity symbol.   -- A no-symbol amount will have the default commodity applied to it@@ -839,7 +837,7 @@         let msuggestedStyle = mdecmarkStyle <|> mcommodityStyle         (q,prec,mdec,mgrps) <- lift $ interpretNumber numRegion msuggestedStyle ambiguousRawNum mExponent         let s = amountstyle{ascommodityside=R, ascommodityspaced=commodityspaced, asprecision=prec, asdecimalmark=mdec, asdigitgroups=mgrps}-        return nullamt{acommodity=c, aquantity=sign q, astyle=s, aprice=Nothing}+        return nullamt{acommodity=c, aquantity=sign q, astyle=s, acost=Nothing}       -- no symbol amount       Nothing -> do         -- look for a number style to use when parsing, based on@@ -856,7 +854,7 @@         let (c,s) = case (mult, defcs) of               (False, Just (defc,defs)) -> (defc, defs{asprecision=max (asprecision defs) prec})               _ -> ("", amountstyle{asprecision=prec, asdecimalmark=mdec, asdigitgroups=mgrps})-        return nullamt{acommodity=c, aquantity=sign q, astyle=s, aprice=Nothing}+        return nullamt{acommodity=c, aquantity=sign q, astyle=s, acost=Nothing}    -- For reducing code duplication. Doesn't parse anything. Has the type   -- of a parser only in order to throw parse errors (for convenience).@@ -911,14 +909,14 @@  -- | Ledger-style cost notation: -- @ UNITAMT, @@ TOTALAMT, (@) UNITAMT, or (@@) TOTALAMT. The () are ignored.-costp :: Amount -> JournalParser m AmountPrice+costp :: Amount -> JournalParser m AmountCost costp baseAmt =   -- dbg "costp" $   label "transaction price" $ do   -- https://www.ledger-cli.org/3.0/doc/ledger3.html#Virtual-posting-costs   parenthesised <- option False $ char '(' >> pure True   char '@'-  totalPrice <- char '@' $> True <|> pure False+  totalCost <- char '@' $> True <|> pure False   when parenthesised $ void $ char ')'    lift skipNonNewlineSpaces@@ -927,9 +925,9 @@   let amtsign' = signum $ aquantity baseAmt       amtsign  = if amtsign' == 0 then 1 else amtsign' -  pure $ if totalPrice-            then TotalPrice priceAmount{aquantity=amtsign * aquantity priceAmount}-            else UnitPrice  priceAmount+  pure $ if totalCost+            then TotalCost priceAmount{aquantity=amtsign * aquantity priceAmount}+            else UnitCost  priceAmount  -- | A valuation function or value can be written in double parentheses after an amount. valuationexprp :: JournalParser m ()@@ -1169,8 +1167,21 @@     pure $ NoSeparators grp1 (Just (decPt, mempty))  isDigitSeparatorChar :: Char -> Bool-isDigitSeparatorChar c = isDecimalMark c || c == ' '+isDigitSeparatorChar c = isDecimalMark c || isDigitSeparatorSpaceChar c +-- | Kinds of unicode space character we accept as digit group marks.+-- See also https://en.wikipedia.org/wiki/Decimal_separator#Digit_grouping .+isDigitSeparatorSpaceChar :: Char -> Bool+isDigitSeparatorSpaceChar c =+     c == ' '  -- space+  || c == ' '  -- no-break space+  || c == ' '  -- en space+  || c == ' '  -- em space+  || c == ' '  -- punctuation space+  || c == ' '  -- thin space+  || c == ' '  -- narrow no-break space+  || c == ' '  -- medium mathematical space+ -- | Some kinds of number literal we might parse. data RawNumber   = NoSeparators   DigitGrp (Maybe (Char, DigitGrp))@@ -1504,10 +1515,10 @@ -- Left ...not a bracketed date... -- -- >>> either (Left . customErrorBundlePretty) Right $ rtp (bracketeddatetagsp Nothing) "[2016/1/32]"--- Left ...1:2:...This date is invalid...+-- Left ...1:2:...This is not a valid date... -- -- >>> either (Left . customErrorBundlePretty) Right $ rtp (bracketeddatetagsp Nothing) "[1/31]"--- Left ...1:2:...The partial date 1/31 can not be parsed...+-- Left ...1:2:...This partial date can not be parsed because the current year is unknown... -- -- >>> either (Left . customErrorBundlePretty) Right $ rtp (bracketeddatetagsp Nothing) "[0123456789/-.=/-.=]" -- Left ...1:13:...expecting month or day...@@ -1588,7 +1599,7 @@          acommodity="$"         ,aquantity=10 -- need to test internal precision with roundTo ? I think not         ,astyle=amountstyle{asprecision=Precision 0, asdecimalmark=Nothing}-        ,aprice=Just $ UnitPrice $+        ,acost=Just $ UnitCost $           nullamt{              acommodity="€"             ,aquantity=0.5@@ -1600,7 +1611,7 @@          acommodity="$"         ,aquantity=10         ,astyle=amountstyle{asprecision=Precision 0, asdecimalmark=Nothing}-        ,aprice=Just $ TotalPrice $+        ,acost=Just $ TotalCost $           nullamt{              acommodity="€"             ,aquantity=5

@@ -41,11 +41,11 @@  --- ** reader -reader :: MonadIO m => Reader m-reader = Reader-  {rFormat     = "csv"-  ,rExtensions = ["csv","tsv","ssv"]-  ,rReadFn     = parse+reader :: MonadIO m => SepFormat -> Reader m+reader sep = Reader+  {rFormat     = Sep sep+  ,rExtensions = [show sep]+  ,rReadFn     = parse sep   ,rParser     = error' "sorry, CSV files can't be included yet"  -- PARTIAL:   } @@ -54,10 +54,10 @@ -- This file path is normally the CSV(/SSV/TSV) data file, and a corresponding rules file is inferred. -- But it can also be the rules file, in which case the corresponding data file is inferred. -- This does not check balance assertions.-parse :: InputOpts -> FilePath -> Text -> ExceptT String IO Journal-parse iopts f t = do+parse :: SepFormat -> InputOpts -> FilePath -> Text -> ExceptT String IO Journal+parse sep iopts f t = do   let mrulesfile = mrules_file_ iopts-  readJournalFromCsv (Right <$> mrulesfile) f t+  readJournalFromCsv (Right <$> mrulesfile) f t (Just sep)   -- apply any command line account aliases. Can fail with a bad replacement pattern.   >>= liftEither . journalApplyAliases (aliasesFromOpts iopts)       -- journalFinalise assumes the journal's items are

@@ -104,6 +104,7 @@ import qualified Hledger.Read.RulesReader as RulesReader (reader) import qualified Hledger.Read.TimeclockReader as TimeclockReader (reader) import qualified Hledger.Read.TimedotReader as TimedotReader (reader)+import System.Directory (canonicalizePath)  --- ** doctest setup -- $setup@@ -139,21 +140,25 @@  ,TimeclockReader.reader  ,TimedotReader.reader  ,RulesReader.reader- ,CsvReader.reader+ ,CsvReader.reader Csv+ ,CsvReader.reader Tsv+ ,CsvReader.reader Ssv --  ,LedgerReader.reader  ]  readerNames :: [String]-readerNames = map rFormat (readers'::[Reader IO])+readerNames = map (show . rFormat) (readers'::[Reader IO])  -- | @findReader mformat mpath@ -- -- Find the reader named by @mformat@, if provided.+-- ("ssv" and "tsv" are recognised as alternate names for the csv reader,+-- which also handles those formats.) -- Or, if a file path is provided, find the first reader that handles -- its file extension, if any. findReader :: MonadIO m => Maybe StorageFormat -> Maybe FilePath -> Maybe (Reader m) findReader Nothing Nothing     = Nothing-findReader (Just fmt) _        = headMay [r | r <- readers', rFormat r == fmt]+findReader (Just fmt) _        = headMay [r | r <- readers', let rname = rFormat r, rname == fmt] findReader Nothing (Just path) =   case prefix of     Just fmt -> headMay [r | r <- readers', rFormat r == fmt]@@ -168,16 +173,27 @@  -- | If a filepath is prefixed by one of the reader names and a colon, -- split that off. Eg "csv:-" -> (Just "csv", "-").-splitReaderPrefix :: PrefixedFilePath -> (Maybe String, FilePath)+-- These reader prefixes can be used to force a specific reader,+-- overriding the file extension. +splitReaderPrefix :: PrefixedFilePath -> (Maybe StorageFormat, FilePath) splitReaderPrefix f =-  headDef (Nothing, f) $-  [(Just r, drop (length r + 1) f) | r <- readerNames, (r++":") `isPrefixOf` f]+  let +  candidates = [(Just r, drop (length r + 1) f) | r <- readerNames ++ ["ssv","tsv"], (r++":") `isPrefixOf` f]+  (strPrefix, newF) = headDef (Nothing, f) candidates+  in case strPrefix of+  Just "csv" -> (Just (Sep Csv), newF)+  Just "tsv" -> (Just (Sep Tsv), newF)+  Just "ssv" -> (Just (Sep Ssv), newF)+  Just "journal" -> (Just Journal', newF)+  Just "timeclock" -> (Just Timeclock, newF)+  Just "timedot" -> (Just Timedot, newF)+  _ -> (Nothing, f)  --- ** reader  reader :: MonadIO m => Reader m reader = Reader-  {rFormat     = "journal"+  {rFormat     = Journal'   ,rExtensions = ["journal", "j", "hledger", "ledger"]   ,rReadFn     = parse   ,rParser    = journalp  -- no need to add command line aliases like journalp'@@ -282,29 +298,31 @@   paths <- getFilePaths parentoff parentpos glb   let prefixedpaths = case mprefix of         Nothing  -> paths-        Just fmt -> map ((fmt++":")++) paths+        Just fmt -> map ((show fmt++":")++) paths   forM_ prefixedpaths $ parseChild parentpos   void newline    where     getFilePaths       :: MonadIO m => Int -> SourcePos -> FilePath -> JournalParser m [FilePath]-    getFilePaths parseroff parserpos filename = do-        let curdir = takeDirectory (sourceName parserpos)-        filename' <- lift $ expandHomePath filename-                         `orRethrowIOError` (show parserpos ++ " locating " ++ filename)-        -- Compiling filename as a glob pattern works even if it is a literal-        fileglob <- case tryCompileWith compDefault{errorRecovery=False} filename' of+    getFilePaths parseroff parserpos fileglobpattern = do+        -- Expand a ~ at the start of the glob pattern, if any.+        fileglobpattern' <- lift $ expandHomePath fileglobpattern+                         `orRethrowIOError` (show parserpos ++ " locating " ++ fileglobpattern)+        -- Compile the glob pattern.+        fileglob <- case tryCompileWith compDefault{errorRecovery=False} fileglobpattern' of             Right x -> pure x-            Left e -> customFailure $-                        parseErrorAt parseroff $ "Invalid glob pattern: " ++ e-        -- Get all matching files in the current working directory, sorting in-        -- lexicographic order to simulate the output of 'ls'.+            Left e -> customFailure $ parseErrorAt parseroff $ "Invalid glob pattern: " ++ e+        -- Get the directory of the including file. This will be used to resolve relative paths.+        let parentfilepath = sourceName parserpos+        realparentfilepath <- liftIO $ canonicalizePath parentfilepath   -- Follow a symlink. If the path is already absolute, the operation never fails. +        let curdir = takeDirectory realparentfilepath+        -- Find all matched files, in lexicographic order mimicking the output of 'ls'.         filepaths <- liftIO $ sort <$> globDir1 fileglob curdir         if (not . null) filepaths             then pure filepaths             else customFailure $ parseErrorAt parseroff $-                   "No existing files match pattern: " ++ filename+                   "No existing files match pattern: " ++ fileglobpattern      parseChild :: MonadIO m => SourcePos -> PrefixedFilePath -> ErroringJournalParser m ()     parseChild parentpos prefixedpath = do

@@ -20,3032 +20,1557 @@ {-# LANGUAGE ScopedTypeVariables  #-} {-# LANGUAGE ViewPatterns         #-} {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}----- ** exports-module Hledger.Read.RulesReader (-  -- * Reader-  reader,-  -- * Misc.-  readJournalFromCsv,-  -- readRulesFile,-  -- parseCsvRules,-  -- validateCsvRules,-  -- CsvRules,-  dataFileFor,-  rulesFileFor,-  -- * Tests-  tests_RulesReader,-)-where----- ** imports-import Prelude hiding (Applicative(..))-import Control.Applicative (Applicative(..))-import Control.Monad              (unless, when, void)-import Control.Monad.Except       (ExceptT(..), liftEither, throwError)-import qualified Control.Monad.Fail as Fail-import Control.Monad.IO.Class     (MonadIO, liftIO)-import Control.Monad.State.Strict (StateT, get, modify', evalStateT)-import Control.Monad.Trans.Class  (lift)-import Data.Char                  (toLower, isDigit, isSpace, isAlphaNum, ord)-import Data.Bifunctor             (first)-import Data.Functor               ((<&>))-import Data.List (elemIndex, foldl', mapAccumL, nub, sortOn)-import Data.List.Extra (groupOn)-import Data.Maybe (catMaybes, fromMaybe, isJust)-import Data.MemoUgly (memo)-import qualified Data.Set as S-import Data.Text (Text)-import qualified Data.Text as T-import qualified Data.Text.Encoding as T-import qualified Data.Text.IO as T-import Data.Time ( Day, TimeZone, UTCTime, LocalTime, ZonedTime(ZonedTime),-  defaultTimeLocale, getCurrentTimeZone, localDay, parseTimeM, utcToLocalTime, localTimeToUTC, zonedTimeToUTC)-import Safe (atMay, headMay, lastMay, readMay)-import System.FilePath ((</>), takeDirectory, takeExtension, stripExtension, takeFileName)-import qualified Data.Csv as Cassava-import qualified Data.Csv.Parser.Megaparsec as CassavaMegaparsec-import qualified Data.ByteString as B-import qualified Data.ByteString.Lazy as BL-import Data.Foldable (asum, toList)-import Text.Megaparsec hiding (match, parse)-import Text.Megaparsec.Char (char, newline, string, digitChar)-import Text.Megaparsec.Custom (parseErrorAt)-import Text.Printf (printf)--import Hledger.Data-import Hledger.Utils-import Hledger.Read.Common (aliasesFromOpts, Reader(..), InputOpts(..), amountp, statusp, journalFinalise, accountnamep, commenttagsp )-import Hledger.Read.CsvUtils-import System.Directory (doesFileExist, getHomeDirectory)-import Data.Either (fromRight)----- ** doctest setup--- $setup--- >>> :set -XOverloadedStrings----- ** reader-_READER__________________________________________ = undefined  -- VSCode outline separator---reader :: MonadIO m => Reader m-reader = Reader-  {rFormat     = "rules"-  ,rExtensions = ["rules"]-  ,rReadFn     = parse-  ,rParser     = error' "sorry, rules files can't be included"  -- PARTIAL:-  }--isFileName f = takeFileName f == f--getDownloadDir = do-  home <- getHomeDirectory-  return $ home </> "Downloads"  -- XXX---- | Parse and post-process a "Journal" from the given rules file path, or give an error.--- A data file is inferred from the @source@ rule, otherwise from a similarly-named file--- in the same directory.--- The source rule can specify a glob pattern and supports ~ for home directory.--- If it is a bare filename it will be relative to the defaut download directory--- on this system. If is a relative file path it will be relative to the rules--- file's directory. When a glob pattern matches multiple files, the alphabetically--- last is used. (Eg in case of multiple numbered downloads, the highest-numbered--- will be used.)--- The provided text, or a --rules-file option, are ignored by this reader.--- Balance assertions are not checked.-parse :: InputOpts -> FilePath -> Text -> ExceptT String IO Journal-parse iopts f _ = do-  rules <- readRulesFile $ dbg4 "reading rules file" f-  -- XXX higher-than usual debug level for file reading to bypass excessive noise from elsewhere, normally 6 or 7-  mdatafile <- liftIO $ do-    dldir <- getDownloadDir-    let rulesdir = takeDirectory f-    let msource = T.unpack <$> getDirective "source" rules-    fs <- case msource of-            Just src -> expandGlob dir (dbg4 "source" src) >>= sortByModTime <&> dbg4 ("matched files"<>desc<>", newest first")-              where (dir,desc) = if isFileName src then (dldir," in download directory") else (rulesdir,"")-            Nothing  -> return [maybe err (dbg4 "inferred source") $ dataFileFor f]  -- shouldn't fail, f has .rules extension-              where err = error' $ "could not infer a data file for " <> f-    return $ dbg4 "data file" $ headMay fs-  case mdatafile of-    Nothing -> return nulljournal  -- data file specified by source rule was not found-    Just dat -> do-      exists <- liftIO $ doesFileExist dat-      if not (dat=="-" || exists)-      then return nulljournal      -- data file inferred from rules file name was not found-      else do-        t <- liftIO $ readFileOrStdinPortably dat-        readJournalFromCsv (Just $ Left rules) dat t-        -- apply any command line account aliases. Can fail with a bad replacement pattern.-        >>= liftEither . journalApplyAliases (aliasesFromOpts iopts)-            -- journalFinalise assumes the journal's items are-            -- reversed, as produced by JournalReader's parser.-            -- But here they are already properly ordered. So we'd-            -- better preemptively reverse them once more. XXX inefficient-            . journalReverse-        >>= journalFinalise iopts{balancingopts_=(balancingopts_ iopts){ignore_assertions_=True}} f ""----- ** reading rules files---- *** rules utilities-_RULES_READING__________________________________________ = undefined---- | Given a rules file path, what would be the corresponding data file ?--- (Remove a .rules extension.)-dataFileFor :: FilePath -> Maybe FilePath-dataFileFor = stripExtension "rules"---- | Given a csv file path, what would be the corresponding rules file ?--- (Add a .rules extension.)-rulesFileFor :: FilePath -> FilePath-rulesFileFor = (++ ".rules")---- | An exception-throwing IO action that reads and validates--- the specified CSV rules file (which may include other rules files).-readRulesFile :: FilePath -> ExceptT String IO CsvRules-readRulesFile f =-  liftIO (do-    dbg6IO "using conversion rules file" f-    readFilePortably f >>= expandIncludes (takeDirectory f)-  ) >>= either throwError return . parseAndValidateCsvRules f---- | Inline all files referenced by include directives in this hledger CSV rules text, recursively.--- Included file paths may be relative to the directory of the provided file path.--- This is done as a pre-parse step to simplify the CSV rules parser.-expandIncludes :: FilePath -> Text -> IO Text-expandIncludes dir0 content = mapM (expandLine dir0) (T.lines content) <&> T.unlines-  where-    expandLine dir1 line =-      case line of-        (T.stripPrefix "include " -> Just f) -> expandIncludes dir2 =<< T.readFile f'-          where-            f' = dir1 </> T.unpack (T.dropWhile isSpace f)-            dir2 = takeDirectory f'-        _ -> return line---- defaultRulesText :: FilePath -> Text--- defaultRulesText _csvfile = T.pack $ unlines---   ["# hledger csv conversion rules" --  for " ++ csvFileFor (takeFileName csvfile)---   ,"# cf http://hledger.org/hledger.html#csv"---   ,""---   ,"account1 assets:bank:checking"---   ,""---   ,"fields date, description, amount1"---   ,""---   ,"#skip 1"---   ,"#newest-first"---   ,""---   ,"#date-format %-d/%-m/%Y"---   ,"#date-format %-m/%-d/%Y"---   ,"#date-format %Y-%h-%d"---   ,""---   ,"#currency $"---   ,""---   ,"if ITUNES"---   ," account2 expenses:entertainment"---   ,""---   ,"if (TO|FROM) SAVINGS"---   ," account2 assets:bank:savings\n"---   ]---- | An error-throwing IO action that parses this text as CSV conversion rules--- and runs some extra validation checks. The file path is used in error messages.-parseAndValidateCsvRules :: FilePath -> T.Text -> Either String CsvRules-parseAndValidateCsvRules rulesfile s =-  case parseCsvRules rulesfile s of-    Left err    -> Left $ customErrorBundlePretty err-    Right rules -> first makeFancyParseError $ validateCsvRules rules-  where-    makeFancyParseError :: String -> String-    makeFancyParseError errorString =-      parseErrorPretty (FancyError 0 (S.singleton $ ErrorFail errorString) :: ParseError Text String)--instance ShowErrorComponent String where-  showErrorComponent = id---- | Parse this text as CSV conversion rules. The file path is for error messages.-parseCsvRules :: FilePath -> T.Text -> Either (ParseErrorBundle T.Text HledgerParseErrorData) CsvRules--- parseCsvRules rulesfile s = runParser csvrulesfile nullrules{baseAccount=takeBaseName rulesfile} rulesfile s-parseCsvRules = runParser (evalStateT rulesp defrules)---- | Return the validated rules, or an error.-validateCsvRules :: CsvRules -> Either String CsvRules-validateCsvRules rules = do-  unless (isAssigned "date")   $ Left "Please specify (at top level) the date field. Eg: date %1"-  Right rules-  where-    isAssigned f = isJust $ getEffectiveAssignment rules [] f----- *** rules types-_RULES_TYPES__________________________________________ = undefined---- | A set of data definitions and account-matching patterns sufficient to--- convert a particular CSV data file into meaningful journal transactions.-data CsvRules' a = CsvRules' {-  rdirectives        :: [(DirectiveName,Text)],-    -- ^ top-level rules, as (keyword, value) pairs-  rcsvfieldindexes   :: [(CsvFieldName, CsvFieldIndex)],-    -- ^ csv field names and their column number, if declared by a fields list-  rassignments       :: [(HledgerFieldName, FieldTemplate)],-    -- ^ top-level assignments to hledger fields, as (field name, value template) pairs-  rconditionalblocks :: [ConditionalBlock],-    -- ^ conditional blocks, which containing additional assignments/rules to apply to matched csv records-  rblocksassigning :: a -- (String -> [ConditionalBlock])-    -- ^ all conditional blocks which can potentially assign field with a given name (memoized)-}---- | Type used by parsers. Directives, assignments and conditional blocks--- are in the reverse order compared to what is in the file and rblocksassigning is non-functional,--- could not be used for processing CSV records yet-type CsvRulesParsed = CsvRules' ()---- | Type used after parsing is done. Directives, assignments and conditional blocks--- are in the same order as they were in the input file and rblocksassigning is functional.--- Ready to be used for CSV record processing-type CsvRules = CsvRules' (Text -> [ConditionalBlock])  -- XXX simplify--instance Eq CsvRules where-  r1 == r2 = (rdirectives r1, rcsvfieldindexes r1, rassignments r1) ==-             (rdirectives r2, rcsvfieldindexes r2, rassignments r2)---- Custom Show instance used for debug output: omit the rblocksassigning field, which isn't showable.-instance Show CsvRules where-  show r = "CsvRules { rdirectives = " ++ show (rdirectives r) ++-           ", rcsvfieldindexes = "     ++ show (rcsvfieldindexes r) ++-           ", rassignments = "         ++ show (rassignments r) ++-           ", rconditionalblocks = "   ++ show (rconditionalblocks r) ++-           " }"--type CsvRulesParser a = StateT CsvRulesParsed SimpleTextParser a---- | The keyword of a CSV rule - "fields", "skip", "if", etc.-type DirectiveName    = Text---- | CSV field name.-type CsvFieldName     = Text---- | 1-based CSV column number.-type CsvFieldIndex    = Int---- | Percent symbol followed by a CSV field name or column number. Eg: %date, %1.-type CsvFieldReference = Text---- | One of the standard hledger fields or pseudo-fields that can be assigned to.--- Eg date, account1, amount, amount1-in, date-format.-type HledgerFieldName = Text---- | A text value to be assigned to a hledger field, possibly--- containing csv field references to be interpolated.-type FieldTemplate    = Text---- | A reference to a regular expression match group. Eg \1.-type MatchGroupReference = Text---- | A strptime date parsing pattern, as supported by Data.Time.Format.-type DateFormat       = Text---- | A prefix for a matcher test, either & or none (implicit or).-data MatcherPrefix = And | Not | None-  deriving (Show, Eq)---- | A single test for matching a CSV record, in one way or another.-data Matcher =-    RecordMatcher MatcherPrefix Regexp                          -- ^ match if this regexp matches the overall CSV record-  | FieldMatcher MatcherPrefix CsvFieldReference Regexp         -- ^ match if this regexp matches the referenced CSV field's value-  deriving (Show, Eq)---- | A conditional block: a set of CSV record matchers, and a sequence--- of rules which will be enabled only if one or more of the matchers--- succeeds.------ Three types of rule are allowed inside conditional blocks: field--- assignments, skip, end. (A skip or end rule is stored as if it was--- a field assignment, and executed in validateCsv. XXX)-data ConditionalBlock = CB {-   cbMatchers    :: [Matcher]-  ,cbAssignments :: [(HledgerFieldName, FieldTemplate)]-  } deriving (Show, Eq)--defrules :: CsvRulesParsed-defrules = CsvRules' {-  rdirectives=[],-  rcsvfieldindexes=[],-  rassignments=[],-  rconditionalblocks=[],-  rblocksassigning = ()-  }---- | Create CsvRules from the content parsed out of the rules file-mkrules :: CsvRulesParsed -> CsvRules-mkrules rules =-  let conditionalblocks = reverse $ rconditionalblocks rules-      maybeMemo = if length conditionalblocks >= 15 then memo else id-  in-    CsvRules' {-    rdirectives=reverse $ rdirectives rules,-    rcsvfieldindexes=rcsvfieldindexes rules,-    rassignments=reverse $ rassignments rules,-    rconditionalblocks=conditionalblocks,-    rblocksassigning = maybeMemo (\f -> filter (any ((==f).fst) . cbAssignments) conditionalblocks)-    }----- *** rules parsers-_RULES_PARSING__________________________________________ = undefined--{--Grammar for the CSV conversion rules, more or less:--RULES: RULE*--RULE: ( SOURCE | FIELD-LIST | FIELD-ASSIGNMENT | CONDITIONAL-BLOCK | SKIP | TIMEZONE | NEWEST-FIRST | INTRA-DAY-REVERSED | DATE-FORMAT | DECIMAL-MARK | COMMENT | BLANK ) NEWLINE--SOURCE: source SPACE FILEPATH--FIELD-LIST: fields SPACE FIELD-NAME ( SPACE? , SPACE? FIELD-NAME )*--FIELD-NAME: QUOTED-FIELD-NAME | BARE-FIELD-NAME--QUOTED-FIELD-NAME: " (any CHAR except double-quote)+ "--BARE-FIELD-NAME: any CHAR except space, tab, #, ;--FIELD-ASSIGNMENT: JOURNAL-FIELD ASSIGNMENT-SEPARATOR FIELD-VALUE--JOURNAL-FIELD: date | date2 | status | code | description | comment | account1 | account2 | amount | JOURNAL-PSEUDO-FIELD--JOURNAL-PSEUDO-FIELD: amount-in | amount-out | currency--ASSIGNMENT-SEPARATOR: SPACE | ( : SPACE? )--FIELD-VALUE: VALUE (possibly containing CSV-FIELD-REFERENCEs and REGEX-MATCHGROUP-REFERENCEs)--CSV-FIELD-REFERENCE: % CSV-FIELD--REGEX-MATCHGROUP-REFERENCE: \ DIGIT+--CSV-FIELD: ( FIELD-NAME | FIELD-NUMBER ) (corresponding to a CSV field)--FIELD-NUMBER: DIGIT+--CONDITIONAL-BLOCK: if ( FIELD-MATCHER NEWLINE )+ INDENTED-BLOCK--FIELD-MATCHER: ( CSV-FIELD-NAME SPACE? )? ( MATCHOP SPACE? )? PATTERNS--MATCHOP: ~--PATTERNS: ( NEWLINE REGEXP )* REGEXP--INDENTED-BLOCK: ( SPACE ( FIELD-ASSIGNMENT | COMMENT ) NEWLINE )+--REGEXP: ( NONSPACE CHAR* ) SPACE?--VALUE: SPACE? ( CHAR* ) SPACE?--COMMENT: SPACE? COMMENT-CHAR VALUE--COMMENT-CHAR: # | ; | *--NONSPACE: any CHAR not a SPACE-CHAR--BLANK: SPACE?--SPACE: SPACE-CHAR+--SPACE-CHAR: space | tab--CHAR: any character except newline--DIGIT: 0-9---}--addDirective :: (DirectiveName, Text) -> CsvRulesParsed -> CsvRulesParsed-addDirective d r = r{rdirectives=d:rdirectives r}--addAssignment :: (HledgerFieldName, FieldTemplate) -> CsvRulesParsed -> CsvRulesParsed-addAssignment a r = r{rassignments=a:rassignments r}--setIndexesAndAssignmentsFromList :: [CsvFieldName] -> CsvRulesParsed -> CsvRulesParsed-setIndexesAndAssignmentsFromList fs = addAssignmentsFromList fs . setCsvFieldIndexesFromList fs-  where-    setCsvFieldIndexesFromList :: [CsvFieldName] -> CsvRulesParsed -> CsvRulesParsed-    setCsvFieldIndexesFromList fs' r = r{rcsvfieldindexes=zip fs' [1..]}--    addAssignmentsFromList :: [CsvFieldName] -> CsvRulesParsed -> CsvRulesParsed-    addAssignmentsFromList fs' r = foldl' maybeAddAssignment r journalfieldnames-      where-        maybeAddAssignment rules f = (maybe id addAssignmentFromIndex $ elemIndex f fs') rules-          where-            addAssignmentFromIndex i = addAssignment (f, T.pack $ '%':show (i+1))--addConditionalBlock :: ConditionalBlock -> CsvRulesParsed -> CsvRulesParsed-addConditionalBlock b r = r{rconditionalblocks=b:rconditionalblocks r}--addConditionalBlocks :: [ConditionalBlock] -> CsvRulesParsed -> CsvRulesParsed-addConditionalBlocks bs r = r{rconditionalblocks=bs++rconditionalblocks r}--rulesp :: CsvRulesParser CsvRules-rulesp = do-  _ <- many $ choice-    [blankorcommentlinep                                                <?> "blank or comment line"-    ,(directivep        >>= modify' . addDirective)                     <?> "directive"-    ,(fieldnamelistp    >>= modify' . setIndexesAndAssignmentsFromList) <?> "field name list"-    ,(fieldassignmentp  >>= modify' . addAssignment)                    <?> "field assignment"-    -- conditionalblockp backtracks because it shares "if" prefix with conditionaltablep.-    ,try (conditionalblockp >>= modify' . addConditionalBlock)          <?> "conditional block"-    -- 'reverse' is there to ensure that conditions are added in the order they listed in the file-    ,(conditionaltablep >>= modify' . addConditionalBlocks . reverse)   <?> "conditional table"-    ]-  eof-  mkrules <$> get--blankorcommentlinep :: CsvRulesParser ()-blankorcommentlinep = lift (dbgparse 8 "trying blankorcommentlinep") >> choiceInState [blanklinep, commentlinep]--blanklinep :: CsvRulesParser ()-blanklinep = lift skipNonNewlineSpaces >> newline >> return () <?> "blank line"--commentlinep :: CsvRulesParser ()-commentlinep = lift skipNonNewlineSpaces >> commentcharp >> lift restofline >> return () <?> "comment line"--commentcharp :: CsvRulesParser Char-commentcharp = oneOf (";#*" :: [Char])--directivep :: CsvRulesParser (DirectiveName, Text)-directivep = (do-  lift $ dbgparse 8 "trying directive"-  d <- choiceInState $ map (lift . string) directives-  v <- (((char ':' >> lift (many spacenonewline)) <|> lift (some spacenonewline)) >> directivevalp)-       <|> (optional (char ':') >> lift skipNonNewlineSpaces >> lift eolof >> return "")-  return (d, v)-  ) <?> "directive"--directives :: [Text]-directives =-  ["source"-  ,"date-format"-  ,"decimal-mark"-  ,"separator"-  -- ,"default-account"-  -- ,"default-currency"-  ,"skip"-  ,"timezone"-  ,"newest-first"-  ,"intra-day-reversed"-  , "balance-type"-  ]--directivevalp :: CsvRulesParser Text-directivevalp = T.pack <$> anySingle `manyTill` lift eolof--fieldnamelistp :: CsvRulesParser [CsvFieldName]-fieldnamelistp = (do-  lift $ dbgparse 8 "trying fieldnamelist"-  string "fields"-  optional $ char ':'-  lift skipNonNewlineSpaces1-  let separator = lift skipNonNewlineSpaces >> char ',' >> lift skipNonNewlineSpaces-  f <- fromMaybe "" <$> optional fieldnamep-  fs <- some $ (separator >> fromMaybe "" <$> optional fieldnamep)-  lift restofline-  return . map T.toLower $ f:fs-  ) <?> "field name list"--fieldnamep :: CsvRulesParser Text-fieldnamep = quotedfieldnamep <|> barefieldnamep--quotedfieldnamep :: CsvRulesParser Text-quotedfieldnamep =-    char '"' *> takeWhile1P Nothing (`notElem` ("\"\n:;#~" :: [Char])) <* char '"'--barefieldnamep :: CsvRulesParser Text-barefieldnamep = takeWhile1P Nothing (`notElem` (" \t\n,;#~" :: [Char]))--fieldassignmentp :: CsvRulesParser (HledgerFieldName, FieldTemplate)-fieldassignmentp = do-  lift $ dbgparse 8 "trying fieldassignmentp"-  f <- journalfieldnamep-  v <- choiceInState [ assignmentseparatorp >> fieldvalp-                     , lift eolof >> return ""-                     ]-  return (f,v)-  <?> "field assignment"--journalfieldnamep :: CsvRulesParser Text-journalfieldnamep = do-  lift (dbgparse 8 "trying journalfieldnamep")-  choiceInState $ map (lift . string) journalfieldnames--maxpostings = 99---- Transaction fields and pseudo fields for CSV conversion.--- Names must precede any other name they contain, for the parser--- (amount-in before amount; date2 before date). TODO: fix-journalfieldnames =-  concat [[ "account" <> i-          ,"amount" <> i <> "-in"-          ,"amount" <> i <> "-out"-          ,"amount" <> i-          ,"balance" <> i-          ,"comment" <> i-          ,"currency" <> i-          ] | x <- [maxpostings, (maxpostings-1)..1], let i = T.pack $ show x]-  ++-  ["amount-in"-  ,"amount-out"-  ,"amount"-  ,"balance"-  ,"code"-  ,"comment"-  ,"currency"-  ,"date2"-  ,"date"-  ,"description"-  ,"status"-  ,"skip" -- skip and end are not really fields, but we list it here to allow conditional rules that skip records-  ,"end"-  ]--assignmentseparatorp :: CsvRulesParser ()-assignmentseparatorp = do-  lift $ dbgparse 8 "trying assignmentseparatorp"-  _ <- choiceInState [ lift skipNonNewlineSpaces >> char ':' >> lift skipNonNewlineSpaces-                     , lift skipNonNewlineSpaces1-                     ]-  return ()--fieldvalp :: CsvRulesParser Text-fieldvalp = do-  lift $ dbgparse 8 "trying fieldvalp"-  T.pack <$> anySingle `manyTill` lift eolof---- A conditional block: one or more matchers, one per line, followed by one or more indented rules.-conditionalblockp :: CsvRulesParser ConditionalBlock-conditionalblockp = do-  lift $ dbgparse 8 "trying conditionalblockp"-  -- "if\nMATCHER" or "if    \nMATCHER" or "if MATCHER"-  start <- getOffset-  string "if" >> ( (newline >> return Nothing)-                  <|> (lift skipNonNewlineSpaces1 >> optional newline))-  ms <- some matcherp-  as <- catMaybes <$>-    many (lift skipNonNewlineSpaces1 >>-          choice [ lift eolof >> return Nothing-                 , fmap Just fieldassignmentp-                 ])-  when (null as) $-    customFailure $ parseErrorAt start $  "start of conditional block found, but no assignment rules afterward\n(assignment rules in a conditional block should be indented)"-  return $ CB{cbMatchers=ms, cbAssignments=as}-  <?> "conditional block"---- A conditional table: "if" followed by separator, followed by some field names,--- followed by many lines, each of which has:--- one matchers, followed by field assignments (as many as there were fields)-conditionaltablep :: CsvRulesParser [ConditionalBlock]-conditionaltablep = do-  lift $ dbgparse 8 "trying conditionaltablep"-  start <- getOffset-  string "if"-  sep <- lift $ satisfy (\c -> not (isAlphaNum c || isSpace c))-  fields <- journalfieldnamep `sepBy1` (char sep)-  newline-  body <- flip manyTill (lift eolof) $ do-    off <- getOffset-    m <- matcherp' $ void $ char sep-    vs <- T.split (==sep) . T.pack <$> lift restofline-    if (length vs /= length fields)-      then customFailure $ parseErrorAt off $ ((printf "line of conditional table should have %d values, but this one has only %d" (length fields) (length vs)) :: String)-      else return (m,vs)-  when (null body) $-    customFailure $ parseErrorAt start $ "start of conditional table found, but no assignment rules afterward"-  return $ flip map body $ \(m,vs) ->-    CB{cbMatchers=[m], cbAssignments=zip fields vs}-  <?> "conditional table"---- A single matcher, on one line.-matcherp' :: CsvRulesParser () -> CsvRulesParser Matcher-matcherp' end = try (fieldmatcherp end) <|> recordmatcherp end--matcherp :: CsvRulesParser Matcher-matcherp = matcherp' (lift eolof)---- A single whole-record matcher.--- A pattern on the whole line, not beginning with a csv field reference.-recordmatcherp :: CsvRulesParser () -> CsvRulesParser Matcher-recordmatcherp end = do-  lift $ dbgparse 8 "trying recordmatcherp"-  -- pos <- currentPos-  -- _  <- optional (matchoperatorp >> lift skipNonNewlineSpaces >> optional newline)-  p <- matcherprefixp-  r <- regexp end-  return $ RecordMatcher p r-  -- when (null ps) $-  --   Fail.fail "start of record matcher found, but no patterns afterward\n(patterns should not be indented)"-  <?> "record matcher"---- | A single matcher for a specific field. A csv field reference--- (like %date or %1), and a pattern on the rest of the line,--- optionally space-separated. Eg:--- %description chez jacques-fieldmatcherp :: CsvRulesParser () -> CsvRulesParser Matcher-fieldmatcherp end = do-  lift $ dbgparse 8 "trying fieldmatcher"-  -- An optional fieldname (default: "all")-  -- f <- fromMaybe "all" `fmap` (optional $ do-  --        f' <- fieldnamep-  --        lift skipNonNewlineSpaces-  --        return f')-  p <- matcherprefixp-  f <- csvfieldreferencep <* lift skipNonNewlineSpaces-  -- optional operator.. just ~ (case insensitive infix regex) for now-  -- _op <- fromMaybe "~" <$> optional matchoperatorp-  lift skipNonNewlineSpaces-  r <- regexp end-  return $ FieldMatcher p f r-  <?> "field matcher"--matcherprefixp :: CsvRulesParser MatcherPrefix-matcherprefixp = do-  lift $ dbgparse 8 "trying matcherprefixp"-  (char '&' >> lift skipNonNewlineSpaces >> return And) <|> (char '!' >> lift skipNonNewlineSpaces >> return Not) <|> return None--csvfieldreferencep :: CsvRulesParser CsvFieldReference-csvfieldreferencep = do-  lift $ dbgparse 8 "trying csvfieldreferencep"-  char '%'-  T.cons '%' . textQuoteIfNeeded <$> fieldnamep---- A single regular expression-regexp :: CsvRulesParser () -> CsvRulesParser Regexp-regexp end = do-  lift $ dbgparse 8 "trying regexp"-  -- notFollowedBy matchoperatorp-  c <- lift nonspace-  cs <- anySingle `manyTill` end-  case toRegexCI . T.strip . T.pack $ c:cs of-       Left x -> Fail.fail $ "CSV parser: " ++ x-       Right x -> return x---- -- A match operator, indicating the type of match to perform.--- -- Currently just ~ meaning case insensitive infix regex match.--- matchoperatorp :: CsvRulesParser String--- matchoperatorp = fmap T.unpack $ choiceInState $ map string---   ["~"---   -- ,"!~"---   -- ,"="---   -- ,"!="---   ]--_RULES_LOOKUP__________________________________________ = undefined--getDirective :: DirectiveName -> CsvRules -> Maybe FieldTemplate-getDirective directivename = lookup directivename . rdirectives---- | Look up the value (template) of a csv rule by rule keyword.-csvRule :: CsvRules -> DirectiveName -> Maybe FieldTemplate-csvRule rules = (`getDirective` rules)---- | Look up the value template assigned to a hledger field by field--- list/field assignment rules, taking into account the current record and--- conditional rules.-hledgerField :: CsvRules -> CsvRecord -> HledgerFieldName -> Maybe FieldTemplate-hledgerField = getEffectiveAssignment---- | Look up the final value assigned to a hledger field, with csv field--- references interpolated.-hledgerFieldValue :: CsvRules -> CsvRecord -> HledgerFieldName -> Maybe Text-hledgerFieldValue rules record f = (fmap (renderTemplate rules record f) . hledgerField rules record) f--maybeNegate :: MatcherPrefix -> Bool -> Bool-maybeNegate Not origbool = not origbool-maybeNegate _ origbool = origbool---- | Given the conversion rules, a CSV record and a hledger field name, find--- the value template ultimately assigned to this field, if any, by a field--- assignment at top level or in a conditional block matching this record.------ Note conditional blocks' patterns are matched against an approximation of the--- CSV record: all the field values, without enclosing quotes, comma-separated.----getEffectiveAssignment :: CsvRules -> CsvRecord -> HledgerFieldName -> Maybe FieldTemplate-getEffectiveAssignment rules record f = lastMay $ map snd $ assignments-  where-    -- all active assignments to field f, in order-    assignments = dbg9 "csv assignments" $ filter ((==f).fst) $ toplevelassignments ++ conditionalassignments-    -- all top level field assignments-    toplevelassignments    = rassignments rules -    -- all field assignments in conditional blocks assigning to field f and active for the current csv record-    conditionalassignments = concatMap cbAssignments $ filter (isBlockActive rules record) $ (rblocksassigning rules) f---- does this conditional block match the current csv record ?-isBlockActive :: CsvRules -> CsvRecord -> ConditionalBlock -> Bool-isBlockActive rules record CB{..} = any (all matcherMatches) $ groupedMatchers cbMatchers-  where-    -- does this individual matcher match the current csv record ?-    matcherMatches :: Matcher -> Bool-    matcherMatches (RecordMatcher prefix pat) = maybeNegate prefix origbool-      where-        pat' = dbg7 "regex" pat-        -- A synthetic whole CSV record to match against. Note, this can be-        -- different from the original CSV data:-        -- - any whitespace surrounding field values is preserved-        -- - any quotes enclosing field values are removed-        -- - and the field separator is always comma-        -- which means that a field containing a comma will look like two fields.-        wholecsvline = dbg7 "wholecsvline" $ T.intercalate "," record-        origbool = regexMatchText pat' wholecsvline-    matcherMatches (FieldMatcher prefix csvfieldref pat) = maybeNegate prefix origbool-      where-        -- the value of the referenced CSV field to match against.-        csvfieldvalue = dbg7 "csvfieldvalue" $ replaceCsvFieldReference rules record csvfieldref-        origbool = regexMatchText pat csvfieldvalue--    -- | Group matchers into associative pairs based on prefix, e.g.:-    --   A-    --   & B-    --   C-    --   D-    --   & E-    --   => [[A, B], [C], [D, E]]-    groupedMatchers :: [Matcher] -> [[Matcher]]-    groupedMatchers [] = []-    groupedMatchers (x:xs) = (x:ys) : groupedMatchers zs-      where-        (ys, zs) = span (\y -> matcherPrefix y == And) xs-        matcherPrefix :: Matcher -> MatcherPrefix-        matcherPrefix (RecordMatcher prefix _) = prefix-        matcherPrefix (FieldMatcher prefix _ _) = prefix---- | Render a field assignment's template, possibly interpolating referenced--- CSV field values or match groups. Outer whitespace is removed from interpolated values.-renderTemplate ::  CsvRules -> CsvRecord -> HledgerFieldName -> FieldTemplate -> Text-renderTemplate rules record f t =-  maybe t mconcat $ parseMaybe-    (many-      (   literaltextp-      <|> (matchrefp <&> replaceRegexGroupReference rules record f)-      <|> (fieldrefp <&> replaceCsvFieldReference   rules record)-      )-    )-    t-  where-    literaltextp :: SimpleTextParser Text-    literaltextp = some (nonBackslashOrPercent <|> nonRefBackslash <|> nonRefPercent) <&> T.pack-      where-        nonBackslashOrPercent = noneOf ['\\', '%'] <?> "character other than backslash or percent"-        nonRefBackslash = try (char '\\' <* notFollowedBy digitChar) <?> "backslash that does not begin a match group reference"-        nonRefPercent   = try (char '%'  <* notFollowedBy (satisfy isFieldNameChar)) <?> "percent that does not begin a field reference"-    matchrefp    = liftA2 T.cons (char '\\') (takeWhile1P (Just "matchref")  isDigit)-    fieldrefp    = liftA2 T.cons (char '%')  (takeWhile1P (Just "reference") isFieldNameChar)-    isFieldNameChar c = isAlphaNum c || c == '_' || c == '-'---- | Replace something that looks like a Regex match group reference with the--- resulting match group value after applying the Regex.-replaceRegexGroupReference :: CsvRules -> CsvRecord -> HledgerFieldName -> MatchGroupReference -> Text-replaceRegexGroupReference rules record f s = case T.uncons s of-    Just ('\\', group) -> fromMaybe "" $ regexMatchValue rules record f group-    _                  -> s--regexMatchValue :: CsvRules -> CsvRecord -> HledgerFieldName -> Text -> Maybe Text-regexMatchValue rules record f sgroup = let-  matchgroups  = concatMap (getMatchGroups rules record)-               $ concatMap cbMatchers-               $ filter (isBlockActive rules record)-               $ rblocksassigning rules f-  group = (read (T.unpack sgroup) :: Int) - 1 -- adjust to 0-indexing-  in atMay matchgroups group--getMatchGroups :: CsvRules -> CsvRecord -> Matcher -> [Text]-getMatchGroups _ record (RecordMatcher _ regex)  = let-  txt = T.intercalate "," record -- see caveats of wholecsvline, in `isBlockActive`-  in regexMatchTextGroups regex txt-getMatchGroups rules record (FieldMatcher _ fieldref regex) = let-  txt = replaceCsvFieldReference rules record fieldref-  in regexMatchTextGroups regex txt---- | Replace something that looks like a reference to a csv field ("%date" or "%1)--- with that field's value. If it doesn't look like a field reference, or if we--- can't find such a field, replace it with the empty string.-replaceCsvFieldReference :: CsvRules -> CsvRecord -> CsvFieldReference -> Text-replaceCsvFieldReference rules record s = case T.uncons s of-    Just ('%', fieldname) -> fromMaybe "" $ csvFieldValue rules record fieldname-    _                     -> s---- | Get the (whitespace-stripped) value of a CSV field, identified by its name or--- column number, ("date" or "1"), from the given CSV record, if such a field exists.-csvFieldValue :: CsvRules -> CsvRecord -> CsvFieldName -> Maybe Text-csvFieldValue rules record fieldname = do-  fieldindex <--    if T.all isDigit fieldname-    then readMay $ T.unpack fieldname-    else lookup (T.toLower fieldname) $ rcsvfieldindexes rules-  T.strip <$> atMay record (fieldindex-1)--_CSV_READING__________________________________________ = undefined---- | Read a Journal from the given CSV data (and filename, used for error--- messages), or return an error. Proceed as follows:------ 1. Conversion rules are provided, or they are parsed from the specified---    rules file, or from the default rules file for the CSV data file.---    If rules parsing fails, or the required rules file does not exist, throw an error.------ 2. Parse the CSV data using the rules, or throw an error.------ 3. Convert the CSV records to hledger transactions using the rules.------ 4. Return the transactions as a Journal.----readJournalFromCsv :: Maybe (Either CsvRules FilePath) -> FilePath -> Text -> ExceptT String IO Journal-readJournalFromCsv Nothing "-" _ = throwError "please use --rules-file when reading CSV from stdin"-readJournalFromCsv merulesfile csvfile csvtext = do-    -- for now, correctness is the priority here, efficiency not so much--    rules <- case merulesfile of-      Just (Left rs)         -> return rs-      Just (Right rulesfile) -> readRulesFile rulesfile-      Nothing                -> readRulesFile $ rulesFileFor csvfile-    dbg6IO "csv rules" rules--    -- convert the csv data to lines and remove all empty/blank lines-    let csvlines1 = dbg9 "csvlines1" $ filter (not . T.null . T.strip) $ dbg9 "csvlines0" $ T.lines csvtext--    -- if there is a top-level skip rule, skip the specified number of non-empty lines-    skiplines <- case getDirective "skip" rules of-                      Nothing -> return 0-                      Just "" -> return 1-                      Just s  -> maybe (throwError $ "could not parse skip value: " ++ show s) return . readMay $ T.unpack s-    let csvlines2 = dbg9 "csvlines2" $ drop skiplines csvlines1--    -- convert back to text and parse as csv records-    let-      csvtext1 = T.unlines csvlines2-      separator =-        case getDirective "separator" rules >>= parseSeparator of-          Just c           -> c-          _ | ext == "ssv" -> ';'-          _ | ext == "tsv" -> '\t'-          _                -> ','-          where-            ext = map toLower $ drop 1 $ takeExtension csvfile-      -- parsec seemed to fail if you pass it "-" here   -- TODO: try again with megaparsec-      parsecfilename = if csvfile == "-" then "(stdin)" else csvfile-    dbg6IO "using separator" separator-    -- parse csv records-    csvrecords0 <- dbg7 "parseCsv" <$> parseCsv separator parsecfilename csvtext1-    -- remove any records skipped by conditional skip or end rules-    let csvrecords1 = applyConditionalSkips rules csvrecords0-    -- and check the remaining records for any obvious problems-    csvrecords <- liftEither $ dbg7 "validateCsv" <$> validateCsv csvrecords1-    dbg6IO "first 3 csv records" $ take 3 csvrecords--    -- XXX identify header lines some day ?-    -- let (headerlines, datalines) = identifyHeaderLines csvrecords'-    --     mfieldnames = lastMay headerlines--    tzout <- liftIO getCurrentTimeZone-    mtzin <- case getDirective "timezone" rules of-              Nothing -> return Nothing-              Just s  ->-                maybe (throwError $ "could not parse time zone: " ++ T.unpack s) (return.Just) $-                parseTimeM False defaultTimeLocale "%Z" $ T.unpack s-    let-      -- convert CSV records to transactions, saving the CSV line numbers for error positions-      txns = dbg7 "csv txns" $ snd $ mapAccumL-                     (\pos r ->-                        let-                          SourcePos name line col = pos-                          line' = (mkPos . (+1) . unPos) line-                          pos' = SourcePos name line' col-                        in-                          (pos', transactionFromCsvRecord timesarezoned mtzin tzout pos rules r)-                     )-                     (initialPos parsecfilename) csvrecords-        where-          timesarezoned =-            case csvRule rules "date-format" of-              Just f | any (`T.isInfixOf` f) ["%Z","%z","%EZ","%Ez"] -> True-              _ -> False--      -- Do our best to ensure transactions will be ordered chronologically,-      -- from oldest to newest. This is done in several steps:-      -- 1. Intra-day order: if there's an "intra-day-reversed" rule,-      -- assume each day's CSV records were ordered in reverse of the overall date order,-      -- so reverse each day's txns.-      intradayreversed = dbg6 "intra-day-reversed" $ isJust $ getDirective "intra-day-reversed" rules-      txns1 = dbg7 "txns1" $-        (if intradayreversed then concatMap reverse . groupOn tdate else id) txns-      -- 2. Overall date order: now if there's a "newest-first" rule,-      -- or if there's multiple dates and the first is more recent than the last,-      -- assume CSV records were ordered newest dates first,-      -- so reverse all txns.-      newestfirst = dbg6 "newest-first" $ isJust $ getDirective "newest-first" rules-      mdatalooksnewestfirst = dbg6 "mdatalooksnewestfirst" $-        case nub $ map tdate txns of-          ds | length ds > 1 -> Just $ head ds > last ds-          _                  -> Nothing-      txns2 = dbg7 "txns2" $-        (if newestfirst || mdatalooksnewestfirst == Just True then reverse else id) txns1-      -- 3. Disordered dates: in case the CSV records were ordered by chaos,-      -- do a final sort by date. If it was only a few records out of order,-      -- this will hopefully refine any good ordering done by steps 1 and 2.-      txns3 = dbg7 "date-sorted csv txns" $ sortOn tdate txns2--    return nulljournal{jtxns=txns3}---- | Parse special separator names TAB and SPACE, or return the first--- character. Return Nothing on empty string-parseSeparator :: Text -> Maybe Char-parseSeparator = specials . T.toLower-  where specials "space" = Just ' '-        specials "tab"   = Just '\t'-        specials xs      = fst <$> T.uncons xs---- Call parseCassava on a file or stdin, converting the result to ExceptT.-parseCsv :: Char -> FilePath -> Text -> ExceptT String IO [CsvRecord]-parseCsv separator filePath csvtext = ExceptT $-  case filePath of-    "-" -> parseCassava separator "(stdin)" <$> T.getContents-    _   -> return $ if T.null csvtext then Right mempty else parseCassava separator filePath csvtext---- Parse text into CSV records, using Cassava and the given field separator.-parseCassava :: Char -> FilePath -> Text -> Either String [CsvRecord]-parseCassava separator path content =-  -- XXX we now remove all blank lines before parsing; will Cassava will still produce [""] records ?-  -- filter (/=[""])-  either (Left . errorBundlePretty) (Right . parseResultToCsv) <$>-  CassavaMegaparsec.decodeWith decodeOptions Cassava.NoHeader path $-  BL.fromStrict $ T.encodeUtf8 content-  where-    decodeOptions = Cassava.defaultDecodeOptions {-                      Cassava.decDelimiter = fromIntegral (ord separator)-                    }-    parseResultToCsv :: (Foldable t, Functor t) => t (t B.ByteString) -> [CsvRecord]-    parseResultToCsv = toListList . unpackFields-      where-        toListList = toList . fmap toList-        unpackFields  = (fmap . fmap) T.decodeUtf8---- | Scan for csv records where a conditional `skip` or `end` rule applies,--- and apply that rule, removing one or more following records.-applyConditionalSkips :: CsvRules -> [CsvRecord] -> [CsvRecord]-applyConditionalSkips _ [] = []-applyConditionalSkips rules (r:rest) =-  case skipnum r of-    Nothing -> r : applyConditionalSkips rules rest-    Just cnt -> applyConditionalSkips rules $ drop (cnt-1) rest-  where-    skipnum r1 =-      case (getEffectiveAssignment rules r1 "end", getEffectiveAssignment rules r1 "skip") of-        (Nothing, Nothing) -> Nothing-        (Just _, _) -> Just maxBound-        (Nothing, Just "") -> Just 1-        (Nothing, Just x) -> Just (read $ T.unpack x)---- | Do some validation on the parsed CSV records:--- check that they all have at least two fields.-validateCsv :: [CsvRecord] -> Either String [CsvRecord]-validateCsv [] = Right []-validateCsv rs@(_first:_) =-  case lessthan2 of-    Just r  -> Left $ printf "CSV record %s has less than two fields" (show r)-    Nothing -> Right rs-  where-    lessthan2 = headMay $ filter ((<2).length) rs---- -- | The highest (0-based) field index referenced in the field--- -- definitions, or -1 if no fields are defined.--- maxFieldIndex :: CsvRules -> Int--- maxFieldIndex r = maximumDef (-1) $ catMaybes [---                    dateField r---                   ,statusField r---                   ,codeField r---                   ,amountField r---                   ,amountInField r---                   ,amountOutField r---                   ,currencyField r---                   ,accountField r---                   ,account2Field r---                   ,date2Field r---                   ]----- ** converting csv records to transactions--transactionFromCsvRecord :: Bool -> Maybe TimeZone -> TimeZone -> SourcePos -> CsvRules -> CsvRecord -> Transaction-transactionFromCsvRecord timesarezoned mtzin tzout sourcepos rules record = t-  where-    -----------------------------------------------------------------------    -- 1. Define some helpers:--    rule     = csvRule           rules        :: DirectiveName    -> Maybe FieldTemplate-    -- ruleval  = csvRuleValue      rules record :: DirectiveName    -> Maybe String-    field    = hledgerField      rules record :: HledgerFieldName -> Maybe FieldTemplate-    fieldval = hledgerFieldValue rules record :: HledgerFieldName -> Maybe Text-    mdateformat = rule "date-format"-    parsedate = parseDateWithCustomOrDefaultFormats timesarezoned mtzin tzout mdateformat-    mkdateerror datefield datevalue mdateformat' = T.unpack $ T.unlines-      ["error: could not parse \""<>datevalue<>"\" as a date using date format "-        <>maybe "\"YYYY/M/D\", \"YYYY-M-D\" or \"YYYY.M.D\"" (T.pack . show) mdateformat'-      ,showRecord record-      ,"the "<>datefield<>" rule is:   "<>(fromMaybe "required, but missing" $ field datefield)-      ,"the date-format is: "<>fromMaybe "unspecified" mdateformat'-      ,"you may need to "-        <>"change your "<>datefield<>" rule, "-        <>maybe "add a" (const "change your") mdateformat'<>" date-format rule, "-        <>"or "<>maybe "add a" (const "change your") mskip<>" skip rule"-      ,"for m/d/y or d/m/y dates, use date-format %-m/%-d/%Y or date-format %-d/%-m/%Y"-      ]-      where-        mskip = rule "skip"--    -----------------------------------------------------------------------    -- 2. Gather values needed for the transaction itself, by evaluating the-    -- field assignment rules using the CSV record's data, and parsing a bit-    -- more where needed (dates, status).--    date        = fromMaybe "" $ fieldval "date"-    -- PARTIAL:-    date'       = fromMaybe (error' $ mkdateerror "date" date mdateformat) $ parsedate date-    mdate2      = fieldval "date2"-    mdate2'     = (maybe (error' $ mkdateerror "date2" (fromMaybe "" mdate2) mdateformat) Just . parsedate) =<< mdate2-    status      =-      case fieldval "status" of-        Nothing -> Unmarked-        Just s  -> either statuserror id $ runParser (statusp <* eof) "" s-          where-            statuserror err = error' . T.unpack $ T.unlines-              ["error: could not parse \""<>s<>"\" as a cleared status (should be *, ! or empty)"-              ,"the parse error is:      "<>T.pack (customErrorBundlePretty err)-              ]-    code        = maybe "" singleline' $ fieldval "code"-    description = maybe "" singleline' $ fieldval "description"-    comment     = maybe "" unescapeNewlines $ fieldval "comment"-    ttags       = fromRight [] $ rtp commenttagsp comment-    precomment  = maybe "" unescapeNewlines $ fieldval "precomment"--    singleline' = T.unwords . filter (not . T.null) . map T.strip . T.lines-    unescapeNewlines = T.intercalate "\n" . T.splitOn "\\n"--    -----------------------------------------------------------------------    -- 3. Generate the postings for which an account has been assigned-    -- (possibly indirectly due to an amount or balance assignment)--    p1IsVirtual = (accountNamePostingType <$> fieldval "account1") == Just VirtualPosting-    ps = [p | n <- [1..maxpostings]-         ,let cmt  = maybe "" unescapeNewlines $ fieldval ("comment"<> T.pack (show n))-         ,let ptags = fromRight [] $ rtp commenttagsp cmt-         ,let currency = fromMaybe "" (fieldval ("currency"<> T.pack (show n)) <|> fieldval "currency")-         ,let mamount  = getAmount rules record currency p1IsVirtual n-         ,let mbalance = getBalance rules record currency n-         ,Just (acct,isfinal) <- [getAccount rules record mamount mbalance n]  -- skips Nothings-         ,let acct' | not isfinal && acct==unknownExpenseAccount &&-                      fromMaybe False (mamount >>= isNegativeMixedAmount) = unknownIncomeAccount-                    | otherwise = acct-         ,let p = nullposting{paccount          = accountNameWithoutPostingType acct'-                             ,pamount           = fromMaybe missingmixedamt mamount-                             ,ptransaction      = Just t-                             ,pbalanceassertion = mkBalanceAssertion rules record <$> mbalance-                             ,pcomment          = cmt-                             ,ptags             = ptags-                             ,ptype             = accountNamePostingType acct-                             }-         ]--    -----------------------------------------------------------------------    -- 4. Build the transaction (and name it, so the postings can reference it).--    t = nulltransaction{-           tsourcepos        = (sourcepos, sourcepos)  -- the CSV line number-          ,tdate             = date'-          ,tdate2            = mdate2'-          ,tstatus           = status-          ,tcode             = code-          ,tdescription      = description-          ,tcomment          = comment-          ,ttags             = ttags-          ,tprecedingcomment = precomment-          ,tpostings         = ps-          }---- | Parse the date string using the specified date-format, or if unspecified--- the "simple date" formats (YYYY/MM/DD, YYYY-MM-DD, YYYY.MM.DD, leading--- zeroes optional). If a timezone is provided, we assume the DateFormat--- produces a zoned time and we localise that to the given timezone.-parseDateWithCustomOrDefaultFormats :: Bool -> Maybe TimeZone -> TimeZone -> Maybe DateFormat -> Text -> Maybe Day-parseDateWithCustomOrDefaultFormats timesarezoned mtzin tzout mformat s = localdate <$> mutctime-  -- this time code can probably be simpler, I'm just happy to get out alive-  where-    localdate :: UTCTime -> Day =-      localDay .-      dbg7 ("time in output timezone "++show tzout) .-      utcToLocalTime tzout-    mutctime :: Maybe UTCTime = asum $ map parseWithFormat formats--    parseWithFormat :: String -> Maybe UTCTime-    parseWithFormat fmt =-      if timesarezoned-      then-        dbg7 "zoned CSV time, expressed as UTC" $-        parseTimeM True defaultTimeLocale fmt $ T.unpack s :: Maybe UTCTime-      else-        -- parse as a local day and time; then if an input timezone is provided,-        -- assume it's in that, otherwise assume it's in the output timezone;-        -- then convert to UTC like the above-        let-          mlocaltime =-            fmap (dbg7 "unzoned CSV time") $-            parseTimeM True defaultTimeLocale fmt $ T.unpack s :: Maybe LocalTime-          localTimeAsZonedTime tz lt =  ZonedTime lt tz-        in-          case mtzin of-            Just tzin ->-              (dbg7 ("unzoned CSV time, declared as "++show tzin++ ", expressed as UTC") .-              localTimeToUTC tzin)-              <$> mlocaltime-            Nothing ->-              (dbg7 ("unzoned CSV time, treated as "++show tzout++ ", expressed as UTC") .-                zonedTimeToUTC .-                localTimeAsZonedTime tzout)-              <$> mlocaltime--    formats = map T.unpack $ maybe-               ["%Y/%-m/%-d"-               ,"%Y-%-m-%-d"-               ,"%Y.%-m.%-d"-               -- ,"%-m/%-d/%Y"-                -- ,parseTimeM TruedefaultTimeLocale "%Y/%m/%e" (take 5 s ++ "0" ++ drop 5 s)-                -- ,parseTimeM TruedefaultTimeLocale "%Y-%m-%e" (take 5 s ++ "0" ++ drop 5 s)-                -- ,parseTimeM TruedefaultTimeLocale "%m/%e/%Y" ('0':s)-                -- ,parseTimeM TruedefaultTimeLocale "%m-%e-%Y" ('0':s)-               ]-               (:[])-                mformat---- | Figure out the amount specified for posting N, if any.--- A currency symbol to prepend to the amount, if any, is provided,--- and whether posting 1 requires balancing or not.--- This looks for a non-empty amount value assigned to "amountN", "amountN-in", or "amountN-out".--- For postings 1 or 2 it also looks at "amount", "amount-in", "amount-out".--- If more than one of these has a value, it looks for one that is non-zero.--- If there's multiple non-zeros, or no non-zeros but multiple zeros, it throws an error.-getAmount :: CsvRules -> CsvRecord -> Text -> Bool -> Int -> Maybe MixedAmount-getAmount rules record currency p1IsVirtual n =-  -- Warning! Many tricky corner cases here.-  -- Keep synced with:-  -- hledger_csv.m4.md -> CSV FORMAT -> "amount", "Setting amounts",-  -- hledger/test/csv.test -> 13, 31-34-  let-    unnumberedfieldnames = ["amount","amount-in","amount-out"]--    -- amount field names which can affect this posting-    fieldnames = map (("amount"<> T.pack (show n))<>) ["","-in","-out"]-                 -- For posting 1, also recognise the old amount/amount-in/amount-out names.-                 -- For posting 2, the same but only if posting 1 needs balancing.-                 ++ if n==1 || n==2 && not p1IsVirtual then unnumberedfieldnames else []--    -- assignments to any of these field names with non-empty values-    assignments = [(f,a') | f <- fieldnames-                          , Just v <- [T.strip . renderTemplate rules record f <$> hledgerField rules record f]-                          , not $ T.null v-                          -- XXX maybe ignore rule-generated values like "", "-", "$", "-$", "$-" ? cf CSV FORMAT -> "amount", "Setting amounts",-                          , let a = parseAmount rules record currency v-                          -- With amount/amount-in/amount-out, in posting 2,-                          -- flip the sign and convert to cost, as they did before 1.17-                          , let a' = if f `elem` unnumberedfieldnames && n==2 then mixedAmountCost (maNegate a) else a-                          ]--    -- if any of the numbered field names are present, discard all the unnumbered ones-    discardUnnumbered xs = if null numbered then xs else numbered-      where-        numbered = filter (T.any isDigit . fst) xs--    -- 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--    -- 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 . textChomp . T.unlines $  -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-          -- PARTIAL:-        ["in CSV rules:"-        ,"While processing " <> showRecord record-        ,"while calculating amount for posting " <> T.pack (show n)-        ] ++-        ["rule \"" <> f <> " " <>-          fromMaybe "" (hledgerField rules record f) <>-          "\" assigned value \"" <> wbToText (showMixedAmountB noColour a) <> "\"" -- XXX not sure this is showing all the right info-          | (f,a) <- fs-        ] ++-        [""-        ,"Multiple non-zero amounts were assigned for an amount field."-        ,"Please ensure just one non-zero amount is assigned, perhaps with an if rule."-        ,"See also: https://hledger.org/hledger.html#setting-amounts"-        ,"(hledger manual -> CSV format -> Tips -> Setting amounts)"-        ]--- | Figure out the expected balance (assertion or assignment) specified for posting N,--- if any (and its parse position).-getBalance :: CsvRules -> CsvRecord -> Text -> Int -> Maybe (Amount, SourcePos)-getBalance rules record currency n = do-  v <- (fieldval ("balance"<> T.pack (show n))-        -- for posting 1, also recognise the old field name-        <|> if n==1 then fieldval "balance" else Nothing)-  case v of-    "" -> Nothing-    s  -> Just (-            parseBalanceAmount rules record currency n s-           ,initialPos ""  -- parse position to show when assertion fails,-           )               -- XXX the csv record's line number would be good-  where-    fieldval = fmap T.strip . hledgerFieldValue rules record :: HledgerFieldName -> Maybe Text---- | Given a non-empty amount string (from CSV) to parse, along with a--- possibly non-empty currency symbol to prepend,--- parse as a hledger MixedAmount (as in journal format), or raise an error.--- The whole CSV record is provided for the error message.-parseAmount :: CsvRules -> CsvRecord -> Text -> Text -> MixedAmount-parseAmount rules record currency s =-    either mkerror mixedAmount $  -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-      -- PARTIAL:-    runParser (evalStateT (amountp <* eof) journalparsestate) "" $-    currency <> simplifySign s-  where-    journalparsestate = nulljournal{jparsedecimalmark=parseDecimalMark rules}-    mkerror e = error' . T.unpack $ T.unlines-      ["error: could not parse \"" <> s <> "\" as an amount"-      ,showRecord record-      ,showRules rules record-      -- ,"the default-currency is: "++fromMaybe "unspecified" (getDirective "default-currency" rules)-      ,"the parse error is:      " <> T.pack (customErrorBundlePretty e)-      ,"you may need to \-        \change your amount*, balance*, or currency* rules, \-        \or add or change your skip rule"-      ]---- | Show the values assigned to each journal field.-showRules rules record = T.unlines $ catMaybes-  [ (("the "<>fld<>" rule is: ")<>) <$>-    getEffectiveAssignment rules record fld | fld <- journalfieldnames ]---- | Show a (approximate) recreation of the original CSV record.-showRecord :: CsvRecord -> Text-showRecord r = "CSV record: "<>T.intercalate "," (map (wrap "\"" "\"") r)---- XXX unify these ^v---- | Almost but not quite the same as parseAmount.--- Given a non-empty amount string (from CSV) to parse, along with a--- possibly non-empty currency symbol to prepend,--- parse as a hledger Amount (as in journal format), or raise an error.--- The CSV record and the field's numeric suffix are provided for the error message.-parseBalanceAmount :: CsvRules -> CsvRecord -> Text -> Int -> Text -> Amount-parseBalanceAmount rules record currency n s =-  either (mkerror n s) id $-    runParser (evalStateT (amountp <* eof) journalparsestate) "" $-    currency <> simplifySign s-                  -- the csv record's line number would be good-  where-    journalparsestate = nulljournal{jparsedecimalmark=parseDecimalMark rules}-    mkerror n' s' e = error' . T.unpack $ T.unlines-      ["error: could not parse \"" <> s' <> "\" as balance"<> T.pack (show n') <> " amount"-      ,showRecord record-      ,showRules rules record-      -- ,"the default-currency is: "++fromMaybe "unspecified" mdefaultcurrency-      ,"the parse error is:      "<> T.pack (customErrorBundlePretty e)-      ]---- Read a valid decimal mark from the decimal-mark rule, if any.--- If the rule is present with an invalid argument, raise an error.-parseDecimalMark :: CsvRules -> Maybe DecimalMark-parseDecimalMark rules = do-    s <- rules `csvRule` "decimal-mark"-    case T.uncons s of-        Just (c, rest) | T.null rest && isDecimalMark c -> return c-        _ -> error' . T.unpack $ "decimal-mark's argument should be \".\" or \",\" (not \""<>s<>"\")"---- | Make a balance assertion for the given amount, with the given parse--- position (to be shown in assertion failures), with the assertion type--- possibly set by a balance-type rule.--- The CSV rules and current record are also provided, to be shown in case--- balance-type's argument is bad (XXX refactor).-mkBalanceAssertion :: CsvRules -> CsvRecord -> (Amount, SourcePos) -> BalanceAssertion-mkBalanceAssertion rules record (amt, pos) = assrt{baamount=amt, baposition=pos}-  where-    assrt =-      case getDirective "balance-type" rules of-        Nothing    -> nullassertion-        Just "="   -> nullassertion-        Just "=="  -> nullassertion{batotal=True}-        Just "=*"  -> nullassertion{bainclusive=True}-        Just "==*" -> nullassertion{batotal=True, bainclusive=True}-        Just x     -> error' . T.unpack $ T.unlines  -- PARTIAL:-          [ "balance-type \"" <> x <>"\" is invalid. Use =, ==, =* or ==*."-          , showRecord record-          , showRules rules record-          ]---- | Figure out the account name specified for posting N, if any.--- And whether it is the default unknown account (which may be--- improved later) or an explicitly set account (which may not).-getAccount :: CsvRules -> CsvRecord -> Maybe MixedAmount -> Maybe (Amount, SourcePos) -> Int -> Maybe (AccountName, Bool)-getAccount rules record mamount mbalance n =-  let-    fieldval = hledgerFieldValue rules record :: HledgerFieldName -> Maybe Text-    maccount = T.strip <$> fieldval ("account"<> T.pack (show n))-  in case maccount of-    -- accountN is set to the empty string - no posting will be generated-    Just "" -> Nothing-    -- accountN is set (possibly to "expenses:unknown"! #1192) - mark it final-    Just a  ->-      -- Check it and reject if invalid.. sometimes people try-      -- to set an amount or comment along with the account name.-      case parsewith (accountnamep >> eof) a of-        Left e  -> usageError $ errorBundlePretty e-        Right _ -> Just (a, True)-    -- accountN is unset-    Nothing ->-      case (mamount, mbalance) of-        -- amountN is set, or implied by balanceN - set accountN to-        -- the default unknown account ("expenses:unknown") and-        -- allow it to be improved later-        (Just _, _) -> Just (unknownExpenseAccount, False)-        (_, Just _) -> Just (unknownExpenseAccount, False)-        -- amountN is also unset - no posting will be generated-        (Nothing, Nothing) -> Nothing---- | Default account names to use when needed.-unknownExpenseAccount = "expenses:unknown"-unknownIncomeAccount  = "income:unknown"--type CsvAmountString = Text---- | Canonicalise the sign in a CSV amount string.--- Such strings can have a minus sign, parentheses (equivalent to minus),--- or any two of these (which cancel out),--- or a plus sign (which is removed),--- or any sign by itself with no following number (which is removed).--- See hledger > CSV FORMAT > Tips > Setting amounts.------ These are supported (note, not every possibile combination):------ >>> simplifySign "1"--- "1"--- >>> simplifySign "+1"--- "1"--- >>> simplifySign "-1"--- "-1"--- >>> simplifySign "(1)"--- "-1"--- >>> simplifySign "--1"--- "1"--- >>> simplifySign "-(1)"--- "1"--- >>> simplifySign "-+1"--- "-1"--- >>> simplifySign "(-1)"--- "1"--- >>> simplifySign "((1))"--- "1"--- >>> simplifySign "-"--- ""--- >>> simplifySign "()"--- ""--- >>> simplifySign "+"--- ""-simplifySign :: CsvAmountString -> CsvAmountString-simplifySign amtstr-  | Just (' ',t) <- T.uncons amtstr = simplifySign t-  | Just (t,' ') <- T.unsnoc amtstr = simplifySign t-  | Just ('(',t) <- T.uncons amtstr, Just (amt,')') <- T.unsnoc t = simplifySign $ negateStr amt-  | Just ('-',b) <- T.uncons amtstr, Just ('(',t) <- T.uncons b, Just (amt,')') <- T.unsnoc t = simplifySign amt-  | Just ('-',m) <- T.uncons amtstr, Just ('-',amt) <- T.uncons m = amt-  | Just ('-',m) <- T.uncons amtstr, Just ('+',amt) <- T.uncons m = negateStr amt-  | amtstr `elem` ["-","+","()"] = ""-  | Just ('+',amt) <- T.uncons amtstr = simplifySign amt-  | otherwise = amtstr--negateStr :: Text -> Text-negateStr amtstr = case T.uncons amtstr of-    Just ('-',s) -> s-    _            -> T.cons '-' amtstr----- ** tests-_TESTS__________________________________________ = undefined--tests_RulesReader = testGroup "RulesReader" [-   testGroup "parseCsvRules" [-     testCase "empty file" $-      parseCsvRules "unknown" "" @?= Right (mkrules defrules)-   ]-  ,testGroup "rulesp" [-     testCase "trailing comments" $-      parseWithState' defrules rulesp "skip\n# \n#\n" @?= Right (mkrules $ defrules{rdirectives = [("skip","")]})--    ,testCase "trailing blank lines" $-      parseWithState' defrules rulesp "skip\n\n  \n" @?= (Right (mkrules $ defrules{rdirectives = [("skip","")]}))--    ,testCase "no final newline" $-      parseWithState' defrules rulesp "skip" @?= (Right (mkrules $ defrules{rdirectives=[("skip","")]}))--    ,testCase "assignment with empty value" $-      parseWithState' defrules rulesp "account1 \nif foo\n  account2 foo\n" @?=-        (Right (mkrules $ defrules{rassignments = [("account1","")], rconditionalblocks = [CB{cbMatchers=[RecordMatcher None (toRegex' "foo")],cbAssignments=[("account2","foo")]}]}))-   ]-  ,testGroup "conditionalblockp" [-    testCase "space after conditional" $ -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-       -- #1120-      parseWithState' defrules conditionalblockp "if a\n account2 b\n \n" @?=-        (Right $ CB{cbMatchers=[RecordMatcher None $ toRegexCI' "a"],cbAssignments=[("account2","b")]})--  ],--  testGroup "csvfieldreferencep" [-    testCase "number" $ parseWithState' defrules csvfieldreferencep "%1" @?= (Right "%1")-   ,testCase "name" $ parseWithState' defrules csvfieldreferencep "%date" @?= (Right "%date")-   ,testCase "quoted name" $ parseWithState' defrules csvfieldreferencep "%\"csv date\"" @?= (Right "%\"csv date\"")-   ]--  ,testGroup "matcherp" [--    testCase "recordmatcherp" $-      parseWithState' defrules matcherp "A A\n" @?= (Right $ RecordMatcher None $ toRegexCI' "A A")--   ,testCase "recordmatcherp.starts-with-&" $-      parseWithState' defrules matcherp "& A A\n" @?= (Right $ RecordMatcher And $ toRegexCI' "A A")--   ,testCase "fieldmatcherp.starts-with-%" $-      parseWithState' defrules matcherp "description A A\n" @?= (Right $ RecordMatcher None $ toRegexCI' "description A A")--   ,testCase "fieldmatcherp" $-      parseWithState' defrules matcherp "%description A A\n" @?= (Right $ FieldMatcher None "%description" $ toRegexCI' "A A")--   ,testCase "fieldmatcherp.starts-with-&" $-      parseWithState' defrules matcherp "& %description A A\n" @?= (Right $ FieldMatcher And "%description" $ toRegexCI' "A A")--   -- ,testCase "fieldmatcherp with operator" $-   --    parseWithState' defrules matcherp "%description ~ A A\n" @?= (Right $ FieldMatcher "%description" "A A")--   ]-- ,testGroup "getEffectiveAssignment" [-    let rules = mkrules $ defrules {rcsvfieldindexes=[("csvdate",1)],rassignments=[("date","%csvdate")]}--    in testCase "toplevel" $ getEffectiveAssignment rules ["a","b"] "date" @?= (Just "%csvdate")--   ,let rules = mkrules $ defrules{rcsvfieldindexes=[("csvdate",1)], rconditionalblocks=[CB [FieldMatcher None "%csvdate" $ toRegex' "a"] [("date","%csvdate")]]}-    in testCase "conditional" $ getEffectiveAssignment rules ["a","b"] "date" @?= (Just "%csvdate")--   ,let rules = mkrules $ defrules{rcsvfieldindexes=[("csvdate",1)], rconditionalblocks=[CB [FieldMatcher Not "%csvdate" $ toRegex' "a"] [("date","%csvdate")]]}-    in testCase "negated-conditional-false" $ getEffectiveAssignment rules ["a","b"] "date" @?= (Nothing)-  -   ,let rules = mkrules $ defrules{rcsvfieldindexes=[("csvdate",1)], rconditionalblocks=[CB [FieldMatcher Not "%csvdate" $ toRegex' "b"] [("date","%csvdate")]]}-    in testCase "negated-conditional-true" $ getEffectiveAssignment rules ["a","b"] "date" @?= (Just "%csvdate")--   ,let rules = mkrules $ defrules{rcsvfieldindexes=[("csvdate",1),("description",2)], rconditionalblocks=[CB [FieldMatcher None "%csvdate" $ toRegex' "a", FieldMatcher None "%description" $ toRegex' "b"] [("date","%csvdate")]]}-    in testCase "conditional-with-or-a" $ getEffectiveAssignment rules ["a"] "date" @?= (Just "%csvdate")--   ,let rules = mkrules $ defrules{rcsvfieldindexes=[("csvdate",1),("description",2)], rconditionalblocks=[CB [FieldMatcher None "%csvdate" $ toRegex' "a", FieldMatcher None "%description" $ toRegex' "b"] [("date","%csvdate")]]}-    in testCase "conditional-with-or-b" $ getEffectiveAssignment rules ["_", "b"] "date" @?= (Just "%csvdate")--   ,let rules = mkrules $ defrules{rcsvfieldindexes=[("csvdate",1),("description",2)], rconditionalblocks=[CB [FieldMatcher None "%csvdate" $ toRegex' "a", FieldMatcher And "%description" $ toRegex' "b"] [("date","%csvdate")]]}-    in testCase "conditional.with-and" $ getEffectiveAssignment rules ["a", "b"] "date" @?= (Just "%csvdate")--   ,let rules = mkrules $ defrules{rcsvfieldindexes=[("csvdate",1),("description",2)], rconditionalblocks=[CB [FieldMatcher None "%csvdate" $ toRegex' "a", FieldMatcher And "%description" $ toRegex' "b", FieldMatcher None "%description" $ toRegex' "c"] [("date","%csvdate")]]}-    in testCase "conditional.with-and-or" $ getEffectiveAssignment rules ["_", "c"] "date" @?= (Just "%csvdate")--   ]-+{-# LANGUAGE LambdaCase #-}++--- ** exports+module Hledger.Read.RulesReader (+  -- * Reader+  reader,+  -- * Misc.+  readJournalFromCsv,+  -- readRulesFile,+  -- parseCsvRules,+  -- validateCsvRules,+  -- CsvRules,+  dataFileFor,+  rulesFileFor,+  parseBalanceAssertionType,+  -- * Tests+  tests_RulesReader,+)+where++--- ** imports+import Prelude hiding (Applicative(..))+import Control.Applicative (Applicative(..))+import Control.Monad              (unless, when, void)+import Control.Monad.Except       (ExceptT(..), liftEither, throwError)+import qualified Control.Monad.Fail as Fail+import Control.Monad.IO.Class     (MonadIO, liftIO)+import Control.Monad.State.Strict (StateT, get, modify', evalStateT)+import Control.Monad.Trans.Class  (lift)+import Data.Char                  (toLower, isDigit, isSpace, isAlphaNum, ord)+import Data.Bifunctor             (first)+import Data.Functor               ((<&>))+import Data.List (elemIndex, foldl', mapAccumL, nub, sortOn)+import Data.List.Extra (groupOn)+import Data.Maybe (catMaybes, fromMaybe, isJust)+import Data.MemoUgly (memo)+import qualified Data.Set as S+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import qualified Data.Text.IO as T+import Data.Time ( Day, TimeZone, UTCTime, LocalTime, ZonedTime(ZonedTime),+  defaultTimeLocale, getCurrentTimeZone, localDay, parseTimeM, utcToLocalTime, localTimeToUTC, zonedTimeToUTC)+import Safe (atMay, headMay, lastMay, readMay)+import System.FilePath ((</>), takeDirectory, takeExtension, stripExtension, takeFileName)+import qualified Data.Csv as Cassava+import qualified Data.Csv.Parser.Megaparsec as CassavaMegaparsec+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as BL+import Data.Foldable (asum, toList)+import Text.Megaparsec hiding (match, parse)+import Text.Megaparsec.Char (char, newline, string, digitChar)+import Text.Megaparsec.Custom (parseErrorAt)+import Text.Printf (printf)++import Hledger.Data+import Hledger.Utils+import Hledger.Read.Common (aliasesFromOpts, Reader(..), InputOpts(..), amountp, statusp, journalFinalise, accountnamep, commenttagsp )+import Hledger.Read.CsvUtils+import System.Directory (doesFileExist, getHomeDirectory)+import Data.Either (fromRight)++--- ** doctest setup+-- $setup+-- >>> :set -XOverloadedStrings++--- ** reader+_READER__________________________________________ = undefined  -- VSCode outline separator+++reader :: MonadIO m => Reader m+reader = Reader+  {rFormat     = Rules+  ,rExtensions = ["rules"]+  ,rReadFn     = parse+  ,rParser     = error' "sorry, rules files can't be included"  -- PARTIAL:+  }++isFileName f = takeFileName f == f++getDownloadDir = do+  home <- getHomeDirectory+  return $ home </> "Downloads"  -- XXX++-- | Parse and post-process a "Journal" from the given rules file path, or give an error.+-- A data file is inferred from the @source@ rule, otherwise from a similarly-named file+-- in the same directory.+-- The source rule can specify a glob pattern and supports ~ for home directory.+-- If it is a bare filename it will be relative to the defaut download directory+-- on this system. If is a relative file path it will be relative to the rules+-- file's directory. When a glob pattern matches multiple files, the alphabetically+-- last is used. (Eg in case of multiple numbered downloads, the highest-numbered+-- will be used.)+-- The provided text, or a --rules-file option, are ignored by this reader.+-- Balance assertions are not checked.+parse :: InputOpts -> FilePath -> Text -> ExceptT String IO Journal+parse iopts f _ = do+  rules <- readRulesFile $ dbg4 "reading rules file" f+  -- XXX higher-than usual debug level for file reading to bypass excessive noise from elsewhere, normally 6 or 7+  mdatafile <- liftIO $ do+    dldir <- getDownloadDir+    let rulesdir = takeDirectory f+    let msource = T.unpack <$> getDirective "source" rules+    fs <- case msource of+            Just src -> expandGlob dir (dbg4 "source" src) >>= sortByModTime <&> dbg4 ("matched files"<>desc<>", newest first")+              where (dir,desc) = if isFileName src then (dldir," in download directory") else (rulesdir,"")+            Nothing  -> return [maybe err (dbg4 "inferred source") $ dataFileFor f]  -- shouldn't fail, f has .rules extension+              where err = error' $ "could not infer a data file for " <> f+    return $ dbg4 "data file" $ headMay fs+  case mdatafile of+    Nothing -> return nulljournal  -- data file specified by source rule was not found+    Just dat -> do+      exists <- liftIO $ doesFileExist dat+      if not (dat=="-" || exists)+      then return nulljournal      -- data file inferred from rules file name was not found+      else do+        t <- liftIO $ readFileOrStdinPortably dat+        readJournalFromCsv (Just $ Left rules) dat t Nothing+        -- apply any command line account aliases. Can fail with a bad replacement pattern.+        >>= liftEither . journalApplyAliases (aliasesFromOpts iopts)+            -- journalFinalise assumes the journal's items are+            -- reversed, as produced by JournalReader's parser.+            -- But here they are already properly ordered. So we'd+            -- better preemptively reverse them once more. XXX inefficient+            . journalReverse+        >>= journalFinalise iopts{balancingopts_=(balancingopts_ iopts){ignore_assertions_=True}} f ""++--- ** reading rules files+--- *** rules utilities+_RULES_READING__________________________________________ = undefined++-- | Given a rules file path, what would be the corresponding data file ?+-- (Remove a .rules extension.)+dataFileFor :: FilePath -> Maybe FilePath+dataFileFor = stripExtension "rules"++-- | Given a csv file path, what would be the corresponding rules file ?+-- (Add a .rules extension.)+rulesFileFor :: FilePath -> FilePath+rulesFileFor = (++ ".rules")++-- | An exception-throwing IO action that reads and validates+-- the specified CSV rules file (which may include other rules files).+readRulesFile :: FilePath -> ExceptT String IO CsvRules+readRulesFile f =+  liftIO (do+    dbg6IO "using conversion rules file" f+    readFilePortably f >>= expandIncludes (takeDirectory f)+  ) >>= either throwError return . parseAndValidateCsvRules f++-- | Inline all files referenced by include directives in this hledger CSV rules text, recursively.+-- Included file paths may be relative to the directory of the provided file path.+-- This is done as a pre-parse step to simplify the CSV rules parser.+expandIncludes :: FilePath -> Text -> IO Text+expandIncludes dir0 content = mapM (expandLine dir0) (T.lines content) <&> T.unlines+  where+    expandLine dir1 line =+      case line of+        (T.stripPrefix "include " -> Just f) -> expandIncludes dir2 =<< T.readFile f'+          where+            f' = dir1 </> T.unpack (T.dropWhile isSpace f)+            dir2 = takeDirectory f'+        _ -> return line++-- defaultRulesText :: FilePath -> Text+-- defaultRulesText _csvfile = T.pack $ unlines+--   ["# hledger csv conversion rules" --  for " ++ csvFileFor (takeFileName csvfile)+--   ,"# cf http://hledger.org/hledger.html#csv"+--   ,""+--   ,"account1 assets:bank:checking"+--   ,""+--   ,"fields date, description, amount1"+--   ,""+--   ,"#skip 1"+--   ,"#newest-first"+--   ,""+--   ,"#date-format %-d/%-m/%Y"+--   ,"#date-format %-m/%-d/%Y"+--   ,"#date-format %Y-%h-%d"+--   ,""+--   ,"#currency $"+--   ,""+--   ,"if ITUNES"+--   ," account2 expenses:entertainment"+--   ,""+--   ,"if (TO|FROM) SAVINGS"+--   ," account2 assets:bank:savings\n"+--   ]++-- | An error-throwing IO action that parses this text as CSV conversion rules+-- and runs some extra validation checks. The file path is used in error messages.+parseAndValidateCsvRules :: FilePath -> T.Text -> Either String CsvRules+parseAndValidateCsvRules rulesfile s =+  case parseCsvRules rulesfile s of+    Left err    -> Left $ customErrorBundlePretty err+    Right rules -> first makeFancyParseError $ validateCsvRules rules+  where+    makeFancyParseError :: String -> String+    makeFancyParseError errorString =+      parseErrorPretty (FancyError 0 (S.singleton $ ErrorFail errorString) :: ParseError Text String)++instance ShowErrorComponent String where+  showErrorComponent = id++-- | Parse this text as CSV conversion rules. The file path is for error messages.+parseCsvRules :: FilePath -> T.Text -> Either (ParseErrorBundle T.Text HledgerParseErrorData) CsvRules+-- parseCsvRules rulesfile s = runParser csvrulesfile nullrules{baseAccount=takeBaseName rulesfile} rulesfile s+parseCsvRules = runParser (evalStateT rulesp defrules)++-- | Return the validated rules, or an error.+validateCsvRules :: CsvRules -> Either String CsvRules+validateCsvRules rules = do+  unless (isAssigned "date")   $ Left "Please specify (at top level) the date field. Eg: date %1"+  Right rules+  where+    isAssigned f = isJust $ hledgerField rules [] f++--- *** rules types+_RULES_TYPES__________________________________________ = undefined++-- | A set of data definitions and account-matching patterns sufficient to+-- convert a particular CSV data file into meaningful journal transactions.+data CsvRules' a = CsvRules' {+  rdirectives        :: [(DirectiveName,Text)],+    -- ^ top-level rules, as (keyword, value) pairs+  rcsvfieldindexes   :: [(CsvFieldName, CsvFieldIndex)],+    -- ^ csv field names and their column number, if declared by a fields list+  rassignments       :: [(HledgerFieldName, FieldTemplate)],+    -- ^ top-level assignments to hledger fields, as (field name, value template) pairs+  rconditionalblocks :: [ConditionalBlock],+    -- ^ conditional blocks, which containing additional assignments/rules to apply to matched csv records+  rblocksassigning :: a -- (String -> [ConditionalBlock])+    -- ^ all conditional blocks which can potentially assign field with a given name (memoized)+}++-- | Type used by parsers. Directives, assignments and conditional blocks+-- are in the reverse order compared to what is in the file and rblocksassigning is non-functional,+-- could not be used for processing CSV records yet+type CsvRulesParsed = CsvRules' ()++-- | Type used after parsing is done. Directives, assignments and conditional blocks+-- are in the same order as they were in the input file and rblocksassigning is functional.+-- Ready to be used for CSV record processing+type CsvRules = CsvRules' (Text -> [ConditionalBlock])  -- XXX simplify++instance Eq CsvRules where+  r1 == r2 = (rdirectives r1, rcsvfieldindexes r1, rassignments r1) ==+             (rdirectives r2, rcsvfieldindexes r2, rassignments r2)++-- Custom Show instance used for debug output: omit the rblocksassigning field, which isn't showable.+instance Show CsvRules where+  show r = "CsvRules { rdirectives = " ++ show (rdirectives r) +++           ", rcsvfieldindexes = "     ++ show (rcsvfieldindexes r) +++           ", rassignments = "         ++ show (rassignments r) +++           ", rconditionalblocks = "   ++ show (rconditionalblocks r) +++           " }"++type CsvRulesParser a = StateT CsvRulesParsed SimpleTextParser a++-- | The keyword of a CSV rule - "fields", "skip", "if", etc.+type DirectiveName    = Text++-- | CSV field name.+type CsvFieldName     = Text++-- | 1-based CSV column number.+type CsvFieldIndex    = Int++-- | Percent symbol followed by a CSV field name or column number. Eg: %date, %1.+type CsvFieldReference = Text++-- | One of the standard hledger fields or pseudo-fields that can be assigned to.+-- Eg date, account1, amount, amount1-in, date-format.+type HledgerFieldName = Text++-- | A text value to be assigned to a hledger field, possibly+-- containing csv field references to be interpolated.+type FieldTemplate    = Text++-- | A reference to a regular expression match group. Eg \1.+type MatchGroupReference = Text++-- | A strptime date parsing pattern, as supported by Data.Time.Format.+type DateFormat       = Text++-- | A prefix for a matcher test, either & or none (implicit or).+data MatcherPrefix = And | Not | None+  deriving (Show, Eq)++-- | A single test for matching a CSV record, in one way or another.+data Matcher =+    RecordMatcher MatcherPrefix Regexp                          -- ^ match if this regexp matches the overall CSV record+  | FieldMatcher MatcherPrefix CsvFieldReference Regexp         -- ^ match if this regexp matches the referenced CSV field's value+  deriving (Show, Eq)++-- | A conditional block: a set of CSV record matchers, and a sequence+-- of rules which will be enabled only if one or more of the matchers+-- succeeds.+--+-- Three types of rule are allowed inside conditional blocks: field+-- assignments, skip, end. (A skip or end rule is stored as if it was+-- a field assignment, and executed in validateCsv. XXX)+data ConditionalBlock = CB {+   cbMatchers    :: [Matcher]+  ,cbAssignments :: [(HledgerFieldName, FieldTemplate)]+  } deriving (Show, Eq)++defrules :: CsvRulesParsed+defrules = CsvRules' {+  rdirectives=[],+  rcsvfieldindexes=[],+  rassignments=[],+  rconditionalblocks=[],+  rblocksassigning = ()+  }++-- | Create CsvRules from the content parsed out of the rules file+mkrules :: CsvRulesParsed -> CsvRules+mkrules rules =+  let conditionalblocks = reverse $ rconditionalblocks rules+      maybeMemo = if length conditionalblocks >= 15 then memo else id+  in+    CsvRules' {+    rdirectives=reverse $ rdirectives rules,+    rcsvfieldindexes=rcsvfieldindexes rules,+    rassignments=reverse $ rassignments rules,+    rconditionalblocks=conditionalblocks,+    rblocksassigning = maybeMemo (\f -> filter (any ((==f).fst) . cbAssignments) conditionalblocks)+    }++--- *** rules parsers+_RULES_PARSING__________________________________________ = undefined++{-+Grammar for the CSV conversion rules, more or less:++RULES: RULE*++RULE: ( SOURCE | FIELD-LIST | FIELD-ASSIGNMENT | CONDITIONAL-BLOCK | SKIP | TIMEZONE | NEWEST-FIRST | INTRA-DAY-REVERSED | DATE-FORMAT | DECIMAL-MARK | COMMENT | BLANK ) NEWLINE++SOURCE: source SPACE FILEPATH++FIELD-LIST: fields SPACE FIELD-NAME ( SPACE? , SPACE? FIELD-NAME )*++FIELD-NAME: QUOTED-FIELD-NAME | BARE-FIELD-NAME++QUOTED-FIELD-NAME: " (any CHAR except double-quote)+ "++BARE-FIELD-NAME: any CHAR except space, tab, #, ;++FIELD-ASSIGNMENT: JOURNAL-FIELD ASSIGNMENT-SEPARATOR FIELD-VALUE++JOURNAL-FIELD: date | date2 | status | code | description | comment | account1 | account2 | amount | JOURNAL-PSEUDO-FIELD++JOURNAL-PSEUDO-FIELD: amount-in | amount-out | currency++ASSIGNMENT-SEPARATOR: SPACE | ( : SPACE? )++FIELD-VALUE: VALUE (possibly containing CSV-FIELD-REFERENCEs and REGEX-MATCHGROUP-REFERENCEs)++CSV-FIELD-REFERENCE: % CSV-FIELD++REGEX-MATCHGROUP-REFERENCE: \ DIGIT+++CSV-FIELD: ( FIELD-NAME | FIELD-NUMBER ) (corresponding to a CSV field)++FIELD-NUMBER: DIGIT+++CONDITIONAL-BLOCK: if ( FIELD-MATCHER NEWLINE )+ INDENTED-BLOCK++FIELD-MATCHER: ( CSV-FIELD-NAME SPACE? )? ( MATCHOP SPACE? )? PATTERNS++MATCHOP: ~++PATTERNS: ( NEWLINE REGEXP )* REGEXP++INDENTED-BLOCK: ( SPACE ( FIELD-ASSIGNMENT | COMMENT ) NEWLINE )+++REGEXP: ( NONSPACE CHAR* ) SPACE?++VALUE: SPACE? ( CHAR* ) SPACE?++COMMENT: SPACE? COMMENT-CHAR VALUE++COMMENT-CHAR: # | ; | *++NONSPACE: any CHAR not a SPACE-CHAR++BLANK: SPACE?++SPACE: SPACE-CHAR+++SPACE-CHAR: space | tab++CHAR: any character except newline++DIGIT: 0-9++-}++addDirective :: (DirectiveName, Text) -> CsvRulesParsed -> CsvRulesParsed+addDirective d r = r{rdirectives=d:rdirectives r}++addAssignment :: (HledgerFieldName, FieldTemplate) -> CsvRulesParsed -> CsvRulesParsed+addAssignment a r = r{rassignments=a:rassignments r}++setIndexesAndAssignmentsFromList :: [CsvFieldName] -> CsvRulesParsed -> CsvRulesParsed+setIndexesAndAssignmentsFromList fs = addAssignmentsFromList fs . setCsvFieldIndexesFromList fs+  where+    setCsvFieldIndexesFromList :: [CsvFieldName] -> CsvRulesParsed -> CsvRulesParsed+    setCsvFieldIndexesFromList fs' r = r{rcsvfieldindexes=zip fs' [1..]}++    addAssignmentsFromList :: [CsvFieldName] -> CsvRulesParsed -> CsvRulesParsed+    addAssignmentsFromList fs' r = foldl' maybeAddAssignment r journalfieldnames+      where+        maybeAddAssignment rules f = (maybe id addAssignmentFromIndex $ elemIndex f fs') rules+          where+            addAssignmentFromIndex i = addAssignment (f, T.pack $ '%':show (i+1))++addConditionalBlock :: ConditionalBlock -> CsvRulesParsed -> CsvRulesParsed+addConditionalBlock b r = r{rconditionalblocks=b:rconditionalblocks r}++addConditionalBlocks :: [ConditionalBlock] -> CsvRulesParsed -> CsvRulesParsed+addConditionalBlocks bs r = r{rconditionalblocks=bs++rconditionalblocks r}++rulesp :: CsvRulesParser CsvRules+rulesp = do+  _ <- many $ choice+    [blankorcommentlinep                                                <?> "blank or comment line"+    ,(directivep        >>= modify' . addDirective)                     <?> "directive"+    ,(fieldnamelistp    >>= modify' . setIndexesAndAssignmentsFromList) <?> "field name list"+    ,(fieldassignmentp  >>= modify' . addAssignment)                    <?> "field assignment"+    -- conditionalblockp backtracks because it shares "if" prefix with conditionaltablep.+    ,try (conditionalblockp >>= modify' . addConditionalBlock)          <?> "conditional block"+    -- 'reverse' is there to ensure that conditions are added in the order they listed in the file+    ,(conditionaltablep >>= modify' . addConditionalBlocks . reverse)   <?> "conditional table"+    ]+  eof+  mkrules <$> get++blankorcommentlinep :: CsvRulesParser ()+blankorcommentlinep = lift (dbgparse 8 "trying blankorcommentlinep") >> choiceInState [blanklinep, commentlinep]++blanklinep :: CsvRulesParser ()+blanklinep = lift skipNonNewlineSpaces >> newline >> return () <?> "blank line"++commentlinep :: CsvRulesParser ()+commentlinep = lift skipNonNewlineSpaces >> commentcharp >> lift restofline >> return () <?> "comment line"++commentcharp :: CsvRulesParser Char+commentcharp = oneOf (";#*" :: [Char])++directivep :: CsvRulesParser (DirectiveName, Text)+directivep = (do+  lift $ dbgparse 8 "trying directive"+  d <- choiceInState $ map (lift . string) directives+  v <- (((char ':' >> lift (many spacenonewline)) <|> lift (some spacenonewline)) >> directivevalp)+       <|> (optional (char ':') >> lift skipNonNewlineSpaces >> lift eolof >> return "")+  return (d, v)+  ) <?> "directive"++directives :: [Text]+directives =+  ["source"+  ,"date-format"+  ,"decimal-mark"+  ,"separator"+  -- ,"default-account"+  -- ,"default-currency"+  ,"skip"+  ,"timezone"+  ,"newest-first"+  ,"intra-day-reversed"+  , "balance-type"+  ]++directivevalp :: CsvRulesParser Text+directivevalp = T.pack <$> anySingle `manyTill` lift eolof++fieldnamelistp :: CsvRulesParser [CsvFieldName]+fieldnamelistp = (do+  lift $ dbgparse 8 "trying fieldnamelist"+  string "fields"+  optional $ char ':'+  lift skipNonNewlineSpaces1+  let separator = lift skipNonNewlineSpaces >> char ',' >> lift skipNonNewlineSpaces+  f <- fromMaybe "" <$> optional fieldnamep+  fs <- some $ (separator >> fromMaybe "" <$> optional fieldnamep)+  lift restofline+  return . map T.toLower $ f:fs+  ) <?> "field name list"++fieldnamep :: CsvRulesParser Text+fieldnamep = quotedfieldnamep <|> barefieldnamep++quotedfieldnamep :: CsvRulesParser Text+quotedfieldnamep =+    char '"' *> takeWhile1P Nothing (`notElem` ("\"\n:;#~" :: [Char])) <* char '"'++barefieldnamep :: CsvRulesParser Text+barefieldnamep = takeWhile1P Nothing (`notElem` (" \t\n,;#~" :: [Char]))++fieldassignmentp :: CsvRulesParser (HledgerFieldName, FieldTemplate)+fieldassignmentp = do+  lift $ dbgparse 8 "trying fieldassignmentp"+  f <- journalfieldnamep+  v <- choiceInState [ assignmentseparatorp >> fieldvalp+                     , lift eolof >> return ""+                     ]+  return (f,v)+  <?> "field assignment"++journalfieldnamep :: CsvRulesParser Text+journalfieldnamep = do+  lift (dbgparse 8 "trying journalfieldnamep")+  choiceInState $ map (lift . string) journalfieldnames++maxpostings = 99++-- Transaction fields and pseudo fields for CSV conversion.+-- Names must precede any other name they contain, for the parser+-- (amount-in before amount; date2 before date). TODO: fix+journalfieldnames =+  concat [[ "account" <> i+          ,"amount" <> i <> "-in"+          ,"amount" <> i <> "-out"+          ,"amount" <> i+          ,"balance" <> i+          ,"comment" <> i+          ,"currency" <> i+          ] | x <- [maxpostings, (maxpostings-1)..1], let i = T.pack $ show x]+  +++  ["amount-in"+  ,"amount-out"+  ,"amount"+  ,"balance"+  ,"code"+  ,"comment"+  ,"currency"+  ,"date2"+  ,"date"+  ,"description"+  ,"status"+  ,"skip" -- skip and end are not really fields, but we list it here to allow conditional rules that skip records+  ,"end"+  ]++assignmentseparatorp :: CsvRulesParser ()+assignmentseparatorp = do+  lift $ dbgparse 8 "trying assignmentseparatorp"+  _ <- choiceInState [ lift skipNonNewlineSpaces >> char ':' >> lift skipNonNewlineSpaces+                     , lift skipNonNewlineSpaces1+                     ]+  return ()++fieldvalp :: CsvRulesParser Text+fieldvalp = do+  lift $ dbgparse 8 "trying fieldvalp"+  T.pack <$> anySingle `manyTill` lift eolof++-- A conditional block: one or more matchers, one per line, followed by one or more indented rules.+conditionalblockp :: CsvRulesParser ConditionalBlock+conditionalblockp = do+  lift $ dbgparse 8 "trying conditionalblockp"+  -- "if\nMATCHER" or "if    \nMATCHER" or "if MATCHER"+  start <- getOffset+  string "if" >> ( (newline >> return Nothing)+                  <|> (lift skipNonNewlineSpaces1 >> optional newline))+  ms <- some matcherp+  as <- catMaybes <$>+    many (lift skipNonNewlineSpaces1 >>+          choice [ lift eolof >> return Nothing+                 , fmap Just fieldassignmentp+                 ])+  when (null as) $+    customFailure $ parseErrorAt start $  "start of conditional block found, but no assignment rules afterward\n(assignment rules in a conditional block should be indented)"+  return $ CB{cbMatchers=ms, cbAssignments=as}+  <?> "conditional block"++-- A conditional table: "if" followed by separator, followed by some field names,+-- followed by many lines, each of which is either:+-- a comment line, or ...+-- one matcher, followed by field assignments (as many as there were fields in the header)+conditionaltablep :: CsvRulesParser [ConditionalBlock]+conditionaltablep = do+  lift $ dbgparse 8 "trying conditionaltablep"+  start <- getOffset+  string "if"+  sep <- lift $ satisfy (\c -> not (isAlphaNum c || isSpace c))+  fields <- journalfieldnamep `sepBy1` (char sep)+  newline+  body <- catMaybes <$> (flip manyTill (lift eolof) $+          choice [ commentlinep >> return Nothing+                 , fmap Just $ bodylinep sep fields+                 ])+  when (null body) $+    customFailure $ parseErrorAt start $ "start of conditional table found, but no assignment rules afterward"+  return $ flip map body $ \(m,vs) ->+    CB{cbMatchers=[m], cbAssignments=zip fields vs}+  <?> "conditional table"+  where+    bodylinep :: Char -> [Text] -> CsvRulesParser (Matcher,[FieldTemplate])+    bodylinep sep fields = do+      off <- getOffset+      m <- matcherp' $ void $ char sep+      vs <- T.split (==sep) . T.pack <$> lift restofline+      if (length vs /= length fields)+        then customFailure $ parseErrorAt off $ ((printf "line of conditional table should have %d values, but this one has only %d" (length fields) (length vs)) :: String)+        else return (m,vs)+      ++-- A single matcher, on one line.+matcherp' :: CsvRulesParser () -> CsvRulesParser Matcher+matcherp' end = try (fieldmatcherp end) <|> recordmatcherp end++matcherp :: CsvRulesParser Matcher+matcherp = matcherp' (lift eolof)++-- A single whole-record matcher.+-- A pattern on the whole line, not beginning with a csv field reference.+recordmatcherp :: CsvRulesParser () -> CsvRulesParser Matcher+recordmatcherp end = do+  lift $ dbgparse 8 "trying recordmatcherp"+  -- pos <- currentPos+  -- _  <- optional (matchoperatorp >> lift skipNonNewlineSpaces >> optional newline)+  p <- matcherprefixp+  r <- regexp end+  return $ RecordMatcher p r+  -- when (null ps) $+  --   Fail.fail "start of record matcher found, but no patterns afterward\n(patterns should not be indented)"+  <?> "record matcher"++-- | A single matcher for a specific field. A csv field reference+-- (like %date or %1), and a pattern on the rest of the line,+-- optionally space-separated. Eg:+-- %description chez jacques+fieldmatcherp :: CsvRulesParser () -> CsvRulesParser Matcher+fieldmatcherp end = do+  lift $ dbgparse 8 "trying fieldmatcher"+  -- An optional fieldname (default: "all")+  -- f <- fromMaybe "all" `fmap` (optional $ do+  --        f' <- fieldnamep+  --        lift skipNonNewlineSpaces+  --        return f')+  p <- matcherprefixp+  f <- csvfieldreferencep <* lift skipNonNewlineSpaces+  -- optional operator.. just ~ (case insensitive infix regex) for now+  -- _op <- fromMaybe "~" <$> optional matchoperatorp+  lift skipNonNewlineSpaces+  r <- regexp end+  return $ FieldMatcher p f r+  <?> "field matcher"++matcherprefixp :: CsvRulesParser MatcherPrefix+matcherprefixp = do+  lift $ dbgparse 8 "trying matcherprefixp"+  (char '&' >> lift skipNonNewlineSpaces >> return And) <|> (char '!' >> lift skipNonNewlineSpaces >> return Not) <|> return None++csvfieldreferencep :: CsvRulesParser CsvFieldReference+csvfieldreferencep = do+  lift $ dbgparse 8 "trying csvfieldreferencep"+  char '%'+  T.cons '%' . textQuoteIfNeeded <$> fieldnamep++-- A single regular expression+regexp :: CsvRulesParser () -> CsvRulesParser Regexp+regexp end = do+  lift $ dbgparse 8 "trying regexp"+  -- notFollowedBy matchoperatorp+  c <- lift nonspace+  cs <- anySingle `manyTill` end+  case toRegexCI . T.strip . T.pack $ c:cs of+       Left x -> Fail.fail $ "CSV parser: " ++ x+       Right x -> return x++-- -- A match operator, indicating the type of match to perform.+-- -- Currently just ~ meaning case insensitive infix regex match.+-- matchoperatorp :: CsvRulesParser String+-- matchoperatorp = fmap T.unpack $ choiceInState $ map string+--   ["~"+--   -- ,"!~"+--   -- ,"="+--   -- ,"!="+--   ]++_RULES_LOOKUP__________________________________________ = undefined++getDirective :: DirectiveName -> CsvRules -> Maybe FieldTemplate+getDirective directivename = lookup directivename . rdirectives++-- | Look up the value (template) of a csv rule by rule keyword.+csvRule :: CsvRules -> DirectiveName -> Maybe FieldTemplate+csvRule rules = (`getDirective` rules)++-- | Look up the value template assigned to a hledger field by field+-- list/field assignment rules, taking into account the current record and+-- conditional rules.+hledgerField :: CsvRules -> CsvRecord -> HledgerFieldName -> Maybe FieldTemplate+hledgerField rules record f = fmap+  (either id (lastCBAssignmentTemplate f))+  (getEffectiveAssignment rules record f)++-- | Look up the final value assigned to a hledger field, with csv field+-- references and regular expression match group references interpolated.+hledgerFieldValue :: CsvRules -> CsvRecord -> HledgerFieldName -> Maybe Text+hledgerFieldValue rules record f = (flip fmap) (getEffectiveAssignment rules record f)+  $ either (renderTemplate rules record)+  $ \cb -> let+      t = lastCBAssignmentTemplate f cb+      r = rules { rconditionalblocks = [cb] } -- XXX handle rblocksassigning+      in renderTemplate r record t++lastCBAssignmentTemplate :: HledgerFieldName -> ConditionalBlock -> FieldTemplate+lastCBAssignmentTemplate f = snd . last . filter ((==f).fst) . cbAssignments++maybeNegate :: MatcherPrefix -> Bool -> Bool+maybeNegate Not origbool = not origbool+maybeNegate _ origbool = origbool++-- | Given the conversion rules, a CSV record and a hledger field name, find+-- either the last applicable `ConditionalBlock`, or the final value template+-- assigned to this field by a top-level field assignment, if any exist.+--+-- Note conditional blocks' patterns are matched against an approximation of the+-- CSV record: all the field values, without enclosing quotes, comma-separated.+--+getEffectiveAssignment+  :: CsvRules+     -> CsvRecord+     -> HledgerFieldName+     -> Maybe (Either FieldTemplate ConditionalBlock)+getEffectiveAssignment rules record f = lastMay assignments+  where+    -- all active assignments to field f, in order+    assignments = dbg9 "csv assignments" $ toplevelassignments ++ conditionalassignments+    -- all top level field assignments+    toplevelassignments    = map (Left . snd) $ filter ((==f).fst) $ rassignments rules+    -- all conditional blocks assigning to field f and active for the current csv record+    conditionalassignments = map Right+                           $ filter (any (==f) . map fst . cbAssignments)+                           $ filter (isBlockActive rules record)+                           $ (rblocksassigning rules) f++-- does this conditional block match the current csv record ?+isBlockActive :: CsvRules -> CsvRecord -> ConditionalBlock -> Bool+isBlockActive rules record CB{..} = any (all matcherMatches) $ groupedMatchers cbMatchers+  where+    -- does this individual matcher match the current csv record ?+    matcherMatches :: Matcher -> Bool+    matcherMatches (RecordMatcher prefix pat) = maybeNegate prefix origbool+      where+        pat' = dbg7 "regex" pat+        -- A synthetic whole CSV record to match against. Note, this can be+        -- different from the original CSV data:+        -- - any whitespace surrounding field values is preserved+        -- - any quotes enclosing field values are removed+        -- - and the field separator is always comma+        -- which means that a field containing a comma will look like two fields.+        wholecsvline = dbg7 "wholecsvline" $ T.intercalate "," record+        origbool = regexMatchText pat' wholecsvline+    matcherMatches (FieldMatcher prefix csvfieldref pat) = maybeNegate prefix origbool+      where+        -- the value of the referenced CSV field to match against.+        csvfieldvalue = dbg7 "csvfieldvalue" $ replaceCsvFieldReference rules record csvfieldref+        origbool = regexMatchText pat csvfieldvalue++    -- | Group matchers into associative pairs based on prefix, e.g.:+    --   A+    --   & B+    --   C+    --   D+    --   & E+    --   => [[A, B], [C], [D, E]]+    groupedMatchers :: [Matcher] -> [[Matcher]]+    groupedMatchers [] = []+    groupedMatchers (x:xs) = (x:ys) : groupedMatchers zs+      where+        (ys, zs) = span (\y -> matcherPrefix y == And) xs+        matcherPrefix :: Matcher -> MatcherPrefix+        matcherPrefix (RecordMatcher prefix _) = prefix+        matcherPrefix (FieldMatcher prefix _ _) = prefix++-- | Render a field assignment's template, possibly interpolating referenced+-- CSV field values or match groups. Outer whitespace is removed from interpolated values.+renderTemplate ::  CsvRules -> CsvRecord -> FieldTemplate -> Text+renderTemplate rules record t =+  maybe t mconcat $ parseMaybe+    (many+      (   literaltextp+      <|> (matchrefp <&> replaceRegexGroupReference rules record)+      <|> (fieldrefp <&> replaceCsvFieldReference   rules record)+      )+    )+    t+  where+    literaltextp :: SimpleTextParser Text+    literaltextp = some (nonBackslashOrPercent <|> nonRefBackslash <|> nonRefPercent) <&> T.pack+      where+        nonBackslashOrPercent = noneOf ['\\', '%'] <?> "character other than backslash or percent"+        nonRefBackslash = try (char '\\' <* notFollowedBy digitChar) <?> "backslash that does not begin a match group reference"+        nonRefPercent   = try (char '%'  <* notFollowedBy (satisfy isFieldNameChar)) <?> "percent that does not begin a field reference"+    matchrefp    = liftA2 T.cons (char '\\') (takeWhile1P (Just "matchref")  isDigit)+    fieldrefp    = liftA2 T.cons (char '%')  (takeWhile1P (Just "reference") isFieldNameChar)+    isFieldNameChar c = isAlphaNum c || c == '_' || c == '-'++-- | Replace something that looks like a Regex match group reference with the+-- resulting match group value after applying the Regex.+replaceRegexGroupReference :: CsvRules -> CsvRecord -> MatchGroupReference -> Text+replaceRegexGroupReference rules record s = case T.uncons s of+    Just ('\\', group) -> fromMaybe "" $ regexMatchValue rules record group+    _                  -> s++regexMatchValue :: CsvRules -> CsvRecord -> Text -> Maybe Text+regexMatchValue rules record sgroup = let+  matchgroups  = concatMap (getMatchGroups rules record)+               $ concatMap cbMatchers+               $ filter (isBlockActive rules record)+               $ rconditionalblocks rules+               -- ^ XXX adjusted to not use memoized field as caller might be sending a subset of rules with just one CB (hacky)+  group = (read (T.unpack sgroup) :: Int) - 1 -- adjust to 0-indexing+  in atMay matchgroups group++getMatchGroups :: CsvRules -> CsvRecord -> Matcher -> [Text]+getMatchGroups _ record (RecordMatcher _ regex)  = let+  txt = T.intercalate "," record -- see caveats of wholecsvline, in `isBlockActive`+  in regexMatchTextGroups regex txt+getMatchGroups rules record (FieldMatcher _ fieldref regex) = let+  txt = replaceCsvFieldReference rules record fieldref+  in regexMatchTextGroups regex txt++-- | Replace something that looks like a reference to a csv field ("%date" or "%1)+-- with that field's value. If it doesn't look like a field reference, or if we+-- can't find such a field, replace it with the empty string.+replaceCsvFieldReference :: CsvRules -> CsvRecord -> CsvFieldReference -> Text+replaceCsvFieldReference rules record s = case T.uncons s of+    Just ('%', fieldname) -> fromMaybe "" $ csvFieldValue rules record fieldname+    _                     -> s++-- | Get the (whitespace-stripped) value of a CSV field, identified by its name or+-- column number, ("date" or "1"), from the given CSV record, if such a field exists.+csvFieldValue :: CsvRules -> CsvRecord -> CsvFieldName -> Maybe Text+csvFieldValue rules record fieldname = do+  fieldindex <-+    if T.all isDigit fieldname+    then readMay $ T.unpack fieldname+    else lookup (T.toLower fieldname) $ rcsvfieldindexes rules+  T.strip <$> atMay record (fieldindex-1)++_CSV_READING__________________________________________ = undefined++-- | Read a Journal from the given CSV data (and filename, used for error+-- messages), or return an error. Proceed as follows:+--+-- 1. Conversion rules are provided, or they are parsed from the specified+--    rules file, or from the default rules file for the CSV data file.+--    If rules parsing fails, or the required rules file does not exist, throw an error.+--+-- 2. Parse the CSV data using the rules, or throw an error.+--+-- 3. Convert the CSV records to hledger transactions using the rules.+--+-- 4. Return the transactions as a Journal.+--+readJournalFromCsv :: Maybe (Either CsvRules FilePath) -> FilePath -> Text -> Maybe SepFormat -> ExceptT String IO Journal+readJournalFromCsv Nothing "-" _ _ = throwError "please use --rules-file when reading CSV from stdin"+readJournalFromCsv merulesfile csvfile csvtext sep = do+    -- for now, correctness is the priority here, efficiency not so much++    rules <- case merulesfile of+      Just (Left rs)         -> return rs+      Just (Right rulesfile) -> readRulesFile rulesfile+      Nothing                -> readRulesFile $ rulesFileFor csvfile+    dbg6IO "csv rules" rules++    -- convert the csv data to lines and remove all empty/blank lines+    let csvlines1 = dbg9 "csvlines1" $ filter (not . T.null . T.strip) $ dbg9 "csvlines0" $ T.lines csvtext++    -- if there is a top-level skip rule, skip the specified number of non-empty lines+    skiplines <- case getDirective "skip" rules of+                      Nothing -> return 0+                      Just "" -> return 1+                      Just s  -> maybe (throwError $ "could not parse skip value: " ++ show s) return . readMay $ T.unpack s+    let csvlines2 = dbg9 "csvlines2" $ drop skiplines csvlines1++    -- convert back to text and parse as csv records+    let+      csvtext1 = T.unlines csvlines2+      -- The separator in the rules file takes precedence over the extension or prefix+      separator = case getDirective "separator" rules >>= parseSeparator of+        Just c           -> c+        _ | ext == "ssv" -> ';'+        _ | ext == "tsv" -> '\t'+        _                -> +          case sep of+            Just Csv -> ','+            Just Ssv -> ';'+            Just Tsv -> '\t'+            Nothing -> ','+        where+          ext = map toLower $ drop 1 $ takeExtension csvfile+      -- parsec seemed to fail if you pass it "-" here   -- TODO: try again with megaparsec+      parsecfilename = if csvfile == "-" then "(stdin)" else csvfile+    dbg6IO "using separator" separator+    -- parse csv records+    csvrecords0 <- dbg7 "parseCsv" <$> parseCsv separator parsecfilename csvtext1+    -- remove any records skipped by conditional skip or end rules+    let csvrecords1 = applyConditionalSkips rules csvrecords0+    -- and check the remaining records for any obvious problems+    csvrecords <- liftEither $ dbg7 "validateCsv" <$> validateCsv csvrecords1+    dbg6IO "first 3 csv records" $ take 3 csvrecords++    -- XXX identify header lines some day ?+    -- let (headerlines, datalines) = identifyHeaderLines csvrecords'+    --     mfieldnames = lastMay headerlines++    tzout <- liftIO getCurrentTimeZone+    mtzin <- case getDirective "timezone" rules of+              Nothing -> return Nothing+              Just s  ->+                maybe (throwError $ "could not parse time zone: " ++ T.unpack s) (return.Just) $+                parseTimeM False defaultTimeLocale "%Z" $ T.unpack s+    let+      -- convert CSV records to transactions, saving the CSV line numbers for error positions+      txns = dbg7 "csv txns" $ snd $ mapAccumL+                     (\pos r ->+                        let+                          SourcePos name line col = pos+                          line' = (mkPos . (+1) . unPos) line+                          pos' = SourcePos name line' col+                        in+                          (pos', transactionFromCsvRecord timesarezoned mtzin tzout pos rules r)+                     )+                     (initialPos parsecfilename) csvrecords+        where+          timesarezoned =+            case csvRule rules "date-format" of+              Just f | any (`T.isInfixOf` f) ["%Z","%z","%EZ","%Ez"] -> True+              _ -> False++      -- Do our best to ensure transactions will be ordered chronologically,+      -- from oldest to newest. This is done in several steps:+      -- 1. Intra-day order: if there's an "intra-day-reversed" rule,+      -- assume each day's CSV records were ordered in reverse of the overall date order,+      -- so reverse each day's txns.+      intradayreversed = dbg6 "intra-day-reversed" $ isJust $ getDirective "intra-day-reversed" rules+      txns1 = dbg7 "txns1" $+        (if intradayreversed then concatMap reverse . groupOn tdate else id) txns+      -- 2. Overall date order: now if there's a "newest-first" rule,+      -- or if there's multiple dates and the first is more recent than the last,+      -- assume CSV records were ordered newest dates first,+      -- so reverse all txns.+      newestfirst = dbg6 "newest-first" $ isJust $ getDirective "newest-first" rules+      mdatalooksnewestfirst = dbg6 "mdatalooksnewestfirst" $+        case nub $ map tdate txns of+          ds@(d:_) -> Just $ d > last ds+          []       -> Nothing+      txns2 = dbg7 "txns2" $+        (if newestfirst || mdatalooksnewestfirst == Just True then reverse else id) txns1+      -- 3. Disordered dates: in case the CSV records were ordered by chaos,+      -- do a final sort by date. If it was only a few records out of order,+      -- this will hopefully refine any good ordering done by steps 1 and 2.+      txns3 = dbg7 "date-sorted csv txns" $ sortOn tdate txns2++    return nulljournal{jtxns=txns3}++-- | Parse special separator names TAB and SPACE, or return the first+-- character. Return Nothing on empty string+parseSeparator :: Text -> Maybe Char+parseSeparator = specials . T.toLower+  where specials "space" = Just ' '+        specials "tab"   = Just '\t'+        specials xs      = fst <$> T.uncons xs++-- Call parseCassava on a file or stdin, converting the result to ExceptT.+parseCsv :: Char -> FilePath -> Text -> ExceptT String IO [CsvRecord]+parseCsv separator filePath csvtext = ExceptT $+  case filePath of+    "-" -> parseCassava separator "(stdin)" <$> T.getContents+    _   -> return $ if T.null csvtext then Right mempty else parseCassava separator filePath csvtext++-- Parse text into CSV records, using Cassava and the given field separator.+parseCassava :: Char -> FilePath -> Text -> Either String [CsvRecord]+parseCassava separator path content =+  -- XXX we now remove all blank lines before parsing; will Cassava will still produce [""] records ?+  -- filter (/=[""])+  either (Left . errorBundlePretty) (Right . parseResultToCsv) <$>+  CassavaMegaparsec.decodeWith decodeOptions Cassava.NoHeader path $+  BL.fromStrict $ T.encodeUtf8 content+  where+    decodeOptions = Cassava.defaultDecodeOptions {+                      Cassava.decDelimiter = fromIntegral (ord separator)+                    }+    parseResultToCsv :: (Foldable t, Functor t) => t (t B.ByteString) -> [CsvRecord]+    parseResultToCsv = toListList . unpackFields+      where+        toListList = toList . fmap toList+        unpackFields  = (fmap . fmap) T.decodeUtf8++-- | Scan for csv records where a conditional `skip` or `end` rule applies,+-- and apply that rule, removing one or more following records.+applyConditionalSkips :: CsvRules -> [CsvRecord] -> [CsvRecord]+applyConditionalSkips _ [] = []+applyConditionalSkips rules (r:rest) =+  case skipnum r of+    Nothing -> r : applyConditionalSkips rules rest+    Just cnt -> applyConditionalSkips rules $ drop (cnt-1) rest+  where+    skipnum r1 =+      case (hledgerField rules r1 "end", hledgerField rules r1 "skip") of+        (Nothing, Nothing) -> Nothing+        (Just _, _) -> Just maxBound+        (Nothing, Just "") -> Just 1+        (Nothing, Just x) -> Just (read $ T.unpack x)++-- | Do some validation on the parsed CSV records:+-- check that they all have at least two fields.+validateCsv :: [CsvRecord] -> Either String [CsvRecord]+validateCsv [] = Right []+validateCsv rs@(_first:_) =+  case lessthan2 of+    Just r  -> Left $ printf "CSV record %s has less than two fields" (show r)+    Nothing -> Right rs+  where+    lessthan2 = headMay $ filter ((<2).length) rs++-- -- | The highest (0-based) field index referenced in the field+-- -- definitions, or -1 if no fields are defined.+-- maxFieldIndex :: CsvRules -> Int+-- maxFieldIndex r = maximumDef (-1) $ catMaybes [+--                    dateField r+--                   ,statusField r+--                   ,codeField r+--                   ,amountField r+--                   ,amountInField r+--                   ,amountOutField r+--                   ,currencyField r+--                   ,accountField r+--                   ,account2Field r+--                   ,date2Field r+--                   ]++--- ** converting csv records to transactions++transactionFromCsvRecord :: Bool -> Maybe TimeZone -> TimeZone -> SourcePos -> CsvRules -> CsvRecord -> Transaction+transactionFromCsvRecord timesarezoned mtzin tzout sourcepos rules record = t+  where+    ----------------------------------------------------------------------+    -- 1. Define some helpers:++    rule     = csvRule           rules        :: DirectiveName    -> Maybe FieldTemplate+    -- ruleval  = csvRuleValue      rules record :: DirectiveName    -> Maybe String+    field    = hledgerField      rules record :: HledgerFieldName -> Maybe FieldTemplate+    fieldval = hledgerFieldValue rules record :: HledgerFieldName -> Maybe Text+    mdateformat = rule "date-format"+    parsedate = parseDateWithCustomOrDefaultFormats timesarezoned mtzin tzout mdateformat+    mkdateerror datefield datevalue mdateformat' = T.unpack $ T.unlines+      ["error: could not parse \""<>datevalue<>"\" as a date using date format "+        <>maybe "\"YYYY/M/D\", \"YYYY-M-D\" or \"YYYY.M.D\"" (T.pack . show) mdateformat'+      ,showRecord record+      ,"the "<>datefield<>" rule is:   "<>(fromMaybe "required, but missing" $ field datefield)+      ,"the date-format is: "<>fromMaybe "unspecified" mdateformat'+      ,"you may need to "+        <>"change your "<>datefield<>" rule, "+        <>maybe "add a" (const "change your") mdateformat'<>" date-format rule, "+        <>"or "<>maybe "add a" (const "change your") mskip<>" skip rule"+      ,"for m/d/y or d/m/y dates, use date-format %-m/%-d/%Y or date-format %-d/%-m/%Y"+      ]+      where+        mskip = rule "skip"++    ----------------------------------------------------------------------+    -- 2. Gather values needed for the transaction itself, by evaluating the+    -- field assignment rules using the CSV record's data, and parsing a bit+    -- more where needed (dates, status).++    date        = fromMaybe "" $ fieldval "date"+    -- PARTIAL:+    date'       = fromMaybe (error' $ mkdateerror "date" date mdateformat) $ parsedate date+    mdate2      = fieldval "date2"+    mdate2'     = (maybe (error' $ mkdateerror "date2" (fromMaybe "" mdate2) mdateformat) Just . parsedate) =<< mdate2+    status      =+      case fieldval "status" of+        Nothing -> Unmarked+        Just s  -> either statuserror id $ runParser (statusp <* eof) "" s+          where+            statuserror err = error' . T.unpack $ T.unlines+              ["error: could not parse \""<>s<>"\" as a cleared status (should be *, ! or empty)"+              ,"the parse error is:      "<>T.pack (customErrorBundlePretty err)+              ]+    code        = maybe "" singleline' $ fieldval "code"+    description = maybe "" singleline' $ fieldval "description"+    comment     = maybe "" unescapeNewlines $ fieldval "comment"+    ttags       = fromRight [] $ rtp commenttagsp comment+    precomment  = maybe "" unescapeNewlines $ fieldval "precomment"++    singleline' = T.unwords . filter (not . T.null) . map T.strip . T.lines+    unescapeNewlines = T.intercalate "\n" . T.splitOn "\\n"++    ----------------------------------------------------------------------+    -- 3. Generate the postings for which an account has been assigned+    -- (possibly indirectly due to an amount or balance assignment)++    p1IsVirtual = (accountNamePostingType <$> fieldval "account1") == Just VirtualPosting+    ps = [p | n <- [1..maxpostings]+         ,let cmt  = maybe "" unescapeNewlines $ fieldval ("comment"<> T.pack (show n))+         ,let ptags = fromRight [] $ rtp commenttagsp cmt+         ,let currency = fromMaybe "" (fieldval ("currency"<> T.pack (show n)) <|> fieldval "currency")+         ,let mamount  = getAmount rules record currency p1IsVirtual n+         ,let mbalance = getBalance rules record currency n+         ,Just (acct,isfinal) <- [getAccount rules record mamount mbalance n]  -- skips Nothings+         ,let acct' | not isfinal && acct==unknownExpenseAccount &&+                      fromMaybe False (mamount >>= isNegativeMixedAmount) = unknownIncomeAccount+                    | otherwise = acct+         ,let p = nullposting{paccount          = accountNameWithoutPostingType acct'+                             ,pamount           = fromMaybe missingmixedamt mamount+                             ,ptransaction      = Just t+                             ,pbalanceassertion = mkBalanceAssertion rules record <$> mbalance+                             ,pcomment          = cmt+                             ,ptags             = ptags+                             ,ptype             = accountNamePostingType acct+                             }+         ]++    ----------------------------------------------------------------------+    -- 4. Build the transaction (and name it, so the postings can reference it).++    t = nulltransaction{+           tsourcepos        = (sourcepos, sourcepos)  -- the CSV line number+          ,tdate             = date'+          ,tdate2            = mdate2'+          ,tstatus           = status+          ,tcode             = code+          ,tdescription      = description+          ,tcomment          = comment+          ,ttags             = ttags+          ,tprecedingcomment = precomment+          ,tpostings         = ps+          }++-- | Parse the date string using the specified date-format, or if unspecified+-- the "simple date" formats (YYYY/MM/DD, YYYY-MM-DD, YYYY.MM.DD, leading+-- zeroes optional). If a timezone is provided, we assume the DateFormat+-- produces a zoned time and we localise that to the given timezone.+parseDateWithCustomOrDefaultFormats :: Bool -> Maybe TimeZone -> TimeZone -> Maybe DateFormat -> Text -> Maybe Day+parseDateWithCustomOrDefaultFormats timesarezoned mtzin tzout mformat s = localdate <$> mutctime+  -- this time code can probably be simpler, I'm just happy to get out alive+  where+    localdate :: UTCTime -> Day =+      localDay .+      dbg7 ("time in output timezone "++show tzout) .+      utcToLocalTime tzout+    mutctime :: Maybe UTCTime = asum $ map parseWithFormat formats++    parseWithFormat :: String -> Maybe UTCTime+    parseWithFormat fmt =+      if timesarezoned+      then+        dbg7 "zoned CSV time, expressed as UTC" $+        parseTimeM True defaultTimeLocale fmt $ T.unpack s :: Maybe UTCTime+      else+        -- parse as a local day and time; then if an input timezone is provided,+        -- assume it's in that, otherwise assume it's in the output timezone;+        -- then convert to UTC like the above+        let+          mlocaltime =+            fmap (dbg7 "unzoned CSV time") $+            parseTimeM True defaultTimeLocale fmt $ T.unpack s :: Maybe LocalTime+          localTimeAsZonedTime tz lt =  ZonedTime lt tz+        in+          case mtzin of+            Just tzin ->+              (dbg7 ("unzoned CSV time, declared as "++show tzin++ ", expressed as UTC") .+              localTimeToUTC tzin)+              <$> mlocaltime+            Nothing ->+              (dbg7 ("unzoned CSV time, treated as "++show tzout++ ", expressed as UTC") .+                zonedTimeToUTC .+                localTimeAsZonedTime tzout)+              <$> mlocaltime++    formats = map T.unpack $ maybe+               ["%Y/%-m/%-d"+               ,"%Y-%-m-%-d"+               ,"%Y.%-m.%-d"+               -- ,"%-m/%-d/%Y"+                -- ,parseTimeM TruedefaultTimeLocale "%Y/%m/%e" (take 5 s ++ "0" ++ drop 5 s)+                -- ,parseTimeM TruedefaultTimeLocale "%Y-%m-%e" (take 5 s ++ "0" ++ drop 5 s)+                -- ,parseTimeM TruedefaultTimeLocale "%m/%e/%Y" ('0':s)+                -- ,parseTimeM TruedefaultTimeLocale "%m-%e-%Y" ('0':s)+               ]+               (:[])+                mformat++-- | Figure out the amount specified for posting N, if any.+-- A currency symbol to prepend to the amount, if any, is provided,+-- and whether posting 1 requires balancing or not.+-- This looks for a non-empty amount value assigned to "amountN", "amountN-in", or "amountN-out".+-- For postings 1 or 2 it also looks at "amount", "amount-in", "amount-out".+-- If more than one of these has a value, it looks for one that is non-zero.+-- If there's multiple non-zeros, or no non-zeros but multiple zeros, it throws an error.+getAmount :: CsvRules -> CsvRecord -> Text -> Bool -> Int -> Maybe MixedAmount+getAmount rules record currency p1IsVirtual n =+  -- Warning! Many tricky corner cases here.+  -- Keep synced with:+  -- hledger_csv.m4.md -> CSV FORMAT -> "amount", "Setting amounts",+  -- hledger/test/csv.test -> 13, 31-34+  let+    unnumberedfieldnames = ["amount","amount-in","amount-out"]++    -- amount field names which can affect this posting+    fieldnames = map (("amount"<> T.pack (show n))<>) ["","-in","-out"]+                 -- For posting 1, also recognise the old amount/amount-in/amount-out names.+                 -- For posting 2, the same but only if posting 1 needs balancing.+                 ++ if n==1 || n==2 && not p1IsVirtual then unnumberedfieldnames else []++    -- assignments to any of these field names with non-empty values+    assignments = [(f,a') | f <- fieldnames+                          , Just v <- [T.strip <$> hledgerFieldValue rules record f]+                          , not $ T.null v+                          -- XXX maybe ignore rule-generated values like "", "-", "$", "-$", "$-" ? cf CSV FORMAT -> "amount", "Setting amounts",+                          , let a = parseAmount rules record currency v+                          -- With amount/amount-in/amount-out, in posting 2,+                          -- flip the sign and convert to cost, as they did before 1.17+                          , let a' = if f `elem` unnumberedfieldnames && n==2 then mixedAmountCost (maNegate a) else a+                          ]++    -- if any of the numbered field names are present, discard all the unnumbered ones+    discardUnnumbered xs = if null numbered then xs else numbered+      where+        numbered = filter (T.any isDigit . fst) xs++    -- 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++    -- 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 . textChomp . T.unlines $+        ["in CSV rules:"+        ,"While processing " <> showRecord record+        ,"while calculating amount for posting " <> T.pack (show n)+        ] +++        ["rule \"" <> f <> " " <>+          fromMaybe "" (hledgerField rules record f) <>+          "\" assigned value \"" <> wbToText (showMixedAmountB defaultFmt a) <> "\"" -- XXX not sure this is showing all the right info+          | (f,a) <- fs+        ] +++        [""+        ,"Multiple non-zero amounts were assigned for an amount field."+        ,"Please ensure just one non-zero amount is assigned, perhaps with an if rule."+        ,"See also: https://hledger.org/hledger.html#setting-amounts"+        ,"(hledger manual -> CSV format -> Tips -> Setting amounts)"+        ]+-- | Figure out the expected balance (assertion or assignment) specified for posting N,+-- if any (and its parse position).+getBalance :: CsvRules -> CsvRecord -> Text -> Int -> Maybe (Amount, SourcePos)+getBalance rules record currency n = do+  v <- (fieldval ("balance"<> T.pack (show n))+        -- for posting 1, also recognise the old field name+        <|> if n==1 then fieldval "balance" else Nothing)+  case v of+    "" -> Nothing+    s  -> Just (+            parseBalanceAmount rules record currency n s+           ,initialPos ""  -- parse position to show when assertion fails,+           )               -- XXX the csv record's line number would be good+  where+    fieldval = fmap T.strip . hledgerFieldValue rules record :: HledgerFieldName -> Maybe Text++-- | Given a non-empty amount string (from CSV) to parse, along with a+-- possibly non-empty currency symbol to prepend,+-- parse as a hledger MixedAmount (as in journal format), or raise an error.+-- The whole CSV record is provided for the error message.+parseAmount :: CsvRules -> CsvRecord -> Text -> Text -> MixedAmount+parseAmount rules record currency s =+    either mkerror mixedAmount $+    runParser (evalStateT (amountp <* eof) journalparsestate) "" $+    currency <> simplifySign s+  where+    journalparsestate = nulljournal{jparsedecimalmark=parseDecimalMark rules}+    mkerror e = error' . T.unpack $ T.unlines+      ["error: could not parse \"" <> s <> "\" as an amount"+      ,showRecord record+      ,showRules rules record+      -- ,"the default-currency is: "++fromMaybe "unspecified" (getDirective "default-currency" rules)+      ,"the parse error is:      " <> T.pack (customErrorBundlePretty e)+      ,"you may need to \+        \change your amount*, balance*, or currency* rules, \+        \or add or change your skip rule"+      ]++-- | Show the values assigned to each journal field.+showRules rules record = T.unlines $ catMaybes+  [ (("the "<>fld<>" rule is: ")<>) <$>+    hledgerField rules record fld | fld <- journalfieldnames ]++-- | Show a (approximate) recreation of the original CSV record.+showRecord :: CsvRecord -> Text+showRecord r = "CSV record: "<>T.intercalate "," (map (wrap "\"" "\"") r)++-- XXX unify these ^v++-- | Almost but not quite the same as parseAmount.+-- Given a non-empty amount string (from CSV) to parse, along with a+-- possibly non-empty currency symbol to prepend,+-- parse as a hledger Amount (as in journal format), or raise an error.+-- The CSV record and the field's numeric suffix are provided for the error message.+parseBalanceAmount :: CsvRules -> CsvRecord -> Text -> Int -> Text -> Amount+parseBalanceAmount rules record currency n s =+  either (mkerror n s) id $+    runParser (evalStateT (amountp <* eof) journalparsestate) "" $+    currency <> simplifySign s+                  -- the csv record's line number would be good+  where+    journalparsestate = nulljournal{jparsedecimalmark=parseDecimalMark rules}+    mkerror n' s' e = error' . T.unpack $ T.unlines+      ["error: could not parse \"" <> s' <> "\" as balance"<> T.pack (show n') <> " amount"+      ,showRecord record+      ,showRules rules record+      -- ,"the default-currency is: "++fromMaybe "unspecified" mdefaultcurrency+      ,"the parse error is:      "<> T.pack (customErrorBundlePretty e)+      ]++-- Read a valid decimal mark from the decimal-mark rule, if any.+-- If the rule is present with an invalid argument, raise an error.+parseDecimalMark :: CsvRules -> Maybe DecimalMark+parseDecimalMark rules = do+    s <- rules `csvRule` "decimal-mark"+    case T.uncons s of+        Just (c, rest) | T.null rest && isDecimalMark c -> return c+        _ -> error' . T.unpack $ "decimal-mark's argument should be \".\" or \",\" (not \""<>s<>"\")"++-- | Make a balance assertion for the given amount, with the given parse+-- position (to be shown in assertion failures), with the assertion type+-- possibly set by a balance-type rule.+-- The CSV rules and current record are also provided, to be shown in case+-- balance-type's argument is bad (XXX refactor).+mkBalanceAssertion :: CsvRules -> CsvRecord -> (Amount, SourcePos) -> BalanceAssertion+mkBalanceAssertion rules record (amt, pos) = assrt{baamount=amt, baposition=pos}+  where+    assrt =+      case getDirective "balance-type" rules of+        Nothing -> nullassertion+        Just x  ->+          case parseBalanceAssertionType $ T.unpack x of+            Just (total, inclusive) -> nullassertion{batotal=total, bainclusive=inclusive}+            Nothing -> error' . T.unpack $ T.unlines  -- PARTIAL:+              [ "balance-type \"" <> x <>"\" is invalid. Use =, ==, =* or ==*."+              , showRecord record+              , showRules rules record+              ]++-- | Detect from a balance assertion's syntax (=, ==, =*, ==*)+-- whether it is (a) total (multi-commodity) and (b) subaccount-inclusive.+-- Returns nothing if invalid syntax was provided.+parseBalanceAssertionType :: String -> Maybe (Bool, Bool)+parseBalanceAssertionType = \case+  "="   -> Just (False, False)+  "=="  -> Just (True,  False)+  "=*"  -> Just (False, True )+  "==*" -> Just (True,  True )+  _     -> Nothing++-- | Figure out the account name specified for posting N, if any.+-- And whether it is the default unknown account (which may be+-- improved later) or an explicitly set account (which may not).+getAccount :: CsvRules -> CsvRecord -> Maybe MixedAmount -> Maybe (Amount, SourcePos) -> Int -> Maybe (AccountName, Bool)+getAccount rules record mamount mbalance n =+  let+    fieldval = hledgerFieldValue rules record :: HledgerFieldName -> Maybe Text+    maccount = T.strip <$> fieldval ("account"<> T.pack (show n))+  in case maccount of+    -- accountN is set to the empty string - no posting will be generated+    Just "" -> Nothing+    -- accountN is set (possibly to "expenses:unknown"! #1192) - mark it final+    Just a  ->+      -- Check it and reject if invalid.. sometimes people try+      -- to set an amount or comment along with the account name.+      case parsewith (accountnamep >> eof) a of+        Left e  -> usageError $ errorBundlePretty e+        Right _ -> Just (a, True)+    -- accountN is unset+    Nothing ->+      case (mamount, mbalance) of+        -- amountN is set, or implied by balanceN - set accountN to+        -- the default unknown account ("expenses:unknown") and+        -- allow it to be improved later+        (Just _, _) -> Just (unknownExpenseAccount, False)+        (_, Just _) -> Just (unknownExpenseAccount, False)+        -- amountN is also unset - no posting will be generated+        (Nothing, Nothing) -> Nothing++-- | Default account names to use when needed.+unknownExpenseAccount = "expenses:unknown"+unknownIncomeAccount  = "income:unknown"++type CsvAmountString = Text++-- | Canonicalise the sign in a CSV amount string.+-- Such strings can have a minus sign, parentheses (equivalent to minus),+-- or any two of these (which cancel out),+-- or a plus sign (which is removed),+-- or any sign by itself with no following number (which is removed).+-- See hledger > CSV FORMAT > Tips > Setting amounts.+--+-- These are supported (note, not every possibile combination):+--+-- >>> simplifySign "1"+-- "1"+-- >>> simplifySign "+1"+-- "1"+-- >>> simplifySign "-1"+-- "-1"+-- >>> simplifySign "(1)"+-- "-1"+-- >>> simplifySign "--1"+-- "1"+-- >>> simplifySign "-(1)"+-- "1"+-- >>> simplifySign "-+1"+-- "-1"+-- >>> simplifySign "(-1)"+-- "1"+-- >>> simplifySign "((1))"+-- "1"+-- >>> simplifySign "-"+-- ""+-- >>> simplifySign "()"+-- ""+-- >>> simplifySign "+"+-- ""+simplifySign :: CsvAmountString -> CsvAmountString+simplifySign amtstr+  | Just (' ',t) <- T.uncons amtstr = simplifySign t+  | Just (t,' ') <- T.unsnoc amtstr = simplifySign t+  | Just ('(',t) <- T.uncons amtstr, Just (amt,')') <- T.unsnoc t = simplifySign $ negateStr amt+  | Just ('-',b) <- T.uncons amtstr, Just ('(',t) <- T.uncons b, Just (amt,')') <- T.unsnoc t = simplifySign amt+  | Just ('-',m) <- T.uncons amtstr, Just ('-',amt) <- T.uncons m = amt+  | Just ('-',m) <- T.uncons amtstr, Just ('+',amt) <- T.uncons m = negateStr amt+  | amtstr `elem` ["-","+","()"] = ""+  | Just ('+',amt) <- T.uncons amtstr = simplifySign amt+  | otherwise = amtstr++negateStr :: Text -> Text+negateStr amtstr = case T.uncons amtstr of+    Just ('-',s) -> s+    _            -> T.cons '-' amtstr++--- ** tests+_TESTS__________________________________________ = undefined++tests_RulesReader = testGroup "RulesReader" [+   testGroup "parseCsvRules" [+     testCase "empty file" $+      parseCsvRules "unknown" "" @?= Right (mkrules defrules)+   ]+  ,testGroup "rulesp" [+     testCase "trailing comments" $+      parseWithState' defrules rulesp "skip\n# \n#\n" @?= Right (mkrules $ defrules{rdirectives = [("skip","")]})++    ,testCase "trailing blank lines" $+      parseWithState' defrules rulesp "skip\n\n  \n" @?= (Right (mkrules $ defrules{rdirectives = [("skip","")]}))++    ,testCase "no final newline" $+      parseWithState' defrules rulesp "skip" @?= (Right (mkrules $ defrules{rdirectives=[("skip","")]}))++    ,testCase "assignment with empty value" $+      parseWithState' defrules rulesp "account1 \nif foo\n  account2 foo\n" @?=+        (Right (mkrules $ defrules{rassignments = [("account1","")], rconditionalblocks = [CB{cbMatchers=[RecordMatcher None (toRegex' "foo")],cbAssignments=[("account2","foo")]}]}))+   ]+  ,testGroup "conditionalblockp" [+    testCase "space after conditional" $+      parseWithState' defrules conditionalblockp "if a\n account2 b\n \n" @?=+        (Right $ CB{cbMatchers=[RecordMatcher None $ toRegexCI' "a"],cbAssignments=[("account2","b")]})+  ],++  testGroup "csvfieldreferencep" [+    testCase "number" $ parseWithState' defrules csvfieldreferencep "%1" @?= (Right "%1")+   ,testCase "name" $ parseWithState' defrules csvfieldreferencep "%date" @?= (Right "%date")+   ,testCase "quoted name" $ parseWithState' defrules csvfieldreferencep "%\"csv date\"" @?= (Right "%\"csv date\"")+   ]++  ,testGroup "matcherp" [++    testCase "recordmatcherp" $+      parseWithState' defrules matcherp "A A\n" @?= (Right $ RecordMatcher None $ toRegexCI' "A A")++   ,testCase "recordmatcherp.starts-with-&" $+      parseWithState' defrules matcherp "& A A\n" @?= (Right $ RecordMatcher And $ toRegexCI' "A A")++   ,testCase "fieldmatcherp.starts-with-%" $+      parseWithState' defrules matcherp "description A A\n" @?= (Right $ RecordMatcher None $ toRegexCI' "description A A")++   ,testCase "fieldmatcherp" $+      parseWithState' defrules matcherp "%description A A\n" @?= (Right $ FieldMatcher None "%description" $ toRegexCI' "A A")++   ,testCase "fieldmatcherp.starts-with-&" $+      parseWithState' defrules matcherp "& %description A A\n" @?= (Right $ FieldMatcher And "%description" $ toRegexCI' "A A")++   -- ,testCase "fieldmatcherp with operator" $+   --    parseWithState' defrules matcherp "%description ~ A A\n" @?= (Right $ FieldMatcher "%description" "A A")++   ]++ ,testGroup "hledgerField" [+    let rules = mkrules $ defrules {rcsvfieldindexes=[("csvdate",1)],rassignments=[("date","%csvdate")]}++    in testCase "toplevel" $ hledgerField rules ["a","b"] "date" @?= (Just "%csvdate")++   ,let rules = mkrules $ defrules{rcsvfieldindexes=[("csvdate",1)], rconditionalblocks=[CB [FieldMatcher None "%csvdate" $ toRegex' "a"] [("date","%csvdate")]]}+    in testCase "conditional" $ hledgerField rules ["a","b"] "date" @?= (Just "%csvdate")++   ,let rules = mkrules $ defrules{rcsvfieldindexes=[("csvdate",1)], rconditionalblocks=[CB [FieldMatcher Not "%csvdate" $ toRegex' "a"] [("date","%csvdate")]]}+    in testCase "negated-conditional-false" $ hledgerField rules ["a","b"] "date" @?= (Nothing)+  +   ,let rules = mkrules $ defrules{rcsvfieldindexes=[("csvdate",1)], rconditionalblocks=[CB [FieldMatcher Not "%csvdate" $ toRegex' "b"] [("date","%csvdate")]]}+    in testCase "negated-conditional-true" $ hledgerField rules ["a","b"] "date" @?= (Just "%csvdate")++   ,let rules = mkrules $ defrules{rcsvfieldindexes=[("csvdate",1),("description",2)], rconditionalblocks=[CB [FieldMatcher None "%csvdate" $ toRegex' "a", FieldMatcher None "%description" $ toRegex' "b"] [("date","%csvdate")]]}+    in testCase "conditional-with-or-a" $ hledgerField rules ["a"] "date" @?= (Just "%csvdate")++   ,let rules = mkrules $ defrules{rcsvfieldindexes=[("csvdate",1),("description",2)], rconditionalblocks=[CB [FieldMatcher None "%csvdate" $ toRegex' "a", FieldMatcher None "%description" $ toRegex' "b"] [("date","%csvdate")]]}+    in testCase "conditional-with-or-b" $ hledgerField rules ["_", "b"] "date" @?= (Just "%csvdate")++   ,let rules = mkrules $ defrules{rcsvfieldindexes=[("csvdate",1),("description",2)], rconditionalblocks=[CB [FieldMatcher None "%csvdate" $ toRegex' "a", FieldMatcher And "%description" $ toRegex' "b"] [("date","%csvdate")]]}+    in testCase "conditional.with-and" $ hledgerField rules ["a", "b"] "date" @?= (Just "%csvdate")++   ,let rules = mkrules $ defrules{rcsvfieldindexes=[("csvdate",1),("description",2)], rconditionalblocks=[CB [FieldMatcher None "%csvdate" $ toRegex' "a", FieldMatcher And "%description" $ toRegex' "b", FieldMatcher None "%description" $ toRegex' "c"] [("date","%csvdate")]]}+    in testCase "conditional.with-and-or" $ hledgerField rules ["_", "c"] "date" @?= (Just "%csvdate")++   ]++ -- testing match groups (#2158)+ ,testGroup "hledgerFieldValue" $+    let rules = mkrules $ defrules+          { rcsvfieldindexes=[ ("date",1), ("description",2) ]+          , rassignments=[ ("account2","equity"), ("amount1","1") ]+          -- ConditionalBlocks here are in reverse order: mkrules reverses the list+          , rconditionalblocks=[ CB { cbMatchers=[FieldMatcher None "%description" (toRegex' "PREFIX (.*) - (.*)")] +                                    , cbAssignments=[("account1","account:\\1:\\2")] }+                               , CB { cbMatchers=[FieldMatcher None "%description" (toRegex' "PREFIX (.*)")]+                                    , cbAssignments=[("account1","account:\\1"), ("comment1","\\1")] }+                               ]+          }+        record = ["2019-02-01","PREFIX Text 1 - Text 2"]+    in [ testCase "scoped match groups forwards" $ hledgerFieldValue rules record "account1" @?= (Just "account:Text 1:Text 2")+       , testCase "scoped match groups backwards" $ hledgerFieldValue rules record "comment1" @?= (Just "Text 1 - Text 2")+       ]  ]

@@ -77,7 +77,7 @@  reader :: MonadIO m => Reader m reader = Reader-  {rFormat     = "timeclock"+  {rFormat     = Timeclock   ,rExtensions = ["timeclock"]   ,rReadFn     = parse   ,rParser    = timeclockfilep

@@ -66,7 +66,7 @@  reader :: MonadIO m => Reader m reader = Reader-  {rFormat     = "timedot"+  {rFormat     = Timedot   ,rExtensions = ["timedot"]   ,rReadFn     = parse   ,rParser    = timedotp

@@ -124,7 +124,7 @@         -- speed improvement by stripping them early. In some cases, such as in hledger-ui, we still         -- want to keep prices around, so we can toggle between cost and no cost quickly. We can use         -- the show_costs_ flag to be efficient when we can, and detailed when we have to.-          (if show_costs_ ropts then id else journalMapPostingAmounts mixedAmountStripPrices)+          (if show_costs_ ropts then id else journalMapPostingAmounts mixedAmountStripCosts)         . traceOrLogAtWith 5 (("ts3:\n"++).pshowTransactions.jtxns)         -- maybe convert these transactions to cost or value         . journalApplyValuationFromOpts rspec

@@ -26,7 +26,7 @@ import Data.Function (on) import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HM-import Data.List (find, partition, transpose, foldl', maximumBy)+import Data.List (find, partition, transpose, foldl', maximumBy, intercalate) import Data.List.Extra (nubSort) import Data.Maybe (fromMaybe, catMaybes, isJust) import Data.Map (Map)@@ -49,21 +49,40 @@ import Data.Ord (comparing) import Control.Monad ((>=>)) -+-- All MixedAmounts: type BudgetGoal    = Change type BudgetTotal   = Total type BudgetAverage = Average  -- | A budget report tracks expected and actual changes per account and subperiod.+-- Each table cell has an actual change amount and/or a budget goal amount. type BudgetCell = (Maybe Change, Maybe BudgetGoal)+-- | A row in a budget report table - account name and data cells. type BudgetReportRow = PeriodicReportRow DisplayName BudgetCell+-- | A full budget report table. type BudgetReport    = PeriodicReport    DisplayName BudgetCell +-- A BudgetCell's data values rendered for display - the actual change amount,+-- the budget goal amount if any, and the corresponding goal percentage if possible. type BudgetDisplayCell = (WideBuilder, Maybe (WideBuilder, Maybe WideBuilder))+-- | A row of rendered budget data cells. type BudgetDisplayRow  = [BudgetDisplayCell]-type BudgetShowMixed   = MixedAmount -> [WideBuilder]-type BudgetPercBudget  = Change -> BudgetGoal -> [Maybe Percentage] +-- | An amount render helper for the budget report. Renders each commodity separately.+type BudgetShowAmountsFn   = MixedAmount -> [WideBuilder]+-- | A goal percentage calculating helper for the budget report.+type BudgetCalcPercentagesFn  = Change -> BudgetGoal -> [Maybe Percentage]++_brrShowDebug :: BudgetReportRow -> String+_brrShowDebug (PeriodicReportRow dname budgetpairs _tot _avg) =+  unwords [+    T.unpack $ displayFull dname,+    "",+    intercalate " | "+      [ maybe "-" showMixedAmount mactual <> " [" <> maybe "-" showMixedAmount mgoal <> "]"+      | (mactual,mgoal) <- budgetpairs ]+    ]+ -- | Calculate per-account, per-period budget (balance change) goals -- from all periodic transactions, calculate actual balance changes -- from the regular transactions, and compare these to get a 'BudgetReport'.@@ -201,54 +220,62 @@ combineBudgetAndActual ropts j       (PeriodicReport budgetperiods budgetrows (PeriodicReportRow _ budgettots budgetgrandtot budgetgrandavg))       (PeriodicReport actualperiods actualrows (PeriodicReportRow _ actualtots actualgrandtot actualgrandavg)) =-    PeriodicReport periods sortedrows totalrow+    PeriodicReport periods combinedrows totalrow   where     periods = nubSort . filter (/= nulldatespan) $ budgetperiods ++ actualperiods      -- first, combine any corresponding budget goals with actual changes-    rows1 =-      [ PeriodicReportRow acct amtandgoals totamtandgoal avgamtandgoal+    actualsplusgoals = [+        -- dbg0With (("actualsplusgoals: "<>)._brrShowDebug) $+        PeriodicReportRow acct amtandgoals totamtandgoal avgamtandgoal       | PeriodicReportRow acct actualamts actualtot actualavg <- actualrows+       , let mbudgetgoals       = HM.lookup (displayFull acct) budgetGoalsByAcct :: Maybe ([BudgetGoal], BudgetTotal, BudgetAverage)       , let budgetmamts        = maybe (Nothing <$ periods) (map Just . first3) mbudgetgoals :: [Maybe BudgetGoal]       , let mbudgettot         = second3 <$> mbudgetgoals :: Maybe BudgetTotal       , let mbudgetavg         = third3 <$> mbudgetgoals  :: Maybe BudgetAverage-      , let acctBudgetByPeriod = Map.fromList [ (p,budgetamt) | (p, Just budgetamt) <- zip budgetperiods budgetmamts ] :: Map DateSpan BudgetGoal+      , let acctGoalByPeriod   = Map.fromList [ (p,budgetamt) | (p, Just budgetamt) <- zip budgetperiods budgetmamts ] :: Map DateSpan BudgetGoal       , let acctActualByPeriod = Map.fromList [ (p,actualamt) | (p, Just actualamt) <- zip actualperiods (map Just actualamts) ] :: Map DateSpan Change-      , let amtandgoals        = [ (Map.lookup p acctActualByPeriod, Map.lookup p acctBudgetByPeriod) | p <- periods ] :: [BudgetCell]+      , let amtandgoals        = [ (Map.lookup p acctActualByPeriod, Map.lookup p acctGoalByPeriod) | p <- periods ] :: [BudgetCell]       , let totamtandgoal      = (Just actualtot, mbudgettot)       , let avgamtandgoal      = (Just actualavg, mbudgetavg)       ]       where         budgetGoalsByAcct :: HashMap AccountName ([BudgetGoal], BudgetTotal, BudgetAverage) =           HM.fromList [ (displayFull acct, (amts, tot, avg))-                         | PeriodicReportRow acct amts tot avg <- budgetrows ]+                      | PeriodicReportRow acct amts tot avg <-+                          -- dbg0With (unlines.map (("budgetgoals: "<>).prrShowDebug)) $+                          budgetrows+                      ]      -- next, make rows for budget goals with no actual changes-    rows2 =-      [ PeriodicReportRow acct amtandgoals totamtandgoal avgamtandgoal+    othergoals = [+        -- dbg0With (("othergoals: "<>)._brrShowDebug) $+        PeriodicReportRow acct amtandgoals totamtandgoal avgamtandgoal       | PeriodicReportRow acct budgetgoals budgettot budgetavg <- budgetrows-      , displayFull acct `notElem` map prrFullName rows1-      , let acctBudgetByPeriod = Map.fromList $ zip budgetperiods budgetgoals :: Map DateSpan BudgetGoal-      , let amtandgoals        = [ (Nothing, Map.lookup p acctBudgetByPeriod) | p <- periods ] :: [BudgetCell]-      , let totamtandgoal      = (Nothing, Just budgettot)-      , let avgamtandgoal      = (Nothing, Just budgetavg)+      , displayFull acct `notElem` map prrFullName actualsplusgoals+      , let acctGoalByPeriod   = Map.fromList $ zip budgetperiods budgetgoals :: Map DateSpan BudgetGoal+      , let amtandgoals        = [ (Just 0, Map.lookup p acctGoalByPeriod) | p <- periods ] :: [BudgetCell]+      , let totamtandgoal      = (Just 0, Just budgettot)+      , let avgamtandgoal      = (Just 0, Just budgetavg)       ]      -- combine and re-sort rows     -- TODO: add --sort-budget to sort by budget goal amount-    sortedrows :: [BudgetReportRow] = sortRowsLike (mbrsorted unbudgetedrows ++ mbrsorted rows') rows+    combinedrows :: [BudgetReportRow] =+      -- map (dbg0With (("combinedrows: "<>)._brrShowDebug)) $+      sortRowsLike (mbrsorted unbudgetedrows ++ mbrsorted rows') rows       where         (unbudgetedrows, rows') = partition ((==unbudgetedAccountName) . prrFullName) rows         mbrsorted = map prrFullName . sortRows ropts j . map (fmap $ fromMaybe nullmixedamt . fst)-        rows = rows1 ++ rows2+        rows = actualsplusgoals ++ othergoals      totalrow = PeriodicReportRow ()-        [ (Map.lookup p totActualByPeriod, Map.lookup p totBudgetByPeriod) | p <- periods ]+        [ (Map.lookup p totActualByPeriod, Map.lookup p totGoalByPeriod) | p <- periods ]         ( Just actualgrandtot, budget budgetgrandtot )         ( Just actualgrandavg, budget budgetgrandavg )       where-        totBudgetByPeriod = Map.fromList $ zip budgetperiods budgettots :: Map DateSpan BudgetTotal+        totGoalByPeriod = Map.fromList $ zip budgetperiods budgettots :: Map DateSpan BudgetTotal         totActualByPeriod = Map.fromList $ zip actualperiods actualtots :: Map DateSpan Change         budget b = if mixedAmountLooksZero b then Nothing else Just b @@ -272,27 +299,17 @@  -- | Build a 'Table' from a multi-column balance report. budgetReportAsTable :: ReportOpts -> BudgetReport -> Tab.Table Text Text WideBuilder-budgetReportAsTable-  ReportOpts{..}-  (PeriodicReport spans items tr) =-    maybetransposetable $-    addtotalrow $+budgetReportAsTable ReportOpts{..} (PeriodicReport spans items totrow) =+  maybetransposetable $+  addtotalrow $     Tab.Table       (Tab.Group Tab.NoLine $ map Tab.Header accts)       (Tab.Group Tab.NoLine $ map Tab.Header colheadings)       rows   where-    colheadings = ["Commodity" | layout_ == LayoutBare]-                  ++ map (reportPeriodName balanceaccum_ spans) spans-                  ++ ["  Total" | row_total_]-                  ++ ["Average" | average_]--    -- FIXME. Have to check explicitly for which to render here, since-    -- budgetReport sets accountlistmode to ALTree. Find a principled way to do-    -- this.-    renderacct row = case accountlistmode_ of-        ALTree -> T.replicate ((prrDepth row - 1)*2) " " <> prrDisplayName row-        ALFlat -> accountNameDrop (drop_) $ prrFullName row+    maybetransposetable+      | transpose_ = \(Tab.Table rh ch vals) -> Tab.Table ch rh (transpose vals)+      | otherwise  = id      addtotalrow       | no_total_ = id@@ -300,154 +317,206 @@                         ch = Tab.Header [] -- ignored                      in (flip (Tab.concatTables Tab.SingleLine) $ Tab.Table rh ch totalrows) -    maybetranspose-      | transpose_ = transpose-      | otherwise  = id--    maybetransposetable-      | transpose_ = \(Tab.Table rh ch vals) -> Tab.Table ch rh (transpose vals)-      | otherwise  = id+    colheadings = ["Commodity" | layout_ == LayoutBare]+                  ++ map (reportPeriodName balanceaccum_ spans) spans+                  ++ ["  Total" | row_total_]+                  ++ ["Average" | average_] -    (accts, rows, totalrows) = (accts', prependcs itemscs (padcells texts), prependcs trcs (padtr trtexts))+    (accts, rows, totalrows) =+      (accts'+      ,maybecommcol itemscs  $ showcells  texts+      ,maybecommcol totrowcs $ showtotrow totrowtexts)       where-        shownitems :: [[(AccountName, WideBuilder, BudgetDisplayRow)]]-        shownitems = (fmap (\i -> fmap (\(cs, cvals) -> (renderacct i, cs, cvals)) . showrow $ rowToBudgetCells i) items)-        (accts', itemscs, texts) = unzip3 $ concat shownitems--        showntr    :: [[(WideBuilder, BudgetDisplayRow)]]-        showntr    = [showrow $ rowToBudgetCells tr]-        (trcs, trtexts)         = unzip  $ concat showntr-        trwidths-          | transpose_ = drop (length texts) widths-          | otherwise = widths--        padcells = maybetranspose . fmap (fmap (uncurry paddisplaycell) . zip widths)   . maybetranspose-        padtr    = maybetranspose . fmap (fmap (uncurry paddisplaycell) . zip trwidths) . maybetranspose--        -- with --layout=bare, begin with a commodity column-        prependcs cs+        -- If --layout=bare, prepend a commodities column.+        maybecommcol :: [WideBuilder] -> [[WideBuilder]] -> [[WideBuilder]]+        maybecommcol cs           | layout_ == LayoutBare = zipWith (:) cs           | otherwise             = id -    rowToBudgetCells (PeriodicReportRow _ as rowtot rowavg) = as-        ++ [rowtot | row_total_ && not (null as)]-        ++ [rowavg | average_   && not (null as)]+        showcells, showtotrow :: [[BudgetDisplayCell]] -> [[WideBuilder]]+        (showcells, showtotrow) =+          (maybetranspose . map (zipWith showBudgetDisplayCell widths)       . maybetranspose+          ,maybetranspose . map (zipWith showBudgetDisplayCell totrowwidths) . maybetranspose)+          where+            -- | Combine a BudgetDisplayCell's rendered values into a "[PERCENT of GOAL]" rendering,+            -- respecting the given widths.+            showBudgetDisplayCell :: (Int, Int, Int) -> BudgetDisplayCell -> WideBuilder+            showBudgetDisplayCell (actualwidth, budgetwidth, percentwidth) (actual, mbudget) =+              flip WideBuilder (actualwidth + totalbudgetwidth) $+                toPadded actual <> maybe emptycell showBudgetGoalAndPercentage mbudget -    -- functions for displaying budget cells depending on `commodity-layout_` option-    rowfuncs :: [CommoditySymbol] -> (BudgetShowMixed, BudgetPercBudget)-    rowfuncs cs = case layout_ of-      LayoutWide width ->-           ( pure . showMixedAmountB oneLine{displayMaxWidth=width, displayColour=color_}-           , \a -> pure . percentage a)-      _ -> ( showMixedAmountLinesB noCost{displayCommodity=layout_/=LayoutBare, displayCommodityOrder=Just cs, displayMinWidth=Nothing, displayColour=color_}-           , \a b -> fmap (percentage' a b) cs)+              where+                toPadded (WideBuilder b w) = (TB.fromText . flip T.replicate " " $ actualwidth - w) <> b -    showrow :: [BudgetCell] -> [(WideBuilder, BudgetDisplayRow)]-    showrow row =-      let cs = budgetCellsCommodities row-          (showmixed, percbudget) = rowfuncs cs-       in   zip (fmap wbFromText cs)-          . transpose-          . fmap (showcell showmixed percbudget)-          $ row+                (totalpercentwidth, totalbudgetwidth) =+                  let totalpercentwidth' = if percentwidth == 0 then 0 else percentwidth + 5+                   in ( totalpercentwidth'+                      , if budgetwidth == 0 then 0 else budgetwidth + totalpercentwidth' + 3+                      ) -    budgetCellsCommodities = S.toList . foldl' S.union mempty . fmap budgetCellCommodities-    budgetCellCommodities :: BudgetCell -> S.Set CommoditySymbol-    budgetCellCommodities (am, bm) = f am `S.union` f bm-      where f = maybe mempty maCommodities+                emptycell :: TB.Builder+                emptycell = TB.fromText $ T.replicate totalbudgetwidth " " -    cellswidth :: [BudgetCell] -> [[(Int, Int, Int)]]-    cellswidth row =-      let cs = budgetCellsCommodities row-          (showmixed, percbudget) = rowfuncs cs-          disp = showcell showmixed percbudget-          budgetpercwidth = wbWidth *** maybe 0 wbWidth-          cellwidth (am, bm) = let (bw, pw) = maybe (0, 0) budgetpercwidth bm in (wbWidth am, bw, pw)-       in fmap (fmap cellwidth . disp) row+                showBudgetGoalAndPercentage :: (WideBuilder, Maybe WideBuilder) -> TB.Builder+                showBudgetGoalAndPercentage (goal, perc) =+                  let perct = case perc of+                        Nothing  -> T.replicate totalpercentwidth " "+                        Just pct -> T.replicate (percentwidth - wbWidth pct) " " <> wbToText pct <> "% of "+                   in TB.fromText $ " [" <> perct <> T.replicate (budgetwidth - wbWidth goal) " " <> wbToText goal <> "]" -    -- build a list of widths for each column. In the case of transposed budget-    -- reports, the total 'row' must be included in this list-    widths = zip3 actualwidths budgetwidths percentwidths-      where-        actualwidths  = map (maximum' . map first3 ) $ cols-        budgetwidths  = map (maximum' . map second3) $ cols-        percentwidths = map (maximum' . map third3 ) $ cols-        catcolumnwidths = foldl' (zipWith (++)) $ repeat []-        cols = maybetranspose $ catcolumnwidths $ map (cellswidth . rowToBudgetCells) items ++ [cellswidth $ rowToBudgetCells tr]+            -- | Build a list of widths for each column.+            -- When --transpose is used, the totals row must be included in this list.+            widths :: [(Int, Int, Int)]+            widths = zip3 actualwidths budgetwidths percentwidths+              where+                actualwidths  = map (maximum' . map first3 ) $ cols+                budgetwidths  = map (maximum' . map second3) $ cols+                percentwidths = map (maximum' . map third3 ) $ cols+                catcolumnwidths = foldl' (zipWith (++)) $ repeat []+                cols = maybetranspose $ catcolumnwidths $ map (cellswidth . rowToBudgetCells) items ++ [cellswidth $ rowToBudgetCells totrow] -    -- split a BudgetCell into BudgetDisplayCell's (one per commodity when applicable)-    showcell :: BudgetShowMixed -> BudgetPercBudget -> BudgetCell -> BudgetDisplayRow-    showcell showmixed percbudget (actual, mbudget) = zip (showmixed actual') full-      where-        actual' = fromMaybe nullmixedamt actual+                cellswidth :: [BudgetCell] -> [[(Int, Int, Int)]]+                cellswidth row =+                  let cs = budgetCellsCommodities row+                      (showmixed, percbudget) = mkBudgetDisplayFns cs+                      disp = showcell showmixed percbudget+                      budgetpercwidth = wbWidth *** maybe 0 wbWidth+                      cellwidth (am, bm) = let (bw, pw) = maybe (0, 0) budgetpercwidth bm in (wbWidth am, bw, pw)+                   in map (map cellwidth . disp) row -        budgetAndPerc b = -          zip (showmixed b) (fmap (wbFromText . T.pack . show . roundTo 0) <$> percbudget actual' b)+            totrowwidths :: [(Int, Int, Int)]+            totrowwidths+              | transpose_ = drop (length texts) widths+              | otherwise = widths -        full-          | Just b <- mbudget = Just <$> budgetAndPerc b-          | otherwise         = repeat Nothing+            maybetranspose+              | transpose_ = transpose+              | otherwise  = id -    paddisplaycell :: (Int, Int, Int) -> BudgetDisplayCell -> WideBuilder-    paddisplaycell (actualwidth, budgetwidth, percentwidth) (actual, mbudget) = full-      where-        toPadded (WideBuilder b w) =-            (TB.fromText . flip T.replicate " " $ actualwidth - w) <> b+        (accts', itemscs, texts) = unzip3 $ concat shownitems+          where+            shownitems :: [[(AccountName, WideBuilder, BudgetDisplayRow)]]+            shownitems =+              map (\i ->+                let+                  addacctcolumn = map (\(cs, cvals) -> (renderacct i, cs, cvals))+                  isunbudgetedrow = displayFull (prrName i) == unbudgetedAccountName+                in addacctcolumn $ showrow isunbudgetedrow $ rowToBudgetCells i)+              items+              where+                -- FIXME. Have to check explicitly for which to render here, since+                -- budgetReport sets accountlistmode to ALTree. Find a principled way to do+                -- this.+                renderacct row = case accountlistmode_ of+                  ALTree -> T.replicate ((prrDepth row - 1)*2) " " <> prrDisplayName row+                  ALFlat -> accountNameDrop (drop_) $ prrFullName row -        (totalpercentwidth, totalbudgetwidth) =-          let totalpercentwidth' = if percentwidth == 0 then 0 else percentwidth + 5-           in ( totalpercentwidth'-              , if budgetwidth == 0 then 0 else budgetwidth + totalpercentwidth' + 3-              )+        (totrowcs, totrowtexts)  = unzip  $ concat showntotrow+          where+            showntotrow :: [[(WideBuilder, BudgetDisplayRow)]]+            showntotrow = [showrow False $ rowToBudgetCells totrow] -        -- | Display a padded budget string-        budgetb (budget, perc) =-          let perct = case perc of-                Nothing  -> T.replicate totalpercentwidth " "-                Just pct -> T.replicate (percentwidth - wbWidth pct) " " <> wbToText pct <> "% of "-           in TB.fromText $ " [" <> perct <> T.replicate (budgetwidth - wbWidth budget) " " <> wbToText budget <> "]"+        -- | Get the data cells from a row or totals row, maybe adding +        -- the row total and/or row average depending on options.+        rowToBudgetCells :: PeriodicReportRow a BudgetCell -> [BudgetCell]+        rowToBudgetCells (PeriodicReportRow _ as rowtot rowavg) = as+            ++ [rowtot | row_total_ && not (null as)]+            ++ [rowavg | average_   && not (null as)] -        emptyBudget = TB.fromText $ T.replicate totalbudgetwidth " "+        -- | Render a row's data cells as "BudgetDisplayCell"s, and a rendered list of commodity symbols.+        -- Also requires a flag indicating whether this is the special <unbudgeted> row.+        -- (The types make that hard to check here.)+        showrow :: Bool -> [BudgetCell] -> [(WideBuilder, BudgetDisplayRow)]+        showrow isunbudgetedrow cells =+          let+            cs = budgetCellsCommodities cells+            -- #2071 If there are no commodities - because there are no actual or goal amounts -+            -- the zipped list would be empty, causing this row not to be shown.+            -- But rows like this sometimes need to be shown to preserve the account tree structure.+            -- So, ensure 0 will be shown as actual amount(s).+            -- Unfortunately this disables boring parent eliding, as if --no-elide had been used.+            -- (Just turning on --no-elide higher up doesn't work right.)+            -- Note, no goal amount will be shown for these rows,+            -- whereas --no-elide is likely to show a goal amount aggregated from children.+            cs1 = if null cs && not isunbudgetedrow then [""] else cs+            (showmixed, percbudget) = mkBudgetDisplayFns cs1+          in+            zip (map wbFromText cs1) $+            transpose $+            map (showcell showmixed percbudget)+            cells -        full = flip WideBuilder (actualwidth + totalbudgetwidth) $-            toPadded actual <> maybe emptyBudget budgetb mbudget+        budgetCellsCommodities :: [BudgetCell] -> [CommoditySymbol]+        budgetCellsCommodities = S.toList . foldl' S.union mempty . map budgetCellCommodities+          where+            budgetCellCommodities :: BudgetCell -> S.Set CommoditySymbol+            budgetCellCommodities (am, bm) = f am `S.union` f bm+              where f = maybe mempty maCommodities -    -- | Calculate the percentage of actual change to budget goal to show, if any.-    -- If valuing at cost, both amounts are converted to cost before comparing.-    -- A percentage will not be shown if:-    -- - actual or goal are not the same, single, commodity-    -- - the goal is zero-    percentage :: Change -> BudgetGoal -> Maybe Percentage-    percentage actual budget =-      case (costedAmounts actual, costedAmounts budget) of-        ([a], [b]) | (acommodity a == acommodity b || amountLooksZero a) && not (amountLooksZero b)-            -> Just $ 100 * aquantity a / aquantity b-        _   -> -- trace (pshow $ (maybecost actual, maybecost budget))  -- debug missing percentage-               Nothing-      where-        costedAmounts = case conversionop_ of-            Just ToCost -> amounts . mixedAmountCost-            _           -> amounts+        -- | Render a "BudgetCell"'s amounts as "BudgetDisplayCell"s (one per commodity).+        showcell :: BudgetShowAmountsFn -> BudgetCalcPercentagesFn -> BudgetCell -> BudgetDisplayRow+        showcell showCommodityAmounts calcCommodityPercentages (mactual, mbudget) =+          zip actualamts budgetinfos+          where+            actual = fromMaybe nullmixedamt mactual+            actualamts = showCommodityAmounts actual+            budgetinfos =+              case mbudget of+                Nothing   -> repeat Nothing+                Just goal -> map Just $ showGoalAmountsAndPercentages goal+                where+                  showGoalAmountsAndPercentages :: MixedAmount -> [(WideBuilder, Maybe WideBuilder)]+                  showGoalAmountsAndPercentages goal = zip amts mpcts+                    where+                      amts  = showCommodityAmounts goal+                      mpcts = map (showrounded <$>) $ calcCommodityPercentages actual goal+                        where showrounded = wbFromText . T.pack . show . roundTo 0 -    -- | Calculate the percentage of actual change to budget goal for a particular commodity-    percentage' :: Change -> BudgetGoal -> CommoditySymbol -> Maybe Percentage-    percentage' am bm c = case ((,) `on` find ((==) c . acommodity) . amounts) am bm of-        (Just a, Just b) -> percentage (mixedAmount a) (mixedAmount b)-        _                -> Nothing+        -- | Make budget info display helpers that adapt to --layout=wide.+        mkBudgetDisplayFns :: [CommoditySymbol] -> (BudgetShowAmountsFn, BudgetCalcPercentagesFn)+        mkBudgetDisplayFns cs = case layout_ of+          LayoutWide width ->+               ( pure . showMixedAmountB oneLineNoCostFmt{displayMaxWidth=width, displayColour=color_}+               , \a -> pure . percentage a)+          _ -> ( showMixedAmountLinesB noCostFmt{displayCommodity=layout_/=LayoutBare, displayCommodityOrder=Just cs, displayMinWidth=Nothing, displayColour=color_}+               , \a b -> map (percentage' a b) cs)+          where+            -- | Calculate the percentage of actual change to budget goal to show, if any.+            -- If valuing at cost, both amounts are converted to cost before comparing.+            -- A percentage will not be shown if:+            --+            -- - actual or goal are not the same, single, commodity+            --+            -- - the goal is zero+            --+            percentage :: Change -> BudgetGoal -> Maybe Percentage+            percentage actual budget =+              case (costedAmounts actual, costedAmounts budget) of+                ([a], [b]) | (acommodity a == acommodity b || amountLooksZero a) && not (amountLooksZero b)+                    -> Just $ 100 * aquantity a / aquantity b+                _   -> Nothing+              where+                costedAmounts = case conversionop_ of+                    Just ToCost -> amounts . mixedAmountCost+                    _           -> amounts +            -- | Like percentage, but accept multicommodity actual and budget amounts,+            -- and extract the specified commodity from both.+            percentage' :: Change -> BudgetGoal -> CommoditySymbol -> Maybe Percentage+            percentage' am bm c = case ((,) `on` find ((==) c . acommodity) . amounts) am bm of+                (Just a, Just b) -> percentage (mixedAmount a) (mixedAmount b)+                _                -> Nothing+ -- XXX generalise this with multiBalanceReportAsCsv ? -- | Render a budget report as CSV. Like multiBalanceReportAsCsv, -- but includes alternating actual and budget amount columns. budgetReportAsCsv :: ReportOpts -> BudgetReport -> [[Text]] budgetReportAsCsv   ReportOpts{..}-  (PeriodicReport colspans items tr)+  (PeriodicReport colspans items totrow)   = (if transpose_ then transpose else id) $    -- heading row-  --  -- heading row   ("Account" :   ["Commodity" | layout_ == LayoutBare ]    ++ concatMap (\spn -> [showDateSpan spn, "budget"]) colspans@@ -456,36 +525,33 @@   ) :    -- account rows-  --  -- account rows   concatMap (rowAsTexts prrFullName) items    -- totals row-  ++ concat [ rowAsTexts (const "Total:") tr | not no_total_ ]+  ++ concat [ rowAsTexts (const "Total:") totrow | not no_total_ ]    where     flattentuples tups = concat [[a,b] | (a,b) <- tups]-    showNorm = maybe "" (wbToText . showMixedAmountB oneLine)+    showNorm = maybe "" (wbToText . showMixedAmountB oneLineNoCostFmt)      rowAsTexts :: (PeriodicReportRow a BudgetCell -> Text)                -> PeriodicReportRow a BudgetCell                -> [[Text]]     rowAsTexts render row@(PeriodicReportRow _ as (rowtot,budgettot) (rowavg, budgetavg))-      | layout_ /= LayoutBare = [render row : fmap showNorm vals]+      | layout_ /= LayoutBare = [render row : map showNorm vals]       | otherwise =             joinNames . zipWith (:) cs  -- add symbols and names           . transpose                   -- each row becomes a list of Text quantities-          . fmap (fmap wbToText . showMixedAmountLinesB dopts . fromMaybe nullmixedamt)+          . map (map wbToText . showMixedAmountLinesB dopts . fromMaybe nullmixedamt)           $ vals       where-        cs = S.toList . foldl' S.union mempty . fmap maCommodities $ catMaybes vals-        dopts = oneLine{displayCommodity=layout_ /= LayoutBare, displayCommodityOrder=Just cs, displayMinWidth=Nothing}+        cs = S.toList . foldl' S.union mempty . map maCommodities $ catMaybes vals+        dopts = oneLineNoCostFmt{displayCommodity=layout_ /= LayoutBare, displayCommodityOrder=Just cs, displayMinWidth=Nothing}         vals = flattentuples as             ++ concat [[rowtot, budgettot] | row_total_]             ++ concat [[rowavg, budgetavg] | average_] -        joinNames = fmap (render row :)+        joinNames = map (render row :)  -- tests