mirror of
https://github.com/simonmichael/hledger.git
synced 2024-12-27 04:13:11 +03:00
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:
parent
be9b637e0c
commit
e892fdc6d5
@ -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}
|
||||
|
@ -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 [
|
||||
|
||||
|
@ -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)
|
||||
|
@ -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 ()
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user