imp: queries: Allow regular expression depth queries
Previously depth-limiting was universal across all accounts, e.g. all accounts are clipped to depth 2. However, sometimes you want certain accounts clipped to a different depth than others, e.g. all expenses to depth 3, while all assets to depth 2. This commit enables depth-limiting to optionally include a regular expression, which limits the accounts it applies to. More than one depth limit can be passed, and they are applied to each account name by the following rules: - If one or more regular-expression depth limit applies, use the most specific one - If no regular-expression depth limits apply, and a flat depth limit is supplied, use that - Otherwise, do not do any depth limiting For example, this will clip all accounts matching "assets" to depth 3, all accounts matching "expenses" to depth 2, and all other accounts to depth 1. --depth assets=3 --depth expenses=2 --depth 1
This commit is contained in:
Stephen Morgan
Simon Michael
parent
436b2ab3fb
commit
74f0f37fb3
@ -175,11 +175,11 @@ clipAccounts d a = a{asubs=subs}
|
||||
-- | Remove subaccounts below the specified depth, aggregating their balance at the depth limit
|
||||
-- (accounts at the depth limit will have any sub-balances merged into their exclusive balance).
|
||||
-- If the depth is Nothing, return the original accounts
|
||||
clipAccountsAndAggregate :: Maybe Int -> [Account] -> [Account]
|
||||
clipAccountsAndAggregate Nothing as = as
|
||||
clipAccountsAndAggregate (Just d) as = combined
|
||||
clipAccountsAndAggregate :: DepthSpec -> [Account] -> [Account]
|
||||
clipAccountsAndAggregate (DepthSpec Nothing []) as = as
|
||||
clipAccountsAndAggregate d as = combined
|
||||
where
|
||||
clipped = [a{aname=clipOrEllipsifyAccountName (Just d) $ aname a} | a <- as]
|
||||
clipped = [a{aname=clipOrEllipsifyAccountName d $ aname a} | a <- as]
|
||||
combined = [a{aebalance=maSum $ map aebalance same}
|
||||
| same@(a:_) <- groupOn aname clipped]
|
||||
{-
|
||||
|
||||
@ -35,6 +35,7 @@ module Hledger.Data.AccountName (
|
||||
,acctsepchar
|
||||
,clipAccountName
|
||||
,clipOrEllipsifyAccountName
|
||||
,getAccountNameClippedDepth
|
||||
,elideAccountName
|
||||
,escapeName
|
||||
,expandAccountName
|
||||
@ -61,9 +62,10 @@ where
|
||||
|
||||
import Control.Applicative ((<|>))
|
||||
import Control.Monad (foldM)
|
||||
import Data.Foldable (asum, toList)
|
||||
import Data.Foldable (asum, find, toList)
|
||||
import qualified Data.List.NonEmpty as NE
|
||||
import qualified Data.Map as M
|
||||
import Data.Maybe (mapMaybe)
|
||||
import Data.MemoUgly (memo)
|
||||
import qualified Data.Set as S
|
||||
import Data.Text (Text)
|
||||
@ -335,18 +337,54 @@ elideAccountName width s
|
||||
| otherwise = done++ss
|
||||
|
||||
-- | Keep only the first n components of an account name, where n
|
||||
-- is a positive integer. If n is Just 0, returns the empty string, if n is
|
||||
-- Nothing, return the full name.
|
||||
clipAccountName :: Maybe Int -> AccountName -> AccountName
|
||||
clipAccountName Nothing = id
|
||||
clipAccountName (Just n) = accountNameFromComponents . take n . accountNameComponents
|
||||
-- is a positive integer.
|
||||
clipAccountNameTo :: Int -> AccountName -> AccountName
|
||||
clipAccountNameTo n = accountNameFromComponents . take n . accountNameComponents
|
||||
|
||||
-- | Keep only the first n components of an account name, where n
|
||||
-- is a positive integer. If n is Just 0, returns "...", if n is Nothing, return
|
||||
-- the full name.
|
||||
clipOrEllipsifyAccountName :: Maybe Int -> AccountName -> AccountName
|
||||
clipOrEllipsifyAccountName (Just 0) = const "..."
|
||||
clipOrEllipsifyAccountName n = clipAccountName n
|
||||
-- | Calculate the depth to which an account name should be clipped for a given
|
||||
-- 'DepthSpec'.
|
||||
--
|
||||
-- First checking whether the account name matches any of the regular
|
||||
-- expressions controlling depth. If so, clip to the depth of the most specific
|
||||
-- of those matches, i.e. the one which starts matching the latest as you
|
||||
-- progress up the parents of the account. Otherwise clip to the flat depth
|
||||
-- provided, or return the full name if Nothing.
|
||||
getAccountNameClippedDepth :: DepthSpec -> AccountName -> Maybe Int
|
||||
getAccountNameClippedDepth (DepthSpec flat regexps) acctName =
|
||||
mostSpecificRegexp regexps <|> flat
|
||||
where
|
||||
-- If any regular expressions match, choose the one with the greatest
|
||||
-- specificity and clip to that depth.
|
||||
mostSpecificRegexp = fmap snd . foldr takeMax Nothing . mapMaybe matchRegexp
|
||||
where
|
||||
-- If two regexps match, take the most specific one. If there is a tie,
|
||||
-- take the last one (this aligns with the behaviour for flat depths
|
||||
-- limiting).
|
||||
takeMax (s, d) (Just (s', d')) = Just $ if s'>= s then (s', d') else (s, d)
|
||||
takeMax (s, d) Nothing = Just (s, d)
|
||||
|
||||
-- If the regular expression matches the account name, store the specificity and requested depth
|
||||
matchRegexp :: (Regexp, Int) -> Maybe (Int, Int)
|
||||
matchRegexp (r, d) = if regexMatchText r acctName then Just (getSpecificity r, d) else Nothing
|
||||
-- Specificity is the smallest parent of the account which matches the regular expression
|
||||
getSpecificity r = maybe maxBound fst $ find (regexMatchText r . snd) acctParents
|
||||
acctParents = zip [1..] . initDef [] $ expandAccountName acctName
|
||||
|
||||
-- | Clip an account name to a given 'DepthSpec', first checking whether it
|
||||
-- matches any of the regular expressions controlling depth. If so, clip to the
|
||||
-- depth of the most specific of those matches, i.e. the one which starts
|
||||
-- matching the latest as you progress up the parents of the account. Otherwise
|
||||
-- clip to the flat depth provided, or return the full name if Nothing.
|
||||
clipAccountName :: DepthSpec -> AccountName -> AccountName
|
||||
clipAccountName ds a = maybe id clipAccountNameTo (getAccountNameClippedDepth ds a) a
|
||||
|
||||
-- | As 'clipAccountName', but return '...' if asked to clip to depth 0.
|
||||
clipOrEllipsifyAccountName :: DepthSpec -> AccountName -> AccountName
|
||||
clipOrEllipsifyAccountName ds a = go (getAccountNameClippedDepth ds a)
|
||||
where
|
||||
go Nothing = a
|
||||
go (Just 0) = "..."
|
||||
go (Just n) = clipAccountNameTo n a
|
||||
|
||||
-- | Escape an AccountName for use within a regular expression.
|
||||
-- >>> putStr . T.unpack $ escapeName "First?!#$*?$(*) !@^#*? %)*!@#"
|
||||
|
||||
@ -44,6 +44,7 @@ import Data.List (intercalate, sortBy)
|
||||
--The stored values don't represent large virtual data structures to be lazily computed.
|
||||
import qualified Data.Map as M
|
||||
import Data.Ord (comparing)
|
||||
import Data.Semigroup (Min(..))
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import Data.Time.Calendar (Day)
|
||||
@ -156,6 +157,19 @@ type Payee = Text
|
||||
|
||||
type AccountName = Text
|
||||
|
||||
-- A specification indicating how to depth-limit
|
||||
data DepthSpec = DepthSpec {
|
||||
dsFlatDepth :: Maybe Int,
|
||||
dsRegexpDepths :: [(Regexp, Int)]
|
||||
} deriving (Eq,Show)
|
||||
|
||||
-- Semigroup instance consider all regular expressions, but take the minimum of the simple flat depths
|
||||
instance Semigroup DepthSpec where
|
||||
DepthSpec d1 l1 <> DepthSpec d2 l2 = DepthSpec (getMin <$> (Min <$> d1) <> (Min <$> d2)) (l1 ++ l2)
|
||||
|
||||
instance Monoid DepthSpec where
|
||||
mempty = DepthSpec Nothing []
|
||||
|
||||
data AccountType =
|
||||
Asset
|
||||
| Liability
|
||||
|
||||
@ -23,6 +23,7 @@ module Hledger.Query (
|
||||
parseQueryList,
|
||||
parseQueryTerm,
|
||||
parseAccountType,
|
||||
parseDepthSpec,
|
||||
-- * modifying
|
||||
simplifyQuery,
|
||||
filterQuery,
|
||||
@ -82,7 +83,7 @@ import Data.Maybe (fromMaybe, isJust, mapMaybe)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import Data.Time.Calendar (Day, fromGregorian )
|
||||
import Safe (headErr, readDef, readMay, maximumByMay, maximumMay, minimumMay)
|
||||
import Safe (headErr, readMay, maximumByMay, maximumMay, minimumMay)
|
||||
import Text.Megaparsec (between, noneOf, sepBy, try, (<?>), notFollowedBy)
|
||||
import Text.Megaparsec.Char (char, string, string')
|
||||
|
||||
@ -116,6 +117,7 @@ data Query =
|
||||
| Acct Regexp -- ^ match account names infix-matched by this regexp
|
||||
| Type [AccountType] -- ^ match accounts whose type is one of these (or with no types, any account)
|
||||
| Depth Int -- ^ match if account depth is less than or equal to this value (or, sometimes used as a display option)
|
||||
| DepthAcct Regexp Int -- ^ match if the account matches and account depth is less than or equal to this value (usually used as a display option)
|
||||
| Real Bool -- ^ match postings with this "realness" value
|
||||
| Amt OrdPlus Quantity -- ^ match if the amount's numeric quantity is less than/greater than/equal to/unsignedly equal to some value
|
||||
| Sym Regexp -- ^ match if the commodity symbol is fully-matched by this regexp
|
||||
@ -301,11 +303,7 @@ parseQueryTerm _ (T.stripPrefix "status:" -> Just s) =
|
||||
Right st -> Right (StatusQ st, [])
|
||||
parseQueryTerm _ (T.stripPrefix "real:" -> Just s) = Right (Real $ parseBool s || T.null s, [])
|
||||
parseQueryTerm _ (T.stripPrefix "amt:" -> Just s) = Right (Amt ord q, []) where (ord, q) = either error id $ parseAmountQueryTerm s -- PARTIAL:
|
||||
parseQueryTerm _ (T.stripPrefix "depth:" -> Just s)
|
||||
| n >= 0 = Right (Depth n, [])
|
||||
| otherwise = Left "depth: should have a positive number"
|
||||
where n = readDef 0 (T.unpack s)
|
||||
|
||||
parseQueryTerm _ (T.stripPrefix "depth:" -> Just s) = (,[]) <$> parseDepthSpecQuery s
|
||||
parseQueryTerm _ (T.stripPrefix "cur:" -> Just s) = (,[]) . Sym <$> toRegexCI ("^" <> s <> "$") -- support cur: as an alias
|
||||
parseQueryTerm _ (T.stripPrefix "tag:" -> Just s) = (,[]) <$> parseTag s
|
||||
parseQueryTerm _ (T.stripPrefix "type:" -> Just s) = (,[]) <$> parseTypeCodes s
|
||||
@ -473,6 +471,25 @@ parseTag s = do
|
||||
return $ Tag tag body
|
||||
where (n,v) = T.break (=='=') s
|
||||
|
||||
parseDepthSpec :: T.Text -> Either RegexError DepthSpec
|
||||
parseDepthSpec s = do
|
||||
let depthString = T.unpack $ if T.null b then a else T.tail b
|
||||
depth <- case readMay depthString of
|
||||
Just d | d >= 0 -> Right d
|
||||
_ -> Left $ "depth: should be a positive number, but received " ++ depthString
|
||||
regexp <- mapM toRegexCI $ if T.null b then Nothing else Just a
|
||||
return $ case regexp of
|
||||
Nothing -> DepthSpec (Just depth) []
|
||||
Just r -> DepthSpec Nothing [(r, depth)]
|
||||
where
|
||||
(a,b) = T.break (=='=') s
|
||||
|
||||
parseDepthSpecQuery :: T.Text -> Either RegexError Query
|
||||
parseDepthSpecQuery s = do
|
||||
DepthSpec flat rs <- parseDepthSpec s
|
||||
let regexps = map (uncurry DepthAcct) rs
|
||||
return . And $ maybe id (\d -> (Depth d :)) flat regexps
|
||||
|
||||
-- | Parse one or more account type code letters to a query matching any of those types.
|
||||
parseTypeCodes :: T.Text -> Either String Query
|
||||
parseTypeCodes s =
|
||||
@ -639,6 +656,7 @@ queryIsType _ = False
|
||||
|
||||
queryIsDepth :: Query -> Bool
|
||||
queryIsDepth (Depth _) = True
|
||||
queryIsDepth (DepthAcct _ _) = True
|
||||
queryIsDepth _ = False
|
||||
|
||||
queryIsReal :: Query -> Bool
|
||||
@ -749,13 +767,12 @@ latestMaybeDate' = fromMaybe Nothing . maximumByMay compareNothingMax
|
||||
compareNothingMax (Just a) (Just b) = compare a b
|
||||
|
||||
-- | The depth limit this query specifies, if it has one
|
||||
queryDepth :: Query -> Maybe Int
|
||||
queryDepth = minimumMay . queryDepth'
|
||||
where
|
||||
queryDepth' (Depth d) = [d]
|
||||
queryDepth' (Or qs) = concatMap queryDepth' qs
|
||||
queryDepth' (And qs) = concatMap queryDepth' qs
|
||||
queryDepth' _ = []
|
||||
queryDepth :: Query -> DepthSpec
|
||||
queryDepth (Or qs) = foldMap queryDepth qs
|
||||
queryDepth (And qs) = foldMap queryDepth qs
|
||||
queryDepth (Depth d) = DepthSpec (Just d) []
|
||||
queryDepth (DepthAcct r d) = DepthSpec Nothing [(r,d)]
|
||||
queryDepth _ = mempty
|
||||
|
||||
-- | The account we are currently focussed on, if any, and whether subaccounts are included.
|
||||
-- Just looks at the first query option.
|
||||
@ -819,6 +836,7 @@ 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 (DepthAcct r d) a = accountNameLevel a <= d || not (regexMatchText r a)
|
||||
matchesAccount (Tag _ _) _ = False
|
||||
matchesAccount _ _ = True
|
||||
|
||||
@ -855,6 +873,7 @@ matchesPosting (Date2 spn) p = spn `spanContainsDate` postingDate2 p
|
||||
matchesPosting (StatusQ s) p = postingStatus p == s
|
||||
matchesPosting (Real v) p = v == isReal p
|
||||
matchesPosting q@(Depth _) Posting{paccount=a} = q `matchesAccount` a
|
||||
matchesPosting q@(DepthAcct _ _) Posting{paccount=a} = q `matchesAccount` a
|
||||
matchesPosting q@(Amt _ _) Posting{pamount=as} = q `matchesMixedAmount` as
|
||||
matchesPosting (Sym r) Posting{pamount=as} = any (matchesCommodity (Sym r) . acommodity) $ amountsRaw as
|
||||
matchesPosting (Tag n v) p = case (reString n, v) of
|
||||
@ -897,7 +916,8 @@ matchesTransaction (Date2 spn) t = spanContainsDate spn $ transactionDate2 t
|
||||
matchesTransaction (StatusQ s) t = tstatus t == s
|
||||
matchesTransaction (Real v) t = v == hasRealPostings t
|
||||
matchesTransaction q@(Amt _ _) t = any (q `matchesPosting`) $ tpostings t
|
||||
matchesTransaction (Depth d) t = any (Depth d `matchesPosting`) $ tpostings t
|
||||
matchesTransaction q@(Depth _) t = any (q `matchesPosting`) $ tpostings t
|
||||
matchesTransaction q@(DepthAcct _ _) t = any (q `matchesPosting`) $ tpostings t
|
||||
matchesTransaction q@(Sym _) t = any (q `matchesPosting`) $ tpostings t
|
||||
matchesTransaction (Tag n v) t = case (reString n, v) of
|
||||
("payee", Just v') -> regexMatchText v' $ transactionPayee t
|
||||
|
||||
@ -149,7 +149,7 @@ tests_BalanceReport = testGroup "BalanceReport" [
|
||||
mixedAmount (usd 0))
|
||||
|
||||
,testCase "with --depth=N" $
|
||||
(defreportspec{_rsReportOpts=defreportopts{depth_=Just 1}}, samplejournal) `gives`
|
||||
(defreportspec{_rsReportOpts=defreportopts{depth_=DepthSpec (Just 1) []}}, samplejournal) `gives`
|
||||
([
|
||||
("expenses", "expenses", 0, mixedAmount (usd 2))
|
||||
,("income", "income", 0, mixedAmount (usd (-2)))
|
||||
@ -222,7 +222,7 @@ tests_BalanceReport = testGroup "BalanceReport" [
|
||||
]
|
||||
|
||||
,testCase "accounts report with account pattern o and --depth 1" ~:
|
||||
defreportopts{patterns_=["o"],depth_=Just 1} `gives`
|
||||
defreportopts{patterns_=["o"],depth_=(Just 1, [])} `gives`
|
||||
[" $1 expenses"
|
||||
," $-2 income"
|
||||
,"--------------------"
|
||||
|
||||
@ -289,10 +289,12 @@ acctChanges ReportSpec{_rsQuery=query,_rsReportOpts=ReportOpts{accountlistmode_,
|
||||
filterQueryOrNotQuery (\q -> queryIsAcct q || queryIsType q || queryIsTag q) query
|
||||
|
||||
filterbydepth = case accountlistmode_ of
|
||||
ALTree -> filter ((depthq `matchesAccount`) . aname) -- a tree - just exclude deeper accounts
|
||||
ALFlat -> clipAccountsAndAggregate (queryDepth depthq) -- a list - aggregate deeper accounts at the depth limit
|
||||
ALTree -> filter (depthMatches . aname) -- a tree - just exclude deeper accounts
|
||||
ALFlat -> clipAccountsAndAggregate depthSpec -- a list - aggregate deeper accounts at the depth limit
|
||||
. filter ((0<) . anumpostings) -- and exclude empty parent accounts
|
||||
where depthq = dbg3 "depthq" $ filterQuery queryIsDepth query
|
||||
where
|
||||
depthSpec = dbg3 "depthq" . queryDepth $ filterQuery queryIsDepth query
|
||||
depthMatches name = maybe True (accountNameLevel name <=) $ getAccountNameClippedDepth depthSpec name
|
||||
|
||||
accts = filterbydepth $ drop 1 $ accountsFromPostings ps'
|
||||
|
||||
@ -409,7 +411,7 @@ displayedAccounts :: ReportSpec
|
||||
-> HashMap AccountName (Map DateSpan Account)
|
||||
-> HashMap AccountName DisplayName
|
||||
displayedAccounts ReportSpec{_rsQuery=query,_rsReportOpts=ropts} unelidableaccts valuedaccts
|
||||
| qdepth == 0 = HM.singleton "..." $ DisplayName "..." "..." 0
|
||||
| qdepthIsZero = HM.singleton "..." $ DisplayName "..." "..." 0
|
||||
| otherwise = HM.mapWithKey (\a _ -> displayedName a) displayedAccts
|
||||
where
|
||||
displayedName name = case accountlistmode_ ropts of
|
||||
@ -425,7 +427,7 @@ displayedAccounts ReportSpec{_rsQuery=query,_rsReportOpts=ropts} unelidableaccts
|
||||
notDisplayed = not . (`HM.member` displayedAccts)
|
||||
|
||||
-- Accounts which are to be displayed
|
||||
displayedAccts = (if qdepth == 0 then id else HM.filterWithKey keep) valuedaccts
|
||||
displayedAccts = (if qdepthIsZero then id else HM.filterWithKey keep) valuedaccts
|
||||
where
|
||||
keep name amts = isInteresting name amts || name `HM.member` interestingParents
|
||||
|
||||
@ -438,6 +440,7 @@ displayedAccounts ReportSpec{_rsQuery=query,_rsReportOpts=ropts} unelidableaccts
|
||||
)
|
||||
where
|
||||
d = accountNameLevel name
|
||||
qdepth = fromMaybe maxBound $ getAccountNameClippedDepth depthspec name
|
||||
keepWhenEmpty = case accountlistmode_ ropts of
|
||||
ALFlat -> const True -- Keep all empty accounts in flat mode
|
||||
ALTree -> all (null . asubs) -- Keep only empty leaves in tree mode
|
||||
@ -455,7 +458,8 @@ displayedAccounts ReportSpec{_rsQuery=query,_rsReportOpts=ropts} unelidableaccts
|
||||
minSubs = if no_elide_ ropts then 1 else 2
|
||||
|
||||
isZeroRow balance = all (mixedAmountLooksZero . balance)
|
||||
qdepth = fromMaybe maxBound $ queryDepth query
|
||||
depthspec = queryDepth query
|
||||
qdepthIsZero = depthspec == DepthSpec (Just 0) []
|
||||
numSubs = subaccountTallies . HM.keys $ HM.filterWithKey isInteresting valuedaccts
|
||||
|
||||
-- | Sort the rows by amount or by account declaration order.
|
||||
|
||||
@ -71,7 +71,7 @@ postingsReport rspec@ReportSpec{_rsReportOpts=ropts@ReportOpts{..}} j = items
|
||||
where
|
||||
(reportspan, colspans) = reportSpanBothDates j rspec
|
||||
whichdate = whichDate ropts
|
||||
mdepth = queryDepth $ _rsQuery rspec
|
||||
depthSpec = queryDepth $ _rsQuery rspec
|
||||
multiperiod = interval_ /= NoInterval
|
||||
|
||||
-- postings to be included in the report, and similarly-matched postings before the report start date
|
||||
@ -82,7 +82,7 @@ postingsReport rspec@ReportSpec{_rsReportOpts=ropts@ReportOpts{..}} j = items
|
||||
| multiperiod = [(p', Just period') | (p', period') <- summariseps reportps]
|
||||
| otherwise = [(p', Nothing) | p' <- reportps]
|
||||
where
|
||||
summariseps = summarisePostingsByInterval whichdate mdepth showempty colspans
|
||||
summariseps = summarisePostingsByInterval whichdate (dsFlatDepth depthSpec) showempty colspans
|
||||
showempty = empty_ || average_
|
||||
|
||||
sortedps = if sortspec_ /= defsortspec then sortPostings ropts sortspec_ displayps else displayps
|
||||
@ -90,7 +90,7 @@ postingsReport rspec@ReportSpec{_rsReportOpts=ropts@ReportOpts{..}} j = items
|
||||
-- Posting report items ready for display.
|
||||
items =
|
||||
dbg4 "postingsReport items" $
|
||||
postingsReportItems postings (nullposting,Nothing) whichdate mdepth startbal runningcalc startnum
|
||||
postingsReportItems postings (nullposting,Nothing) whichdate depthSpec startbal runningcalc startnum
|
||||
where
|
||||
-- In historical mode we'll need a starting balance, which we
|
||||
-- may be converting to value per hledger_options.m4.md "Effect
|
||||
@ -180,7 +180,7 @@ matchedPostingsBeforeAndDuring rspec@ReportSpec{_rsReportOpts=ropts,_rsQuery=q}
|
||||
|
||||
-- | Generate postings report line items from a list of postings or (with
|
||||
-- non-Nothing periods attached) summary postings.
|
||||
postingsReportItems :: [(Posting,Maybe Period)] -> (Posting,Maybe Period) -> WhichDate -> Maybe Int -> MixedAmount -> (Int -> MixedAmount -> MixedAmount -> MixedAmount) -> Int -> [PostingsReportItem]
|
||||
postingsReportItems :: [(Posting,Maybe Period)] -> (Posting,Maybe Period) -> WhichDate -> DepthSpec -> MixedAmount -> (Int -> MixedAmount -> MixedAmount -> MixedAmount) -> Int -> [PostingsReportItem]
|
||||
postingsReportItems [] _ _ _ _ _ _ = []
|
||||
postingsReportItems ((p,mperiod):ps) (pprev,mperiodprev) wd d b runningcalcfn itemnum =
|
||||
i:(postingsReportItems ps (p,mperiod) wd d b' runningcalcfn (itemnum+1))
|
||||
@ -237,7 +237,7 @@ summarisePostingsInDateSpan spn@(DateSpan b e) wd mdepth showempty ps
|
||||
postingdate = if wd == PrimaryDate then postingDate else postingDate2
|
||||
b' = maybe (maybe nulldate postingdate $ headMay ps) fromEFDay b
|
||||
summaryp = nullposting{pdate=Just b'}
|
||||
clippedanames = nub $ map (clipAccountName mdepth) anames
|
||||
clippedanames = nub $ map (clipAccountName (DepthSpec mdepth [])) anames
|
||||
summaryps | mdepth == Just 0 = [summaryp{paccount="...",pamount=sumPostings ps}]
|
||||
| otherwise = [summaryp{paccount=a,pamount=balance a} | a <- clippedanames]
|
||||
summarypes = map (, dateSpanAsPeriod spn) $ (if showempty then id else filter (not . mixedAmountLooksZero . pamount)) summaryps
|
||||
|
||||
@ -75,6 +75,7 @@ import Data.Char (toLower)
|
||||
import Data.Either (fromRight)
|
||||
import Data.Either.Extra (eitherToMaybe)
|
||||
import Data.Functor.Identity (Identity(..))
|
||||
import Data.List (partition)
|
||||
import Data.List.Extra (find, isPrefixOf, nubSort, stripPrefix)
|
||||
import Data.Maybe (fromMaybe, isJust, isNothing)
|
||||
import qualified Data.Text as T
|
||||
@ -134,7 +135,7 @@ data ReportOpts = ReportOpts {
|
||||
,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
|
||||
,depth_ :: DepthSpec
|
||||
,date2_ :: Bool
|
||||
,empty_ :: Bool
|
||||
,no_elide_ :: Bool
|
||||
@ -194,7 +195,7 @@ defreportopts = ReportOpts
|
||||
, conversionop_ = Nothing
|
||||
, value_ = Nothing
|
||||
, infer_prices_ = False
|
||||
, depth_ = Nothing
|
||||
, depth_ = DepthSpec Nothing []
|
||||
, date2_ = False
|
||||
, empty_ = False
|
||||
, no_elide_ = False
|
||||
@ -251,7 +252,7 @@ rawOptsToReportOpts d usecoloronstdout rawopts =
|
||||
,conversionop_ = conversionOpFromRawOpts rawopts
|
||||
,value_ = valuationTypeFromRawOpts rawopts
|
||||
,infer_prices_ = boolopt "infer-market-prices" rawopts
|
||||
,depth_ = maybeposintopt "depth" rawopts
|
||||
,depth_ = depthFromRawOpts rawopts
|
||||
,date2_ = boolopt "date2" rawopts
|
||||
,empty_ = boolopt "empty" rawopts
|
||||
,no_elide_ = boolopt "no-elide" rawopts
|
||||
@ -541,6 +542,21 @@ conversionOpFromRawOpts rawopts
|
||||
| n == "value", takeWhile (/=',') v `elem` ["cost", "c"] = Just ToCost -- keep supporting --value=cost for now
|
||||
| otherwise = Nothing
|
||||
|
||||
-- | Parse the depth arguments. This can be either a flat depth that applies to
|
||||
-- all accounts, or a regular expression and depth, which only matches certain
|
||||
-- accounts. If an account name is matched by a regular expression, then the
|
||||
-- smallest depth is used. Otherwise, if no regular expressions match, then the
|
||||
-- flat depth is used. If more than one flat depth is supplied, use only the
|
||||
-- last one.
|
||||
depthFromRawOpts :: RawOpts -> DepthSpec
|
||||
depthFromRawOpts rawopts = lastDef mempty flats <> mconcat regexps
|
||||
where
|
||||
(flats, regexps) = partition (\(DepthSpec f rs) -> isJust f && null rs) depthSpecs
|
||||
depthSpecs = case mapM (parseDepthSpec . T.pack) depths of
|
||||
Right d -> d
|
||||
Left err -> usageError $ "Unable to parse depth specification: " ++ err
|
||||
depths = listofstringopt "depth" rawopts
|
||||
|
||||
-- | Select the Transaction date accessor based on --date2.
|
||||
transactionDateFn :: ReportOpts -> (Transaction -> Day)
|
||||
transactionDateFn ReportOpts{..} = if date2_ then transactionDate2 else tdate
|
||||
@ -667,11 +683,13 @@ queryFromFlags :: ReportOpts -> Query
|
||||
queryFromFlags ReportOpts{..} = simplifyQuery $ And flagsq
|
||||
where
|
||||
flagsq = consIf Real real_
|
||||
. consJust Depth depth_
|
||||
$ [ (if date2_ then Date2 else Date) $ periodAsDateSpan period_
|
||||
. consJust Depth flatDepth
|
||||
$ map (uncurry DepthAcct) regexpDepths
|
||||
++ [ (if date2_ then Date2 else Date) $ periodAsDateSpan period_
|
||||
, Or $ map StatusQ statuses_
|
||||
]
|
||||
consIf f b = if b then (f True:) else id
|
||||
DepthSpec flatDepth regexpDepths = depth_
|
||||
consJust f = maybe id ((:) . f)
|
||||
|
||||
-- Methods/types needed for --sort argument
|
||||
@ -891,7 +909,7 @@ class HasReportOptsNoUpdate a => HasReportOpts a where
|
||||
statuses = reportOpts.statusesNoUpdate
|
||||
{-# INLINE statuses #-}
|
||||
|
||||
depth :: ReportableLens' a (Maybe Int)
|
||||
depth :: ReportableLens' a DepthSpec
|
||||
depth = reportOpts.depthNoUpdate
|
||||
{-# INLINE depth #-}
|
||||
|
||||
|
||||
@ -98,7 +98,7 @@ aregister opts@CliOpts{rawopts_=rawopts,reportspec_=rspec} j = do
|
||||
thisacctq = Acct $ (if inclusive then accountNameToAccountRegex else accountNameToAccountOnlyRegex) acct
|
||||
ropts' = (_rsReportOpts rspec) {
|
||||
-- ignore any depth limit, as in postingsReport; allows register's total to match balance reports (cf #1468)
|
||||
depth_=Nothing
|
||||
depth_=DepthSpec Nothing []
|
||||
, balanceaccum_ =
|
||||
case balanceaccum_ $ _rsReportOpts rspec of
|
||||
PerPeriod -> Historical
|
||||
|
||||
@ -7,11 +7,35 @@ $ hledger -f sample.journal balance --no-total --depth 1
|
||||
$-2 income
|
||||
$1 liabilities
|
||||
|
||||
# ** 2. Depth 0 aggregates everything into one line
|
||||
# ** 2. If more than one flat depth, take the later one, when the later is smaller
|
||||
$ hledger -f sample.journal balance --no-total --depth 2 --depth 1
|
||||
$-1 assets
|
||||
$2 expenses
|
||||
$-2 income
|
||||
$1 liabilities
|
||||
|
||||
# ** 3. If more than one flat depth, take the later one, when the later is bigger
|
||||
$ hledger -f sample.journal balance --no-total --depth 1 --depth 2
|
||||
$1 assets:bank
|
||||
$-2 assets:cash
|
||||
$1 expenses:food
|
||||
$1 expenses:supplies
|
||||
$-1 income:gifts
|
||||
$-1 income:salary
|
||||
$1 liabilities:debts
|
||||
|
||||
# ** 4. If more than one flat depth when supplied with query terms, take the smaller one, even if it's not last
|
||||
$ hledger -f sample.journal balance --no-total depth:1 depth:2
|
||||
$-1 assets
|
||||
$2 expenses
|
||||
$-2 income
|
||||
$1 liabilities
|
||||
|
||||
# ** 5. Depth 0 aggregates everything into one line
|
||||
$ hledger -f sample.journal balance --no-total --depth 0 assets
|
||||
$-1 ...
|
||||
|
||||
# ** 3. Ditto in a multi-column balance report.
|
||||
# ** 6. Ditto in a multi-column balance report.
|
||||
$ hledger -f sample.journal balance -M -e 2008/2 --depth 0 assets
|
||||
Balance changes in 2008-01:
|
||||
|
||||
@ -20,3 +44,50 @@ Balance changes in 2008-01:
|
||||
... || $1
|
||||
-----++-----
|
||||
|| $1
|
||||
|
||||
# ** 7. Aggregate at different levels for regular expressions
|
||||
$ hledger -f sample.journal balance --no-total --depth assets=1 --depth 2
|
||||
$-1 assets
|
||||
$1 expenses:food
|
||||
$1 expenses:supplies
|
||||
$-1 income:gifts
|
||||
$-1 income:salary
|
||||
$1 liabilities:debts
|
||||
|
||||
# ** 8. If two regexps match, use the more specific one
|
||||
$ hledger -f sample.journal balance --no-total --depth assets:bank=2 --depth assets=1 assets
|
||||
$-2 assets
|
||||
$1 assets:bank
|
||||
|
||||
# ** 9. If a regexp matches, don't use the flat depth
|
||||
$ hledger -f sample.journal balance --no-total --depth assets=2 --depth 1
|
||||
$1 assets:bank
|
||||
$-2 assets:cash
|
||||
$2 expenses
|
||||
$-2 income
|
||||
$1 liabilities
|
||||
|
||||
# ** 10. Aggregate at different levels for regular expressions for tree mode
|
||||
$ hledger -f sample.journal balance --no-total --depth assets=1 --depth 2 --tree
|
||||
$-1 assets
|
||||
$2 expenses
|
||||
$1 food
|
||||
$1 supplies
|
||||
$-2 income
|
||||
$-1 gifts
|
||||
$-1 salary
|
||||
$1 liabilities:debts
|
||||
|
||||
# ** 11. If a regexp matches, don't use the flat depth in tree mode
|
||||
$ hledger -f sample.journal balance --no-total --depth assets=2 --depth 1 --tree
|
||||
$-1 assets
|
||||
$1 bank
|
||||
$-2 cash
|
||||
$2 expenses
|
||||
$-2 income
|
||||
$1 liabilities
|
||||
|
||||
# ** 12. If two regexps match, use the more specific one in tree mode
|
||||
$ hledger -f sample.journal balance --no-total --depth assets:bank=2 --depth assets=1 --tree assets
|
||||
$-1 assets
|
||||
$1 bank
|
||||
|
||||
Loading…
Reference in New Issue
Block a user