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

@@ -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 :: [AccountAlias] -> Journal -> Journal
-journalApplyAliases aliases j@Journal{jtxns=ts} = j{jtxns=map fixtransaction ts}
+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}

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 :: [AccountAlias] -> AccountName -> AccountName
-accountNameApplyAliases aliases a = withorigtype
+accountNameApplyAliases aliases a = accountNameWithPostingType atype aname'
-    where
+  where
-      (a',t) = (accountNameWithoutPostingType a, accountNamePostingType a)
+    (aname,atype) = (accountNameWithoutPostingType a, accountNamePostingType a)
-      firstmatchingalias = headDef Nothing $ map Just $ filter (\(orig,_) -> orig == a' || orig `isAccountNamePrefixOf` a') aliases
+    firstmatchingalias = headDef Nothing $ map Just $ filter (\(re,_) -> regexMatchesCI re aname) aliases
-      rewritten = maybe a' (\(orig,alias) -> alias++drop (length orig) a') firstmatchingalias
+    applyAlias = uncurry regexReplaceCI
-      withorigtype = accountNameWithPostingType t rewritten
+    aname' = maybe id applyAlias firstmatchingalias $ aname
 
 tests_Hledger_Data_Posting = TestList [
 

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)

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 ()

tests/misc/aliases.test

@@ -1,40 +1,66 @@
 # alias-related tests
 
-# 1. command-line --alias option.  Note multiple applicable aliases, but
+# 1. alias directive. The pattern is a case-insensitive regular
-# only one is applied per account name.  Spaces are allowed if quoted.
+# expression matching anywhere in the account name. Only the most
-hledgerdev -f- print --alias 'a a=A' --alias b=B
+# 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
+    b b             1
-    c            -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.
+# 2. command-line --alias option. Only the first matching alias is
-hledgerdev -f- print
+# 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
+# 3. Alias options run after alias directives. At most one of each is
-# matched and rewritten. Accounts with an internal part matching the alias
+# applied.
-# are ignored.
+#
-hledgerdev -f- print --alias a=A --alias B=C
+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
+    [E:x]             1
-    [x:a:x]            -1
+    [x:A:x]            -1
 
 >>>2
 >>>=0