diff --git a/hledger-lib/Hledger/Data/Journal.hs b/hledger-lib/Hledger/Data/Journal.hs index 837e57077..a101212c4 100644 --- a/hledger-lib/Hledger/Data/Journal.hs +++ b/hledger-lib/Hledger/Data/Journal.hs @@ -79,6 +79,7 @@ module Hledger.Data.Journal ( journalNumberAndTieTransactions, journalUntieTransactions, journalModifyTransactions, + journalApplyAliases, -- * Tests samplejournal, tests_Journal, @@ -1226,6 +1227,11 @@ postingPivot fieldortagname p = p{paccount = pivotedacct, poriginal = Just $ ori postingFindTag :: TagName -> Posting -> Maybe (TagName, TagValue) postingFindTag tagname p = find ((tagname==) . fst) $ postingAllTags p +-- | Apply some account aliases to all posting account names in the journal, as described by accountNameApplyAliases. +-- This can raise an error arising from a bad replacement pattern in a regular expression alias. +journalApplyAliases :: [AccountAlias] -> Journal -> Journal +journalApplyAliases aliases j = j{jtxns = map (transactionApplyAliases aliases) $ jtxns j} -- PARTIAL: + -- -- | Build a database of market prices in effect on the given date, -- -- from the journal's price directives. -- journalPrices :: Day -> Journal -> Prices diff --git a/hledger-lib/Hledger/Data/Posting.hs b/hledger-lib/Hledger/Data/Posting.hs index 006fb19ce..fd401e319 100644 --- a/hledger-lib/Hledger/Data/Posting.hs +++ b/hledger-lib/Hledger/Data/Posting.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE NamedFieldPuns #-} {-| A 'Posting' represents a change (by some 'MixedAmount') of the balance in @@ -37,6 +38,7 @@ module Hledger.Data.Posting ( transactionAllTags, relatedPostings, removePrices, + postingApplyAliases, -- * date operations postingDate, postingDate2, @@ -288,6 +290,16 @@ concatAccountNames :: [AccountName] -> AccountName concatAccountNames as = accountNameWithPostingType t $ T.intercalate ":" $ map accountNameWithoutPostingType as where t = headDef RegularPosting $ filter (/= RegularPosting) $ map accountNamePostingType as +-- | Apply some account aliases to the posting's account name, as described by accountNameApplyAliases. +-- This can raise an error arising from a bad replacement pattern in a regular expression alias. +postingApplyAliases :: [AccountAlias] -> Posting -> Posting +postingApplyAliases aliases p@Posting{paccount} = + case accountNameApplyAliases aliases paccount of + Right a -> p{paccount=a} + Left e -> error' err -- PARTIAL: + where + err = "problem in account aliases:\n" ++ pshow aliases ++ "\n applied to account name: "++T.unpack paccount++"\n "++e + -- | Rewrite an account name using all matching aliases from the given list, in sequence. -- Each alias sees the result of applying the previous aliases. -- Or, return any error arising from a bad regular expression in the aliases. diff --git a/hledger-lib/Hledger/Data/Transaction.hs b/hledger-lib/Hledger/Data/Transaction.hs index ae584ed48..4dc562104 100644 --- a/hledger-lib/Hledger/Data/Transaction.hs +++ b/hledger-lib/Hledger/Data/Transaction.hs @@ -33,6 +33,7 @@ module Hledger.Data.Transaction ( transactionTransformPostings, transactionApplyValuation, transactionToCost, + transactionApplyAliases, -- nonzerobalanceerror, -- * date operations transactionDate2, @@ -591,6 +592,12 @@ transactionApplyValuation priceoracle styles periodlast mreportlast today ismult transactionToCost :: M.Map CommoditySymbol AmountStyle -> Transaction -> Transaction transactionToCost styles t@Transaction{tpostings=ps} = t{tpostings=map (postingToCost styles) ps} +-- | Apply some account aliases to all posting account names in the transaction, as described by accountNameApplyAliases. +-- This can raise an error arising from a bad replacement pattern in a regular expression alias. +transactionApplyAliases :: [AccountAlias] -> Transaction -> Transaction +transactionApplyAliases aliases t = + txnTieKnot $ t{tpostings = map (postingApplyAliases aliases) $ tpostings t} -- PARTIAL: + -- tests tests_Transaction :: TestTree diff --git a/hledger-lib/Hledger/Read.hs b/hledger-lib/Hledger/Read.hs index 84a3a270d..c9e2a3c9a 100644 --- a/hledger-lib/Hledger/Read.hs +++ b/hledger-lib/Hledger/Read.hs @@ -32,7 +32,6 @@ module Hledger.Read ( readJournal', -- * Re-exported - JournalReader.accountaliasp, JournalReader.postingp, findReader, splitReaderPrefix, diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs index 6a9072ff2..358c9c150 100644 --- a/hledger-lib/Hledger/Read/Common.hs +++ b/hledger-lib/Hledger/Read/Common.hs @@ -75,6 +75,9 @@ module Hledger.Read.Common ( modifiedaccountnamep, accountnamep, + -- ** account aliases + accountaliasp, + -- ** amounts spaceandamountormissingp, amountp, @@ -103,9 +106,9 @@ module Hledger.Read.Common ( singlespacedtextp, singlespacedtextsatisfyingp, singlespacep, - skipNonNewlineSpaces, skipNonNewlineSpaces1, + aliasesFromOpts, -- * tests tests_Common, @@ -279,6 +282,7 @@ parseAndFinaliseJournal parser iopts f txt = do Right pj -> journalFinalise iopts f txt pj -- | Like parseAndFinaliseJournal but takes a (non-Erroring) JournalParser. +-- Also, applies command-line account aliases before finalising. -- Used for timeclock/timedot. -- TODO: get rid of this, use parseAndFinaliseJournal instead parseAndFinaliseJournal' :: JournalParser IO ParsedJournal -> InputOpts @@ -292,7 +296,10 @@ parseAndFinaliseJournal' parser iopts f txt = do -- see notes above case ep of Left e -> throwError $ customErrorBundlePretty e - Right pj -> journalFinalise iopts f txt pj + Right pj -> journalFinalise iopts f txt $ + -- apply any command line account aliases. Can fail with a bad replacement pattern. + journalApplyAliases (aliasesFromOpts iopts) $ -- PARTIAL: + pj -- | Post-process a Journal that has just been parsed or generated, in this order: -- @@ -1371,6 +1378,39 @@ bracketeddatetagsp mYear1 = do {-# INLINABLE bracketeddatetagsp #-} +-- | Get the account name aliases from options, if any. +aliasesFromOpts :: InputOpts -> [AccountAlias] +aliasesFromOpts = map (\a -> fromparse $ runParser accountaliasp ("--alias "++quoteIfNeeded a) $ T.pack a) + . aliases_ + +accountaliasp :: TextParser m AccountAlias +accountaliasp = regexaliasp <|> basicaliasp + +basicaliasp :: TextParser m AccountAlias +basicaliasp = do + -- dbgparse 0 "basicaliasp" + old <- rstrip <$> (some $ noneOf ("=" :: [Char])) + char '=' + skipNonNewlineSpaces + new <- rstrip <$> anySingle `manyTill` eolof -- eol in journal, eof in command lines, normally + return $ BasicAlias (T.pack old) (T.pack new) + +regexaliasp :: TextParser m AccountAlias +regexaliasp = do + -- dbgparse 0 "regexaliasp" + char '/' + off1 <- getOffset + re <- some $ noneOf ("/\n\r" :: [Char]) -- paranoid: don't try to read past line end + off2 <- getOffset + char '/' + skipNonNewlineSpaces + char '=' + skipNonNewlineSpaces + repl <- anySingle `manyTill` eolof + case toRegexCI re of + Right r -> return $! RegexAlias r repl + Left e -> customFailure $! parseErrorAtRegion off1 off2 e + --- ** tests tests_Common = tests "Common" [ diff --git a/hledger-lib/Hledger/Read/CsvReader.hs b/hledger-lib/Hledger/Read/CsvReader.hs index d69e3794b..ab93a3ce8 100644 --- a/hledger-lib/Hledger/Read/CsvReader.hs +++ b/hledger-lib/Hledger/Read/CsvReader.hs @@ -78,7 +78,7 @@ import Text.Printf (printf) import Hledger.Data import Hledger.Utils -import Hledger.Read.Common ( Reader(..),InputOpts(..), amountp, statusp, genericSourcePos, journalFinalise ) +import Hledger.Read.Common (aliasesFromOpts, Reader(..),InputOpts(..), amountp, statusp, genericSourcePos, journalFinalise ) --- ** doctest setup -- $setup @@ -108,13 +108,15 @@ parse iopts f t = do let rulesfile = mrules_file_ iopts r <- liftIO $ readJournalFromCsv rulesfile f t case r of Left e -> throwError e - Right pj -> journalFinalise iopts{ignore_assertions_=True} f t pj' + Right pj -> journalFinalise iopts{ignore_assertions_=True} f t pj'' where -- journalFinalise assumes the journal's items are -- reversed, as produced by JournalReader's parser. -- But here they are already properly ordered. So we'd -- better preemptively reverse them once more. XXX inefficient pj' = journalReverse pj + -- apply any command line account aliases. Can fail with a bad replacement pattern. + pj'' = journalApplyAliases (aliasesFromOpts iopts) pj' -- PARTIAL: --- ** reading rules files --- *** rules utilities diff --git a/hledger-lib/Hledger/Read/JournalReader.hs b/hledger-lib/Hledger/Read/JournalReader.hs index 509069f8f..0b941e309 100644 --- a/hledger-lib/Hledger/Read/JournalReader.hs +++ b/hledger-lib/Hledger/Read/JournalReader.hs @@ -179,11 +179,6 @@ parse iopts = parseAndFinaliseJournal journalp' iopts mapM_ addAccountAlias (reverse $ aliasesFromOpts iopts) journalp --- | Get the account name aliases from options, if any. -aliasesFromOpts :: InputOpts -> [AccountAlias] -aliasesFromOpts = map (\a -> fromparse $ runParser accountaliasp ("--alias "++quoteIfNeeded a) $ T.pack a) - . aliases_ - --- ** parsers --- *** journal @@ -505,34 +500,6 @@ aliasdirectivep = do alias <- lift accountaliasp addAccountAlias alias -accountaliasp :: TextParser m AccountAlias -accountaliasp = regexaliasp <|> basicaliasp - -basicaliasp :: TextParser m AccountAlias -basicaliasp = do - -- dbgparse 0 "basicaliasp" - old <- rstrip <$> (some $ noneOf ("=" :: [Char])) - char '=' - skipNonNewlineSpaces - new <- rstrip <$> anySingle `manyTill` eolof -- eol in journal, eof in command lines, normally - return $ BasicAlias (T.pack old) (T.pack new) - -regexaliasp :: TextParser m AccountAlias -regexaliasp = do - -- dbgparse 0 "regexaliasp" - char '/' - off1 <- getOffset - re <- some $ noneOf ("/\n\r" :: [Char]) -- paranoid: don't try to read past line end - off2 <- getOffset - char '/' - skipNonNewlineSpaces - char '=' - skipNonNewlineSpaces - repl <- anySingle `manyTill` eolof - case toRegexCI re of - Right r -> return $! RegexAlias r repl - Left e -> customFailure $! parseErrorAtRegion off1 off2 e - endaliasesdirectivep :: JournalParser m () endaliasesdirectivep = do keywordsp "end aliases" "end aliases directive" diff --git a/hledger-lib/hledger_timedot.m4.md b/hledger-lib/hledger_timedot.m4.md index 2cdfa73be..09c300592 100644 --- a/hledger-lib/hledger_timedot.m4.md +++ b/hledger-lib/hledger_timedot.m4.md @@ -147,7 +147,7 @@ fos.hledger.timedot 4 fos.ledger .. ``` ```shell -$ hledger -f t.timedot --alias /\\./=: bal date:2016/2/4 +$ hledger -f t.timedot --alias /\\./=: bal date:2016/2/4 --tree 4.50 fos 4.00 hledger:timedot 0.50 ledger diff --git a/hledger/test/csv.test b/hledger/test/csv.test index c28bd6723..8311e50c3 100644 --- a/hledger/test/csv.test +++ b/hledger/test/csv.test @@ -926,7 +926,7 @@ $ ./csvtest.sh >= -# 46. +# 46. decimal-mark again < 2020-01-01,"1,000" 2020-01-02,"1.000" @@ -946,6 +946,19 @@ $ ./csvtest.sh >= +# 47. Account aliases work when reading from CSV. +< +2020-01-01,10 + +RULES +fields date,amount + +$ ./csvtest.sh --alias expenses=FOO +2020-01-01 + FOO:unknown 10 + income:unknown -10 + +>= ## . #< diff --git a/hledger/test/timeclock.test b/hledger/test/timeclock.test index d0ee26073..765a7d9e2 100644 --- a/hledger/test/timeclock.test +++ b/hledger/test/timeclock.test @@ -22,6 +22,19 @@ $ hledger -f timeclock:- print >2 >= 0 +# Command-line account aliases are applied. +$ hledger -ftimeclock:- print --alias '/account/=FOO' +2009-01-01 * 08:00-09:00 + () 1.00h + +2009-01-02 * 08:00-09:00 + (FOO name) 1.00h + +2009-01-03 * and a description + (some:FOO name) 1.00h + +>= 0 + # For a missing clock-out, now is implied < i 2020/1/1 08:00 diff --git a/hledger/test/timedot.test b/hledger/test/timedot.test index bee15d136..1525fe26a 100644 --- a/hledger/test/timedot.test +++ b/hledger/test/timedot.test @@ -29,3 +29,9 @@ $ hledger -ftimedot:- print >=0 +# 3. Command-line account aliases are applied. +$ hledger -ftimedot:- print --alias a=b +2020-01-01 * + (b:aa) 1.00 + +>=0