apply all matching account aliases, not just one directive and one option

This commit is contained in:
Simon Michael 2014-10-29 08:20:27 -07:00
parent 9fa22e0398
commit d25fe21834
3 changed files with 26 additions and 16 deletions

View File

@ -37,6 +37,7 @@ module Hledger.Data.Posting (
joinAccountNames, joinAccountNames,
concatAccountNames, concatAccountNames,
accountNameApplyAliases, accountNameApplyAliases,
accountNameApplyOneAlias,
-- * arithmetic -- * arithmetic
sumPostings, sumPostings,
-- * rendering -- * rendering
@ -218,9 +219,17 @@ concatAccountNames :: [AccountName] -> AccountName
concatAccountNames as = accountNameWithPostingType t $ intercalate ":" $ map accountNameWithoutPostingType as concatAccountNames as = accountNameWithPostingType t $ intercalate ":" $ map accountNameWithoutPostingType as
where t = headDef RegularPosting $ filter (/= RegularPosting) $ map accountNamePostingType as where t = headDef RegularPosting $ filter (/= RegularPosting) $ map accountNamePostingType as
-- | Rewrite an account name using the first applicable alias from the given list, if any. -- | Rewrite an account name using all applicable aliases from the given list, in sequence.
accountNameApplyAliases :: [AccountAlias] -> AccountName -> AccountName accountNameApplyAliases :: [AccountAlias] -> AccountName -> AccountName
accountNameApplyAliases aliases a = accountNameWithPostingType atype aname' accountNameApplyAliases aliases a = accountNameWithPostingType atype aname'
where
(aname,atype) = (accountNameWithoutPostingType a, accountNamePostingType a)
matchingaliases = filter (\(re,_) -> regexMatchesCI re aname) aliases
aname' = foldl (flip (uncurry regexReplaceCI)) aname matchingaliases
-- | Rewrite an account name using the first applicable alias from the given list, if any.
accountNameApplyOneAlias :: [AccountAlias] -> AccountName -> AccountName
accountNameApplyOneAlias aliases a = accountNameWithPostingType atype aname'
where where
(aname,atype) = (accountNameWithoutPostingType a, accountNamePostingType a) (aname,atype) = (accountNameWithoutPostingType a, accountNamePostingType a)
firstmatchingalias = headDef Nothing $ map Just $ filter (\(re,_) -> regexMatchesCI re aname) aliases firstmatchingalias = headDef Nothing $ map Just $ filter (\(re,_) -> regexMatchesCI re aname) aliases

View File

@ -58,7 +58,7 @@ import Hledger.Utils.UTF8IOCompat (error')
-- | Regular expression. Extended regular expression-ish syntax ? But does not support eg (?i) syntax. -- | Regular expression. Extended regular expression-ish syntax ? But does not support eg (?i) syntax.
type Regexp = String type Regexp = String
-- | A replacement pattern. May include backreferences (\N). -- | A replacement pattern. May include numeric backreferences (\N).
type Replacement = String type Replacement = String
-- | Convert our string-based regexps to real ones. Can fail if the -- | Convert our string-based regexps to real ones. Can fail if the
@ -91,8 +91,9 @@ regexReplaceBy r = replaceAllBy (toRegex r)
regexReplaceByCI :: Regexp -> (String -> String) -> String -> String regexReplaceByCI :: Regexp -> (String -> String) -> String -> String
regexReplaceByCI r = replaceAllBy (toRegexCI r) regexReplaceByCI r = replaceAllBy (toRegexCI r)
-- | Replace all occurrences of the regexp with the replacement pattern. -- | Replace all occurrences of the regexp with the replacement
-- The replacement pattern supports \N backreferences but no other RE syntax. -- pattern. The replacement pattern supports numeric backreferences
-- (\N) but no other RE syntax.
regexReplace :: Regexp -> Replacement -> String -> String regexReplace :: Regexp -> Replacement -> String -> String
regexReplace re = replaceRegex (toRegex re) regexReplace re = replaceRegex (toRegex re)

View File

@ -1,10 +1,11 @@
# alias-related tests # alias-related tests
# 1. alias directive. The pattern is a case-insensitive regular # 1. alias directive. The pattern is a case-insensitive regular
# expression matching anywhere in the account name. Only the most # expression matching anywhere in the account name. All matching
# recently declared matching alias is applied to an account name. The # aliases will be applied to an account name in turn, most recently
# replacement can replace multiple matches within the account name. # declared first. The replacement can replace multiple matches within
# The replacement pattern does not yet support match references. # the account name. The replacement pattern supports numeric
# backreferences.
# #
hledgerdev -f- print hledgerdev -f- print
<<< <<<
@ -29,14 +30,14 @@ alias A (.)=\1
c -3 c -3
2011/01/01 2011/01/01
a 1 b 1
a 2 b 2
c -3 c -3
>>>=0 >>>=0
# 2. command-line --alias option. Only the first matching alias is # 2. command-line --alias option. These are applied in the order
# applied per account name. Spaces are allowed if quoted. # written. Spaces are allowed if quoted.
# #
hledgerdev -f- print --alias 'A (.)=a' --alias a=b hledgerdev -f- print --alias 'A (.)=a' --alias a=b
<<< <<<
@ -47,14 +48,13 @@ hledgerdev -f- print --alias 'A (.)=a' --alias a=b
>>> >>>
2011/01/01 2011/01/01
a 1 b 1
a 2 b 2
c -3 c -3
>>>=0 >>>=0
# 3. Alias options run after alias directives. At most one of each is # 3. Alias options run after alias directives.
# applied.
# #
hledgerdev -f- print --alias a=A --alias B=C --alias B=D --alias C=D hledgerdev -f- print --alias a=A --alias B=C --alias B=D --alias C=D
<<< <<<