parsing: alias/end aliases directives, like ledger's but a bit more powerful

MANUAL.md

@@ -436,6 +436,46 @@ Included files are also affected, eg:
     !include personal.journal
     !end
 
+### Account aliases
+
+You can define account aliases to rewrite certain account names (and their subaccounts).
+The format is `alias ORIGACCT = ALIAS`. Use `end aliases` to forget all previously defined aliases.
+
+Here's an example: say a sole proprietor has a personal.journal:
+
+    1/1
+        expenses:food  $1
+        assets:cash
+
+and a business.journal:
+
+    1/1
+        expenses:office supplies  $1
+        assets:business checking
+
+Here each entity has a simple journal with its own simple chart of
+accounts.  But at tax reporting time, we need to view these as a single
+entity.  So in unified.journal we adjust the personal account names to fit
+within the business chart of accounts:
+
+    alias expenses    = equity:draw:personal
+    alias assets:cash = assets:personal cash
+    include personal.journal
+    end aliases
+    include business.journal
+
+giving:
+
+    $ hledger -f unified.journal print
+    2011/01/01
+        equity:draw:personal:food            $1
+        assets:personal cash                $-1
+    
+    2011/01/01
+        expenses:office supplies            $1
+        assets:business checking           $-1
+
+
 ## Core commands
 
 These commands are provided by the main hledger package and are always

hledger-lib/Hledger/Data/Journal.hs

@@ -56,7 +56,7 @@ nulljournal = Journal { jmodifiertxns = []
                       }
 
 nullctx :: JournalContext
-nullctx = Ctx { ctxYear = Nothing, ctxCommodity = Nothing, ctxAccount = [] }
+nullctx = Ctx { ctxYear = Nothing, ctxCommodity = Nothing, ctxAccount = [], ctxAliases = [] }
 
 nullfilterspec :: FilterSpec
 nullfilterspec = FilterSpec {

hledger-lib/Hledger/Data/Types.hs

@@ -150,6 +150,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
     } deriving (Read, Show, Eq)
 
 data Journal = Journal {

hledger-lib/Hledger/Read/JournalReader.hs

@@ -202,6 +202,8 @@ ledgerDirective = do
   optional $ char '!'
   choice' [
     ledgerInclude
+   ,ledgerAlias
+   ,ledgerEndAliases
    ,ledgerAccountBegin
    ,ledgerAccountEnd
    ,ledgerTagDirective
@@ -248,6 +250,23 @@ ledgerAccountEnd = do
   popParentAccount
   return (return id)
 
+ledgerAlias :: GenParser Char JournalContext JournalUpdate
+ledgerAlias = do
+  string "alias"
+  many1 spacenonewline
+  orig <- many1 $ noneOf "="
+  char '='
+  alias <- restofline
+  addAccountAlias (accountNameWithoutPostingType $ strip orig
+                  ,accountNameWithoutPostingType $ strip alias)
+  return $ return id
+
+ledgerEndAliases :: GenParser Char JournalContext JournalUpdate
+ledgerEndAliases = do
+  string "end aliases"
+  clearAccountAliases
+  return (return id)
+
 ledgerTagDirective :: GenParser Char JournalContext JournalUpdate
 ledgerTagDirective = do
   string "tag" <?> "tag directive"
@@ -447,7 +466,7 @@ ledgerposting = do
   many1 spacenonewline
   status <- ledgerstatus
   many spacenonewline
-  account <- transactionaccountname
+  account <- modifiedaccountname
   let (ptype, account') = (accountNamePostingType account, unbracket account)
   amount <- postingamount
   many spacenonewline
@@ -456,9 +475,19 @@ ledgerposting = do
   md <- ledgermetadata
   return (Posting status account' amount comment ptype md Nothing)
 
--- Prepend any parent account currently in effect.
-transactionaccountname :: GenParser Char JournalContext AccountName
-transactionaccountname = liftM2 joinAccountNames getParentAccount ledgeraccountname
+-- Parse an account name, then apply any parent account prefix and/or account aliases currently in effect.
+modifiedaccountname :: GenParser Char JournalContext AccountName
+modifiedaccountname = do
+  a <- ledgeraccountname
+  prefix <- getParentAccount
+  let prefixed = prefix `joinAccountNames` a
+  aliases <- getAccountAliases
+  let t = accountNamePostingType prefixed
+      a' = accountNameWithoutPostingType prefixed
+      match = headDef Nothing $ map Just $ filter (\(orig,_) -> orig == a' || orig `isAccountNamePrefixOf` a') aliases
+      rewritten = maybe a' (\(orig,alias) -> alias++drop (length orig) a') match
+      withtype = accountNameWithPostingType t rewritten
+  return withtype
 
 -- | Parse an account name. Account names may have single spaces inside
 -- them, and are terminated by two or more spaces. They should have one or

hledger-lib/Hledger/Read/Utils.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE RecordWildCards #-}
 {-|
 Utilities common to hledger journal readers.
 -}
@@ -62,6 +63,15 @@ popParentAccount = do ctx0 <- getState
 getParentAccount :: GenParser tok JournalContext String
 getParentAccount = liftM (concatAccountNames . reverse . ctxAccount) getState
 
+addAccountAlias :: (AccountName,AccountName) -> GenParser tok JournalContext ()
+addAccountAlias a = updateState (\(ctx@Ctx{..}) -> ctx{ctxAliases=a:ctxAliases})
+
+getAccountAliases :: GenParser tok JournalContext [(AccountName,AccountName)]
+getAccountAliases = liftM ctxAliases getState
+
+clearAccountAliases :: GenParser tok JournalContext ()
+clearAccountAliases = updateState (\(ctx@Ctx{..}) -> ctx{ctxAliases=[]})
+
 -- | Convert a possibly relative, possibly tilde-containing file path to an absolute one.
 -- using the current directory from a parsec source position. ~username is not supported.
 expandPath :: (MonadIO m) => SourcePos -> FilePath -> m FilePath

hledger/Hledger/Cli.hs

@@ -96,6 +96,11 @@ tests_Hledger_Cli = TestList
 
    ]
 
+   ,"account aliases" ~: do
+      Right j <- readJournal Nothing "!alias expenses = equity:draw:personal\n1/1\n (expenses:food)  1\n"
+      let p = head $ tpostings $ head $ jtxns j
+      assertBool "" $ paccount p == "equity:draw:personal:food"
+
   ,"ledgerAccountNames" ~:
     ledgerAccountNames ledger7 `is`
      ["assets","assets:cash","assets:checking","assets:saving","equity","equity:opening balances",