mirror of
https://github.com/simonmichael/hledger.git
synced 2024-09-20 02:37:12 +03:00
;csv: extract mkPosting! and refactor
This commit is contained in:
parent
f2767477ab
commit
b18f71a81b
@ -766,21 +766,18 @@ hledgerFieldValue rules record = fmap (renderTemplate rules record) . hledgerFie
|
|||||||
|
|
||||||
s `withDefault` def = if null s then def else s
|
s `withDefault` def = if null s then def else s
|
||||||
|
|
||||||
-- warning: 200 line beast ahead
|
|
||||||
transactionFromCsvRecord :: SourcePos -> CsvRules -> CsvRecord -> Transaction
|
transactionFromCsvRecord :: SourcePos -> CsvRules -> CsvRecord -> Transaction
|
||||||
transactionFromCsvRecord sourcepos rules record = t
|
transactionFromCsvRecord sourcepos rules record = t
|
||||||
where
|
where
|
||||||
----------------------------------------------------------------------
|
|
||||||
-- 1. Some helpers
|
|
||||||
rule = csvRule rules :: DirectiveName -> Maybe FieldTemplate
|
rule = csvRule rules :: DirectiveName -> Maybe FieldTemplate
|
||||||
ruleval = csvRuleValue rules record :: DirectiveName -> Maybe String
|
-- ruleval = csvRuleValue rules record :: DirectiveName -> Maybe String
|
||||||
field = hledgerField rules record :: HledgerFieldName -> Maybe FieldTemplate
|
field = hledgerField rules record :: HledgerFieldName -> Maybe FieldTemplate
|
||||||
fieldval = hledgerFieldValue rules record :: HledgerFieldName -> Maybe String
|
fieldval = hledgerFieldValue rules record :: HledgerFieldName -> Maybe String
|
||||||
|
|
||||||
----------------------------------------------------------------------
|
----------------------------------------------------------------------
|
||||||
-- 2. Gather the values needed for the transaction itself, by evaluating
|
-- 1. Gather the values needed for the transaction itself, by evaluating
|
||||||
-- the field assignment rules using the CSV record's data, and parsing a
|
-- the field assignment rules using the CSV record's data, and parsing a
|
||||||
-- bit more where needed, into dates, amounts, status..
|
-- bit more where needed (dates, status).
|
||||||
|
|
||||||
mdateformat = rule "date-format"
|
mdateformat = rule "date-format"
|
||||||
date = fromMaybe "" $ fieldval "date"
|
date = fromMaybe "" $ fieldval "date"
|
||||||
@ -820,85 +817,18 @@ transactionFromCsvRecord sourcepos rules record = t
|
|||||||
precomment = maybe "" singleline $ fieldval "precomment"
|
precomment = maybe "" singleline $ fieldval "precomment"
|
||||||
|
|
||||||
----------------------------------------------------------------------
|
----------------------------------------------------------------------
|
||||||
-- 3. Generate the postings
|
-- 2. Generate the postings
|
||||||
|
|
||||||
-- Helper to generate posting N, if sufficient fields have been assigned
|
|
||||||
-- for it. N is provided as a string.
|
|
||||||
mkPosting ::
|
|
||||||
String -> HledgerFieldName -> HledgerFieldName -> HledgerFieldName ->
|
|
||||||
HledgerFieldName -> HledgerFieldName -> HledgerFieldName ->
|
|
||||||
Maybe (Posting, Bool)
|
|
||||||
mkPosting number accountFld amountFld amountInFld amountOutFld balanceFld commentFld =
|
|
||||||
let 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) mempty) "" $
|
|
||||||
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
|
|
||||||
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))
|
|
||||||
-- figure out 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"! cf #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
|
|
||||||
in
|
|
||||||
-- if there's 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)
|
|
||||||
|
|
||||||
-- Make posting 1 if possible, with special support for old syntax, to
|
-- Make posting 1 if possible, with special support for old syntax, to
|
||||||
-- support pre-1.16 rules.
|
-- support pre-1.16 rules.
|
||||||
posting1 = mkPosting "1"
|
posting1 = mkPosting rules record "1"
|
||||||
("account1" `withAlias` "account")
|
("account1" `withAlias` "account")
|
||||||
("amount1" `withAlias` "amount")
|
("amount1" `withAlias` "amount")
|
||||||
("amount1-in" `withAlias` "amount-in")
|
("amount1-in" `withAlias` "amount-in")
|
||||||
("amount1-out" `withAlias` "amount-out")
|
("amount1-out" `withAlias` "amount-out")
|
||||||
("balance1" `withAlias` "balance")
|
("balance1" `withAlias` "balance")
|
||||||
"comment1" -- comment1 does not have legacy alias
|
"comment1" -- comment1 does not have legacy alias
|
||||||
|
t
|
||||||
where
|
where
|
||||||
withAlias fld alias =
|
withAlias fld alias =
|
||||||
case (field fld, field alias) of
|
case (field fld, field alias) of
|
||||||
@ -914,9 +844,10 @@ transactionFromCsvRecord sourcepos rules record = t
|
|||||||
postings = catMaybes $ posting1 : otherpostings
|
postings = catMaybes $ posting1 : otherpostings
|
||||||
where
|
where
|
||||||
otherpostings = [mkPostingN i | x<-[2..9], let i = show x]
|
otherpostings = [mkPostingN i | x<-[2..9], let i = show x]
|
||||||
mkPostingN n = mkPosting n
|
where
|
||||||
|
mkPostingN n = mkPosting rules record n
|
||||||
("account"++n) ("amount"++n) ("amount"++n++"-in")
|
("account"++n) ("amount"++n) ("amount"++n++"-in")
|
||||||
("amount"++n++"-out") ("balance"++n) ("comment"++n)
|
("amount"++n++"-out") ("balance"++n) ("comment"++n) t
|
||||||
|
|
||||||
-- Adjust the postings to mimic some pre-1.16 behaviour, for compatibility.
|
-- Adjust the postings to mimic some pre-1.16 behaviour, for compatibility.
|
||||||
-- And also, wherever default "unknown" accounts were used,
|
-- And also, wherever default "unknown" accounts were used,
|
||||||
@ -949,7 +880,7 @@ transactionFromCsvRecord sourcepos rules record = t
|
|||||||
improveUnless final = if final then id else improveUnknownAccountName
|
improveUnless final = if final then id else improveUnknownAccountName
|
||||||
|
|
||||||
----------------------------------------------------------------------
|
----------------------------------------------------------------------
|
||||||
-- 4. Build the transaction (and name it, so postings can reference it).
|
-- 3. Build the transaction (and name it, so the postings can reference it).
|
||||||
|
|
||||||
t = nulltransaction{
|
t = nulltransaction{
|
||||||
tsourcepos = genericSourcePos sourcepos -- the CSV line number
|
tsourcepos = genericSourcePos sourcepos -- the CSV line number
|
||||||
@ -963,6 +894,83 @@ transactionFromCsvRecord sourcepos rules record = t
|
|||||||
,tpostings = postings'
|
,tpostings = postings'
|
||||||
}
|
}
|
||||||
|
|
||||||
|
-- | 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))
|
||||||
|
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) mempty) "" $
|
||||||
|
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.
|
-- | Default account names to use when needed.
|
||||||
unknownExpenseAccount = "expenses:unknown"
|
unknownExpenseAccount = "expenses:unknown"
|
||||||
unknownIncomeAccount = "income:unknown"
|
unknownIncomeAccount = "income:unknown"
|
||||||
|
Loading…
Reference in New Issue
Block a user