csv, timedot, timeclock: respect --alias options (fix #859)

Command-line account aliases now also affect transactions read
from these formats (not just journal format).

lib: journalApplyAliases, transactionApplyAliases, postingApplyAliases
helpers have been added.
This commit is contained in:
Simon Michael 2020-11-24 09:17:01 -08:00
parent 9b9f2543d8
commit 94b3f090be
11 changed files with 105 additions and 40 deletions

View File

@ -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

View File

@ -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.

View File

@ -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

View File

@ -32,7 +32,6 @@ module Hledger.Read (
readJournal',
-- * Re-exported
JournalReader.accountaliasp,
JournalReader.postingp,
findReader,
splitReaderPrefix,

View File

@ -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" [

View File

@ -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

View File

@ -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"

View File

@ -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

View File

@ -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
>=
## .
#<

View File

@ -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

View File

@ -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