mirror of
https://github.com/simonmichael/hledger.git
synced 2024-11-08 07:09:28 +03:00
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,
|
||||
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
|
||||
|
@ -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.
|
||||
|
@ -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
|
||||
|
@ -32,7 +32,6 @@ module Hledger.Read (
|
||||
readJournal',
|
||||
|
||||
-- * Re-exported
|
||||
JournalReader.accountaliasp,
|
||||
JournalReader.postingp,
|
||||
findReader,
|
||||
splitReaderPrefix,
|
||||
|
@ -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" [
|
||||
|
@ -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
|
||||
|
@ -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"
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
||||
>=
|
||||
|
||||
## .
|
||||
#<
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user