hledger-lib 1.24.99 → 1.25

raw patch · 25 files changed

+831/−478 lines, 25 filesdep ~aesonPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: aeson

API changes (from Hackage documentation)

Files

• CHANGES.md +19/−4
• Hledger/Data/AccountName.hs +122/−1
• Hledger/Data/Amount.hs +1/−0
• Hledger/Data/Balancing.hs +17/−18
• Hledger/Data/Dates.hs +86/−99
• Hledger/Data/Journal.hs +128/−44
• Hledger/Data/PeriodicTransaction.hs +1/−1
• Hledger/Data/Posting.hs +46/−74
• Hledger/Data/Transaction.hs +10/−4
• Hledger/Data/TransactionModifier.hs +21/−12
• Hledger/Data/Types.hs +33/−5
• Hledger/Data/Valuation.hs +10/−8
• Hledger/Query.hs +122/−37
• Hledger/Read/Common.hs +59/−36
• Hledger/Read/CsvReader.hs +2/−2
• Hledger/Read/InputOptions.hs +2/−0
• Hledger/Read/JournalReader.hs +20/−24
• Hledger/Reports/BalanceReport.hs +1/−1
• Hledger/Reports/BudgetReport.hs +11/−9
• Hledger/Reports/EntriesReport.hs +1/−1
• Hledger/Reports/MultiBalanceReport.hs +43/−34
• Hledger/Reports/PostingsReport.hs +9/−12
• Hledger/Reports/ReportOptions.hs +61/−48
• Hledger/Utils/Text.hs +5/−3
• hledger-lib.cabal +1/−1

@@ -9,14 +9,29 @@ Internal/api/developer-ish changes in the hledger-lib (and hledger) packages. For user-visible changes, see the hledger package changelog. -# a98e6125f+# 1.25 2022-03-04 -Improvements+- hledger-lib now builds with GHC 9.2 and latest deps. +  ([#1774](https://github.com/simonmichael/hledger/issues/1774) -- hledger-lib now builds with GHC 9.2 and newer libs (#1774).+- Journal has a new jaccounttypes map.+  The journalAccountType lookup function makes it easy to check an account's type.+  The journalTags and journalInheritedTags functions look up an account's tags.+  Functions like journalFilterPostings and journalFilterTransactions,+  and new matching functions matchesAccountExtra, matchesPostingExtra+  and matchesTransactionExtra, use these to allow more powerful matching+  that is aware of account types and tags. +- Journal has a new jdeclaredaccounttags field+  for easy lookup of account tags.+  Query.matchesTaggedAccount is a tag-aware version of matchesAccount.++- Some account name functions have moved from Hledger.Data.Posting+  to Hledger.Data.AccountName:+  accountNamePostingType, accountNameWithPostingType, accountNameWithoutPostingType,+  joinAccountNames, concatAccountNames, accountNameApplyAliases, accountNameApplyAliasesMemo.+ - Renamed: CommodityLayout to Layout.-  (Stephen Morgan)  # 1.24.1 2021-12-10 

@@ -20,6 +20,15 @@   ,accountNameToAccountRegexCI   ,accountNameTreeFrom   ,accountSummarisedName+  ,accountNameInferType+  ,accountNameType+  ,assetAccountRegex+  ,cashAccountRegex+  ,liabilityAccountRegex+  ,equityAccountRegex+  ,conversionAccountRegex+  ,revenueAccountRegex+  ,expenseAccountRegex   ,acctsep   ,acctsepchar   ,clipAccountName@@ -36,16 +45,28 @@   ,subAccountNamesFrom   ,topAccountNames   ,unbudgetedAccountName+  ,accountNamePostingType+  ,accountNameWithoutPostingType+  ,accountNameWithPostingType+  ,joinAccountNames+  ,concatAccountNames+  ,accountNameApplyAliases+  ,accountNameApplyAliasesMemo   ,tests_AccountName ) where -import Data.Foldable (toList)+import Control.Applicative ((<|>))+import Control.Monad (foldM)+import Data.Foldable (asum, toList) import qualified Data.List.NonEmpty as NE+import qualified Data.Map as M+import Data.MemoUgly (memo) import qualified Data.Set as S import Data.Text (Text) import qualified Data.Text as T import Data.Tree (Tree(..))+import Safe import Text.DocLayout (realLength)  import Hledger.Data.Types@@ -82,6 +103,36 @@       cs = accountNameComponents a       a' = accountLeafName a +-- | Regular expressions matching common English top-level account names,+-- used as a fallback when account types are not declared.+assetAccountRegex      = toRegexCI' "^assets?(:|$)"+cashAccountRegex       = toRegexCI' "^assets?(:.+)?:(cash|bank|che(ck|que?)(ing)?|savings?|current)(:|$)"+liabilityAccountRegex  = toRegexCI' "^(debts?|liabilit(y|ies))(:|$)"+equityAccountRegex     = toRegexCI' "^equity(:|$)"+conversionAccountRegex = toRegexCI' "^equity:(trad(e|ing)|conversion)s?(:|$)"+revenueAccountRegex    = toRegexCI' "^(income|revenue)s?(:|$)"+expenseAccountRegex    = toRegexCI' "^expenses?(:|$)"++-- | Try to guess an account's type from its name,+-- matching common English top-level account names.+accountNameInferType :: AccountName -> Maybe AccountType+accountNameInferType a+  | regexMatchText cashAccountRegex       a = Just Cash+  | regexMatchText assetAccountRegex      a = Just Asset+  | regexMatchText liabilityAccountRegex  a = Just Liability+  | regexMatchText conversionAccountRegex a = Just Conversion+  | regexMatchText equityAccountRegex     a = Just Equity+  | regexMatchText revenueAccountRegex    a = Just Revenue+  | regexMatchText expenseAccountRegex    a = Just Expense+  | otherwise                               = Nothing++-- Extract the 'AccountType' of an 'AccountName' by looking it up in the+-- provided Map, traversing the parent accounts if necessary. If none of those+-- work, try 'accountNameInferType'.+accountNameType :: M.Map AccountName AccountType -> AccountName -> Maybe AccountType+accountNameType atypes a = asum (map (`M.lookup` atypes) $ a : parentAccountNames a)+                         <|> accountNameInferType a+ accountNameLevel :: AccountName -> Int accountNameLevel "" = 0 accountNameLevel a = T.length (T.filter (==acctsepchar) a) + 1@@ -91,6 +142,65 @@ unbudgetedAccountName :: T.Text unbudgetedAccountName = "<unbudgeted>" +accountNamePostingType :: AccountName -> PostingType+accountNamePostingType a+    | T.null a = RegularPosting+    | T.head a == '[' && T.last a == ']' = BalancedVirtualPosting+    | T.head a == '(' && T.last a == ')' = VirtualPosting+    | otherwise = RegularPosting++accountNameWithoutPostingType :: AccountName -> AccountName+accountNameWithoutPostingType a = case accountNamePostingType a of+                                    BalancedVirtualPosting -> textUnbracket a+                                    VirtualPosting -> textUnbracket a+                                    RegularPosting -> a++accountNameWithPostingType :: PostingType -> AccountName -> AccountName+accountNameWithPostingType BalancedVirtualPosting = wrap "[" "]" . accountNameWithoutPostingType+accountNameWithPostingType VirtualPosting         = wrap "(" ")" . accountNameWithoutPostingType+accountNameWithPostingType RegularPosting         = accountNameWithoutPostingType++-- | Prefix one account name to another, preserving posting type+-- indicators like concatAccountNames.+joinAccountNames :: AccountName -> AccountName -> AccountName+joinAccountNames a b = concatAccountNames $ filter (not . T.null) [a,b]++-- | Join account names into one. If any of them has () or [] posting type+-- indicators, these (the first type encountered) will also be applied to+-- the resulting account name.+concatAccountNames :: [AccountName] -> AccountName+concatAccountNames as = accountNameWithPostingType t $ T.intercalate ":" $ map accountNameWithoutPostingType as+    where t = headDef RegularPosting $ filter (/= RegularPosting) $ map accountNamePostingType as++-- | Rewrite an account name using all matching aliases from the given list, in sequence.+-- Each alias sees the result of applying the previous aliases.+-- Or, return any error arising from a bad regular expression in the aliases.+accountNameApplyAliases :: [AccountAlias] -> AccountName -> Either RegexError AccountName+accountNameApplyAliases aliases a =+  let (aname,atype) = (accountNameWithoutPostingType a, accountNamePostingType a)+  in foldM+     (\acct alias -> dbg6 "result" $ aliasReplace (dbg6 "alias" alias) (dbg6 "account" acct))+     aname+     aliases+     >>= Right . accountNameWithPostingType atype++-- | Memoising version of accountNameApplyAliases, maybe overkill.+accountNameApplyAliasesMemo :: [AccountAlias] -> AccountName -> Either RegexError AccountName+accountNameApplyAliasesMemo aliases = memo (accountNameApplyAliases aliases)+  -- XXX re-test this memoisation++-- aliasMatches :: AccountAlias -> AccountName -> Bool+-- aliasMatches (BasicAlias old _) a = old `isAccountNamePrefixOf` a+-- aliasMatches (RegexAlias re  _) a = regexMatchesCI re a++aliasReplace :: AccountAlias -> AccountName -> Either RegexError AccountName+aliasReplace (BasicAlias old new) a+  | old `isAccountNamePrefixOf` a || old == a =+      Right $ new <> T.drop (T.length old) a+  | otherwise = Right a+aliasReplace (RegexAlias re repl) a =+  fmap T.pack . regexReplace re repl $ T.unpack a -- XXX+ -- | Remove some number of account name components from the front of the account name. -- If the special "<unbudgeted>" top-level account is present, it is preserved and -- dropping affects the rest of the account name.@@ -255,5 +365,16 @@     "assets:bank" `isSubAccountNameOf` "assets" @?= True     "assets:bank:checking" `isSubAccountNameOf` "assets" @?= False     "assets:bank" `isSubAccountNameOf` "my assets" @?= False+  ,testCase "accountNameInferType" $ do+    accountNameInferType "assets"            @?= Just Asset+    accountNameInferType "assets:cash"       @?= Just Cash+    accountNameInferType "assets:A/R"        @?= Just Asset+    accountNameInferType "liabilities"       @?= Just Liability+    accountNameInferType "equity"            @?= Just Equity+    accountNameInferType "equity:conversion" @?= Just Conversion+    accountNameInferType "expenses"          @?= Just Expense+    accountNameInferType "revenues"          @?= Just Revenue+    accountNameInferType "revenue"           @?= Just Revenue+    accountNameInferType "income"            @?= Just Revenue  ] 

@@ -80,6 +80,7 @@   amountUnstyled,   showAmountB,   showAmount,+  showAmountPrice,   cshowAmount,   showAmountWithZeroCommodity,   showAmountDebug,

@@ -350,7 +350,7 @@ data BalancingState s = BalancingState {    -- read only    bsStyles       :: Maybe (M.Map CommoditySymbol AmountStyle)  -- ^ commodity display styles-  ,bsUnassignable :: S.Set AccountName                          -- ^ accounts in which balance assignments may not be used+  ,bsUnassignable :: S.Set AccountName                          -- ^ accounts where balance assignments may not be used (because of auto posting rules)   ,bsAssrt        :: Bool                                       -- ^ whether to check balance assertions    -- mutable   ,bsBalances     :: H.HashTable s AccountName MixedAmount      -- ^ running account balances, initially empty@@ -422,8 +422,8 @@     -- display precisions used in balanced checking     styles = Just $ journalCommodityStyles j     bopts = bopts'{commodity_styles_=styles}-    -- balance assignments will not be allowed on these-    txnmodifieraccts = S.fromList . map (paccount . tmprPosting) . concatMap tmpostingrules $ jtxnmodifiers j+    -- balance assignments are not allowed on accounts affected by auto postings+    autopostingaccts = S.fromList . map (paccount . tmprPosting) . concatMap tmpostingrules $ jtxnmodifiers j   in     runST $ do       -- We'll update a mutable array of transactions as we balance them,@@ -448,7 +448,7 @@         -- 2. Sort these items by date, preserving the order of same-day items,         -- and step through them while keeping running account balances,         runningbals <- lift $ H.newSized (length $ journalAccountNamesUsed j)-        flip runReaderT (BalancingState styles txnmodifieraccts (not $ ignore_assertions_ bopts) runningbals balancedtxns) $ do+        flip runReaderT (BalancingState styles autopostingaccts (not $ ignore_assertions_ bopts) runningbals balancedtxns) $ do           -- performing balance assignments in, and balancing, the remaining transactions,           -- and checking balance assertions as each posting is processed.           void $ mapM' balanceTransactionAndCheckAssertionsB $ sortOn (either postingDate tdate) psandts@@ -618,30 +618,29 @@ checkBalanceAssignmentPostingDateB :: Posting -> Balancing s () checkBalanceAssignmentPostingDateB p =   when (hasBalanceAssignment p && isJust (pdate p)) $-    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:"+    throwError $ chomp $ unlines [+       "can't use balance assignment with custom posting date"       ,""-      ,maybe (T.unlines $ showPostingLines p) showTransaction $ ptransaction p+      ,chomp1 $ T.unpack $ maybe (T.unlines $ showPostingLines p) showTransaction $ ptransaction p+      ,"Balance assignments may not be used on postings with a custom posting date"+      ,"(it makes balancing the journal impossible)."+      ,"Please write the posting amount explicitly (or remove the posting date)."       ]  -- | Throw an error if this posting is trying to do a balance assignment and -- the account does not allow balance assignments (eg because it is referenced--- by a transaction modifier, which might generate additional postings to it).+-- by an auto posting rule, which might generate additional postings to it). checkBalanceAssignmentUnassignableAccountB :: Posting -> Balancing s () checkBalanceAssignmentUnassignableAccountB p = do   unassignable <- R.asks bsUnassignable   when (hasBalanceAssignment p && paccount p `S.member` unassignable) $-    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: " <> paccount p-      ,""-      ,"transaction:"+    throwError $ chomp $ unlines [+       "can't use balance assignment with auto postings"       ,""-      ,maybe (T.unlines $ showPostingLines p) showTransaction $ ptransaction p+      ,chomp1 $ T.unpack $ maybe (T.unlines $ showPostingLines p) (showTransaction) $ ptransaction p+      ,"Balance assignments may not be used on accounts affected by auto posting rules"+      ,"(it makes balancing the journal impossible)."+      ,"Please write the posting amount explicitly (or remove the auto posting rule(s))."       ]  -- lenses

@@ -12,7 +12,8 @@ For date and time values, we use the standard Day and UTCTime types.  A 'SmartDate' is a date which may be partially-specified or relative.-Eg 2008\/12\/31, but also 2008\/12, 12\/31, tomorrow, last week, next year.+Eg 2008\/12\/31, but also 2008\/12, 12\/31, tomorrow, last week, next year,+in 5 days, in -3 quarters. We represent these as a triple of strings like (\"2008\",\"12\",\"\"), (\"\",\"\",\"tomorrow\"), (\"\",\"last\",\"week\"). @@ -66,6 +67,7 @@   latestSpanContaining,   smartdate,   splitSpan,+  spansFromBoundaries,   groupByDateSpan,   fixSmartDate,   fixSmartDateStr,@@ -73,7 +75,6 @@   fixSmartDateStrEither',   yearp,   daysInSpan,-  maybePeriod,    tests_Dates )@@ -104,7 +105,7 @@ import Safe (headMay, lastMay, maximumMay, minimumMay) import Text.Megaparsec import Text.Megaparsec.Char (char, char', digitChar, string, string')-import Text.Megaparsec.Char.Lexer (decimal)+import Text.Megaparsec.Char.Lexer (decimal, signed) import Text.Megaparsec.Custom (customErrorBundlePretty) import Text.Printf (printf) @@ -207,52 +208,48 @@ -- splitSpan :: Interval -> DateSpan -> [DateSpan] splitSpan _ (DateSpan Nothing Nothing) = [DateSpan Nothing Nothing]-splitSpan _ s | isEmptySpan s = []-splitSpan NoInterval     s = [s]-splitSpan (Days n)       s = splitspan startofday     (applyN n nextday)     s-splitSpan (Weeks n)      s = splitspan startofweek    (applyN n nextweek)    s-splitSpan (Months n)     s = splitspan startofmonth   (applyN n nextmonth)   s-splitSpan (Quarters n)   s = splitspan startofquarter (applyN n nextquarter) s-splitSpan (Years n)      s = splitspan startofyear    (applyN n nextyear)    s-splitSpan (DayOfMonth n) s = splitspan (nthdayofmonthcontaining n) (nthdayofmonth n . nextmonth) s-splitSpan (WeekdayOfMonth n wd) s = splitspan (nthweekdayofmonthcontaining n wd) (advancetonthweekday n wd . nextmonth) s-splitSpan (DaysOfWeek []) s = [s]  -- shouldn't happen in parser but for completeness-splitSpan (DaysOfWeek days@(n:_)) ds-  | DateSpan Nothing  (Just e)  <- ds = split (DateSpan (Just $ start e) (Just $ nextday $ start e))-  | DateSpan (Just s) Nothing  <- ds = split (DateSpan (Just $ start s) (Just $ nextday $ start s))-  | DateSpan (Just s) (Just e) <- ds =-      if s == e then [ds] else split (DateSpan (Just $ start s) (Just e))+splitSpan _ ds | isEmptySpan ds = []+splitSpan _ ds@(DateSpan (Just s) (Just e)) | s == e = [ds]+splitSpan NoInterval      ds = [ds]+splitSpan (Days n)        ds = splitspan startofday     addDays n                    ds+splitSpan (Weeks n)       ds = splitspan startofweek    addDays (7*n)                ds+splitSpan (Months n)      ds = splitspan startofmonth   addGregorianMonthsClip n     ds+splitSpan (Quarters n)    ds = splitspan startofquarter addGregorianMonthsClip (3*n) ds+splitSpan (Years n)       ds = splitspan startofyear    addGregorianYearsClip n      ds+splitSpan (DayOfMonth n)  ds = splitspan (nthdayofmonthcontaining n)  addGregorianMonthsClip 1 ds+splitSpan (DayOfYear m n) ds = splitspan (nthdayofyearcontaining m n) addGregorianYearsClip 1 ds+splitSpan (WeekdayOfMonth n wd) ds = splitspan (nthweekdayofmonthcontaining n wd) advancemonths 1 ds   where-    start = nthdayofweekcontaining n--    wheel = (\x -> zipWith (-) (tail x) x) . concat . zipWith fmap (fmap (+) [0,7..]) . repeat $ days--    split = splitspan' (repeat startofday) (fmap (`applyN` nextday) wheel)--splitSpan (DayOfYear m n) s = splitspan (nthdayofyearcontaining m n) (applyN (n-1) nextday . applyN (m-1) nextmonth . nextyear) s--- splitSpan (WeekOfYear n)    s = splitspan startofweek    (applyN n nextweek)    s--- splitSpan (MonthOfYear n)   s = splitspan startofmonth   (applyN n nextmonth)   s--- splitSpan (QuarterOfYear n) s = splitspan startofquarter (applyN n nextquarter) s+    advancemonths 0 = id+    advancemonths w = advancetonthweekday n wd . startofmonth . addGregorianMonthsClip w+splitSpan (DaysOfWeek [])         ds = [ds]+splitSpan (DaysOfWeek days@(n:_)) ds = spansFromBoundaries e bdrys+  where+    (s, e) = dateSpanSplitLimits (nthdayofweekcontaining n) nextday ds+    bdrys = concatMap (flip map starts . addDays) [0,7..]+    -- The first representative of each weekday+    starts = map (\d -> addDays (toInteger $ d - n) $ nthdayofweekcontaining n s) days  -- Split the given span using the provided helper functions: -- start is applied to the span's start date to get the first sub-span's start date--- next is applied to a sub-span's start date to get the next sub-span's start date-splitspan :: (Day -> Day) -> (Day -> Day) -> DateSpan -> [DateSpan]-splitspan _ _ (DateSpan Nothing Nothing) = []-splitspan start next (DateSpan Nothing (Just e)) = splitspan start next (DateSpan (Just $ start e) (Just $ next $ start e))-splitspan start next (DateSpan (Just s) Nothing) = splitspan start next (DateSpan (Just $ start s) (Just $ next $ start s))-splitspan start next span@(DateSpan (Just s) (Just e))-    | s == e = [span]-    | otherwise = splitspan' (repeat start) (repeat next) span+-- addInterval is applied to an integer n (multiplying it by mult) and the span's start date to get the nth sub-span's start date+splitspan :: (Day -> Day) -> (Integer -> Day -> Day) -> Int -> DateSpan -> [DateSpan]+splitspan start addInterval mult ds = spansFromBoundaries e bdrys+  where+    (s, e) = dateSpanSplitLimits start (addInterval $ toInteger mult) ds+    bdrys = mapM (addInterval . toInteger) [0,mult..] $ start s -splitspan' :: [Day -> Day] -> [Day -> Day] -> DateSpan -> [DateSpan]-splitspan' (start:ss) (next:ns) (DateSpan (Just s) (Just e))-    | s >= e = []-    | otherwise = DateSpan (Just subs) (Just sube) : splitspan' ss ns (DateSpan (Just sube) (Just e))-    where subs = start s-          sube = next subs-splitspan' _ _ _ = error' "won't happen, avoids warnings"  -- PARTIAL:+-- | Fill in missing endpoints for calculating 'splitSpan'.+dateSpanSplitLimits :: (Day -> Day) -> (Day -> Day) -> DateSpan -> (Day, Day)+dateSpanSplitLimits start _    (DateSpan (Just s) (Just e)) = (start s, e)+dateSpanSplitLimits start next (DateSpan (Just s) Nothing)  = (start s, next $ start s)+dateSpanSplitLimits start next (DateSpan Nothing  (Just e)) = (start e, next $ start e)+dateSpanSplitLimits _     _    (DateSpan Nothing   Nothing) = error "dateSpanSplitLimits: Should not be nulldatespan"  -- PARTIAL: This case should have been handled in splitSpan +-- | Construct a list of 'DateSpan's from a list of boundaries, which fit within a given range.+spansFromBoundaries :: Day -> [Day] -> [DateSpan]+spansFromBoundaries e bdrys = zipWith (DateSpan `on` Just) (takeWhile (< e) bdrys) $ drop 1 bdrys+ -- | Count the days in a DateSpan, or if it is open-ended return Nothing. daysInSpan :: DateSpan -> Maybe Integer daysInSpan (DateSpan (Just d1) (Just d2)) = Just $ diffDays d2 d1@@ -373,9 +370,6 @@   either (error' . ("failed to parse:" ++) . customErrorBundlePretty) id $  -- PARTIAL:   parsePeriodExpr refdate s -maybePeriod :: Day -> Text -> Maybe (Interval,DateSpan)-maybePeriod refdate = either (const Nothing) Just . parsePeriodExpr refdate- -- | Show a DateSpan as a human-readable pseudo-period-expression string. -- dateSpanAsText :: DateSpan -> String -- dateSpanAsText (DateSpan Nothing Nothing)   = "all"@@ -396,21 +390,11 @@       (ry,rm,_) = toGregorian refdate       (b,e) = span sdate       span :: SmartDate -> (Day,Day)-      span (SmartRelative This Day)                 = (refdate, nextday refdate)-      span (SmartRelative Last Day)                 = (prevday refdate, refdate)-      span (SmartRelative Next Day)                 = (nextday refdate, addDays 2 refdate)-      span (SmartRelative This Week)                = (thisweek refdate, nextweek refdate)-      span (SmartRelative Last Week)                = (prevweek refdate, thisweek refdate)-      span (SmartRelative Next Week)                = (nextweek refdate, startofweek $ addDays 14 refdate)-      span (SmartRelative This Month)               = (thismonth refdate, nextmonth refdate)-      span (SmartRelative Last Month)               = (prevmonth refdate, thismonth refdate)-      span (SmartRelative Next Month)               = (nextmonth refdate, startofmonth $ addGregorianMonthsClip 2 refdate)-      span (SmartRelative This Quarter)             = (thisquarter refdate, nextquarter refdate)-      span (SmartRelative Last Quarter)             = (prevquarter refdate, thisquarter refdate)-      span (SmartRelative Next Quarter)             = (nextquarter refdate, startofquarter $ addGregorianMonthsClip 6 refdate)-      span (SmartRelative This Year)                = (thisyear refdate, nextyear refdate)-      span (SmartRelative Last Year)                = (prevyear refdate, thisyear refdate)-      span (SmartRelative Next Year)                = (nextyear refdate, startofyear $ addGregorianYearsClip 2 refdate)+      span (SmartRelative n Day)                    = (addDays n refdate, addDays (n+1) refdate)+      span (SmartRelative n Week)                   = let d = thisweek refdate in (addDays (7*n) d, addDays (7*n+7) d)+      span (SmartRelative n Month)                  = let d = thismonth refdate in (addGregorianMonthsClip n d, addGregorianMonthsClip (n+1) d)+      span (SmartRelative n Quarter)                = let d = thisquarter refdate in (addGregorianMonthsClip (3*n) d, addGregorianMonthsClip (3*n+3) d)+      span (SmartRelative n Year)                   = let d = thisyear refdate in (addGregorianYearsClip n d, addGregorianYearsClip (n+1) d)       span (SmartAssumeStart y Nothing)             = (startofyear day, nextyear day) where day = fromGregorian y 1 1       span (SmartAssumeStart y (Just (m, Nothing))) = (startofmonth day, nextmonth day) where day = fromGregorian y m 1       span (SmartAssumeStart y (Just (m, Just d)))  = (day, nextday day) where day = fromGregorian y m d@@ -510,28 +494,28 @@ -- t "next january" -- "2009-01-01" --+-- >>> t "in 5 days"+-- "2008-12-01"+-- >>> t "in 7 months"+-- "2009-06-01"+-- >>> t "in -2 weeks"+-- "2008-11-10"+-- >>> t "1 quarter ago"+-- "2008-07-01"+-- >>> t "1 week ahead"+-- "2008-12-01" fixSmartDate :: Day -> SmartDate -> Day fixSmartDate refdate = fix   where     fix :: SmartDate -> Day-    fix (SmartRelative This Day)     = refdate-    fix (SmartRelative Last Day)     = prevday refdate-    fix (SmartRelative Next Day)     = nextday refdate-    fix (SmartRelative This Week)    = thisweek refdate-    fix (SmartRelative Last Week)    = prevweek refdate-    fix (SmartRelative Next Week)    = nextweek refdate-    fix (SmartRelative This Month)   = thismonth refdate-    fix (SmartRelative Last Month)   = prevmonth refdate-    fix (SmartRelative Next Month)   = nextmonth refdate-    fix (SmartRelative This Quarter) = thisquarter refdate-    fix (SmartRelative Last Quarter) = prevquarter refdate-    fix (SmartRelative Next Quarter) = nextquarter refdate-    fix (SmartRelative This Year)    = thisyear refdate-    fix (SmartRelative Last Year)    = prevyear refdate-    fix (SmartRelative Next Year)    = nextyear refdate-    fix (SmartAssumeStart y md)      = fromGregorian y (maybe 1 fst md) (fromMaybe 1 $ snd =<< md)-    fix (SmartFromReference m d)     = fromGregorian ry (fromMaybe rm m) d-    fix (SmartMonth m)               = fromGregorian ry m 1+    fix (SmartRelative n Day)     = addDays n refdate+    fix (SmartRelative n Week)    = addDays (7*n) $ thisweek refdate+    fix (SmartRelative n Month)   = addGregorianMonthsClip n $ thismonth refdate+    fix (SmartRelative n Quarter) = addGregorianMonthsClip (3*n) $ thisquarter refdate+    fix (SmartRelative n Year)    = addGregorianYearsClip n $ thisyear refdate+    fix (SmartAssumeStart y md)   = fromGregorian y (maybe 1 fst md) (fromMaybe 1 $ snd =<< md)+    fix (SmartFromReference m d)  = fromGregorian ry (fromMaybe rm m) d+    fix (SmartMonth m)            = fromGregorian ry m 1     (ry, rm, _) = toGregorian refdate  prevday :: Day -> Day@@ -554,8 +538,6 @@ nthdayofmonth d day = fromGregorian y m d where (y,m,_) = toGregorian day  thisquarter = startofquarter-prevquarter = startofquarter . addGregorianMonthsClip (-3)-nextquarter = startofquarter . addGregorianMonthsClip 3 startofquarter day = fromGregorian y (firstmonthofquarter m) 1     where       (y,m,_) = toGregorian day@@ -726,6 +708,8 @@ > october, oct                                (start of month in current year) > yesterday, today, tomorrow                  (-1, 0, 1 days from today) > last/this/next day/week/month/quarter/year  (-1, 0, 1 periods from the current period)+> in n days/weeks/months/quarters/years       (n periods from the current period)+> n days/weeks/months/quarters/years ago      (-n periods from the current period) > 20181201                                    (8 digit YYYYMMDD with valid year month and day) > 201812                                      (6 digit YYYYMM with valid year and month) @@ -763,20 +747,27 @@ smartdate :: TextParser m SmartDate smartdate = choice'   -- XXX maybe obscures date errors ? see ledgerdate-    [ yyyymmdd, ymd+    [ relativeP+    , yyyymmdd, ymd     , (\(m,d) -> SmartFromReference (Just m) d) <$> md     , failIfInvalidDate . SmartFromReference Nothing =<< decimal     , SmartMonth <$> (month <|> mon)-    , SmartRelative This Day <$ string' "today"-    , SmartRelative Last Day <$ string' "yesterday"-    , SmartRelative Next Day <$ string' "tomorrow"-    , liftA2 SmartRelative (seqP <* skipNonNewlineSpaces) intervalP+    , SmartRelative 0    Day <$ string' "today"+    , SmartRelative (-1) Day <$ string' "yesterday"+    , SmartRelative 1    Day <$ string' "tomorrow"     ]   where-    seqP = choice [This <$ string' "this", Last <$ string' "last", Next <$ string' "next"]-    intervalP = choice [Day <$ string' "day", Week <$ string' "week", Month <$ string' "month",-                        Quarter <$ string' "quarter", Year <$ string' "year"]+    relativeP = do+        optional $ string' "in" <* skipNonNewlineSpaces+        num      <- seqP <* skipNonNewlineSpaces+        interval <- intervalP <* skipNonNewlineSpaces+        sign     <- choice [negate <$ string' "ago", id <$ string' "ahead", pure id]+        return $ SmartRelative (sign num) interval +    seqP = choice [ 0 <$ string' "this", -1 <$ string' "last", 1 <$ string' "next", signed skipNonNewlineSpaces decimal ]+    intervalP = choice [ Day <$ string' "day", Week <$ string' "week", Month <$ string' "month"+                       , Quarter <$ string' "quarter", Year <$ string' "year" ] <* optional (char' 's')+ -- | Like smartdate, but there must be nothing other than whitespace after the date. smartdateonly :: TextParser m SmartDate smartdateonly = smartdate <* skipNonNewlineSpaces <* eof@@ -968,18 +959,14 @@                                               (toPermutation $ nth <* skipNonNewlineSpaces)      -- Parse any of several variants of a basic interval, eg "daily", "every day", "every N days".-    tryinterval :: String -> String -> (Int -> Interval) -> TextParser m Interval+    tryinterval :: Text -> Text -> (Int -> Interval) -> TextParser m Interval     tryinterval singular compact intcons = intcons <$> choice'-        [ 1 <$ string' compact'+        [ 1 <$ string' compact         , string' "every" *> skipNonNewlineSpaces *> choice-            [ 1 <$ string' singular'-            , decimal <* skipNonNewlineSpaces <* string' plural'+            [ 1 <$ string' singular+            , decimal <* skipNonNewlineSpaces <* string' (singular <> "s")             ]         ]-      where-        compact'  = T.pack compact-        singular' = T.pack singular-        plural'   = T.pack $ singular ++ "s"  periodexprdatespanp :: Day -> TextParser m DateSpan periodexprdatespanp rdate = choice $ map try [@@ -1078,8 +1065,8 @@             ]    , testCase "match dayOfWeek" $ do-      let dayofweek n s = splitspan (nthdayofweekcontaining n) (applyN (n-1) nextday . nextweek) s-          match ds day = dayofweek day ds == splitSpan (DaysOfWeek [day]) ds @?= True+      let dayofweek n s = splitspan (nthdayofweekcontaining n) (\w -> (if w == 0 then id else applyN (n-1) nextday . applyN (fromInteger w) nextweek)) 1 s+          match ds day = splitSpan (DaysOfWeek [day]) ds @?= dayofweek day ds           ys2021 = fromGregorian 2021 01 01           ye2021 = fromGregorian 2021 12 31           ys2022 = fromGregorian 2022 01 01

@@ -2,6 +2,7 @@ {-# LANGUAGE OverloadedStrings   #-} {-# LANGUAGE Rank2Types          #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TupleSections       #-}  {-| @@ -24,6 +25,7 @@   commodityStylesFromAmounts,   journalCommodityStyles,   journalToCost,+  journalAddInferredEquityPostings,   journalReverse,   journalSetLastReadTime,   journalPivot,@@ -46,7 +48,12 @@   journalAccountNamesDeclared,   journalAccountNamesDeclaredOrUsed,   journalAccountNamesDeclaredOrImplied,+  journalLeafAccountNamesDeclared,   journalAccountNames,+  journalLeafAccountNames,+  journalAccountNameTree,+  journalAccountTags,+  journalInheritedAccountTags,   -- journalAmountAndPriceCommodities,   -- journalAmountStyles,   -- overJournalAmounts,@@ -70,6 +77,11 @@   journalPrevTransaction,   journalPostings,   journalTransactionsSimilarTo,+  -- * Account types+  journalAccountType,+  journalAccountTypes,+  journalAddAccountTypes,+  journalPostingsAddAccountTags,   -- journalPrices,   -- * Standard account types   journalBalanceSheetAccountQuery,@@ -80,6 +92,7 @@   journalLiabilityAccountQuery,   journalEquityAccountQuery,   journalCashAccountQuery,+  journalConversionAccount,   -- * Misc   canonicalStyleFrom,   nulljournal,@@ -92,7 +105,8 @@   samplejournal,   samplejournalMaybeExplicit,   tests_Journal-,journalLeafAccountNamesDeclared)+  --+) where  import Control.Applicative ((<|>))@@ -101,7 +115,7 @@ import Data.Char (toUpper, isDigit) import Data.Default (Default(..)) import Data.Foldable (toList)-import Data.List ((\\), find, foldl', sortBy)+import Data.List ((\\), find, foldl', sortBy, union) import Data.List.Extra (nubSort) import qualified Data.Map.Strict as M import Data.Maybe (catMaybes, fromMaybe, mapMaybe, maybeToList)@@ -111,7 +125,7 @@ import Safe (headMay, headDef, maximumMay, minimumMay) import Data.Time.Calendar (Day, addDays, fromGregorian) import Data.Time.Clock.POSIX (POSIXTime)-import Data.Tree (Tree, flatten)+import Data.Tree (Tree(..), flatten) import Text.Printf (printf) import Text.Megaparsec (ParsecT) import Text.Megaparsec.Custom (FinalParseError)@@ -120,9 +134,10 @@ import Hledger.Data.Types import Hledger.Data.AccountName import Hledger.Data.Amount+import Hledger.Data.Posting import Hledger.Data.Transaction import Hledger.Data.TransactionModifier-import Hledger.Data.Posting+import Hledger.Data.Valuation import Hledger.Query  @@ -193,7 +208,9 @@     ,jincludefilestack          = jincludefilestack j2     ,jdeclaredpayees            = jdeclaredpayees            j1 <> jdeclaredpayees            j2     ,jdeclaredaccounts          = jdeclaredaccounts          j1 <> jdeclaredaccounts          j2+    ,jdeclaredaccounttags       = jdeclaredaccounttags       j1 <> jdeclaredaccounttags       j2     ,jdeclaredaccounttypes      = jdeclaredaccounttypes      j1 <> jdeclaredaccounttypes      j2+    ,jaccounttypes              = jaccounttypes              j1 <> jaccounttypes              j2     ,jglobalcommoditystyles     = jglobalcommoditystyles     j1 <> jglobalcommoditystyles     j2     ,jcommodities               = jcommodities               j1 <> jcommodities               j2     ,jinferredcommodities       = jinferredcommodities       j1 <> jinferredcommodities       j2@@ -222,7 +239,9 @@   ,jincludefilestack          = []   ,jdeclaredpayees            = []   ,jdeclaredaccounts          = []+  ,jdeclaredaccounttags       = M.empty   ,jdeclaredaccounttypes      = M.empty+  ,jaccounttypes              = M.empty   ,jglobalcommoditystyles     = M.empty   ,jcommodities               = M.empty   ,jinferredcommodities       = M.empty@@ -334,9 +353,26 @@ journalAccountNames :: Journal -> [AccountName] journalAccountNames = journalAccountNamesDeclaredOrImplied +-- | Sorted unique account names declared or implied in this journal+-- which have no children.+journalLeafAccountNames :: Journal -> [AccountName]+journalLeafAccountNames = treeLeaves . journalAccountNameTree+ journalAccountNameTree :: Journal -> Tree AccountName journalAccountNameTree = accountNameTreeFrom . journalAccountNamesDeclaredOrImplied +-- | Which tags have been declared explicitly for this account, if any ?+journalAccountTags :: Journal -> AccountName -> [Tag]+journalAccountTags Journal{jdeclaredaccounttags} a = M.findWithDefault [] a jdeclaredaccounttags++-- | Which tags are in effect for this account, including tags inherited from parent accounts ?+journalInheritedAccountTags :: Journal -> AccountName -> [Tag]+journalInheritedAccountTags j a =+  foldl' (\ts a -> ts `union` journalAccountTags j a) [] as+  where+    as = a : parentAccountNames a+-- PERF: cache in journal ?+ -- | 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@@ -395,13 +431,16 @@ -- 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.+-- Account types include:+-- Asset, Liability, Equity, Revenue, Expense, Cash, Conversion. -- 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.+--+-- This is older code pre-dating 2022's expansion of account types. journalAccountTypeQuery :: [AccountType] -> Regexp -> Journal -> Query journalAccountTypeQuery atypes fallbackregex Journal{jdeclaredaccounttypes} =   let@@ -427,69 +466,55 @@ -- or otherwise for accounts with names matched by the case-insensitive  -- regular expression @^assets?(:|$)@. journalAssetAccountQuery :: Journal -> Query-journalAssetAccountQuery j = +journalAssetAccountQuery j =   Or [-     journalAccountTypeQuery [Asset] (toRegexCI' "^assets?(:|$)") j+     journalAccountTypeQuery [Asset] assetAccountRegex j     ,journalCashAccountOnlyQuery j   ] --- | 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 = journalAccountTypeQuery [Asset] (toRegexCI' "^assets?(:|$)")- -- | 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-    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)" ]+-- declared as Cash by account directives, or otherwise accounts whose+-- names match the case-insensitive regular expression+-- @(^assets:(.+:)?(cash|bank)(:|$)@.+journalCashAccountQuery :: Journal -> Query+journalCashAccountQuery = journalAccountTypeQuery [Cash] cashAccountRegex  -- | 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+journalCashAccountOnlyQuery :: Journal -> Query+journalCashAccountOnlyQuery j+  -- Cash accounts are declared; get a query for them (the fallback regex won't be used)+  | Cash `M.member` jdeclaredaccounttypes j = journalAccountTypeQuery [Cash] notused j+  | otherwise = None+  where notused = error' "journalCashAccountOnlyQuery: this should not have happened!"  -- PARTIAL:  -- | 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 -- @^(debts?|liabilit(y|ies))(:|$)@. journalLiabilityAccountQuery :: Journal -> Query-journalLiabilityAccountQuery = journalAccountTypeQuery [Liability] (toRegexCI' "^(debts?|liabilit(y|ies))(:|$)")+journalLiabilityAccountQuery = journalAccountTypeQuery [Liability] liabilityAccountRegex  -- | A query for accounts in this journal which have been -- declared as Equity by account directives, or otherwise for -- accounts with names matched by the case-insensitive regular expression -- @^equity(:|$)@. journalEquityAccountQuery :: Journal -> Query-journalEquityAccountQuery = journalAccountTypeQuery [Equity] (toRegexCI' "^equity(:|$)")+journalEquityAccountQuery = journalAccountTypeQuery [Equity] equityAccountRegex  -- | A query for accounts in this journal which have been -- declared as Revenue by account directives, or otherwise for -- accounts with names matched by the case-insensitive regular expression -- @^(income|revenue)s?(:|$)@. journalRevenueAccountQuery :: Journal -> Query-journalRevenueAccountQuery = journalAccountTypeQuery [Revenue] (toRegexCI' "^(income|revenue)s?(:|$)")+journalRevenueAccountQuery = journalAccountTypeQuery [Revenue] revenueAccountRegex  -- | A query for accounts in this journal which have been -- declared as Expense by account directives, or otherwise for -- accounts with names matched by the case-insensitive regular expression -- @^expenses?(:|$)@. journalExpenseAccountQuery  :: Journal -> Query-journalExpenseAccountQuery = journalAccountTypeQuery [Expense] (toRegexCI' "^expenses?(:|$)")+journalExpenseAccountQuery = journalAccountTypeQuery [Expense] expenseAccountRegex  -- | A query for Asset, Liability & Equity accounts in this journal. -- Cf <http://en.wikipedia.org/wiki/Chart_of_accounts#Balance_Sheet_Accounts>.@@ -506,6 +531,54 @@                                         ,journalExpenseAccountQuery j                                         ] +-- | The 'AccountName' to use for automatically generated conversion postings.+journalConversionAccount :: Journal -> AccountName+journalConversionAccount =+    headDef (T.pack "equity:conversion")+    . M.findWithDefault [] Conversion+    . jdeclaredaccounttypes++-- Newer account type functionality.++journalAccountType :: Journal -> AccountName -> Maybe AccountType+journalAccountType Journal{jaccounttypes} = accountNameType jaccounttypes++-- | Add a map of all known account types to the journal.+journalAddAccountTypes :: Journal -> Journal+journalAddAccountTypes j = j{jaccounttypes = journalAccountTypes j}++-- | Build a map of all known account types, explicitly declared+-- or inferred from the account's parent or name.+journalAccountTypes :: Journal -> M.Map AccountName AccountType+journalAccountTypes j = M.fromList [(a,acctType) | (a, Just (acctType,_)) <- flatten t']+  where+    t = accountNameTreeFrom $ journalAccountNames j :: Tree AccountName+    t' = settypes Nothing t :: Tree (AccountName, Maybe (AccountType, Bool))+    -- Map from the top of the account tree down to the leaves, propagating+    -- account types downward. Keep track of whether the account is declared+    -- (True), in which case the parent account should be preferred, or merely+    -- inferred (False), in which case the inferred type should be preferred.+    settypes :: Maybe (AccountType, Bool) -> Tree AccountName -> Tree (AccountName, Maybe (AccountType, Bool))+    settypes mparenttype (Node a subs) = Node (a, mtype) (map (settypes mtype) subs)+      where+        mtype = M.lookup a declaredtypes <|> minferred+        minferred = if maybe False snd mparenttype+                       then mparenttype+                       else (,False) <$> accountNameInferType a <|> mparenttype+    declaredtypes = (,True) <$> journalDeclaredAccountTypes j++-- | Build a map of the account types explicitly declared.+journalDeclaredAccountTypes :: Journal -> M.Map AccountName AccountType+journalDeclaredAccountTypes Journal{jdeclaredaccounttypes} =+  M.fromList $ concat [map (,t) as | (t,as) <- M.toList jdeclaredaccounttypes]++-- | To all postings in the journal, add any tags from their account+-- (including those inherited from parent accounts).+-- If the same tag exists on posting and account, the latter is ignored.+journalPostingsAddAccountTags :: Journal -> Journal+journalPostingsAddAccountTags j = journalMapPostings addtags j+  where addtags p = p `postingAddTags` (journalInheritedAccountTags j $ paccount p)+ -- Various kinds of filtering on journals. We do it differently depending -- on the command. @@ -514,12 +587,12 @@  -- | Keep only transactions matching the query expression. filterJournalTransactions :: Query -> Journal -> Journal-filterJournalTransactions q j@Journal{jtxns=ts} = j{jtxns=filter (q `matchesTransaction`) ts}+filterJournalTransactions q j@Journal{jtxns} = j{jtxns=filter (matchesTransactionExtra (journalAccountType j) q) jtxns}  -- | Keep only postings matching the query expression. -- This can leave unbalanced transactions. filterJournalPostings :: Query -> Journal -> Journal-filterJournalPostings q j@Journal{jtxns=ts} = j{jtxns=map (filterTransactionPostings q) ts}+filterJournalPostings q j@Journal{jtxns=ts} = j{jtxns=map (filterTransactionPostingsExtra (journalAccountType j) q) ts}  -- | Keep only postings which do not match the query expression, but for which a related posting does. -- This can leave unbalanced transactions.@@ -550,6 +623,11 @@ filterTransactionPostings :: Query -> Transaction -> Transaction filterTransactionPostings q t@Transaction{tpostings=ps} = t{tpostings=filter (q `matchesPosting`) ps} +-- Like filterTransactionPostings, but is given the map of account types so can also filter by account type.+filterTransactionPostingsExtra :: (AccountName -> Maybe AccountType) -> Query -> Transaction -> Transaction+filterTransactionPostingsExtra atypes q t@Transaction{tpostings=ps} =+  t{tpostings=filter (matchesPostingExtra atypes q) ps}+ filterTransactionRelatedPostings :: Query -> Transaction -> Transaction filterTransactionRelatedPostings q t@Transaction{tpostings=ps} =     t{tpostings=if null matches then [] else ps \\ matches}@@ -732,7 +810,7 @@ -- relative dates in transaction modifier queries. journalModifyTransactions :: Day -> Journal -> Either String Journal journalModifyTransactions d j =-    case modifyTransactions (journalCommodityStyles j) d (jtxnmodifiers j) (jtxns j) of+    case modifyTransactions (journalAccountType j) (journalInheritedAccountTags j) (journalCommodityStyles j) d (jtxnmodifiers j) (jtxns j) of       Right ts -> Right j{jtxns=ts}       Left err -> Left err @@ -870,11 +948,17 @@  -- | Convert all this journal's amounts to cost using the transaction prices, if any. -- The journal's commodity styles are applied to the resulting amounts.-journalToCost :: Journal -> Journal-journalToCost j@Journal{jtxns=ts} = j{jtxns=map (transactionToCost styles) ts}-    where-      styles = journalCommodityStyles j+journalToCost :: ConversionOp -> Journal -> Journal+journalToCost cost j@Journal{jtxns=ts} = j{jtxns=map (transactionToCost styles cost) ts}+  where+    styles = journalCommodityStyles j +-- | Add inferred equity postings to a 'Journal' using transaction prices.+journalAddInferredEquityPostings :: Journal -> Journal+journalAddInferredEquityPostings j = journalMapTransactions (transactionAddInferredEquityPostings equityAcct) j+  where+    equityAcct = journalConversionAccount j+ -- -- | Get this journal's unique, display-preference-canonicalised commodities, by symbol. -- journalCanonicalCommodities :: Journal -> M.Map String CommoditySymbol -- journalCanonicalCommodities j = canonicaliseCommodities $ journalAmountCommodities j@@ -1221,7 +1305,7 @@       namesfrom qfunc = journalAccountNamesMatching (qfunc j) j     in [testCase "assets"      $ assertEqual "" ["assets","assets:bank","assets:bank:checking","assets:bank:saving","assets:cash"]          (namesfrom journalAssetAccountQuery)-       ,testCase "cash"        $ assertEqual "" ["assets","assets:bank","assets:bank:checking","assets:bank:saving","assets:cash"]+       ,testCase "cash"        $ assertEqual "" ["assets:bank","assets:bank:checking","assets:bank:saving","assets:cash"]          (namesfrom journalCashAccountQuery)        ,testCase "liabilities" $ assertEqual "" ["liabilities","liabilities:debts"]          (namesfrom journalLiabilityAccountQuery)

@@ -263,7 +263,7 @@     _                    -> Nothing     where       checkStart d x =-        let firstDate = fixSmartDate d $ SmartRelative This x+        let firstDate = fixSmartDate d $ SmartRelative 0 x         in          if d == firstDate          then Nothing

@@ -39,6 +39,7 @@   postingStripPrices,   postingApplyAliases,   postingApplyCommodityStyles,+  postingAddTags,   -- * date operations   postingDate,   postingDate2,@@ -47,13 +48,6 @@   isPostingInDateSpan',   -- * account name operations   accountNamesFromPostings,-  accountNamePostingType,-  accountNameWithoutPostingType,-  accountNameWithPostingType,-  joinAccountNames,-  concatAccountNames,-  accountNameApplyAliases,-  accountNameApplyAliasesMemo,   -- * comment/tag operations   commentJoin,   commentAddTag,@@ -71,24 +65,23 @@   postingTransformAmount,   postingApplyValuation,   postingToCost,+  postingAddInferredEquityPostings,   tests_Posting ) where -import Control.Monad (foldM) import Data.Default (def) import Data.Foldable (asum) import qualified Data.Map as M import Data.Maybe (fromMaybe, isJust)-import Data.MemoUgly (memo)-import Data.List (foldl')+import Data.List (foldl', sort, union) import qualified Data.Set as S import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Builder as TB import Data.Time.Calendar (Day)-import Safe (headDef, maximumBound)+import Safe (maximumBound) import Text.DocLayout (realLength)  import Text.Tabular.AsciiWide@@ -393,38 +386,6 @@ isEmptyPosting :: Posting -> Bool isEmptyPosting = mixedAmountLooksZero . pamount --- AccountName stuff that depends on PostingType--accountNamePostingType :: AccountName -> PostingType-accountNamePostingType a-    | T.null a = RegularPosting-    | T.head a == '[' && T.last a == ']' = BalancedVirtualPosting-    | T.head a == '(' && T.last a == ')' = VirtualPosting-    | otherwise = RegularPosting--accountNameWithoutPostingType :: AccountName -> AccountName-accountNameWithoutPostingType a = case accountNamePostingType a of-                                    BalancedVirtualPosting -> T.init $ T.tail a-                                    VirtualPosting -> T.init $ T.tail a-                                    RegularPosting -> a--accountNameWithPostingType :: PostingType -> AccountName -> AccountName-accountNameWithPostingType BalancedVirtualPosting = wrap "[" "]" . accountNameWithoutPostingType-accountNameWithPostingType VirtualPosting         = wrap "(" ")" . accountNameWithoutPostingType-accountNameWithPostingType RegularPosting         = accountNameWithoutPostingType---- | Prefix one account name to another, preserving posting type--- indicators like concatAccountNames.-joinAccountNames :: AccountName -> AccountName -> AccountName-joinAccountNames a b = concatAccountNames $ filter (not . T.null) [a,b]---- | Join account names into one. If any of them has () or [] posting type--- indicators, these (the first type encountered) will also be applied to--- the resulting account name.-concatAccountNames :: [AccountName] -> AccountName-concatAccountNames as = accountNameWithPostingType t $ T.intercalate ":" $ map accountNameWithoutPostingType as-    where t = headDef RegularPosting $ filter (/= RegularPosting) $ map accountNamePostingType as- -- | Apply some account aliases to the posting's account name, as described by accountNameApplyAliases. -- This can fail due to a bad replacement pattern in a regular expression alias. postingApplyAliases :: [AccountAlias] -> Posting -> Either RegexError Posting@@ -444,34 +405,9 @@   where     fixbalanceassertion ba = ba{baamount=styleAmountExceptPrecision styles $ baamount ba} --- | Rewrite an account name using all matching aliases from the given list, in sequence.--- Each alias sees the result of applying the previous aliases.--- Or, return any error arising from a bad regular expression in the aliases.-accountNameApplyAliases :: [AccountAlias] -> AccountName -> Either RegexError AccountName-accountNameApplyAliases aliases a =-  let (aname,atype) = (accountNameWithoutPostingType a, accountNamePostingType a)-  in foldM-     (\acct alias -> dbg6 "result" $ aliasReplace (dbg6 "alias" alias) (dbg6 "account" acct))-     aname-     aliases-     >>= Right . accountNameWithPostingType atype---- | Memoising version of accountNameApplyAliases, maybe overkill.-accountNameApplyAliasesMemo :: [AccountAlias] -> AccountName -> Either RegexError AccountName-accountNameApplyAliasesMemo aliases = memo (accountNameApplyAliases aliases)-  -- XXX re-test this memoisation---- aliasMatches :: AccountAlias -> AccountName -> Bool--- aliasMatches (BasicAlias old _) a = old `isAccountNamePrefixOf` a--- aliasMatches (RegexAlias re  _) a = regexMatchesCI re a--aliasReplace :: AccountAlias -> AccountName -> Either RegexError AccountName-aliasReplace (BasicAlias old new) a-  | old `isAccountNamePrefixOf` a || old == a =-      Right $ new <> T.drop (T.length old) a-  | otherwise = Right a-aliasReplace (RegexAlias re repl) a =-  fmap T.pack . regexReplace re repl $ T.unpack a -- XXX+-- | Add tags to a posting, discarding any for which the posting already has a value.+postingAddTags :: Posting -> [Tag] -> Posting+postingAddTags p@Posting{ptags} tags = p{ptags=ptags `union` tags}  -- | Apply a specified valuation to this posting's amount, using the -- provided price oracle, commodity styles, and reference dates.@@ -480,9 +416,45 @@ 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 = postingTransformAmount (styleMixedAmount styles . mixedAmountCost)+-- | Maybe convert this 'Posting's amount to cost, and apply apply appropriate+-- amount styles.+postingToCost :: M.Map CommoditySymbol AmountStyle -> ConversionOp -> Posting -> Posting+postingToCost _      NoConversionOp p = p+postingToCost styles ToCost         p = postingTransformAmount (styleMixedAmount styles . mixedAmountCost) p++-- | Generate inferred equity postings from a 'Posting' using transaction prices.+postingAddInferredEquityPostings :: Text -> Posting -> [Posting]+postingAddInferredEquityPostings equityAcct p = taggedPosting : concatMap conversionPostings priceAmounts+  where+    taggedPosting+      | null priceAmounts = p+      | otherwise         = p{ pcomment = pcomment p `commentAddTag` priceTag+                             , ptags = priceTag : ptags p+                             }+    conversionPostings amt = case aprice amt of+        Nothing -> []+        Just _  -> [ cp{ paccount = accountPrefix <> amtCommodity+                       , pamount = mixedAmount . negate $ amountStripPrices amt+                       }+                   , cp{ paccount = accountPrefix <> costCommodity+                       , pamount = mixedAmount cost+                       }+                   ]+      where+        cost = amountCost amt+        amtCommodity  = commodity amt+        costCommodity = commodity cost+        cp = p{ pcomment = pcomment p `commentAddTag` ("generated-posting","")+              , ptags = [("generated-posting", ""), ("_generated-posting", "")]+              , pbalanceassertion = Nothing+              , poriginal = Nothing+              }+        accountPrefix = mconcat [ equityAcct, ":", T.intercalate "-" $ sort [amtCommodity, costCommodity], ":"]+        -- Take the commodity of an amount and collapse consecutive spaces to a single space+        commodity = T.unwords . filter (not . T.null) . T.words . acommodity++    priceTag = ("cost", T.strip . wbToText $ foldMap showAmountPrice priceAmounts)+    priceAmounts = filter (isJust . aprice) . amountsRaw $ pamount p  -- | Apply a transform function to this posting's amount. postingTransformAmount :: (MixedAmount -> MixedAmount) -> Posting -> Posting

@@ -9,7 +9,6 @@  {-# LANGUAGE NamedFieldPuns    #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards   #-}  module Hledger.Data.Transaction ( -- * Transaction@@ -27,6 +26,7 @@ , transactionTransformPostings , transactionApplyValuation , transactionToCost+, transactionAddInferredEquityPostings , transactionApplyAliases , transactionMapPostings , transactionMapPostingAmounts@@ -202,9 +202,15 @@ 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-transactionToCost styles = transactionTransformPostings (postingToCost styles)+-- | Maybe convert this 'Transaction's amounts to cost and apply the+-- appropriate amount styles.+transactionToCost :: M.Map CommoditySymbol AmountStyle -> ConversionOp -> Transaction -> Transaction+transactionToCost styles cost = transactionMapPostings (postingToCost styles cost)++-- | Add inferred equity postings to a 'Transaction' using transaction prices.+transactionAddInferredEquityPostings :: AccountName -> Transaction -> Transaction+transactionAddInferredEquityPostings equityAcct t =+    t{tpostings=concatMap (postingAddInferredEquityPostings equityAcct) $ tpostings t}  -- | Apply some account aliases to all posting account names in the transaction, as described by accountNameApplyAliases. -- This can fail due to a bad replacement pattern in a regular expression alias.

@@ -18,12 +18,12 @@ import qualified Data.Text as T import Data.Time.Calendar (Day) import Hledger.Data.Types-import Hledger.Data.Dates import Hledger.Data.Amount+import Hledger.Data.Dates import Hledger.Data.Transaction (txnTieKnot)-import Hledger.Query (Query, filterQuery, matchesAmount, matchesPosting,+import Hledger.Query (Query, filterQuery, matchesAmount, matchesPostingExtra,                       parseQuery, queryIsAmt, queryIsSym, simplifyQuery)-import Hledger.Data.Posting (commentJoin, commentAddTag, postingApplyCommodityStyles)+import Hledger.Data.Posting (commentJoin, commentAddTag, postingAddTags, postingApplyCommodityStyles) import Hledger.Utils (dbg6, wrap)  -- $setup@@ -36,9 +36,13 @@ -- Or if any of them fails to be parsed, return the first error. A reference -- date is provided to help interpret relative dates in transaction modifier -- queries.-modifyTransactions :: M.Map CommoditySymbol AmountStyle -> Day -> [TransactionModifier] -> [Transaction] -> Either String [Transaction]-modifyTransactions styles d tmods ts = do-  fs <- mapM (transactionModifierToFunction styles d) tmods  -- convert modifiers to functions, or return a parse error+modifyTransactions :: (AccountName -> Maybe AccountType)+                   -> (AccountName -> [Tag])+                   -> M.Map CommoditySymbol AmountStyle+                   -> Day -> [TransactionModifier] -> [Transaction]+                   -> Either String [Transaction]+modifyTransactions atypes atags styles d tmods ts = do+  fs <- mapM (transactionModifierToFunction atypes atags styles d) tmods  -- convert modifiers to functions, or return a parse error   let     modifytxn t = t''       where@@ -62,7 +66,7 @@ -- >>> import qualified Data.Text.IO as T -- >>> t = nulltransaction{tpostings=["ping" `post` usd 1]} -- >>> tmpost acc amt = TMPostingRule (acc `post` amt) False--- >>> test = either putStr (T.putStr.showTransaction) . fmap ($ t) . transactionModifierToFunction mempty nulldate+-- >>> test = either putStr (T.putStr.showTransaction) . fmap ($ t) . transactionModifierToFunction (const Nothing) (const []) mempty nulldate -- >>> test $ TransactionModifier "" ["pong" `tmpost` usd 2] -- 0000-01-01 --     ping           $1.00@@ -78,13 +82,18 @@ --     pong           $3.00  ; generated-posting: = ping -- <BLANKLINE> ---transactionModifierToFunction :: M.Map CommoditySymbol AmountStyle -> Day -> TransactionModifier -> Either String (Transaction -> Transaction)-transactionModifierToFunction styles refdate TransactionModifier{tmquerytxt, tmpostingrules} = do+transactionModifierToFunction :: (AccountName -> Maybe AccountType)+                              -> (AccountName -> [Tag])+                              -> M.Map CommoditySymbol AmountStyle+                              -> Day -> TransactionModifier+                              -> Either String (Transaction -> Transaction)+transactionModifierToFunction atypes atags styles refdate TransactionModifier{tmquerytxt, tmpostingrules} = do   q <- simplifyQuery . fst <$> parseQuery refdate tmquerytxt   let-    fs = map (tmPostingRuleToFunction styles q tmquerytxt) tmpostingrules-    generatePostings = concatMap (\p -> p : map ($ p) (if q `matchesPosting` p then fs else []))-  Right $ \t@(tpostings -> ps) -> txnTieKnot t{tpostings=generatePostings ps}+    fs = map (\tmpr -> addAccountTags . tmPostingRuleToFunction styles q tmquerytxt tmpr) tmpostingrules+    addAccountTags p = p `postingAddTags` atags (paccount p)+    generatePostings p = p : map ($ p) (if matchesPostingExtra atypes q p then fs else [])+  Right $ \t@(tpostings -> ps) -> txnTieKnot t{tpostings=concatMap generatePostings ps}  -- | Converts a 'TransactionModifier''s posting rule to a 'Posting'-generating function, -- which will be used to make a new posting based on the old one (an "automated posting").

@@ -84,10 +84,9 @@   = SmartAssumeStart Year (Maybe (Month, Maybe MonthDay))   | SmartFromReference (Maybe Month) MonthDay   | SmartMonth Month-  | SmartRelative SmartSequence SmartInterval+  | SmartRelative Integer SmartInterval   deriving (Show) -data SmartSequence = Last | This | Next deriving (Show) data SmartInterval = Day | Week | Month | Quarter | Year deriving (Show)  data WhichDate = PrimaryDate | SecondaryDate deriving (Eq,Show)@@ -151,8 +150,32 @@   | Revenue   | Expense   | Cash  -- ^ a subtype of Asset - liquid assets to show in cashflow report-  deriving (Show,Eq,Ord,Generic)+  | Conversion -- ^ a subtype of Equity - account in which to generate conversion postings for transaction prices+  deriving (Eq,Ord,Generic) +instance Show AccountType where+  show Asset      = "A"+  show Liability  = "L"+  show Equity     = "E"+  show Revenue    = "R"+  show Expense    = "X"+  show Cash       = "C"+  show Conversion = "V"++-- | Check whether the first argument is a subtype of the second: either equal+-- or one of the defined subtypes.+isAccountSubtypeOf :: AccountType -> AccountType -> Bool+isAccountSubtypeOf Asset      Asset      = True+isAccountSubtypeOf Liability  Liability  = True+isAccountSubtypeOf Equity     Equity     = True+isAccountSubtypeOf Revenue    Revenue    = True+isAccountSubtypeOf Expense    Expense    = True+isAccountSubtypeOf Cash       Cash       = True+isAccountSubtypeOf Cash       Asset      = True+isAccountSubtypeOf Conversion Conversion = True+isAccountSubtypeOf Conversion Equity     = True+isAccountSubtypeOf _          _          = False+ -- not worth the trouble, letters defined in accountdirectivep for now --instance Read AccountType --  where@@ -362,7 +385,8 @@       pamount           :: MixedAmount,       pcomment          :: Text,              -- ^ this posting's comment lines, as a single non-indented multi-line string       ptype             :: PostingType,-      ptags             :: [Tag],                   -- ^ tag names and values, extracted from the comment+      ptags             :: [Tag],                   -- ^ tag names and values, extracted from the posting comment +                                                    --   and (after finalisation) the posting account's directive if any       pbalanceassertion :: Maybe BalanceAssertion,  -- ^ an expected balance in the account after this posting,                                                     --   in a single commodity, excluding subaccounts.       ptransaction      :: Maybe Transaction,       -- ^ this posting's parent transaction (co-recursive types).@@ -512,7 +536,9 @@   -- 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)+  ,jdeclaredaccounttags   :: M.Map AccountName [Tag]                -- ^ Accounts which have tags declared in their directives, and those tags. (Does not include parents' tags.)+  ,jdeclaredaccounttypes  :: M.Map AccountType [AccountName]        -- ^ Accounts whose type has been explicitly declared in their account directives, grouped by type.+  ,jaccounttypes          :: M.Map AccountName AccountType          -- ^ All accounts for which a type has been declared or can be inferred from its parent or its name.   ,jglobalcommoditystyles :: M.Map CommoditySymbol AmountStyle      -- ^ per-commodity display styles declared globally, eg by command line option or import command   ,jcommodities           :: M.Map CommoditySymbol Commodity        -- ^ commodities and formats declared by commodity directives   ,jinferredcommodities   :: M.Map CommoditySymbol AmountStyle      -- ^ commodities and formats inferred from journal amounts@@ -528,6 +554,8 @@                                                                     --   TODO: FilePath is a sloppy type here, don't assume it's a                                                                     --   real file; values like "", "-", "(string)" can be seen   ,jlastreadtime          :: POSIXTime                              -- ^ when this journal was last read from its file(s)+  -- NOTE: after adding new fields, eg involving account names, consider updating+  -- the Anon instance in Hleger.Cli.Anon   } deriving (Eq, Generic)  -- | A journal in the process of being parsed, not yet finalised.

@@ -13,7 +13,7 @@ {-# LANGUAGE DeriveGeneric #-}  module Hledger.Data.Valuation (-   Costing(..)+   ConversionOp(..)   ,ValuationType(..)   ,PriceOracle   ,journalPriceOracle@@ -51,8 +51,10 @@ ------------------------------------------------------------------------------ -- Types --- | Whether to convert amounts to cost.-data Costing = Cost | NoCost+-- | Which operation to perform on conversion transactions.+-- (There was also an "infer equity postings" operation, but that is now done +-- earlier, in journal finalisation.)+data ConversionOp = NoConversionOp | ToCost   deriving (Show,Eq)  -- | What kind of value conversion should be done on amounts ?@@ -98,8 +100,8 @@ -- Converting things to value  -- | Convert all component amounts to cost/selling price if requested, and style them.-mixedAmountToCost :: Costing -> M.Map CommoditySymbol AmountStyle -> MixedAmount -> MixedAmount-mixedAmountToCost cost styles = mapMixedAmount (amountToCost cost styles)+mixedAmountToCost :: M.Map CommoditySymbol AmountStyle -> ConversionOp -> MixedAmount -> MixedAmount+mixedAmountToCost styles cost = mapMixedAmount (amountToCost styles cost)  -- | Apply a specified valuation to this mixed amount, using the -- provided price oracle, commodity styles, and reference dates.@@ -109,9 +111,9 @@   mapMixedAmount (amountApplyValuation priceoracle styles periodlast today postingdate v)  -- | Convert an Amount to its cost if requested, and style it appropriately.-amountToCost :: Costing -> M.Map CommoditySymbol AmountStyle -> Amount -> Amount-amountToCost NoCost _      = id-amountToCost Cost   styles = styleAmount styles . amountCost+amountToCost :: M.Map CommoditySymbol AmountStyle -> ConversionOp -> Amount -> Amount+amountToCost styles ToCost         = styleAmount styles . amountCost+amountToCost _      NoConversionOp = id  -- | Apply a specified valuation to this amount, using the provided -- price oracle, and reference dates. Also fix up its display style

@@ -21,6 +21,7 @@   parseQuery,   parseQueryList,   parseQueryTerm,+  parseAccountType,   simplifyQuery,   filterQuery,   filterQueryOrNotQuery,@@ -36,6 +37,8 @@   queryIsSym,   queryIsReal,   queryIsStatus,+  queryIsType,+  queryIsTag,   queryStartDate,   queryEndDate,   queryDateSpan,@@ -45,10 +48,13 @@   inAccountQuery,   -- * matching   matchesTransaction,+  matchesTransactionExtra,   matchesDescription,   matchesPayeeWIP,   matchesPosting,+  matchesPostingExtra,   matchesAccount,+  matchesAccountExtra,   matchesMixedAmount,   matchesAmount,   matchesCommodity,@@ -64,7 +70,7 @@ import Control.Applicative ((<|>), many, optional) import Data.Default (Default(..)) import Data.Either (fromLeft, partitionEithers)-import Data.List (partition)+import Data.List (partition, intercalate) import Data.Maybe (fromMaybe, isJust, mapMaybe) import Data.Text (Text) import qualified Data.Text as T@@ -103,6 +109,7 @@                               --   and sometimes like a query option (for controlling display)            | Tag Regexp (Maybe Regexp)  -- ^ match if a tag's name, and optionally its value, is matched by these respective regexps                                         -- matching the regexp if provided, exists+           | Type [AccountType]  -- ^ match accounts whose type is one of these (or with no types, any account)     deriving (Eq,Show)  instance Default Query where def = Any@@ -238,6 +245,7 @@     ,"empty"     ,"depth"     ,"tag"+    ,"type"     ]  defaultprefix :: T.Text@@ -286,6 +294,7 @@  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 _ (T.stripPrefix "type:" -> Just s) = Left <$> parseTypeCodes s parseQueryTerm _ "" = Right $ Left $ Any parseQueryTerm d s = parseQueryTerm d $ defaultprefix<>":"<>s @@ -339,6 +348,45 @@     return $ Tag tag body   where (n,v) = T.break (=='=') s +-- | Parse one or more account type code letters to a query matching any of those types.+parseTypeCodes :: T.Text -> Either String Query+parseTypeCodes s =+  case partitionEithers $ map (parseAccountType False . T.singleton) $ T.unpack s of+    ((e:_),_) -> Left $ "could not parse " <> show e <> " as an account type code.\n" <> help+    ([],[])   -> Left help+    ([],ts)   -> Right $ Type ts+  where+    help = "type:'s argument should be one or more of " ++ accountTypeChoices False ++ " (case insensitive)."++accountTypeChoices :: Bool -> String+accountTypeChoices allowlongform = +  intercalate ", " +    -- keep synced with parseAccountType+    $ ["A","L","E","R","X","C","V"]+    ++ if allowlongform then ["Asset","Liability","Equity","Revenue","Expense","Cash","Conversion"] else []++-- | Case-insensitively parse one single-letter code, or one long-form word if permitted, to an account type.+-- On failure, returns the unparseable text.+parseAccountType :: Bool -> Text -> Either String AccountType+parseAccountType allowlongform s =+  case T.toLower s of+    -- keep synced with accountTypeChoices+    "a"                          -> Right Asset+    "l"                          -> Right Liability+    "e"                          -> Right Equity+    "r"                          -> Right Revenue+    "x"                          -> Right Expense+    "c"                          -> Right Cash+    "v"                          -> Right Conversion+    "asset"      | allowlongform -> Right Asset+    "liability"  | allowlongform -> Right Liability+    "equity"     | allowlongform -> Right Equity+    "revenue"    | allowlongform -> Right Revenue+    "expense"    | allowlongform -> Right Expense+    "cash"       | allowlongform -> Right Cash+    "conversion" | allowlongform -> Right Conversion+    _                            -> Left $ T.unpack s+ -- | Parse the value part of a "status:" query, or return an error. parseStatus :: T.Text -> Either String Status parseStatus s | s `elem` ["*","1"] = Right Cleared@@ -457,6 +505,14 @@ queryIsStatus (StatusQ _) = True queryIsStatus _ = False +queryIsType :: Query -> Bool+queryIsType (Type _) = True+queryIsType _ = False++queryIsTag :: Query -> Bool+queryIsTag (Tag _ _) = True+queryIsTag _ = False+ -- | Does this query specify a start date and nothing else (that would -- filter postings prior to the date) ? -- When the flag is true, look for a starting secondary date instead.@@ -562,25 +618,6 @@  -- matching --- | Does the match expression match this account ?--- A matching in: clause is also considered a match.--- When matching by account name pattern, if there's a regular--- expression error, this function calls error.-matchesAccount :: Query -> AccountName -> Bool-matchesAccount (None) _ = False-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 = regexMatchText r a-matchesAccount (Depth d) a = accountNameLevel a <= d-matchesAccount (Tag _ _) _ = False-matchesAccount _ _ = True--matchesMixedAmount :: Query -> MixedAmount -> Bool-matchesMixedAmount q ma = case amountsRaw ma of-    [] -> q `matchesAmount` nullamt-    as -> any (q `matchesAmount`) as- matchesCommodity :: Query -> CommoditySymbol -> Bool matchesCommodity (Sym r) = regexMatchText r matchesCommodity _ = const True@@ -596,9 +633,6 @@ matchesAmount (Sym r) a = matchesCommodity (Sym r) (acommodity a) matchesAmount _ _ = True --- | Is this simple (single-amount) mixed amount's quantity less than, greater than, equal to, or unsignedly equal to this number ?--- For multi-amount (multiple commodities, or just unsimplified) mixed amounts this is always true.- -- | Is this amount's quantity less than, greater than, equal to, or unsignedly equal to this number ? compareAmount :: OrdPlus -> Quantity -> Amount -> Bool compareAmount ord q Amount{aquantity=aq} = case ord of Lt      -> aq <  q@@ -612,9 +646,42 @@                                                        AbsGtEq -> abs aq >= abs q                                                        AbsEq   -> abs aq == abs q --- | Does the match expression match this posting ?+matchesMixedAmount :: Query -> MixedAmount -> Bool+matchesMixedAmount q ma = case amountsRaw ma of+    [] -> q `matchesAmount` nullamt+    as -> any (q `matchesAmount`) as++-- | Does the query match this account name ?+-- A matching in: clause is also considered a match.+matchesAccount :: Query -> AccountName -> Bool+matchesAccount (None) _ = False+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 = regexMatchText r a+matchesAccount (Depth d) a = accountNameLevel a <= d+matchesAccount (Tag _ _) _ = False+matchesAccount _ _ = True++-- | Like matchesAccount, but with optional extra matching features: ----- Note that for account match we try both original and effective account+-- - If the account's type is provided, any type: terms in the query+--   must match it (and any negated type: terms must not match it).+--+-- - If the account's tags are provided, any tag: terms must match+--   at least one of them (and any negated tag: terms must match none).+--+matchesAccountExtra :: (AccountName -> Maybe AccountType) -> (AccountName -> [Tag]) -> Query -> AccountName -> Bool+matchesAccountExtra atypes atags (Not q  ) a = not $ matchesAccountExtra atypes atags q a+matchesAccountExtra atypes atags (Or  qs ) a = any (\q -> matchesAccountExtra atypes atags q a) qs+matchesAccountExtra atypes atags (And qs ) a = all (\q -> matchesAccountExtra atypes atags q a) qs+matchesAccountExtra atypes _     (Type ts) a = maybe False (\t -> any (t `isAccountSubtypeOf`) ts) $ atypes a+matchesAccountExtra _      atags (Tag npat vpat) a = matchesTags npat vpat $ atags a+matchesAccountExtra _      _     q         a = matchesAccount q a++-- | Does the match expression match this posting ?+-- When matching account name, and the posting has been transformed+-- in some way, we will match either the original or transformed name. matchesPosting :: Query -> Posting -> Bool matchesPosting (Not q) p = not $ q `matchesPosting` p matchesPosting (Any) _ = True@@ -623,8 +690,7 @@ matchesPosting (And qs) p = all (`matchesPosting` p) qs 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 || maybe False matches (poriginal p)-  where matches = regexMatchText r . paccount+matchesPosting (Acct r) p = matches p || maybe False matches (poriginal p) 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@@ -635,8 +701,19 @@ matchesPosting (Tag n v) p = case (reString n, v) of   ("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+  (_, mv) -> matchesTags n mv $ postingAllTags p+matchesPosting (Type _) _ = False +-- | Like matchesPosting, but if the posting's account's type is provided,+-- any type: terms in the query must match it (and any negated type: terms+-- must not match it).+matchesPostingExtra :: (AccountName -> Maybe AccountType) -> Query -> Posting -> Bool+matchesPostingExtra atype (Not q )  p = not $ matchesPostingExtra atype q p+matchesPostingExtra atype (Or  qs)  p = any (\q -> matchesPostingExtra atype q p) qs+matchesPostingExtra atype (And qs)  p = all (\q -> matchesPostingExtra atype q p) qs+matchesPostingExtra atype (Type ts) p = maybe False (\t -> any (t `isAccountSubtypeOf`) ts) . atype $ paccount p+matchesPostingExtra _ q p             = matchesPosting q p+ -- | Does the match expression match this transaction ? matchesTransaction :: Query -> Transaction -> Bool matchesTransaction (Not q) t = not $ q `matchesTransaction` t@@ -658,7 +735,18 @@   ("payee", Just v) -> regexMatchText v $ transactionPayee t   ("note", Just v) -> regexMatchText v $ transactionNote t   (_, v) -> matchesTags n v $ transactionAllTags t+matchesTransaction (Type _) _ = False +-- | Like matchesTransaction, but if the journal's account types are provided,+-- any type: terms in the query must match at least one posting's account type+-- (and any negated type: terms must match none).+matchesTransactionExtra :: (AccountName -> Maybe AccountType) -> Query -> Transaction -> Bool+matchesTransactionExtra atype (Not  q) t = not $ matchesTransactionExtra atype q t+matchesTransactionExtra atype (Or  qs) t = any (\q -> matchesTransactionExtra atype q t) qs+matchesTransactionExtra atype (And qs) t = all (\q -> matchesTransactionExtra atype q t) qs+matchesTransactionExtra atype q@(Type _) t = any (matchesPostingExtra atype q) $ tpostings t+matchesTransactionExtra _ q t = matchesTransaction q t+ -- | Does the query match this transaction description ? -- Tests desc: terms, any other terms are ignored. matchesDescription :: Query -> Text -> Bool@@ -669,15 +757,7 @@ 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+matchesDescription _ _            = False  -- | Does the query match this transaction payee ? -- Tests desc: (and payee: ?) terms, any other terms are ignored.@@ -800,6 +880,11 @@      assertBool "" $ Date nulldatespan `matchesAccount` "a"      assertBool "" $ Date2 nulldatespan `matchesAccount` "a"      assertBool "" $ not $ Tag (toRegex' "a") Nothing `matchesAccount` "a"++  ,testCase "matchesAccountExtra" $ do+     let tagq = Tag (toRegexCI' "type") Nothing+     assertBool "" $ not $ matchesAccountExtra (const Nothing) (const []) tagq "a"+     assertBool "" $       matchesAccountExtra (const Nothing) (const [("type","")]) tagq "a"    ,testGroup "matchesPosting" [      testCase "positive match on cleared posting status"  $

@@ -19,7 +19,6 @@ {-# LANGUAGE NamedFieldPuns      #-} {-# LANGUAGE NoMonoLocalBinds    #-} {-# LANGUAGE OverloadedStrings   #-}-{-# LANGUAGE PackageImports      #-} {-# LANGUAGE Rank2Types          #-} {-# LANGUAGE RecordWildCards     #-} {-# LANGUAGE ScopedTypeVariables #-}@@ -49,6 +48,7 @@   getDefaultCommodityAndStyle,   getDefaultAmountStyle,   getAmountStyle,+  addDeclaredAccountTags,   addDeclaredAccountType,   pushParentAccount,   popParentAccount,@@ -129,7 +129,7 @@ import Data.Either (lefts, rights) import Data.Function ((&)) import Data.Functor ((<&>), ($>))-import Data.List (find, genericReplicate)+import Data.List (find, genericReplicate, union) import Data.List.NonEmpty (NonEmpty(..)) import Data.Maybe (catMaybes, fromMaybe, isJust, listToMaybe) import qualified Data.Map as M@@ -213,6 +213,7 @@       ,forecast_          = forecastPeriodFromRawOpts day rawopts       ,reportspan_        = DateSpan (queryStartDate False datequery) (queryEndDate False datequery)       ,auto_              = boolopt "auto" rawopts+      ,infer_equity_      = boolopt "infer-equity" rawopts && conversionop_ ropts /= Just ToCost       ,balancingopts_     = defbalancingopts{                                  ignore_assertions_ = boolopt "ignore-assertions" rawopts                                , infer_transaction_prices_ = not noinferprice@@ -287,47 +288,58 @@  -- | Post-process a Journal that has just been parsed or generated, in this order: ----- - apply canonical amount styles,+-- - add misc info (file path, read time)  ----- - save misc info and reverse transactions into their original parse order,+-- - reverse transactions into their original parse order ----- - add forecast transactions,+-- - apply canonical commodity styles ----- - evaluate balance assignments and balance each transaction,+-- - add tags from account directives to postings' tags ----- - apply transaction modifiers (auto postings) if enabled,+-- - add forecast transactions if enabled ----- - check balance assertions if enabled.+-- - add tags from account directives to postings' tags (again to affect forecast transactions) ----- - infer transaction-implied market prices from transaction prices+-- - add auto postings if enabled --+-- - add tags from account directives to postings' tags (again to affect auto postings)+--+-- - evaluate balance assignments and balance each transaction+--+-- - check balance assertions if enabled+--+-- - infer equity postings in conversion transactions if enabled+--+-- - infer market prices from costs if enabled+--+-- - check all accounts have been declared if in strict mode+--+-- - check all commodities have been declared if in strict mode+-- journalFinalise :: InputOpts -> FilePath -> Text -> ParsedJournal -> ExceptT String IO Journal-journalFinalise iopts@InputOpts{auto_,balancingopts_,strict_} f txt pj = do-    t <- liftIO getPOSIXTime-    -- Infer and apply canonical styles for each commodity (or throw an error).-    -- This affects transaction balancing/assertions/assignments, so needs to be done early.-    liftEither $ checkAddAndBalance (_ioDay iopts) <=< journalApplyCommodityStyles $-        pj{jglobalcommoditystyles=fromMaybe mempty $ commodity_styles_ balancingopts_}  -- save any global commodity styles-        & journalAddFile (f, txt)           -- save the main file's info-        & journalSetLastReadTime t          -- save the last read time-        & journalReverse                    -- convert all lists to the order they were parsed-  where-    checkAddAndBalance d j = do-        when strict_ $ do-          -- If in strict mode, check all postings are to declared accounts-          journalCheckAccountsDeclared j-          -- and using declared commodities-          journalCheckCommoditiesDeclared j--        -- Add forecast transactions if enabled-        journalAddForecast (forecastPeriod iopts j) j-        -- Add auto postings if enabled-          & (if auto_ && not (null $ jtxnmodifiers j) then journalAddAutoPostings d balancingopts_ else pure)-        -- Balance all transactions and maybe check balance assertions.-          >>= journalBalanceTransactions balancingopts_-        -- infer market prices from commodity-exchanging transactions-          <&> journalInferMarketPricesFromTransactions+journalFinalise iopts@InputOpts{auto_,infer_equity_,balancingopts_,strict_,_ioDay} f txt pj = do+  t <- liftIO getPOSIXTime+  liftEither $ do+    j <- pj{jglobalcommoditystyles=fromMaybe mempty $ commodity_styles_ balancingopts_}+      &   journalSetLastReadTime t                       -- save the last read time+      &   journalAddFile (f, txt)                        -- save the main file's info+      &   journalReverse                                 -- convert all lists to the order they were parsed+      &   journalAddAccountTypes                         -- build a map of all known account types+      &   journalApplyCommodityStyles                    -- Infer and apply commodity styles - should be done early+      <&> journalAddForecast (forecastPeriod iopts pj)   -- Add forecast transactions if enabled+      <&> journalPostingsAddAccountTags                  -- Add account tags to postings, so they can be matched by auto postings.+      >>= (if auto_ && not (null $ jtxnmodifiers pj)+              then journalAddAutoPostings _ioDay balancingopts_  -- Add auto postings if enabled, and account tags if needed+              else pure)+      >>= journalBalanceTransactions balancingopts_      -- Balance all transactions and maybe check balance assertions.+      <&> (if infer_equity_ then journalAddInferredEquityPostings else id)  -- Add inferred equity postings, after balancing transactions and generating auto postings+      <&> journalInferMarketPricesFromTransactions       -- infer market prices from commodity-exchanging transactions+    when strict_ $ do+      journalCheckAccountsDeclared j                     -- If in strict mode, check all postings are to declared accounts+      journalCheckCommoditiesDeclared j                  -- and using declared commodities+    return j +-- | Apply any auto posting rules to generate extra postings on this journal's transactions. journalAddAutoPostings :: Day -> BalancingOpts -> Journal -> Either String Journal journalAddAutoPostings d bopts =     -- Balance all transactions without checking balance assertions,@@ -403,9 +415,14 @@                           (linesPrepend "  " . (<>"\n") . textChomp $ showTransaction t)       where         mfirstundeclaredcomm =-          find (`M.notMember` jcommodities j) . map acommodity $-          (maybe id ((:) . baamount) pbalanceassertion) . filter (/= missingamt) $ amountsRaw pamount+          find (`M.notMember` jcommodities j)+          . map acommodity+          . (maybe id ((:) . baamount) pbalanceassertion)+          . filter (not . isIgnorable)+          $ amountsRaw pamount +    -- Ignore missing amounts and zero amounts without commodity (#1767)+    isIgnorable a = (T.null (acommodity a) && amountIsZero a) || a == missingamt  setYear :: Year -> JournalParser m () setYear y = modify' (\j -> j{jparsedefaultyear=Just y})@@ -444,6 +461,10 @@   mdefaultStyle <- fmap snd <$> getDefaultCommodityAndStyle   return $ listToMaybe $ catMaybes [mspecificStyle, mdefaultStyle] +addDeclaredAccountTags :: AccountName -> [Tag] -> JournalParser m ()+addDeclaredAccountTags acct atags =+  modify' (\j -> j{jdeclaredaccounttags = M.insertWith (flip union) acct atags (jdeclaredaccounttags j)})+ addDeclaredAccountType :: AccountName -> AccountType -> JournalParser m () addDeclaredAccountType acct atype =   modify' (\j -> j{jdeclaredaccounttypes = M.insertWith (++) atype [acct] (jdeclaredaccounttypes j)})@@ -1575,3 +1596,5 @@     ]    ]++

@@ -45,7 +45,7 @@ import Control.Monad.IO.Class     (MonadIO, liftIO) import Control.Monad.State.Strict (StateT, get, modify', evalStateT) import Control.Monad.Trans.Class  (lift)-import Data.Char                  (toLower, isDigit, isSpace, isAlphaNum, isAscii, ord)+import Data.Char                  (toLower, isDigit, isSpace, isAlphaNum, ord) import Data.Bifunctor             (first) import Data.List (elemIndex, foldl', intersperse, mapAccumL, nub, sortBy) import Data.Maybe (catMaybes, fromMaybe, isJust)@@ -1245,7 +1245,7 @@     t   where     referencep = liftA2 T.cons (char '%') (takeWhile1P (Just "reference") isFieldNameChar) :: Parsec CustomErr Text Text-    isFieldNameChar c = isAscii c && (isAlphaNum c || c == '_' || c == '-')+    isFieldNameChar 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

@@ -36,6 +36,7 @@     ,forecast_          :: Maybe DateSpan       -- ^ span in which to generate forecast transactions     ,reportspan_        :: DateSpan             -- ^ a dirty hack keeping the query dates in InputOpts. This rightfully lives in ReportSpec, but is duplicated here.     ,auto_              :: Bool                 -- ^ generate automatic postings when journal is parsed+    ,infer_equity_      :: Bool                 -- ^ generate automatic equity postings from transaction prices     ,balancingopts_     :: BalancingOpts        -- ^ options for balancing transactions     ,strict_            :: Bool                 -- ^ do extra error checking (eg, all posted accounts are declared, no prices are inferred)     ,_ioDay             :: Day                  -- ^ today's date, for use with forecast transactions  XXX this duplicates _rsDay, and should eventually be removed when it's not needed anymore.@@ -53,6 +54,7 @@     , forecast_          = Nothing     , reportspan_        = nulldatespan     , auto_              = False+    , infer_equity_      = False     , balancingopts_     = defbalancingopts     , strict_            = False     , _ioDay             = nulldate

@@ -73,7 +73,7 @@ --- ** imports import qualified Control.Monad.Fail as Fail (fail) import qualified Control.Exception as C-import Control.Monad (forM_, when, void)+import Control.Monad (forM_, when, void, unless) import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Monad.Except (ExceptT(..), runExceptT) import Control.Monad.State.Strict (evalStateT,get,modify',put)@@ -347,12 +347,6 @@   -- the account name, possibly modified by preceding alias or apply account directives   acct <- modifiedaccountnamep -  -- maybe an account type code (ALERX) after two or more spaces-  -- XXX added in 1.11, deprecated in 1.13, remove in 1.14-  mtypecode :: Maybe Char <- lift $ optional $ try $ do-    skipNonNewlineSpaces1 -- at least one more space in addition to the one consumed by modifiedaccountp-    choice $ map char "ALERX"-   -- maybe a comment, on this and/or following lines   (cmt, tags) <- lift transactioncommentp @@ -362,11 +356,11 @@   -- an account type may have been set by account type code or a tag;   -- the latter takes precedence   let-    mtypecode' :: Maybe Text = lookup accountTypeTagName tags <|> (T.singleton <$> mtypecode)-    metype = parseAccountTypeCode <$> mtypecode'+    metype = parseAccountTypeCode <$> lookup accountTypeTagName tags    -- update the journal   addAccountDeclaration (acct, cmt, tags)+  unless (null tags) $ addDeclaredAccountTags acct tags   case metype of     Nothing         -> return ()     Just (Right t)  -> addDeclaredAccountType acct t@@ -378,22 +372,24 @@ parseAccountTypeCode :: Text -> Either String AccountType parseAccountTypeCode s =   case T.toLower s of-    "asset"     -> Right Asset-    "a"         -> Right Asset-    "liability" -> Right Liability-    "l"         -> Right Liability-    "equity"    -> Right Equity-    "e"         -> Right Equity-    "revenue"   -> Right Revenue-    "r"         -> Right Revenue-    "expense"   -> Right Expense-    "x"         -> Right Expense-    "cash"      -> Right Cash-    "c"         -> Right Cash-    _           -> Left err+    "asset"      -> Right Asset+    "a"          -> Right Asset+    "liability"  -> Right Liability+    "l"          -> Right Liability+    "equity"     -> Right Equity+    "e"          -> Right Equity+    "revenue"    -> Right Revenue+    "r"          -> Right Revenue+    "expense"    -> Right Expense+    "x"          -> Right Expense+    "cash"       -> Right Cash+    "c"          -> Right Cash+    "conversion" -> Right Conversion+    "v"          -> Right Conversion+    _            -> Left err   where     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"]+            T.intercalate ", " ["A","L","E","R","X","C","V","Asset","Liability","Equity","Revenue","Expense","Cash","Conversion"]  -- Add an account declaration to the journal, auto-numbering it. addAccountDeclaration :: (AccountName,Text,[Tag]) -> JournalParser m ()@@ -1008,7 +1004,7 @@   ,testGroup "accountdirectivep" [        testCase "with-comment"       $ assertParse accountdirectivep "account a:b  ; a comment\n"       ,testCase "does-not-support-!" $ assertParseError accountdirectivep "!account a:b\n" ""-      ,testCase "account-type-code"  $ assertParse accountdirectivep "account a:b  A\n"+      ,testCase "account-type-code"  $ assertParse accountdirectivep "account a:b  ; type:A\n"       ,testCase "account-type-tag"   $ assertParseStateOn accountdirectivep "account a:b  ; type:asset\n"         jdeclaredaccounts         [("a:b", AccountDeclarationInfo{adicomment          = "type:asset\n"

@@ -313,7 +313,7 @@                 ,"  a:b          10h @ $50"                 ,"  c:d                   "                 ]) >>= either error' return-         let j' = journalCanonicaliseAmounts $ journalToCost j -- enable cost basis adjustment+         let j' = journalCanonicaliseAmounts $ journalToCost ToCost j -- enable cost basis adjustment          balanceReportAsText defreportopts (balanceReport defreportopts Any j') `is`            ["                $500  a:b"            ,"               $-500  c:d"

@@ -82,10 +82,12 @@       jperiodictxns j     actualj = journalWithBudgetAccountNames budgetedaccts showunbudgeted j     budgetj = journalAddBudgetGoalTransactions bopts ropts reportspan j-    actualreport@(PeriodicReport actualspans _ _) =-        dbg5 "actualreport" $ multiBalanceReport rspec{_rsReportOpts=ropts{empty_=True}} actualj+    priceoracle = journalPriceOracle (infer_prices_ ropts) j     budgetgoalreport@(PeriodicReport _ budgetgoalitems budgetgoaltotals) =-        dbg5 "budgetgoalreport" $ multiBalanceReport rspec{_rsReportOpts=ropts{empty_=True}} budgetj+        dbg5 "budgetgoalreport" $ multiBalanceReportWith rspec{_rsReportOpts=ropts{empty_=True}} budgetj priceoracle mempty+    budgetedacctsseen = S.fromList $ map prrFullName budgetgoalitems+    actualreport@(PeriodicReport actualspans _ _) =+        dbg5 "actualreport"     $ multiBalanceReportWith rspec{_rsReportOpts=ropts{empty_=True}} actualj priceoracle budgetedacctsseen     budgetgoalreport'       -- If no interval is specified:       -- budgetgoalreport's span might be shorter actualreport's due to periodic txns;@@ -218,9 +220,9 @@       balanceReportTableAsText ropts (budgetReportAsTable ropts budgetr)   where     title = "Budget performance in " <> showDateSpan (periodicReportSpan budgetr)-           <> (case cost_ of-                 Cost   -> ", converted to cost"-                 NoCost -> "")+           <> (case conversionop_ of+                 Just ToCost -> ", converted to cost"+                 _           -> "")            <> (case value_ of                  Just (AtThen _mc)   -> ", valued at posting date"                  Just (AtEnd _mc)    -> ", valued at period ends"@@ -386,9 +388,9 @@         _   -> -- trace (pshow $ (maybecost actual, maybecost budget))  -- debug missing percentage                Nothing       where-        costedAmounts = case cost_ of-            Cost   -> amounts . mixedAmountCost-            NoCost -> amounts+        costedAmounts = case conversionop_ of+            Just ToCost -> amounts . mixedAmountCost+            _           -> amounts      -- | Calculate the percentage of actual change to budget goal for a particular commodity     percentage' :: Change -> BudgetGoal -> CommoditySymbol -> Maybe Percentage

@@ -36,7 +36,7 @@ entriesReport :: ReportSpec -> Journal -> EntriesReport entriesReport rspec@ReportSpec{_rsReportOpts=ropts} =     sortBy (comparing $ transactionDateFn ropts) . jtxns-    . journalApplyValuationFromOpts rspec{_rsReportOpts=ropts{show_costs_=True}}+    . journalApplyValuationFromOpts (setDefaultConversionOp NoConversionOp rspec)     . filterJournalTransactions (_rsQuery rspec)  tests_EntriesReport = testGroup "EntriesReport" [

@@ -47,6 +47,8 @@ import Data.Maybe (fromMaybe, isJust, mapMaybe) import Data.Ord (Down(..)) import Data.Semigroup (sconcat)+import Data.Set (Set)+import qualified Data.Set as Set import Data.Time.Calendar (fromGregorian) import Safe (lastDef, minimumMay) @@ -102,23 +104,23 @@ -- by the balance command (in multiperiod mode) and (via compoundBalanceReport) -- by the bs/cf/is commands. multiBalanceReport :: ReportSpec -> Journal -> MultiBalanceReport-multiBalanceReport rspec j = multiBalanceReportWith rspec j (journalPriceOracle infer j)+multiBalanceReport rspec j = multiBalanceReportWith rspec j (journalPriceOracle infer j) mempty   where infer = infer_prices_ $ _rsReportOpts rspec --- | A helper for multiBalanceReport. This one takes an extra argument,--- a PriceOracle to be used for looking up market prices. Commands which--- run multiple reports (bs etc.) can generate the price oracle just--- once for efficiency, passing it to each report by calling this--- function directly.-multiBalanceReportWith :: ReportSpec -> Journal -> PriceOracle -> MultiBalanceReport-multiBalanceReportWith rspec' j priceoracle = report+-- | A helper for multiBalanceReport. This one takes some extra arguments,+-- a 'PriceOracle' to be used for looking up market prices, and a set of+-- 'AccountName's which should not be elided. Commands which run multiple+-- reports (bs etc.) can generate the price oracle just once for efficiency,+-- passing it to each report by calling this function directly.+multiBalanceReportWith :: ReportSpec -> Journal -> PriceOracle -> Set AccountName -> MultiBalanceReport+multiBalanceReportWith rspec' j priceoracle unelidableaccts = report   where     -- Queries, report/column dates.-    reportspan = dbg3 "reportspan" $ reportSpan j rspec'-    rspec      = dbg3 "reportopts" $ makeReportQuery rspec' reportspan+    (reportspan, colspans) = reportSpan j rspec'+    rspec = dbg3 "reportopts" $ makeReportQuery rspec' reportspan      -- Group postings into their columns.-    colps = dbg5 "colps" $ getPostingsByColumn rspec j priceoracle reportspan+    colps = dbg5 "colps" $ getPostingsByColumn rspec j priceoracle colspans      -- 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.@@ -127,7 +129,7 @@      -- Generate and postprocess the report, negating balances and taking percentages if needed     report = dbg4 "multiBalanceReportWith" $-      generateMultiBalanceReport rspec j priceoracle colps startbals+      generateMultiBalanceReport rspec j priceoracle unelidableaccts colps startbals  -- | Generate a compound balance report from a list of CBCSubreportSpec. This -- shares postings between the subreports.@@ -143,11 +145,11 @@ compoundBalanceReportWith rspec' j priceoracle subreportspecs = cbr   where     -- Queries, report/column dates.-    reportspan = dbg3 "reportspan" $ reportSpan j rspec'-    rspec      = dbg3 "reportopts" $ makeReportQuery rspec' reportspan+    (reportspan, colspans) = reportSpan j rspec'+    rspec = dbg3 "reportopts" $ makeReportQuery rspec' reportspan      -- Group postings into their columns.-    colps = dbg5 "colps" $ getPostingsByColumn rspec j priceoracle reportspan+    colps = dbg5 "colps" $ getPostingsByColumn rspec j priceoracle colspans      -- The matched postings with a starting balance. All of these should appear     -- in the report, even if they have no postings during the report period.@@ -159,7 +161,7 @@             ( cbcsubreporttitle             -- Postprocess the report, negating balances and taking percentages if needed             , cbcsubreporttransform $-                generateMultiBalanceReport rspecsub j priceoracle colps' startbals'+                generateMultiBalanceReport rspecsub j priceoracle mempty colps' startbals'             , cbcsubreportincreasestotal             )           where@@ -169,8 +171,9 @@             ropts = cbcsubreportoptions $ _rsReportOpts rspec             rspecsub = rspec{_rsReportOpts=ropts, _rsQuery=And [q, _rsQuery rspec]}             -- Starting balances and column postings specific to this subreport.-            startbals' = startingBalances rspecsub j priceoracle $ filter (matchesPosting q) startps-            colps'     = map (second $ filter (matchesPosting q)) colps+            startbals' = startingBalances rspecsub j priceoracle $+              filter (matchesPostingExtra (journalAccountType j) q) startps+            colps' = map (second $ filter (matchesPostingExtra (journalAccountType j) q)) colps      -- Sum the subreport totals by column. Handle these cases:     -- - no subreports@@ -240,14 +243,13 @@     dateqcons        = if date2_ (_rsReportOpts rspec) then Date2 else Date  -- | Group postings, grouped by their column-getPostingsByColumn :: ReportSpec -> Journal -> PriceOracle -> DateSpan -> [(DateSpan, [Posting])]-getPostingsByColumn rspec j priceoracle reportspan =+getPostingsByColumn :: ReportSpec -> Journal -> PriceOracle -> [DateSpan] -> [(DateSpan, [Posting])]+getPostingsByColumn rspec j priceoracle colspans =     groupByDateSpan True getDate colspans ps   where     -- Postings matching the query within the report period.     ps = dbg5 "getPostingsByColumn" $ getPostings rspec j priceoracle     -- The date spans to be included as report columns.-    colspans = dbg3 "colspans" $ splitSpan (interval_ $ _rsReportOpts rspec) reportspan     getDate = postingDateOrDate2 (whichDate (_rsReportOpts rspec))  -- | Gather postings matching the query within the report period.@@ -257,7 +259,7 @@   where     rspec' = rspec{_rsQuery=depthless, _rsReportOpts = ropts'}     ropts' = if isJust (valuationAfterSum ropts)-        then ropts{value_=Nothing, cost_=NoCost}  -- If we're valuing after the sum, don't do it now+        then ropts{value_=Nothing, conversionop_=Just NoConversionOp}  -- If we're valuing after the sum, don't do it now         else ropts      -- The user's query with no depth limit, and expanded to the report span@@ -281,11 +283,15 @@     -- and the declared accounts are really only needed for the former,      -- but it's harmless to have them in the column changes as well.     ps' = ps ++ if declared_ then declaredacctps else []-      where -        declaredacctps = -          [nullposting{paccount=n} | n <- journalLeafAccountNamesDeclared j-                                   , acctq `matchesAccount` n]-          where acctq  = dbg3 "acctq" $ filterQueryOrNotQuery queryIsAcct query+      where+        declaredacctps =+          [nullposting{paccount=a}+          | a <- journalLeafAccountNamesDeclared j+          , matchesAccountExtra (journalAccountType j) (journalAccountTags j) accttypetagsq a+          ]+          where+            accttypetagsq  = dbg3 "accttypetagsq" $+              filterQueryOrNotQuery (\q -> queryIsAcct q || queryIsType q || queryIsTag q) query      filterbydepth = case accountlistmode_ of       ALTree -> filter ((depthq `matchesAccount`) . aname)    -- a tree - just exclude deeper accounts@@ -343,17 +349,17 @@ -- | 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 -> PriceOracle+generateMultiBalanceReport :: ReportSpec -> Journal -> PriceOracle -> Set AccountName                            -> [(DateSpan, [Posting])] -> HashMap AccountName Account                            -> MultiBalanceReport-generateMultiBalanceReport rspec@ReportSpec{_rsReportOpts=ropts} j priceoracle colps startbals =+generateMultiBalanceReport rspec@ReportSpec{_rsReportOpts=ropts} j priceoracle unelidableaccts colps startbals =     report   where     -- Process changes into normal, cumulative, or historical amounts, plus value them     matrix = calculateReportMatrix rspec j priceoracle startbals colps      -- All account names that will be displayed, possibly depth-clipped.-    displaynames = dbg5 "displaynames" $ displayedAccounts rspec matrix+    displaynames = dbg5 "displaynames" $ displayedAccounts rspec unelidableaccts matrix      -- All the rows of the report.     rows = dbg5 "rows" . (if invert_ ropts then map (fmap maNegate) else id)  -- Negate amounts if applicable@@ -394,9 +400,11 @@  -- | Calculate accounts which are to be displayed in the report, as well as -- their name and depth-displayedAccounts :: ReportSpec -> HashMap AccountName (Map DateSpan Account)+displayedAccounts :: ReportSpec+                  -> Set AccountName+                  -> HashMap AccountName (Map DateSpan Account)                   -> HashMap AccountName DisplayName-displayedAccounts ReportSpec{_rsQuery=query,_rsReportOpts=ropts} valuedaccts+displayedAccounts ReportSpec{_rsQuery=query,_rsReportOpts=ropts} unelidableaccts valuedaccts     | depth == 0 = HM.singleton "..." $ DisplayName "..." "..." 1     | otherwise  = HM.mapWithKey (\a _ -> displayedName a) displayedAccts   where@@ -421,7 +429,8 @@     -- Accounts interesting for their own sake     isInteresting name amts =         d <= depth                                 -- Throw out anything too deep-        && ( (empty_ ropts && keepWhenEmpty amts)  -- Keep empty accounts when called with --empty+        && ( name `Set.member` unelidableaccts     -- Unelidable accounts should be kept unless too deep+           ||(empty_ ropts && keepWhenEmpty amts)  -- Keep empty accounts when called with --empty            || not (isZeroRow balance amts)         -- Keep everything with a non-zero balance in the row            )       where@@ -432,7 +441,7 @@         balance = maybeStripPrices . case accountlistmode_ ropts of             ALTree | d == depth -> aibalance             _                   -> aebalance-          where maybeStripPrices = if show_costs_ ropts then id else mixedAmountStripPrices+          where maybeStripPrices = if conversionop_ ropts == Just NoConversionOp then id else mixedAmountStripPrices      -- Accounts interesting because they are a fork for interesting subaccounts     interestingParents = dbg5 "interestingParents" $ case accountlistmode_ ropts of

@@ -63,7 +63,7 @@ postingsReport :: ReportSpec -> Journal -> PostingsReport postingsReport rspec@ReportSpec{_rsReportOpts=ropts@ReportOpts{..}} j = items     where-      reportspan  = reportSpanBothDates j rspec+      (reportspan, colspans) = reportSpanBothDates j rspec       whichdate   = whichDate ropts       mdepth      = queryDepth $ _rsQuery rspec       multiperiod = interval_ /= NoInterval@@ -76,7 +76,7 @@         | multiperiod = [(p, Just period) | (p, period) <- summariseps reportps]         | otherwise   = [(p, Nothing) | p <- reportps]         where-          summariseps = summarisePostingsByInterval interval_ whichdate mdepth showempty reportspan+          summariseps = summarisePostingsByInterval whichdate mdepth showempty colspans           showempty = empty_ || average_        -- Posting report items ready for display.@@ -164,15 +164,12 @@ -- | Convert a list of postings into summary postings, one per interval, -- aggregated to the specified depth if any. -- Each summary posting will have a non-Nothing interval end date.-summarisePostingsByInterval :: Interval -> WhichDate -> Maybe Int -> Bool -> DateSpan -> [Posting] -> [SummaryPosting]-summarisePostingsByInterval interval wd mdepth showempty reportspan =+summarisePostingsByInterval :: WhichDate -> Maybe Int -> Bool -> [DateSpan] -> [Posting] -> [SummaryPosting]+summarisePostingsByInterval wd mdepth showempty colspans =     concatMap (\(s,ps) -> summarisePostingsInDateSpan s wd mdepth showempty ps)     -- Group postings into their columns. We try to be efficient, since     -- there can possibly be a very large number of intervals (cf #1683)     . groupByDateSpan showempty (postingDateOrDate2 wd) colspans-  where-    -- The date spans to be included as report columns.-    colspans = splitSpan interval reportspan  -- | Given a date span (representing a report interval) and a list of -- postings within it, aggregate the postings into one summary posting per@@ -332,14 +329,14 @@         let periodexpr `gives` dates = do               j' <- samplejournal               registerdates (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j') `is` dates-                  where opts = defreportopts{period_=maybePeriod date1 periodexpr}+                  where opts = defreportopts{period_=Just $ parsePeriodExpr' date1 periodexpr}         ""     `gives` ["2008/01/01","2008/06/01","2008/06/02","2008/06/03","2008/12/31"]         "2008" `gives` ["2008/01/01","2008/06/01","2008/06/02","2008/06/03","2008/12/31"]         "2007" `gives` []         "june" `gives` ["2008/06/01","2008/06/02","2008/06/03"]         "monthly" `gives` ["2008/01/01","2008/06/01","2008/12/01"]         "quarterly" `gives` ["2008/01/01","2008/04/01","2008/10/01"]-        let opts = defreportopts{period_=maybePeriod date1 "yearly"}+        let opts = defreportopts{period_=Just $ parsePeriodExpr' date1 "yearly"}         (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` unlines          ["2008/01/01 - 2008/12/31         assets:bank:saving               $1           $1"          ,"                                assets:cash                     $-2          $-1"@@ -349,9 +346,9 @@          ,"                                income:salary                   $-1          $-1"          ,"                                liabilities:debts                $1            0"          ]-        let opts = defreportopts{period_=maybePeriod date1 "quarterly"}+        let opts = defreportopts{period_=Just $ parsePeriodExpr' date1 "quarterly"}         registerdates (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` ["2008/01/01","2008/04/01","2008/10/01"]-        let opts = defreportopts{period_=maybePeriod date1 "quarterly",empty_=True}+        let opts = defreportopts{period_=Just $ parsePeriodExpr' date1 "quarterly",empty_=True}         registerdates (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` ["2008/01/01","2008/04/01","2008/07/01","2008/10/01"]        ]@@ -377,7 +374,7 @@     -}    ,testCase "summarisePostingsByInterval" $-    summarisePostingsByInterval (Quarters 1) PrimaryDate Nothing False (DateSpan Nothing Nothing) [] @?= []+    summarisePostingsByInterval PrimaryDate Nothing False [DateSpan Nothing Nothing] [] @?= []    -- ,tests_summarisePostingsInDateSpan = [     --  "summarisePostingsInDateSpan" ~: do

@@ -30,6 +30,7 @@   defreportopts,   rawOptsToReportOpts,   defreportspec,+  setDefaultConversionOp,   reportOptsToSpec,   updateReportSpec,   updateReportSpecWith,@@ -69,7 +70,7 @@ import Data.Either.Extra (eitherToMaybe) import Data.Functor.Identity (Identity(..)) import Data.List.Extra (find, isPrefixOf, nubSort)-import Data.Maybe (fromMaybe, mapMaybe)+import Data.Maybe (fromMaybe, isJust) import qualified Data.Text as T import Data.Time.Calendar (Day, addDays) import Data.Default (Default(..))@@ -124,7 +125,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?+    ,conversionop_     :: Maybe ConversionOp  -- ^ Which operation should we apply to conversion transactions?     ,value_            :: Maybe ValuationType  -- ^ What value should amounts be converted to ?     ,infer_prices_     :: Bool      -- ^ Infer market prices from transactions ?     ,depth_            :: Maybe Int@@ -180,7 +181,7 @@     { period_           = PeriodAll     , interval_         = NoInterval     , statuses_         = []-    , cost_             = NoCost+    , conversionop_     = Nothing     , value_            = Nothing     , infer_prices_     = False     , depth_            = Nothing@@ -223,7 +224,6 @@      let formatstring = T.pack <$> maybestringopt "format" rawopts         querystring  = map T.pack $ listofstringopt "args" rawopts  -- doesn't handle an arg like "" right-        (costing, valuation) = valuationTypeFromRawOpts rawopts         pretty = fromMaybe False $ alwaysneveropt "pretty" rawopts          format = case parseStringFormat <$> formatstring of@@ -235,8 +235,8 @@           {period_           = periodFromRawOpts d rawopts           ,interval_         = intervalFromRawOpts rawopts           ,statuses_         = statusesFromRawOpts rawopts-          ,cost_             = costing-          ,value_            = valuation+          ,conversionop_     = conversionOpFromRawOpts rawopts+          ,value_            = valuationTypeFromRawOpts rawopts           ,infer_prices_     = boolopt "infer-market-prices" rawopts           ,depth_            = maybeposintopt "depth" rawopts           ,date2_            = boolopt "date2" rawopts@@ -290,6 +290,11 @@     , _rsQueryOpts  = []     } +-- | Set the default ConversionOp.+setDefaultConversionOp :: ConversionOp -> ReportSpec -> ReportSpec+setDefaultConversionOp def rspec@ReportSpec{_rsReportOpts=ropts} =+    rspec{_rsReportOpts=ropts{conversionop_=conversionop_ ropts <|> Just def}}+ accountlistmodeopt :: RawOpts -> AccountListMode accountlistmodeopt =   fromMaybe ALFlat . choiceopt parse where@@ -469,39 +474,32 @@   | s `elem` ss = ropts{statuses_=filter (/= s) ss}   | otherwise   = ropts{statuses_=simplifyStatuses (s:ss)} --- | 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.--- This will fail with a usage error if an invalid argument is passed--- to --value, or if --valuechange is called with a valuation type--- other than -V/--value=end.-valuationTypeFromRawOpts :: RawOpts -> (Costing, Maybe ValuationType)-valuationTypeFromRawOpts rawopts = case (balancecalcopt rawopts, directcost, directval) of-    (CalcValueChange, _,      Nothing       ) -> (directcost, Just $ AtEnd Nothing)  -- If no valuation requested for valuechange, use AtEnd-    (CalcValueChange, _,      Just (AtEnd _)) -> (directcost, directval)             -- If AtEnd valuation requested, use it-    (CalcValueChange, _,      _             ) -> usageError "--valuechange only produces sensible results with --value=end"-    (CalcGain,        Cost,   _             ) -> usageError "--gain cannot be combined with --cost"-    (CalcGain,        NoCost, Nothing       ) -> (directcost, Just $ AtEnd Nothing)  -- If no valuation requested for gain, use AtEnd-    (_,               _,      _             ) -> (directcost, directval)             -- Otherwise, use requested valuation+-- | Parse the type of valuation to be performed, if any, specified by -V,+-- -X/--exchange, or --value flags. If there's more than one valuation type,+-- the rightmost flag wins. This will fail with a usage error if an invalid+-- argument is passed to --value, or if --valuechange is called with a+-- valuation type other than -V/--value=end.+valuationTypeFromRawOpts :: RawOpts -> Maybe ValuationType+valuationTypeFromRawOpts rawopts = case (balancecalcopt rawopts, directval) of+    (CalcValueChange, Nothing       ) -> Just $ AtEnd Nothing  -- If no valuation requested for valuechange, use AtEnd+    (CalcValueChange, Just (AtEnd _)) -> directval             -- If AtEnd valuation requested, use it+    (CalcValueChange, _             ) -> usageError "--valuechange only produces sensible results with --value=end"+    (CalcGain,        Nothing       ) -> Just $ AtEnd Nothing  -- If no valuation requested for gain, use AtEnd+    (_,               _             ) -> directval             -- Otherwise, use requested valuation   where-    directcost = if Cost `elem` map fst valuationopts then Cost else NoCost-    directval  = lastMay $ mapMaybe snd valuationopts--    valuationopts = collectopts valuationfromrawopt rawopts+    directval = lastMay $ collectopts valuationfromrawopt rawopts     valuationfromrawopt (n,v)  -- option name, value-      | 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+      | n == "V"     = Just $ AtEnd Nothing+      | n == "X"     = Just $ AtEnd (Just $ T.pack v)+      | n == "value" = valueopt v       | otherwise    = Nothing     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)+      | t `elem` ["cost","c"]  = AtEnd . Just <$> mc  -- keep supporting --value=cost,COMM for now+      | t `elem` ["then" ,"t"] = Just $ AtThen mc+      | t `elem` ["end" ,"e"]  = Just $ AtEnd  mc+      | t `elem` ["now" ,"n"]  = Just $ AtNow  mc       | otherwise = case parsedateM t of-            Just d  -> (NoCost, Just $ AtDate d mc)+            Just d  -> 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]@@ -510,6 +508,21 @@                    "" -> Nothing                    c  -> Just $ T.pack c +-- | Parse the type of costing to be performed, if any, specified by -B/--cost+-- or --value flags. If there's more than one costing type, the rightmost flag+-- wins. This will fail with a usage error if an invalid argument is passed to+-- --cost or if a costing type is requested with --gain.+conversionOpFromRawOpts :: RawOpts -> Maybe ConversionOp+conversionOpFromRawOpts rawopts+    | isJust costFlag && balancecalcopt rawopts == CalcGain = usageError "--gain cannot be combined with --cost"+    | otherwise = costFlag+  where+    costFlag = lastMay $ collectopts conversionopfromrawopt rawopts+    conversionopfromrawopt (n,v)  -- option name, value+      | n == "B"                                    = Just ToCost+      | n == "value", takeWhile (/=',') v `elem` ["cost", "c"] = Just ToCost  -- keep supporting --value=cost for now+      | otherwise                                   = Nothing+ -- | Select the Transaction date accessor based on --date2. transactionDateFn :: ReportOpts -> (Transaction -> Day) transactionDateFn ReportOpts{..} = if date2_ then transactionDate2 else tdate@@ -578,17 +591,15 @@   where     valuation p = maybe id (mixedAmountApplyValuation priceoracle styles (periodEnd p) (_rsDay rspec) (postingDate p)) (value_ ropts)     gain      p = maybe id (mixedAmountApplyGain      priceoracle styles (periodEnd p) (_rsDay rspec) (postingDate p)) (value_ ropts)-    costing = case cost_ ropts of-        Cost   -> journalToCost-        NoCost -> id+    costing     = journalToCost (fromMaybe NoConversionOp $ conversionop_ ropts)      -- Find the end of the period containing this posting     periodEnd  = addDays (-1) . fromMaybe err . mPeriodEnd . postingDate     mPeriodEnd = case interval_ ropts of-        NoInterval -> const . spanEnd $ reportSpan j rspec+        NoInterval -> const . spanEnd . fst $ reportSpan j rspec         _          -> spanEnd <=< latestSpanContaining (historical : spans)     historical = DateSpan Nothing $ spanStart =<< headMay spans-    spans = splitSpan (interval_ ropts) $ reportSpanBothDates j rspec+    spans = snd $ reportSpanBothDates j rspec     styles = journalCommodityStyles j     err = error "journalApplyValuationFromOpts: expected all spans to have an end date" @@ -605,9 +616,9 @@   where     valuation mc span = mixedAmountValueAtDate priceoracle styles mc (maybe err (addDays (-1)) $ spanEnd span)     gain mc span = mixedAmountGainAtDate priceoracle styles mc (maybe err (addDays (-1)) $ spanEnd span)-    costing = case cost_ ropts of-        Cost   -> styleMixedAmount styles . mixedAmountCost-        NoCost -> id+    costing = case fromMaybe NoConversionOp $ conversionop_ ropts of+        NoConversionOp -> id+        ToCost         -> styleMixedAmount styles . mixedAmountCost     styles = journalCommodityStyles j     err = error "mixedAmountApplyValuationAfterSumFromOptsWith: expected all spans to have an end date" @@ -642,18 +653,20 @@ -- 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.-reportSpan :: Journal -> ReportSpec -> DateSpan+-- Also return the intervals if they are requested.+reportSpan :: Journal -> ReportSpec -> (DateSpan, [DateSpan]) reportSpan = reportSpanHelper False  -- | Like reportSpan, but uses both primary and secondary dates when calculating -- the span.-reportSpanBothDates :: Journal -> ReportSpec -> DateSpan+reportSpanBothDates :: Journal -> ReportSpec -> (DateSpan, [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, _rsReportOpts=ropts} = reportspan+reportSpanHelper :: Bool -> Journal -> ReportSpec -> (DateSpan, [DateSpan])+reportSpanHelper bothdates j ReportSpec{_rsQuery=query, _rsReportOpts=ropts} =+    (reportspan, intervalspans)   where     -- 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@@ -677,10 +690,10 @@                                               (spanEnd =<< lastMay intervalspans)  reportStartDate :: Journal -> ReportSpec -> Maybe Day-reportStartDate j = spanStart . reportSpan j+reportStartDate j = spanStart . fst . reportSpan j  reportEndDate :: Journal -> ReportSpec -> Maybe Day-reportEndDate j = spanEnd . reportSpan j+reportEndDate j = spanEnd . fst . reportSpan j  -- Some pure alternatives to the above. XXX review/clean up 

@@ -169,15 +169,17 @@  isSingleQuoted :: Text -> Bool isSingleQuoted s =-  T.length (T.take 2 s) == 2 && T.head s == '\'' && T.last s == '\''+  T.length s >= 2 && T.head s == '\'' && T.last s == '\''  isDoubleQuoted :: Text -> Bool isDoubleQuoted s =-  T.length (T.take 2 s) == 2 && T.head s == '"' && T.last s == '"'+  T.length s >= 2 && T.head s == '"' && T.last s == '"'  textUnbracket :: Text -> Text textUnbracket s-    | (T.head s == '[' && T.last s == ']') || (T.head s == '(' && T.last s == ')') = T.init $ T.tail s+    | T.null s = s+    | T.head s == '[' && T.last s == ']' = T.init $ T.tail s+    | T.head s == '(' && T.last s == ')' = T.init $ T.tail s     | otherwise = s  -- | Join several multi-line strings as side-by-side rectangular strings of the same height, top-padded.

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           hledger-lib-version:        1.24.99+version:        1.25 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