From a1361ecc04246fc85144551b573a87ebb398d348 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Thu, 12 Mar 2020 08:52:43 -0700 Subject: [PATCH] csv: don't force a second posting with amount1 A rewrite and simplification of the posting-generating code. The "special handling for pre 1.17 rules" should now be less noticeable. amount1/amount2 no longer force a second posting or explicit amounts on both postings. (Only amount/amount-in/amount-out do that.) Error messages and handling of corner cases may be more robust, also. --- hledger-lib/Hledger/Read/CsvReader.hs | 335 +++++++++++--------------- hledger-lib/hledger_csv.5 | 41 ++-- hledger-lib/hledger_csv.info | 129 +++++----- hledger-lib/hledger_csv.m4.md | 32 +-- hledger-lib/hledger_csv.txt | 44 ++-- tests/csv.test | 32 +-- 6 files changed, 278 insertions(+), 335 deletions(-) diff --git a/hledger-lib/Hledger/Read/CsvReader.hs b/hledger-lib/Hledger/Read/CsvReader.hs index 6102a456e..01a11516c 100644 --- a/hledger-lib/Hledger/Read/CsvReader.hs +++ b/hledger-lib/Hledger/Read/CsvReader.hs @@ -457,6 +457,8 @@ journalfieldnamep = do lift (dbgparse 2 "trying journalfieldnamep") T.unpack <$> choiceInState (map (lift . string . T.pack) journalfieldnames) +maxpostings = 9 + -- Transaction fields and pseudo fields for CSV conversion. -- Names must precede any other name they contain, for the parser -- (amount-in before amount; date2 before date). TODO: fix @@ -468,7 +470,7 @@ journalfieldnames = ,"balance" ++ i ,"comment" ++ i ,"currency" ++ i - ] | x <- [1..9], let i = show x] + ] | x <- [1..maxpostings], let i = show x] ++ ["amount-in" ,"amount-out" @@ -761,8 +763,8 @@ csvRule rules = (`getDirective` rules) -- into account the current record and conditional rules. -- Generally rules with keywords ("directives") don't have interpolated -- values, but for now it's possible. -csvRuleValue :: CsvRules -> CsvRecord -> DirectiveName -> Maybe String -csvRuleValue rules record = fmap (renderTemplate rules record) . csvRule rules +-- csvRuleValue :: CsvRules -> CsvRecord -> DirectiveName -> Maybe String +-- csvRuleValue rules record = fmap (renderTemplate rules record) . csvRule rules -- | Look up the value template assigned to a hledger field by field -- list/field assignment rules, taking into account the current record and @@ -775,7 +777,7 @@ hledgerField = getEffectiveAssignment hledgerFieldValue :: CsvRules -> CsvRecord -> HledgerFieldName -> Maybe String hledgerFieldValue rules record = fmap (renderTemplate rules record) . hledgerField rules record -s `withDefault` def = if null s then def else s +-- s `orIfNull` def = if null s then def else s transactionFromCsvRecord :: SourcePos -> CsvRules -> CsvRecord -> Transaction transactionFromCsvRecord sourcepos rules record = t @@ -828,64 +830,27 @@ transactionFromCsvRecord sourcepos rules record = t precomment = maybe "" singleline $ fieldval "precomment" ---------------------------------------------------------------------- - -- 3. Generate the postings + -- 3. Generate the postings for which an account has been assigned + -- (possibly indirectly due to an amount or balance assignment) - -- Make posting 1 if possible, with special support for old syntax to - -- support pre-1.16 rules. - posting1 = mkPosting rules record "1" - ("account1" `withAlias` "account") - ("amount1" `withAlias` "amount") - ("amount1-in" `withAlias` "amount-in") - ("amount1-out" `withAlias` "amount-out") - ("balance1" `withAlias` "balance") - "comment1" -- comment1 does not have legacy alias - t - where - withAlias fld alias = - case (field fld, field alias) of - (Just fld, Just alias) -> error' $ unlines - [ "error: both \"" ++ fld ++ "\" and \"" ++ alias ++ "\" have values." - , showRecord record - , showRules rules record - ] - (Nothing, Just _) -> alias - (_, Nothing) -> fld - - -- Make other postings where possible, and gather all that were generated. - postings = catMaybes $ posting1 : otherpostings - where - otherpostings = [mkPostingN i | x<-[2..9], let i = show x] - where - mkPostingN n = mkPosting rules record n - ("account"++n) ("amount"++n) ("amount"++n++"-in") - ("amount"++n++"-out") ("balance"++n) ("comment"++n) t - - -- Auto-generate a second posting or second posting amount, - -- for compatibility with pre-1.16 rules. - postings' = - case postings of - -- when rules generate just one posting, of a kind that needs to be - -- balanced, generate the second posting to balance it. - [p1@(p1',_)] -> - if ptype p1' == VirtualPosting then [p1] else [p1, p2] - where - p2 = (nullposting{paccount=unknownExpenseAccount - ,pamount=costOfMixedAmount (-pamount p1') - ,ptransaction=Just t}, False) - -- when rules generate exactly two postings, and only the second has - -- no amount, give it the balancing amount. - [p1@(p1',_), p2@(p2',final2)] -> - if hasAmount p1' && not (hasAmount p2') - then [p1, (p2'{pamount=costOfMixedAmount(-(pamount p1'))}, final2)] - else [p1, p2] - -- - ps -> ps - - -- Finally, wherever default "unknown" accounts were used, refine them - -- based on the sign of the posting amount if it's now known. - postings'' = map maybeImprove postings' - where - maybeImprove (p,final) = if final then p else improveUnknownAccountName p + p1IsVirtual = (accountNamePostingType . T.pack <$> fieldval "account1") == Just VirtualPosting + ps = [p | n <- [1..maxpostings] + ,let comment = T.pack $ fromMaybe "" $ fieldval ("comment"++show n) + ,let currency = fromMaybe "" (fieldval ("currency"++show n) <|> fieldval "currency") + ,let mamount = getAmount rules record currency p1IsVirtual n + ,let mbalance = getBalance rules record currency n + ,Just (acct,isfinal) <- [getAccount rules record mamount mbalance n] -- skips Nothings + ,let acct' | not isfinal && acct==unknownExpenseAccount && + fromMaybe False (mamount >>= isNegativeMixedAmount) = unknownIncomeAccount + | otherwise = acct + ,let p = nullposting{paccount = accountNameWithoutPostingType acct' + ,pamount = fromMaybe missingmixedamt mamount + ,ptransaction = Just t + ,pbalanceassertion = mkBalanceAssertion rules record <$> mbalance + ,pcomment = comment + ,ptype = accountNamePostingType acct + } + ] ---------------------------------------------------------------------- -- 4. Build the transaction (and name it, so the postings can reference it). @@ -899,98 +864,99 @@ transactionFromCsvRecord sourcepos rules record = t ,tdescription = T.pack description ,tcomment = T.pack comment ,tprecedingcomment = T.pack precomment - ,tpostings = postings'' + ,tpostings = ps } --- | Given CSV rules and a CSV record, generate the corresponding transaction's --- Nth posting, if sufficient fields have been assigned for it. --- N is provided as a string. --- The names of the required fields are provided, allowing more flexibility. --- The transaction which will contain this posting is also provided, --- so we can build the usual transaction<->posting cyclic reference. -mkPosting :: - CsvRules -> CsvRecord -> String -> - HledgerFieldName -> HledgerFieldName -> HledgerFieldName -> - HledgerFieldName -> HledgerFieldName -> HledgerFieldName -> - Transaction -> - Maybe (Posting, Bool) -mkPosting rules record number accountFld amountFld amountInFld amountOutFld balanceFld commentFld t = - -- if we have figured out an account N, make a posting N - case maccountAndIsFinal of - Nothing -> Nothing - Just (acct, final) -> - Just (posting{paccount = accountNameWithoutPostingType acct - ,pamount = fromMaybe missingmixedamt mamount - ,ptransaction = Just t - ,pbalanceassertion = mkBalanceAssertion rules record <$> mbalance - ,pcomment = comment - ,ptype = accountNamePostingType acct} - ,final) - where - -- the account name to use for this posting, if any, and whether it is the - -- default unknown account, which may be improved later, or an explicitly - -- set account, which may not. - maccountAndIsFinal :: Maybe (AccountName, Bool) = - case maccount of - -- accountN is set to the empty string - no posting will be generated - Just "" -> Nothing - -- accountN is set (possibly to "expenses:unknown"! #1192) - mark it final - Just a -> Just (a, True) - -- accountN is unset - Nothing -> - case (mamount, mbalance) of - -- amountN is set, or implied by balanceN - set accountN to - -- the default unknown account ("expenses:unknown") and - -- allow it to be improved later - (Just _, _) -> Just (unknownExpenseAccount, False) - (_, Just _) -> Just (unknownExpenseAccount, False) - -- amountN is also unset - no posting will be generated - (Nothing, Nothing) -> Nothing - where - maccount = T.pack <$> (fieldval accountFld - -- XXX what's this needed for ? Test & document, or drop. - -- Also, this the only place we interpolate in a keyword rule, I think. - `withDefault` ruleval ("default-account" ++ number)) - -- XXX what's this needed for ? Test & document, or drop. - mdefaultcurrency = rule "default-currency" - currency = fromMaybe (fromMaybe "" mdefaultcurrency) $ - fieldval ("currency"++number) `withDefault` fieldval "currency" - mamount = chooseAmount rules record currency amountFld amountInFld amountOutFld - mbalance :: Maybe (Amount, GenericSourcePos) = - fieldval balanceFld >>= parsebalance currency number - where - parsebalance currency n str - | all isSpace str = Nothing - | otherwise = Just - (either (balanceerror n str) id $ - runParser (evalStateT (amountp <* eof) nulljournal) "" $ - T.pack $ (currency++) $ simplifySign str - ,nullsourcepos) -- XXX parse position to show when assertion fails, - -- the csv record's line number would be good - where - balanceerror n str err = error' $ unlines - ["error: could not parse \""++str++"\" as balance"++n++" amount" - ,showRecord record - ,showRules rules record - ,"the default-currency is: "++fromMaybe "unspecified" mdefaultcurrency - ,"the parse error is: "++customErrorBundlePretty err - ] - comment = T.pack $ fromMaybe "" $ fieldval commentFld - rule = csvRule rules :: DirectiveName -> Maybe FieldTemplate - ruleval = csvRuleValue rules record :: DirectiveName -> Maybe String - -- field = hledgerField rules record :: HledgerFieldName -> Maybe FieldTemplate - fieldval = hledgerFieldValue rules record :: HledgerFieldName -> Maybe String --- | Default account names to use when needed. -unknownExpenseAccount = "expenses:unknown" -unknownIncomeAccount = "income:unknown" +-- -- | Given CSV rules and a CSV record, generate the corresponding transaction's +-- -- Nth posting, if sufficient fields have been assigned for it. +-- -- N is provided as a string. +-- -- The names of the required fields are provided, allowing more flexibility. +-- -- The transaction which will contain this posting is also provided, +-- -- so we can build the usual transaction<->posting cyclic reference. +-- mkPosting :: CsvRules -> CsvRecord -> String -> Transaction -> Maybe (Posting, Bool) +-- mkPosting rules record n t = --- | If this posting has the "expenses:unknown" account name, --- replace that with "income:unknown" if the amount is negative. --- The posting's amount should be explicit. -improveUnknownAccountName p@Posting{..} - | paccount == unknownExpenseAccount - && fromMaybe False (isNegativeMixedAmount pamount) = p{paccount=unknownIncomeAccount} - | otherwise = p +-- | Figure out the amount specified for posting N, if any. +-- Looks for a non-zero amount assigned to one of "amountN", "amountN-in", "amountN-out". +-- Postings 1 or 2 also look at "amount", "amount-in", "amount-out". +-- Throws an error if more than one of these has a non-zero amount assigned. +-- A currency symbol to prepend to the amount, if any, is provided, +-- and whether posting 1 requires balancing or not. +getAmount :: CsvRules -> CsvRecord -> String -> Bool -> Int -> Maybe MixedAmount +getAmount rules record currency p1IsVirtual n = + let + unnumberedfieldnames = ["amount","amount-in","amount-out"] + fieldnames = map (("amount"++show n)++) ["","-in","-out"] + -- For posting 1, also recognise the old amount/amount-in/amount-out names. + -- For posting 2, the same but only if posting 1 needs balancing. + ++ if n==1 || n==2 && not p1IsVirtual then unnumberedfieldnames else [] + nonzeroamounts = [(f,a') | f <- fieldnames + , Just v@(_:_) <- [strip . renderTemplate rules record <$> hledgerField rules record f] + , let a = parseAmount rules record currency v + , not $ isZeroMixedAmount a + -- With amount/amount-in/amount-out, in posting 2, + -- flip the sign and convert to cost, as they did before 1.17 + , let a' = if f `elem` unnumberedfieldnames && n==2 then costOfMixedAmount (-a) else a + ] + in case nonzeroamounts of + [] -> Nothing + [(f,a)] | "-out" `isSuffixOf` f -> Just (-a) -- for -out fields, flip the sign + [(_,a)] -> Just a + fs -> error' $ + "more than one non-zero amount for this record, please ensure just one\n" + ++ unlines [" " ++ padright 11 f ++ ": " ++ showMixedAmount a + ++ " from rule: " ++ fromMaybe "" (hledgerField rules record f) + | (f,a) <- fs] + ++ " " ++ showRecord record ++ "\n" + where + -- | Given a non-empty amount string to parse, along with a possibly + -- non-empty currency symbol to prepend, parse as a hledger amount (as + -- in journal format), or raise an error. + -- The CSV rules and record are provided for the error message. + parseAmount :: CsvRules -> CsvRecord -> String -> String -> MixedAmount + parseAmount rules record currency amountstr = + either mkerror (Mixed . (:[])) $ + runParser (evalStateT (amountp <* eof) nulljournal) "" $ + T.pack $ (currency++) $ simplifySign amountstr + where + mkerror e = error' $ unlines + ["error: could not parse \""++amountstr++"\" as an amount" + ,showRecord record + ,showRules rules record + -- ,"the default-currency is: "++fromMaybe "unspecified" (getDirective "default-currency" rules) + ,"the parse error is: "++customErrorBundlePretty e + ,"you may need to " + ++"change your amount*, balance*, or currency* rules, " + ++"or add or change your skip rule" + ] + +-- | Figure out the expected balance (assertion or assignment) specified for posting N, +-- if any (and its parse position). +getBalance :: CsvRules -> CsvRecord -> String -> Int -> Maybe (Amount, GenericSourcePos) +getBalance rules record currency n = + (fieldval ("balance"++show n) + -- for posting 1, also recognise the old field name + <|> if n==1 then fieldval "balance" else Nothing) + >>= parsebalance currency n . strip + where + parsebalance currency n s + | null s = Nothing + | otherwise = Just + (either (mkerror n s) id $ + runParser (evalStateT (amountp <* eof) nulljournal) "" $ + T.pack $ (currency++) $ simplifySign s + ,nullsourcepos) -- XXX parse position to show when assertion fails, + -- the csv record's line number would be good + where + mkerror n s e = error' $ unlines + ["error: could not parse \""++s++"\" as balance"++show n++" amount" + ,showRecord record + ,showRules rules record + -- ,"the default-currency is: "++fromMaybe "unspecified" mdefaultcurrency + ,"the parse error is: "++customErrorBundlePretty e + ] + -- mdefaultcurrency = rule "default-currency" + fieldval = hledgerFieldValue rules record :: HledgerFieldName -> Maybe String -- | Make a balance assertion for the given amount, with the given parse -- position (to be shown in assertion failures), with the assertion type @@ -1013,48 +979,33 @@ mkBalanceAssertion rules record (amt, pos) = assrt{baamount=amt, baposition=pos} , showRules rules record ] -chooseAmount :: CsvRules -> CsvRecord -> String -> String -> String -> String -> Maybe MixedAmount -chooseAmount rules record currency amountFld amountInFld amountOutFld = - let - mamount = getEffectiveAssignment rules record amountFld - mamountin = getEffectiveAssignment rules record amountInFld - mamountout = getEffectiveAssignment rules record amountOutFld - parse amt = notZero =<< (parseAmount currency <$> notEmpty =<< (strip . renderTemplate rules record) <$> amt) - in - case (parse mamount, parse mamountin, parse mamountout) of - (Nothing, Nothing, Nothing) -> Nothing - (Just a, Nothing, Nothing) -> Just a - (Nothing, Just i, Nothing) -> Just i - (Nothing, Nothing, Just o) -> Just $ negate o - (Nothing, Just i, Just o) -> error' $ "both "++amountInFld++" and "++amountOutFld++" have a value\n" - ++ " "++amountInFld++": " ++ show i ++ "\n" - ++ " "++amountOutFld++": " ++ show o ++ "\n" - ++ " record: " ++ showRecord record - _ -> error' $ "found values for "++amountFld++" and for "++amountInFld++"/"++amountOutFld++"\n" - ++ "please use either "++amountFld++" or "++amountInFld++"/"++amountOutFld++"\n" - ++ " record: " ++ showRecord record - where - notZero amt = if isZeroMixedAmount amt then Nothing else Just amt - notEmpty str = if str=="" then Nothing else Just str +-- | Figure out the account name specified for posting N, if any. +-- And whether it is the default unknown account (which may be +-- improved later) or an explicitly set account (which may not). +getAccount :: CsvRules -> CsvRecord -> Maybe MixedAmount -> Maybe (Amount, GenericSourcePos) -> Int -> Maybe (AccountName, Bool) +getAccount rules record mamount mbalance n = + let + fieldval = hledgerFieldValue rules record :: HledgerFieldName -> Maybe String + maccount = T.pack <$> fieldval ("account"++show n) + in case maccount of + -- accountN is set to the empty string - no posting will be generated + Just "" -> Nothing + -- accountN is set (possibly to "expenses:unknown"! #1192) - mark it final + Just a -> Just (a, True) + -- accountN is unset + Nothing -> + case (mamount, mbalance) of + -- amountN is set, or implied by balanceN - set accountN to + -- the default unknown account ("expenses:unknown") and + -- allow it to be improved later + (Just _, _) -> Just (unknownExpenseAccount, False) + (_, Just _) -> Just (unknownExpenseAccount, False) + -- amountN is also unset - no posting will be generated + (Nothing, Nothing) -> Nothing - parseAmount currency amountstr = - either (amounterror amountstr) (Mixed . (:[])) - <$> runParser (evalStateT (amountp <* eof) nulljournal) "" - <$> T.pack - <$> (currency++) - <$> simplifySign - <$> amountstr - - amounterror amountstr err = error' $ unlines - ["error: could not parse \""++fromJust amountstr++"\" as an amount" - ,showRecord record - ,showRules rules record - ,"the default-currency is: "++fromMaybe "unspecified" (getDirective "default-currency" rules) - ,"the parse error is: "++customErrorBundlePretty err - ,"you may need to " - ++"change your amount or currency rules, " - ++"or add or change your skip rule" - ] +-- | Default account names to use when needed. +unknownExpenseAccount = "expenses:unknown" +unknownIncomeAccount = "income:unknown" type CsvAmountString = String @@ -1088,7 +1039,7 @@ negateStr s = '-':s -- | Show a (approximate) recreation of the original CSV record. showRecord :: CsvRecord -> String -showRecord r = "the CSV record is: "++intercalate "," (map show r) +showRecord r = "record values: "++intercalate "," (map show r) -- | Given the conversion rules, a CSV record and a hledger field name, find -- the value template ultimately assigned to this field, if any, by a field diff --git a/hledger-lib/hledger_csv.5 b/hledger-lib/hledger_csv.5 index f1a710c22..6234be684 100644 --- a/hledger-lib/hledger_csv.5 +++ b/hledger-lib/hledger_csv.5 @@ -494,6 +494,9 @@ with that account name. .PP Most often there are two postings, so you\[aq]ll want to set \f[C]account1\f[R] and \f[C]account2\f[R]. +Typically \f[C]account1\f[R] is associated with the CSV file, and is set +once with a top-level assignment, while \f[C]account2\f[R] is set based +on each transaction\[aq]s description, and in conditional blocks. .PP If a posting\[aq]s account name is left unset but its amount is set (see below), a default account name will be chosen (like @@ -501,38 +504,30 @@ below), a default account name will be chosen (like .SS amount .PP \f[C]amountN\f[R] sets posting N\[aq]s amount. +If the CSV uses separate fields for debit and credit amounts, you can +use \f[C]amountN-in\f[R] and \f[C]amountN-out\f[R] instead. .PP -Or if the CSV has debits and credits in two separate fields, use -\f[C]amountN-in\f[R] and \f[C]amountN-out\f[R] instead. -.PP -Some aliases and special behaviour exist to support older CSV rules -(before hledger 1.17): -.IP \[bu] 2 -if \f[C]amount1\f[R] is the only posting amount assigned, then a second -posting with the balancing amount will be generated automatically. -(Unless the account name is parenthesised indicating an unbalanced -posting.) -.IP \[bu] 2 -\f[C]amount\f[R] is an alias for \f[C]amount1\f[R] -.IP \[bu] 2 -\f[C]amount-in\f[R]/\f[C]amount-out\f[R] are aliases for -\f[C]amount1-in\f[R]/\f[C]amount1-out\f[R] -.PP -This can occasionally get in the way. -For example, currently it\[aq]s possible to generate a transaction with -a blank amount1, but not one with a blank amount2. +Also, for compatibility with hledger <1.17: \f[C]amount\f[R] or +\f[C]amount-in\f[R]/\f[C]amount-out\f[R] with no number sets the amount +for postings 1 and 2. +For posting 2 the amount is negated, and converted to cost if +there\[aq]s a transaction price. .SS currency .PP If the CSV has the currency symbol in a separate field (ie, not part of the amount field), you can use \f[C]currencyN\f[R] to prepend it to posting N\[aq]s amount. -Or, \f[C]currency\f[R] affects all postings. +Or, \f[C]currency\f[R] with no number affects all postings. .SS balance .PP \f[C]balanceN\f[R] sets a balance assertion amount (or if the posting -amount is left empty, a balance assignment). -You may need to adjust this with the \f[C]balance-type\f[R] rule (see -below). +amount is left empty, a balance assignment) on posting N. +.PP +Also, for compatibility with hledger <1.17: \f[C]balance\f[R] with no +number is equivalent to \f[C]balance1\f[R]. +.PP +You can adjust the type of assertion/assignment with the +\f[C]balance-type\f[R] rule (see below). .SS comment .PP Finally, \f[C]commentN\f[R] sets a comment on the Nth posting. diff --git a/hledger-lib/hledger_csv.info b/hledger-lib/hledger_csv.info index 6ec76f934..4bef60a39 100644 --- a/hledger-lib/hledger_csv.info +++ b/hledger-lib/hledger_csv.info @@ -469,7 +469,9 @@ File: hledger_csv.info, Node: account, Next: amount, Up: Posting field names that account name. Most often there are two postings, so you'll want to set 'account1' -and 'account2'. +and 'account2'. Typically 'account1' is associated with the CSV file, +and is set once with a top-level assignment, while 'account2' is set +based on each transaction's description, and in conditional blocks. If a posting's account name is left unset but its amount is set (see below), a default account name will be chosen (like "expenses:unknown" @@ -481,24 +483,14 @@ File: hledger_csv.info, Node: amount, Next: currency, Prev: account, Up: Pos 2.2.2.2 amount .............. -'amountN' sets posting N's amount. +'amountN' sets posting N's amount. If the CSV uses separate fields for +debit and credit amounts, you can use 'amountN-in' and 'amountN-out' +instead. - Or if the CSV has debits and credits in two separate fields, use -'amountN-in' and 'amountN-out' instead. - - Some aliases and special behaviour exist to support older CSV rules -(before hledger 1.17): - - * if 'amount1' is the only posting amount assigned, then a second - posting with the balancing amount will be generated automatically. - (Unless the account name is parenthesised indicating an unbalanced - posting.) - * 'amount' is an alias for 'amount1' - * 'amount-in'/'amount-out' are aliases for 'amount1-in'/'amount1-out' - - This can occasionally get in the way. For example, currently it's -possible to generate a transaction with a blank amount1, but not one -with a blank amount2. + Also, for compatibility with hledger <1.17: 'amount' or +'amount-in'/'amount-out' with no number sets the amount for postings 1 +and 2. For posting 2 the amount is negated, and converted to cost if +there's a transaction price.  File: hledger_csv.info, Node: currency, Next: balance, Prev: amount, Up: Posting field names @@ -508,7 +500,7 @@ File: hledger_csv.info, Node: currency, Next: balance, Prev: amount, Up: Pos If the CSV has the currency symbol in a separate field (ie, not part of the amount field), you can use 'currencyN' to prepend it to posting N's -amount. Or, 'currency' affects all postings. +amount. Or, 'currency' with no number affects all postings.  File: hledger_csv.info, Node: balance, Next: comment, Prev: currency, Up: Posting field names @@ -517,7 +509,12 @@ File: hledger_csv.info, Node: balance, Next: comment, Prev: currency, Up: Po ............... 'balanceN' sets a balance assertion amount (or if the posting amount is -left empty, a balance assignment). You may need to adjust this with the +left empty, a balance assignment) on posting N. + + Also, for compatibility with hledger <1.17: 'balance' with no number +is equivalent to 'balance1'. + + You can adjust the type of assertion/assignment with the 'balance-type' rule (see below).  @@ -1044,52 +1041,52 @@ Node: Posting field names16638 Ref: #posting-field-names16790 Node: account16860 Ref: #account16976 -Node: amount17320 -Ref: #amount17451 -Node: currency18195 -Ref: #currency18330 -Node: balance18521 -Ref: #balance18655 -Node: comment18834 -Ref: #comment18951 -Node: field assignment19114 -Ref: #field-assignment19257 -Node: separator20075 -Ref: #separator20204 -Node: if20615 -Ref: #if20717 -Node: end22636 -Ref: #end22742 -Node: date-format22966 -Ref: #date-format23098 -Node: newest-first23847 -Ref: #newest-first23985 -Node: include24668 -Ref: #include24797 -Node: balance-type25241 -Ref: #balance-type25361 -Node: TIPS26061 -Ref: #tips26143 -Node: Rapid feedback26399 -Ref: #rapid-feedback26516 -Node: Valid CSV26976 -Ref: #valid-csv27106 -Node: File Extension27298 -Ref: #file-extension27450 -Node: Reading multiple CSV files27860 -Ref: #reading-multiple-csv-files28045 -Node: Valid transactions28286 -Ref: #valid-transactions28464 -Node: Deduplicating importing29092 -Ref: #deduplicating-importing29271 -Node: Setting amounts30304 -Ref: #setting-amounts30473 -Node: Setting currency/commodity31459 -Ref: #setting-currencycommodity31651 -Node: Referencing other fields32454 -Ref: #referencing-other-fields32654 -Node: How CSV rules are evaluated33551 -Ref: #how-csv-rules-are-evaluated33724 +Node: amount17512 +Ref: #amount17643 +Node: currency18024 +Ref: #currency18159 +Node: balance18365 +Ref: #balance18499 +Node: comment18816 +Ref: #comment18933 +Node: field assignment19096 +Ref: #field-assignment19239 +Node: separator20057 +Ref: #separator20186 +Node: if20597 +Ref: #if20699 +Node: end22618 +Ref: #end22724 +Node: date-format22948 +Ref: #date-format23080 +Node: newest-first23829 +Ref: #newest-first23967 +Node: include24650 +Ref: #include24779 +Node: balance-type25223 +Ref: #balance-type25343 +Node: TIPS26043 +Ref: #tips26125 +Node: Rapid feedback26381 +Ref: #rapid-feedback26498 +Node: Valid CSV26958 +Ref: #valid-csv27088 +Node: File Extension27280 +Ref: #file-extension27432 +Node: Reading multiple CSV files27842 +Ref: #reading-multiple-csv-files28027 +Node: Valid transactions28268 +Ref: #valid-transactions28446 +Node: Deduplicating importing29074 +Ref: #deduplicating-importing29253 +Node: Setting amounts30286 +Ref: #setting-amounts30455 +Node: Setting currency/commodity31441 +Ref: #setting-currencycommodity31633 +Node: Referencing other fields32436 +Ref: #referencing-other-fields32636 +Node: How CSV rules are evaluated33533 +Ref: #how-csv-rules-are-evaluated33706  End Tag Table diff --git a/hledger-lib/hledger_csv.m4.md b/hledger-lib/hledger_csv.m4.md index 99fd1186f..4409b8560 100644 --- a/hledger-lib/hledger_csv.m4.md +++ b/hledger-lib/hledger_csv.m4.md @@ -418,6 +418,8 @@ For more about the transaction parts they refer to, see the manual for hledger's with that account name. Most often there are two postings, so you'll want to set `account1` and `account2`. +Typically `account1` is associated with the CSV file, and is set once with a top-level assignment, +while `account2` is set based on each transaction's description, and in conditional blocks. If a posting's account name is left unset but its amount is set (see below), a default account name will be chosen (like "expenses:unknown" or "income:unknown"). @@ -425,31 +427,31 @@ a default account name will be chosen (like "expenses:unknown" or "income:unknow #### amount `amountN` sets posting N's amount. +If the CSV uses separate fields for debit and credit amounts, you can +use `amountN-in` and `amountN-out` instead. -Or if the CSV has debits and credits in two separate fields, use `amountN-in` and `amountN-out` instead. - -Some aliases and special behaviour exist to support older CSV rules (before hledger 1.17): - -- if `amount1` is the only posting amount assigned, then a second posting - with the balancing amount will be generated automatically. - (Unless the account name is parenthesised indicating an [unbalanced posting](journal.html#virtual-postings).) -- `amount` is an alias for `amount1` -- `amount-in`/`amount-out` are aliases for `amount1-in`/`amount1-out` - -This can occasionally get in the way. For example, currently it's possible to generate -a transaction with a blank amount1, but not one with a blank amount2. +Also, for compatibility with hledger <1.17: +`amount` or `amount-in`/`amount-out` with no number sets the amount +for postings 1 and 2. For posting 2 the amount is negated, and +converted to cost if there's a [transaction price](journal.html#transaction-prices). #### currency If the CSV has the currency symbol in a separate field (ie, not part of the amount field), you can use `currencyN` to prepend it to posting -N's amount. Or, `currency` affects all postings. +N's amount. Or, `currency` with no number affects all postings. #### balance `balanceN` sets a [balance assertion](journal.html#balance-assertions) amount -(or if the posting amount is left empty, a [balance assignment](journal.html#balance-assignments)). -You may need to adjust this with the [`balance-type` rule](#balance-type) (see below). +(or if the posting amount is left empty, a [balance assignment](journal.html#balance-assignments)) +on posting N. + +Also, for compatibility with hledger <1.17: +`balance` with no number is equivalent to `balance1`. + +You can adjust the type of assertion/assignment with the +[`balance-type` rule](#balance-type) (see below). #### comment diff --git a/hledger-lib/hledger_csv.txt b/hledger-lib/hledger_csv.txt index 4719bdc96..f1e90c2ea 100644 --- a/hledger-lib/hledger_csv.txt +++ b/hledger-lib/hledger_csv.txt @@ -381,42 +381,38 @@ CSV RULES that account name. Most often there are two postings, so you'll want to set account1 and - account2. + account2. Typically account1 is associated with the CSV file, and is + set once with a top-level assignment, while account2 is set based on + each transaction's description, and in conditional blocks. If a posting's account name is left unset but its amount is set (see below), a default account name will be chosen (like "expenses:unknown" or "income:unknown"). amount - amountN sets posting N's amount. + amountN sets posting N's amount. If the CSV uses separate fields for + debit and credit amounts, you can use amountN-in and amountN-out in- + stead. - Or if the CSV has debits and credits in two separate fields, use - amountN-in and amountN-out instead. - - Some aliases and special behaviour exist to support older CSV rules - (before hledger 1.17): - - o if amount1 is the only posting amount assigned, then a second posting - with the balancing amount will be generated automatically. (Unless - the account name is parenthesised indicating an unbalanced posting.) - - o amount is an alias for amount1 - - o amount-in/amount-out are aliases for amount1-in/amount1-out - - This can occasionally get in the way. For example, currently it's pos- - sible to generate a transaction with a blank amount1, but not one with - a blank amount2. + Also, for compatibility with hledger <1.17: amount or amount-in/amount- + out with no number sets the amount for postings 1 and 2. For posting 2 + the amount is negated, and converted to cost if there's a transaction + price. currency If the CSV has the currency symbol in a separate field (ie, not part of - the amount field), you can use currencyN to prepend it to posting N's - amount. Or, currency affects all postings. + the amount field), you can use currencyN to prepend it to posting N's + amount. Or, currency with no number affects all postings. balance - balanceN sets a balance assertion amount (or if the posting amount is - left empty, a balance assignment). You may need to adjust this with - the balance-type rule (see below). + balanceN sets a balance assertion amount (or if the posting amount is + left empty, a balance assignment) on posting N. + + Also, for compatibility with hledger <1.17: balance with no number is + equivalent to balance1. + + You can adjust the type of assertion/assignment with the balance-type + rule (see below). comment Finally, commentN sets a comment on the Nth posting. Comments can also diff --git a/tests/csv.test b/tests/csv.test index e516a6299..de20ecc31 100644 --- a/tests/csv.test +++ b/tests/csv.test @@ -219,9 +219,9 @@ account4 the:remainder $ ./csvtest.sh 2009-09-10 Flubber Co - assets:myacct $50.000 = $321.000 - expenses:unknown = $123.000 - expenses:tax $0.234 ; VAT + assets:myacct $50.000 = $321.000 + income:unknown $-50.000 = $123.000 + expenses:tax $0.234 ; VAT the:remainder >=0 @@ -240,9 +240,9 @@ account4 the:remainder $ ./csvtest.sh 2009-09-10 Flubber Co - assets:myacct $50 = $321 - expenses:unknown = $123 - expenses:tax £0.234 ; VAT + assets:myacct $50 = $321 + income:unknown $-50 = $123 + expenses:tax £0.234 ; VAT the:remainder >=0 @@ -472,7 +472,7 @@ $ ./csvtest.sh 2018-12-22 (10101010101) Someone for Joyful Systems sm:assets:online:paypal $7.77 = $88.66 - sm:expenses:unknown $-7.77 + sm:expenses:unknown >=0 @@ -613,15 +613,16 @@ $ ./csvtest.sh >=0 -# 31. Currently can't generate a transaction with amount on the first posting only. XXX +# 31. Can generate a transaction with amount on the first posting only. < 2020-01-01, 1 RULES fields date, amount1 +account2 b $ ./csvtest.sh 2020-01-01 expenses:unknown 1 - income:unknown -1 + b >=0 @@ -630,23 +631,24 @@ $ ./csvtest.sh 2020-01-01, 1 RULES fields date, amount2 -account1 asset +account1 a $ ./csvtest.sh 2020-01-01 - asset + a expenses:unknown 1 >=0 -# 33. If account1 is unset, the above doesn't work. Also amount2 appears to become amount1 ? XXX +# 33. The old amount rules convert amount1 to cost in posting 2: < 2020-01-01, 1 RULES -fields date, amount2 +fields date, amt +amount %amt @@ 1 EUR $ ./csvtest.sh 2020-01-01 - expenses:unknown 1 - income:unknown -1 + expenses:unknown 1 @@ 1 EUR + income:unknown -1 EUR >=0