hledger-lib 1.20.4 → 1.21

raw patch · 50 files changed

+1857/−11670 lines, 50 filesdep −splitPVP ok

version bump matches the API change (PVP)

Dependencies removed: split

API changes (from Hackage documentation)

Files

• CHANGES.md +91/−0
• Hledger/Data/Account.hs +4/−4
• Hledger/Data/AccountName.hs +7/−7
• Hledger/Data/Amount.hs +283/−231
• Hledger/Data/Dates.hs +8/−8
• Hledger/Data/Journal.hs +220/−100
• Hledger/Data/Json.hs +3/−2
• Hledger/Data/Period.hs +15/−9
• Hledger/Data/PeriodicTransaction.hs +3/−2
• Hledger/Data/Posting.hs +27/−35
• Hledger/Data/StringFormat.hs +43/−48
• Hledger/Data/Timeclock.hs +13/−8
• Hledger/Data/Transaction.hs +135/−98
• Hledger/Data/TransactionModifier.hs +6/−5
• Hledger/Data/Types.hs +31/−13
• Hledger/Data/Valuation.hs +51/−42
• Hledger/Query.hs +55/−26
• Hledger/Read.hs +17/−13
• Hledger/Read/Common.hs +52/−18
• Hledger/Read/CsvReader.hs +175/−159
• Hledger/Read/JournalReader.hs +29/−3
• Hledger/Read/TimedotReader.hs +1/−1
• Hledger/Reports/AccountTransactionsReport.hs +11/−20
• Hledger/Reports/BudgetReport.hs +47/−44
• Hledger/Reports/EntriesReport.hs +2/−6
• Hledger/Reports/MultiBalanceReport.hs +96/−120
• Hledger/Reports/PostingsReport.hs +26/−57
• Hledger/Reports/ReportOptions.hs +117/−66
• Hledger/Reports/ReportTypes.hs +6/−5
• Hledger/Reports/TransactionsReport.hs +9/−15
• Hledger/Utils/Color.hs +18/−0
• Hledger/Utils/Debug.hs +20/−3
• Hledger/Utils/Regex.hs +27/−13
• Hledger/Utils/String.hs +15/−11
• Hledger/Utils/Text.hs +60/−46
• Text/Tabular/AsciiWide.hs +96/−78
• Text/WideString.hs +36/−1
• hledger-lib.cabal +2/−17
• hledger_csv.5 +0/−1300
• hledger_csv.info +0/−1352
• hledger_csv.txt +0/−962
• hledger_journal.5 +0/−2153
• hledger_journal.info +0/−2217
• hledger_journal.txt +0/−1597
• hledger_timeclock.5 +0/−90
• hledger_timeclock.info +0/−67
• hledger_timeclock.txt +0/−80
• hledger_timedot.5 +0/−199
• hledger_timedot.info +0/−156
• hledger_timedot.txt +0/−163

@@ -1,6 +1,97 @@ Internal/api/developer-ish changes in the hledger-lib (and hledger) packages. For user-visible changes, see the hledger package changelog. +# 1.21 2021-03-10++- Building Hledger.Data.Journal no longer fails if the monad-extras+  package is installed.++- Many parts of the hledger-lib and hledger APIs have become more+  Text-ified, expecting or returning Text instead of String, reducing+  hledger's time and resident memory requirements by roughly 10%.+  Some functions now use WideBuilder (a text "builder" which keeps track+  of width), to concatenate text more efficiently. There are some+  helpers for converting to and from WideBuilder (wbUnpack, wbToText..)+  showAmountB/showMixedAmountB are new amount-displaying functions+  taking an AmountDisplayOpts. These will probably replace the old+  show(Mixed)Amount* functions. (#1427, Stephen Morgan)++- AtThen valuation is now implemented for all report types.+  amountApplyValuation now takes the posting date as an argument.+  (transaction/posting)ApplyValuation's valuation type and+  transaction/posting arguments have been reordered like+  amountApplyValuation's. (Stephen Morgan)++- Amount, AmountPrice, AmountStyle, DigitGroupStyle fields are now+  strict. (Stephen Morgan)++- Amount prices are now stored with their sign, so negative prices can+  be represented. (They seem to have always worked, but now the+  internal representation is more accurate.) (Stephen Morgan)+ +- normaliseMixedAmount now combines Amounts with TotalPrices in the+  same commodity. (Stephen Morgan)++- normaliseMixedAmount now uses a strict Map for combining amounts+  internally, closing a big space leak. (Stephen Morgan)++- (multiply|divide)(Mixed)?Amount now also multiply or divide the+  TotalPrice if it is present, and the old+  (multiply|divide)(Mixed)?AmountAndPrice functions are removed. (Stephen Morgan)++- (amount|mixedAmount)(Looks|Is)Zero functions now check whether both+  the quantity and the cost are zero. This is usually what you want,+  but if you do only want to check whether the quantity is zero, you+  can run mixedAmountStripPrices (or similar) before this. (Stephen Morgan)++- commodityStylesFromAmounts now consumes the list immediately,+  reducing the maximum heap size per thread from ~850K to ~430K in a+  real-world register report. (Stephen Morgan)++- *ApplyValuation functions take two less arguments, and+  *ApplyCostValuation functions have been added, performing both+  costing and valuation. (Stephen Morgan)++- traceAtWith now has a level argument and works properly.++- API changes include:+  ```+  Hledger.Data.Amount:+   setAmountPrecision -> amountSetPrecision+   setFullPrecision -> amountSetFullPrecision+   setMixedAmountPrecision -> mixedAmountSetPrecision+   showMixed -> showMixedAmountB+   showMixedLines -> showMixedAmountLinesB+  -mixedAmountSetFullPrecision++  Hledger.Data.Journal:+   mapJournalTransactions -> journalMapTransactions+   mapJournalPostings -> journalMapPostings+  -mapTransactionPostings+  +journalPayeesUsed+  +journalPayeesDeclaredOrUsed++  Hledger.Data.Transaction:+  +transactionFile+  +transactionMapPostings++  Hledger.Data.Valuation:+  -valuationTypeIsCost+  -valuationTypeIsDefaultValue+  -ValuationType's AtDefault constructor++  Hledger.Query:+  +matchesDescription+  +matchesPayeeWIP++  Hledger.Utils.Text:+  +textConcatBottomPadded+  +wbToText+  +wbUnpack++  Text.Tabular.AsciiWide:+   alignCell -> textCell+  ``` # 1.20.4 2021-01-29  - See hledger.

@@ -30,8 +30,8 @@                        aname                        (if aboring then "y" else "n" :: String)                        anumpostings-                       (showMixedAmount aebalance)-                       (showMixedAmount aibalance)+                       (wbUnpack $ showMixedAmountB noColour aebalance)+                       (wbUnpack $ showMixedAmountB noColour aibalance)  instance Eq Account where   (==) a b = aname a == aname b -- quick equality test for speed@@ -265,6 +265,6 @@  showAccountDebug a = printf "%-25s %4s %4s %s"                      (aname a)-                     (showMixedAmount $ aebalance a)-                     (showMixedAmount $ aibalance a)+                     (wbUnpack . showMixedAmountB noColour $ aebalance a)+                     (wbUnpack . showMixedAmountB noColour $ aibalance a)                      (if aboring a then "b" else " " :: String)

@@ -208,31 +208,31 @@ clipOrEllipsifyAccountName n        = clipAccountName n  -- | Escape an AccountName for use within a regular expression.--- >>> putStr $ escapeName "First?!#$*?$(*) !@^#*? %)*!@#"+-- >>> putStr . T.unpack $ escapeName "First?!#$*?$(*) !@^#*? %)*!@#" -- First\?!#\$\*\?\$\(\*\) !@\^#\*\? %\)\*!@#-escapeName :: AccountName -> String-escapeName = T.unpack . T.concatMap escapeChar+escapeName :: AccountName -> Text+escapeName = T.concatMap escapeChar   where     escapeChar c = if c `elem` escapedChars then T.snoc "\\" c else T.singleton c     escapedChars = ['[', '?', '+', '|', '(', ')', '*', '$', '^', '\\']  -- | Convert an account name to a regular expression matching it and its subaccounts. accountNameToAccountRegex :: AccountName -> Regexp-accountNameToAccountRegex a = toRegex' $ '^' : escapeName a ++ "(:|$)"  -- PARTIAL: Is this safe after escapeName?+accountNameToAccountRegex a = toRegex' $ "^" <> escapeName a <> "(:|$)"  -- PARTIAL: Is this safe after escapeName?  -- | Convert an account name to a regular expression matching it and its subaccounts, -- case insensitively. accountNameToAccountRegexCI :: AccountName -> Regexp-accountNameToAccountRegexCI a = toRegexCI' $ '^' : escapeName a ++ "(:|$)"  -- PARTIAL: Is this safe after escapeName?+accountNameToAccountRegexCI a = toRegexCI' $ "^" <> escapeName a <> "(:|$)"  -- PARTIAL: Is this safe after escapeName?  -- | Convert an account name to a regular expression matching it but not its subaccounts. accountNameToAccountOnlyRegex :: AccountName -> Regexp-accountNameToAccountOnlyRegex a = toRegex' $ '^' : escapeName a ++ "$" -- PARTIAL: Is this safe after escapeName?+accountNameToAccountOnlyRegex a = toRegex' $ "^" <> escapeName a <> "$" -- PARTIAL: Is this safe after escapeName?  -- | Convert an account name to a regular expression matching it but not its subaccounts, -- case insensitively. accountNameToAccountOnlyRegexCI :: AccountName -> Regexp-accountNameToAccountOnlyRegexCI a = toRegexCI' $ '^' : escapeName a ++ "$" -- PARTIAL: Is this safe after escapeName?+accountNameToAccountOnlyRegexCI a = toRegexCI' $ "^" <> escapeName a <> "$" -- PARTIAL: Is this safe after escapeName?  -- -- | Does this string look like an exact account-matching regular expression ? --isAccountRegex  :: String -> Bool

@@ -40,7 +40,11 @@  -} -{-# LANGUAGE StandaloneDeriving, RecordWildCards, OverloadedStrings #-}+{-# LANGUAGE BangPatterns       #-}+{-# LANGUAGE CPP                #-}+{-# LANGUAGE OverloadedStrings  #-}+{-# LANGUAGE RecordWildCards    #-}+{-# LANGUAGE StandaloneDeriving #-}  module Hledger.Data.Amount (   -- * Amount@@ -62,22 +66,25 @@   amountLooksZero,   divideAmount,   multiplyAmount,-  divideAmountAndPrice,-  multiplyAmountAndPrice,   amountTotalPriceToUnitPrice,   -- ** rendering+  AmountDisplayOpts(..),+  noColour,+  noPrice,+  oneLine,   amountstyle,   styleAmount,   styleAmountExceptPrecision,   amountUnstyled,+  showAmountB,   showAmount,   cshowAmount,   showAmountWithZeroCommodity,   showAmountDebug,   showAmountWithoutPrice,-  setAmountPrecision,+  amountSetPrecision,   withPrecision,-  setFullPrecision,+  amountSetFullPrecision,   setAmountInternalPrecision,   withInternalPrecision,   setAmountDecimalPoint,@@ -99,8 +106,6 @@   mixedAmountCost,   divideMixedAmount,   multiplyMixedAmount,-  divideMixedAmountAndPrice,-  multiplyMixedAmountAndPrice,   averageMixedAmounts,   isNegativeAmount,   isNegativeMixedAmount,@@ -117,12 +122,12 @@   showMixedAmountOneLineWithoutPrice,   showMixedAmountElided,   showMixedAmountWithZeroCommodity,-  showMixedAmountWithPrecision,-  showMixed,-  showMixedUnnormalised,-  showMixedOneLine,-  showMixedOneLineUnnormalised,-  setMixedAmountPrecision,+  showMixedAmountB,+  showMixedAmountLinesB,+  wbToText,+  wbUnpack,+  mixedAmountSetPrecision,+  mixedAmountSetFullPrecision,   canonicaliseMixedAmount,   -- * misc.   ltraceamount,@@ -130,17 +135,20 @@ ) where  import Control.Monad (foldM)-import Data.Char (isDigit)-import Data.Decimal (decimalPlaces, normalizeDecimal, roundTo)-import Data.Function (on)-import Data.List (genericSplitAt, groupBy, intercalate, mapAccumL,-                  partition, sortBy)-import qualified Data.Map as M-import Data.Map (findWithDefault)+import Data.Decimal (DecimalRaw(..), decimalPlaces, normalizeDecimal, roundTo)+import Data.Default (Default(..))+import Data.Foldable (toList)+import Data.List (intercalate, intersperse, mapAccumL, partition)+import Data.List.NonEmpty (NonEmpty(..), nonEmpty)+import qualified Data.Map.Strict as M import Data.Maybe (fromMaybe)+#if !(MIN_VERSION_base(4,11,0))+import Data.Semigroup ((<>))+#endif import qualified Data.Text as T+import qualified Data.Text.Lazy.Builder as TB import Data.Word (Word8)-import Safe (lastDef, lastMay)+import Safe (headDef, lastDef, lastMay) import Text.Printf (printf)  import Hledger.Data.Types@@ -150,13 +158,45 @@ deriving instance Show MarketPrice  +-- | Options for the display of Amount and MixedAmount.+data AmountDisplayOpts = AmountDisplayOpts+  { displayPrice         :: Bool       -- ^ Whether to display the Price of an Amount.+  , displayZeroCommodity :: Bool       -- ^ If the Amount rounds to 0, whether to display its commodity string.+  , displayColour        :: Bool       -- ^ Whether to colourise negative Amounts.+  , displayNormalised    :: Bool       -- ^ Whether to normalise MixedAmounts before displaying.+  , displayOneLine       :: Bool       -- ^ Whether to display on one line.+  , displayMinWidth      :: Maybe Int  -- ^ Minimum width to pad to+  , displayMaxWidth      :: Maybe Int  -- ^ Maximum width to clip to+  } deriving (Show)++-- | Display Amount and MixedAmount with no colour.+instance Default AmountDisplayOpts where def = noColour++-- | Display Amount and MixedAmount with no colour.+noColour :: AmountDisplayOpts+noColour = AmountDisplayOpts { displayPrice         = True+                             , displayColour        = False+                             , displayZeroCommodity = False+                             , displayNormalised    = True+                             , displayOneLine       = False+                             , displayMinWidth      = Nothing+                             , displayMaxWidth      = Nothing+                             }++-- | Display Amount and MixedAmount with no prices.+noPrice :: AmountDisplayOpts+noPrice = def{displayPrice=False}++-- | Display Amount and MixedAmount on one line with no prices.+oneLine :: AmountDisplayOpts+oneLine = def{displayOneLine=True, displayPrice=False}+ ------------------------------------------------------------------------------- -- Amount styles  -- | Default amount style amountstyle = AmountStyle L False (Precision 0) (Just '.') Nothing - ------------------------------------------------------------------------------- -- Amount @@ -164,7 +204,7 @@     abs a@Amount{aquantity=q}    = a{aquantity=abs q}     signum a@Amount{aquantity=q} = a{aquantity=signum q}     fromInteger i                = nullamt{aquantity=fromInteger i}-    negate a@Amount{aquantity=q} = a{aquantity= -q}+    negate a                     = transformAmount negate a     (+)                          = similarAmountsOp (+)     (-)                          = similarAmountsOp (-)     (*)                          = similarAmountsOp (*)@@ -197,8 +237,8 @@ -- Prices 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}}-                    Amount{acommodity=c2, aquantity=q2, astyle=s2@AmountStyle{asprecision=p2}} =+similarAmountsOp op !Amount{acommodity=_,  aquantity=q1, astyle=AmountStyle{asprecision=p1}}+                    !Amount{acommodity=c2, aquantity=q2, astyle=s2@AmountStyle{asprecision=p2}} =    -- trace ("a1:"++showAmountDebug a1) $ trace ("a2:"++showAmountDebug a2) $ traceWith (("= :"++).showAmountDebug)    amount{acommodity=c2, aquantity=q1 `op` q2, astyle=s2{asprecision=max p1 p2}}   --  c1==c2 || q1==0 || q2==0 =@@ -215,14 +255,14 @@ -- - price amounts must be MixedAmounts with exactly one component Amount --   (or there will be a runtime error XXX) ----- - price amounts should be positive+-- - price amounts should be positive in the Journal --   (though this is currently not enforced) amountCost :: Amount -> Amount amountCost a@Amount{aquantity=q, aprice=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 * signum q}+      Just (TotalPrice p@Amount{aquantity=pq}) -> p{aquantity=pq}  -- | Replace an amount's TotalPrice, if it has one, with an equivalent UnitPrice. -- Has no effect on amounts without one.@@ -240,29 +280,20 @@                 Precision p      -> Precision $ if p == maxBound then maxBound else p + 1 amountTotalPriceToUnitPrice a = a --- | Divide an amount's quantity by a constant.-divideAmount :: Quantity -> Amount -> Amount-divideAmount n a@Amount{aquantity=q} = a{aquantity=q/n}---- | Multiply an amount's quantity by a constant.-multiplyAmount :: Quantity -> Amount -> Amount-multiplyAmount n a@Amount{aquantity=q} = a{aquantity=q*n}+-- | Apply a function to an amount's quantity (and its total price, if it has one).+transformAmount :: (Quantity -> Quantity) -> Amount -> Amount+transformAmount f a@Amount{aquantity=q,aprice=p} = a{aquantity=f q, aprice=f' <$> p}+  where+    f' (TotalPrice a@Amount{aquantity=pq}) = TotalPrice a{aquantity = f pq}+    f' p = p  -- | Divide an amount's quantity (and its total price, if it has one) by a constant.--- The total price will be kept positive regardless of the multiplier's sign.-divideAmountAndPrice :: Quantity -> Amount -> Amount-divideAmountAndPrice n a@Amount{aquantity=q,aprice=p} = a{aquantity=q/n, aprice=f <$> p}-  where-    f (TotalPrice a) = TotalPrice $ abs $ n `divideAmount` a-    f p = p+divideAmount :: Quantity -> Amount -> Amount+divideAmount n = transformAmount (/n)  -- | Multiply an amount's quantity (and its total price, if it has one) by a constant.--- The total price will be kept positive regardless of the multiplier's sign.-multiplyAmountAndPrice :: Quantity -> Amount -> Amount-multiplyAmountAndPrice n a@Amount{aquantity=q,aprice=p} = a{aquantity=q*n, aprice=f <$> p}-  where-    f (TotalPrice a) = TotalPrice $ abs $ n `multiplyAmount` a-    f p = p+multiplyAmount :: Quantity -> Amount -> Amount+multiplyAmount n = transformAmount (*n)  -- | Is this amount negative ? The price is ignored. isNegativeAmount :: Amount -> Bool@@ -275,28 +306,34 @@     NaturalPrecision -> q     Precision p'     -> roundTo p' q --- | Does mixed amount appear to be zero when rendered with its+-- | 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+    _                       -> f amt++-- | Do this Amount and (and its total price, if it has one) appear to be zero when rendered with its -- display precision ? amountLooksZero :: Amount -> Bool-amountLooksZero = (0==) . amountRoundedQuantity+amountLooksZero = testAmountAndTotalPrice ((0==) . amountRoundedQuantity) --- | Is this amount exactly zero, ignoring its display precision ?+-- | Is this Amount (and its total price, if it has one) exactly zero, ignoring its display precision ? amountIsZero :: Amount -> Bool-amountIsZero Amount{aquantity=q} = q == 0+amountIsZero = testAmountAndTotalPrice ((0==) . aquantity)  -- | Set an amount's display precision, flipped. withPrecision :: Amount -> AmountPrecision -> Amount-withPrecision = flip setAmountPrecision+withPrecision = flip amountSetPrecision  -- | Set an amount's display precision.-setAmountPrecision :: AmountPrecision -> Amount -> Amount-setAmountPrecision p a@Amount{astyle=s} = a{astyle=s{asprecision=p}}+amountSetPrecision :: AmountPrecision -> Amount -> Amount+amountSetPrecision p a@Amount{astyle=s} = a{astyle=s{asprecision=p}}  -- | Increase an amount's display precision, if needed, to enough decimal places -- to show it exactly (showing all significant decimal digits, excluding trailing -- zeros).-setFullPrecision :: Amount -> Amount-setFullPrecision a = setAmountPrecision p a+amountSetFullPrecision :: Amount -> Amount+amountSetFullPrecision a = amountSetPrecision p a   where     p                = max displayprecision naturalprecision     displayprecision = asprecision $ astyle a@@ -327,10 +364,12 @@ withDecimalPoint :: Amount -> Maybe Char -> Amount withDecimalPoint = flip setAmountDecimalPoint -showAmountPrice :: Maybe AmountPrice -> String-showAmountPrice Nothing                = ""-showAmountPrice (Just (UnitPrice pa))  = " @ "  ++ showAmount pa-showAmountPrice (Just (TotalPrice pa)) = " @@ " ++ showAmount pa+showAmountPrice :: Amount -> WideBuilder+showAmountPrice amt = case aprice amt of+    Nothing              -> mempty+    Just (UnitPrice  pa) -> WideBuilder (TB.fromString " @ ")  3 <> showAmountB noColour pa+    Just (TotalPrice pa) -> WideBuilder (TB.fromString " @@ ") 4 <> showAmountB noColour (sign pa)+  where sign = if aquantity amt < 0 then negate else id  showAmountPriceDebug :: Maybe AmountPrice -> String showAmountPriceDebug Nothing                = ""@@ -361,40 +400,49 @@ -- 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 showAmount :: Amount -> String-showAmount = showAmountHelper False+showAmount = wbUnpack . showAmountB noColour +-- | General function to generate a WideBuilder for an Amount, according the+-- supplied AmountDisplayOpts. The special "missing" amount is displayed as+-- the empty string. 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.+showAmountB :: AmountDisplayOpts -> Amount -> WideBuilder+showAmountB _ Amount{acommodity="AUTO"} = mempty+showAmountB opts a@Amount{astyle=style} =+    color $ case ascommodityside style of+      L -> c' <> space <> quantity' <> price+      R -> quantity' <> space <> c' <> price+  where+    quantity = showamountquantity a+    (quantity',c) | amountLooksZero a && not (displayZeroCommodity opts) = (WideBuilder (TB.singleton '0') 1,"")+                  | otherwise = (quantity, quoteCommoditySymbolIfNeeded $ acommodity a)+    space = if not (T.null c) && ascommodityspaced style then WideBuilder (TB.singleton ' ') 1 else mempty+    c' = WideBuilder (TB.fromText c) (textWidth c)+    price = if displayPrice opts then showAmountPrice a else mempty+    color = if displayColour opts && isNegativeAmount a then colorB Dull Red else id+ -- | Colour version. For a negative amount, adds ANSI codes to change the colour, -- currently to hard-coded red.+--+-- > cshowAmount = wbUnpack . showAmountB def{displayColour=True} cshowAmount :: Amount -> String-cshowAmount a = (if isNegativeAmount a then color Dull Red else id) $-                showAmountHelper False a+cshowAmount = wbUnpack . showAmountB def{displayColour=True}  -- | Get the string representation of an amount, without any \@ price.+--+-- > showAmountWithoutPrice = wbUnpack . showAmountB noPrice showAmountWithoutPrice :: Amount -> String-showAmountWithoutPrice a = showAmount a{aprice=Nothing}---- | Get the string representation of an amount, based on its commodity's--- display settings except using the specified precision.-showAmountWithPrecision :: AmountPrecision -> Amount -> String-showAmountWithPrecision p = showAmount . setAmountPrecision p--showAmountHelper :: Bool -> Amount -> String-showAmountHelper _ Amount{acommodity="AUTO"} = ""-showAmountHelper showzerocommodity a@Amount{acommodity=c, aprice=mp, astyle=AmountStyle{..}} =-    case ascommodityside of-      L -> printf "%s%s%s%s" (T.unpack c') space quantity' price-      R -> printf "%s%s%s%s" quantity' space (T.unpack c') price-    where-      quantity = showamountquantity a-      (quantity',c') | amountLooksZero a && not showzerocommodity = ("0","")-                     | otherwise = (quantity, quoteCommoditySymbolIfNeeded c)-      space = if not (T.null c') && ascommodityspaced then " " else "" :: String-      price = showAmountPrice mp+showAmountWithoutPrice = wbUnpack . showAmountB noPrice  -- | Like showAmount, but show a zero amount's commodity if it has one.+--+-- > showAmountWithZeroCommodity = wbUnpack . showAmountB noColour{displayZeryCommodity=True} showAmountWithZeroCommodity :: Amount -> String-showAmountWithZeroCommodity = showAmountHelper True+showAmountWithZeroCommodity = wbUnpack . showAmountB noColour{displayZeroCommodity=True}  -- | Get a string representation of an amount for debugging, -- appropriate to the current debug level. 9 shows maximum detail.@@ -402,42 +450,46 @@ showAmountDebug Amount{acommodity="AUTO"} = "(missing)" showAmountDebug Amount{..} = printf "Amount {acommodity=%s, aquantity=%s, aprice=%s, astyle=%s}" (show acommodity) (show aquantity) (showAmountPriceDebug aprice) (show astyle) --- | Get the string representation of the number part of of an amount,--- using the display settings from its commodity.-showamountquantity :: Amount -> String+-- | 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.+showamountquantity :: Amount -> WideBuilder showamountquantity amt@Amount{astyle=AmountStyle{asdecimalpoint=mdec, asdigitgroups=mgrps}} =-    punctuatenumber (fromMaybe '.' mdec) mgrps . show $ amountRoundedQuantity amt+    signB <> intB <> fracB+  where+    Decimal e n = amountRoundedQuantity amt --- | Replace a number string's decimal mark with the specified--- character, and add the specified digit group marks. The last digit--- group will be repeated as needed.-punctuatenumber :: Char -> Maybe DigitGroupStyle -> String -> String-punctuatenumber dec mgrps s = sign ++ reverse (applyDigitGroupStyle mgrps (reverse int)) ++ frac''-    where-      (sign,num) = break isDigit s-      (int,frac) = break (=='.') num-      frac' = dropWhile (=='.') frac-      frac'' | null frac' = ""-             | otherwise  = dec:frac'+    strN = T.pack . show $ abs n+    len = T.length strN+    intLen = max 1 $ len - fromIntegral e+    dec = fromMaybe '.' mdec+    padded = T.replicate (fromIntegral e + 1 - len) "0" <> strN+    (intPart, fracPart) = T.splitAt intLen padded -applyDigitGroupStyle :: Maybe DigitGroupStyle -> String -> String-applyDigitGroupStyle Nothing s = s-applyDigitGroupStyle (Just (DigitGroups c gs)) s = addseps (repeatLast gs) s+    intB = applyDigitGroupStyle mgrps intLen $ if e == 0 then strN else intPart+    signB = if n < 0 then WideBuilder (TB.singleton '-') 1 else mempty+    fracB = if e > 0 then WideBuilder (TB.singleton dec <> TB.fromText fracPart) (fromIntegral e + 1) else mempty++-- | Split a string representation into chunks according to DigitGroupStyle,+-- returning a Text builder and the number of separators used.+applyDigitGroupStyle :: Maybe DigitGroupStyle -> Int -> T.Text -> WideBuilder+applyDigitGroupStyle Nothing                       l s = WideBuilder (TB.fromText s) l+applyDigitGroupStyle (Just (DigitGroups _ []))     l s = WideBuilder (TB.fromText s) l+applyDigitGroupStyle (Just (DigitGroups c (g:gs))) l s = addseps (g:|gs) (toInteger l) s   where-    addseps [] s = s-    addseps (g:gs) s-      | toInteger (length s) <= toInteger g = s-      | otherwise     = let (part,rest) = genericSplitAt g s-                        in part ++ c : addseps gs rest-    repeatLast [] = []-    repeatLast gs = init gs ++ repeat (last gs)+    addseps (g:|gs) l s+        | l' > 0    = addseps gs' l' rest <> WideBuilder (TB.singleton c <> TB.fromText part) (fromIntegral g + 1)+        | otherwise = WideBuilder (TB.fromText s) (fromInteger l)+      where+        (rest, part) = T.splitAt (fromInteger l') s+        gs' = fromMaybe (g:|[]) $ nonEmpty gs+        l' = l - toInteger g  -- like journalCanonicaliseAmounts -- | Canonicalise an amount's display style using the provided commodity style map. canonicaliseAmount :: M.Map CommoditySymbol AmountStyle -> Amount -> Amount canonicaliseAmount styles a@Amount{acommodity=c, astyle=s} = a{astyle=s'}-    where-      s' = findWithDefault s c styles+  where s' = M.findWithDefault s c styles  ------------------------------------------------------------------------------- -- MixedAmount@@ -479,24 +531,18 @@  normaliseHelper :: Bool -> MixedAmount -> MixedAmount normaliseHelper squashprices (Mixed as)-  | missingamt `elem` as = missingmixedamt -- missingamt should always be alone, but detect it even if not-  | null nonzeros        = Mixed [newzero]-  | otherwise            = Mixed nonzeros+  | missingkey `M.member` amtMap = missingmixedamt -- missingamt should always be alone, but detect it even if not+  | M.null nonzeros= Mixed [newzero]+  | otherwise      = Mixed $ toList nonzeros   where-    newzero = lastDef nullamt $ filter (not . T.null . acommodity) zeros-    (zeros, nonzeros) = partition amountIsZero $-                        map sumSimilarAmountsUsingFirstPrice $-                        groupBy groupfn $-                        sortBy sortfn-                        as-    sortfn  | squashprices = compare `on` acommodity-            | otherwise    = compare `on` \a -> (acommodity a, aprice a)-    groupfn | squashprices = (==) `on` acommodity-            | otherwise    = \a1 a2 -> acommodity a1 == acommodity a2 && combinableprices a1 a2--    combinableprices Amount{aprice=Nothing} Amount{aprice=Nothing} = True-    combinableprices Amount{aprice=Just (UnitPrice p1)} Amount{aprice=Just (UnitPrice p2)} = p1 == p2-    combinableprices _ _ = False+    newzero = maybe nullamt snd . M.lookupMin $ M.filter (not . T.null . acommodity) zeros+    (zeros, nonzeros) = M.partition amountIsZero amtMap+    amtMap = foldr (\a -> M.insertWith sumSimilarAmountsUsingFirstPrice (key a) a) mempty as+    key Amount{acommodity=c,aprice=p} = (c, if squashprices then Nothing else priceKey <$> p)+      where+        priceKey (UnitPrice  x) = (acommodity x, Just $ aquantity x)+        priceKey (TotalPrice x) = (acommodity x, Nothing)+    missingkey = key missingamt  -- | Like normaliseMixedAmount, but combine each commodity's amounts -- into just one by throwing away all prices except the first. This is@@ -520,9 +566,13 @@ -- | Sum same-commodity amounts in a lossy way, applying the first -- price to the result and discarding any other prices. Only used as a -- rendering helper.-sumSimilarAmountsUsingFirstPrice :: [Amount] -> Amount-sumSimilarAmountsUsingFirstPrice [] = nullamt-sumSimilarAmountsUsingFirstPrice as = (sumStrict as){aprice=aprice $ head as}+sumSimilarAmountsUsingFirstPrice :: Amount -> Amount -> Amount+sumSimilarAmountsUsingFirstPrice a b = (a + b){aprice=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@@ -557,26 +607,16 @@ -- | Convert all component amounts to cost/selling price where -- possible (see amountCost). mixedAmountCost :: MixedAmount -> MixedAmount-mixedAmountCost (Mixed as) = Mixed $ map amountCost as+mixedAmountCost = mapMixedAmount amountCost --- | Divide a mixed amount's quantities by a constant.+-- | Divide a mixed amount's quantities (and total prices, if any) by a constant. divideMixedAmount :: Quantity -> MixedAmount -> MixedAmount divideMixedAmount n = mapMixedAmount (divideAmount n) --- | Multiply a mixed amount's quantities by a constant.+-- | Multiply a mixed amount's quantities (and total prices, if any) by a constant. multiplyMixedAmount :: Quantity -> MixedAmount -> MixedAmount multiplyMixedAmount n = mapMixedAmount (multiplyAmount n) --- | Divide a mixed amount's quantities (and total prices, if any) by a constant.--- The total prices will be kept positive regardless of the multiplier's sign.-divideMixedAmountAndPrice :: Quantity -> MixedAmount -> MixedAmount-divideMixedAmountAndPrice n = mapMixedAmount (divideAmountAndPrice n)---- | Multiply a mixed amount's quantities (and total prices, if any) by a constant.--- The total prices will be kept positive regardless of the multiplier's sign.-multiplyMixedAmountAndPrice :: Quantity -> MixedAmount -> MixedAmount-multiplyMixedAmountAndPrice n = mapMixedAmount (multiplyAmountAndPrice n)- -- | Calculate the average of some mixed amounts. averageMixedAmounts :: [MixedAmount] -> MixedAmount averageMixedAmounts [] = 0@@ -593,12 +633,15 @@     as | not (any isNegativeAmount as) -> Just False     _ -> Nothing  -- multiple amounts with different signs --- | Does this mixed amount appear to be zero when rendered with its--- display precision ?+-- | Does this mixed amount appear to be zero when rendered with its display precision?+-- i.e. does it have zero quantity with no price, zero quantity with a total price (which is also zero),+-- and zero quantity for each unit price? mixedAmountLooksZero :: MixedAmount -> Bool mixedAmountLooksZero = all amountLooksZero . amounts . normaliseMixedAmountSquashPricesForDisplay --- | Is this mixed amount exactly zero, ignoring display precisions ?+-- | Is this mixed amount exactly to be zero, ignoring its display precision?+-- i.e. does it have zero quantity with no price, zero quantity with a total price (which is also zero),+-- and zero quantity for each unit price? mixedAmountIsZero :: MixedAmount -> Bool mixedAmountIsZero = all amountIsZero . amounts . normaliseMixedAmountSquashPricesForDisplay @@ -613,7 +656,7 @@ -- | Given a map of standard commodity display styles, apply the -- appropriate one to each individual amount. styleMixedAmount :: M.Map CommoditySymbol AmountStyle -> MixedAmount -> MixedAmount-styleMixedAmount styles (Mixed as) = Mixed $ map (styleAmount styles) as+styleMixedAmount styles = mapMixedAmount (styleAmount styles)  -- | Reset each individual amount's display style to the default. mixedAmountUnstyled :: MixedAmount -> MixedAmount@@ -622,40 +665,46 @@ -- | 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 showMixedAmount :: MixedAmount -> String-showMixedAmount = fst . showMixed showAmount Nothing Nothing False+showMixedAmount = wbUnpack . showMixedAmountB noColour  -- | Get the one-line string representation of a mixed amount.+--+-- > showMixedAmountOneLine = wbUnpack . showMixedAmountB oneLine showMixedAmountOneLine :: MixedAmount -> String-showMixedAmountOneLine = fst . showMixedOneLine showAmountWithoutPrice Nothing Nothing False+showMixedAmountOneLine = wbUnpack . showMixedAmountB oneLine  -- | Like showMixedAmount, but zero amounts are shown with their -- commodity if they have one.+--+-- > showMixedAmountWithZeroCommodity = wbUnpack . showMixedAmountB noColour{displayZeroCommodity=True} showMixedAmountWithZeroCommodity :: MixedAmount -> String-showMixedAmountWithZeroCommodity = fst . showMixed showAmountWithZeroCommodity Nothing Nothing False---- | Get the string representation of a mixed amount, showing each of its--- component amounts with the specified precision, ignoring their--- commoditys' display precision settings.-showMixedAmountWithPrecision :: AmountPrecision -> MixedAmount -> String-showMixedAmountWithPrecision p = fst . showMixed (showAmountWithPrecision p) Nothing Nothing False+showMixedAmountWithZeroCommodity = wbUnpack . showMixedAmountB noColour{displayZeroCommodity=True}  -- | Get the string representation of a mixed amount, without showing any transaction prices. -- With a True argument, adds ANSI codes to show negative amounts in red.+--+-- > showMixedAmountWithoutPrice c = wbUnpack . showMixedAmountB noPrice{displayColour=c} showMixedAmountWithoutPrice :: Bool -> MixedAmount -> String-showMixedAmountWithoutPrice c = fst . showMixed showAmountWithoutPrice Nothing Nothing c+showMixedAmountWithoutPrice c = wbUnpack . showMixedAmountB noPrice{displayColour=c}  -- | Get the one-line string representation of a mixed amount, but without -- any \@ prices. -- 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 = fst . showMixedOneLine showAmountWithoutPrice Nothing Nothing c+showMixedAmountOneLineWithoutPrice c = wbUnpack . showMixedAmountB oneLine{displayColour=c}  -- | Like showMixedAmountOneLineWithoutPrice, 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} showMixedAmountElided :: Int -> Bool -> MixedAmount -> String-showMixedAmountElided w c = fst . showMixedOneLine showAmountWithoutPrice Nothing (Just w) c+showMixedAmountElided w c = wbUnpack . showMixedAmountB oneLine{displayColour=c, displayMaxWidth=Just w}  -- | Get an unambiguous string representation of a mixed amount for debugging. showMixedAmountDebug :: MixedAmount -> String@@ -663,60 +712,67 @@                        | otherwise       = printf "Mixed [%s]" as     where as = intercalate "\n       " $ map showAmountDebug $ amounts m --- | General function to display a MixedAmount, one Amount on each line.--- It takes a function to display each Amount, an optional minimum width--- to pad to, an optional maximum width to display, and a Bool to determine--- whether to colourise negative numbers. Amounts longer than the maximum--- width (if given) will be elided. The function also returns the actual--- width of the output string.-showMixed :: (Amount -> String) -> Maybe Int -> Maybe Int -> Bool -> MixedAmount -> (String, Int)-showMixed showamt mmin mmax c =-    showMixedUnnormalised showamt mmin mmax c . normaliseMixedAmountSquashPricesForDisplay+-- | General function to generate a WideBuilder for a MixedAmount, according 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.+--+-- 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.+-- - If displayed on multiple lines, any Amounts longer than the+--   maximum width will be elided.+showMixedAmountB :: AmountDisplayOpts -> MixedAmount -> WideBuilder+showMixedAmountB opts ma+    | displayOneLine opts = showMixedAmountOneLineB opts ma'+    | otherwise           = WideBuilder (wbBuilder . mconcat $ intersperse sep lines) width+  where+    ma' = if displayPrice opts then ma else mixedAmountStripPrices ma+    lines = showMixedAmountLinesB opts ma'+    width = headDef 0 $ map wbWidth lines+    sep = WideBuilder (TB.singleton '\n') 0 --- | Like showMixed, but does not normalise the MixedAmount before displaying.-showMixedUnnormalised :: (Amount -> String) -> Maybe Int -> Maybe Int -> Bool -> MixedAmount -> (String, Int)-showMixedUnnormalised showamt mmin mmax c (Mixed as) =-    (intercalate "\n" $ map finalise elided, width)+-- | Helper for showMixedAmountB to show a MixedAmount on multiple lines. This returns+-- the list of WideBuilders: one for each Amount in the MixedAmount (possibly+-- normalised), 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 =+    map (adBuilder . pad) elided   where-    width    = maximum $ fromMaybe 0 mmin : map adLength elided-    astrs    = amtDisplayList sepwidth showamt as-    sepwidth = 0  -- "\n" has width 0+    Mixed amts = if displayNormalised opts then normaliseMixedAmountSquashPricesForDisplay ma else ma -    finalise = adString . pad . if c then colourise else id-    pad amt = amt{ adString = applyN (width - adLength amt) (' ':) $ adString amt-                 , adLength = width-                 }+    astrs = amtDisplayList (wbWidth sep) (showAmountB opts) amts+    sep   = WideBuilder (TB.singleton '\n') 0+    width = maximum $ fromMaybe 0 mmin : map (wbWidth . adBuilder) elided +    pad amt = amt{ adBuilder = WideBuilder (TB.fromText $ T.replicate w " ") w <> adBuilder amt }+      where w = width - wbWidth (adBuilder amt)+     elided = maybe id elideTo mmax astrs     elideTo m xs = maybeAppend elisionStr short       where-        elisionStr = elisionDisplay (Just m) sepwidth (length long) $ lastDef nullAmountDisplay short-        (short, long) = partition ((m>=) . adLength) xs---- | General function to display a MixedAmount on a single line. It--- takes a function to display each Amount, an optional minimum width to--- pad to, an optional maximum width to display, and a Bool to determine--- whether to colourise negative numbers. It will display as many Amounts--- as it can in the maximum width (if given), and further Amounts will be--- elided. The function also returns the actual width of the output string.-showMixedOneLine :: (Amount -> String) -> Maybe Int -> Maybe Int -> Bool -> MixedAmount -> (String, Int)-showMixedOneLine showamt mmin mmax c =-    showMixedOneLineUnnormalised showamt mmin mmax c . normaliseMixedAmountSquashPricesForDisplay+        elisionStr = elisionDisplay (Just m) (wbWidth sep) (length long) $ lastDef nullAmountDisplay short+        (short, long) = partition ((m>=) . wbWidth . adBuilder) xs --- | Like showMixedOneLine, but does not normalise the MixedAmount before--- displaying.-showMixedOneLineUnnormalised :: (Amount -> String) -> Maybe Int -> Maybe Int -> Bool -> MixedAmount -> (String, Int)-showMixedOneLineUnnormalised showamt mmin mmax c (Mixed as) =-    (pad . intercalate ", " $ map finalise elided, max width $ fromMaybe 0 mmin)+-- | 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 =+    WideBuilder (wbBuilder . pad . mconcat . intersperse sep $ map adBuilder elided) . max width $ fromMaybe 0 mmin   where-    width    = maybe 0 adTotal $ lastMay elided-    astrs    = amtDisplayList sepwidth showamt as-    sepwidth = 2  -- ", " has width 2-    n        = length as+    Mixed amts = if displayNormalised opts then normaliseMixedAmountSquashPricesForDisplay ma else ma -    finalise = adString . if c then colourise else id-    pad = applyN (fromMaybe 0 mmin - width) (' ':)+    width  = maybe 0 adTotal $ lastMay elided+    astrs  = amtDisplayList (wbWidth sep) (showAmountB opts) amts+    sep    = WideBuilder (TB.fromString ", ") 2+    n      = length amts +    pad = (WideBuilder (TB.fromText $ T.replicate w " ") w <>)+      where w = fromMaybe 0 mmin - width+     elided = maybe id elideTo mmax astrs     elideTo m = addElide . takeFitting m . withElided     -- Add the last elision string to the end of the display list@@ -728,39 +784,36 @@     dropWhileRev p = foldr (\x xs -> if null xs && p x then [] else x:xs) []      -- Add the elision strings (if any) to each amount-    withElided = zipWith (\num amt -> (amt, elisionDisplay Nothing sepwidth num amt)) [n-1,n-2..0]+    withElided = zipWith (\num amt -> (amt, elisionDisplay Nothing (wbWidth sep) num amt)) [n-1,n-2..0]  data AmountDisplay = AmountDisplay-  { adAmount :: !Amount  -- ^ Amount displayed-  , adString :: !String  -- ^ String representation of the Amount-  , adLength :: !Int     -- ^ Length of the string representation-  , adTotal  :: !Int     -- ^ Cumulative length of MixedAmount this Amount is part of,-                         --   including separators-  } deriving (Show)+  { adBuilder :: !WideBuilder  -- ^ String representation of the Amount+  , adTotal   :: !Int            -- ^ Cumulative length of MixedAmount this Amount is part of,+                                --   including separators+  }  nullAmountDisplay :: AmountDisplay-nullAmountDisplay = AmountDisplay nullamt "" 0 0+nullAmountDisplay = AmountDisplay mempty 0 -amtDisplayList :: Int -> (Amount -> String) -> [Amount] -> [AmountDisplay]+amtDisplayList :: Int -> (Amount -> WideBuilder) -> [Amount] -> [AmountDisplay] amtDisplayList sep showamt = snd . mapAccumL display (-sep)   where-    display tot amt = (tot', AmountDisplay amt str width tot')+    display tot amt = (tot', AmountDisplay str tot')       where         str  = showamt amt-        width  = strWidth str-        tot' = tot + width + sep+        tot' = tot + (wbWidth str) + sep  -- The string "m more", added to the previous running total elisionDisplay :: Maybe Int -> Int -> Int -> AmountDisplay -> Maybe AmountDisplay elisionDisplay mmax sep n lastAmt-  | n > 0     = Just $ AmountDisplay 0 str len (adTotal lastAmt + len)+  | n > 0     = Just $ AmountDisplay (WideBuilder (TB.fromText str) len) (adTotal lastAmt + len)   | otherwise = Nothing   where-    fullString = show n ++ " more.."+    fullString = T.pack $ show n ++ " more.."     -- sep from the separator, 7 from " more..", 1 + floor (logBase 10 n) from number     fullLength = sep + 8 + floor (logBase 10 $ fromIntegral n) -    str | Just m <- mmax, fullLength > m = take (m - 2) fullString ++ ".."+    str | Just m <- mmax, fullLength > m = T.take (m - 2) fullString <> ".."         | otherwise                      = fullString     len = case mmax of Nothing -> fullLength                        Just m  -> max 2 $ min m fullLength@@ -769,30 +822,31 @@ maybeAppend Nothing  = id maybeAppend (Just a) = (++[a]) -colourise :: AmountDisplay -> AmountDisplay-colourise amt = amt{adString=markColour $ adString amt}-  where markColour = if isNegativeAmount (adAmount amt) then color Dull Red else id- -- | Compact labelled trace of a mixed amount, for debugging. ltraceamount :: String -> MixedAmount -> MixedAmount ltraceamount s = traceWith (((s ++ ": ") ++).showMixedAmount)  -- | Set the display precision in the amount's commodities.-setMixedAmountPrecision :: AmountPrecision -> MixedAmount -> MixedAmount-setMixedAmountPrecision p (Mixed as) = Mixed $ map (setAmountPrecision p) as+mixedAmountSetPrecision :: AmountPrecision -> MixedAmount -> MixedAmount+mixedAmountSetPrecision p = mapMixedAmount (amountSetPrecision p) +-- | In each component amount, increase the display precision sufficiently+-- to render it exactly (showing all significant decimal digits).+mixedAmountSetFullPrecision :: MixedAmount -> MixedAmount+mixedAmountSetFullPrecision = mapMixedAmount amountSetFullPrecision+ mixedAmountStripPrices :: MixedAmount -> MixedAmount-mixedAmountStripPrices (Mixed as) = Mixed $ map (\a -> a{aprice=Nothing}) as+mixedAmountStripPrices = mapMixedAmount (\a -> a{aprice=Nothing})  -- | Canonicalise a mixed amount's display styles using the provided commodity style map. canonicaliseMixedAmount :: M.Map CommoditySymbol AmountStyle -> MixedAmount -> MixedAmount-canonicaliseMixedAmount styles (Mixed as) = Mixed $ map (canonicaliseAmount styles) as+canonicaliseMixedAmount styles = mapMixedAmount (canonicaliseAmount styles)  -- | Replace each component amount's TotalPrice, if it has one, with an equivalent UnitPrice. -- Has no effect on amounts without one. -- Does Decimal division, might be some rounding/irrational number issues. mixedAmountTotalPriceToUnitPrice :: MixedAmount -> MixedAmount-mixedAmountTotalPriceToUnitPrice (Mixed as) = Mixed $ map amountTotalPriceToUnitPrice as+mixedAmountTotalPriceToUnitPrice = mapMixedAmount amountTotalPriceToUnitPrice   -------------------------------------------------------------------------------@@ -805,7 +859,7 @@        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 (-1)){aprice=Just $ TotalPrice $ usd (-2)} @?= usd (-2)      ,test "amountLooksZero" $ do        assertBool "" $ amountLooksZero amount@@ -846,9 +900,7 @@        [usd 1 @@ eur 1        ,usd (-2) @@ eur 1        ])-        @?= Mixed [usd 1 @@ eur 1-                   ,usd (-2) @@ eur 1-                   ]+        @?= Mixed [usd (-1) @@ eur 2 ]      ,test "showMixedAmount" $ do        showMixedAmount (Mixed [usd 1]) @?= "$1.00"@@ -871,8 +923,8 @@         normaliseMixedAmount (Mixed [usd 1 `at` eur 1, usd 1 `at` eur 1]) @?= Mixed [usd 2 `at` eur 1]       ,test "amounts with different unit prices are not combined" $         normaliseMixedAmount (Mixed [usd 1 `at` eur 1, usd 1 `at` eur 2]) @?= Mixed [usd 1 `at` eur 1, usd 1 `at` eur 2]-      ,test "amounts with total prices are not combined" $-        normaliseMixedAmount (Mixed  [usd 1 @@ eur 1, usd 1 @@ eur 1]) @?= Mixed [usd 1 @@ eur 1, usd 1 @@ eur 1]+      ,test "amounts with total prices are combined" $+        normaliseMixedAmount (Mixed  [usd 1 @@ eur 1, usd 1 @@ eur 1]) @?= Mixed [usd 2 @@ eur 2]     ]      ,test "normaliseMixedAmountSquashPricesForDisplay" $ do

@@ -110,19 +110,19 @@  -- Help ppShow parse and line-wrap DateSpans better in debug output. instance Show DateSpan where-    show s = "DateSpan " ++ showDateSpan s+    show s = "DateSpan " ++ T.unpack (showDateSpan s) -showDate :: Day -> String-showDate = show+showDate :: Day -> Text+showDate = T.pack . show  -- | Render a datespan as a display string, abbreviating into a -- compact form if possible.-showDateSpan :: DateSpan -> String+showDateSpan :: DateSpan -> Text showDateSpan = showPeriod . dateSpanAsPeriod  -- | Like showDateSpan, but show month spans as just the abbreviated month name -- in the current locale.-showDateSpanMonthAbbrev :: DateSpan -> String+showDateSpanMonthAbbrev :: DateSpan -> Text showDateSpanMonthAbbrev = showPeriodMonthAbbrev . dateSpanAsPeriod  -- | Get the current local date.@@ -388,13 +388,13 @@  -- | Convert a smart date string to an explicit yyyy\/mm\/dd string using -- the provided reference date, or raise an error.-fixSmartDateStr :: Day -> Text -> String+fixSmartDateStr :: Day -> Text -> Text fixSmartDateStr d s =   either (error' . printf "could not parse date %s %s" (show s) . show) id $  -- PARTIAL:-  (fixSmartDateStrEither d s :: Either (ParseErrorBundle Text CustomErr) String)+  (fixSmartDateStrEither d s :: Either (ParseErrorBundle Text CustomErr) Text)  -- | A safe version of fixSmartDateStr.-fixSmartDateStrEither :: Day -> Text -> Either (ParseErrorBundle Text CustomErr) String+fixSmartDateStrEither :: Day -> Text -> Either (ParseErrorBundle Text CustomErr) Text fixSmartDateStrEither d = fmap showDate . fixSmartDateStrEither' d  fixSmartDateStrEither'

@@ -1,3 +1,4 @@+{-# LANGUAGE PackageImports #-} {-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-}@@ -37,9 +38,9 @@   filterTransactionPostings,   filterPostingAmount,   -- * Mapping-  mapJournalTransactions,-  mapJournalPostings,-  mapTransactionPostings,+  journalMapTransactions,+  journalMapPostings,+  journalMapPostingAmounts,   -- * Querying   journalAccountNamesUsed,   journalAccountNamesImplied,@@ -52,8 +53,12 @@   -- overJournalAmounts,   -- traverseJournalAmounts,   -- journalCanonicalCommodities,+  journalPayeesDeclared,+  journalPayeesUsed,+  journalPayeesDeclaredOrUsed,   journalCommoditiesDeclared,   journalDateSpan,+  journalDateSpanBothDates,   journalStartDate,   journalEndDate,   journalDescriptions,@@ -63,6 +68,7 @@   journalNextTransaction,   journalPrevTransaction,   journalPostings,+  journalTransactionsSimilarTo,   -- journalPrices,   -- * Standard account types   journalBalanceSheetAccountQuery,@@ -86,31 +92,33 @@   tests_Journal, ) where-import Control.Monad-import Control.Monad.Except-import Control.Monad.Extra++import Control.Applicative ((<|>))+import Control.Monad.Except (ExceptT(..), runExceptT, throwError)+import "extra" Control.Monad.Extra (whenM) import Control.Monad.Reader as R-import Control.Monad.ST-import Data.Array.ST+import Control.Monad.ST (ST, runST)+import Data.Array.ST (STArray, getElems, newListArray, writeArray)+import Data.Char (toUpper, isDigit) import Data.Default (Default(..)) import Data.Function ((&)) import qualified Data.HashTable.Class as H (toList) import qualified Data.HashTable.ST.Cuckoo as H-import Data.List-import Data.List.Extra (groupSort, nubSort)-import qualified Data.Map as M-import Data.Maybe+import Data.List (find, foldl', sortOn)+import Data.List.Extra (nubSort)+import qualified Data.Map.Strict as M+import Data.Maybe (catMaybes, fromJust, fromMaybe, isJust, mapMaybe, maybeToList) #if !(MIN_VERSION_base(4,11,0)) import Data.Semigroup (Semigroup(..)) #endif import qualified Data.Set as S import Data.Text (Text) import qualified Data.Text as T-import Safe (headMay, headDef)-import Data.Time.Calendar-import Data.Tree+import Safe (headMay, headDef, maximumMay, minimumMay)+import Data.Time.Calendar (Day, addDays, fromGregorian)+import Data.Tree (Tree, flatten) import System.Time (ClockTime(TOD))-import Text.Printf+import Text.Printf (printf)  import Hledger.Utils import Hledger.Data.Types@@ -121,6 +129,7 @@ import Hledger.Data.TransactionModifier import Hledger.Data.Posting import Hledger.Query+import Data.List (sortBy)   -- try to make Journal ppShow-compatible@@ -183,6 +192,7 @@     -- ,jparsetransactioncount     = jparsetransactioncount     j1 +  jparsetransactioncount     j2     ,jparsetimeclockentries     = jparsetimeclockentries     j1 <> jparsetimeclockentries     j2     ,jincludefilestack          = jincludefilestack j2+    ,jdeclaredpayees            = jdeclaredpayees            j1 <> jdeclaredpayees            j2     ,jdeclaredaccounts          = jdeclaredaccounts          j1 <> jdeclaredaccounts          j2     ,jdeclaredaccounttypes      = jdeclaredaccounttypes      j1 <> jdeclaredaccounttypes      j2     ,jglobalcommoditystyles     = jglobalcommoditystyles     j1 <> jglobalcommoditystyles     j2@@ -211,6 +221,7 @@   -- ,jparsetransactioncount     = 0   ,jparsetimeclockentries     = []   ,jincludefilestack          = []+  ,jdeclaredpayees            = []   ,jdeclaredaccounts          = []   ,jdeclaredaccounttypes      = M.empty   ,jglobalcommoditystyles     = M.empty@@ -261,10 +272,6 @@ journalPrevTransaction :: Journal -> Transaction -> Maybe Transaction journalPrevTransaction j t = journalTransactionAt j (tindex t - 1) --- | Unique transaction descriptions used in this journal.-journalDescriptions :: Journal -> [Text]-journalDescriptions = nubSort . map tdescription . jtxns- -- | All postings from this journal's transactions, in order. journalPostings :: Journal -> [Posting] journalPostings = concatMap tpostings . jtxns@@ -273,6 +280,22 @@ journalCommoditiesDeclared :: Journal -> [AccountName] journalCommoditiesDeclared = nubSort . M.keys . jcommodities +-- | Unique transaction descriptions used in this journal.+journalDescriptions :: Journal -> [Text]+journalDescriptions = nubSort . map tdescription . jtxns++-- | Sorted unique payees declared by payee directives in this journal.+journalPayeesDeclared :: Journal -> [Payee]+journalPayeesDeclared = nubSort . map fst . jdeclaredpayees++-- | Sorted unique payees used by transactions in this journal.+journalPayeesUsed :: Journal -> [Payee]+journalPayeesUsed = nubSort . map transactionPayee . jtxns++-- | Sorted unique payees used in transactions or declared by payee directives in this journal.+journalPayeesDeclaredOrUsed :: Journal -> [Payee]+journalPayeesDeclaredOrUsed j = nubSort $ journalPayeesDeclared j ++ journalPayeesUsed j+ -- | Sorted unique account names posted to by this journal's transactions. journalAccountNamesUsed :: Journal -> [AccountName] journalAccountNamesUsed = accountNamesFromPostings . journalPostings@@ -303,26 +326,134 @@ journalAccountNameTree :: Journal -> Tree AccountName journalAccountNameTree = accountNameTreeFrom . journalAccountNames +-- | Find up to N most similar and most recent transactions matching+-- the given transaction description and query. Transactions are+-- listed with their description's similarity score (see+-- compareDescriptions), sorted by highest score and then by date.+-- Only transactions with a similarity score greater than a minimum+-- threshold (currently 0) are returned.+journalTransactionsSimilarTo :: Journal -> Query -> Text -> Int -> [(Double,Transaction)]+journalTransactionsSimilarTo Journal{jtxns} q desc n =+  take n $+  sortBy (\(s1,t1) (s2,t2) -> compare (s2,tdate t2) (s1,tdate t1)) $+  filter ((> threshold).fst)+  [(compareDescriptions desc $ tdescription t, t) | t <- jtxns, q `matchesTransaction` t]+  where+    threshold = 0++-- | Return a similarity score from 0 to 1.5 for two transaction descriptions. +-- This is based on compareStrings, with the following modifications:+--+-- - numbers are stripped out before measuring similarity+--+-- - if the (unstripped) first description appears in its entirety within the second,+--   the score is boosted by 0.5.+--+compareDescriptions :: Text -> Text -> Double+compareDescriptions a b =+  (if a `T.isInfixOf` b then (0.5+) else id) $+  compareStrings (simplify a) (simplify b)+  where+    simplify = T.unpack . T.filter (not.isDigit)++-- | Return a similarity score from 0 to 1 for two strings.  This+-- was based on Simon White's string similarity algorithm+-- (http://www.catalysoft.com/articles/StrikeAMatch.html), later found+-- to be https://en.wikipedia.org/wiki/S%C3%B8rensen%E2%80%93Dice_coefficient,+-- and modified to handle short strings better.+-- Todo: check out http://nlp.fi.muni.cz/raslan/2008/raslan08.pdf#page=14 .+compareStrings :: String -> String -> Double+compareStrings "" "" = 1+compareStrings [_] "" = 0+compareStrings "" [_] = 0+compareStrings [a] [b] = if toUpper a == toUpper b then 1 else 0+compareStrings s1 s2 = 2 * commonpairs / totalpairs+  where+    pairs1      = S.fromList $ wordLetterPairs $ uppercase s1+    pairs2      = S.fromList $ wordLetterPairs $ uppercase s2+    commonpairs = fromIntegral $ S.size $ S.intersection pairs1 pairs2+    totalpairs  = fromIntegral $ S.size pairs1 + S.size pairs2++wordLetterPairs :: String -> [String]+wordLetterPairs = concatMap letterPairs . words++letterPairs :: String -> [String]+letterPairs (a:b:rest) = [a,b] : letterPairs (b:rest)+letterPairs _ = []+ -- queries for standard account types +-- | Get a query for accounts of the specified types in this journal. +-- Account types include Asset, Liability, Equity, Revenue, Expense, Cash.+-- For each type, if no accounts were declared with this type, the query +-- will instead match accounts with names matched by the case-insensitive +-- regular expression provided as a fallback.+-- The query will match all accounts which were declared as one of+-- these types (by account directives with the type: tag), plus all their +-- subaccounts which have not been declared as some other type.+journalAccountTypeQuery :: [AccountType] -> Regexp -> Journal -> Query+journalAccountTypeQuery atypes fallbackregex Journal{jdeclaredaccounttypes} =+  let+    declaredacctsoftype :: [AccountName] =+      concat $ mapMaybe (`M.lookup` jdeclaredaccounttypes) atypes+  in case declaredacctsoftype of+    [] -> Acct fallbackregex+    as -> And $ [ Or acctnameRegexes ]+            ++ if null differentlyTypedRegexes then [] else [ Not $ Or differentlyTypedRegexes ]+      where+        -- XXX Query isn't able to match account type since that requires extra info from the journal.+        -- So we do a hacky search by name instead.+        acctnameRegexes = map (Acct . accountNameToAccountRegex) as+        differentlyTypedRegexes = map (Acct . accountNameToAccountRegex) differentlytypedsubs++        differentlytypedsubs = concat+          [subs | (t,bs) <- M.toList jdeclaredaccounttypes+              , not $ t `elem` atypes+              , let subs = [b | b <- bs, any (`isAccountNamePrefixOf` b) as]+          ]+ -- | A query for accounts in this journal which have been -- declared as Asset (or Cash, a subtype of Asset) by account directives,  -- or otherwise for accounts with names matched by the case-insensitive  -- regular expression @^assets?(:|$)@. journalAssetAccountQuery :: Journal -> Query-journalAssetAccountQuery = journalAccountTypeQuery [Asset,Cash] (toRegexCI' "^assets?(:|$)")+journalAssetAccountQuery j = +  Or [+     journalAccountTypeQuery [Asset] (toRegexCI' "^assets?(:|$)") j+    ,journalCashAccountOnlyQuery j+  ] --- | A query for "Cash" (liquid asset) accounts in this journal, ie accounts--- declared as Cash by account directives, or otherwise with names matched by the --- case-insensitive regular expression @^assets?(:|$)@. and not including--- the case-insensitive regular expression @(investment|receivable|:A/R|:fixed)@.+-- | A query for accounts in this journal which have been+-- declared as Asset (and not Cash) by account directives, +-- or otherwise for accounts with names matched by the case-insensitive +-- regular expression @^assets?(:|$)@.+journalAssetNonCashAccountQuery :: Journal -> Query+journalAssetNonCashAccountQuery j = +  journalAccountTypeQuery [Asset] (toRegexCI' "^assets?(:|$)") j++-- | A query for Cash (liquid asset) accounts in this journal, ie accounts+-- declared as Cash by account directives, or otherwise Asset accounts whose +-- names do not include the case-insensitive regular expression +-- @(investment|receivable|:A/R|:fixed)@. journalCashAccountQuery  :: Journal -> Query journalCashAccountQuery j =   case M.lookup Cash (jdeclaredaccounttypes j) of-    Nothing -> And [ journalAssetAccountQuery j, Not . Acct $ toRegexCI' "(investment|receivable|:A/R|:fixed)" ]-    Just _  -> journalAccountTypeQuery [Cash] notused j-      where notused = error' "journalCashAccountQuery: this should not have happened!"  -- PARTIAL:+    Just _  -> journalCashAccountOnlyQuery j+    Nothing ->+      -- no Cash accounts are declared; query for Asset accounts and exclude some of them+      And [ journalAssetNonCashAccountQuery j, Not . Acct $ toRegexCI' "(investment|receivable|:A/R|:fixed)" ] +-- | A query for accounts in this journal specifically declared as Cash by +-- account directives, or otherwise the None query.+journalCashAccountOnlyQuery  :: Journal -> Query+journalCashAccountOnlyQuery j = +  case M.lookup Cash (jdeclaredaccounttypes j) of+    Just _  -> +      -- Cash accounts are declared; get a query for them (the fallback regex won't be used)+      journalAccountTypeQuery [Cash] notused j+        where notused = error' "journalCashAccountOnlyQuery: this should not have happened!"  -- PARTIAL:+    Nothing -> None+ -- | A query for accounts in this journal which have been -- declared as Liability by account directives, or otherwise for -- accounts with names matched by the case-insensitive regular expression@@ -366,33 +497,6 @@                                         ,journalExpenseAccountQuery j                                         ] --- | Get a query for accounts of the specified types (Asset, Liability..) in this journal.--- The query will match all accounts which were declared as one of--- these types by account directives, plus all their subaccounts which--- have not been declared as some other type.--- Or if no accounts were declared with these types, the query will--- instead match accounts with names matched by the provided--- case-insensitive regular expression.-journalAccountTypeQuery :: [AccountType] -> Regexp -> Journal -> Query-journalAccountTypeQuery atypes fallbackregex Journal{jdeclaredaccounttypes} =-  let-    declaredacctsoftype :: [AccountName] =-      concat $ mapMaybe (`M.lookup` jdeclaredaccounttypes) atypes-  in case declaredacctsoftype of-    [] -> Acct fallbackregex-    as -> And [ Or acctnameRegexes, Not $ Or differentlyTypedRegexes ]-      where-        -- XXX Query isn't able to match account type since that requires extra info from the journal.-        -- So we do a hacky search by name instead.-        acctnameRegexes = map (Acct . accountNameToAccountRegex) as-        differentlyTypedRegexes = map (Acct . accountNameToAccountRegex) differentlytypedsubs--        differentlytypedsubs = concat-          [subs | (t,bs) <- M.toList jdeclaredaccounttypes-              , not $ t `elem` atypes-              , let subs = [b | b <- bs, any (`isAccountNamePrefixOf` b) as]-          ]- -- Various kinds of filtering on journals. We do it differently depending -- on the command. @@ -426,16 +530,16 @@ filterTransactionPostings q t@Transaction{tpostings=ps} = t{tpostings=filter (q `matchesPosting`) ps}  -- | Apply a transformation to a journal's transactions.-mapJournalTransactions :: (Transaction -> Transaction) -> Journal -> Journal-mapJournalTransactions f j@Journal{jtxns=ts} = j{jtxns=map f ts}+journalMapTransactions :: (Transaction -> Transaction) -> Journal -> Journal+journalMapTransactions f j@Journal{jtxns=ts} = j{jtxns=map f ts}  -- | Apply a transformation to a journal's postings.-mapJournalPostings :: (Posting -> Posting) -> Journal -> Journal-mapJournalPostings f j@Journal{jtxns=ts} = j{jtxns=map (mapTransactionPostings f) ts}+journalMapPostings :: (Posting -> Posting) -> Journal -> Journal+journalMapPostings f j@Journal{jtxns=ts} = j{jtxns=map (transactionMapPostings f) ts} --- | Apply a transformation to a transaction's postings.-mapTransactionPostings :: (Posting -> Posting) -> Transaction -> Transaction-mapTransactionPostings f t@Transaction{tpostings=ps} = t{tpostings=map f ps}+-- | Apply a transformation to a journal's posting amounts.+journalMapPostingAmounts :: (Amount -> Amount) -> Journal -> Journal+journalMapPostingAmounts f = journalMapPostings (postingTransformAmount (mapMixedAmount f))  {- -------------------------------------------------------------------------------@@ -888,7 +992,7 @@          Nothing -> "?" -- shouldn't happen          Just t ->  printf "%s\ntransaction:\n%s"                       (showGenericSourcePos pos)-                      (chomp $ showTransaction t)+                      (textChomp $ showTransaction t)                       :: String                       where                         pos = baposition $ fromJust $ pbalanceassertion p@@ -919,11 +1023,11 @@ checkBalanceAssignmentPostingDateB :: Posting -> Balancing s () checkBalanceAssignmentPostingDateB p =   when (hasBalanceAssignment p && isJust (pdate p)) $-    throwError $ unlines $+    throwError . T.unpack $ T.unlines       ["postings which are balance assignments may not have a custom date."       ,"Please write the posting amount explicitly, or remove the posting date:"       ,""-      ,maybe (unlines $ showPostingLines p) showTransaction $ ptransaction p+      ,maybe (T.unlines $ showPostingLines p) showTransaction $ ptransaction p       ]  -- | Throw an error if this posting is trying to do a balance assignment and@@ -933,16 +1037,16 @@ checkBalanceAssignmentUnassignableAccountB p = do   unassignable <- R.asks bsUnassignable   when (hasBalanceAssignment p && paccount p `S.member` unassignable) $-    throwError $ unlines $+    throwError . T.unpack $ T.unlines       ["balance assignments cannot be used with accounts which are"       ,"posted to by transaction modifier rules (auto postings)."       ,"Please write the posting amount explicitly, or remove the rule."       ,""-      ,"account: "++T.unpack (paccount p)+      ,"account: " <> paccount p       ,""       ,"transaction:"       ,""-      ,maybe (unlines $ showPostingLines p) showTransaction $ ptransaction p+      ,maybe (T.unlines $ showPostingLines p) showTransaction $ ptransaction p       ]  --@@ -963,7 +1067,8 @@         fixtransaction t@Transaction{tpostings=ps} = t{tpostings=map fixposting ps}         fixposting p = p{pamount=styleMixedAmount styles $ pamount p                         ,pbalanceassertion=fixbalanceassertion <$> pbalanceassertion p}-        fixbalanceassertion ba = ba{baamount=styleAmount styles $ baamount ba}+        -- balance assertion amounts are always displayed (by print) at full precision, per docs+        fixbalanceassertion ba = ba{baamount=styleAmountExceptPrecision styles $ baamount ba}         fixpricedirective pd@PriceDirective{pdamount=a} = pd{pdamount=styleAmountExceptPrecision styles a}  -- | Get the canonical amount styles for this journal, whether (in order of precedence):@@ -1006,42 +1111,40 @@ -- and this function never reports an error. -- commodityStylesFromAmounts :: [Amount] -> Either String (M.Map CommoditySymbol AmountStyle)-commodityStylesFromAmounts amts =-  Right $ M.fromList commstyles-  where-    commamts = groupSort [(acommodity as, as) | as <- amts]-    commstyles = [(c, canonicalStyleFrom $ map astyle as) | (c,as) <- commamts]+commodityStylesFromAmounts =+    Right . foldr (\a -> M.insertWith canonicalStyle (acommodity a) (astyle a)) mempty --- TODO: should probably detect and report inconsistencies here.--- Though, we don't have the info for a good error message, so maybe elsewhere. -- | Given a list of amount styles (assumed to be from parsed amounts -- in a single commodity), in parse order, choose a canonical style.+canonicalStyleFrom :: [AmountStyle] -> AmountStyle+-- canonicalStyleFrom [] = amountstyle+canonicalStyleFrom ss = foldl' canonicalStyle amountstyle ss++-- TODO: should probably detect and report inconsistencies here.+-- Though, we don't have the info for a good error message, so maybe elsewhere.+-- | Given a pair of AmountStyles, choose a canonical style. -- This is:--- the general style of the first amount, +-- the general style of the first amount, -- with the first digit group style seen, -- with the maximum precision of all.----canonicalStyleFrom :: [AmountStyle] -> AmountStyle-canonicalStyleFrom [] = amountstyle-canonicalStyleFrom ss@(s:_) =-  s{asprecision=prec, asdecimalpoint=Just decmark, asdigitgroups=mgrps}+canonicalStyle :: AmountStyle -> AmountStyle -> AmountStyle+canonicalStyle a b = a{asprecision=prec, asdecimalpoint=decmark, asdigitgroups=mgrps}   where     -- precision is maximum of all precisions-    prec = maximumStrict $ map asprecision ss+    prec = max (asprecision a) (asprecision b)     -- identify the digit group mark (& group sizes)-    mgrps = headMay $ mapMaybe asdigitgroups ss+    mgrps = asdigitgroups a <|> asdigitgroups b     -- if a digit group mark was identified above, we can rely on that;     -- make sure the decimal mark is different. If not, default to period.-    defdecmark =-      case mgrps of+    defdecmark = case mgrps of         Just (DigitGroups '.' _) -> ','         _                        -> '.'     -- identify the decimal mark: the first one used, or the above default,     -- but never the same character as the digit group mark.     -- urgh.. refactor..     decmark = case mgrps of-                Just _ -> defdecmark-                _      -> headDef defdecmark $ mapMaybe asdecimalpoint ss+        Just _  -> Just defdecmark+        Nothing -> asdecimalpoint a <|> asdecimalpoint b <|> Just defdecmark  -- -- | Apply this journal's historical price records to unpriced amounts where possible. -- journalApplyPriceDirectives :: Journal -> Journal@@ -1185,17 +1288,34 @@ -- of all this journal's transactions and postings, or DateSpan Nothing Nothing -- if there are none. journalDateSpan :: Bool -> Journal -> DateSpan-journalDateSpan secondary j-    | null ts   = DateSpan Nothing Nothing-    | otherwise = DateSpan (Just earliest) (Just $ addDays 1 latest)-    where-      earliest = minimumStrict dates-      latest   = maximumStrict dates-      dates    = pdates ++ tdates-      tdates   = map (if secondary then transactionDate2 else tdate) ts-      pdates   = concatMap (mapMaybe (if secondary then (Just . postingDate2) else pdate) . tpostings) ts-      ts       = jtxns j+journalDateSpan False = journalDateSpanHelper $ Just PrimaryDate+journalDateSpan True  = journalDateSpanHelper $ Just SecondaryDate +-- | The fully specified date span enclosing the dates (primary and secondary)+-- of all this journal's transactions and postings, or DateSpan Nothing Nothing+-- if there are none.+journalDateSpanBothDates :: Journal -> DateSpan+journalDateSpanBothDates = journalDateSpanHelper Nothing++-- | A helper for journalDateSpan which takes Maybe WhichDate directly. Nothing+-- uses both primary and secondary dates.+journalDateSpanHelper :: Maybe WhichDate -> Journal -> DateSpan+journalDateSpanHelper whichdate j =+    DateSpan (minimumMay dates) (addDays 1 <$> maximumMay dates)+  where+    dates    = pdates ++ tdates+    tdates   = concatMap gettdate ts+    pdates   = concatMap getpdate $ concatMap tpostings ts+    ts       = jtxns j+    gettdate t = case whichdate of+        Just PrimaryDate   -> [tdate t]+        Just SecondaryDate -> [fromMaybe (tdate t) $ tdate2 t]+        Nothing            -> tdate t : maybeToList (tdate2 t)+    getpdate p = case whichdate of+        Just PrimaryDate   -> maybeToList $ pdate p+        Just SecondaryDate -> maybeToList $ pdate2 p <|> pdate p+        Nothing            -> catMaybes [pdate p, pdate2 p]+ -- | The earliest of this journal's transaction and posting dates, or -- Nothing if there are none. journalStartDate :: Bool -> Journal -> Maybe Day@@ -1241,7 +1361,7 @@   case mapM (transactionApplyAliases aliases) $ jtxns j of     Right ts -> Right j{jtxns = ts}     Left err -> Left err-  + -- -- | Build a database of market prices in effect on the given date, -- -- from the journal's price directives. -- journalPrices :: Day -> Journal -> Prices@@ -1253,7 +1373,7 @@ --     [ "P" --     , showDate (pddate pd) --     , T.unpack (pdcommodity pd)---     , (showAmount . setAmountPrecision maxprecision) (pdamount pd+--     , (showAmount . amountSetPrecision maxprecision) (pdamount pd --     ) --     ] 

@@ -44,7 +44,7 @@ import           Data.Maybe import qualified Data.Text.Lazy    as TL import qualified Data.Text.Lazy.IO as TL-import           Data.Text.Lazy.Builder (toLazyText)+import qualified Data.Text.Lazy.Builder as TB import           GHC.Generics (Generic) import           System.Time (ClockTime) @@ -126,6 +126,7 @@ instance ToJSON AccountType instance ToJSONKey AccountType instance ToJSON AccountDeclarationInfo+instance ToJSON PayeeDeclarationInfo instance ToJSON Commodity instance ToJSON TimeclockCode instance ToJSON TimeclockEntry@@ -231,7 +232,7 @@  -- | Show a JSON-convertible haskell value as pretty-printed JSON text. toJsonText :: ToJSON a => a -> TL.Text-toJsonText = (<>"\n") . toLazyText . encodePrettyToTextBuilder+toJsonText = TB.toLazyText . (<> TB.fromText "\n") . encodePrettyToTextBuilder  -- | Write a JSON-convertible haskell value to a pretty-printed JSON file. -- Eg: writeJsonFile "a.json" nulltransaction

@@ -5,6 +5,8 @@  -} +{-# LANGUAGE OverloadedStrings #-}+ module Hledger.Data.Period (    periodAsDateSpan   ,dateSpanAsPeriod@@ -30,6 +32,8 @@ ) where +import Data.Text (Text)+import qualified Data.Text as T import Data.Time.Calendar import Data.Time.Calendar.MonthDay import Data.Time.Calendar.OrdinalDate@@ -155,21 +159,23 @@ -- -- >>> showPeriod (WeekPeriod (fromGregorian 2016 7 25)) -- "2016-07-25W30"-showPeriod (DayPeriod b)       = formatTime defaultTimeLocale "%F" b              -- DATE-showPeriod (WeekPeriod b)      = formatTime defaultTimeLocale "%FW%V" b           -- STARTDATEWYEARWEEK-showPeriod (MonthPeriod y m)   = printf "%04d-%02d" y m                           -- YYYY-MM-showPeriod (QuarterPeriod y q) = printf "%04dQ%d" y q                             -- YYYYQN-showPeriod (YearPeriod y)      = printf "%04d" y                                  -- YYYY-showPeriod (PeriodBetween b e) = formatTime defaultTimeLocale "%F" b+showPeriod :: Period -> Text+showPeriod (DayPeriod b)       = T.pack $ formatTime defaultTimeLocale "%F" b              -- DATE+showPeriod (WeekPeriod b)      = T.pack $ formatTime defaultTimeLocale "%FW%V" b           -- STARTDATEWYEARWEEK+showPeriod (MonthPeriod y m)   = T.pack $ printf "%04d-%02d" y m                           -- YYYY-MM+showPeriod (QuarterPeriod y q) = T.pack $ printf "%04dQ%d" y q                             -- YYYYQN+showPeriod (YearPeriod y)      = T.pack $ printf "%04d" y                                  -- YYYY+showPeriod (PeriodBetween b e) = T.pack $ formatTime defaultTimeLocale "%F" b                                  ++ formatTime defaultTimeLocale "..%F" (addDays (-1) e) -- STARTDATE..INCLUSIVEENDDATE-showPeriod (PeriodFrom b)      = formatTime defaultTimeLocale "%F.." b                   -- STARTDATE..-showPeriod (PeriodTo e)        = formatTime defaultTimeLocale "..%F" (addDays (-1) e)    -- ..INCLUSIVEENDDATE+showPeriod (PeriodFrom b)      = T.pack $ formatTime defaultTimeLocale "%F.." b                   -- STARTDATE..+showPeriod (PeriodTo e)        = T.pack $ formatTime defaultTimeLocale "..%F" (addDays (-1) e)    -- ..INCLUSIVEENDDATE showPeriod PeriodAll           = ".."  -- | Like showPeriod, but if it's a month period show just -- the 3 letter month name abbreviation for the current locale.+showPeriodMonthAbbrev :: Period -> Text showPeriodMonthAbbrev (MonthPeriod _ m)                           -- Jan-  | m > 0 && m <= length monthnames = snd $ monthnames !! (m-1)+  | m > 0 && m <= length monthnames = T.pack . snd $ monthnames !! (m-1)   where monthnames = months defaultTimeLocale showPeriodMonthAbbrev p = showPeriod p 

@@ -16,6 +16,7 @@ import Data.Semigroup ((<>)) #endif import qualified Data.Text as T+import qualified Data.Text.IO as T import Text.Printf  import Hledger.Data.Types@@ -40,7 +41,7 @@   case checkPeriodicTransactionStartDate i s t of     Just e  -> error' e  -- PARTIAL:     Nothing ->-      mapM_ (putStr . showTransaction) $+      mapM_ (T.putStr . showTransaction) $         runPeriodicTransaction           nullperiodictransaction{ ptperiodexpr=t , ptspan=s, ptinterval=i, ptpostings=["a" `post` usd 1] }           nulldatespan@@ -52,7 +53,7 @@   case checkPeriodicTransactionStartDate i s t of     Just e  -> error' e  -- PARTIAL:     Nothing ->-      mapM_ (putStr . showTransaction) $+      mapM_ (T.putStr . showTransaction) $         runPeriodicTransaction           nullperiodictransaction{ ptperiodexpr=t , ptspan=s, ptinterval=i, ptpostings=["a" `post` usd 1] }           span

@@ -64,6 +64,7 @@   -- * misc.   showComment,   postingTransformAmount,+  postingApplyCostValuation,   postingApplyValuation,   postingToCost,   tests_Posting@@ -161,20 +162,20 @@ -- XXX once rendered user output, but just for debugging now; clean up showPosting :: Posting -> String showPosting p@Posting{paccount=a,pamount=amt,ptype=t} =-    unlines $ [concatTopPadded [show (postingDate p) ++ " ", showaccountname a ++ " ", showamount amt, showComment (pcomment p)]]+    unlines $ [concatTopPadded [show (postingDate p) ++ " ", showaccountname a ++ " ", showamount amt, T.unpack . showComment $ pcomment p]]     where       ledger3ishlayout = False       acctnamewidth = if ledger3ishlayout then 25 else 22-      showaccountname = fitString (Just acctnamewidth) Nothing False False . bracket . T.unpack . elideAccountName width+      showaccountname = T.unpack . fitText (Just acctnamewidth) Nothing False False . bracket . elideAccountName width       (bracket,width) = case t of-                          BalancedVirtualPosting -> (\s -> "["++s++"]", acctnamewidth-2)-                          VirtualPosting -> (\s -> "("++s++")", acctnamewidth-2)-                          _ -> (id,acctnamewidth)-      showamount = fst . showMixed showAmount (Just 12) Nothing False+                          BalancedVirtualPosting -> (wrap "[" "]", acctnamewidth-2)+                          VirtualPosting         -> (wrap "(" ")", acctnamewidth-2)+                          _                      -> (id,acctnamewidth)+      showamount = wbUnpack . showMixedAmountB noColour{displayMinWidth=Just 12}  -showComment :: Text -> String-showComment t = if T.null t then "" else "  ;" ++ T.unpack t+showComment :: Text -> Text+showComment t = if T.null t then "" else "  ;" <> t  isReal :: Posting -> Bool isReal p = ptype p == RegularPosting@@ -274,9 +275,9 @@                                     RegularPosting -> a  accountNameWithPostingType :: PostingType -> AccountName -> AccountName-accountNameWithPostingType BalancedVirtualPosting a = "["<>accountNameWithoutPostingType a<>"]"-accountNameWithPostingType VirtualPosting a = "("<>accountNameWithoutPostingType a<>")"-accountNameWithPostingType RegularPosting a = accountNameWithoutPostingType a+accountNameWithPostingType BalancedVirtualPosting = wrap "[" "]" . accountNameWithoutPostingType+accountNameWithPostingType VirtualPosting         = wrap "(" ")" . accountNameWithoutPostingType+accountNameWithPostingType RegularPosting         = accountNameWithoutPostingType  -- | Prefix one account name to another, preserving posting type -- indicators like concatAccountNames.@@ -330,33 +331,24 @@ aliasReplace (RegexAlias re repl) a =   fmap T.pack . regexReplace re repl $ T.unpack a -- XXX +-- | Apply a specified costing and valuation to this posting's amount,+-- using the provided price oracle, commodity styles, and reference dates.+-- Costing is done first if requested, and after that any valuation.+-- See amountApplyValuation and amountCost.+postingApplyCostValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> Costing -> Maybe ValuationType -> Posting -> Posting+postingApplyCostValuation priceoracle styles periodlast today cost v p =+    postingTransformAmount (mixedAmountApplyCostValuation priceoracle styles periodlast today (postingDate p) cost v) p+ -- | Apply a specified valuation to this posting's amount, using the--- provided price oracle, commodity styles, reference dates, and--- whether this is for a multiperiod report or not. See--- amountApplyValuation.-postingApplyValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Maybe Day -> Day -> Bool -> Posting -> ValuationType -> Posting-postingApplyValuation priceoracle styles periodlast mreportlast today ismultiperiod p v =-  case v of-    AtCost    Nothing            -> postingToCost styles p-    AtCost    mc                 -> postingValueAtDate priceoracle styles mc periodlast $ postingToCost styles p-    AtThen    mc                 -> postingValueAtDate priceoracle styles mc (postingDate p) p-    AtEnd     mc                 -> postingValueAtDate priceoracle styles mc periodlast p-    AtNow     mc                 -> postingValueAtDate priceoracle styles mc today p-    AtDefault mc | ismultiperiod -> postingValueAtDate priceoracle styles mc periodlast p-    AtDefault mc                 -> postingValueAtDate priceoracle styles mc (fromMaybe today mreportlast) p-    AtDate d  mc                 -> postingValueAtDate priceoracle styles mc d p+-- provided price oracle, commodity styles, and reference dates.+-- See amountApplyValuation.+postingApplyValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> ValuationType -> Posting -> Posting+postingApplyValuation priceoracle styles periodlast today v p =+    postingTransformAmount (mixedAmountApplyValuation priceoracle styles periodlast today (postingDate p) v) p  -- | Convert this posting's amount to cost, and apply the appropriate amount styles. postingToCost :: M.Map CommoditySymbol AmountStyle -> Posting -> Posting-postingToCost styles p@Posting{pamount=a} = p{pamount=styleMixedAmount styles $ mixedAmountCost a}---- | Convert this posting's amount to market value in the given commodity,--- or the default valuation commodity, at the given valuation date,--- using the given market price oracle.--- When market prices available on that date are not sufficient to--- calculate the value, amounts are left unchanged.-postingValueAtDate :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Maybe CommoditySymbol -> Day -> Posting -> Posting-postingValueAtDate priceoracle styles mc d p = postingTransformAmount (mixedAmountValueAtDate priceoracle styles mc d) p+postingToCost styles = postingTransformAmount (styleMixedAmount styles . mixedAmountCost)  -- | Apply a transform function to this posting's amount. postingTransformAmount :: (MixedAmount -> MixedAmount) -> Posting -> Posting@@ -385,7 +377,7 @@ -- A space is inserted following the colon, before the value. commentAddTagNextLine :: Text -> Tag -> Text commentAddTagNextLine cmt (t,v) =-  cmt <> if "\n" `T.isSuffixOf` cmt then "" else "\n" <> t <> ": " <> v +  cmt <> (if "\n" `T.isSuffixOf` cmt then "" else "\n") <> t <> ": " <> v    -- tests

@@ -2,7 +2,10 @@ -- hledger's report item fields. The formats are used by -- report-specific renderers like renderBalanceReportItem. -{-# LANGUAGE FlexibleContexts, OverloadedStrings, TypeFamilies, PackageImports #-}+{-# LANGUAGE FlexibleContexts  #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PackageImports    #-}+{-# LANGUAGE TypeFamilies      #-}  module Hledger.Data.StringFormat (           parseStringFormat@@ -10,7 +13,6 @@         , StringFormat(..)         , StringFormatComponent(..)         , ReportItemField(..)-        , overlineWidth         , defaultBalanceLineFormat         , tests_StringFormat         ) where@@ -21,22 +23,20 @@ import Data.Char (isPrint) import Data.Default (Default(..)) import Data.Maybe (isJust)--- import qualified Data.Text as T+import Data.Text (Text)+import qualified Data.Text as T import Text.Megaparsec import Text.Megaparsec.Char (char, digitChar, string) -import Hledger.Utils.Parse (SimpleStringParser)-import Hledger.Utils.String (formatString)+import Hledger.Utils.Parse (SimpleTextParser)+import Hledger.Utils.Text (formatText) import Hledger.Utils.Test  -- | A format specification/template to use when rendering a report line item as text. ----- A format is an optional width, along with a sequence of components;--- each is either a literal string, or a hledger report item field with--- specified width and justification whose value will be interpolated--- at render time. The optional width determines the length of the--- overline to draw above the totals row; if it is Nothing, then the--- maximum width of all lines is used.+-- A format is a sequence of components; each is either a literal+-- string, or a hledger report item field with specified width and+-- justification whose value will be interpolated at render time. -- -- A component's value may be a multi-line string (or a -- multi-commodity amount), in which case the final string will be@@ -47,13 +47,13 @@ -- mode, which provides a limited StringFormat renderer. -- data StringFormat =-    OneLine       (Maybe Int) [StringFormatComponent] -- ^ multi-line values will be rendered on one line, comma-separated-  | TopAligned    (Maybe Int) [StringFormatComponent] -- ^ values will be top-aligned (and bottom-padded to the same height)-  | BottomAligned (Maybe Int) [StringFormatComponent] -- ^ values will be bottom-aligned (and top-padded)+    OneLine       [StringFormatComponent] -- ^ multi-line values will be rendered on one line, comma-separated+  | TopAligned    [StringFormatComponent] -- ^ values will be top-aligned (and bottom-padded to the same height)+  | BottomAligned [StringFormatComponent] -- ^ values will be bottom-aligned (and top-padded)   deriving (Show, Eq)  data StringFormatComponent =-    FormatLiteral String        -- ^ Literal text to be rendered as-is+    FormatLiteral Text          -- ^ Literal text to be rendered as-is   | FormatField Bool                 (Maybe Int)                 (Maybe Int)@@ -81,14 +81,9 @@  instance Default StringFormat where def = defaultBalanceLineFormat -overlineWidth :: StringFormat -> Maybe Int-overlineWidth (OneLine       w _) = w-overlineWidth (TopAligned    w _) = w-overlineWidth (BottomAligned w _) = w- -- | Default line format for balance report: "%20(total)  %2(depth_spacer)%-(account)" defaultBalanceLineFormat :: StringFormat-defaultBalanceLineFormat = BottomAligned (Just 20) [+defaultBalanceLineFormat = BottomAligned [       FormatField False (Just 20) Nothing TotalField     , FormatLiteral "  "     , FormatField True (Just 2) Nothing DepthSpacerField@@ -102,37 +97,37 @@ ----------------------------------------------------------------------  -- | Parse a string format specification, or return a parse error.-parseStringFormat :: String -> Either String StringFormat+parseStringFormat :: Text -> Either String StringFormat parseStringFormat input = case (runParser (stringformatp <* eof) "(unknown)") input of     Left y -> Left $ show y     Right x -> Right x  defaultStringFormatStyle = BottomAligned -stringformatp :: SimpleStringParser StringFormat+stringformatp :: SimpleTextParser StringFormat stringformatp = do   alignspec <- optional (try $ char '%' >> oneOf ("^_,"::String))   let constructor =         case alignspec of-          Just '^' -> TopAligned Nothing-          Just '_' -> BottomAligned Nothing-          Just ',' -> OneLine Nothing-          _        -> defaultStringFormatStyle Nothing+          Just '^' -> TopAligned+          Just '_' -> BottomAligned+          Just ',' -> OneLine+          _        -> defaultStringFormatStyle   constructor <$> many componentp -componentp :: SimpleStringParser StringFormatComponent+componentp :: SimpleTextParser StringFormatComponent componentp = formatliteralp <|> formatfieldp -formatliteralp :: SimpleStringParser StringFormatComponent+formatliteralp :: SimpleTextParser StringFormatComponent formatliteralp = do-    s <- some c+    s <- T.pack <$> some c     return $ FormatLiteral s     where       isPrintableButNotPercentage x = isPrint x && x /= '%'       c =     (satisfy isPrintableButNotPercentage <?> "printable character")           <|> try (string "%%" >> return '%') -formatfieldp :: SimpleStringParser StringFormatComponent+formatfieldp :: SimpleTextParser StringFormatComponent formatfieldp = do     char '%'     leftJustified <- optional (char '-')@@ -147,7 +142,7 @@         Just text -> Just m where ((m,_):_) = readDec text         _ -> Nothing -fieldp :: SimpleStringParser ReportItemField+fieldp :: SimpleTextParser ReportItemField fieldp = do         try (string "account" >> return AccountField)     <|> try (string "depth_spacer" >> return DepthSpacerField)@@ -161,8 +156,8 @@ formatStringTester fs value expected = actual @?= expected   where     actual = case fs of-      FormatLiteral l                   -> formatString False Nothing Nothing l-      FormatField leftJustify min max _ -> formatString leftJustify min max value+      FormatLiteral l                   -> formatText False Nothing Nothing l+      FormatField leftJustify min max _ -> formatText leftJustify min max value  tests_StringFormat = tests "StringFormat" [ @@ -176,25 +171,25 @@       formatStringTester (FormatField True (Just 20) (Just 20) DescriptionField) "description" "description         "       formatStringTester (FormatField True Nothing (Just 3) DescriptionField)    "description" "des" -  ,let s `gives` expected = test s $ parseStringFormat s @?= Right expected+  ,let s `gives` expected = test s $ parseStringFormat (T.pack s) @?= Right expected    in tests "parseStringFormat" [-      ""                           `gives` (defaultStringFormatStyle Nothing [])-    , "D"                          `gives` (defaultStringFormatStyle Nothing [FormatLiteral "D"])-    , "%(date)"                    `gives` (defaultStringFormatStyle Nothing [FormatField False Nothing Nothing DescriptionField])-    , "%(total)"                   `gives` (defaultStringFormatStyle Nothing [FormatField False Nothing Nothing TotalField])+      ""                           `gives` (defaultStringFormatStyle [])+    , "D"                          `gives` (defaultStringFormatStyle [FormatLiteral "D"])+    , "%(date)"                    `gives` (defaultStringFormatStyle [FormatField False Nothing Nothing DescriptionField])+    , "%(total)"                   `gives` (defaultStringFormatStyle [FormatField False Nothing Nothing TotalField])     -- TODO     -- , "^%(total)"                  `gives` (TopAligned [FormatField False Nothing Nothing TotalField])     -- , "_%(total)"                  `gives` (BottomAligned [FormatField False Nothing Nothing TotalField])     -- , ",%(total)"                  `gives` (OneLine [FormatField False Nothing Nothing TotalField])-    , "Hello %(date)!"             `gives` (defaultStringFormatStyle Nothing [FormatLiteral "Hello ", FormatField False Nothing Nothing DescriptionField, FormatLiteral "!"])-    , "%-(date)"                   `gives` (defaultStringFormatStyle Nothing [FormatField True Nothing Nothing DescriptionField])-    , "%20(date)"                  `gives` (defaultStringFormatStyle Nothing [FormatField False (Just 20) Nothing DescriptionField])-    , "%.10(date)"                 `gives` (defaultStringFormatStyle Nothing [FormatField False Nothing (Just 10) DescriptionField])-    , "%20.10(date)"               `gives` (defaultStringFormatStyle Nothing [FormatField False (Just 20) (Just 10) DescriptionField])-    , "%20(account) %.10(total)"   `gives` (defaultStringFormatStyle Nothing [FormatField False (Just 20) Nothing AccountField-                                                                             ,FormatLiteral " "-                                                                             ,FormatField False Nothing (Just 10) TotalField-                                                                             ])+    , "Hello %(date)!"             `gives` (defaultStringFormatStyle [FormatLiteral "Hello ", FormatField False Nothing Nothing DescriptionField, FormatLiteral "!"])+    , "%-(date)"                   `gives` (defaultStringFormatStyle [FormatField True Nothing Nothing DescriptionField])+    , "%20(date)"                  `gives` (defaultStringFormatStyle [FormatField False (Just 20) Nothing DescriptionField])+    , "%.10(date)"                 `gives` (defaultStringFormatStyle [FormatField False Nothing (Just 10) DescriptionField])+    , "%20.10(date)"               `gives` (defaultStringFormatStyle [FormatField False (Just 20) (Just 10) DescriptionField])+    , "%20(account) %.10(total)"   `gives` (defaultStringFormatStyle [FormatField False (Just 20) Nothing AccountField+                                                                     ,FormatLiteral " "+                                                                     ,FormatField False Nothing (Just 10) TotalField+                                                                     ])     , test "newline not parsed" $ assertLeft $ parseStringFormat "\n"     ]  ]

@@ -6,6 +6,7 @@  -} +{-# LANGUAGE CPP               #-} {-# LANGUAGE OverloadedStrings #-}  module Hledger.Data.Timeclock (@@ -14,14 +15,18 @@ ) where -import Data.Maybe+import Data.Maybe (fromMaybe)+#if !(MIN_VERSION_base(4,11,0))+import Data.Semigroup ((<>))+#endif -- import Data.Text (Text) import qualified Data.Text as T-import Data.Time.Calendar-import Data.Time.Clock-import Data.Time.Format-import Data.Time.LocalTime-import Text.Printf+import Data.Time.Calendar (addDays)+import Data.Time.Clock (addUTCTime, getCurrentTime)+import Data.Time.Format (defaultTimeLocale, formatTime, parseTimeM)+import Data.Time.LocalTime (LocalTime(..), TimeOfDay(..), getCurrentTimeZone,+                            localTimeToUTC, midnight, utc, utcToLocalTime)+import Text.Printf (printf)  import Hledger.Utils import Hledger.Data.Types@@ -90,8 +95,8 @@ entryFromTimeclockInOut :: TimeclockEntry -> TimeclockEntry -> Transaction entryFromTimeclockInOut i o     | otime >= itime = t-    | otherwise =-        error' $ "clock-out time less than clock-in time in:\n" ++ showTransaction t  -- PARTIAL:+    | otherwise = error' . T.unpack $+        "clock-out time less than clock-in time in:\n" <> showTransaction t  -- PARTIAL:     where       t = Transaction {             tindex       = 0,

@@ -7,12 +7,14 @@  -} -{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE CPP               #-}+{-# LANGUAGE FlexibleContexts  #-}+{-# LANGUAGE LambdaCase        #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE Rank2Types #-}-{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE Rank2Types        #-}+{-# LANGUAGE RecordWildCards   #-} +{-# LANGUAGE NamedFieldPuns #-} module Hledger.Data.Transaction (   -- * Transaction   nulltransaction,@@ -31,9 +33,12 @@   balanceTransaction,   balanceTransactionHelper,   transactionTransformPostings,+  transactionApplyCostValuation,   transactionApplyValuation,   transactionToCost,   transactionApplyAliases,+  transactionMapPostings,+  transactionMapPostingAmounts,   -- nonzerobalanceerror,   -- * date operations   transactionDate2,@@ -44,8 +49,6 @@   -- * rendering   showTransaction,   showTransactionOneLineAmounts,-  showTransactionUnelided,-  showTransactionUnelidedOneLineAmounts,   -- showPostingLine,   showPostingLines,   -- * GenericSourcePos@@ -53,17 +56,24 @@   sourceFirstLine,   showGenericSourcePos,   annotateErrorWithTransaction,+  transactionFile,   -- * tests   tests_Transaction ) where-import Data.List++import Data.Default (def)+import Data.List (intercalate, partition) import Data.List.Extra (nubSort)-import Data.Maybe+import Data.Maybe (fromMaybe, mapMaybe)+#if !(MIN_VERSION_base(4,11,0))+import Data.Semigroup ((<>))+#endif import Data.Text (Text) import qualified Data.Text as T-import Data.Time.Calendar-import Text.Printf+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Builder as TB+import Data.Time.Calendar (Day, fromGregorian) import qualified Data.Map as M  import Hledger.Utils@@ -72,6 +82,8 @@ import Hledger.Data.Posting import Hledger.Data.Amount import Hledger.Data.Valuation+import Text.Tabular+import Text.Tabular.AsciiWide  sourceFilePath :: GenericSourcePos -> FilePath sourceFilePath = \case@@ -148,53 +160,46 @@ are displayed as multiple similar postings, one per commodity. (Normally does not happen with this function). -}-showTransaction :: Transaction -> String-showTransaction = showTransactionHelper False---- | Deprecated alias for 'showTransaction'-showTransactionUnelided :: Transaction -> String-showTransactionUnelided = showTransaction  -- TODO: drop it+showTransaction :: Transaction -> Text+showTransaction = TL.toStrict . TB.toLazyText . showTransactionHelper False  -- | Like showTransaction, but explicit multi-commodity amounts -- are shown on one line, comma-separated. In this case the output will -- not be parseable journal syntax.-showTransactionOneLineAmounts :: Transaction -> String-showTransactionOneLineAmounts = showTransactionHelper True---- | Deprecated alias for 'showTransactionOneLineAmounts'-showTransactionUnelidedOneLineAmounts :: Transaction -> String-showTransactionUnelidedOneLineAmounts = showTransactionOneLineAmounts  -- TODO: drop it+showTransactionOneLineAmounts :: Transaction -> Text+showTransactionOneLineAmounts = TL.toStrict . TB.toLazyText . showTransactionHelper True  -- | Helper for showTransaction*.-showTransactionHelper :: Bool -> Transaction -> String+showTransactionHelper :: Bool -> Transaction -> TB.Builder showTransactionHelper onelineamounts t =-    unlines $ [descriptionline]-              ++ newlinecomments-              ++ (postingsAsLines onelineamounts (tpostings t))-              ++ [""]-    where-      descriptionline = rstrip $ concat [date, status, code, desc, samelinecomment]-      date = showDate (tdate t) ++ maybe "" (("="++) . showDate) (tdate2 t)-      status | tstatus t == Cleared = " *"-             | tstatus t == Pending = " !"-             | otherwise            = ""-      code = if T.length (tcode t) > 0 then printf " (%s)" $ T.unpack $ tcode t else ""-      desc = if null d then "" else " " ++ d where d = T.unpack $ tdescription t-      (samelinecomment, newlinecomments) =-        case renderCommentLines (tcomment t) of []   -> ("",[])-                                                c:cs -> (c,cs)+      TB.fromText descriptionline <> newline+    <> foldMap ((<> newline) . TB.fromText) newlinecomments+    <> foldMap ((<> newline) . TB.fromText) (postingsAsLines onelineamounts $ tpostings t)+    <> newline+  where+    descriptionline = T.stripEnd $ T.concat [date, status, code, desc, samelinecomment]+    date = showDate (tdate t) <> maybe "" (("="<>) . showDate) (tdate2 t)+    status | tstatus t == Cleared = " *"+           | tstatus t == Pending = " !"+           | otherwise            = ""+    code = if T.null (tcode t) then "" else wrap " (" ")" $ tcode t+    desc = if T.null d then "" else " " <> d where d = tdescription t+    (samelinecomment, newlinecomments) =+      case renderCommentLines (tcomment t) of []   -> ("",[])+                                              c:cs -> (c,cs)+    newline = TB.singleton '\n'  -- | Render a transaction or posting's comment as indented, semicolon-prefixed comment lines. -- The first line (unless empty) will have leading space, subsequent lines will have a larger indent.-renderCommentLines :: Text -> [String]+renderCommentLines :: Text -> [Text] renderCommentLines t =-  case lines $ T.unpack t of+  case T.lines t of     []      -> []-    [l]     -> [(commentSpace . comment) l]        -- single-line comment+    [l]     -> [commentSpace $ comment l]        -- single-line comment     ("":ls) -> "" : map (lineIndent . comment) ls  -- multi-line comment with empty first line-    (l:ls)  -> (commentSpace . comment) l : map (lineIndent . comment) ls+    (l:ls)  -> commentSpace (comment l) : map (lineIndent . comment) ls   where-    comment = ("; "++)+    comment = ("; "<>)  -- | Given a transaction and its postings, render the postings, suitable -- for `print` output. Normally this output will be valid journal syntax which@@ -214,7 +219,7 @@ -- Posting amounts will be aligned with each other, starting about 4 columns -- beyond the widest account name (see postingAsLines for details). ---postingsAsLines :: Bool -> [Posting] -> [String]+postingsAsLines :: Bool -> [Posting] -> [Text] postingsAsLines onelineamounts ps = concatMap (postingAsLines False onelineamounts ps) ps  -- | Render one posting, on one or more lines, suitable for `print` output.@@ -236,41 +241,55 @@ -- increased if needed to match the posting with the longest account name. -- This is used to align the amounts of a transaction's postings. ---postingAsLines :: Bool -> Bool -> [Posting] -> Posting -> [String]-postingAsLines elideamount onelineamounts pstoalignwith p = concat [-    postingblock-    ++ newlinecomments-    | postingblock <- postingblocks]+postingAsLines :: Bool -> Bool -> [Posting] -> Posting -> [Text]+postingAsLines elideamount onelineamounts pstoalignwith p =+    concatMap (++ newlinecomments) postingblocks   where-    postingblocks = [map rstrip $ lines $ concatTopPadded [statusandaccount, "  ", amt, assertion, samelinecomment] | amt <- shownAmounts]-    assertion = maybe "" ((' ':).showBalanceAssertion) $ pbalanceassertion p-    statusandaccount = lineIndent $ fitString (Just $ minwidth) Nothing False True $ pstatusandacct p-        where-          -- pad to the maximum account name width, plus 2 to leave room for status flags, to keep amounts aligned-          minwidth = maximum $ map ((2+) . textWidth . T.pack . pacctstr) pstoalignwith-          pstatusandacct p' = pstatusprefix p' ++ pacctstr p'-          pstatusprefix p' | null s    = ""-                           | otherwise = s ++ " "-            where s = show $ pstatus p'-          pacctstr p' = showAccountName Nothing (ptype p') (paccount p')+    -- This needs to be converted to strict Text in order to strip trailing+    -- spaces. This adds a small amount of inefficiency, and the only difference+    -- is whether there are trailing spaces in print (and related) reports. This+    -- could be removed and we could just keep everything as a Text Builder, but+    -- would require adding trailing spaces to 42 failing tests.+    postingblocks = [map T.stripEnd . T.lines . TL.toStrict $+                       render [ textCell BottomLeft statusandaccount+                              , textCell BottomLeft "  "+                              , Cell BottomLeft [amt]+                              , Cell BottomLeft [assertion]+                              , textCell BottomLeft samelinecomment+                              ]+                    | amt <- shownAmounts]+    render = renderRow def{tableBorders=False, borderSpaces=False} . Group NoLine . map Header+    assertion = maybe mempty ((WideBuilder (TB.singleton ' ') 1 <>).showBalanceAssertion) $ pbalanceassertion p+    statusandaccount = lineIndent . fitText (Just $ minwidth) Nothing False True $ pstatusandacct p+      where+        -- pad to the maximum account name width, plus 2 to leave room for status flags, to keep amounts aligned+        minwidth = maximum $ map ((2+) . textWidth . pacctstr) pstoalignwith+        pstatusandacct p' = pstatusprefix p' <> pacctstr p'+        pstatusprefix p' = case pstatus p' of+            Unmarked -> ""+            s        -> T.pack (show s) <> " "+        pacctstr p' = showAccountName Nothing (ptype p') (paccount p')      -- currently prices are considered part of the amount string when right-aligning amounts     shownAmounts-      | elideamount    = [""]-      | onelineamounts = [fst . showMixedOneLineUnnormalised showAmount (Just amtwidth) Nothing False $ pamount p]-      | null (amounts $ pamount p) = [""]-      | otherwise      = lines . fst . showMixedUnnormalised showAmount (Just amtwidth) Nothing False $ pamount p+      | elideamount || null (amounts $ pamount p) = [mempty]+      | otherwise = showMixedAmountLinesB displayopts $ pamount p       where-        amtwidth = maximum $ 12 : map (snd . showMixedUnnormalised showAmount Nothing Nothing False . pamount) pstoalignwith  -- min. 12 for backwards compatibility+        displayopts = noColour{displayOneLine=onelineamounts, displayMinWidth = Just amtwidth, displayNormalised=False}+        amtwidth = maximum $ 12 : map (wbWidth . showMixedAmountB displayopts{displayMinWidth=Nothing} . pamount) pstoalignwith  -- min. 12 for backwards compatibility      (samelinecomment, newlinecomments) =       case renderCommentLines (pcomment p) of []   -> ("",[])                                               c:cs -> (c,cs)  -- | Render a balance assertion, as the =[=][*] symbol and expected amount.-showBalanceAssertion :: BalanceAssertion -> [Char]+showBalanceAssertion :: BalanceAssertion -> WideBuilder showBalanceAssertion BalanceAssertion{..} =-  "=" ++ ['=' | batotal] ++ ['*' | bainclusive] ++ " " ++ showAmountWithZeroCommodity baamount+    singleton '=' <> eq <> ast <> singleton ' ' <> showAmountB def{displayZeroCommodity=True} baamount+  where+    eq  = if batotal     then singleton '=' else mempty+    ast = if bainclusive then singleton '*' else mempty+    singleton c = WideBuilder (TB.singleton c) 1  -- | Render a posting, simply. Used in balance assertion errors. -- showPostingLine p =@@ -286,33 +305,27 @@  -- | Render a posting, at the appropriate width for aligning with -- its siblings if any. Used by the rewrite command.-showPostingLines :: Posting -> [String]+showPostingLines :: Posting -> [Text] showPostingLines p = postingAsLines False False ps p where     ps | Just t <- ptransaction p = tpostings t        | otherwise = [p]  -- | Prepend a suitable indent for a posting (or transaction/posting comment) line.-lineIndent :: String -> String-lineIndent = ("    "++)+lineIndent :: Text -> Text+lineIndent = ("    "<>)  -- | Prepend the space required before a same-line comment.-commentSpace :: String -> String-commentSpace = ("  "++)+commentSpace :: Text -> Text+commentSpace = ("  "<>)  -- | Show an account name, clipped to the given width if any, and -- appropriately bracketed/parenthesised for the given posting type.-showAccountName :: Maybe Int -> PostingType -> AccountName -> String+showAccountName :: Maybe Int -> PostingType -> AccountName -> Text showAccountName w = fmt   where-    fmt RegularPosting = maybe id take w . T.unpack-    fmt VirtualPosting = parenthesise . maybe id (takeEnd . subtract 2) w . T.unpack-    fmt BalancedVirtualPosting = bracket . maybe id (takeEnd . subtract 2) w . T.unpack--parenthesise :: String -> String-parenthesise s = "("++s++")"--bracket :: String -> String-bracket s = "["++s++"]"+    fmt RegularPosting         = maybe id T.take w+    fmt VirtualPosting         = wrap "(" ")" . maybe id (T.takeEnd . subtract 2) w+    fmt BalancedVirtualPosting = wrap "[" "]" . maybe id (T.takeEnd . subtract 2) w  hasRealPostings :: Transaction -> Bool hasRealPostings = not . null . realPostings@@ -356,7 +369,7 @@      -- check for mixed signs, detecting nonzeros at display precision     canonicalise = maybe id canonicaliseMixedAmount mstyles-    signsOk ps = +    signsOk ps =       case filter (not.mixedAmountLooksZero) $ map (canonicalise.mixedAmountCost.pamount) ps of         nonzeros | length nonzeros >= 2                    -> length (nubSort $ mapMaybe isNegativeMixedAmount nonzeros) > 1@@ -427,7 +440,9 @@  annotateErrorWithTransaction :: Transaction -> String -> String annotateErrorWithTransaction t s =-  unlines [showGenericSourcePos $ tsourcepos t, s, rstrip $ showTransaction t]+  unlines [ showGenericSourcePos $ tsourcepos t, s+          , T.unpack . T.stripEnd $ showTransaction t+          ]  -- | Infer up to one missing amount for this transactions's real postings, and -- likewise for its balanced virtual postings, if needed; or return an error@@ -540,8 +555,9 @@         = p{pamount=Mixed [a{aprice=Just conversionprice}], poriginal=Just $ originalPosting p}       where         fromcommodity = head $ filter (`elem` sumcommodities) pcommodities -- these heads are ugly but should be safe+        totalpricesign = if aquantity a < 0 then negate else id         conversionprice-          | fromcount==1 = TotalPrice $ abs toamount `withPrecision` NaturalPrecision+          | fromcount==1 = TotalPrice $ totalpricesign (abs toamount) `withPrecision` NaturalPrecision           | otherwise    = UnitPrice $ abs unitprice `withPrecision` unitprecision           where             fromcount     = length $ filter ((==fromcommodity).acommodity) pamounts@@ -580,13 +596,19 @@ transactionTransformPostings :: (Posting -> Posting) -> Transaction -> Transaction transactionTransformPostings f t@Transaction{tpostings=ps} = t{tpostings=map f ps} +-- | Apply a specified costing and valuation to this transaction's amounts,+-- using the provided price oracle, commodity styles, and reference dates.+-- See amountApplyValuation and amountCost.+transactionApplyCostValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> Costing -> Maybe ValuationType -> Transaction -> Transaction+transactionApplyCostValuation priceoracle styles periodlast today cost v =+  transactionTransformPostings (postingApplyCostValuation priceoracle styles periodlast today cost v)+ -- | Apply a specified valuation to this transaction's amounts, using--- the provided price oracle, commodity styles, reference dates, and--- whether this is for a multiperiod report or not. See--- amountApplyValuation.-transactionApplyValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Maybe Day -> Day -> Bool -> Transaction -> ValuationType -> Transaction-transactionApplyValuation priceoracle styles periodlast mreportlast today ismultiperiod t v =-  transactionTransformPostings (\p -> postingApplyValuation priceoracle styles periodlast mreportlast today ismultiperiod p v) t+-- the provided price oracle, commodity styles, and reference dates.+-- See amountApplyValuation.+transactionApplyValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> ValuationType -> Transaction -> Transaction+transactionApplyValuation priceoracle styles periodlast today v =+  transactionTransformPostings (postingApplyValuation priceoracle styles periodlast today v)  -- | Convert this transaction's amounts to cost, and apply the appropriate amount styles. transactionToCost :: M.Map CommoditySymbol AmountStyle -> Transaction -> Transaction@@ -600,6 +622,21 @@     Right ps -> Right $ txnTieKnot $ t{tpostings=ps}     Left err -> Left err +-- | Apply a transformation to a transaction's postings.+transactionMapPostings :: (Posting -> Posting) -> Transaction -> Transaction+transactionMapPostings f t@Transaction{tpostings=ps} = t{tpostings=map f ps}++-- | Apply a transformation to a transaction's posting amounts.+transactionMapPostingAmounts :: (Amount -> Amount) -> Transaction -> Transaction+transactionMapPostingAmounts f  = transactionMapPostings (postingTransformAmount (mapMixedAmount f))++-- | The file path from which this transaction was parsed.+transactionFile :: Transaction -> FilePath+transactionFile Transaction{tsourcepos} =+  case tsourcepos of+    GenericSourcePos f _ _ -> f+    JournalSourcePos f _   -> f+ -- tests  tests_Transaction :: TestTree@@ -678,7 +715,7 @@            Right nulltransaction{tpostings = ["a" `post` usd (-5), "b" `post` usd 5]}          (fst <$> inferBalancingAmount M.empty nulltransaction{tpostings = ["a" `post` usd (-5), "b" `post` (eur 3 @@ usd 4), "c" `post` missingamt]}) @?=            Right nulltransaction{tpostings = ["a" `post` usd (-5), "b" `post` (eur 3 @@ usd 4), "c" `post` usd 1]}-         +     , tests "showTransaction" [           test "null transaction" $ showTransaction nulltransaction @?= "0000-01-01\n\n"         , test "non-null transaction" $ showTransaction@@ -701,7 +738,7 @@                       }                   ]               } @?=-          unlines+          T.unlines             [ "2012-05-14=2012-05-15 (code) desc  ; tcomment1"             , "    ; tcomment2"             , "    * a         $1.00"@@ -727,7 +764,7 @@                    , posting {paccount = "assets:checking", pamount = Mixed [usd (-47.18)], ptransaction = Just t}                    ]             in showTransaction t) @?=-          (unlines+          (T.unlines              [ "2007-01-28 coopportunity"              , "    expenses:food:groceries          $47.18"              , "    assets:checking                 $-47.18"@@ -750,7 +787,7 @@                 [ posting {paccount = "expenses:food:groceries", pamount = Mixed [usd 47.18]}                 , posting {paccount = "assets:checking", pamount = Mixed [usd (-47.19)]}                 ])) @?=-          (unlines+          (T.unlines              [ "2007-01-28 coopportunity"              , "    expenses:food:groceries          $47.18"              , "    assets:checking                 $-47.19"@@ -771,7 +808,7 @@                 ""                 []                 [posting {paccount = "expenses:food:groceries", pamount = missingmixedamt}])) @?=-          (unlines ["2007-01-28 coopportunity", "    expenses:food:groceries", ""])+          (T.unlines ["2007-01-28 coopportunity", "    expenses:food:groceries", ""])         , test "show a transaction with a priced commodityless amount" $           (showTransaction              (txnTieKnot $@@ -789,7 +826,7 @@                 [ posting {paccount = "a", pamount = Mixed [num 1 `at` (usd 2 `withPrecision` Precision 0)]}                 , posting {paccount = "b", pamount = missingmixedamt}                 ])) @?=-          (unlines ["2010-01-01 x", "    a          1 @ $2", "    b", ""])+          (T.unlines ["2010-01-01 x", "    a          1 @ $2", "    b", ""])         ]     , tests "balanceTransaction" [          test "detect unbalanced entry, sign error" $@@ -896,7 +933,7 @@                ""                []                [ posting {paccount = "a", pamount = Mixed [usd 1 @@ eur 1]}-               , posting {paccount = "a", pamount = Mixed [usd (-2) @@ eur 1]}+               , posting {paccount = "a", pamount = Mixed [usd (-2) @@ eur (-1)]}                ])         ]     , tests "isTransactionBalanced" [

@@ -26,7 +26,7 @@ import Hledger.Data.Transaction import Hledger.Query import Hledger.Data.Posting (commentJoin, commentAddTag)-import Hledger.Utils.Debug+import Hledger.Utils  -- $setup -- >>> :set -XOverloadedStrings@@ -62,7 +62,8 @@ -- postings when certain other postings are present. -- -- >>> t = nulltransaction{tpostings=["ping" `post` usd 1]}--- >>> test = either putStr (putStr.showTransaction) . fmap ($ t) . transactionModifierToFunction nulldate+-- >>> import qualified Data.Text.IO as T+-- >>> test = either putStr (T.putStr.showTransaction) . fmap ($ t) . transactionModifierToFunction nulldate -- >>> test $ TransactionModifier "" ["pong" `post` usd 2] -- 0000-01-01 --     ping           $1.00@@ -119,7 +120,7 @@             -- Approach 1: convert to a unit price and increase the display precision slightly             -- Mixed as = dbg6 "multipliedamount" $ n `multiplyMixedAmount` mixedAmountTotalPriceToUnitPrice matchedamount             -- Approach 2: multiply the total price (keeping it positive) as well as the quantity-            Mixed as = dbg6 "multipliedamount" $ n `multiplyMixedAmountAndPrice` matchedamount+            Mixed as = dbg6 "multipliedamount" $ n `multiplyMixedAmount` matchedamount           in             case acommodity pramount of               "" -> Mixed as@@ -137,7 +138,7 @@ renderPostingCommentDates :: Posting -> Posting renderPostingCommentDates p = p { pcomment = comment' }     where-        dates = T.concat $ catMaybes [T.pack . showDate <$> pdate p, ("=" <>) . T.pack . showDate <$> pdate2 p]+        dates = T.concat $ catMaybes [showDate <$> pdate p, ("=" <>) . showDate <$> pdate2 p]         comment'             | T.null dates = pcomment p-            | otherwise    = ("[" <> dates <> "]") `commentJoin` pcomment p+            | otherwise    = (wrap "[" "]" dates) `commentJoin` pcomment p

@@ -132,6 +132,8 @@  instance Default Interval where def = NoInterval +type Payee = Text+ type AccountName = Text  data AccountType =@@ -176,16 +178,16 @@ -- | An amount's per-unit or total cost/selling price in another -- commodity, as recorded in the journal entry eg with @ or @@. -- Docs call this "transaction price". The amount is always positive.-data AmountPrice = UnitPrice Amount | TotalPrice Amount+data AmountPrice = UnitPrice !Amount | TotalPrice !Amount   deriving (Eq,Ord,Generic,Show)  -- | Display style for an amount. data AmountStyle = AmountStyle {-      ascommodityside   :: Side,                 -- ^ does the symbol appear on the left or the right ?-      ascommodityspaced :: Bool,                 -- ^ space between symbol and quantity ?-      asprecision       :: !AmountPrecision,     -- ^ number of digits displayed after the decimal point-      asdecimalpoint    :: Maybe Char,           -- ^ character used as decimal point: period or comma. Nothing means "unspecified, use default"-      asdigitgroups     :: Maybe DigitGroupStyle -- ^ style for displaying digit groups, if any+      ascommodityside   :: !Side,                   -- ^ does the symbol appear on the left or the right ?+      ascommodityspaced :: !Bool,                   -- ^ space between symbol and quantity ?+      asprecision       :: !AmountPrecision,        -- ^ number of digits displayed after the decimal point+      asdecimalpoint    :: !(Maybe Char),           -- ^ character used as decimal point: period or comma. Nothing means "unspecified, use default"+      asdigitgroups     :: !(Maybe DigitGroupStyle) -- ^ style for displaying digit groups, if any } deriving (Eq,Ord,Read,Generic)  instance Show AmountStyle where@@ -197,6 +199,10 @@     (show asdecimalpoint)     (show asdigitgroups) +-- | The "display precision" for a hledger amount, by which we mean+-- the number of decimal digits to display to the right of the decimal mark.+-- This can be from 0 to 255 digits (the maximum supported by the Decimal library),+-- or NaturalPrecision meaning "show all significant decimal digits". data AmountPrecision = Precision !Word8 | NaturalPrecision deriving (Eq,Ord,Read,Show,Generic)  -- | A style for displaying digit groups in the integer part of a@@ -205,7 +211,7 @@ -- point), and the size of each group, starting with the one nearest -- the decimal point. The last group size is assumed to repeat. Eg, -- comma between thousands is DigitGroups ',' [3].-data DigitGroupStyle = DigitGroups Char [Word8]+data DigitGroupStyle = DigitGroups !Char ![Word8]   deriving (Eq,Ord,Read,Show,Generic)  type CommoditySymbol = Text@@ -216,12 +222,12 @@   } deriving (Show,Eq,Generic) --,Ord)  data Amount = Amount {-      acommodity  :: CommoditySymbol,   -- commodity symbol, or special value "AUTO"-      aquantity   :: Quantity,          -- numeric quantity, or zero in case of "AUTO"-      aismultiplier :: Bool,            -- ^ kludge: a flag marking this amount and posting as a multiplier-                                        --   in a TMPostingRule. In a regular Posting, should always be false.-      astyle      :: AmountStyle,-      aprice      :: Maybe AmountPrice  -- ^ the (fixed, transaction-specific) price for this amount, if any+      acommodity  :: !CommoditySymbol,     -- commodity symbol, or special value "AUTO"+      aquantity   :: !Quantity,            -- numeric quantity, or zero in case of "AUTO"+      aismultiplier :: !Bool,              -- ^ kludge: a flag marking this amount and posting as a multiplier+                                           --   in a TMPostingRule. In a regular Posting, should always be false.+      astyle      :: !AmountStyle,+      aprice      :: !(Maybe AmountPrice)  -- ^ the (fixed, transaction-specific) price for this amount, if any     } deriving (Eq,Ord,Generic,Show)  newtype MixedAmount = Mixed [Amount] deriving (Eq,Ord,Generic,Show)@@ -453,6 +459,7 @@   ,jparsetimeclockentries :: [TimeclockEntry]                       -- ^ timeclock sessions which have not been clocked out   ,jincludefilestack      :: [FilePath]   -- principal data+  ,jdeclaredpayees        :: [(Payee,PayeeDeclarationInfo)]         -- ^ Payees declared by payee directives, in parse order (after journal finalisation)   ,jdeclaredaccounts      :: [(AccountName,AccountDeclarationInfo)] -- ^ Accounts declared by account directives, in parse order (after journal finalisation)   ,jdeclaredaccounttypes  :: M.Map AccountType [AccountName]        -- ^ Accounts whose type has been declared in account directives (usually 5 top-level accounts)   ,jglobalcommoditystyles :: M.Map CommoditySymbol AmountStyle      -- ^ per-commodity display styles declared globally, eg by command line option or import command@@ -481,6 +488,17 @@ -- | 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++-- | Extra information found in a payee directive.+data PayeeDeclarationInfo = PayeeDeclarationInfo {+   pdicomment :: Text   -- ^ any comment lines following the payee directive+  ,pditags    :: [Tag]  -- ^ tags extracted from the comment, if any+} deriving (Eq,Show,Generic)++nullpayeedeclarationinfo = PayeeDeclarationInfo {+   pdicomment          = ""+  ,pditags             = []+}  -- | Extra information about an account that can be derived from -- its account directive (and the other account directives).

@@ -13,12 +13,13 @@ {-# LANGUAGE DeriveGeneric #-}  module Hledger.Data.Valuation (-   ValuationType(..)+   Costing(..)+  ,ValuationType(..)   ,PriceOracle   ,journalPriceOracle-  ,unsupportedValueThenError   -- ,amountApplyValuation   -- ,amountValueAtDate+  ,mixedAmountApplyCostValuation   ,mixedAmountApplyValuation   ,mixedAmountValueAtDate   ,marketPriceReverse@@ -34,7 +35,6 @@ import Data.List.Extra (nubSortBy) import qualified Data.Map as M import qualified Data.Set as S-import Data.Maybe ( fromMaybe ) import qualified Data.Text as T import Data.Time.Calendar (Day, fromGregorian) import Data.MemoUgly (memo)@@ -46,20 +46,24 @@ import Hledger.Data.Amount import Hledger.Data.Dates (nulldate) import Hledger.Data.Commodity (showCommoditySymbol)+import Data.Maybe (fromMaybe)+import Text.Printf (printf)   ------------------------------------------------------------------------------ -- Types +-- | Whether to convert amounts to cost.+data Costing = Cost | NoCost+  deriving (Show,Eq)+ -- | What kind of value conversion should be done on amounts ?--- CLI: --value=cost|then|end|now|DATE[,COMM]+-- CLI: --value=then|end|now|DATE[,COMM] data ValuationType =-    AtCost     (Maybe CommoditySymbol)  -- ^ convert to cost commodity using transaction prices, then optionally to given commodity using market prices at posting date-  | AtThen     (Maybe CommoditySymbol)  -- ^ convert to default or given valuation commodity, using market prices at each posting's date+    AtThen     (Maybe CommoditySymbol)  -- ^ convert to default or given valuation commodity, using market prices at each posting's date   | AtEnd      (Maybe CommoditySymbol)  -- ^ convert to default or given valuation commodity, using market prices at period end(s)   | AtNow      (Maybe CommoditySymbol)  -- ^ convert to default or given valuation commodity, using current market prices   | AtDate Day (Maybe CommoditySymbol)  -- ^ convert to default or given valuation commodity, using market prices on some date-  | AtDefault  (Maybe CommoditySymbol)  -- ^ works like AtNow in single period reports, like AtEnd in multiperiod reports   deriving (Show,Eq)  -- | A price oracle is a magic memoising function that efficiently@@ -95,13 +99,25 @@ ------------------------------------------------------------------------------ -- Converting things to value +-- | Apply a specified costing and valuation to this mixed amount,+-- using the provided price oracle, commodity styles, and reference dates.+-- Costing is done first if requested, and after that any valuation.+-- See amountApplyValuation and amountCost.+mixedAmountApplyCostValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> Day -> Costing -> Maybe ValuationType -> MixedAmount -> MixedAmount+mixedAmountApplyCostValuation priceoracle styles periodlast today postingdate cost v =+    valuation . costing+  where+    valuation = maybe id (mixedAmountApplyValuation priceoracle styles periodlast today postingdate) v+    costing = case cost of+        Cost   -> styleMixedAmount styles . mixedAmountCost+        NoCost -> id+ -- | Apply a specified valuation to this mixed amount, using the--- provided price oracle, commodity styles, reference dates, and--- whether this is for a multiperiod report or not.+-- provided price oracle, commodity styles, and reference dates. -- See amountApplyValuation.-mixedAmountApplyValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Maybe Day -> Day -> Bool -> ValuationType -> MixedAmount -> MixedAmount-mixedAmountApplyValuation priceoracle styles periodlast mreportlast today ismultiperiod v (Mixed as) =-  Mixed $ map (amountApplyValuation priceoracle styles periodlast mreportlast today ismultiperiod v) as+mixedAmountApplyValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> Day -> ValuationType -> MixedAmount -> MixedAmount+mixedAmountApplyValuation priceoracle styles periodlast today postingdate v =+  mapMixedAmount (amountApplyValuation priceoracle styles periodlast today postingdate v)  -- | Apply a specified valuation to this amount, using the provided -- price oracle, reference dates, and whether this is for a@@ -115,7 +131,7 @@ -- -- - a fixed date specified by the ValuationType itself --   (--value=DATE).--- +-- -- - the provided "period end" date - this is typically the last day --   of a subperiod (--value=end with a multi-period report), or of --   the specified report period or the journal (--value=end with a@@ -127,29 +143,17 @@ -- - the provided "today" date - (--value=now, or -V/X with no report --   end date). -- --- Note --value=then is not supported by this function, and will cause an error;--- use postingApplyValuation for that.---  -- This is all a bit complicated. See the reference doc at -- https://hledger.org/hledger.html#effect-of-valuation-on-reports -- (hledger_options.m4.md "Effect of valuation on reports"), and #1083. ---amountApplyValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Maybe Day -> Day -> Bool -> ValuationType -> Amount -> Amount-amountApplyValuation priceoracle styles periodlast mreportlast today ismultiperiod v a =+amountApplyValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> Day -> ValuationType -> Amount -> Amount+amountApplyValuation priceoracle styles periodlast today postingdate v a =   case v of-    AtCost    Nothing            -> styleAmount styles $ amountCost a-    AtCost    mc                 -> amountValueAtDate priceoracle styles mc periodlast $ styleAmount styles $ amountCost a-    AtThen    _mc                -> error' unsupportedValueThenError  -- PARTIAL:-                                 -- amountValueAtDate priceoracle styles mc periodlast a  -- posting date unknown, handle like AtEnd-    AtEnd     mc                 -> amountValueAtDate priceoracle styles mc periodlast a-    AtNow     mc                 -> amountValueAtDate priceoracle styles mc today a-    AtDefault mc | ismultiperiod -> amountValueAtDate priceoracle styles mc periodlast a-    AtDefault mc                 -> amountValueAtDate priceoracle styles mc (fromMaybe today mreportlast) a-    AtDate d  mc                 -> amountValueAtDate priceoracle styles mc d a---- | Standard error message for a report not supporting --value=then.-unsupportedValueThenError :: String-unsupportedValueThenError = "Sorry, --value=then is not yet supported for this kind of report."+    AtThen    mc      -> amountValueAtDate priceoracle styles mc postingdate a+    AtEnd     mc      -> amountValueAtDate priceoracle styles mc periodlast a+    AtNow     mc      -> amountValueAtDate priceoracle styles mc today a+    AtDate d  mc      -> amountValueAtDate priceoracle styles mc d a  -- | Find the market value of each component amount in the given -- commodity, or its default valuation commodity, at the given@@ -157,7 +161,7 @@ -- When market prices available on that date are not sufficient to -- calculate the value, amounts are left unchanged. mixedAmountValueAtDate :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Maybe CommoditySymbol -> Day -> MixedAmount -> MixedAmount-mixedAmountValueAtDate priceoracle styles mc d (Mixed as) = Mixed $ map (amountValueAtDate priceoracle styles mc d) as+mixedAmountValueAtDate priceoracle styles mc d = mapMixedAmount (amountValueAtDate priceoracle styles mc d)  -- | Find the market value of this amount in the given valuation -- commodity if any, otherwise the default valuation commodity, at the@@ -220,7 +224,7 @@       Just to            ->         -- We have a commodity to convert to. Find the most direct price available,         -- according to the rules described in makePriceGraph.-        let msg = "seeking " ++ pshowedge' "" from to ++ " price"+        let msg = printf "seeking %s to %s price" (showCommoditySymbol from) (showCommoditySymbol to)         in case            (traceAt 2 (msg++" using forward prices") $              pricesShortestPath from to forwardprices)@@ -285,20 +289,25 @@ -- USD->EUR price and one EUR->USD price. pricesShortestPath :: CommoditySymbol -> CommoditySymbol -> [Edge] -> Maybe Path pricesShortestPath start end edges =-  dbg2 ("shortest "++pshowedge' "" start end++" price path") $+  -- at --debug=2 +, print the pretty path and also the detailed prices+  let label = printf "shortest path from %s to %s: " (showCommoditySymbol start) (showCommoditySymbol end) in+  fmap (dbg2With (("price chain:\n"++).pshow)) $ +  dbg2With ((label++).(maybe "none found" (pshowpath ""))) $+   find [([],edges)]+   where     -- Find the first and shortest complete path using a breadth-first search.     find :: [(Path,[Edge])] -> Maybe Path     find paths =       case concatMap extend paths of         [] -> Nothing -        _ | iteration > maxiterations -> -          trace ("gave up searching for a price chain after "++show maxiterations++" iterations, please report a bug")+        _ | pathlength > maxpathlength -> +          trace ("gave up searching for a price chain at length "++show maxpathlength++", please report a bug")           Nothing           where -            iteration = 1 + maybe 0 (length . fst) (headMay paths)-            maxiterations = 1000+            pathlength = 2 + maybe 0 (length . fst) (headMay paths)+            maxpathlength = 1000         paths' ->            case completepaths of                 p:_ -> Just p  -- the left-most complete path at this length@@ -329,7 +338,7 @@   p@(e:_) -> prefix label $ pshownode (mpfrom e) ++ ">" ++ intercalate ">" (map (pshownode . mpto) p) -- pshowedges label = prefix label . intercalate ", " . map (pshowedge "") -- pshowedge label MarketPrice{..} = pshowedge' label mpfrom mpto-pshowedge' label from to = prefix label $ pshownode from ++ ">" ++ pshownode to+-- pshowedge' label from to = prefix label $ pshownode from ++ ">" ++ pshownode to pshownode = T.unpack . showCommoditySymbol prefix l = if null l then (""++) else ((l++": ")++) @@ -356,7 +365,7 @@ -- -- 1. A *declared market price* or *inferred market price*: --    A's latest market price in B on or before the valuation date---    as declared by a P directive, or (with the `--infer-value` flag)+--    as declared by a P directive, or (with the `--infer-market-price` flag) --    inferred from transaction prices. --    -- 2. A *reverse market price*:@@ -381,7 +390,7 @@ --    prices before the valuation date.) -- -- 3. If there are no P directives at all (any commodity or date), and---    the `--infer-value` flag is used, then the price commodity from+--    the `--infer-market-price` flag is used, then the price commodity from --    the latest transaction price for A on or before valuation date." -- makePriceGraph :: [MarketPrice] -> [MarketPrice] -> Day -> PriceGraph@@ -420,7 +429,7 @@           where             ps | not $ null visibledeclaredprices = visibledeclaredprices                | not $ null alldeclaredprices     = alldeclaredprices-               | otherwise                        = visibleinferredprices  -- will be null without --infer-value+               | otherwise                        = visibleinferredprices  -- will be null without --infer-market-price  -- | Given a list of P-declared market prices in parse order and a -- list of transaction-inferred market prices in parse order, select

@@ -44,6 +44,8 @@   inAccountQuery,   -- * matching   matchesTransaction,+  matchesDescription,+  matchesPayeeWIP,   matchesPosting,   matchesAccount,   matchesMixedAmount,@@ -66,6 +68,7 @@ #if !(MIN_VERSION_base(4,11,0)) import Data.Monoid ((<>)) #endif+import Data.Text (Text) import qualified Data.Text as T import Data.Time.Calendar (Day, fromGregorian ) import Safe (readDef, readMay, maximumByMay, maximumMay, minimumMay)@@ -107,11 +110,11 @@ instance Default Query where def = Any  -- | Construct a payee tag-payeeTag :: Maybe String -> Either RegexError Query+payeeTag :: Maybe Text -> Either RegexError Query payeeTag = fmap (Tag (toRegexCI' "payee")) . maybe (pure Nothing) (fmap Just . toRegexCI)  -- | Construct a note tag-noteTag :: Maybe String -> Either RegexError Query+noteTag :: Maybe Text -> Either RegexError Query noteTag = fmap (Tag (toRegexCI' "note")) . maybe (pure Nothing) (fmap Just . toRegexCI)  -- | Construct a generated-transaction tag@@ -262,11 +265,11 @@     Right (Left m)  -> Right $ Left $ Not m     Right (Right _) -> Right $ Left Any -- not:somequeryoption will be ignored     Left err        -> Left err-parseQueryTerm _ (T.stripPrefix "code:" -> Just s) = Left . Code <$> toRegexCI (T.unpack s)-parseQueryTerm _ (T.stripPrefix "desc:" -> Just s) = Left . Desc <$> toRegexCI (T.unpack s)-parseQueryTerm _ (T.stripPrefix "payee:" -> Just s) = Left <$> payeeTag (Just $ T.unpack s)-parseQueryTerm _ (T.stripPrefix "note:" -> Just s) = Left <$> noteTag (Just $ T.unpack s)-parseQueryTerm _ (T.stripPrefix "acct:" -> Just s) = Left . Acct <$> toRegexCI (T.unpack s)+parseQueryTerm _ (T.stripPrefix "code:" -> Just s) = Left . Code <$> toRegexCI s+parseQueryTerm _ (T.stripPrefix "desc:" -> Just s) = Left . Desc <$> toRegexCI s+parseQueryTerm _ (T.stripPrefix "payee:" -> Just s) = Left <$> payeeTag (Just s)+parseQueryTerm _ (T.stripPrefix "note:" -> Just s) = Left <$> noteTag (Just s)+parseQueryTerm _ (T.stripPrefix "acct:" -> Just s) = Left . Acct <$> toRegexCI s parseQueryTerm d (T.stripPrefix "date2:" -> Just s) =         case parsePeriodExpr d s of Left e         -> Left $ "\"date2:"++T.unpack s++"\" gave a "++showDateParseError e                                     Right (_,span) -> Right $ Left $ Date2 span@@ -283,7 +286,7 @@   | otherwise = Left "depth: should have a positive number"   where n = readDef 0 (T.unpack s) -parseQueryTerm _ (T.stripPrefix "cur:" -> Just s) = Left . Sym <$> toRegexCI ('^' : T.unpack s ++ "$") -- support cur: as an alias+parseQueryTerm _ (T.stripPrefix "cur:" -> Just s) = Left . Sym <$> toRegexCI ("^" <> s <> "$") -- support cur: as an alias parseQueryTerm _ (T.stripPrefix "tag:" -> Just s) = Left <$> parseTag s parseQueryTerm _ "" = Right $ Left $ Any parseQueryTerm d s = parseQueryTerm d $ defaultprefix<>":"<>s@@ -322,20 +325,19 @@     (parse ">"   -> Just q) -> Right (AbsGt   ,q)     (parse "="   -> Just q) -> Right (AbsEq   ,q)     (parse ""    -> Just q) -> Right (AbsEq   ,q)-    _ -> Left $-         "could not parse as a comparison operator followed by an optionally-signed number: "-         ++ T.unpack amtarg+    _ -> Left . T.unpack $+         "could not parse as a comparison operator followed by an optionally-signed number: " <> amtarg   where     -- Strip outer whitespace from the text, require and remove the     -- specified prefix, remove all whitespace from the remainder, and     -- read it as a simple integer or decimal if possible.     parse :: T.Text -> T.Text -> Maybe Quantity-    parse p s = (T.stripPrefix p . T.strip) s >>= readMay . filter (not.(==' ')) . T.unpack+    parse p s = (T.stripPrefix p . T.strip) s >>= readMay . T.unpack . T.filter (/=' ')  parseTag :: T.Text -> Either RegexError Query parseTag s = do-    tag <- toRegexCI . T.unpack $ if T.null v then s else n-    body <- if T.null v then pure Nothing else Just <$> toRegexCI (tail $ T.unpack v)+    tag <- toRegexCI $ if T.null v then s else n+    body <- if T.null v then pure Nothing else Just <$> toRegexCI (T.tail v)     return $ Tag tag body   where (n,v) = T.break (=='=') s @@ -554,7 +556,7 @@ matchesAccount (Not m) a = not $ matchesAccount m a matchesAccount (Or ms) a = any (`matchesAccount` a) ms matchesAccount (And ms) a = all (`matchesAccount` a) ms-matchesAccount (Acct r) a = regexMatch r $ T.unpack a -- XXX pack+matchesAccount (Acct r) a = regexMatchText r a matchesAccount (Depth d) a = accountNameLevel a <= d matchesAccount (Tag _ _) _ = False matchesAccount _ _ = True@@ -564,7 +566,7 @@ matchesMixedAmount q (Mixed as) = any (q `matchesAmount`) as  matchesCommodity :: Query -> CommoditySymbol -> Bool-matchesCommodity (Sym r) = regexMatch r . T.unpack+matchesCommodity (Sym r) = regexMatchText r matchesCommodity _ = const True  -- | Does the match expression match this (simple) amount ?@@ -603,10 +605,10 @@ matchesPosting (None) _ = False matchesPosting (Or qs) p = any (`matchesPosting` p) qs matchesPosting (And qs) p = all (`matchesPosting` p) qs-matchesPosting (Code r) p = regexMatch r $ maybe "" (T.unpack . tcode) $ ptransaction p-matchesPosting (Desc r) p = regexMatch r $ maybe "" (T.unpack . tdescription) $ ptransaction p+matchesPosting (Code r) p = maybe False (regexMatchText r . tcode) $ ptransaction p+matchesPosting (Desc r) p = maybe False (regexMatchText r . tdescription) $ ptransaction p matchesPosting (Acct r) p = matches p || matches (originalPosting p)-  where matches p = regexMatch r . T.unpack $ paccount p -- XXX pack+  where matches = regexMatchText r . paccount matchesPosting (Date span) p = span `spanContainsDate` postingDate p matchesPosting (Date2 span) p = span `spanContainsDate` postingDate2 p matchesPosting (StatusQ s) p = postingStatus p == s@@ -615,8 +617,8 @@ matchesPosting q@(Amt _ _) Posting{pamount=amt} = q `matchesMixedAmount` amt matchesPosting (Sym r) Posting{pamount=Mixed as} = any (matchesCommodity (Sym r)) $ map acommodity as matchesPosting (Tag n v) p = case (reString n, v) of-  ("payee", Just v) -> maybe False (regexMatch v . T.unpack . transactionPayee) $ ptransaction p-  ("note", Just v) -> maybe False (regexMatch v . T.unpack . transactionNote) $ ptransaction p+  ("payee", Just v) -> maybe False (regexMatchText v . transactionPayee) $ ptransaction p+  ("note", Just v) -> maybe False (regexMatchText v . transactionNote) $ ptransaction p   (_, v) -> matchesTags n v $ postingAllTags p  -- | Does the match expression match this transaction ?@@ -626,8 +628,8 @@ matchesTransaction (None) _ = False matchesTransaction (Or qs) t = any (`matchesTransaction` t) qs matchesTransaction (And qs) t = all (`matchesTransaction` t) qs-matchesTransaction (Code r) t = regexMatch r $ T.unpack $ tcode t-matchesTransaction (Desc r) t = regexMatch r $ T.unpack $ tdescription t+matchesTransaction (Code r) t = regexMatchText r $ tcode t+matchesTransaction (Desc r) t = regexMatchText r $ tdescription t matchesTransaction q@(Acct _) t = any (q `matchesPosting`) $ tpostings t matchesTransaction (Date span) t = spanContainsDate span $ tdate t matchesTransaction (Date2 span) t = spanContainsDate span $ transactionDate2 t@@ -637,15 +639,42 @@ matchesTransaction (Depth d) t = any (Depth d `matchesPosting`) $ tpostings t matchesTransaction q@(Sym _) t = any (q `matchesPosting`) $ tpostings t matchesTransaction (Tag n v) t = case (reString n, v) of-  ("payee", Just v) -> regexMatch v . T.unpack . transactionPayee $ t-  ("note", Just v) -> regexMatch v . T.unpack . transactionNote $ t+  ("payee", Just v) -> regexMatchText v $ transactionPayee t+  ("note", Just v) -> regexMatchText v $ transactionNote t   (_, v) -> matchesTags n v $ transactionAllTags t +-- | Does the query match this transaction description ?+-- Tests desc: terms, any other terms are ignored.+matchesDescription :: Query -> Text -> Bool+matchesDescription (Not q) d      = not $ q `matchesDescription` d+matchesDescription (Any) _        = True+matchesDescription (None) _       = False+matchesDescription (Or qs) d      = any (`matchesDescription` d) $ filter queryIsDesc qs+matchesDescription (And qs) d     = all (`matchesDescription` d) $ filter queryIsDesc qs+matchesDescription (Code _) _     = False+matchesDescription (Desc r) d     = regexMatchText r d+matchesDescription (Acct _) _     = False+matchesDescription (Date _) _     = False+matchesDescription (Date2 _) _    = False+matchesDescription (StatusQ _) _  = False+matchesDescription (Real _) _     = False+matchesDescription (Amt _ _) _    = False+matchesDescription (Depth _) _    = False+matchesDescription (Sym _) _      = False+matchesDescription (Tag _ _) _    = False++-- | Does the query match this transaction payee ?+-- Tests desc: (and payee: ?) terms, any other terms are ignored.+-- XXX Currently an alias for matchDescription. I'm not sure if more is needed,+-- There's some shenanigan with payee: and "payeeTag" to figure out.+matchesPayeeWIP :: Query -> Payee -> Bool+matchesPayeeWIP q p = matchesDescription q p+ -- | Does the query match the name and optionally the value of any of these tags ? matchesTags :: Regexp -> Maybe Regexp -> [Tag] -> Bool matchesTags namepat valuepat = not . null . filter (matches namepat valuepat)   where-    matches npat vpat (n,v) = regexMatch npat (T.unpack n) && maybe (const True) regexMatch vpat (T.unpack v)+    matches npat vpat (n,v) = regexMatchText npat n && maybe (const True) regexMatchText vpat v  -- | Does the query match this market price ? matchesPriceDirective :: Query -> PriceDirective -> Bool

@@ -11,8 +11,9 @@ -}  --- ** language-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE PackageImports #-}+{-# LANGUAGE CPP                 #-}+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE PackageImports      #-} {-# LANGUAGE ScopedTypeVariables #-}  --- ** exports@@ -53,9 +54,13 @@ import Data.List.NonEmpty (nonEmpty) import Data.Maybe (fromMaybe) import Data.Ord (comparing)+#if !(MIN_VERSION_base(4,11,0))+import Data.Semigroup ((<>))+#endif import Data.Semigroup (sconcat) import Data.Text (Text) import qualified Data.Text as T+import qualified Data.Text.IO as T import Data.Time (Day) import Safe (headDef) import System.Directory (doesFileExist, getHomeDirectory)@@ -63,8 +68,7 @@ import System.Exit (exitFailure) import System.FilePath ((<.>), (</>), splitDirectories, splitFileName) import System.Info (os)-import System.IO (stderr, writeFile)-import Text.Printf (hPrintf, printf)+import System.IO (hPutStr, stderr)  import Hledger.Data.Dates (getCurrentDay, parsedateM, showDate) import Hledger.Data.Types@@ -191,9 +195,9 @@ requireJournalFileExists f = do   exists <- doesFileExist f   when (not exists) $ do  -- XXX might not be a journal file-    hPrintf stderr "The hledger journal file \"%s\" was not found.\n" f-    hPrintf stderr "Please create it first, eg with \"hledger add\" or a text editor.\n"-    hPrintf stderr "Or, specify an existing journal file with -f or LEDGER_FILE.\n"+    hPutStr stderr $ "The hledger journal file \"" <> show 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"     exitFailure  -- | Ensure there is a journal file at the given path, creating an empty one if needed.@@ -202,14 +206,14 @@ ensureJournalFileExists :: FilePath -> IO () ensureJournalFileExists f = do   when (os/="mingw32" && isWindowsUnsafeDotPath f) $ do-    hPrintf stderr "Part of file path %s\n ends with a dot, which is unsafe on Windows; please use a different path.\n" (show f)+    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   when (not exists) $ do-    hPrintf stderr "Creating hledger journal file %s.\n" f+    hPutStr stderr $ "Creating hledger journal file " <> show f <> ".\n"     -- note Hledger.Utils.UTF8.* do no line ending conversion on windows,     -- we currently require unix line endings on all platforms.-    newJournalContent >>= writeFile f+    newJournalContent >>= T.writeFile f  -- | Does any part of this path contain non-. characters and end with a . ? -- Such paths are not safe to use on Windows (cf #1056).@@ -221,10 +225,10 @@   splitDirectories  -- | Give the content for a new auto-created journal file.-newJournalContent :: IO String+newJournalContent :: IO Text newJournalContent = do   d <- getCurrentDay-  return $ printf "; journal created %s by hledger\n" (show d)+  return $ "; journal created " <> T.pack (show d) <> " by hledger\n"  -- A "LatestDates" is zero or more copies of the same date, -- representing the latest transaction date read from a file,@@ -240,7 +244,7 @@ -- | Remember that these transaction dates were the latest seen when -- reading this journal file. saveLatestDates :: LatestDates -> FilePath -> IO ()-saveLatestDates dates f = writeFile (latestDatesFileFor f) $ unlines $ map showDate dates+saveLatestDates dates f = T.writeFile (latestDatesFileFor f) $ T.unlines $ map showDate dates  -- | What were the latest transaction dates seen the last time this -- journal file was read ? If there were multiple transactions on the

@@ -45,6 +45,9 @@   parseAndFinaliseJournal,   parseAndFinaliseJournal',   journalFinalise,+  journalCheckAccountsDeclared,+  journalCheckCommoditiesDeclared,+  journalCheckPayeesDeclared,   setYear,   getYear,   setDefaultCommodityAndStyle,@@ -149,6 +152,7 @@ import Hledger.Data import Hledger.Utils import Safe (headMay)+import Text.Printf (printf)  --- ** doctest setup -- $setup@@ -368,6 +372,22 @@                 )             & fmap journalInferMarketPricesFromTransactions  -- infer market prices from commodity-exchanging transactions +-- | Check that all the journal's transactions have payees declared with+-- payee directives, returning an error message otherwise.+journalCheckPayeesDeclared :: Journal -> Either String ()+journalCheckPayeesDeclared j = sequence_ $ map checkpayee $ jtxns j+  where+    checkpayee t+      | p `elem` ps = Right ()+      | otherwise = Left $+          printf "undeclared payee \"%s\"\nat: %s\n\n%s"+            (T.unpack p)+            (showGenericSourcePos $ tsourcepos t)+            (linesPrepend2 "> " "  " . (<>"\n") . textChomp $ showTransaction t)+      where+        p  = transactionPayee t+        ps = journalPayeesDeclared j+ -- | Check that all the journal's postings are to accounts declared with -- account directives, returning an error message otherwise. journalCheckAccountsDeclared :: Journal -> Either String ()@@ -375,11 +395,13 @@   where     checkacct Posting{paccount,ptransaction}       | paccount `elem` as = Right ()-      | otherwise          = -          Left $ "\nstrict mode: undeclared account \""++T.unpack paccount++"\""-            ++ case ptransaction of-                Just Transaction{tsourcepos} -> "\nin transaction at: "++showGenericSourcePos tsourcepos-                Nothing -> ""+      | otherwise = Left $+          (printf "undeclared account \"%s\"\n" (T.unpack paccount))+          ++ case ptransaction of+              Nothing -> ""+              Just t  -> printf "in transaction at: %s\n\n%s"+                          (showGenericSourcePos $ tsourcepos t)+                          (linesPrepend "  " . (<>"\n") . textChomp $ showTransaction t)       where         as = journalAccountNamesDeclared j @@ -392,18 +414,21 @@     checkcommodities Posting{..} =       case mfirstundeclaredcomm of         Nothing -> Right ()-        Just c  -> Left $ -          "\nstrict mode: undeclared commodity \""++T.unpack c++"\""+        Just c  -> Left $+          (printf "undeclared commodity \"%s\"\n" (T.unpack c))           ++ case ptransaction of-                Just Transaction{tsourcepos} -> "\nin transaction at: "++showGenericSourcePos tsourcepos-                Nothing -> ""      +              Nothing -> ""+              Just t  -> printf "in transaction at: %s\n\n%s"+                          (showGenericSourcePos $ tsourcepos t)+                          (linesPrepend "  " . (<>"\n") . textChomp $ showTransaction t)       where-        mfirstundeclaredcomm = +        mfirstundeclaredcomm =           headMay $ filter (not . (`elem` cs)) $ catMaybes $           (acommodity . baamount <$> pbalanceassertion) :           (map (Just . acommodity) . filter (/= missingamt) $ amounts pamount)         cs = journalCommoditiesDeclared j + setYear :: Year -> JournalParser m () setYear y = modify' (\j -> j{jparsedefaultyear=Just y}) @@ -732,7 +757,7 @@     spaces = lift $ skipNonNewlineSpaces   amount <- amountwithoutpricep <* spaces   (mprice, _elotprice, _elotdate) <- runPermutation $-    (,,) <$> toPermutationWithDefault Nothing (Just <$> priceamountp <* spaces)+    (,,) <$> toPermutationWithDefault Nothing (Just <$> priceamountp amount <* spaces)          <*> toPermutationWithDefault Nothing (Just <$> lotpricep <* spaces)          <*> toPermutationWithDefault Nothing (Just <$> lotdatep <* spaces)   pure $ amount { aprice = mprice }@@ -742,7 +767,7 @@   let spaces = lift $ skipNonNewlineSpaces   amount <- amountwithoutpricep   spaces-  mprice <- optional $ priceamountp <* spaces+  mprice <- optional $ priceamountp amount <* spaces   pure $ amount { aprice = mprice }  amountwithoutpricep :: JournalParser m Amount@@ -757,6 +782,7 @@     c <- lift commoditysymbolp     mdecmarkStyle <- getDecimalMarkStyle     mcommodityStyle <- getAmountStyle c+    -- XXX amounts of this commodity in periodic transaction rules and auto posting rules ? #1461     let suggestedStyle = mdecmarkStyle <|> mcommodityStyle     commodityspaced <- lift skipNonNewlineSpaces'     sign2 <- lift $ signp@@ -782,6 +808,7 @@       Just (commodityspaced, c) -> do         mdecmarkStyle <- getDecimalMarkStyle         mcommodityStyle <- getAmountStyle c+        -- XXX amounts of this commodity in periodic transaction rules and auto posting rules ? #1461         let msuggestedStyle = mdecmarkStyle <|> mcommodityStyle         (q,prec,mdec,mgrps) <- lift $ interpretNumber numRegion msuggestedStyle ambiguousRawNum mExponent         let s = amountstyle{ascommodityside=R, ascommodityspaced=commodityspaced, asprecision=prec, asdecimalpoint=mdec, asdigitgroups=mgrps}@@ -793,6 +820,7 @@         mdecmarkStyle   <- getDecimalMarkStyle   -- a decimal-mark CSV rule         mcommodityStyle <- getAmountStyle ""     -- a commodity directive for the no-symbol commodity         mdefaultStyle   <- getDefaultAmountStyle -- a D default commodity directive+        -- XXX no-symbol amounts in periodic transaction rules and auto posting rules ? #1461         let msuggestedStyle = mdecmarkStyle <|> mcommodityStyle <|> mdefaultStyle         (q,prec,mdec,mgrps) <- lift $ interpretNumber numRegion msuggestedStyle ambiguousRawNum mExponent         -- if a default commodity has been set, apply it and its style to this amount@@ -849,19 +877,25 @@ simplecommoditysymbolp :: TextParser m CommoditySymbol simplecommoditysymbolp = takeWhile1P Nothing (not . isNonsimpleCommodityChar) -priceamountp :: JournalParser m AmountPrice-priceamountp = label "transaction price" $ do+priceamountp :: Amount -> JournalParser m AmountPrice+priceamountp baseAmt = label "transaction price" $ do   -- https://www.ledger-cli.org/3.0/doc/ledger3.html#Virtual-posting-costs   parenthesised <- option False $ char '(' >> pure True   char '@'-  priceConstructor <- char '@' *> pure TotalPrice <|> pure UnitPrice+  totalPrice <- char '@' *> pure True <|> pure False   when parenthesised $ void $ char ')'    lift skipNonNewlineSpaces   priceAmount <- amountwithoutpricep -- <?> "unpriced amount (specifying a price)" -  pure $ priceConstructor priceAmount+  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++ balanceassertionp :: JournalParser m BalanceAssertion balanceassertionp = do   sourcepos <- genericSourcePos <$> lift getSourcePos@@ -1122,7 +1156,7 @@ digitgroupp = label "digits"             $ makeGroup <$> takeWhile1P (Just "digit") isDigit   where-    makeGroup = uncurry DigitGrp . foldl' step (0, 0) . T.unpack+    makeGroup = uncurry DigitGrp . T.foldl' step (0, 0)     step (!l, !a) c = (l+1, a*10 + fromIntegral (digitToInt c))  --- *** comments@@ -1461,7 +1495,7 @@   char '='   skipNonNewlineSpaces   repl <- anySingle `manyTill` eolof-  case toRegexCI re of+  case toRegexCI $ T.pack re of     Right r -> return $! RegexAlias r repl     Left e  -> customFailure $! parseErrorAtRegion off1 off2 e 

@@ -11,17 +11,17 @@ -- stack haddock hledger-lib --fast --no-haddock-deps --haddock-arguments='--ignore-all-exports' --open  --- ** language-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiWayIf #-}-{-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE PackageImports #-}-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleContexts     #-}+{-# LANGUAGE FlexibleInstances    #-}+{-# LANGUAGE MultiWayIf           #-}+{-# LANGUAGE NamedFieldPuns       #-}+{-# LANGUAGE OverloadedStrings    #-}+{-# LANGUAGE PackageImports       #-}+{-# LANGUAGE RecordWildCards      #-}+{-# LANGUAGE ScopedTypeVariables  #-}+{-# LANGUAGE TypeFamilies         #-} {-# LANGUAGE TypeSynonymInstances #-}-{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE ViewPatterns         #-}  --- ** exports module Hledger.Read.CsvReader (@@ -52,7 +52,6 @@ import Data.Char                  (toLower, isDigit, isSpace, isAlphaNum, isAscii, ord) import Data.Bifunctor             (first) import "base-compat-batteries" Data.List.Compat-import qualified Data.List.Split as LS (splitOn) import Data.Maybe (catMaybes, fromMaybe, isJust) import Data.MemoUgly (memo) import Data.Ord (comparing)@@ -61,6 +60,8 @@ import qualified Data.Text as T import qualified Data.Text.Encoding as T import qualified Data.Text.IO as T+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Builder as TB import Data.Time.Calendar (Day) import Data.Time.Format (parseTimeM, defaultTimeLocale) import Safe (atMay, headMay, lastMay, readDef, readMay)@@ -88,7 +89,7 @@  type CSV       = [CsvRecord] type CsvRecord = [CsvValue]-type CsvValue  = String+type CsvValue  = Text  --- ** reader @@ -164,7 +165,7 @@   ," account2 assets:bank:savings\n"   ] -addDirective :: (DirectiveName, String) -> CsvRulesParsed -> CsvRulesParsed+addDirective :: (DirectiveName, Text) -> CsvRulesParsed -> CsvRulesParsed addDirective d r = r{rdirectives=d:rdirectives r}  addAssignment :: (HledgerFieldName, FieldTemplate) -> CsvRulesParsed -> CsvRulesParsed@@ -181,7 +182,7 @@   where     maybeAddAssignment rules f = (maybe id addAssignmentFromIndex $ elemIndex f fs) rules       where-        addAssignmentFromIndex i = addAssignment (f, "%"++show (i+1))+        addAssignmentFromIndex i = addAssignment (f, T.pack $ '%':show (i+1))  addConditionalBlock :: ConditionalBlock -> CsvRulesParsed -> CsvRulesParsed addConditionalBlock b r = r{rconditionalblocks=b:rconditionalblocks r}@@ -205,7 +206,7 @@       case line of         (T.stripPrefix "include " -> Just f) -> expandIncludes dir' =<< T.readFile f'           where-            f' = dir </> dropWhile isSpace (T.unpack f)+            f' = dir </> T.unpack (T.dropWhile isSpace f)             dir' = takeDirectory f'         _ -> return line @@ -240,7 +241,7 @@ -- | 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,String)],+  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@@ -260,7 +261,7 @@ -- | Type used after parsing is done. Directives, assignments and conditional blocks -- are in the same order as they were in the unput file and rblocksassigning is functional. -- Ready to be used for CSV record processing-type CsvRules = CsvRules' (String -> [ConditionalBlock])+type CsvRules = CsvRules' (Text -> [ConditionalBlock])  instance Eq CsvRules where   r1 == r2 = (rdirectives r1, rcsvfieldindexes r1, rassignments r1) ==@@ -277,27 +278,27 @@ type CsvRulesParser a = StateT CsvRulesParsed SimpleTextParser a  -- | The keyword of a CSV rule - "fields", "skip", "if", etc.-type DirectiveName    = String+type DirectiveName    = Text  -- | CSV field name.-type CsvFieldName     = String+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 = String+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 = String+type HledgerFieldName = Text  -- | A text value to be assigned to a hledger field, possibly -- containing csv field references to be interpolated.-type FieldTemplate    = String+type FieldTemplate    = Text  -- | A strptime date parsing pattern, as supported by Data.Time.Format.-type DateFormat       = String+type DateFormat       = Text  -- | A prefix for a matcher test, either & or none (implicit or). data MatcherPrefix = And | None@@ -453,16 +454,16 @@ commentcharp :: CsvRulesParser Char commentcharp = oneOf (";#*" :: [Char]) -directivep :: CsvRulesParser (DirectiveName, String)+directivep :: CsvRulesParser (DirectiveName, Text) directivep = (do   lift $ dbgparse 8 "trying directive"-  d <- fmap T.unpack $ choiceInState $ map (lift . string . T.pack) directives+  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 :: [String]+directives :: [Text] directives =   ["date-format"   ,"decimal-mark"@@ -474,8 +475,8 @@   , "balance-type"   ] -directivevalp :: CsvRulesParser String-directivevalp = anySingle `manyTill` lift eolof+directivevalp :: CsvRulesParser Text+directivevalp = T.pack <$> anySingle `manyTill` lift eolof  fieldnamelistp :: CsvRulesParser [CsvFieldName] fieldnamelistp = (do@@ -487,21 +488,18 @@   f <- fromMaybe "" <$> optional fieldnamep   fs <- some $ (separator >> fromMaybe "" <$> optional fieldnamep)   lift restofline-  return $ map (map toLower) $ f:fs+  return . map T.toLower $ f:fs   ) <?> "field name list" -fieldnamep :: CsvRulesParser String+fieldnamep :: CsvRulesParser Text fieldnamep = quotedfieldnamep <|> barefieldnamep -quotedfieldnamep :: CsvRulesParser String-quotedfieldnamep = do-  char '"'-  f <- some $ noneOf ("\"\n:;#~" :: [Char])-  char '"'-  return f+quotedfieldnamep :: CsvRulesParser Text+quotedfieldnamep =+    char '"' *> takeWhile1P Nothing (`notElem` ("\"\n:;#~" :: [Char])) <* char '"' -barefieldnamep :: CsvRulesParser String-barefieldnamep = some $ noneOf (" \t\n,;#~" :: [Char])+barefieldnamep :: CsvRulesParser Text+barefieldnamep = takeWhile1P Nothing (`notElem` (" \t\n,;#~" :: [Char]))  fieldassignmentp :: CsvRulesParser (HledgerFieldName, FieldTemplate) fieldassignmentp = do@@ -513,10 +511,10 @@   return (f,v)   <?> "field assignment" -journalfieldnamep :: CsvRulesParser String+journalfieldnamep :: CsvRulesParser Text journalfieldnamep = do   lift (dbgparse 8 "trying journalfieldnamep")-  T.unpack <$> choiceInState (map (lift . string . T.pack) journalfieldnames)+  choiceInState $ map (lift . string) journalfieldnames  maxpostings = 99 @@ -524,14 +522,14 @@ -- 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 = show x]+  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"@@ -556,10 +554,10 @@                      ]   return () -fieldvalp :: CsvRulesParser String+fieldvalp :: CsvRulesParser Text fieldvalp = do   lift $ dbgparse 8 "trying fieldvalp"-  anySingle `manyTill` lift eolof+  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@@ -587,14 +585,14 @@ conditionaltablep = do   lift $ dbgparse 8 "trying conditionaltablep"   start <- getOffset-  string "if" +  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' (char sep >> return ())-    vs <- LS.splitOn [sep] <$> lift restofline+    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\n" (length fields) (length vs)) :: String)       else return (m,vs)@@ -655,8 +653,7 @@ csvfieldreferencep = do   lift $ dbgparse 8 "trying csvfieldreferencep"   char '%'-  f <- fieldnamep-  return $ '%' : quoteIfNeeded f+  T.cons '%' . textQuoteIfNeeded <$> fieldnamep  -- A single regular expression regexp :: CsvRulesParser () -> CsvRulesParser Regexp@@ -665,7 +662,7 @@   -- notFollowedBy matchoperatorp   c <- lift nonspace   cs <- anySingle `manyTill` end-  case toRegexCI . strip $ c:cs of+  case toRegexCI . T.strip . T.pack $ c:cs of        Left x -> Fail.fail $ "CSV parser: " ++ x        Right x -> return x @@ -721,7 +718,7 @@   let skiplines = case getDirective "skip" rules of                     Nothing -> 0                     Just "" -> 1-                    Just s  -> readDef (throwerr $ "could not parse skip value: " ++ show s) s+                    Just s  -> readDef (throwerr $ "could not parse skip value: " ++ show s) $ T.unpack s    -- parse csv   let@@ -779,18 +776,17 @@    when (not rulesfileexists) $ do     dbg1IO "creating conversion rules file" rulesfile-    writeFile rulesfile $ T.unpack rulestext+    T.writeFile rulesfile rulestext    return $ Right nulljournal{jtxns=txns''}  -- | Parse special separator names TAB and SPACE, or return the first -- character. Return Nothing on empty string-parseSeparator :: String -> Maybe Char-parseSeparator = specials . map toLower+parseSeparator :: Text -> Maybe Char+parseSeparator = specials . T.toLower   where specials "space" = Just ' '         specials "tab"   = Just '\t'-        specials (x:_)   = Just x-        specials []      = Nothing+        specials xs      = fst <$> T.uncons xs  parseCsv :: Char -> FilePath -> Text -> IO (Either String CSV) parseCsv separator filePath csvdata =@@ -813,15 +809,12 @@ parseResultToCsv = toListList . unpackFields     where         toListList = toList . fmap toList-        unpackFields  = (fmap . fmap) (T.unpack . T.decodeUtf8)+        unpackFields  = (fmap . fmap) T.decodeUtf8 -printCSV :: CSV -> String-printCSV records = unlined (printRecord `map` records)-    where printRecord = concat . intersperse "," . map printField-          printField f = "\"" ++ concatMap escape f ++ "\""-          escape '"' = "\"\""-          escape x = [x]-          unlined = concat . intersperse "\n"+printCSV :: CSV -> TL.Text+printCSV = TB.toLazyText . unlinesB . map printRecord+    where printRecord = mconcat . map TB.fromText . intersperse "," . map printField+          printField = wrap "\"" "\"" . T.replace "\"" "\\\"\\\""  -- | Return the cleaned up and validated CSV data (can be empty), or an error. validateCsv :: CsvRules -> Int -> Either String CSV -> Either String [CsvRecord]@@ -834,7 +827,7 @@         (Nothing, Nothing) -> Nothing         (Just _, _) -> Just maxBound         (Nothing, Just "") -> Just 1-        (Nothing, Just x) -> Just (read x)+        (Nothing, Just x) -> Just (read $ T.unpack x)     applyConditionalSkips [] = []     applyConditionalSkips (r:rest) =       case skipCount r of@@ -866,7 +859,7 @@ --- ** converting csv records to transactions  showRules rules record =-  unlines $ catMaybes [ (("the "++fld++" rule is: ")++) <$> getEffectiveAssignment rules record fld | fld <- journalfieldnames]+  T.unlines $ catMaybes [ (("the "<>fld<>" rule is: ")<>) <$> getEffectiveAssignment rules record fld | fld <- journalfieldnames]  -- | Look up the value (template) of a csv rule by rule keyword. csvRule :: CsvRules -> DirectiveName -> Maybe FieldTemplate@@ -880,7 +873,7 @@  -- | Look up the final value assigned to a hledger field, with csv field -- references interpolated.-hledgerFieldValue :: CsvRules -> CsvRecord -> HledgerFieldName -> Maybe String+hledgerFieldValue :: CsvRules -> CsvRecord -> HledgerFieldName -> Maybe Text hledgerFieldValue rules record = fmap (renderTemplate rules record) . hledgerField rules record  transactionFromCsvRecord :: SourcePos -> CsvRules -> CsvRecord -> Transaction@@ -892,18 +885,18 @@     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 String+    fieldval = hledgerFieldValue rules record :: HledgerFieldName -> Maybe Text     parsedate = parseDateWithCustomOrDefaultFormats (rule "date-format")-    mkdateerror datefield datevalue mdateformat = unlines-      ["error: could not parse \""++datevalue++"\" as a date using date format "-        ++maybe "\"YYYY/M/D\", \"YYYY-M-D\" or \"YYYY.M.D\"" show 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+      ,"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"+        <>"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@@ -923,25 +916,27 @@     status      =       case fieldval "status" of         Nothing -> Unmarked-        Just s  -> either statuserror id $ runParser (statusp <* eof) "" $ T.pack s+        Just s  -> either statuserror id $ runParser (statusp <* eof) "" s           where-            statuserror err = error' $ unlines-              ["error: could not parse \""++s++"\" as a cleared status (should be *, ! or empty)"-              ,"the parse error is:      "++customErrorBundlePretty err+            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 "" singleline $ fieldval "comment"     precomment  = maybe "" singleline $ fieldval "precomment" +    singleline = T.unwords . filter (not . T.null) . map T.strip . T.lines+     ----------------------------------------------------------------------     -- 3. Generate the postings for which an account has been assigned     -- (possibly indirectly due to an amount or balance assignment) -    p1IsVirtual = (accountNamePostingType . T.pack <$> fieldval "account1") == Just VirtualPosting+    p1IsVirtual = (accountNamePostingType <$> fieldval "account1") == Just VirtualPosting     ps = [p | n <- [1..maxpostings]-         ,let comment  = T.pack $ fromMaybe "" $ fieldval ("comment"++show n)-         ,let currency = fromMaybe "" (fieldval ("currency"++show n) <|> fieldval "currency")+         ,let comment  = fromMaybe "" $ fieldval ("comment"<> T.pack (show n))+         ,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@@ -965,10 +960,10 @@           ,tdate             = date'           ,tdate2            = mdate2'           ,tstatus           = status-          ,tcode             = T.pack code-          ,tdescription      = T.pack description-          ,tcomment          = T.pack comment-          ,tprecedingcomment = T.pack precomment+          ,tcode             = code+          ,tdescription      = description+          ,tcomment          = comment+          ,tprecedingcomment = precomment           ,tpostings         = ps           }   @@ -979,7 +974,7 @@ -- 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 -> String -> Bool -> Int -> Maybe MixedAmount+getAmount :: CsvRules -> CsvRecord -> Text -> Bool -> Int -> Maybe MixedAmount getAmount rules record currency p1IsVirtual n =   -- Warning, many tricky corner cases here.   -- docs: hledger_csv.m4.md #### amount@@ -988,14 +983,15 @@     unnumberedfieldnames = ["amount","amount-in","amount-out"]      -- amount field names which can affect this posting-    fieldnames = map (("amount"++show n)++) ["","-in","-out"]+    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@(_:_) <- [strip . renderTemplate rules record <$> hledgerField rules record f]+                          , Just v <- [T.strip . renderTemplate rules record <$> hledgerField rules record f]+                          , not $ T.null v                           , 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@@ -1006,7 +1002,7 @@     assignments' | any isnumbered assignments = filter isnumbered assignments                  | otherwise                  = assignments       where-        isnumbered (f,_) = any (flip elem ['0'..'9']) f+        isnumbered (f,_) = T.any (flip elem ['0'..'9']) f      -- if there's more than one value and only some are zeros, discard the zeros     assignments''@@ -1017,24 +1013,24 @@   in case -- dbg0 ("amounts for posting "++show n)           assignments'' of       [] -> Nothing-      [(f,a)] | "-out" `isSuffixOf` f -> Just (-a)  -- for -out fields, flip the sign+      [(f,a)] | "-out" `T.isSuffixOf` f -> Just (-a)  -- for -out fields, flip the sign       [(_,a)] -> Just a-      fs      -> error' $ unlines $ [  -- PARTIAL:+      fs      -> error' . T.unpack . T.unlines $ [  -- PARTIAL:          "multiple non-zero amounts or multiple zero amounts assigned,"         ,"please ensure just one. (https://hledger.org/csv.html#amount)"-        ,"  " ++ showRecord record-        ,"  for posting: " ++ show n+        ,"  " <> showRecord record+        ,"  for posting: " <> T.pack (show n)         ]-        ++ ["  assignment: " ++ f ++ " " ++-             fromMaybe "" (hledgerField rules record f) ++-             "\t=> value: " ++ showMixedAmount a -- XXX not sure this is showing all the right info+        ++ ["  assignment: " <> f <> " " <>+             fromMaybe "" (hledgerField rules record f) <>+             "\t=> value: " <> wbToText (showMixedAmountB noColour a) -- XXX not sure this is showing all the right info            | (f,a) <- fs]  -- | Figure out the expected balance (assertion or assignment) specified for posting N, -- if any (and its parse position).-getBalance :: CsvRules -> CsvRecord -> String -> Int -> Maybe (Amount, GenericSourcePos)+getBalance :: CsvRules -> CsvRecord -> Text -> Int -> Maybe (Amount, GenericSourcePos) getBalance rules record currency n = do-  v <- (fieldval ("balance"++show n)+  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@@ -1043,30 +1039,29 @@             parseBalanceAmount rules record currency n s            ,nullsourcepos  -- parse position to show when assertion fails,            )               -- XXX the csv record's line number would be good-     where-    fieldval = fmap strip . hledgerFieldValue rules record :: HledgerFieldName -> Maybe String+    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 -> String -> String -> MixedAmount+parseAmount :: CsvRules -> CsvRecord -> Text -> Text -> MixedAmount parseAmount rules record currency s =-  either mkerror (Mixed . (:[])) $  -- PARTIAL:-  runParser (evalStateT (amountp <* eof) journalparsestate) "" $-  T.pack $ (currency++) $ simplifySign s+    either mkerror (Mixed . (:[])) $  -- PARTIAL:+    runParser (evalStateT (amountp <* eof) journalparsestate) "" $+    currency <> simplifySign s   where     journalparsestate = nulljournal{jparsedecimalmark=parseDecimalMark rules}-    mkerror e = error' $ unlines-      ["error: could not parse \""++s++"\" as an amount"+    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:      "++customErrorBundlePretty e-      ,"you may need to "-        ++"change your amount*, balance*, or currency* rules, "-        ++"or add or change your skip rule"+      ,"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"       ]  -- XXX unify these ^v@@ -1076,30 +1071,30 @@ -- 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 -> String -> Int -> String -> Amount+parseBalanceAmount :: CsvRules -> CsvRecord -> Text -> Int -> Text -> Amount parseBalanceAmount rules record currency n s =   either (mkerror n s) id $     runParser (evalStateT (amountp <* eof) journalparsestate) "" $-    T.pack $ (currency++) $ simplifySign s+    currency <> simplifySign s                   -- the csv record's line number would be good   where     journalparsestate = nulljournal{jparsedecimalmark=parseDecimalMark rules}-    mkerror n s e = error' $ unlines-      ["error: could not parse \""++s++"\" as balance"++show n++" amount"+    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:      "++customErrorBundlePretty e+      ,"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 =-  case rules `csvRule` "decimal-mark" of-    Nothing -> Nothing-    Just [c] | isDecimalMark c -> Just c-    Just s -> error' $ "decimal-mark's argument should be \".\" or \",\" (not \""++s++"\")"+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@@ -1116,8 +1111,8 @@         Just "=="  -> nullassertion{batotal=True}         Just "=*"  -> nullassertion{bainclusive=True}         Just "==*" -> nullassertion{batotal=True, bainclusive=True}-        Just x     -> error' $ unlines  -- PARTIAL:-          [ "balance-type \"" ++ x ++"\" is invalid. Use =, ==, =* or ==*."+        Just x     -> error' . T.unpack $ T.unlines  -- PARTIAL:+          [ "balance-type \"" <> x <>"\" is invalid. Use =, ==, =* or ==*."           , showRecord record           , showRules rules record           ]@@ -1128,8 +1123,8 @@ getAccount :: CsvRules -> CsvRecord -> Maybe MixedAmount -> Maybe (Amount, GenericSourcePos) -> Int -> Maybe (AccountName, Bool) getAccount rules record mamount mbalance n =   let-    fieldval = hledgerFieldValue rules record :: HledgerFieldName -> Maybe String-    maccount = T.pack <$> fieldval ("account"++show n)+    fieldval = hledgerFieldValue rules record :: HledgerFieldName -> Maybe Text+    maccount = fieldval ("account"<> T.pack (show n))   in case maccount of     -- accountN is set to the empty string - no posting will be generated     Just "" -> Nothing@@ -1150,14 +1145,21 @@ unknownExpenseAccount = "expenses:unknown" unknownIncomeAccount  = "income:unknown" -type CsvAmountString = String+type CsvAmountString = Text  -- | Canonicalise the sign in a CSV amount string.--- Such strings can have a minus sign, negating parentheses,--- or any two of these (which cancels out).+-- 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)"@@ -1166,23 +1168,36 @@ -- "1" -- >>> simplifySign "-(1)" -- "1"+-- >>> simplifySign "-+1"+-- "-1" -- >>> simplifySign "(-1)" -- "1" -- >>> simplifySign "((1))" -- "1"+-- >>> simplifySign "-"+-- ""+-- >>> simplifySign "()"+-- ""+-- >>> simplifySign "+"+-- "" simplifySign :: CsvAmountString -> CsvAmountString-simplifySign ('(':s) | lastMay s == Just ')' = simplifySign $ negateStr $ init s-simplifySign ('-':'(':s) | lastMay s == Just ')' = simplifySign $ init s-simplifySign ('-':'-':s) = s-simplifySign s = s+simplifySign amtstr+  | 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 :: String -> String-negateStr ('-':s) = s-negateStr s       = '-':s+negateStr :: Text -> Text+negateStr amtstr = case T.uncons amtstr of+    Just ('-',s) -> s+    _            -> T.cons '-' amtstr  -- | Show a (approximate) recreation of the original CSV record.-showRecord :: CsvRecord -> String-showRecord r = "record values: "++intercalate "," (map show r)+showRecord :: CsvRecord -> Text+showRecord r = "record values: "<>T.intercalate "," (map (wrap "\"" "\"") r)  -- | 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@@ -1208,7 +1223,7 @@               where                 -- does this individual matcher match the current csv record ?                 matcherMatches :: Matcher -> Bool-                matcherMatches (RecordMatcher _ pat) = regexMatch pat' wholecsvline+                matcherMatches (RecordMatcher _ pat) = regexMatchText pat' wholecsvline                   where                     pat' = dbg7 "regex" pat                     -- A synthetic whole CSV record to match against. Note, this can be@@ -1217,47 +1232,48 @@                     -- - 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" $ intercalate "," record-                matcherMatches (FieldMatcher _ csvfieldref pat) = regexMatch pat csvfieldvalue+                    wholecsvline = dbg7 "wholecsvline" $ T.intercalate "," record+                matcherMatches (FieldMatcher _ csvfieldref pat) = regexMatchText pat csvfieldvalue                   where                     -- the value of the referenced CSV field to match against.                     csvfieldvalue = dbg7 "csvfieldvalue" $ replaceCsvFieldReference rules record csvfieldref  -- | Render a field assignment's template, possibly interpolating referenced -- CSV field values. Outer whitespace is removed from interpolated values.-renderTemplate ::  CsvRules -> CsvRecord -> FieldTemplate -> String-renderTemplate rules record t = maybe t concat $ parseMaybe+renderTemplate ::  CsvRules -> CsvRecord -> FieldTemplate -> Text+renderTemplate rules record t = maybe t mconcat $ parseMaybe     (many $ takeWhile1P Nothing (/='%')         <|> replaceCsvFieldReference rules record <$> referencep)     t   where-    referencep = liftA2 (:) (char '%') (takeWhile1P (Just "reference") isDescriptorChar) :: Parsec CustomErr String String+    referencep = liftA2 T.cons (char '%') (takeWhile1P (Just "reference") isDescriptorChar) :: Parsec CustomErr Text Text     isDescriptorChar c = isAscii c && (isAlphaNum c || c == '_' || c == '-')  -- | 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, leave it unchanged.-replaceCsvFieldReference :: CsvRules -> CsvRecord -> CsvFieldReference -> String-replaceCsvFieldReference rules record s@('%':fieldname) = fromMaybe s $ csvFieldValue rules record fieldname-replaceCsvFieldReference _ _ s = s+replaceCsvFieldReference :: CsvRules -> CsvRecord -> CsvFieldReference -> Text+replaceCsvFieldReference rules record s = case T.uncons s of+    Just ('%', fieldname) -> fromMaybe s $ 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 String+csvFieldValue :: CsvRules -> CsvRecord -> CsvFieldName -> Maybe Text csvFieldValue rules record fieldname = do-  fieldindex <- if | all isDigit fieldname -> readMay fieldname-                   | otherwise             -> lookup (map toLower fieldname) $ rcsvfieldindexes rules-  fieldvalue <- strip <$> atMay record (fieldindex-1)+  fieldindex <- if | T.all isDigit fieldname -> readMay $ T.unpack fieldname+                   | otherwise               -> lookup (T.toLower fieldname) $ rcsvfieldindexes rules+  fieldvalue <- T.strip <$> atMay record (fieldindex-1)   return fieldvalue  -- | 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).-parseDateWithCustomOrDefaultFormats :: Maybe DateFormat -> String -> Maybe Day+parseDateWithCustomOrDefaultFormats :: Maybe DateFormat -> Text -> Maybe Day parseDateWithCustomOrDefaultFormats mformat s = asum $ map parsewith formats   where-    parsewith = flip (parseTimeM True defaultTimeLocale) s-    formats = maybe+    parsewith = flip (parseTimeM True defaultTimeLocale) (T.unpack s)+    formats = map T.unpack $ maybe                ["%Y/%-m/%-d"                ,"%Y-%-m-%-d"                ,"%Y.%-m.%-d"

@@ -42,7 +42,7 @@   -- * Reader-finding utils   findReader,   splitReaderPrefix,-  +   -- * Reader   reader, @@ -226,6 +226,7 @@    ,applyaccountdirectivep    ,commoditydirectivep    ,endapplyaccountdirectivep+   ,payeedirectivep    ,tagdirectivep    ,endtagdirectivep    ,defaultyeardirectivep@@ -379,8 +380,8 @@     "c"         -> Right Cash     _           -> Left err   where-    err = "invalid account type code "++T.unpack s++", should be one of " ++-          (intercalate ", " $ ["A","L","E","R","X","C","Asset","Liability","Equity","Revenue","Expense","Cash"])+    err = T.unpack $ "invalid account type code "<>s<>", should be one of " <>+            T.intercalate ", " ["A","L","E","R","X","C","Asset","Liability","Equity","Revenue","Expense","Cash"]  -- Add an account declaration to the journal, auto-numbering it. addAccountDeclaration :: (AccountName,Text,[Tag]) -> JournalParser m ()@@ -396,6 +397,17 @@              in                j{jdeclaredaccounts = d:decls}) +-- Add a payee declaration to the journal.+addPayeeDeclaration :: (Payee,Text,[Tag]) -> JournalParser m ()+addPayeeDeclaration (p, cmt, tags) =+  modify' (\j@Journal{jdeclaredpayees} -> j{jdeclaredpayees=d:jdeclaredpayees})+             where+               d = (p+                   ,nullpayeedeclarationinfo{+                     pdicomment = cmt+                    ,pditags    = tags+                    })+ indentedlinep :: JournalParser m String indentedlinep = lift skipNonNewlineSpaces1 >> (rstrip <$> lift restofline) @@ -519,6 +531,15 @@   lift restofline   return () +payeedirectivep :: JournalParser m ()+payeedirectivep = do+  string "payee" <?> "payee directive"+  lift skipNonNewlineSpaces1+  payee <- lift descriptionp  -- all text until ; or \n+  (comment, tags) <- lift transactioncommentp+  addPayeeDeclaration (payee, comment, tags)+  return ()+ defaultyeardirectivep :: JournalParser m () defaultyeardirectivep = do   char 'Y' <?> "default year"@@ -984,6 +1005,11 @@       pdcommodity = "BTC",       pdamount    = usd 922.83       }++  ,tests "payeedirectivep" [+       test "simple"             $ assertParse payeedirectivep "payee foo\n"+       ,test "with-comment"       $ assertParse payeedirectivep "payee foo ; comment\n"+       ]    ,test "tagdirectivep" $ do      assertParse tagdirectivep "tag foo \n"

@@ -182,7 +182,7 @@         tstatus    = Cleared,         tpostings  = [           nullposting{paccount=a-                     ,pamount=Mixed [setAmountPrecision (Precision 2) $ num hours]  -- don't assume hours; do set precision to 2+                     ,pamount=Mixed [amountSetPrecision (Precision 2) $ num hours]  -- don't assume hours; do set precision to 2                      ,ptype=VirtualPosting                      ,ptransaction=Just t                      }

@@ -18,6 +18,7 @@ import Data.List import Data.Ord import Data.Maybe+import Data.Text (Text) import qualified Data.Text as T import Data.Time.Calendar @@ -64,26 +65,20 @@ -- posts to the current account), most recent first. -- Reporting intervals are currently ignored. ---type AccountTransactionsReport =-  (String                          -- label for the balance column, eg "balance" or "total"-  ,[AccountTransactionsReportItem] -- line items, one per transaction-  )+type AccountTransactionsReport = [AccountTransactionsReportItem] -- line items, one per transaction  type AccountTransactionsReportItem =   (    Transaction -- the transaction, unmodified   ,Transaction -- the transaction, as seen from the current account   ,Bool        -- is this a split (more than one posting to other accounts) ?-  ,String      -- a display string describing the other account(s), if any+  ,Text        -- a display string describing the other account(s), if any   ,MixedAmount -- the amount posted to the current account(s) (or total amount posted)   ,MixedAmount -- the register's running total or the current account(s)'s historical balance, after this transaction   ) -totallabel   = "Period Total"-balancelabel = "Historical Total"- accountTransactionsReport :: ReportSpec -> Journal -> Query -> Query -> AccountTransactionsReport-accountTransactionsReport rspec@ReportSpec{rsOpts=ropts} j reportq thisacctq = (label, items)+accountTransactionsReport rspec@ReportSpec{rsOpts=ropts} j reportq thisacctq = items   where     -- a depth limit should not affect the account transactions report     -- seems unnecessary for some reason XXX@@ -116,14 +111,10 @@     periodlast =       fromMaybe (error' "journalApplyValuation: expected a non-empty journal") $ -- XXX shouldn't happen       reportPeriodOrJournalLastDay rspec j-    mreportlast = reportPeriodLastDay rspec-    multiperiod = interval_ ropts /= NoInterval-    tval = case value_ ropts of-             Just v  -> \t -> transactionApplyValuation prices styles periodlast mreportlast (rsToday rspec) multiperiod t v-             Nothing -> id+    tval = transactionApplyCostValuation prices styles periodlast (rsToday rspec) (cost_ ropts) $ value_ ropts     ts4 =       ptraceAtWith 5 (("ts4:\n"++).pshowTransactions) $-      map tval ts3 +      map tval ts3      -- sort by the transaction's register date, for accurate starting balance     -- these are not yet filtered by tdate, we want to search them all for priorps@@ -131,9 +122,9 @@       ptraceAtWith 5 (("ts5:\n"++).pshowTransactions) $       sortBy (comparing (transactionRegisterDate reportq' thisacctq)) ts4 -    (startbal,label)-      | balancetype_ ropts == HistoricalBalance = (sumPostings priorps, balancelabel)-      | otherwise                               = (nullmixedamt,        totallabel)+    startbal+      | balancetype_ ropts == HistoricalBalance = sumPostings priorps+      | otherwise                               = nullmixedamt       where         priorps = dbg5 "priorps" $                   filter (matchesPosting@@ -218,9 +209,9 @@  -- | Generate a simplified summary of some postings' accounts. -- To reduce noise, if there are both real and virtual postings, show only the real ones.-summarisePostingAccounts :: [Posting] -> String+summarisePostingAccounts :: [Posting] -> Text summarisePostingAccounts ps =-  (intercalate ", " . map (T.unpack . accountSummarisedName) . nub . map paccount) displayps -- XXX pack+    T.intercalate ", " . map accountSummarisedName . nub $ map paccount displayps   where     realps = filter isReal ps     displayps | null realps = ps

@@ -27,27 +27,27 @@ ) where -import Data.Decimal+import Data.Decimal (roundTo) import Data.Default (def) import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HM-import Data.List+import Data.List (nub, partition, transpose) import Data.List.Extra (nubSort)-import Data.Maybe+import Data.Maybe (fromMaybe) #if !(MIN_VERSION_base(4,11,0)) import Data.Monoid ((<>)) #endif-import Safe+import Safe (headDef) --import Data.List --import Data.Maybe import qualified Data.Map as Map import Data.Map (Map)+import Data.Text (Text) import qualified Data.Text as T---import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Builder as TB --import System.Console.CmdArgs.Explicit as C --import Lucid as L--import Text.Printf (printf) import Text.Tabular as T import Text.Tabular.AsciiWide as T @@ -68,7 +68,7 @@ type BudgetReportRow = PeriodicReportRow DisplayName BudgetCell type BudgetReport    = PeriodicReport    DisplayName BudgetCell -type BudgetDisplayCell = ((String, Int), Maybe ((String, Int), Maybe (String, Int)))+type BudgetDisplayCell = ((Text, Int), Maybe ((Text, Int), Maybe (Text, Int)))  -- | Calculate per-account, per-period budget (balance change) goals -- from all periodic transactions, calculate actual balance changes @@ -219,27 +219,25 @@         totActualByPeriod = Map.fromList $ zip actualperiods actualtots :: Map DateSpan Change  -- | Render a budget report as plain text suitable for console output.-budgetReportAsText :: ReportOpts -> BudgetReport -> String-budgetReportAsText ropts@ReportOpts{..} budgetr =-    title ++ "\n\n" ++-    renderTable def{tableBorders=False,prettyTable=pretty_tables_}-        (alignCell TopLeft) (alignCell TopRight) (uncurry showcell) displayTableWithWidths+budgetReportAsText :: ReportOpts -> BudgetReport -> TL.Text+budgetReportAsText ropts@ReportOpts{..} budgetr = TB.toLazyText $+    TB.fromText title <> TB.fromText "\n\n" <>+      renderTableB def{tableBorders=False,prettyTable=pretty_tables_}+        (textCell TopLeft) (textCell TopRight) (uncurry showcell) displayTableWithWidths   where-    multiperiod = interval_ /= NoInterval-    title = printf "Budget performance in %s%s:"-      (showDateSpan $ periodicReportSpan budgetr)-      (case value_ of-        Just (AtCost _mc)   -> ", valued at cost"-        Just (AtThen _mc)   -> error' unsupportedValueThenError  -- PARTIAL:-        Just (AtEnd _mc)    -> ", valued at period ends"-        Just (AtNow _mc)    -> ", current value"-        -- XXX duplicates the above-        Just (AtDefault _mc) | multiperiod -> ", valued at period ends"-        Just (AtDefault _mc)  -> ", current value"-        Just (AtDate d _mc) -> ", valued at "++showDate d-        Nothing             -> "")+    title = "Budget performance in " <> showDateSpan (periodicReportSpan budgetr)+           <> (case cost_ of+                 Cost   -> ", converted to cost"+                 NoCost -> "")+           <> (case value_ of+                 Just (AtThen _mc)   -> ", valued at posting date"+                 Just (AtEnd _mc)    -> ", valued at period ends"+                 Just (AtNow _mc)    -> ", current value"+                 Just (AtDate d _mc) -> ", valued at " <> showDate d+                 Nothing             -> "")+           <> ":" -    displayTableWithWidths :: Table String String ((Int, Int, Int), BudgetDisplayCell)+    displayTableWithWidths :: Table Text Text ((Int, Int, Int), BudgetDisplayCell)     displayTableWithWidths = Table rh ch $ map (zipWith (,) widths) displaycells     Table rh ch displaycells = case budgetReportAsTable ropts budgetr of         Table rh' ch' vals -> maybetranspose . Table rh' ch' $ map (map displayCell) vals@@ -248,8 +246,8 @@       where         actual' = fromMaybe 0 actual         budgetAndPerc b = (showamt b, showper <$> percentage actual' b)-        showamt = showMixedOneLine showAmountWithoutPrice Nothing (Just 32) color_-        showper p = let str = show (roundTo 0 p) in (str, length str)+        showamt = (\(WideBuilder b w) -> (TL.toStrict $ TB.toLazyText b, w)) . showMixedAmountB oneLine{displayColour=color_, displayMaxWidth=Just 32}+        showper p = let str = T.pack (show $ roundTo 0 p) in (str, T.length str)     cellWidth ((_,wa), Nothing)                    = (wa,  0,  0)     cellWidth ((_,wa), Just ((_,wb), Nothing))     = (wa, wb,  0)     cellWidth ((_,wa), Just ((_,wb), Just (_,wp))) = (wa, wb, wp)@@ -263,14 +261,17 @@     -- XXX lay out actual, percentage and/or goal in the single table cell for now, should probably use separate cells     showcell :: (Int, Int, Int) -> BudgetDisplayCell -> Cell     showcell (actualwidth, budgetwidth, percentwidth) ((actual,wa), mbudget) =-        Cell TopRight [(replicate (actualwidth - wa) ' ' ++ actual ++ budgetstr, actualwidth + totalbudgetwidth)]+        Cell TopRight [WideBuilder ( TB.fromText (T.replicate (actualwidth - wa) " ")+                                   <> TB.fromText actual+                                   <> budgetstr+                                   ) (actualwidth + totalbudgetwidth)]       where         totalpercentwidth = if percentwidth == 0 then 0 else percentwidth + 5         totalbudgetwidth  = if budgetwidth == 0 then 0 else budgetwidth + totalpercentwidth + 3-        budgetstr = case mbudget of-          Nothing                             -> replicate totalbudgetwidth ' '-          Just ((budget, wb), Nothing)        -> " [" ++ replicate totalpercentwidth ' ' ++ replicate (budgetwidth - wb) ' ' ++ budget ++ "]"-          Just ((budget, wb), Just (pct, wp)) -> " [" ++ replicate (percentwidth - wp) ' ' ++ pct ++ "% of " ++ replicate (budgetwidth - wb) ' ' ++ budget ++ "]"+        budgetstr = TB.fromText $ case mbudget of+          Nothing                             -> T.replicate totalbudgetwidth " "+          Just ((budget, wb), Nothing)        -> " [" <> T.replicate totalpercentwidth " " <> T.replicate (budgetwidth - wb) " " <> budget <> "]"+          Just ((budget, wb), Just (pct, wp)) -> " [" <> T.replicate (percentwidth - wp) " " <> pct <> "% of " <> T.replicate (budgetwidth - wb) " " <> budget <> "]"      -- | 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.@@ -285,13 +286,15 @@         _   -> -- trace (pshow $ (maybecost actual, maybecost budget))  -- debug missing percentage                Nothing       where-        maybecost = if valuationTypeIsCost ropts then mixedAmountCost else id+        maybecost = case cost_ of+            Cost   -> mixedAmountCost+            NoCost -> id      maybetranspose | transpose_ = \(Table rh ch vals) -> Table ch rh (transpose vals)                    | otherwise  = id  -- | Build a 'Table' from a multi-column balance report.-budgetReportAsTable :: ReportOpts -> BudgetReport -> Table String String (Maybe MixedAmount, Maybe MixedAmount)+budgetReportAsTable :: ReportOpts -> BudgetReport -> Table Text Text (Maybe MixedAmount, Maybe MixedAmount) budgetReportAsTable   ropts@ReportOpts{balancetype_}   (PeriodicReport spans rows (PeriodicReportRow _ coltots grandtot grandavg)) =@@ -310,8 +313,8 @@     -- budgetReport sets accountlistmode to ALTree. Find a principled way to do     -- this.     renderacct row = case accountlistmode_ ropts of-        ALTree -> replicate ((prrDepth row - 1)*2) ' ' ++ T.unpack (prrDisplayName row)-        ALFlat -> T.unpack . accountNameDrop (drop_ ropts) $ prrFullName row+        ALTree -> T.replicate ((prrDepth row - 1)*2) " " <> prrDisplayName row+        ALFlat -> accountNameDrop (drop_ ropts) $ prrFullName row     rowvals (PeriodicReportRow _ as rowtot rowavg) =         as ++ [rowtot | row_total_ ropts] ++ [rowavg | average_ ropts]     addtotalrow@@ -334,7 +337,7 @@ -- - all other balance change reports: a description of the datespan, --   abbreviated to compact form if possible (see showDateSpan). ---reportPeriodName :: BalanceType -> [DateSpan] -> DateSpan -> String+reportPeriodName :: BalanceType -> [DateSpan] -> DateSpan -> T.Text reportPeriodName balancetype spans =   case balancetype of     PeriodChange -> if multiyear then showDateSpan else showDateSpanMonthAbbrev@@ -346,20 +349,20 @@ -- | Render a budget report as CSV. Like multiBalanceReportAsCsv, -- but includes alternating actual and budget amount columns. budgetReportAsCsv :: ReportOpts -> BudgetReport -> CSV-budgetReportAsCsv +budgetReportAsCsv   ReportOpts{average_, row_total_, no_total_, transpose_}   (PeriodicReport colspans items (PeriodicReportRow _ abtotals (magrandtot,mbgrandtot) (magrandavg,mbgrandavg)))   = (if transpose_ then transpose else id) $    -- heading row-  ("Account" : +  ("Account" :    concatMap (\span -> [showDateSpan span, "budget"]) colspans    ++ concat [["Total"  ,"budget"] | row_total_]    ++ concat [["Average","budget"] | average_]   ) :    -- account rows-  [T.unpack (displayFull a) :+  [displayFull a :    map showmamt (flattentuples abamts)    ++ concat [[showmamt mactualrowtot, showmamt mbudgetrowtot] | row_total_]    ++ concat [[showmamt mactualrowavg, showmamt mbudgetrowavg] | average_]@@ -371,7 +374,7 @@     [     "Total:" :     map showmamt (flattentuples abtotals)-    ++ concat [[showmamt magrandtot,showmamt mbgrandtot] | row_total_] +    ++ concat [[showmamt magrandtot,showmamt mbgrandtot] | row_total_]     ++ concat [[showmamt magrandavg,showmamt mbgrandavg] | average_]     ]   | not no_total_@@ -379,7 +382,7 @@    where     flattentuples abs = concat [[a,b] | (a,b) <- abs]-    showmamt = maybe "" (showMixedAmountOneLineWithoutPrice False)+    showmamt = maybe "" (wbToText . showMixedAmountB oneLine)  -- tests 

@@ -40,12 +40,8 @@     -- We may be converting posting amounts to value, per hledger_options.m4.md "Effect of --value on reports".     tvalue t@Transaction{..} = t{tpostings=map pvalue tpostings}       where-        pvalue p = maybe p-          (postingApplyValuation (journalPriceOracle infer_value_ j) (journalCommodityStyles j) periodlast mreportlast (rsToday rspec) False p)-          value_-          where-            periodlast  = fromMaybe (rsToday rspec) $ reportPeriodOrJournalLastDay rspec j-            mreportlast = reportPeriodLastDay rspec+        pvalue = postingApplyCostValuation (journalPriceOracle infer_value_ j) (journalCommodityStyles j) periodlast (rsToday rspec) cost_ value_+          where periodlast  = fromMaybe (rsToday rspec) $ reportPeriodOrJournalLastDay rspec j  tests_EntriesReport = tests "EntriesReport" [   tests "entriesReport" [

@@ -23,11 +23,9 @@   sortRowsLike,    -- * Helper functions-  calculateReportSpan,   makeReportQuery,   getPostingsByColumn,   getPostings,-  calculateColSpans,   startingBalances,   generateMultiBalanceReport, @@ -51,7 +49,7 @@ #endif import Data.Semigroup (sconcat) import Data.Time.Calendar (Day, addDays, fromGregorian)-import Safe (headMay, lastDef, lastMay)+import Safe (lastDef, minimumMay)  import Hledger.Data import Hledger.Query@@ -113,22 +111,19 @@ multiBalanceReportWith rspec' j priceoracle = report   where     -- Queries, report/column dates.-    reportspan = dbg3 "reportspan" $ calculateReportSpan rspec' j+    reportspan = dbg3 "reportspan" $ reportSpan j rspec'     rspec      = dbg3 "reportopts" $ makeReportQuery rspec' reportspan-    valuation  = makeValuation rspec' j priceoracle  -- Must use rspec' instead of rspec,-                                                     -- so the reportspan isn't used for valuation      -- Group postings into their columns.     colps    = dbg5 "colps"  $ getPostingsByColumn rspec j reportspan-    colspans = dbg3 "colspans" $ M.keys colps      -- The matched accounts with a starting balance. All of these should appear     -- in the report, even if they have no postings during the report period.-    startbals = dbg5 "startbals" $ startingBalances rspec j reportspan+    startbals = dbg5 "startbals" $ startingBalances rspec j priceoracle reportspan      -- Generate and postprocess the report, negating balances and taking percentages if needed     report = dbg4 "multiBalanceReportWith" $-      generateMultiBalanceReport rspec j valuation colspans colps startbals+      generateMultiBalanceReport rspec j priceoracle colps startbals  -- | Generate a compound balance report from a list of CBCSubreportSpec. This -- shares postings between the subreports.@@ -144,18 +139,15 @@ compoundBalanceReportWith rspec' j priceoracle subreportspecs = cbr   where     -- Queries, report/column dates.-    reportspan = dbg3 "reportspan" $ calculateReportSpan rspec' j+    reportspan = dbg3 "reportspan" $ reportSpan j rspec'     rspec      = dbg3 "reportopts" $ makeReportQuery rspec' reportspan-    valuation  = makeValuation rspec' j priceoracle  -- Must use ropts' instead of ropts,-                                                     -- so the reportspan isn't used for valuation      -- Group postings into their columns.-    colps    = dbg5 "colps"  $ getPostingsByColumn rspec{rsOpts=(rsOpts rspec){empty_=True}} j reportspan-    colspans = dbg3 "colspans" $ M.keys colps+    colps    = dbg5 "colps"  $ getPostingsByColumn rspec j reportspan      -- The matched accounts with a starting balance. All of these should appear     -- in the report, even if they have no postings during the report period.-    startbals = dbg5 "startbals" $ startingBalances rspec j reportspan+    startbals = dbg5 "startbals" $ startingBalances rspec j priceoracle reportspan      subreports = map generateSubreport subreportspecs       where@@ -163,7 +155,7 @@             ( cbcsubreporttitle             -- Postprocess the report, negating balances and taking percentages if needed             , cbcsubreporttransform $-                generateMultiBalanceReport rspec{rsOpts=ropts} j valuation colspans colps' startbals'+                generateMultiBalanceReport rspec{rsOpts=ropts} j priceoracle colps' startbals'             , cbcsubreportincreasestotal             )           where@@ -184,7 +176,7 @@         subreportTotal (_, sr, increasestotal) =             (if increasestotal then id else fmap negate) $ prTotals sr -    cbr = CompoundPeriodicReport "" colspans subreports overalltotals+    cbr = CompoundPeriodicReport "" (M.keys colps) subreports overalltotals   -- | Calculate starting balances, if needed for -H@@ -194,14 +186,20 @@ -- TODO: Do we want to check whether to bother calculating these? isHistorical -- and startDate is not nothing, otherwise mempty? This currently gives a -- failure with some totals which are supposed to be 0 being blank.-startingBalances :: ReportSpec -> Journal -> DateSpan -> HashMap AccountName Account-startingBalances rspec@ReportSpec{rsQuery=query,rsOpts=ropts} j reportspan =-    acctChangesFromPostings rspec' . map fst $ getPostings rspec' j+startingBalances :: ReportSpec -> Journal -> PriceOracle -> DateSpan -> HashMap AccountName Account+startingBalances rspec@ReportSpec{rsQuery=query,rsOpts=ropts} j priceoracle reportspan =+    fmap (M.findWithDefault nullacct precedingspan) acctmap   where+    acctmap = calculateReportMatrix rspec' j priceoracle mempty+            . M.singleton precedingspan . map fst $ getPostings rspec' j+     rspec' = rspec{rsQuery=startbalq,rsOpts=ropts'}-    ropts' = case accountlistmode_ ropts of-        ALTree -> ropts{period_=precedingperiod, no_elide_=True}-        ALFlat -> ropts{period_=precedingperiod}+    -- If we're re-valuing every period, we need to have the unvalued start+    -- balance, so we can do it ourselves later.+    ropts' = case value_ ropts of+        Just (AtEnd _) -> ropts''{value_=Nothing}+        _              -> ropts''+      where ropts'' = ropts{period_=precedingperiod, no_elide_=accountlistmode_ ropts == ALTree}      -- q projected back before the report start date.     -- When there's no report start date, in case there are future txns (the hledger-ui case above),@@ -216,26 +214,6 @@         DateSpan Nothing Nothing -> emptydatespan         a -> a --- | Calculate the span of the report to be generated.-calculateReportSpan :: ReportSpec -> Journal -> DateSpan-calculateReportSpan ReportSpec{rsQuery=query,rsOpts=ropts} j = reportspan-  where-    -- The date span specified by -b/-e/-p options and query args if any.-    requestedspan  = dbg3 "requestedspan" $ queryDateSpan (date2_ ropts) query-    -- If the requested span is open-ended, close it using the journal's end dates.-    -- This can still be the null (open) span if the journal is empty.-    requestedspan' = dbg3 "requestedspan'" $-        requestedspan `spanDefaultsFrom` journalDateSpan (date2_ ropts) j-    -- The list of interval spans enclosing the requested span.-    -- This list can be empty if the journal was empty,-    -- or if hledger-ui has added its special date:-tomorrow to the query-    -- and all txns are in the future.-    intervalspans  = dbg3 "intervalspans" $ splitSpan (interval_ ropts) requestedspan'-    -- The requested span enlarged to enclose a whole number of intervals.-    -- This can be the null span if there were no intervals.-    reportspan = DateSpan (spanStart =<< headMay intervalspans)-                          (spanEnd =<< lastMay intervalspans)- -- | Remove any date queries and insert queries from the report span. -- The user's query expanded to the report span -- if there is one (otherwise any date queries are left as-is, which@@ -250,27 +228,15 @@     dateless         = dbg3 "dateless" . filterQuery (not . queryIsDateOrDate2)     dateqcons        = if date2_ (rsOpts rspec) then Date2 else Date --- | Make a valuation function for valuating MixedAmounts and a given Day-makeValuation :: ReportSpec -> Journal -> PriceOracle -> (Day -> MixedAmount -> MixedAmount)-makeValuation rspec j priceoracle day = case value_ (rsOpts rspec) of-    Nothing -> id-    Just v  -> mixedAmountApplyValuation priceoracle styles day mreportlast (rsToday rspec) multiperiod v-  where-    -- Some things needed if doing valuation.-    styles = journalCommodityStyles j-    mreportlast = reportPeriodLastDay rspec-    multiperiod = interval_ (rsOpts rspec) /= NoInterval- -- | Group postings, grouped by their column getPostingsByColumn :: ReportSpec -> Journal -> DateSpan -> Map DateSpan [Posting] getPostingsByColumn rspec j reportspan = columns   where     -- Postings matching the query within the report period.     ps :: [(Posting, Day)] = dbg5 "getPostingsByColumn" $ getPostings rspec j-    days = map snd ps      -- The date spans to be included as report columns.-    colspans = calculateColSpans (rsOpts rspec) reportspan days+    colspans = dbg3 "colspans" $ splitSpan (interval_ $ rsOpts rspec) reportspan     addPosting (p, d) = maybe id (M.adjust (p:)) $ latestSpanContaining colspans d     emptyMap = M.fromList . zip colspans $ repeat [] @@ -296,33 +262,7 @@         PrimaryDate   -> postingDate         SecondaryDate -> postingDate2 --- | Calculate the DateSpans to be used for the columns of the report.-calculateColSpans :: ReportOpts -> DateSpan -> [Day] -> [DateSpan]-calculateColSpans ropts reportspan days =-    splitSpan (interval_ ropts) displayspan-  where-    displayspan-      | empty_ ropts = dbg3 "displayspan (-E)" reportspan                        -- all the requested intervals-      | otherwise = dbg3 "displayspan" $ reportspan `spanIntersect` matchedspan  -- exclude leading/trailing empty intervals-    matchedspan = dbg3 "matchedspan" $ daysSpan days ---- | Gather the account balance changes into a regular matrix--- including the accounts from all columns.-calculateAccountChanges :: ReportSpec -> [DateSpan] -> Map DateSpan [Posting]-                        -> HashMap ClippedAccountName (Map DateSpan Account)-calculateAccountChanges rspec colspans colps-    | queryDepth (rsQuery rspec) == Just 0 = acctchanges <> elided-    | otherwise = acctchanges-  where-    -- Transpose to get each account's balance changes across all columns.-    acctchanges = transposeMap colacctchanges--    colacctchanges :: Map DateSpan (HashMap ClippedAccountName Account) =-      dbg5 "colacctchanges" $ fmap (acctChangesFromPostings rspec) colps--    elided = HM.singleton "..." $ M.fromList [(span, nullacct) | span <- colspans]- -- | Given a set of postings, eg for a single report column, gather -- the accounts that have postings and calculate the change amount for -- each. Accounts and amounts will be depth-clipped appropriately if@@ -338,70 +278,68 @@                       filter ((0<) . anumpostings)     depthq = dbg3 "depthq" $ filterQuery queryIsDepth query --- | Accumulate and value amounts, as specified by the report options.+-- | Gather the account balance changes into a regular matrix, then+-- accumulate and value amounts, as specified by the report options. -- -- Makes sure all report columns have an entry.-accumValueAmounts :: ReportOpts -> (Day -> MixedAmount -> MixedAmount) -> [DateSpan]-                  -> HashMap ClippedAccountName Account-                  -> HashMap ClippedAccountName (Map DateSpan Account)-                  -> HashMap ClippedAccountName (Map DateSpan Account)-accumValueAmounts ropts valuation colspans startbals acctchanges =  -- PARTIAL:+calculateReportMatrix :: ReportSpec -> Journal -> PriceOracle+                      -> HashMap ClippedAccountName Account+                      -> Map DateSpan [Posting]+                      -> HashMap ClippedAccountName (Map DateSpan Account)+calculateReportMatrix rspec@ReportSpec{rsOpts=ropts} j priceoracle startbals colps =  -- PARTIAL:     -- Ensure all columns have entries, including those with starting balances-    HM.mapWithKey rowbals $ ((<>zeros) <$> acctchanges) <> (zeros <$ startbals)+    HM.mapWithKey rowbals allchanges   where     -- The valued row amounts to be displayed: per-period changes,     -- zero-based cumulative totals, or     -- starting-balance-based historical balances.     rowbals name changes = dbg5 "rowbals" $ case balancetype_ ropts of         PeriodChange      -> changeamts-        CumulativeChange  -> cumulative+        CumulativeChange  -> cumulativeSum avalue nullacct changeamts         HistoricalBalance -> historical       where-        historical = cumulativeSum startingBalance-        cumulative = cumulativeSum nullacct-        changeamts = M.mapWithKey valueAcct changes--        cumulativeSum start = snd $ M.mapAccumWithKey accumValued start changes-          where accumValued startAmt date newAmt = (s, valueAcct date s)-                  where s = sumAcct startAmt newAmt-+        -- changes to report on: usually just the changes itself, but use the+        -- differences in the historical amount for ValueChangeReports.+        changeamts = case reporttype_ ropts of+            ChangeReport      -> M.mapWithKey avalue changes+            BudgetReport      -> M.mapWithKey avalue changes+            ValueChangeReport -> periodChanges valuedStart historical+        historical = cumulativeSum avalue startingBalance changes         startingBalance = HM.lookupDefault nullacct name startbals--    -- Add the values of two accounts. Should be right-biased, since it's used-    -- in scanl, so other properties (such as anumpostings) stay in the right place-    sumAcct Account{aibalance=i1,aebalance=e1} a@Account{aibalance=i2,aebalance=e2} =-        a{aibalance = i1 + i2, aebalance = e1 + e2}+        valuedStart = avalue (DateSpan Nothing historicalDate) startingBalance -    -- We may be converting amounts to value, per hledger_options.m4.md "Effect of --value on reports".-    valueAcct (DateSpan _ (Just end)) acct =-        acct{aibalance = value (aibalance acct), aebalance = value (aebalance acct)}-      where value = valuation (addDays (-1) end)-    valueAcct _ _ = error "multiBalanceReport: expected all spans to have an end date"  -- XXX should not happen+    -- Transpose to get each account's balance changes across all columns, then+    -- pad with zeros+    allchanges     = ((<>zeros) <$> acctchanges) <> (zeros <$ startbals)+    acctchanges    = dbg5 "acctchanges" . addElided $ transposeMap colacctchanges+    colacctchanges = dbg5 "colacctchanges" $ fmap (acctChangesFromPostings rspec) valuedps+    valuedps = M.mapWithKey (\colspan -> map (pvalue colspan)) colps +    (pvalue, avalue) = postingAndAccountValuations rspec j priceoracle+    addElided = if queryDepth (rsQuery rspec) == Just 0 then HM.insert "..." zeros else id+    historicalDate = minimumMay $ mapMaybe spanStart colspans     zeros = M.fromList [(span, nullacct) | span <- colspans]+    colspans = M.keys colps + -- | Lay out a set of postings grouped by date span into a regular matrix with rows -- given by AccountName and columns by DateSpan, then generate a MultiBalanceReport -- from the columns.-generateMultiBalanceReport :: ReportSpec -> Journal -> (Day -> MixedAmount -> MixedAmount) -> [DateSpan]+generateMultiBalanceReport :: ReportSpec -> Journal -> PriceOracle                            -> Map DateSpan [Posting] -> HashMap AccountName Account                            -> MultiBalanceReport-generateMultiBalanceReport rspec@ReportSpec{rsOpts=ropts} j valuation colspans colps startbals =+generateMultiBalanceReport rspec@ReportSpec{rsOpts=ropts} j priceoracle colps startbals =     report   where-    -- Each account's balance changes across all columns.-    acctchanges = dbg5 "acctchanges" $ calculateAccountChanges rspec colspans colps-     -- Process changes into normal, cumulative, or historical amounts, plus value them-    accumvalued = accumValueAmounts ropts valuation colspans startbals acctchanges+    matrix = calculateReportMatrix rspec j priceoracle startbals colps      -- All account names that will be displayed, possibly depth-clipped.-    displaynames = dbg5 "displaynames" $ displayedAccounts rspec accumvalued+    displaynames = dbg5 "displaynames" $ displayedAccounts rspec matrix      -- All the rows of the report.-    rows = dbg5 "rows"-             . (if invert_ ropts then map (fmap negate) else id)  -- Negate amounts if applicable-             $ buildReportRows ropts displaynames accumvalued+    rows = dbg5 "rows" . (if invert_ ropts then map (fmap negate) else id)  -- Negate amounts if applicable+             $ buildReportRows ropts displaynames matrix      -- Calculate column totals     totalsrow = dbg5 "totalsrow" $ calculateTotalsRow ropts rows@@ -410,7 +348,7 @@     sortedrows = dbg5 "sortedrows" $ sortRows ropts j rows      -- Take percentages if needed-    report = reportPercent ropts $ PeriodicReport colspans sortedrows totalsrow+    report = reportPercent ropts $ PeriodicReport (M.keys colps) sortedrows totalsrow  -- | Build the report rows. -- One row per account, with account name info, row amounts, row total and row average.@@ -560,7 +498,7 @@ -- Makes sure that all DateSpans are present in all rows. transposeMap :: Map DateSpan (HashMap AccountName a)              -> HashMap AccountName (Map DateSpan a)-transposeMap xs = M.foldrWithKey addSpan mempty xs+transposeMap = M.foldrWithKey addSpan mempty   where     addSpan span acctmap seen = HM.foldrWithKey (addAcctSpan span) seen acctmap @@ -592,6 +530,44 @@     guard $ amountIsZero a' || amountIsZero b' || acommodity a' == acommodity b'     return $ mixed [per $ if aquantity b' == 0 then 0 else aquantity a' / abs (aquantity b') * 100]   where errmsg = "Cannot calculate percentages if accounts have different commodities (Hint: Try --cost, -V or similar flags.)"++-- Add the values of two accounts. Should be right-biased, since it's used+-- in scanl, so other properties (such as anumpostings) stay in the right place+sumAcct :: Account -> Account -> Account+sumAcct Account{aibalance=i1,aebalance=e1} a@Account{aibalance=i2,aebalance=e2} =+    a{aibalance = i1 + i2, aebalance = e1 + e2}++-- Subtract the values in one account from another. Should be left-biased.+subtractAcct :: Account -> Account -> Account+subtractAcct a@Account{aibalance=i1,aebalance=e1} Account{aibalance=i2,aebalance=e2} =+    a{aibalance = i1 - i2, aebalance = e1 - e2}++-- | Extract period changes from a cumulative list+periodChanges :: Account -> Map k Account -> Map k Account+periodChanges start amtmap =+    M.fromDistinctAscList . zip dates $ zipWith subtractAcct amts (start:amts)+  where (dates, amts) = unzip $ M.toAscList amtmap++-- | Calculate a cumulative sum from a list of period changes and a valuation+-- function.+cumulativeSum :: (DateSpan -> Account -> Account) -> Account -> Map DateSpan Account -> Map DateSpan Account+cumulativeSum value start = snd . M.mapAccumWithKey accumValued start+  where accumValued startAmt date newAmt = let s = sumAcct startAmt newAmt in (s, value date s)++-- | Calculate the Posting and Account valuation functions required by this+-- MultiBalanceReport.+postingAndAccountValuations :: ReportSpec -> Journal -> PriceOracle+                            -> (DateSpan -> Posting -> Posting, DateSpan -> Account -> Account)+postingAndAccountValuations ReportSpec{rsToday=today, rsOpts=ropts} j priceoracle = case value_ ropts of+    Just (AtEnd _) -> (const id, avalue' (cost_ ropts) (value_ ropts))+    _              -> (pvalue' (cost_ ropts) (value_ ropts), const id)+  where+    avalue' c v span a = a{aibalance = value (aibalance a), aebalance = value (aebalance a)}+      where value = mixedAmountApplyCostValuation priceoracle styles (end span) today (error "multiBalanceReport: did not expect amount valuation to be called ") c v  -- PARTIAL: should not happen+    pvalue' c v span = postingApplyCostValuation priceoracle styles (end span) today c v+    end = fromMaybe (error "multiBalanceReport: expected all spans to have an end date")  -- XXX should not happen+        . fmap (addDays (-1)) . spanEnd+    styles = journalCommodityStyles j  -- tests 

@@ -24,8 +24,7 @@ import Data.List import Data.List.Extra (nubSort) import Data.Maybe--- import Data.Text (Text)-import qualified Data.Text as T+import Data.Text (Text) import Data.Time.Calendar import Safe (headMay, lastMay) @@ -35,12 +34,10 @@ import Hledger.Reports.ReportOptions  --- | A postings report is a list of postings with a running total, a label--- for the total field, and a little extra transaction info to help with rendering.+-- | A postings report is a list of postings with a running total, and a little extra+-- transaction info to help with rendering. -- This is used eg for the register command.-type PostingsReport = (String               -- label for the running balance column XXX remove-                      ,[PostingsReportItem] -- line items, one per posting-                      )+type PostingsReport = [PostingsReportItem] -- line items, one per posting type PostingsReportItem = (Maybe Day    -- The posting date, if this is the first posting in a                                         -- transaction or if it's different from the previous                                         -- posting's date. Or if this a summary posting, the@@ -49,7 +46,7 @@                           ,Maybe Day    -- If this is a summary posting, the report interval's                                         -- end date if this is the first summary posting in                                         -- the interval.-                          ,Maybe String -- The posting's transaction's description, if this is the first posting in the transaction.+                          ,Maybe Text   -- The posting's transaction's description, if this is the first posting in the transaction.                           ,Posting      -- The posting, possibly with the account name depth-clipped.                           ,MixedAmount  -- The running total after this posting, or with --average,                                         -- the running average posting amount. With --historical,@@ -66,10 +63,9 @@ -- | Select postings from the journal and add running balance and other -- information to make a postings report. Used by eg hledger's register command. postingsReport :: ReportSpec -> Journal -> PostingsReport-postingsReport rspec@ReportSpec{rsOpts=ropts@ReportOpts{..}} j =-  (totallabel, items)+postingsReport rspec@ReportSpec{rsOpts=ropts@ReportOpts{..}} j = items     where-      reportspan  = adjustReportDates rspec j+      reportspan  = reportSpanBothDates j rspec       whichdate   = whichDateFromOpts ropts       mdepth      = queryDepth $ rsQuery rspec       styles      = journalCommodityStyles j@@ -79,19 +75,18 @@       -- postings to be included in the report, and similarly-matched postings before the report start date       (precedingps, reportps) = matchedPostingsBeforeAndDuring rspec j reportspan +      -- We may be converting posting amounts to value, per hledger_options.m4.md "Effect of --value on reports".+      pvalue periodlast = postingApplyCostValuation priceoracle styles periodlast (rsToday rspec) cost_ value_+       -- Postings, or summary postings with their subperiod's end date, to be displayed.       displayps :: [(Posting, Maybe Day)]-        | multiperiod && changingValuation ropts = [(pvalue lastday p, Just periodend) | (p, periodend) <- summariseps reportps, let lastday = addDays (-1) periodend]-        | multiperiod                            = [(p, Just periodend) | (p, periodend) <- summariseps valuedps]-        | otherwise                              = [(p, Nothing)        | p <- valuedps]+        | multiperiod, Just (AtEnd _) <- value_ = [(pvalue lastday p, Just periodend) | (p, periodend) <- summariseps reportps, let lastday = addDays (-1) periodend]+        | multiperiod = [(p, Just periodend) | (p, periodend) <- summariseps valuedps]+        | otherwise   = [(p, Nothing) | p <- valuedps]         where           summariseps = summarisePostingsByInterval interval_ whichdate mdepth showempty reportspan           valuedps = map (pvalue reportorjournallast) reportps           showempty = empty_ || average_-          -- We may be converting posting amounts to value, per hledger_options.m4.md "Effect of --value on reports".-          pvalue periodlast p = maybe p (postingApplyValuation priceoracle styles periodlast mreportlast (rsToday rspec) multiperiod p) value_-            where-              mreportlast = reportPeriodLastDay rspec           reportorjournallast =             fromMaybe (error' "postingsReport: expected a non-empty journal") $  -- PARTIAL: shouldn't happen             reportPeriodOrJournalLastDay rspec j@@ -106,19 +101,16 @@           -- of --value on reports".           -- XXX balance report doesn't value starting balance.. should this ?           historical = balancetype_ == HistoricalBalance-          startbal | average_  = if historical then bvalue precedingavg else 0-                   | otherwise = if historical then bvalue precedingsum else 0+          startbal | average_  = if historical then precedingavg else 0+                   | otherwise = if historical then precedingsum else 0             where-              precedingsum = sumPostings precedingps+              precedingsum = sumPostings $ map (pvalue daybeforereportstart) precedingps               precedingavg | null precedingps = 0                            | otherwise        = divideMixedAmount (fromIntegral $ length precedingps) precedingsum-              bvalue = maybe id (mixedAmountApplyValuation priceoracle styles daybeforereportstart Nothing (rsToday rspec) multiperiod) value_-                  -- XXX constrain valuation type to AtDate daybeforereportstart here ?-                where-                  daybeforereportstart =-                    maybe (error' "postingsReport: expected a non-empty journal")  -- PARTIAL: shouldn't happen-                    (addDays (-1))-                    $ reportPeriodOrJournalStart rspec j+              daybeforereportstart =+                maybe (error' "postingsReport: expected a non-empty journal")  -- PARTIAL: shouldn't happen+                (addDays (-1))+                $ reportPeriodOrJournalStart rspec j            runningcalc = registerRunningCalculationFn ropts           startnum = if historical then length precedingps + 1 else 1@@ -132,28 +124,6 @@   | average_ ropts = \i avg amt -> avg + divideMixedAmount (fromIntegral i) (amt - avg)   | otherwise      = \_ bal amt -> bal + amt -totallabel = "Total"---- | Adjust report start/end dates to more useful ones based on--- journal data and report intervals. Ie:--- 1. If the start date is unspecified, use the earliest date in the journal (if any)--- 2. If the end date is unspecified, use the latest date in the journal (if any)--- 3. If a report interval is specified, enlarge the dates to enclose whole intervals-adjustReportDates :: ReportSpec -> Journal -> DateSpan-adjustReportDates rspec@ReportSpec{rsOpts=ropts} j = reportspan-  where-    -- see also multiBalanceReport-    requestedspan       = dbg3 "requestedspan"       $ queryDateSpan' $ rsQuery rspec                         -- span specified by -b/-e/-p options and query args-    journalspan         = dbg3 "journalspan"         $ dates `spanUnion` date2s                               -- earliest and latest dates (or date2s) in the journal-      where-        dates  = journalDateSpan False j-        date2s = journalDateSpan True  j-    requestedspanclosed = dbg3 "requestedspanclosed" $ requestedspan `spanDefaultsFrom` journalspan           -- if open-ended, close it using the journal's dates (if any)-    intervalspans       = dbg3 "intervalspans"       $ splitSpan (interval_ ropts) requestedspanclosed  -- get the whole intervals enclosing that-    mreportstart        = dbg3 "reportstart"         $ maybe Nothing spanStart $ headMay intervalspans        -- start of the first interval, or open ended-    mreportend          = dbg3 "reportend"           $ maybe Nothing spanEnd   $ lastMay intervalspans        -- end of the last interval, or open ended-    reportspan          = dbg3 "reportspan"          $ DateSpan mreportstart mreportend                       -- the requested span enlarged to whole intervals if possible- -- | Find postings matching a given query, within a given date span, -- and also any similarly-matched postings before that date span. -- Date restrictions and depth restrictions in the query are ignored.@@ -208,14 +178,13 @@ mkpostingsReportItem showdate showdesc wd menddate p b =   (if showdate then Just date else Nothing   ,menddate-  ,if showdesc then Just desc else Nothing+  ,if showdesc then tdescription <$> ptransaction p else Nothing   ,p   ,b   )   where     date = case wd of PrimaryDate   -> postingDate p                       SecondaryDate -> postingDate2 p-    desc = T.unpack $ maybe "" tdescription $ ptransaction p  -- | Convert a list of postings into summary postings, one per interval, -- aggregated to the specified depth if any.@@ -269,7 +238,7 @@ tests_PostingsReport = tests "PostingsReport" [     test "postingsReport" $ do-    let (query, journal) `gives` n = (length $ snd $ postingsReport defreportspec{rsQuery=query} journal) @?= n+    let (query, journal) `gives` n = (length $ postingsReport defreportspec{rsQuery=query} journal) @?= n     -- with the query specified explicitly     (Any, nulljournal) `gives` 0     (Any, samplejournal) `gives` 13@@ -278,10 +247,10 @@     (And [Depth 1, StatusQ Cleared, Acct (toRegex' "expenses")], samplejournal) `gives` 2     (And [And [Depth 1, StatusQ Cleared], Acct (toRegex' "expenses")], samplejournal) `gives` 2     -- with query and/or command-line options-    (length $ snd $ postingsReport defreportspec samplejournal) @?= 13-    (length $ snd $ postingsReport defreportspec{rsOpts=defreportopts{interval_=Months 1}} samplejournal) @?= 11-    (length $ snd $ postingsReport defreportspec{rsOpts=defreportopts{interval_=Months 1, empty_=True}} samplejournal) @?= 20-    (length $ snd $ postingsReport defreportspec{rsQuery=Acct $ toRegex' "assets:bank:checking"} samplejournal) @?= 5+    (length $ postingsReport defreportspec samplejournal) @?= 13+    (length $ postingsReport defreportspec{rsOpts=defreportopts{interval_=Months 1}} samplejournal) @?= 11+    (length $ postingsReport defreportspec{rsOpts=defreportopts{interval_=Months 1, empty_=True}} samplejournal) @?= 20+    (length $ postingsReport defreportspec{rsQuery=Acct $ toRegex' "assets:bank:checking"} samplejournal) @?= 5       -- (defreportopts, And [Acct "a a", Acct "'b"], samplejournal2) `gives` 0      -- [(Just (fromGregorian 2008 01 01,"income"),assets:bank:checking             $1,$1)

@@ -11,6 +11,7 @@ module Hledger.Reports.ReportOptions (   ReportOpts(..),   ReportSpec(..),+  ReportType(..),   BalanceType(..),   AccountListMode(..),   ValuationType(..),@@ -21,9 +22,9 @@   updateReportSpec,   updateReportSpecWith,   rawOptsToReportSpec,+  balanceTypeOverride,   flat_,   tree_,-  changingValuation,   reportOptsToggleStatus,   simplifyStatuses,   whichDateFromOpts,@@ -34,24 +35,23 @@   transactionDateFn,   postingDateFn,   reportSpan,+  reportSpanBothDates,   reportStartDate,   reportEndDate,   reportPeriodStart,   reportPeriodOrJournalStart,   reportPeriodLastDay,   reportPeriodOrJournalLastDay,-  valuationTypeIsCost,-  valuationTypeIsDefaultValue, ) where  import Control.Applicative ((<|>)) import Data.List.Extra (nubSort)-import Data.Maybe (fromMaybe, isJust)+import Data.Maybe (fromMaybe, isJust, mapMaybe) import qualified Data.Text as T import Data.Time.Calendar (Day, addDays) import Data.Default (Default(..))-import Safe (lastDef, lastMay)+import Safe (headMay, lastDef, lastMay, maximumMay)  import System.Console.ANSI (hSupportsANSIColor) import System.Environment (lookupEnv)@@ -63,8 +63,16 @@ import Hledger.Utils  --- | Which "balance" is being shown in a balance report.-data BalanceType = PeriodChange      -- ^ The change of balance in each period.+-- | What is calculated and shown in each cell in a balance report.+data ReportType = ChangeReport       -- ^ The sum of posting amounts.+                | BudgetReport       -- ^ The sum of posting amounts and the goal.+                | ValueChangeReport  -- ^ The change of value of period-end historical values.+  deriving (Eq, Show)++instance Default ReportType where def = ChangeReport++-- | Which "accumulation method" is being shown in a balance report.+data BalanceType = PeriodChange      -- ^ The accumulate change over a single period.                  | CumulativeChange  -- ^ The accumulated change across multiple periods.                  | HistoricalBalance -- ^ The historical ending balance, including the effect of                                      --   all postings before the report period. Unless altered by,@@ -87,6 +95,7 @@      period_         :: Period     ,interval_       :: Interval     ,statuses_       :: [Status]  -- ^ Zero, one, or two statuses to be matched+    ,cost_           :: Costing  -- ^ Should we convert amounts to cost, when present?     ,value_          :: Maybe ValuationType  -- ^ What value should amounts be converted to ?     ,infer_value_    :: Bool      -- ^ Infer market prices from transactions ?     ,depth_          :: Maybe Int@@ -103,6 +112,7 @@     -- for account transactions reports (aregister)     ,txn_dates_      :: Bool     -- for balance reports (bal, bs, cf, is)+    ,reporttype_     :: ReportType     ,balancetype_    :: BalanceType     ,accountlistmode_ :: AccountListMode     ,drop_           :: Int@@ -136,6 +146,7 @@     { period_          = PeriodAll     , interval_        = NoInterval     , statuses_        = []+    , cost_            = NoCost     , value_           = Nothing     , infer_value_     = False     , depth_           = Nothing@@ -148,6 +159,7 @@     , average_         = False     , related_         = False     , txn_dates_       = False+    , reporttype_      = def     , balancetype_     = def     , accountlistmode_ = ALFlat     , drop_            = 0@@ -170,20 +182,22 @@     supports_color <- hSupportsANSIColor stdout      let colorflag    = stringopt "color" rawopts-        formatstring = maybestringopt "format" rawopts+        formatstring = T.pack <$> maybestringopt "format" rawopts         querystring  = map T.pack $ listofstringopt "args" rawopts  -- doesn't handle an arg like "" right+        (costing, valuation) = valuationTypeFromRawOpts rawopts      format <- case parseStringFormat <$> formatstring of         Nothing         -> return defaultBalanceLineFormat         Just (Right x)  -> return x         Just (Left err) -> fail $ "could not parse format option: " ++ err -    let reportopts = defreportopts+    return defreportopts           {period_      = periodFromRawOpts d rawopts           ,interval_    = intervalFromRawOpts rawopts           ,statuses_    = statusesFromRawOpts rawopts-          ,value_       = valuationTypeFromRawOpts rawopts-          ,infer_value_ = boolopt "infer-value" rawopts+          ,cost_        = costing+          ,value_       = valuation+          ,infer_value_ = boolopt "infer-market-price" rawopts           ,depth_       = maybeposintopt "depth" rawopts           ,date2_       = boolopt "date2" rawopts           ,empty_       = boolopt "empty" rawopts@@ -194,6 +208,7 @@           ,average_     = boolopt "average" rawopts           ,related_     = boolopt "related" rawopts           ,txn_dates_   = boolopt "txn-dates" rawopts+          ,reporttype_  = reporttypeopt rawopts           ,balancetype_ = balancetypeopt rawopts           ,accountlistmode_ = accountlistmodeopt rawopts           ,drop_        = posintopt "drop" rawopts@@ -210,7 +225,6 @@           ,forecast_    = forecastPeriodFromRawOpts d rawopts           ,transpose_   = boolopt "transpose" rawopts           }-    return reportopts  -- | The result of successfully parsing a ReportOpts on a particular -- Day. Any ambiguous dates are completed and Queries are parsed,@@ -273,13 +287,29 @@       "flat" -> Just ALFlat       _      -> Nothing +reporttypeopt :: RawOpts -> ReportType+reporttypeopt =+  fromMaybe ChangeReport . choiceopt parse where+    parse = \case+      "sum"         -> Just ChangeReport+      "valuechange" -> Just ValueChangeReport+      "budget"      -> Just BudgetReport+      _             -> Nothing+ balancetypeopt :: RawOpts -> BalanceType-balancetypeopt =-  fromMaybe PeriodChange . choiceopt parse where+balancetypeopt = fromMaybe PeriodChange . balanceTypeOverride++balanceTypeOverride :: RawOpts -> Maybe BalanceType+balanceTypeOverride rawopts = choiceopt parse rawopts <|> reportbal+  where     parse = \case       "historical" -> Just HistoricalBalance       "cumulative" -> Just CumulativeChange+      "change"     -> Just PeriodChange       _            -> Nothing+    reportbal = case reporttypeopt rawopts of+      ValueChangeReport -> Just PeriodChange+      _                 -> Nothing  -- Get the period specified by any -b/--begin, -e/--end and/or -p/--period -- options appearing in the command line.@@ -402,27 +432,37 @@   | s `elem` ss = ropts{statuses_=filter (/= s) ss}   | otherwise   = ropts{statuses_=simplifyStatuses (s:ss)} --- | Parse the type of valuation to be performed, if any, specified by--- -B/--cost, -V, -X/--exchange, or --value flags. If there's more--- than one of these, the rightmost flag wins.-valuationTypeFromRawOpts :: RawOpts -> Maybe ValuationType-valuationTypeFromRawOpts = lastMay . collectopts valuationfromrawopt+-- | Parse the type of valuation and costing to be performed, if any,+-- specified by -B/--cost, -V, -X/--exchange, or --value flags. It is+-- allowed to combine -B/--cost with any other valuation type. If+-- there's more than one valuation type, the rightmost flag wins.+valuationTypeFromRawOpts :: RawOpts -> (Costing, Maybe ValuationType)+valuationTypeFromRawOpts rawopts = (costing, valuation)   where+    costing   = if (any ((Cost==) . fst) valuationopts) then Cost else NoCost+    valuation = case reporttypeopt rawopts of+        ValueChangeReport -> case directval of+            Nothing        -> Just $ AtEnd Nothing  -- If no valuation requested for valuechange, use AtEnd+            Just (AtEnd _) -> directval             -- If AtEnd valuation requested, use it+            Just _         -> usageError "--valuechange only produces sensible results with --value=end"+        _                  -> directval             -- Otherwise, use requested valuation+      where directval = lastMay $ mapMaybe snd valuationopts++    valuationopts = collectopts valuationfromrawopt rawopts     valuationfromrawopt (n,v)  -- option name, value-      | n == "B"     = Just $ AtCost Nothing-      | n == "V"     = Just $ AtDefault Nothing-      | n == "X"     = Just $ AtDefault (Just $ T.pack v)-      | n == "value" = Just $ valuation v+      | n == "B"     = Just (Cost,   Nothing)  -- keep supporting --value=cost for now+      | n == "V"     = Just (NoCost, Just $ AtEnd Nothing)+      | n == "X"     = Just (NoCost, Just $ AtEnd (Just $ T.pack v))+      | n == "value" = Just $ valueopt v       | otherwise    = Nothing-    valuation v-      | t `elem` ["cost","c"]  = AtCost mc-      | t `elem` ["then" ,"t"] = AtThen  mc-      | t `elem` ["end" ,"e"]  = AtEnd  mc-      | t `elem` ["now" ,"n"]  = AtNow  mc-      | otherwise =-          case parsedateM t of-            Just d  -> AtDate d mc-            Nothing -> usageError $ "could not parse \""++t++"\" as valuation type, should be: cost|then|end|now|c|t|e|n|YYYY-MM-DD"+    valueopt v+      | t `elem` ["cost","c"]  = (Cost,   AtEnd . Just <$> mc)  -- keep supporting --value=cost,COMM for now+      | t `elem` ["then" ,"t"] = (NoCost, Just $ AtThen mc)+      | t `elem` ["end" ,"e"]  = (NoCost, Just $ AtEnd  mc)+      | t `elem` ["now" ,"n"]  = (NoCost, Just $ AtNow  mc)+      | otherwise = case parsedateM t of+            Just d  -> (NoCost, Just $ AtDate d mc)+            Nothing -> usageError $ "could not parse \""++t++"\" as valuation type, should be: then|end|now|t|e|n|YYYY-MM-DD"       where         -- parse --value's value: TYPE[,COMM]         (t,c') = break (==',') v@@ -430,18 +470,6 @@                    "" -> Nothing                    c  -> Just $ T.pack c -valuationTypeIsCost :: ReportOpts -> Bool-valuationTypeIsCost ropts =-  case value_ ropts of-    Just (AtCost _) -> True-    _               -> False--valuationTypeIsDefaultValue :: ReportOpts -> Bool-valuationTypeIsDefaultValue ropts =-  case value_ ropts of-    Just (AtDefault _) -> True-    _                  -> False- -- | Select the Transaction date accessor based on --date2. transactionDateFn :: ReportOpts -> (Transaction -> Day) transactionDateFn ReportOpts{..} = if date2_ then transactionDate2 else tdate@@ -466,13 +494,12 @@ -- depthFromOpts opts = min (fromMaybe 99999 $ depth_ opts) (queryDepth $ queryFromOpts nulldate opts)  -- | Convert this journal's postings' amounts to cost using their--- transaction prices, if specified by options (-B/--value=cost).+-- transaction prices, if specified by options (-B/--cost). -- Maybe soon superseded by newer valuation code. journalSelectingAmountFromOpts :: ReportOpts -> Journal -> Journal-journalSelectingAmountFromOpts opts =-  case value_ opts of-    Just (AtCost _) -> journalToCost-    _               -> id+journalSelectingAmountFromOpts opts = case cost_ opts of+    Cost   -> journalToCost+    NoCost -> id  -- | Convert report options to a query, ignoring any non-flag command line arguments. queryFromFlags :: ReportOpts -> Query@@ -486,28 +513,47 @@     consIf f b = if b then (f True:) else id     consJust f = maybe id ((:) . f) --- | Whether the market price for postings might change when reported in--- different report periods.-changingValuation :: ReportOpts -> Bool-changingValuation ropts = case value_ ropts of-    Just (AtCost (Just _)) -> True-    Just (AtEnd  _)        -> True-    Just (AtDefault _)     -> interval_ ropts /= NoInterval-    _                      -> False- -- Report dates.  -- | The effective report span is the start and end dates specified by -- options or queries, or otherwise the earliest and latest transaction or -- posting dates in the journal. If no dates are specified by options/queries -- and the journal is empty, returns the null date span.+-- The boolean argument flags whether primary and secondary dates are considered+-- equivalently. reportSpan :: Journal -> ReportSpec -> DateSpan-reportSpan j ReportSpec{rsQuery=query} = dbg3 "reportspan" $ DateSpan mstartdate menddate+reportSpan = reportSpanHelper False++-- | Like reportSpan, but uses both primary and secondary dates when calculating+-- the span.+reportSpanBothDates :: Journal -> ReportSpec -> DateSpan+reportSpanBothDates = reportSpanHelper True++-- | A helper for reportSpan, which takes a Bool indicating whether to use both+-- primary and secondary dates.+reportSpanHelper :: Bool -> Journal -> ReportSpec -> DateSpan+reportSpanHelper bothdates j ReportSpec{rsQuery=query, rsOpts=ropts} = reportspan   where-    DateSpan mjournalstartdate mjournalenddate =-      dbg3 "journalspan" $ journalDateSpan False j  -- ignore secondary dates-    mstartdate = queryStartDate False query <|> mjournalstartdate-    menddate   = queryEndDate   False query <|> mjournalenddate+    -- The date span specified by -b/-e/-p options and query args if any.+    requestedspan  = dbg3 "requestedspan" $ if bothdates then queryDateSpan' query else queryDateSpan (date2_ ropts) query+    -- If we are requesting period-end valuation, the journal date span should+    -- include price directives after the last transaction+    journalspan = dbg3 "journalspan" $ if bothdates then journalDateSpanBothDates j else journalDateSpan (date2_ ropts) j+    pricespan = dbg3 "pricespan" . DateSpan Nothing $ case value_ ropts of+        Just (AtEnd _) -> fmap (addDays 1) . maximumMay . map pddate $ jpricedirectives j+        _              -> Nothing+    -- If the requested span is open-ended, close it using the journal's start and end dates.+    -- This can still be the null (open) span if the journal is empty.+    requestedspan' = dbg3 "requestedspan'" $ requestedspan `spanDefaultsFrom` (journalspan `spanUnion` pricespan)+    -- The list of interval spans enclosing the requested span.+    -- This list can be empty if the journal was empty,+    -- or if hledger-ui has added its special date:-tomorrow to the query+    -- and all txns are in the future.+    intervalspans  = dbg3 "intervalspans" $ splitSpan (interval_ ropts) requestedspan'+    -- The requested span enlarged to enclose a whole number of intervals.+    -- This can be the null span if there were no intervals.+    reportspan = dbg3 "reportspan" $ DateSpan (spanStart =<< headMay intervalspans)+                                              (spanEnd =<< lastMay intervalspans)  reportStartDate :: Journal -> ReportSpec -> Maybe Day reportStartDate j = spanStart . reportSpan j@@ -538,8 +584,13 @@  -- Get the last day of the overall report period, or if no report -- period is specified, the last day of the journal (ie the latest--- posting date). If there's no report period and nothing in the+-- posting date). If we're doing period-end valuation, include price+-- directive dates. If there's no report period and nothing in the -- journal, will be Nothing. reportPeriodOrJournalLastDay :: ReportSpec -> Journal -> Maybe Day-reportPeriodOrJournalLastDay rspec j =-  reportPeriodLastDay rspec <|> journalEndDate False j+reportPeriodOrJournalLastDay rspec j = reportPeriodLastDay rspec <|> journalOrPriceEnd+  where+    journalOrPriceEnd = case value_ $ rsOpts rspec of+        Just (AtEnd _) -> max (journalEndDate False j) lastPriceDirective+        _              -> journalEndDate False j+    lastPriceDirective = fmap (addDays 1) . maximumMay . map pddate $ jpricedirectives j

@@ -32,9 +32,10 @@ , prrDepth ) where -import Data.Aeson-import Data.Decimal+import Data.Aeson (ToJSON(..))+import Data.Decimal (Decimal) import Data.Maybe (mapMaybe)+import Data.Text (Text) #if !(MIN_VERSION_base(4,11,0)) import Data.Semigroup (Semigroup(..)) #endif@@ -144,16 +145,16 @@ -- It is used in compound balance report commands like balancesheet, -- cashflow and incomestatement. data CompoundPeriodicReport a b = CompoundPeriodicReport-  { cbrTitle      :: String+  { cbrTitle      :: Text   , cbrDates      :: [DateSpan]-  , cbrSubreports :: [(String, PeriodicReport a b, Bool)]+  , cbrSubreports :: [(Text, PeriodicReport a b, Bool)]   , cbrTotals     :: PeriodicReportRow () b   } deriving (Show, Functor, Generic, ToJSON)  -- | Description of one subreport within a compound balance report. -- Part of a "CompoundBalanceCommandSpec", but also used in hledger-lib. data CBCSubreportSpec a = CBCSubreportSpec-  { cbcsubreporttitle          :: String                    -- ^ The title to use for the subreport+  { cbcsubreporttitle          :: Text                      -- ^ The title to use for the subreport   , cbcsubreportquery          :: Journal -> Query          -- ^ The Query to use for the subreport   , cbcsubreportoptions        :: ReportOpts -> ReportOpts  -- ^ A function to transform the ReportOpts used to produce the subreport   , cbcsubreporttransform      :: PeriodicReport DisplayName MixedAmount -> PeriodicReport a MixedAmount  -- ^ A function to transform the result of the subreport

@@ -23,6 +23,7 @@  import Data.List import Data.List.Extra (nubSort)+import Data.Text (Text) import Data.Ord  import Hledger.Data@@ -34,18 +35,14 @@  -- | A transactions report includes a list of transactions touching multiple accounts -- (posting-filtered and unfiltered variants), a running balance, and some--- other information helpful for rendering a register view (a flag--- indicating multiple other accounts and a display string describing--- them) with or without a notion of current account(s).--- Two kinds of report use this data structure, see transactionsReport+-- other information helpful for rendering a register view with or without a notion+-- of current account(s). Two kinds of report use this data structure, see transactionsReport -- and accountTransactionsReport below for details.-type TransactionsReport = (String                   -- label for the balance column, eg "balance" or "total"-                          ,[TransactionsReportItem] -- line items, one per transaction-                          )+type TransactionsReport = [TransactionsReportItem] -- line items, one per transaction type TransactionsReportItem = (Transaction -- the original journal transaction, unmodified                               ,Transaction -- the transaction as seen from a particular account, with postings maybe filtered                               ,Bool        -- is this a split, ie more than one other account posting-                              ,String      -- a display string describing the other account(s), if any+                              ,Text        -- a display string describing the other account(s), if any                               ,MixedAmount -- the amount posted to the current account(s) by the filtered postings (or total amount posted)                               ,MixedAmount -- the running total of item amounts, starting from zero;                                            -- or with --historical, the running total including items@@ -59,14 +56,12 @@ triCommodityAmount c = filterMixedAmountByCommodity c  . triAmount triCommodityBalance c = filterMixedAmountByCommodity c  . triBalance -totallabel   = "Period Total"- -- | Select transactions from the whole journal. This is similar to a -- "postingsReport" except with transaction-based report items which -- are ordered most recent first. XXX Or an EntriesReport - use that instead ? -- This is used by hledger-web's journal view. transactionsReport :: ReportOpts -> Journal -> Query -> TransactionsReport-transactionsReport opts j q = (totallabel, items)+transactionsReport opts j q = items    where      -- XXX items' first element should be the full transaction with all postings      items = reverse $ accountTransactionsReportItems q None nullmixedamt id ts@@ -79,15 +74,14 @@ transactionsReportByCommodity tr =   [(c, filterTransactionsReportByCommodity c tr) | c <- transactionsReportCommodities tr]   where-    transactionsReportCommodities (_,items) =-      nubSort . map acommodity $ concatMap (amounts . triAmount) items+    transactionsReportCommodities = nubSort . map acommodity . concatMap (amounts . triAmount)  -- Remove transaction report items and item amount (and running -- balance amount) components that don't involve the specified -- commodity. Other item fields such as the transaction are left unchanged. filterTransactionsReportByCommodity :: CommoditySymbol -> TransactionsReport -> TransactionsReport-filterTransactionsReportByCommodity c (label,items) =-  (label, fixTransactionsReportItemBalances $ concat [filterTransactionsReportItemByCommodity c i | i <- items])+filterTransactionsReportByCommodity c =+    fixTransactionsReportItemBalances . concatMap (filterTransactionsReportItemByCommodity c)   where     filterTransactionsReportItemByCommodity c (t,t2,s,o,a,bal)       | c `elem` cs = [item']

@@ -1,17 +1,25 @@ -- | Basic color helpers for prettifying console output. +{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-}  module Hledger.Utils.Color (   color,   bgColor,+  colorB,+  bgColorB,   Color(..),   ColorIntensity(..) ) where +#if !(MIN_VERSION_base(4,11,0))+import Data.Semigroup ((<>))+#endif+import qualified Data.Text.Lazy.Builder as TB import System.Console.ANSI+import Hledger.Utils.Text (WideBuilder(..))   -- | Wrap a string in ANSI codes to set and reset foreground colour.@@ -21,3 +29,13 @@ -- | Wrap a string in ANSI codes to set and reset background colour. bgColor :: ColorIntensity -> Color -> String -> String bgColor int col s = setSGRCode [SetColor Background int col] ++ s ++ setSGRCode []++-- | Wrap a WideBuilder in ANSI codes to set and reset foreground colour.+colorB :: ColorIntensity -> Color -> WideBuilder -> WideBuilder+colorB int col (WideBuilder s w) =+    WideBuilder (TB.fromString (setSGRCode [SetColor Foreground int col]) <> s <> TB.fromString (setSGRCode [])) w++-- | Wrap a WideBuilder in ANSI codes to set and reset background colour.+bgColorB :: ColorIntensity -> Color -> WideBuilder -> WideBuilder+bgColorB int col (WideBuilder s w) =+    WideBuilder (TB.fromString (setSGRCode [SetColor Background int col]) <> s <> TB.fromString (setSGRCode [])) w

@@ -15,6 +15,21 @@ save a dummy change in Debug.hs and do a :reload. (Sometimes it's more convenient to temporarily add dbg0's and :reload.) +In hledger, debug levels are used as follows:++Debug level:  What to show:+------------  ---------------------------------------------------------+0             normal command output only (no warnings, eg)+1 (--debug)   useful warnings, most common troubleshooting info, eg valuation+2             common troubleshooting info, more detail+3             report options selection+4             report generation+5             report generation, more detail+6             input file reading+7             input file reading, more detail+8             command line parsing+9             any other rarely needed / more in-depth info+ -}  -- more:@@ -153,9 +168,11 @@     | level > 0 && debugLevel < level = flip const     | otherwise = trace --- | Trace (print to stderr) a showable value using a custom show function.-traceAtWith :: (a -> String) -> a -> a-traceAtWith f a = trace (f a) a+-- | Trace (print to stderr) a showable value using a custom show function,+-- if the global debug level is at or above the specified level.+-- At level 0, always prints. Otherwise, uses unsafePerformIO.+traceAtWith :: Int -> (a -> String) -> a -> a+traceAtWith level f a = traceAt level (f a) a  -- | Pretty-print a label and a showable value to the console -- if the global debug level is at or above the specified level.

@@ -1,5 +1,7 @@+{-# LANGUAGE CPP                   #-} {-# LANGUAGE FlexibleInstances     #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings     #-} {-# LANGUAGE ScopedTypeVariables   #-} {-# LANGUAGE TypeSynonymInstances  #-} {-|@@ -54,6 +56,7 @@   ,RegexError    -- * total regex operations   ,regexMatch+  ,regexMatchText   ,regexReplace   ,regexReplaceUnmemo   ,regexReplaceAllBy@@ -66,6 +69,10 @@ import Data.Char (isDigit) import Data.List (foldl') import Data.MemoUgly (memo)+#if !(MIN_VERSION_base(4,11,0))+import Data.Semigroup ((<>))+#endif+import Data.Text (Text) import qualified Data.Text as T import Text.Regex.TDFA (   Regex, CompOption(..), defaultCompOpt, defaultExecOpt,@@ -78,8 +85,8 @@  -- | Regular expression. Extended regular expression-ish syntax ? But does not support eg (?i) syntax. data Regexp-  = Regexp   { reString :: String, reCompiled :: Regex }-  | RegexpCI { reString :: String, reCompiled :: Regex }+  = Regexp   { reString :: Text, reCompiled :: Regex }+  | RegexpCI { reString :: Text, reCompiled :: Regex }  instance Eq Regexp where   Regexp   s1 _ == Regexp   s2 _ = s1 == s2@@ -93,7 +100,7 @@   RegexpCI _ _ `compare` Regexp _ _ = GT  instance Show Regexp where-  showsPrec d r = showParen (d > app_prec) $ reCons . showsPrec (app_prec+1) (reString r)+  showsPrec d r = showParen (d > app_prec) $ reCons . showsPrec (app_prec+1) (T.unpack $ reString r)     where app_prec = 10           reCons = case r of Regexp   _ _ -> showString "Regexp "                              RegexpCI _ _ -> showString "RegexpCI "@@ -108,8 +115,8 @@     where app_prec = 10  instance ToJSON Regexp where-  toJSON (Regexp   s _) = String . T.pack $ "Regexp "   ++ s-  toJSON (RegexpCI s _) = String . T.pack $ "RegexpCI " ++ s+  toJSON (Regexp   s _) = String $ "Regexp "   <> s+  toJSON (RegexpCI s _) = String $ "RegexpCI " <> s  instance RegexLike Regexp String where   matchOnce = matchOnce . reCompiled@@ -124,24 +131,24 @@   matchM = matchM . reCompiled  -- Convert a Regexp string to a compiled Regex, or return an error message.-toRegex :: String -> Either RegexError Regexp-toRegex = memo $ \s -> mkRegexErr s (Regexp s <$> makeRegexM s)+toRegex :: Text -> Either RegexError Regexp+toRegex = memo $ \s -> mkRegexErr s (Regexp s <$> makeRegexM (T.unpack s))  -- Have to unpack here because Text instance in regex-tdfa only appears in 1.3.1  -- Like toRegex, but make a case-insensitive Regex.-toRegexCI :: String -> Either RegexError Regexp-toRegexCI = memo $ \s -> mkRegexErr s (RegexpCI s <$> makeRegexOptsM defaultCompOpt{caseSensitive=False} defaultExecOpt s)+toRegexCI :: Text -> Either RegexError Regexp+toRegexCI = memo $ \s -> mkRegexErr s (RegexpCI s <$> makeRegexOptsM defaultCompOpt{caseSensitive=False} defaultExecOpt (T.unpack s))  -- Have to unpack here because Text instance in regex-tdfa only appears in 1.3.1  -- | Make a nice error message for a regexp error.-mkRegexErr :: String -> Maybe a -> Either RegexError a+mkRegexErr :: Text -> Maybe a -> Either RegexError a mkRegexErr s = maybe (Left errmsg) Right-  where errmsg = "this regular expression could not be compiled: " ++ s+  where errmsg = T.unpack $ "this regular expression could not be compiled: " <> s  -- Convert a Regexp string to a compiled Regex, throw an error-toRegex' :: String -> Regexp+toRegex' :: Text -> Regexp toRegex' = either error' id . toRegex  -- Like toRegex', but make a case-insensitive Regex.-toRegexCI' :: String -> Regexp+toRegexCI' :: Text -> Regexp toRegexCI' = either error' id . toRegexCI  -- | A replacement pattern. May include numeric backreferences (\N).@@ -158,6 +165,13 @@ -- naming. regexMatch :: Regexp -> String -> Bool regexMatch = matchTest++-- | Tests whether a Regexp matches a Text.+--+-- This currently unpacks the Text to a String an works on that. This is due to+-- a performance bug in regex-tdfa (#9), which may or may not be relevant here.+regexMatchText :: Regexp -> Text -> Bool+regexMatchText r = matchTest r . T.unpack  -------------------------------------------------------------------------------- -- new total functions

@@ -21,6 +21,7 @@  lstrip,  rstrip,  chomp,+ chomp1,  singleline,  elideLeft,  elideRight,@@ -52,6 +53,8 @@ import Data.Char (isSpace, toLower, toUpper) import Data.Default (def) import Data.List (intercalate)+import qualified Data.Text as T+import qualified Data.Text.Lazy as TL import Text.Megaparsec ((<|>), between, many, noneOf, sepBy) import Text.Megaparsec.Char (char) import Text.Printf (printf)@@ -59,8 +62,8 @@ import Hledger.Utils.Parse import Hledger.Utils.Regex (toRegex', regexReplace) import Text.Tabular (Header(..), Properties(..))-import Text.Tabular.AsciiWide (Align(..), Cell(..), TableOpts(..), renderRow)-import Text.WideString (strWidth, charWidth)+import Text.Tabular.AsciiWide (Align(..), TableOpts(..), textCell, renderRow)+import Text.WideString (charWidth, strWidth)   -- | Take elements from the end of a list.@@ -86,10 +89,14 @@ rstrip :: String -> String rstrip = reverse . lstrip . reverse --- | Remove trailing newlines/carriage returns.+-- | Remove all trailing newlines/carriage returns. chomp :: String -> String chomp = reverse . dropWhile (`elem` "\r\n") . reverse +-- | Remove all trailing newline/carriage returns, leaving just one trailing newline.+chomp1 :: String -> String+chomp1 = (++"\n") . chomp+ -- | Remove consecutive line breaks, replacing them with single space singleline :: String -> String singleline = unwords . filter (/="") . (map strip) . lines@@ -177,17 +184,14 @@ -- | Join several multi-line strings as side-by-side rectangular strings of the same height, top-padded. -- Treats wide characters as double width. concatTopPadded :: [String] -> String-concatTopPadded = renderRow def{tableBorders=False, borderSpaces=False}-                . Group NoLine . map (Header . cell)-  where cell = Cell BottomLeft . map (\x -> (x, strWidth x)) . lines+concatTopPadded = TL.unpack . renderRow def{tableBorders=False, borderSpaces=False}+                . Group NoLine . map (Header . textCell BottomLeft . T.pack)  -- | Join several multi-line strings as side-by-side rectangular strings of the same height, bottom-padded. -- Treats wide characters as double width. concatBottomPadded :: [String] -> String-concatBottomPadded = renderRow def{tableBorders=False, borderSpaces=False}-                   . Group NoLine . map (Header . cell)-  where cell = Cell TopLeft . map (\x -> (x, strWidth x)) . lines-+concatBottomPadded = TL.unpack . renderRow def{tableBorders=False, borderSpaces=False}+                   . Group NoLine . map (Header . textCell TopLeft . T.pack)  -- | Join multi-line strings horizontally, after compressing each of -- them to a single line with a comma and space between each original line.@@ -342,4 +346,4 @@ stripAnsi s = either err id $ regexReplace ansire "" s  where    err    = error "stripAnsi: invalid replacement pattern"      -- PARTIAL, shouldn't happen-   ansire = toRegex' "\ESC\\[([0-9]+;)*([0-9]+)?[ABCDHJKfmsu]"  -- PARTIAL, should succeed+   ansire = toRegex' $ T.pack "\ESC\\[([0-9]+;)*([0-9]+)?[ABCDHJKfmsu]"  -- PARTIAL, should succeed

@@ -12,6 +12,8 @@  -- underline,  -- stripbrackets,   textUnbracket,+  wrap,+  textChomp,  -- -- quoting   quoteIfSpaced,   textQuoteIfNeeded,@@ -29,10 +31,10 @@  -- -- * single-line layout  -- elideLeft,   textElideRight,- -- formatString,+  formatText,  -- -- * multi-line layout   textConcatTopPadded,- -- concatBottomPadded,+  textConcatBottomPadded,  -- concatOneLine,  -- vConcatLeftAligned,  -- vConcatRightAligned,@@ -43,7 +45,13 @@  -- cliptopleft,  -- fitto,   fitText,+  linesPrepend,+  linesPrepend2,+  unlinesB,  -- -- * wide-character-aware layout+  WideBuilder(..),+  wbToText,+  wbUnpack,   textWidth,   textTakeWidth,  -- fitString,@@ -58,20 +66,21 @@ where  import Data.Char (digitToInt)-import Data.List+import Data.Default (def) #if !(MIN_VERSION_base(4,11,0))-import Data.Monoid+import Data.Semigroup ((<>)) #endif import Data.Text (Text) import qualified Data.Text as T--- import Text.Parsec--- import Text.Printf (printf)+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Builder as TB --- import Hledger.Utils.Parse--- import Hledger.Utils.Regex-import Hledger.Utils.Test-import Text.WideString (charWidth, textWidth)+import Hledger.Utils.Test ((@?=), test, tests)+import Text.Tabular (Header(..), Properties(..))+import Text.Tabular.AsciiWide (Align(..), TableOpts(..), textCell, renderRow)+import Text.WideString (WideBuilder(..), wbToText, wbUnpack, charWidth, textWidth) + -- lowercase, uppercase :: String -> String -- lowercase = map toLower -- uppercase = map toUpper@@ -87,16 +96,24 @@ textElideRight width t =     if T.length t > width then T.take (width - 2) t <> ".." else t --- -- | Clip and pad a string to a minimum & maximum width, and/or left/right justify it.--- -- Works on multi-line strings too (but will rewrite non-unix line endings).--- formatString :: Bool -> Maybe Int -> Maybe Int -> String -> String--- formatString leftJustified minwidth maxwidth s = intercalate "\n" $ map (printf fmt) $ lines s---     where---       justify = if leftJustified then "-" else ""---       minwidth' = maybe "" show minwidth---       maxwidth' = maybe "" (("."++).show) maxwidth---       fmt = "%" ++ justify ++ minwidth' ++ maxwidth' ++ "s"+-- | Wrap a Text with the surrounding Text.+wrap :: Text -> Text -> Text -> Text+wrap start end x = start <> x <> end +-- | Remove trailing newlines/carriage returns.+textChomp :: Text -> Text+textChomp = T.dropWhileEnd (`elem` ['\r', '\n'])++-- | Clip and pad a string to a minimum & maximum width, and/or left/right justify it.+-- Works on multi-line strings too (but will rewrite non-unix line endings).+formatText :: Bool -> Maybe Int -> Maybe Int -> Text -> Text+formatText leftJustified minwidth maxwidth t =+    T.intercalate "\n" . map (pad . clip) $ if T.null t then [""] else T.lines t+  where+    pad  = maybe id justify minwidth+    clip = maybe id T.take maxwidth+    justify n = if leftJustified then T.justifyLeft n ' ' else T.justifyRight n ' '+ -- underline :: String -> String -- underline s = s' ++ replicate (length s) '-' ++ "\n" --     where s'@@ -108,7 +125,7 @@ -- double-quoted. quoteIfSpaced :: T.Text -> T.Text quoteIfSpaced s | isSingleQuoted s || isDoubleQuoted s = s-                | not $ any (`elem` (T.unpack s)) whitespacechars = s+                | not $ any (\c -> T.any (==c) s) whitespacechars = s                 | otherwise = textQuoteIfNeeded s  -- -- | Wrap a string in double quotes, and \-prefix any embedded single@@ -122,7 +139,7 @@ -- -- | Double-quote this string if it contains whitespace, single quotes -- -- or double-quotes, escaping the quotes as needed. textQuoteIfNeeded :: T.Text -> T.Text-textQuoteIfNeeded s | any (`elem` T.unpack s) (quotechars++whitespacechars) = "\"" <> escapeDoubleQuotes s <> "\""+textQuoteIfNeeded s | any (\c -> T.any (==c) s) (quotechars++whitespacechars) = "\"" <> escapeDoubleQuotes s <> "\""                     | otherwise = s  -- -- | Single-quote this string if it contains whitespace or double-quotes.@@ -181,28 +198,14 @@ -- | Join several multi-line strings as side-by-side rectangular strings of the same height, top-padded. -- Treats wide characters as double width. textConcatTopPadded :: [Text] -> Text-textConcatTopPadded ts = T.intercalate "\n" $ map T.concat $ transpose padded-    where-      lss = map T.lines ts :: [[Text]]-      h = maximum $ map length lss-      ypad ls = replicate (difforzero h (length ls)) "" ++ ls-      xpad ls = map (textPadLeftWide w) ls-        where w | null ls = 0-                | otherwise = maximum $ map textWidth ls-      padded = map (xpad . ypad) lss :: [[Text]]---- -- | Join several multi-line strings as side-by-side rectangular strings of the same height, bottom-padded.--- -- Treats wide characters as double width.--- concatBottomPadded :: [String] -> String--- concatBottomPadded strs = intercalate "\n" $ map concat $ transpose padded---     where---       lss = map lines strs---       h = maximum $ map length lss---       ypad ls = ls ++ replicate (difforzero h (length ls)) ""---       xpad ls = map (padRightWide w) ls where w | null ls = 0---                                                 | otherwise = maximum $ map strWidth ls---       padded = map (xpad . ypad) lss+textConcatTopPadded = TL.toStrict . renderRow def{tableBorders=False, borderSpaces=False}+                    . Group NoLine . map (Header . textCell BottomLeft) +-- | Join several multi-line strings as side-by-side rectangular strings of the same height, bottom-padded.+-- Treats wide characters as double width.+textConcatBottomPadded :: [Text] -> Text+textConcatBottomPadded = TL.toStrict . renderRow def{tableBorders=False, borderSpaces=False}+                       . Group NoLine . map (Header . textCell TopLeft)  -- -- | Join multi-line strings horizontally, after compressing each of -- -- them to a single line with a comma and space between each original line.@@ -245,9 +248,6 @@ --       ypadded = ls ++ replicate (difforzero h sh) "" --       xpadded = map (padleft sw) ypadded -difforzero :: (Num a, Ord a) => a -> a -> a-difforzero a b = maximum [(a - b), 0]- -- -- | Convert a multi-line string to a rectangular string left-padded to the specified width. -- -- Treats wide characters as double width. -- padleft :: Int -> String -> String@@ -344,11 +344,25 @@                 = T.cons c $ textTakeWidth (w-cw) (T.tail t)               | otherwise = "" +-- | Add a prefix to each line of a string.+linesPrepend :: Text -> Text -> Text+linesPrepend prefix = T.unlines . map (prefix<>) . T.lines +-- | Add a prefix to the first line of a string, +-- and a different prefix to the remaining lines.+linesPrepend2 :: Text -> Text -> Text -> Text+linesPrepend2 prefix1 prefix2 s = T.unlines $ case T.lines s of+    []   -> []+    l:ls -> (prefix1<>l) : map (prefix2<>) ls++-- | Join a list of Text Builders with a newline after each item.+unlinesB :: [TB.Builder] -> TB.Builder+unlinesB = foldMap (<> TB.singleton '\n')+ -- | Read a decimal number from a Text. Assumes the input consists only of digit -- characters. readDecimal :: Text -> Integer-readDecimal = foldl' step 0 . T.unpack+readDecimal = T.foldl' step 0   where step a c = a * 10 + toInteger (digitToInt c)  

@@ -1,14 +1,25 @@ -- | Text.Tabular.AsciiArt from tabular-0.2.2.7, modified to treat -- wide characters as double width. +{-# LANGUAGE CPP               #-}+{-# LANGUAGE OverloadedStrings #-}+ module Text.Tabular.AsciiWide where  import Data.Maybe (fromMaybe) import Data.Default (Default(..)) import Data.List (intersperse, transpose)+#if !(MIN_VERSION_base(4,11,0))+import Data.Semigroup ((<>))+#endif+import Data.Semigroup (stimesMonoid)+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.Lazy as TL+import Data.Text.Lazy.Builder (Builder, fromString, fromText, singleton, toLazyText) import Safe (maximumMay) import Text.Tabular-import Text.WideString (strWidth)+import Text.WideString (WideBuilder(..), textWidth)   -- | The options to use for rendering a table.@@ -25,8 +36,7 @@                   }  -- | Cell contents along an alignment-data Cell = Cell Align [(String, Int)]-    deriving (Show)+data Cell = Cell Align [WideBuilder]  -- | How to align text in a cell data Align = TopRight | BottomRight | BottomLeft | TopLeft@@ -36,31 +46,40 @@ emptyCell = Cell TopRight []  -- | Create a single-line cell from the given contents with its natural width.-alignCell :: Align -> String -> Cell-alignCell a x = Cell a [(x, strWidth x)]+textCell :: Align -> Text -> Cell+textCell a x = Cell a . map (\x -> WideBuilder (fromText x) (textWidth x)) $ if T.null x then [""] else T.lines x  -- | Return the width of a Cell. cellWidth :: Cell -> Int-cellWidth (Cell _ xs) = fromMaybe 0 . maximumMay $ map snd xs+cellWidth (Cell _ xs) = fromMaybe 0 . maximumMay $ map wbWidth xs   -- | Render a table according to common options, for backwards compatibility-render :: Bool -> (rh -> String) -> (ch -> String) -> (a -> String) -> Table rh ch a -> String+render :: Bool -> (rh -> Text) -> (ch -> Text) -> (a -> Text) -> Table rh ch a -> TL.Text render pretty fr fc f = renderTable def{prettyTable=pretty} (cell . fr) (cell . fc) (cell . f)-  where cell = alignCell TopRight+  where cell = textCell TopRight --- | Render a table according to various cell specifications-renderTable :: TableOpts         -- ^ Options controlling Table rendering+-- | Render a table according to various cell specifications>+renderTable :: TableOpts       -- ^ Options controlling Table rendering             -> (rh -> Cell)  -- ^ Rendering function for row headers             -> (ch -> Cell)  -- ^ Rendering function for column headers             -> (a -> Cell)   -- ^ Function determining the string and width of a cell             -> Table rh ch a-            -> String-renderTable topts@TableOpts{prettyTable=pretty, tableBorders=borders} fr fc f (Table rh ch cells) =-  unlines . addBorders $-    renderColumns topts sizes ch2-    : bar VM DoubleLine   -- +======================================+-    : renderRs (fmap renderR $ zipHeader [] cellContents rowHeaders)+            -> TL.Text+renderTable topts fr fc f = toLazyText . renderTableB topts fr fc f++-- | A version of renderTable which returns the underlying Builder.+renderTableB :: TableOpts       -- ^ Options controlling Table rendering+             -> (rh -> Cell)  -- ^ Rendering function for row headers+             -> (ch -> Cell)  -- ^ Rendering function for column headers+             -> (a -> Cell)   -- ^ Function determining the string and width of a cell+             -> Table rh ch a+             -> Builder+renderTableB topts@TableOpts{prettyTable=pretty, tableBorders=borders} fr fc f (Table rh ch cells) =+   unlinesB . addBorders $+     renderColumns topts sizes ch2+     : bar VM DoubleLine   -- +======================================++     : renderRs (fmap renderR $ zipHeader [] cellContents rowHeaders)  where   renderR (cs,h) = renderColumns topts sizes $ Group DoubleLine                      [ Header h@@ -83,63 +102,68 @@    -- borders and bars   addBorders xs = if borders then bar VT SingleLine : xs ++ [bar VB SingleLine] else xs-  bar vpos prop = concat $ renderHLine vpos borders pretty sizes ch2 prop+  bar vpos prop = mconcat $ renderHLine vpos borders pretty sizes ch2 prop+  unlinesB = foldMap (<> singleton '\n')  -- | Render a single row according to cell specifications.-renderRow :: TableOpts -> Header Cell -> String-renderRow topts h = renderColumns topts is h-  where is = map (\(Cell _ xs) -> fromMaybe 0 . maximumMay $ map snd xs) $ headerContents h+renderRow :: TableOpts -> Header Cell -> TL.Text+renderRow topts = toLazyText . renderRowB topts +-- | A version of renderRow which returns the underlying Builder.+renderRowB:: TableOpts -> Header Cell -> Builder+renderRowB topts h = renderColumns topts is h+  where is = map cellWidth $ headerContents h + verticalBar :: Bool -> Char verticalBar pretty = if pretty then '│' else '|' -leftBar :: Bool -> Bool -> String-leftBar pretty True  = verticalBar pretty : " "-leftBar pretty False = [verticalBar pretty]+leftBar :: Bool -> Bool -> Builder+leftBar pretty True  = fromString $ verticalBar pretty : " "+leftBar pretty False = singleton $ verticalBar pretty -rightBar :: Bool -> Bool -> String-rightBar pretty True  = ' ' : [verticalBar pretty]-rightBar pretty False = [verticalBar pretty]+rightBar :: Bool -> Bool -> Builder+rightBar pretty True  = fromString $ ' ' : [verticalBar pretty]+rightBar pretty False = singleton $ verticalBar pretty -midBar :: Bool -> Bool -> String-midBar pretty True  = ' ' : verticalBar pretty : " "-midBar pretty False = [verticalBar pretty]+midBar :: Bool -> Bool -> Builder+midBar pretty True  = fromString $ ' ' : verticalBar pretty : " "+midBar pretty False = singleton $ verticalBar pretty -doubleMidBar :: Bool -> Bool -> String-doubleMidBar pretty True  = if pretty then " ║ " else " || "-doubleMidBar pretty False = if pretty then "║" else "||"+doubleMidBar :: Bool -> Bool -> Builder+doubleMidBar pretty True  = fromText $ if pretty then " ║ " else " || "+doubleMidBar pretty False = fromText $ if pretty then "║" else "||"  -- | We stop rendering on the shortest list! renderColumns :: TableOpts  -- ^ rendering options for the table               -> [Int]      -- ^ max width for each column               -> Header Cell-              -> String+              -> Builder renderColumns TableOpts{prettyTable=pretty, tableBorders=borders, borderSpaces=spaces} is h =-    concat . intersperse "\n"                    -- Put each line on its own line-    . map (addBorders . concat) . transpose      -- Change to a list of lines and add borders+    mconcat . intersperse "\n"                   -- Put each line on its own line+    . map (addBorders . mconcat) . transpose     -- Change to a list of lines and add borders     . map (either hsep padCell) . flattenHeader  -- We now have a matrix of strings     . zipHeader 0 is $ padRow <$> h  -- Pad cell height and add width marker   where     -- Pad each cell to have the appropriate width-    padCell (w, Cell TopLeft     ls) = map (\(x,xw) -> x ++ replicate (w - xw) ' ') ls-    padCell (w, Cell BottomLeft  ls) = map (\(x,xw) -> x ++ replicate (w - xw) ' ') ls-    padCell (w, Cell TopRight    ls) = map (\(x,xw) -> replicate (w - xw) ' ' ++ x) ls-    padCell (w, Cell BottomRight ls) = map (\(x,xw) -> replicate (w - xw) ' ' ++ x) ls+    padCell (w, Cell TopLeft     ls) = map (\x -> wbBuilder x <> fromText (T.replicate (w - wbWidth x) " ")) ls+    padCell (w, Cell BottomLeft  ls) = map (\x -> wbBuilder x <> fromText (T.replicate (w - wbWidth x) " ")) ls+    padCell (w, Cell TopRight    ls) = map (\x -> fromText (T.replicate (w - wbWidth x) " ") <> wbBuilder x) ls+    padCell (w, Cell BottomRight ls) = map (\x -> fromText (T.replicate (w - wbWidth x) " ") <> wbBuilder x) ls      -- Pad each cell to have the same number of lines-    padRow (Cell TopLeft     ls) = Cell TopLeft     $ ls ++ replicate (nLines - length ls) ("",0)-    padRow (Cell TopRight    ls) = Cell TopRight    $ ls ++ replicate (nLines - length ls) ("",0)-    padRow (Cell BottomLeft  ls) = Cell BottomLeft  $ replicate (nLines - length ls) ("",0) ++ ls-    padRow (Cell BottomRight ls) = Cell BottomRight $ replicate (nLines - length ls) ("",0) ++ ls+    padRow (Cell TopLeft     ls) = Cell TopLeft     $ ls ++ replicate (nLines - length ls) mempty+    padRow (Cell TopRight    ls) = Cell TopRight    $ ls ++ replicate (nLines - length ls) mempty+    padRow (Cell BottomLeft  ls) = Cell BottomLeft  $ replicate (nLines - length ls) mempty ++ ls+    padRow (Cell BottomRight ls) = Cell BottomRight $ replicate (nLines - length ls) mempty ++ ls -    hsep :: Properties -> [String]+    hsep :: Properties -> [Builder]     hsep NoLine     = replicate nLines $ if spaces then "  " else ""     hsep SingleLine = replicate nLines $ midBar pretty spaces     hsep DoubleLine = replicate nLines $ doubleMidBar pretty spaces -    addBorders xs | borders   = leftBar pretty spaces ++ xs ++ rightBar pretty spaces-                  | spaces    =  ' ' : xs ++ " "+    addBorders xs | borders   = leftBar pretty spaces <> xs <> rightBar pretty spaces+                  | spaces    = fromText " " <> xs <> fromText " "                   | otherwise = xs      nLines = fromMaybe 0 . maximumMay . map (\(Cell _ ls) -> length ls) $ headerContents h@@ -150,52 +174,48 @@             -> [Int] -- ^ width specifications             -> Header a             -> Properties-            -> [String]+            -> [Builder] renderHLine _ _ _ _ _ NoLine = [] renderHLine vpos borders pretty w h prop = [renderHLine' vpos borders pretty prop w h] -renderHLine' :: VPos -> Bool -> Bool -> Properties -> [Int] -> Header a -> String-renderHLine' vpos borders pretty prop is h = addBorders $ sep ++ coreLine ++ sep+renderHLine' :: VPos -> Bool -> Bool -> Properties -> [Int] -> Header a -> Builder+renderHLine' vpos borders pretty prop is h = addBorders $ sep <> coreLine <> sep  where-  addBorders xs   = if borders then edge HL ++ xs ++ edge HR else xs+  addBorders xs   = if borders then edge HL <> xs <> edge HR else xs   edge hpos       = boxchar vpos hpos SingleLine prop pretty-  coreLine        = concatMap helper $ flattenHeader $ zipHeader 0 is h+  coreLine        = foldMap helper $ flattenHeader $ zipHeader 0 is h   helper          = either vsep dashes-  dashes (i,_)    = concat (replicate i sep)+  dashes (i,_)    = stimesMonoid i sep   sep             = boxchar vpos HM NoLine prop pretty   vsep v          = case v of-                      NoLine -> sep ++ sep-                      _      -> sep ++ cross v prop ++ sep+                      NoLine -> sep <> sep+                      _      -> sep <> cross v prop <> sep   cross v h       = boxchar vpos HM v h pretty  data VPos = VT | VM | VB -- top middle bottom data HPos = HL | HM | HR -- left middle right -boxchar :: VPos -> HPos -> Properties -> Properties -> Bool -> String+boxchar :: VPos -> HPos -> Properties -> Properties -> Bool -> Builder boxchar vpos hpos vert horiz = lineart u d l r   where-    u =-      case vpos of-        VT -> NoLine-        _  -> vert-    d =-      case vpos of-        VB -> NoLine-        _  -> vert-    l =-      case hpos of-        HL -> NoLine-        _  -> horiz-    r =-      case hpos of-        HR -> NoLine-        _  -> horiz+    u = case vpos of+          VT -> NoLine+          _  -> vert+    d = case vpos of+          VB -> NoLine+          _  -> vert+    l = case hpos of+          HL -> NoLine+          _  -> horiz+    r = case hpos of+          HR -> NoLine+          _  -> horiz -pick :: String -> String -> Bool -> String-pick x _ True  = x-pick _ x False = x+pick :: Text -> Text -> Bool -> Builder+pick x _ True  = fromText x+pick _ x False = fromText x -lineart :: Properties -> Properties -> Properties -> Properties -> Bool -> String+lineart :: Properties -> Properties -> Properties -> Properties -> Bool -> Builder --      up         down       left      right lineart SingleLine SingleLine SingleLine SingleLine = pick "┼" "+" lineart SingleLine SingleLine SingleLine NoLine     = pick "┤" "+"@@ -244,6 +264,4 @@ lineart SingleLine SingleLine DoubleLine DoubleLine = pick "╪" "+" lineart DoubleLine DoubleLine SingleLine SingleLine = pick "╫" "++" -lineart _          _          _          _          = const ""---- +lineart _          _          _          _          = const mempty

@@ -1,14 +1,49 @@ -- | Calculate the width of String and Text, being aware of wide characters. +{-# LANGUAGE CPP #-}+ module Text.WideString (   -- * wide-character-aware layout   strWidth,   textWidth,-  charWidth+  charWidth,+  -- * Text Builders which keep track of length+  WideBuilder(..),+  wbUnpack,+  wbToText   ) where +#if !(MIN_VERSION_base(4,11,0))+import Data.Semigroup (Semigroup(..))+#endif import Data.Text (Text) import qualified Data.Text as T+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Builder as TB+++-- | Helper for constructing Builders while keeping track of text width.+data WideBuilder = WideBuilder+  { wbBuilder :: !TB.Builder+  , wbWidth   :: !Int+  }++instance Semigroup WideBuilder where+  WideBuilder x i <> WideBuilder y j = WideBuilder (x <> y) (i + j)++instance Monoid WideBuilder where+  mempty = WideBuilder mempty 0+#if !(MIN_VERSION_base(4,11,0))+  mappend = (<>)+#endif++-- | Convert a WideBuilder to a strict Text.+wbToText :: WideBuilder -> Text+wbToText = TL.toStrict . TB.toLazyText . wbBuilder++-- | Convert a WideBuilder to a String.+wbUnpack :: WideBuilder -> String+wbUnpack = TL.unpack . TB.toLazyText . wbBuilder   -- | Calculate the render width of a string, considering

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 3f8656e682d0ff102bad0022b06b881b2de2ca72cf342fd31090a33f7d87b692+-- hash: 2724f18a071add9d644b3060aba58a3f4f6c71b66d88af1e8ca3f526043d461f  name:           hledger-lib-version:        1.20.4+version:        1.21 synopsis:       A reusable library providing the core functionality of hledger description:    A reusable library containing hledger's core functionality.                 This is used by most hledger* packages so that they support the same@@ -34,18 +34,6 @@     README.md     test/unittest.hs     test/doctests.hs-    hledger_csv.5-    hledger_csv.txt-    hledger_csv.info-    hledger_journal.5-    hledger_journal.txt-    hledger_journal.info-    hledger_timedot.5-    hledger_timedot.txt-    hledger_timedot.info-    hledger_timeclock.5-    hledger_timeclock.txt-    hledger_timeclock.info  source-repository head   type: git@@ -137,7 +125,6 @@     , pretty-simple >4 && <5     , regex-tdfa     , safe >=0.2-    , split >=0.1     , tabular >=0.2     , tasty >=1.2.3     , tasty-hunit >=0.10.0.2@@ -188,7 +175,6 @@     , pretty-simple >4 && <5     , regex-tdfa     , safe >=0.2-    , split >=0.1     , tabular >=0.2     , tasty >=1.2.3     , tasty-hunit >=0.10.0.2@@ -241,7 +227,6 @@     , pretty-simple >4 && <5     , regex-tdfa     , safe >=0.2-    , split >=0.1     , tabular >=0.2     , tasty >=1.2.3     , tasty-hunit >=0.10.0.2

@@ -1,1300 +0,0 @@-.\"t--.TH "HLEDGER_CSV" "5" "December 2020" "hledger-lib-1.20.4 " "hledger User Manuals"----.SH NAME-.PP-How hledger reads CSV data, and the CSV rules file format.-.SH DESCRIPTION-.PP-hledger can read CSV files (Character Separated Value - usually comma,-semicolon, or tab) containing dated records as if they were journal-files, automatically converting each CSV record into a transaction.-.PP-(To learn about \f[I]writing\f[R] CSV, see CSV output.)-.PP-We describe each CSV file\[aq]s format with a corresponding \f[I]rules-file\f[R].-By default this is named like the CSV file with a \f[C].rules\f[R]-extension added.-Eg when reading \f[C]FILE.csv\f[R], hledger also looks for-\f[C]FILE.csv.rules\f[R] in the same directory as \f[C]FILE.csv\f[R].-You can specify a different rules file with the \f[C]--rules-file\f[R]-option.-If a rules file is not found, hledger will create a sample rules file,-which you\[aq]ll need to adjust.-.PP-This file contains rules describing the CSV data (header line, fields-layout, date format etc.), and how to construct hledger journal entries-(transactions) from it.-Often there will also be a list of conditional rules for categorising-transactions based on their descriptions.-Here\[aq]s an overview of the CSV rules; these are described more fully-below, after the examples:-.PP-.TS-tab(@);-lw(30.1n) lw(39.9n).-T{-\f[B]\f[CB]skip\f[B]\f[R]-T}@T{-skip one or more header lines or matched CSV records-T}-T{-\f[B]\f[CB]fields\f[B]\f[R]-T}@T{-name CSV fields, assign them to hledger fields-T}-T{-\f[B]field assignment\f[R]-T}@T{-assign a value to one hledger field, with interpolation-T}-T{-\f[B]\f[CB]separator\f[B]\f[R]-T}@T{-a custom field separator-T}-T{-\f[B]\f[CB]if\f[B] block\f[R]-T}@T{-apply some rules to CSV records matched by patterns-T}-T{-\f[B]\f[CB]if\f[B] table\f[R]-T}@T{-apply some rules to CSV records matched by patterns, alternate syntax-T}-T{-\f[B]\f[CB]end\f[B]\f[R]-T}@T{-skip the remaining CSV records-T}-T{-\f[B]\f[CB]date-format\f[B]\f[R]-T}@T{-how to parse dates in CSV records-T}-T{-\f[B]\f[CB]decimal-mark\f[B]\f[R]-T}@T{-the decimal mark used in CSV amounts, if ambiguous-T}-T{-\f[B]\f[CB]newest-first\f[B]\f[R]-T}@T{-disambiguate record order when there\[aq]s only one date-T}-T{-\f[B]\f[CB]include\f[B]\f[R]-T}@T{-inline another CSV rules file-T}-T{-\f[B]\f[CB]balance-type\f[B]\f[R]-T}@T{-choose which type of balance assignments to use-T}-.TE-.PP-Note, for best error messages when reading CSV files, use a-\f[C].csv\f[R], \f[C].tsv\f[R] or \f[C].ssv\f[R] file extension or file-prefix - see File Extension below.-.PP-There\[aq]s an introductory Convert CSV files tutorial on hledger.org.-.SH EXAMPLES-.PP-Here are some sample hledger CSV rules files.-See also the full collection at:-.PD 0-.P-.PD-https://github.com/simonmichael/hledger/tree/master/examples/csv-.SS Basic-.PP-At minimum, the rules file must identify the date and amount fields, and-often it also specifies the date format and how many header lines there-are.-Here\[aq]s a simple CSV file and a rules file for it:-.IP-.nf-\f[C]-Date, Description, Id, Amount-12/11/2019, Foo, 123, 10.23-\f[R]-.fi-.IP-.nf-\f[C]-# basic.csv.rules-skip         1-fields       date, description, _, amount-date-format  %d/%m/%Y-\f[R]-.fi-.IP-.nf-\f[C]-$ hledger print -f basic.csv-2019-11-12 Foo-    expenses:unknown           10.23-    income:unknown            -10.23-\f[R]-.fi-.PP-Default account names are chosen, since we didn\[aq]t set them.-.SS Bank of Ireland-.PP-Here\[aq]s a CSV with two amount fields (Debit and Credit), and a-balance field, which we can use to add balance assertions, which is not-necessary but provides extra error checking:-.IP-.nf-\f[C]-Date,Details,Debit,Credit,Balance-07/12/2012,LODGMENT       529898,,10.0,131.21-07/12/2012,PAYMENT,5,,126-\f[R]-.fi-.IP-.nf-\f[C]-# bankofireland-checking.csv.rules--# skip the header line-skip--# name the csv fields, and assign some of them as journal entry fields-fields  date, description, amount-out, amount-in, balance--# We generate balance assertions by assigning to \[dq]balance\[dq]-# above, but you may sometimes need to remove these because:-#-# - the CSV balance differs from the true balance,-#   by up to 0.0000000000005 in my experience-#-# - it is sometimes calculated based on non-chronological ordering,-#   eg when multiple transactions clear on the same day--# date is in UK/Ireland format-date-format  %d/%m/%Y--# set the currency-currency  EUR--# set the base account for all txns-account1  assets:bank:boi:checking-\f[R]-.fi-.IP-.nf-\f[C]-$ hledger -f bankofireland-checking.csv print-2012-12-07 LODGMENT       529898-    assets:bank:boi:checking         EUR10.0 = EUR131.2-    income:unknown                  EUR-10.0--2012-12-07 PAYMENT-    assets:bank:boi:checking         EUR-5.0 = EUR126.0-    expenses:unknown                  EUR5.0-\f[R]-.fi-.PP-The balance assertions don\[aq]t raise an error above, because we\[aq]re-reading directly from CSV, but they will be checked if these entries are-imported into a journal file.-.SS Amazon-.PP-Here we convert amazon.com order history, and use an if block to-generate a third posting if there\[aq]s a fee.-(In practice you\[aq]d probably get this data from your bank instead,-but it\[aq]s an example.)-.IP-.nf-\f[C]-\[dq]Date\[dq],\[dq]Type\[dq],\[dq]To/From\[dq],\[dq]Name\[dq],\[dq]Status\[dq],\[dq]Amount\[dq],\[dq]Fees\[dq],\[dq]Transaction ID\[dq]-\[dq]Jul 29, 2012\[dq],\[dq]Payment\[dq],\[dq]To\[dq],\[dq]Foo.\[dq],\[dq]Completed\[dq],\[dq]$20.00\[dq],\[dq]$0.00\[dq],\[dq]16000000000000DGLNJPI1P9B8DKPVHL\[dq]-\[dq]Jul 30, 2012\[dq],\[dq]Payment\[dq],\[dq]To\[dq],\[dq]Adapteva, Inc.\[dq],\[dq]Completed\[dq],\[dq]$25.00\[dq],\[dq]$1.00\[dq],\[dq]17LA58JSKRD4HDGLNJPI1P9B8DKPVHL\[dq]-\f[R]-.fi-.IP-.nf-\f[C]-# amazon-orders.csv.rules--# skip one header line-skip 1--# name the csv fields, and assign the transaction\[aq]s date, amount and code.-# Avoided the \[dq]status\[dq] and \[dq]amount\[dq] hledger field names to prevent confusion.-fields date, _, toorfrom, name, amzstatus, amzamount, fees, code--# how to parse the date-date-format %b %-d, %Y--# combine two fields to make the description-description %toorfrom %name--# save the status as a tag-comment     status:%amzstatus--# set the base account for all transactions-account1    assets:amazon-# leave amount1 blank so it can balance the other(s).-# I\[aq]m assuming amzamount excludes the fees, don\[aq]t remember--# set a generic account2-account2    expenses:misc-amount2     %amzamount-# and maybe refine it further:-#include categorisation.rules--# add a third posting for fees, but only if they are non-zero.-if %fees [1-9]- account3    expenses:fees- amount3     %fees-\f[R]-.fi-.IP-.nf-\f[C]-$ hledger -f amazon-orders.csv print-2012-07-29 (16000000000000DGLNJPI1P9B8DKPVHL) To Foo.  ; status:Completed-    assets:amazon-    expenses:misc          $20.00--2012-07-30 (17LA58JSKRD4HDGLNJPI1P9B8DKPVHL) To Adapteva, Inc.  ; status:Completed-    assets:amazon-    expenses:misc          $25.00-    expenses:fees           $1.00-\f[R]-.fi-.SS Paypal-.PP-Here\[aq]s a real-world rules file for (customised) Paypal CSV, with-some Paypal-specific rules, and a second rules file included:-.IP-.nf-\f[C]-\[dq]Date\[dq],\[dq]Time\[dq],\[dq]TimeZone\[dq],\[dq]Name\[dq],\[dq]Type\[dq],\[dq]Status\[dq],\[dq]Currency\[dq],\[dq]Gross\[dq],\[dq]Fee\[dq],\[dq]Net\[dq],\[dq]From Email Address\[dq],\[dq]To Email Address\[dq],\[dq]Transaction ID\[dq],\[dq]Item Title\[dq],\[dq]Item ID\[dq],\[dq]Reference Txn ID\[dq],\[dq]Receipt ID\[dq],\[dq]Balance\[dq],\[dq]Note\[dq]-\[dq]10/01/2019\[dq],\[dq]03:46:20\[dq],\[dq]PDT\[dq],\[dq]Calm Radio\[dq],\[dq]Subscription Payment\[dq],\[dq]Completed\[dq],\[dq]USD\[dq],\[dq]-6.99\[dq],\[dq]0.00\[dq],\[dq]-6.99\[dq],\[dq]simon\[at]joyful.com\[dq],\[dq]memberships\[at]calmradio.com\[dq],\[dq]60P57143A8206782E\[dq],\[dq]MONTHLY - $1 for the first 2 Months: Me - Order 99309. Item total: $1.00 USD first 2 months, then $6.99 / Month\[dq],\[dq]\[dq],\[dq]I-R8YLY094FJYR\[dq],\[dq]\[dq],\[dq]-6.99\[dq],\[dq]\[dq]-\[dq]10/01/2019\[dq],\[dq]03:46:20\[dq],\[dq]PDT\[dq],\[dq]\[dq],\[dq]Bank Deposit to PP Account \[dq],\[dq]Pending\[dq],\[dq]USD\[dq],\[dq]6.99\[dq],\[dq]0.00\[dq],\[dq]6.99\[dq],\[dq]\[dq],\[dq]simon\[at]joyful.com\[dq],\[dq]0TU1544T080463733\[dq],\[dq]\[dq],\[dq]\[dq],\[dq]60P57143A8206782E\[dq],\[dq]\[dq],\[dq]0.00\[dq],\[dq]\[dq]-\[dq]10/01/2019\[dq],\[dq]08:57:01\[dq],\[dq]PDT\[dq],\[dq]Patreon\[dq],\[dq]PreApproved Payment Bill User Payment\[dq],\[dq]Completed\[dq],\[dq]USD\[dq],\[dq]-7.00\[dq],\[dq]0.00\[dq],\[dq]-7.00\[dq],\[dq]simon\[at]joyful.com\[dq],\[dq]support\[at]patreon.com\[dq],\[dq]2722394R5F586712G\[dq],\[dq]Patreon* Membership\[dq],\[dq]\[dq],\[dq]B-0PG93074E7M86381M\[dq],\[dq]\[dq],\[dq]-7.00\[dq],\[dq]\[dq]-\[dq]10/01/2019\[dq],\[dq]08:57:01\[dq],\[dq]PDT\[dq],\[dq]\[dq],\[dq]Bank Deposit to PP Account \[dq],\[dq]Pending\[dq],\[dq]USD\[dq],\[dq]7.00\[dq],\[dq]0.00\[dq],\[dq]7.00\[dq],\[dq]\[dq],\[dq]simon\[at]joyful.com\[dq],\[dq]71854087RG994194F\[dq],\[dq]Patreon* Membership\[dq],\[dq]\[dq],\[dq]2722394R5F586712G\[dq],\[dq]\[dq],\[dq]0.00\[dq],\[dq]\[dq]-\[dq]10/19/2019\[dq],\[dq]03:02:12\[dq],\[dq]PDT\[dq],\[dq]Wikimedia Foundation, Inc.\[dq],\[dq]Subscription Payment\[dq],\[dq]Completed\[dq],\[dq]USD\[dq],\[dq]-2.00\[dq],\[dq]0.00\[dq],\[dq]-2.00\[dq],\[dq]simon\[at]joyful.com\[dq],\[dq]tle\[at]wikimedia.org\[dq],\[dq]K9U43044RY432050M\[dq],\[dq]Monthly donation to the Wikimedia Foundation\[dq],\[dq]\[dq],\[dq]I-R5C3YUS3285L\[dq],\[dq]\[dq],\[dq]-2.00\[dq],\[dq]\[dq]-\[dq]10/19/2019\[dq],\[dq]03:02:12\[dq],\[dq]PDT\[dq],\[dq]\[dq],\[dq]Bank Deposit to PP Account \[dq],\[dq]Pending\[dq],\[dq]USD\[dq],\[dq]2.00\[dq],\[dq]0.00\[dq],\[dq]2.00\[dq],\[dq]\[dq],\[dq]simon\[at]joyful.com\[dq],\[dq]3XJ107139A851061F\[dq],\[dq]\[dq],\[dq]\[dq],\[dq]K9U43044RY432050M\[dq],\[dq]\[dq],\[dq]0.00\[dq],\[dq]\[dq]-\[dq]10/22/2019\[dq],\[dq]05:07:06\[dq],\[dq]PDT\[dq],\[dq]Noble Benefactor\[dq],\[dq]Subscription Payment\[dq],\[dq]Completed\[dq],\[dq]USD\[dq],\[dq]10.00\[dq],\[dq]-0.59\[dq],\[dq]9.41\[dq],\[dq]noble\[at]bene.fac.tor\[dq],\[dq]simon\[at]joyful.com\[dq],\[dq]6L8L1662YP1334033\[dq],\[dq]Joyful Systems\[dq],\[dq]\[dq],\[dq]I-KC9VBGY2GWDB\[dq],\[dq]\[dq],\[dq]9.41\[dq],\[dq]\[dq]-\f[R]-.fi-.IP-.nf-\f[C]-# paypal-custom.csv.rules--# Tips:-# Export from Activity -> Statements -> Custom -> Activity download-# Suggested transaction type: \[dq]Balance affecting\[dq]-# Paypal\[aq]s default fields in 2018 were:-# \[dq]Date\[dq],\[dq]Time\[dq],\[dq]TimeZone\[dq],\[dq]Name\[dq],\[dq]Type\[dq],\[dq]Status\[dq],\[dq]Currency\[dq],\[dq]Gross\[dq],\[dq]Fee\[dq],\[dq]Net\[dq],\[dq]From Email Address\[dq],\[dq]To Email Address\[dq],\[dq]Transaction ID\[dq],\[dq]Shipping Address\[dq],\[dq]Address Status\[dq],\[dq]Item Title\[dq],\[dq]Item ID\[dq],\[dq]Shipping and Handling Amount\[dq],\[dq]Insurance Amount\[dq],\[dq]Sales Tax\[dq],\[dq]Option 1 Name\[dq],\[dq]Option 1 Value\[dq],\[dq]Option 2 Name\[dq],\[dq]Option 2 Value\[dq],\[dq]Reference Txn ID\[dq],\[dq]Invoice Number\[dq],\[dq]Custom Number\[dq],\[dq]Quantity\[dq],\[dq]Receipt ID\[dq],\[dq]Balance\[dq],\[dq]Address Line 1\[dq],\[dq]Address Line 2/District/Neighborhood\[dq],\[dq]Town/City\[dq],\[dq]State/Province/Region/County/Territory/Prefecture/Republic\[dq],\[dq]Zip/Postal Code\[dq],\[dq]Country\[dq],\[dq]Contact Phone Number\[dq],\[dq]Subject\[dq],\[dq]Note\[dq],\[dq]Country Code\[dq],\[dq]Balance Impact\[dq]-# This rules file assumes the following more detailed fields, configured in \[dq]Customize report fields\[dq]:-# \[dq]Date\[dq],\[dq]Time\[dq],\[dq]TimeZone\[dq],\[dq]Name\[dq],\[dq]Type\[dq],\[dq]Status\[dq],\[dq]Currency\[dq],\[dq]Gross\[dq],\[dq]Fee\[dq],\[dq]Net\[dq],\[dq]From Email Address\[dq],\[dq]To Email Address\[dq],\[dq]Transaction ID\[dq],\[dq]Item Title\[dq],\[dq]Item ID\[dq],\[dq]Reference Txn ID\[dq],\[dq]Receipt ID\[dq],\[dq]Balance\[dq],\[dq]Note\[dq]--fields date, time, timezone, description_, type, status_, currency, grossamount, feeamount, netamount, fromemail, toemail, code, itemtitle, itemid, referencetxnid, receiptid, balance, note--skip  1--date-format  %-m/%-d/%Y--# ignore some paypal events-if-In Progress-Temporary Hold-Update to- skip--# add more fields to the description-description %description_ %itemtitle--# save some other fields as tags-comment  itemid:%itemid, fromemail:%fromemail, toemail:%toemail, time:%time, type:%type, status:%status_--# convert to short currency symbols-if %currency USD- currency $-if %currency EUR- currency E-if %currency GBP- currency P--# generate postings--# the first posting will be the money leaving/entering my paypal account-# (negative means leaving my account, in all amount fields)-account1 assets:online:paypal-amount1  %netamount--# the second posting will be money sent to/received from other party-# (account2 is set below)-amount2  -%grossamount--# if there\[aq]s a fee, add a third posting for the money taken by paypal.-if %feeamount [1-9]- account3 expenses:banking:paypal- amount3  -%feeamount- comment3 business:--# choose an account for the second posting--# override the default account names:-# if the amount is positive, it\[aq]s income (a debit)-if %grossamount \[ha][\[ha]-]- account2 income:unknown-# if negative, it\[aq]s an expense (a credit)-if %grossamount \[ha]-- account2 expenses:unknown--# apply common rules for setting account2 & other tweaks-include common.rules--# apply some overrides specific to this csv--# Transfers from/to bank. These are usually marked Pending,-# which can be disregarded in this case.-if-Bank Account-Bank Deposit to PP Account- description %type for %referencetxnid %itemtitle- account2 assets:bank:wf:pchecking- account1 assets:online:paypal--# Currency conversions-if Currency Conversion- account2 equity:currency conversion-\f[R]-.fi-.IP-.nf-\f[C]-# common.rules--if-darcs-noble benefactor- account2 revenues:foss donations:darcshub- comment2 business:--if-Calm Radio- account2 expenses:online:apps--if-electronic frontier foundation-Patreon-wikimedia-Advent of Code- account2 expenses:dues--if Google- account2 expenses:online:apps- description google | music-\f[R]-.fi-.IP-.nf-\f[C]-$ hledger -f paypal-custom.csv  print-2019-10-01 (60P57143A8206782E) Calm Radio MONTHLY - $1 for the first 2 Months: Me - Order 99309. Item total: $1.00 USD first 2 months, then $6.99 / Month  ; itemid:, fromemail:simon\[at]joyful.com, toemail:memberships\[at]calmradio.com, time:03:46:20, type:Subscription Payment, status:Completed-    assets:online:paypal          $-6.99 = $-6.99-    expenses:online:apps           $6.99--2019-10-01 (0TU1544T080463733) Bank Deposit to PP Account for 60P57143A8206782E  ; itemid:, fromemail:, toemail:simon\[at]joyful.com, time:03:46:20, type:Bank Deposit to PP Account, status:Pending-    assets:online:paypal               $6.99 = $0.00-    assets:bank:wf:pchecking          $-6.99--2019-10-01 (2722394R5F586712G) Patreon Patreon* Membership  ; itemid:, fromemail:simon\[at]joyful.com, toemail:support\[at]patreon.com, time:08:57:01, type:PreApproved Payment Bill User Payment, status:Completed-    assets:online:paypal          $-7.00 = $-7.00-    expenses:dues                  $7.00--2019-10-01 (71854087RG994194F) Bank Deposit to PP Account for 2722394R5F586712G Patreon* Membership  ; itemid:, fromemail:, toemail:simon\[at]joyful.com, time:08:57:01, type:Bank Deposit to PP Account, status:Pending-    assets:online:paypal               $7.00 = $0.00-    assets:bank:wf:pchecking          $-7.00--2019-10-19 (K9U43044RY432050M) Wikimedia Foundation, Inc. Monthly donation to the Wikimedia Foundation  ; itemid:, fromemail:simon\[at]joyful.com, toemail:tle\[at]wikimedia.org, time:03:02:12, type:Subscription Payment, status:Completed-    assets:online:paypal             $-2.00 = $-2.00-    expenses:dues                     $2.00-    expenses:banking:paypal      ; business:--2019-10-19 (3XJ107139A851061F) Bank Deposit to PP Account for K9U43044RY432050M  ; itemid:, fromemail:, toemail:simon\[at]joyful.com, time:03:02:12, type:Bank Deposit to PP Account, status:Pending-    assets:online:paypal               $2.00 = $0.00-    assets:bank:wf:pchecking          $-2.00--2019-10-22 (6L8L1662YP1334033) Noble Benefactor Joyful Systems  ; itemid:, fromemail:noble\[at]bene.fac.tor, toemail:simon\[at]joyful.com, time:05:07:06, type:Subscription Payment, status:Completed-    assets:online:paypal                       $9.41 = $9.41-    revenues:foss donations:darcshub         $-10.00  ; business:-    expenses:banking:paypal                    $0.59  ; business:-\f[R]-.fi-.SH CSV RULES-.PP-The following kinds of rule can appear in the rules file, in any order.-Blank lines and lines beginning with \f[C]#\f[R] or \f[C];\f[R] are-ignored.-.SS \f[C]skip\f[R]-.IP-.nf-\f[C]-skip N-\f[R]-.fi-.PP-The word \[dq]skip\[dq] followed by a number (or no number, meaning 1)-tells hledger to ignore this many non-empty lines preceding the CSV-data.-(Empty/blank lines are skipped automatically.) You\[aq]ll need this-whenever your CSV data contains header lines.-.PP-It also has a second purpose: it can be used inside if blocks to ignore-certain CSV records (described below).-.SS \f[C]fields\f[R]-.IP-.nf-\f[C]-fields FIELDNAME1, FIELDNAME2, ...-\f[R]-.fi-.PP-A fields list (the word \[dq]fields\[dq] followed by comma-separated-field names) is the quick way to assign CSV field values to hledger-fields.-It does two things:-.IP "1." 3-it names the CSV fields.-This is optional, but can be convenient later for interpolating them.-.IP "2." 3-when you use a standard hledger field name, it assigns the CSV value to-that part of the hledger transaction.-.PP-Here\[aq]s an example that says \[dq]use the 1st, 2nd and 4th fields as-the transaction\[aq]s date, description and amount; name the last two-fields for later reference; and ignore the others\[dq]:-.IP-.nf-\f[C]-fields date, description, , amount, , , somefield, anotherfield-\f[R]-.fi-.PP-Field names may not contain whitespace.-Fields you don\[aq]t care about can be left unnamed.-Currently there must be least two items (there must be at least one-comma).-.PP-Note, always use comma in the fields list, even if your CSV uses another-separator character.-.PP-Here are the standard hledger field/pseudo-field names.-For more about the transaction parts they refer to, see the manual for-hledger\[aq]s journal format.-.SS Transaction field names-.PP-\f[C]date\f[R], \f[C]date2\f[R], \f[C]status\f[R], \f[C]code\f[R],-\f[C]description\f[R], \f[C]comment\f[R] can be used to form the-transaction\[aq]s first line.-.SS Posting field names-.SS account-.PP-\f[C]accountN\f[R], where N is 1 to 99, causes a posting to be-generated, with that account name.-.PP-Most often there are two postings, so you\[aq]ll want to set-\f[C]account1\f[R] and \f[C]account2\f[R].-Typically \f[C]account1\f[R] is associated with the CSV file, and is set-once with a top-level assignment, while \f[C]account2\f[R] is set based-on each transaction\[aq]s description, and in conditional blocks.-.PP-If a posting\[aq]s account name is left unset but its amount is set (see-below), a default account name will be chosen (like-\[dq]expenses:unknown\[dq] or \[dq]income:unknown\[dq]).-.SS amount-.PP-\f[C]amountN\f[R] sets posting N\[aq]s amount.-If the CSV uses separate fields for inflows and outflows, you can use-\f[C]amountN-in\f[R] and \f[C]amountN-out\f[R] instead.-By assigning to \f[C]amount1\f[R], \f[C]amount2\f[R], ...-etc.-you can generate anywhere from 0 to 99 postings.-.PP-There is also an older, unnumbered form of these names, suitable for-2-posting transactions, which sets both posting 1\[aq]s and (negated)-posting 2\[aq]s amount: \f[C]amount\f[R], or \f[C]amount-in\f[R] and-\f[C]amount-out\f[R].-This is still supported because it keeps pre-hledger-1.17 csv rules-files working, and because it can be more succinct, and because it-converts posting 2\[aq]s amount to cost if there\[aq]s a transaction-price, which can be useful.-.PP-If you have an existing rules file using the unnumbered form, you might-want to use the numbered form in certain conditional blocks, without-having to update and retest all the old rules.-To facilitate this, posting 1 ignores-\f[C]amount\f[R]/\f[C]amount-in\f[R]/\f[C]amount-out\f[R] if any of-\f[C]amount1\f[R]/\f[C]amount1-in\f[R]/\f[C]amount1-out\f[R] are-assigned, and posting 2 ignores them if any of-\f[C]amount2\f[R]/\f[C]amount2-in\f[R]/\f[C]amount2-out\f[R] are-assigned, avoiding conflicts.-.SS currency-.PP-If the CSV has the currency symbol in a separate field (ie, not part of-the amount field), you can use \f[C]currencyN\f[R] to prepend it to-posting N\[aq]s amount.-Or, \f[C]currency\f[R] with no number affects all postings.-.SS balance-.PP-\f[C]balanceN\f[R] sets a balance assertion amount (or if the posting-amount is left empty, a balance assignment) on posting N.-.PP-Also, for compatibility with hledger <1.17: \f[C]balance\f[R] with no-number is equivalent to \f[C]balance1\f[R].-.PP-You can adjust the type of assertion/assignment with the-\f[C]balance-type\f[R] rule (see below).-.SS comment-.PP-Finally, \f[C]commentN\f[R] sets a comment on the Nth posting.-Comments can also contain tags, as usual.-.PP-See TIPS below for more about setting amounts and currency.-.SS field assignment-.IP-.nf-\f[C]-HLEDGERFIELDNAME FIELDVALUE-\f[R]-.fi-.PP-Instead of or in addition to a fields list, you can use a \[dq]field-assignment\[dq] rule to set the value of a single hledger field, by-writing its name (any of the standard hledger field names above)-followed by a text value.-The value may contain interpolated CSV fields, referenced by their-1-based position in the CSV record (\f[C]%N\f[R]), or by the name they-were given in the fields list (\f[C]%CSVFIELDNAME\f[R]).-Some examples:-.IP-.nf-\f[C]-# set the amount to the 4th CSV field, with \[dq] USD\[dq] appended-amount %4 USD--# combine three fields to make a comment, containing note: and date: tags-comment note: %somefield - %anotherfield, date: %1-\f[R]-.fi-.PP-Interpolation strips outer whitespace (so a CSV value like-\f[C]\[dq] 1 \[dq]\f[R] becomes \f[C]1\f[R] when interpolated) (#1051).-See TIPS below for more about referencing other fields.-.SS \f[C]separator\f[R]-.PP-You can use the \f[C]separator\f[R] rule to read other kinds of-character-separated data.-The argument is any single separator character, or the words-\f[C]tab\f[R] or \f[C]space\f[R] (case insensitive).-Eg, for comma-separated values (CSV):-.IP-.nf-\f[C]-separator ,-\f[R]-.fi-.PP-or for semicolon-separated values (SSV):-.IP-.nf-\f[C]-separator ;-\f[R]-.fi-.PP-or for tab-separated values (TSV):-.IP-.nf-\f[C]-separator TAB-\f[R]-.fi-.PP-If the input file has a \f[C].csv\f[R], \f[C].ssv\f[R] or \f[C].tsv\f[R]-file extension (or a \f[C]csv:\f[R], \f[C]ssv:\f[R], \f[C]tsv:\f[R]-prefix), the appropriate separator will be inferred automatically, and-you won\[aq]t need this rule.-.SS \f[C]if\f[R] block-.IP-.nf-\f[C]-if MATCHER- RULE--if-MATCHER-MATCHER-MATCHER- RULE- RULE-\f[R]-.fi-.PP-Conditional blocks (\[dq]if blocks\[dq]) are a block of rules that are-applied only to CSV records which match certain patterns.-They are often used for customising account names based on transaction-descriptions.-.SS Matching the whole record-.PP-Each MATCHER can be a record matcher, which looks like this:-.IP-.nf-\f[C]-REGEX-\f[R]-.fi-.PP-REGEX is a case-insensitive regular expression which tries to match-anywhere within the CSV record.-It is a POSIX ERE (extended regular expression) that also supports GNU-word boundaries (\f[C]\[rs]b\f[R], \f[C]\[rs]B\f[R], \f[C]\[rs]<\f[R],-\f[C]\[rs]>\f[R]), and nothing else.-If you have trouble, be sure to check our-https://hledger.org/hledger.html#regular-expressions doc.-.PP-Important note: the record that is matched is not the original record,-but a synthetic one, with any enclosing double quotes (but not enclosing-whitespace) removed, and always comma-separated (which means that a-field containing a comma will appear like two fields).-Eg, if the original record is-\f[C]2020-01-01; \[dq]Acme, Inc.\[dq];  1,000\f[R], the REGEX will-actually see \f[C]2020-01-01,Acme, Inc.,  1,000\f[R]).-.SS Matching individual fields-.PP-Or, MATCHER can be a field matcher, like this:-.IP-.nf-\f[C]-%CSVFIELD REGEX-\f[R]-.fi-.PP-which matches just the content of a particular CSV field.-CSVFIELD is a percent sign followed by the field\[aq]s name or column-number, like \f[C]%date\f[R] or \f[C]%1\f[R].-.SS Combining matchers-.PP-A single matcher can be written on the same line as the \[dq]if\[dq]; or-multiple matchers can be written on the following lines, non-indented.-Multiple matchers are OR\[aq]d (any one of them can match), unless one-begins with an \f[C]&\f[R] symbol, in which case it is AND\[aq]ed with-the previous matcher.-.IP-.nf-\f[C]-if-MATCHER-& MATCHER- RULE-\f[R]-.fi-.SS Rules applied on successful match-.PP-After the patterns there should be one or more rules to apply, all-indented by at least one space.-Three kinds of rule are allowed in conditional blocks:-.IP \[bu] 2-field assignments (to set a hledger field)-.IP \[bu] 2-skip (to skip the matched CSV record)-.IP \[bu] 2-end (to skip all remaining CSV records).-.PP-Examples:-.IP-.nf-\f[C]-# if the CSV record contains \[dq]groceries\[dq], set account2 to \[dq]expenses:groceries\[dq]-if groceries- account2 expenses:groceries-\f[R]-.fi-.IP-.nf-\f[C]-# if the CSV record contains any of these patterns, set account2 and comment as shown-if-monthly service fee-atm transaction fee-banking thru software- account2 expenses:business:banking- comment  XXX deductible ? check it-\f[R]-.fi-.SS \f[C]if\f[R] table-.IP-.nf-\f[C]-if,CSVFIELDNAME1,CSVFIELDNAME2,...,CSVFIELDNAMEn-MATCHER1,VALUE11,VALUE12,...,VALUE1n-MATCHER2,VALUE21,VALUE22,...,VALUE2n-MATCHER3,VALUE31,VALUE32,...,VALUE3n-<empty line>-\f[R]-.fi-.PP-Conditional tables (\[dq]if tables\[dq]) are a different syntax to-specify field assignments that will be applied only to CSV records which-match certain patterns.-.PP-MATCHER could be either field or record matcher, as described above.-When MATCHER matches, values from that row would be assigned to the CSV-fields named on the \f[C]if\f[R] line, in the same order.-.PP-Therefore \f[C]if\f[R] table is exactly equivalent to a sequence of of-\f[C]if\f[R] blocks:-.IP-.nf-\f[C]-if MATCHER1-  CSVFIELDNAME1 VALUE11-  CSVFIELDNAME2 VALUE12-  ...-  CSVFIELDNAMEn VALUE1n--if MATCHER2-  CSVFIELDNAME1 VALUE21-  CSVFIELDNAME2 VALUE22-  ...-  CSVFIELDNAMEn VALUE2n--if MATCHER3-  CSVFIELDNAME1 VALUE31-  CSVFIELDNAME2 VALUE32-  ...-  CSVFIELDNAMEn VALUE3n-\f[R]-.fi-.PP-Each line starting with MATCHER should contain enough (possibly empty)-values for all the listed fields.-.PP-Rules would be checked and applied in the order they are listed in the-table and, like with \f[C]if\f[R] blocks, later rules (in the same or-another table) or \f[C]if\f[R] blocks could override the effect of any-rule.-.PP-Instead of \[aq],\[aq] you can use a variety of other non-alphanumeric-characters as a separator.-First character after \f[C]if\f[R] is taken to be the separator for the-rest of the table.-It is the responsibility of the user to ensure that separator does not-occur inside MATCHERs and values - there is no way to escape separator.-.PP-Example:-.IP-.nf-\f[C]-if,account2,comment-atm transaction fee,expenses:business:banking,deductible? check it-%description groceries,expenses:groceries,-2020/01/12.*Plumbing LLC,expenses:house:upkeep,emergency plumbing call-out-\f[R]-.fi-.SS \f[C]end\f[R]-.PP-This rule can be used inside if blocks (only), to make hledger stop-reading this CSV file and move on to the next input file, or to command-execution.-Eg:-.IP-.nf-\f[C]-# ignore everything following the first empty record-if ,,,,- end-\f[R]-.fi-.SS \f[C]date-format\f[R]-.IP-.nf-\f[C]-date-format DATEFMT-\f[R]-.fi-.PP-This is a helper for the \f[C]date\f[R] (and \f[C]date2\f[R]) fields.-If your CSV dates are not formatted like \f[C]YYYY-MM-DD\f[R],-\f[C]YYYY/MM/DD\f[R] or \f[C]YYYY.MM.DD\f[R], you\[aq]ll need to add a-date-format rule describing them with a strptime date parsing pattern,-which must parse the CSV date value completely.-Some examples:-.IP-.nf-\f[C]-# MM/DD/YY-date-format %m/%d/%y-\f[R]-.fi-.IP-.nf-\f[C]-# D/M/YYYY-# The - makes leading zeros optional.-date-format %-d/%-m/%Y-\f[R]-.fi-.IP-.nf-\f[C]-# YYYY-Mmm-DD-date-format %Y-%h-%d-\f[R]-.fi-.IP-.nf-\f[C]-# M/D/YYYY HH:MM AM some other junk-# Note the time and junk must be fully parsed, though only the date is used.-date-format %-m/%-d/%Y %l:%M %p some other junk-\f[R]-.fi-.PP-For the supported strptime syntax, see:-.PD 0-.P-.PD-https://hackage.haskell.org/package/time/docs/Data-Time-Format.html#v:formatTime-.SS \f[C]decimal-mark\f[R]-.IP-.nf-\f[C]-decimal-mark .-\f[R]-.fi-.PP-or:-.IP-.nf-\f[C]-decimal-mark ,-\f[R]-.fi-.PP-hledger automatically accepts either period or comma as a decimal mark-when parsing numbers (cf Amounts).-However if any numbers in the CSV contain digit group marks, such as-thousand-separating commas, you should declare the decimal mark-explicitly with this rule, to avoid misparsed numbers.-.SS \f[C]newest-first\f[R]-.PP-hledger always sorts the generated transactions by date.-Transactions on the same date should appear in the same order as their-CSV records, as hledger can usually auto-detect whether the CSV\[aq]s-normal order is oldest first or newest first.-But if all of the following are true:-.IP \[bu] 2-the CSV might sometimes contain just one day of data (all records having-the same date)-.IP \[bu] 2-the CSV records are normally in reverse chronological order (newest at-the top)-.IP \[bu] 2-and you care about preserving the order of same-day transactions-.PP-then, you should add the \f[C]newest-first\f[R] rule as a hint.-Eg:-.IP-.nf-\f[C]-# tell hledger explicitly that the CSV is normally newest first-newest-first-\f[R]-.fi-.SS \f[C]include\f[R]-.IP-.nf-\f[C]-include RULESFILE-\f[R]-.fi-.PP-This includes the contents of another CSV rules file at this point.-\f[C]RULESFILE\f[R] is an absolute file path or a path relative to the-current file\[aq]s directory.-This can be useful for sharing common rules between several rules files,-eg:-.IP-.nf-\f[C]-# someaccount.csv.rules--## someaccount-specific rules-fields   date,description,amount-account1 assets:someaccount-account2 expenses:misc--## common rules-include categorisation.rules-\f[R]-.fi-.SS \f[C]balance-type\f[R]-.PP-Balance assertions generated by assigning to balanceN are of the simple-\f[C]=\f[R] type by default, which is a single-commodity,-subaccount-excluding assertion.-You may find the subaccount-including variants more useful, eg if you-have created some virtual subaccounts of checking to help with-budgeting.-You can select a different type of assertion with the-\f[C]balance-type\f[R] rule:-.IP-.nf-\f[C]-# balance assertions will consider all commodities and all subaccounts-balance-type ==*-\f[R]-.fi-.PP-Here are the balance assertion types for quick reference:-.IP-.nf-\f[C]-=    single commodity, exclude subaccounts-=*   single commodity, include subaccounts-==   multi commodity,  exclude subaccounts-==*  multi commodity,  include subaccounts-\f[R]-.fi-.SH TIPS-.SS Rapid feedback-.PP-It\[aq]s a good idea to get rapid feedback while-creating/troubleshooting CSV rules.-Here\[aq]s a good way, using entr from http://eradman.com/entrproject :-.IP-.nf-\f[C]-$ ls foo.csv* | entr bash -c \[aq]echo ----; hledger -f foo.csv print desc:SOMEDESC\[aq]-\f[R]-.fi-.PP-A desc: query (eg) is used to select just one, or a few, transactions of-interest.-\[dq]bash -c\[dq] is used to run multiple commands, so we can echo a-separator each time the command re-runs, making it easier to read the-output.-.SS Valid CSV-.PP-hledger accepts CSV conforming to RFC 4180.-When CSV values are enclosed in quotes, note:-.IP \[bu] 2-they must be double quotes (not single quotes)-.IP \[bu] 2-spaces outside the quotes are not allowed-.SS File Extension-.PP-To help hledger identify the format and show the right error messages,-CSV/SSV/TSV files should normally be named with a \f[C].csv\f[R],-\f[C].ssv\f[R] or \f[C].tsv\f[R] filename extension.-Or, the file path should be prefixed with \f[C]csv:\f[R], \f[C]ssv:\f[R]-or \f[C]tsv:\f[R].-Eg:-.IP-.nf-\f[C]-$ hledger -f foo.ssv print-\f[R]-.fi-.PP-or:-.IP-.nf-\f[C]-$ cat foo | hledger -f ssv:- foo-\f[R]-.fi-.PP-You can override the file extension with a separator rule if needed.-See also: Input files in the hledger manual.-.SS Reading multiple CSV files-.PP-If you use multiple \f[C]-f\f[R] options to read multiple CSV files at-once, hledger will look for a correspondingly-named rules file for each-CSV file.-But if you use the \f[C]--rules-file\f[R] option, that rules file will-be used for all the CSV files.-.SS Valid transactions-.PP-After reading a CSV file, hledger post-processes and validates the-generated journal entries as it would for a journal file - balancing-them, applying balance assignments, and canonicalising amount styles.-Any errors at this stage will be reported in the usual way, displaying-the problem entry.-.PP-There is one exception: balance assertions, if you have generated them,-will not be checked, since normally these will work only when the CSV-data is part of the main journal.-If you do need to check balance assertions generated from CSV right-away, pipe into another hledger:-.IP-.nf-\f[C]-$ hledger -f file.csv print | hledger -f- print-\f[R]-.fi-.SS Deduplicating, importing-.PP-When you download a CSV file periodically, eg to get your latest bank-transactions, the new file may overlap with the old one, containing some-of the same records.-.PP-The import command will (a) detect the new transactions, and (b) append-just those transactions to your main journal.-It is idempotent, so you don\[aq]t have to remember how many times you-ran it or with which version of the CSV.-(It keeps state in a hidden \f[C].latest.FILE.csv\f[R] file.) This is-the easiest way to import CSV data.-Eg:-.IP-.nf-\f[C]-# download the latest CSV files, then run this command.-# Note, no -f flags needed here.-$ hledger import *.csv [--dry]-\f[R]-.fi-.PP-This method works for most CSV files.-(Where records have a stable chronological order, and new records appear-only at the new end.)-.PP-A number of other tools and workflows, hledger-specific and otherwise,-exist for converting, deduplicating, classifying and managing CSV data.-See:-.IP \[bu] 2-https://hledger.org -> sidebar -> real world setups-.IP \[bu] 2-https://plaintextaccounting.org -> data import/conversion-.SS Setting amounts-.PP-A posting amount can be set in one of these ways:-.IP \[bu] 2-by assigning (with a fields list or field assignment) to-\f[C]amountN\f[R] (posting N\[aq]s amount) or \f[C]amount\f[R] (posting-1\[aq]s amount)-.IP \[bu] 2-by assigning to \f[C]amountN-in\f[R] and \f[C]amountN-out\f[R] (or-\f[C]amount-in\f[R] and \f[C]amount-out\f[R]).-For each CSV record, whichever of these has a non-zero value will be-used, with appropriate sign.-If both contain a non-zero value, this may not work.-.IP \[bu] 2-by assigning to \f[C]balanceN\f[R] (or \f[C]balance\f[R]) instead of the-above, setting the amount indirectly via a balance assignment.-If you do this the default account name may be wrong, so you should set-that explicitly.-.PP-There is some special handling for an amount\[aq]s sign:-.IP \[bu] 2-If an amount value is parenthesised, it will be de-parenthesised and-sign-flipped.-.IP \[bu] 2-If an amount value begins with a double minus sign, those cancel out and-are removed.-.IP \[bu] 2-If an amount value begins with a plus sign, that will be removed-.SS Setting currency/commodity-.PP-If the currency/commodity symbol is included in the CSV\[aq]s amount-field(s):-.IP-.nf-\f[C]-2020-01-01,foo,$123.00-\f[R]-.fi-.PP-you don\[aq]t have to do anything special for the commodity symbol, it-will be assigned as part of the amount.-Eg:-.IP-.nf-\f[C]-fields date,description,amount-\f[R]-.fi-.IP-.nf-\f[C]-2020-01-01 foo-    expenses:unknown         $123.00-    income:unknown          $-123.00-\f[R]-.fi-.PP-If the currency is provided as a separate CSV field:-.IP-.nf-\f[C]-2020-01-01,foo,USD,123.00-\f[R]-.fi-.PP-You can assign that to the \f[C]currency\f[R] pseudo-field, which has-the special effect of prepending itself to every amount in the-transaction (on the left, with no separating space):-.IP-.nf-\f[C]-fields date,description,currency,amount-\f[R]-.fi-.IP-.nf-\f[C]-2020-01-01 foo-    expenses:unknown       USD123.00-    income:unknown        USD-123.00-\f[R]-.fi-.PP-Or, you can use a field assignment to construct the amount yourself,-with more control.-Eg to put the symbol on the right, and separated by a space:-.IP-.nf-\f[C]-fields date,description,cur,amt-amount %amt %cur-\f[R]-.fi-.IP-.nf-\f[C]-2020-01-01 foo-    expenses:unknown        123.00 USD-    income:unknown         -123.00 USD-\f[R]-.fi-.PP-Note we used a temporary field name (\f[C]cur\f[R]) that is not-\f[C]currency\f[R] - that would trigger the prepending effect, which we-don\[aq]t want here.-.SS Referencing other fields-.PP-In field assignments, you can interpolate only CSV fields, not hledger-fields.-In the example below, there\[aq]s both a CSV field and a hledger field-named amount1, but %amount1 always means the CSV field, not the hledger-field:-.IP-.nf-\f[C]-# Name the third CSV field \[dq]amount1\[dq]-fields date,description,amount1--# Set hledger\[aq]s amount1 to the CSV amount1 field followed by USD-amount1 %amount1 USD--# Set comment to the CSV amount1 (not the amount1 assigned above)-comment %amount1-\f[R]-.fi-.PP-Here, since there\[aq]s no CSV amount1 field, %amount1 will produce a-literal \[dq]amount1\[dq]:-.IP-.nf-\f[C]-fields date,description,csvamount-amount1 %csvamount USD-# Can\[aq]t interpolate amount1 here-comment %amount1-\f[R]-.fi-.PP-When there are multiple field assignments to the same hledger field,-only the last one takes effect.-Here, comment\[aq]s value will be be B, or C if \[dq]something\[dq] is-matched, but never A:-.IP-.nf-\f[C]-comment A-comment B-if something- comment C-\f[R]-.fi-.SS How CSV rules are evaluated-.PP-Here\[aq]s how to think of CSV rules being evaluated (if you really need-to).-First,-.IP \[bu] 2-\f[C]include\f[R] - all includes are inlined, from top to bottom, depth-first.-(At each include point the file is inlined and scanned for further-includes, recursively, before proceeding.)-.PP-Then \[dq]global\[dq] rules are evaluated, top to bottom.-If a rule is repeated, the last one wins:-.IP \[bu] 2-\f[C]skip\f[R] (at top level)-.IP \[bu] 2-\f[C]date-format\f[R]-.IP \[bu] 2-\f[C]newest-first\f[R]-.IP \[bu] 2-\f[C]fields\f[R] - names the CSV fields, optionally sets up initial-assignments to hledger fields-.PP-Then for each CSV record in turn:-.IP \[bu] 2-test all \f[C]if\f[R] blocks.-If any of them contain a \f[C]end\f[R] rule, skip all remaining CSV-records.-Otherwise if any of them contain a \f[C]skip\f[R] rule, skip that many-CSV records.-If there are multiple matched \f[C]skip\f[R] rules, the first one wins.-.IP \[bu] 2-collect all field assignments at top level and in matched \f[C]if\f[R]-blocks.-When there are multiple assignments for a field, keep only the last one.-.IP \[bu] 2-compute a value for each hledger field - either the one that was-assigned to it (and interpolate the %CSVFIELDNAME references), or a-default-.IP \[bu] 2-generate a synthetic hledger transaction from these values.-.PP-This is all part of the CSV reader, one of several readers hledger can-use to parse input files.-When all files have been read successfully, the transactions are passed-as input to whichever hledger command the user specified.---.SH "REPORTING BUGS"-Report bugs at http://bugs.hledger.org-(or on the #hledger IRC channel or hledger mail list)--.SH AUTHORS-Simon Michael <simon@joyful.com> and contributors--.SH COPYRIGHT--Copyright (C) 2007-2020 Simon Michael.-.br-Released under GNU GPL v3 or later.--.SH SEE ALSO-hledger(1), hledger\-ui(1), hledger\-web(1), ledger(1)--hledger_journal(5), hledger_csv(5), hledger_timeclock(5), hledger_timedot(5)