reg: --related/-r flag to show other postings in the transaction

This commit is contained in:
Simon Michael 2012-12-22 00:24:38 +00:00
parent 552a15a1ba
commit 7175c57992
6 changed files with 21 additions and 4 deletions

View File

@ -760,6 +760,9 @@ this is 80 characters. To allow more space for descriptions and account
names, use `-w` to increase the width to 120 characters, or `-wN` to set names, use `-w` to increase the width to 120 characters, or `-wN` to set
any desired width (at least 50 recommended). any desired width (at least 50 recommended).
The `--related`/`-r` flag shows the *other* postings in the transactions
of the postings which would normally be shown.
#### balance #### balance
The balance command displays accounts and their balances, indented to show the account hierarchy. The balance command displays accounts and their balances, indented to show the account hierarchy.

View File

@ -364,7 +364,7 @@ journalFinalise tclock tlocal path txt ctx j@Journal{files=fs} =
-- depends on display precision. Reports only the first error encountered. -- depends on display precision. Reports only the first error encountered.
journalBalanceTransactions :: Journal -> Either String Journal journalBalanceTransactions :: Journal -> Either String Journal
journalBalanceTransactions j@Journal{jtxns=ts, jcommoditystyles=ss} = journalBalanceTransactions j@Journal{jtxns=ts, jcommoditystyles=ss} =
case sequence $ map balance ts of Right ts' -> Right j{jtxns=ts'} case sequence $ map balance ts of Right ts' -> Right j{jtxns=map txnTieKnot ts'}
Left e -> Left e Left e -> Left e
where balance = balanceTransaction (Just ss) where balance = balanceTransaction (Just ss)

View File

@ -21,6 +21,7 @@ module Hledger.Data.Posting (
hasAmount, hasAmount,
postingAllTags, postingAllTags,
transactionAllTags, transactionAllTags,
relatedPostings,
-- * date operations -- * date operations
postingDate, postingDate,
postingDate2, postingDate2,
@ -149,6 +150,11 @@ postingAllTags p = ptags p ++ maybe [] transactionAllTags (ptransaction p)
transactionAllTags :: Transaction -> [Tag] transactionAllTags :: Transaction -> [Tag]
transactionAllTags t = ttags t transactionAllTags t = ttags t
-- Get the other postings from this posting's transaction.
relatedPostings :: Posting -> [Posting]
relatedPostings p@Posting{ptransaction=Just t} = filter (/= p) $ tpostings t
relatedPostings _ = []
-- | Does this posting fall within the given date span ? -- | Does this posting fall within the given date span ?
isPostingInDateSpan :: DateSpan -> Posting -> Bool isPostingInDateSpan :: DateSpan -> Posting -> Bool
isPostingInDateSpan s = spanContainsDate s . postingDate isPostingInDateSpan s = spanContainsDate s . postingDate

View File

@ -264,7 +264,7 @@ balanceTransaction styles t@Transaction{tpostings=ps}
| length rwithoutamounts > 1 || length bvwithoutamounts > 1 | length rwithoutamounts > 1 || length bvwithoutamounts > 1
= Left $ printerr "could not balance this transaction (too many missing amounts)" = Left $ printerr "could not balance this transaction (too many missing amounts)"
| not $ isTransactionBalanced styles t''' = Left $ printerr $ nonzerobalanceerror t''' | not $ isTransactionBalanced styles t''' = Left $ printerr $ nonzerobalanceerror t'''
| otherwise = Right t''' | otherwise = Right t''''
where where
-- maybe infer missing amounts -- maybe infer missing amounts
(rwithamounts, rwithoutamounts) = partition hasAmount $ realPostings t (rwithamounts, rwithoutamounts) = partition hasAmount $ realPostings t
@ -329,6 +329,9 @@ balanceTransaction styles t@Transaction{tpostings=ps}
bvamountsinunpricedcommodity = filter ((==unpricedcommodity).acommodity) bvamountsinorder bvamountsinunpricedcommodity = filter ((==unpricedcommodity).acommodity) bvamountsinorder
inferprice p = p inferprice p = p
-- tie the knot so eg relatedPostings works right
t'''' = txnTieKnot t'''
printerr s = intercalate "\n" [s, showTransactionUnelided t] printerr s = intercalate "\n" [s, showTransactionUnelided t]
nonzerobalanceerror :: Transaction -> String nonzerobalanceerror :: Transaction -> String

View File

@ -91,6 +91,7 @@ data ReportOpts = ReportOpts {
,quarterly_ :: Bool ,quarterly_ :: Bool
,yearly_ :: Bool ,yearly_ :: Bool
,format_ :: Maybe FormatStr ,format_ :: Maybe FormatStr
,related_ :: Bool
,query_ :: String -- all arguments, as a string ,query_ :: String -- all arguments, as a string
} deriving (Show) } deriving (Show)
@ -120,6 +121,7 @@ defreportopts = ReportOpts
def def
def def
def def
def
instance Default ReportOpts where def = defreportopts instance Default ReportOpts where def = defreportopts
@ -259,7 +261,8 @@ postingsReport opts q j = -- trace ("q: "++show q++"\nq': "++show q') $
wd = whichDateFromOpts opts wd = whichDateFromOpts opts
-- delay depth filtering until the end -- delay depth filtering until the end
(depth, q') = (queryDepth q, filterQuery (not . queryIsDepth) q) (depth, q') = (queryDepth q, filterQuery (not . queryIsDepth) q)
(precedingps, displayableps, _) = dbg "ps3" $ postingsMatchingDisplayExpr (display_ opts) (precedingps, displayableps, _) = dbg "ps4" $ postingsMatchingDisplayExpr displayexpr
$ dbg "ps3" $ (if related_ opts then concatMap relatedPostings else id)
$ dbg "ps2" $ filter (q' `matchesPosting`) $ dbg "ps2" $ filter (q' `matchesPosting`)
$ dbg "ps1" $ journalPostings j' $ dbg "ps1" $ journalPostings j'
dbg :: Show a => String -> a -> a dbg :: Show a => String -> a -> a

View File

@ -215,6 +215,7 @@ postingsmode = (commandmode ["register","postings"]) {
,modeGroupFlags = Group { ,modeGroupFlags = Group {
groupUnnamed = [ groupUnnamed = [
flagOpt (show defaultWidthWithFlag) ["width","w"] (\s opts -> Right $ setopt "width" s opts) "N" "increase or set the output width (default: 80)" flagOpt (show defaultWidthWithFlag) ["width","w"] (\s opts -> Right $ setopt "width" s opts) "N" "increase or set the output width (default: 80)"
,flagNone ["related","r"] (\opts -> setboolopt "related" opts) "show the other postings in the transactions of those that would have been shown"
] ]
,groupHidden = [] ,groupHidden = []
,groupNamed = [(generalflagstitle, generalflags1)] ,groupNamed = [(generalflagstitle, generalflags1)]
@ -336,7 +337,7 @@ toCliOpts rawopts = do
,cost_ = boolopt "cost" rawopts ,cost_ = boolopt "cost" rawopts
,depth_ = maybeintopt "depth" rawopts ,depth_ = maybeintopt "depth" rawopts
,display_ = maybedisplayopt d rawopts ,display_ = maybedisplayopt d rawopts
,date2_ = boolopt "date2" rawopts ,date2_ = boolopt "date2" rawopts
,empty_ = boolopt "empty" rawopts ,empty_ = boolopt "empty" rawopts
,no_elide_ = boolopt "no-elide" rawopts ,no_elide_ = boolopt "no-elide" rawopts
,real_ = boolopt "real" rawopts ,real_ = boolopt "real" rawopts
@ -349,6 +350,7 @@ toCliOpts rawopts = do
,quarterly_ = boolopt "quarterly" rawopts ,quarterly_ = boolopt "quarterly" rawopts
,yearly_ = boolopt "yearly" rawopts ,yearly_ = boolopt "yearly" rawopts
,format_ = maybestringopt "format" rawopts ,format_ = maybestringopt "format" rawopts
,related_ = boolopt "related" rawopts -- register
,query_ = unwords $ listofstringopt "args" rawopts ,query_ = unwords $ listofstringopt "args" rawopts
} }
} }