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:
parent
9b9f2543d8
commit
94b3f090be
@ -79,6 +79,7 @@ module Hledger.Data.Journal (
|
|||||||
journalNumberAndTieTransactions,
|
journalNumberAndTieTransactions,
|
||||||
journalUntieTransactions,
|
journalUntieTransactions,
|
||||||
journalModifyTransactions,
|
journalModifyTransactions,
|
||||||
|
journalApplyAliases,
|
||||||
-- * Tests
|
-- * Tests
|
||||||
samplejournal,
|
samplejournal,
|
||||||
tests_Journal,
|
tests_Journal,
|
||||||
@ -1226,6 +1227,11 @@ postingPivot fieldortagname p = p{paccount = pivotedacct, poriginal = Just $ ori
|
|||||||
postingFindTag :: TagName -> Posting -> Maybe (TagName, TagValue)
|
postingFindTag :: TagName -> Posting -> Maybe (TagName, TagValue)
|
||||||
postingFindTag tagname p = find ((tagname==) . fst) $ postingAllTags p
|
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,
|
-- -- | Build a database of market prices in effect on the given date,
|
||||||
-- -- from the journal's price directives.
|
-- -- from the journal's price directives.
|
||||||
-- journalPrices :: Day -> Journal -> Prices
|
-- journalPrices :: Day -> Journal -> Prices
|
||||||
|
|||||||
@ -1,3 +1,4 @@
|
|||||||
|
{-# LANGUAGE NamedFieldPuns #-}
|
||||||
{-|
|
{-|
|
||||||
|
|
||||||
A 'Posting' represents a change (by some 'MixedAmount') of the balance in
|
A 'Posting' represents a change (by some 'MixedAmount') of the balance in
|
||||||
@ -37,6 +38,7 @@ module Hledger.Data.Posting (
|
|||||||
transactionAllTags,
|
transactionAllTags,
|
||||||
relatedPostings,
|
relatedPostings,
|
||||||
removePrices,
|
removePrices,
|
||||||
|
postingApplyAliases,
|
||||||
-- * date operations
|
-- * date operations
|
||||||
postingDate,
|
postingDate,
|
||||||
postingDate2,
|
postingDate2,
|
||||||
@ -288,6 +290,16 @@ concatAccountNames :: [AccountName] -> AccountName
|
|||||||
concatAccountNames as = accountNameWithPostingType t $ T.intercalate ":" $ map accountNameWithoutPostingType as
|
concatAccountNames as = accountNameWithPostingType t $ T.intercalate ":" $ map accountNameWithoutPostingType as
|
||||||
where t = headDef RegularPosting $ filter (/= RegularPosting) $ map accountNamePostingType 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.
|
-- | Rewrite an account name using all matching aliases from the given list, in sequence.
|
||||||
-- Each alias sees the result of applying the previous aliases.
|
-- Each alias sees the result of applying the previous aliases.
|
||||||
-- Or, return any error arising from a bad regular expression in the aliases.
|
-- Or, return any error arising from a bad regular expression in the aliases.
|
||||||
|
|||||||
@ -33,6 +33,7 @@ module Hledger.Data.Transaction (
|
|||||||
transactionTransformPostings,
|
transactionTransformPostings,
|
||||||
transactionApplyValuation,
|
transactionApplyValuation,
|
||||||
transactionToCost,
|
transactionToCost,
|
||||||
|
transactionApplyAliases,
|
||||||
-- nonzerobalanceerror,
|
-- nonzerobalanceerror,
|
||||||
-- * date operations
|
-- * date operations
|
||||||
transactionDate2,
|
transactionDate2,
|
||||||
@ -591,6 +592,12 @@ transactionApplyValuation priceoracle styles periodlast mreportlast today ismult
|
|||||||
transactionToCost :: M.Map CommoditySymbol AmountStyle -> Transaction -> Transaction
|
transactionToCost :: M.Map CommoditySymbol AmountStyle -> Transaction -> Transaction
|
||||||
transactionToCost styles t@Transaction{tpostings=ps} = t{tpostings=map (postingToCost styles) ps}
|
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
|
||||||
|
|
||||||
tests_Transaction :: TestTree
|
tests_Transaction :: TestTree
|
||||||
|
|||||||
@ -32,7 +32,6 @@ module Hledger.Read (
|
|||||||
readJournal',
|
readJournal',
|
||||||
|
|
||||||
-- * Re-exported
|
-- * Re-exported
|
||||||
JournalReader.accountaliasp,
|
|
||||||
JournalReader.postingp,
|
JournalReader.postingp,
|
||||||
findReader,
|
findReader,
|
||||||
splitReaderPrefix,
|
splitReaderPrefix,
|
||||||
|
|||||||
@ -75,6 +75,9 @@ module Hledger.Read.Common (
|
|||||||
modifiedaccountnamep,
|
modifiedaccountnamep,
|
||||||
accountnamep,
|
accountnamep,
|
||||||
|
|
||||||
|
-- ** account aliases
|
||||||
|
accountaliasp,
|
||||||
|
|
||||||
-- ** amounts
|
-- ** amounts
|
||||||
spaceandamountormissingp,
|
spaceandamountormissingp,
|
||||||
amountp,
|
amountp,
|
||||||
@ -103,9 +106,9 @@ module Hledger.Read.Common (
|
|||||||
singlespacedtextp,
|
singlespacedtextp,
|
||||||
singlespacedtextsatisfyingp,
|
singlespacedtextsatisfyingp,
|
||||||
singlespacep,
|
singlespacep,
|
||||||
|
|
||||||
skipNonNewlineSpaces,
|
skipNonNewlineSpaces,
|
||||||
skipNonNewlineSpaces1,
|
skipNonNewlineSpaces1,
|
||||||
|
aliasesFromOpts,
|
||||||
|
|
||||||
-- * tests
|
-- * tests
|
||||||
tests_Common,
|
tests_Common,
|
||||||
@ -279,6 +282,7 @@ parseAndFinaliseJournal parser iopts f txt = do
|
|||||||
Right pj -> journalFinalise iopts f txt pj
|
Right pj -> journalFinalise iopts f txt pj
|
||||||
|
|
||||||
-- | Like parseAndFinaliseJournal but takes a (non-Erroring) JournalParser.
|
-- | Like parseAndFinaliseJournal but takes a (non-Erroring) JournalParser.
|
||||||
|
-- Also, applies command-line account aliases before finalising.
|
||||||
-- Used for timeclock/timedot.
|
-- Used for timeclock/timedot.
|
||||||
-- TODO: get rid of this, use parseAndFinaliseJournal instead
|
-- TODO: get rid of this, use parseAndFinaliseJournal instead
|
||||||
parseAndFinaliseJournal' :: JournalParser IO ParsedJournal -> InputOpts
|
parseAndFinaliseJournal' :: JournalParser IO ParsedJournal -> InputOpts
|
||||||
@ -292,7 +296,10 @@ parseAndFinaliseJournal' parser iopts f txt = do
|
|||||||
-- see notes above
|
-- see notes above
|
||||||
case ep of
|
case ep of
|
||||||
Left e -> throwError $ customErrorBundlePretty e
|
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:
|
-- | Post-process a Journal that has just been parsed or generated, in this order:
|
||||||
--
|
--
|
||||||
@ -1371,6 +1378,39 @@ bracketeddatetagsp mYear1 = do
|
|||||||
|
|
||||||
{-# INLINABLE bracketeddatetagsp #-}
|
{-# 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
|
||||||
|
|
||||||
tests_Common = tests "Common" [
|
tests_Common = tests "Common" [
|
||||||
|
|||||||
@ -78,7 +78,7 @@ import Text.Printf (printf)
|
|||||||
|
|
||||||
import Hledger.Data
|
import Hledger.Data
|
||||||
import Hledger.Utils
|
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
|
--- ** doctest setup
|
||||||
-- $setup
|
-- $setup
|
||||||
@ -108,13 +108,15 @@ parse iopts f t = do
|
|||||||
let rulesfile = mrules_file_ iopts
|
let rulesfile = mrules_file_ iopts
|
||||||
r <- liftIO $ readJournalFromCsv rulesfile f t
|
r <- liftIO $ readJournalFromCsv rulesfile f t
|
||||||
case r of Left e -> throwError e
|
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
|
where
|
||||||
-- journalFinalise assumes the journal's items are
|
-- journalFinalise assumes the journal's items are
|
||||||
-- reversed, as produced by JournalReader's parser.
|
-- reversed, as produced by JournalReader's parser.
|
||||||
-- But here they are already properly ordered. So we'd
|
-- But here they are already properly ordered. So we'd
|
||||||
-- better preemptively reverse them once more. XXX inefficient
|
-- better preemptively reverse them once more. XXX inefficient
|
||||||
pj' = journalReverse pj
|
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
|
--- ** reading rules files
|
||||||
--- *** rules utilities
|
--- *** rules utilities
|
||||||
|
|||||||
@ -179,11 +179,6 @@ parse iopts = parseAndFinaliseJournal journalp' iopts
|
|||||||
mapM_ addAccountAlias (reverse $ aliasesFromOpts iopts)
|
mapM_ addAccountAlias (reverse $ aliasesFromOpts iopts)
|
||||||
journalp
|
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
|
--- ** parsers
|
||||||
--- *** journal
|
--- *** journal
|
||||||
|
|
||||||
@ -505,34 +500,6 @@ aliasdirectivep = do
|
|||||||
alias <- lift accountaliasp
|
alias <- lift accountaliasp
|
||||||
addAccountAlias alias
|
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 :: JournalParser m ()
|
||||||
endaliasesdirectivep = do
|
endaliasesdirectivep = do
|
||||||
keywordsp "end aliases" <?> "end aliases directive"
|
keywordsp "end aliases" <?> "end aliases directive"
|
||||||
|
|||||||
@ -147,7 +147,7 @@ fos.hledger.timedot 4
|
|||||||
fos.ledger ..
|
fos.ledger ..
|
||||||
```
|
```
|
||||||
```shell
|
```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.50 fos
|
||||||
4.00 hledger:timedot
|
4.00 hledger:timedot
|
||||||
0.50 ledger
|
0.50 ledger
|
||||||
|
|||||||
@ -926,7 +926,7 @@ $ ./csvtest.sh
|
|||||||
|
|
||||||
>=
|
>=
|
||||||
|
|
||||||
# 46.
|
# 46. decimal-mark again
|
||||||
<
|
<
|
||||||
2020-01-01,"1,000"
|
2020-01-01,"1,000"
|
||||||
2020-01-02,"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
|
||||||
|
|
||||||
|
>=
|
||||||
|
|
||||||
## .
|
## .
|
||||||
#<
|
#<
|
||||||
|
|||||||
@ -22,6 +22,19 @@ $ hledger -f timeclock:- print
|
|||||||
>2
|
>2
|
||||||
>= 0
|
>= 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
|
# For a missing clock-out, now is implied
|
||||||
<
|
<
|
||||||
i 2020/1/1 08:00
|
i 2020/1/1 08:00
|
||||||
|
|||||||
@ -29,3 +29,9 @@ $ hledger -ftimedot:- print
|
|||||||
|
|
||||||
>=0
|
>=0
|
||||||
|
|
||||||
|
# 3. Command-line account aliases are applied.
|
||||||
|
$ hledger -ftimedot:- print --alias a=b
|
||||||
|
2020-01-01 *
|
||||||
|
(b:aa) 1.00
|
||||||
|
|
||||||
|
>=0
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user