parsing: aliases now match by regular expression

alias match patterns (the part left of the =) are now case-insensitive
regular expressions matching anywhere in the account name. The
replacement string (the part right of the =) can replace multiple
matches within the account name. The replacement string does not yet
support any of the usual syntax like backreferences.
This commit is contained in:
Simon Michael 2014-10-24 15:05:10 -07:00
parent be9b637e0c
commit e892fdc6d5
5 changed files with 67 additions and 31 deletions

View File

@ -385,8 +385,14 @@ filterJournalTransactionsByAccount apats j@Journal{jtxns=ts} = j{jtxns=filter tm
-}
-- | Apply additional account aliases (eg from the command-line) to all postings in a journal.
journalApplyAliases :: [(AccountName,AccountName)] -> Journal -> Journal
journalApplyAliases aliases j@Journal{jtxns=ts} = j{jtxns=map fixtransaction ts}
journalApplyAliases :: [AccountAlias] -> Journal -> Journal
journalApplyAliases aliases j@Journal{jtxns=ts} =
-- (if null aliases
-- then id
-- else (dbgtrace $
-- "applying additional command-line aliases:\n"
-- ++ chomp (unlines $ map (" "++) $ lines $ ppShow aliases))) $
j{jtxns=map fixtransaction ts}
where
fixtransaction t@Transaction{tpostings=ps} = t{tpostings=map fixposting ps}
fixposting p@Posting{paccount=a} = p{paccount=accountNameApplyAliases aliases a}

View File

@ -219,13 +219,13 @@ concatAccountNames as = accountNameWithPostingType t $ intercalate ":" $ map acc
where t = headDef RegularPosting $ filter (/= RegularPosting) $ map accountNamePostingType as
-- | Rewrite an account name using the first applicable alias from the given list, if any.
accountNameApplyAliases :: [(AccountName,AccountName)] -> AccountName -> AccountName
accountNameApplyAliases aliases a = withorigtype
where
(a',t) = (accountNameWithoutPostingType a, accountNamePostingType a)
firstmatchingalias = headDef Nothing $ map Just $ filter (\(orig,_) -> orig == a' || orig `isAccountNamePrefixOf` a') aliases
rewritten = maybe a' (\(orig,alias) -> alias++drop (length orig) a') firstmatchingalias
withorigtype = accountNameWithPostingType t rewritten
accountNameApplyAliases :: [AccountAlias] -> AccountName -> AccountName
accountNameApplyAliases aliases a = accountNameWithPostingType atype aname'
where
(aname,atype) = (accountNameWithoutPostingType a, accountNamePostingType a)
firstmatchingalias = headDef Nothing $ map Just $ filter (\(re,_) -> regexMatchesCI re aname) aliases
applyAlias = uncurry regexReplaceCI
aname' = maybe id applyAlias firstmatchingalias $ aname
tests_Hledger_Data_Posting = TestList [

View File

@ -31,6 +31,8 @@ import Data.Time.LocalTime
import System.Time (ClockTime(..))
import Text.Parsec.Pos
import Hledger.Utils.Regex
type SmartDate = (String,String,String)
@ -46,6 +48,8 @@ data Interval = NoInterval
type AccountName = String
type AccountAlias = (Regexp,Replacement)
data Side = L | R deriving (Eq,Show,Read,Ord,Typeable,Data)
type Commodity = String
@ -172,7 +176,7 @@ data JournalContext = Ctx {
, ctxAccount :: ![AccountName] -- ^ the current stack of parent accounts/account name components
-- specified with "account" directive(s). Concatenated, these
-- are the account prefix prepended to parsed account names.
, ctxAliases :: ![(AccountName,AccountName)] -- ^ the current list of account name aliases in effect
, ctxAliases :: ![AccountAlias] -- ^ the current list of account name aliases in effect
} deriving (Read, Show, Eq, Data, Typeable)
deriving instance Data (ClockTime)

View File

@ -134,10 +134,10 @@ popParentAccount = do ctx0 <- getState
getParentAccount :: GenParser tok JournalContext String
getParentAccount = liftM (concatAccountNames . reverse . ctxAccount) getState
addAccountAlias :: (AccountName,AccountName) -> GenParser tok JournalContext ()
addAccountAlias :: AccountAlias -> GenParser tok JournalContext ()
addAccountAlias a = updateState (\(ctx@Ctx{..}) -> ctx{ctxAliases=a:ctxAliases})
getAccountAliases :: GenParser tok JournalContext [(AccountName,AccountName)]
getAccountAliases :: GenParser tok JournalContext [AccountAlias]
getAccountAliases = liftM ctxAliases getState
clearAccountAliases :: GenParser tok JournalContext ()

View File

@ -1,40 +1,66 @@
# alias-related tests
# 1. command-line --alias option. Note multiple applicable aliases, but
# only one is applied per account name. Spaces are allowed if quoted.
hledgerdev -f- print --alias 'a a=A' --alias b=B
# 1. alias directive. The pattern is a case-insensitive regular
# expression matching anywhere in the account name. Only the most
# recently declared matching alias is applied to an account name. The
# replacement can replace multiple matches within the account name.
# The replacement pattern does not yet support match references.
#
hledgerdev -f- print
<<<
alias a=b
2011/01/01
a a 1
A a 1
a a 2
c
alias A (.)=\1
2011/01/01
A a 1
a a 2
c
>>>
2011/01/01
A 1
c -1
b b 1
b b 2
c -3
2011/01/01
\1 1
\1 2
c -3
>>>=0
# 2. alias directive, and an account with unbalanced posting indicators.
hledgerdev -f- print
# 2. command-line --alias option. Only the first matching alias is
# applied per account name. Spaces are allowed if quoted.
#
hledgerdev -f- print --alias 'A (.)=a' --alias a=b
<<<
alias b=B
2011/01/01
(b) 1
a a 1
A a 2
c
>>>
2011/01/01
(B) 1
a 1
a 2
c -3
>>>=0
# 3. --alias options run after alias directives. Subaccounts are also
# matched and rewritten. Accounts with an internal part matching the alias
# are ignored.
hledgerdev -f- print --alias a=A --alias B=C
# 3. Alias options run after alias directives. At most one of each is
# applied.
#
hledgerdev -f- print --alias a=A --alias B=C --alias B=D --alias C=D
<<<
alias a=B
alias ^a=B
alias ^a=E
alias E=F
2011/01/01
[a:x] 1
@ -42,8 +68,8 @@ alias a=B
>>>
2011/01/01
[C:x] 1
[x:a:x] -1
[E:x] 1
[x:A:x] -1
>>>2
>>>=0