From 30b7448f454c0a48cb1b80656917dd5a49da3f96 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Thu, 4 Aug 2011 08:45:18 +0000 Subject: [PATCH] parsing: alias/end aliases directives, like ledger's but a bit more powerful --- MANUAL.md | 40 +++++++++++++++++++++++ hledger-lib/Hledger/Data/Journal.hs | 2 +- hledger-lib/Hledger/Data/Types.hs | 1 + hledger-lib/Hledger/Read/JournalReader.hs | 37 ++++++++++++++++++--- hledger-lib/Hledger/Read/Utils.hs | 10 ++++++ hledger/Hledger/Cli.hs | 5 +++ 6 files changed, 90 insertions(+), 5 deletions(-) diff --git a/MANUAL.md b/MANUAL.md index 2ab25c256..f3e70af93 100644 --- a/MANUAL.md +++ b/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 diff --git a/hledger-lib/Hledger/Data/Journal.hs b/hledger-lib/Hledger/Data/Journal.hs index fcdf67043..1067ffddf 100644 --- a/hledger-lib/Hledger/Data/Journal.hs +++ b/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 { diff --git a/hledger-lib/Hledger/Data/Types.hs b/hledger-lib/Hledger/Data/Types.hs index 20bd4fb34..434e14e27 100644 --- a/hledger-lib/Hledger/Data/Types.hs +++ b/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 { diff --git a/hledger-lib/Hledger/Read/JournalReader.hs b/hledger-lib/Hledger/Read/JournalReader.hs index 2010a96c8..4191037ac 100644 --- a/hledger-lib/Hledger/Read/JournalReader.hs +++ b/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 diff --git a/hledger-lib/Hledger/Read/Utils.hs b/hledger-lib/Hledger/Read/Utils.hs index 532a37c6d..34a1477b7 100644 --- a/hledger-lib/Hledger/Read/Utils.hs +++ b/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 diff --git a/hledger/Hledger/Cli.hs b/hledger/Hledger/Cli.hs index 7c5f5d0b7..ece77d9aa 100644 --- a/hledger/Hledger/Cli.hs +++ b/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",