From e892fdc6d5b4d2cb0973c42ec95a836cdd91b978 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Fri, 24 Oct 2014 15:05:10 -0700 Subject: [PATCH] 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. --- hledger-lib/Hledger/Data/Journal.hs | 10 +++- hledger-lib/Hledger/Data/Posting.hs | 14 ++--- hledger-lib/Hledger/Data/Types.hs | 6 ++- hledger-lib/Hledger/Read/JournalReader.hs | 4 +- tests/misc/aliases.test | 64 ++++++++++++++++------- 5 files changed, 67 insertions(+), 31 deletions(-) diff --git a/hledger-lib/Hledger/Data/Journal.hs b/hledger-lib/Hledger/Data/Journal.hs index e321022c3..1648a575f 100644 --- a/hledger-lib/Hledger/Data/Journal.hs +++ b/hledger-lib/Hledger/Data/Journal.hs @@ -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} diff --git a/hledger-lib/Hledger/Data/Posting.hs b/hledger-lib/Hledger/Data/Posting.hs index ddfd18e4b..83fb841ce 100644 --- a/hledger-lib/Hledger/Data/Posting.hs +++ b/hledger-lib/Hledger/Data/Posting.hs @@ -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 [ diff --git a/hledger-lib/Hledger/Data/Types.hs b/hledger-lib/Hledger/Data/Types.hs index 858a88446..b683df327 100644 --- a/hledger-lib/Hledger/Data/Types.hs +++ b/hledger-lib/Hledger/Data/Types.hs @@ -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) diff --git a/hledger-lib/Hledger/Read/JournalReader.hs b/hledger-lib/Hledger/Read/JournalReader.hs index 7d35e9e35..13e72fea6 100644 --- a/hledger-lib/Hledger/Read/JournalReader.hs +++ b/hledger-lib/Hledger/Read/JournalReader.hs @@ -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 () diff --git a/tests/misc/aliases.test b/tests/misc/aliases.test index 64ea2f918..9e9c732ae 100644 --- a/tests/misc/aliases.test +++ b/tests/misc/aliases.test @@ -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