lib,rewrite: simplify transactionModifierToFunction
This removes transactionModifierToFunction's extra query parameter; the rewrite command sets it in the TransactionModifier instead, which I think is equivalent. I had to change one functional test, but it seems correct now, so perhaps it wasn't working right before ?
This commit is contained in:
parent
72acb86299
commit
d685d1aa9b
@ -32,44 +32,37 @@ import Hledger.Utils.UTF8IOCompat (error')
|
||||
-- >>> import Hledger.Data.Transaction
|
||||
-- >>> import Hledger.Data.Journal
|
||||
|
||||
-- | Converts a 'TransactionModifier' and a 'Query' to a
|
||||
-- 'Transaction'-transforming function, which applies the modification(s)
|
||||
-- specified by the TransactionModifier. Currently this means adding automated
|
||||
-- postings when certain other postings - specified by the TransactionModifier,
|
||||
-- and additionally limited by the extra query, if it's not 'Any' - are present.
|
||||
-- The postings of the transformed transaction will reference it, as usual
|
||||
-- ('txnTieKnot').
|
||||
-- | Converts a 'TransactionModifier' to a 'Transaction'-transforming function,
|
||||
-- which applies the modification(s) specified by the TransactionModifier.
|
||||
-- Currently this means adding automated postings when certain other postings are present.
|
||||
-- The postings of the transformed transaction will reference it in the usual
|
||||
-- way (ie, 'txnTieKnot' is called).
|
||||
--
|
||||
-- >>> transactionModifierToFunction Any (TransactionModifier "" ["pong" `post` usd 2]) nulltransaction{tpostings=["ping" `post` usd 1]}
|
||||
-- >>> transactionModifierToFunction (TransactionModifier "" ["pong" `post` usd 2]) nulltransaction{tpostings=["ping" `post` usd 1]}
|
||||
-- 0000/01/01
|
||||
-- ping $1.00
|
||||
-- pong $2.00
|
||||
-- <BLANKLINE>
|
||||
-- <BLANKLINE>
|
||||
-- >>> transactionModifierToFunction Any (TransactionModifier "miss" ["pong" `post` usd 2]) nulltransaction{tpostings=["ping" `post` usd 1]}
|
||||
-- >>> transactionModifierToFunction (TransactionModifier "miss" ["pong" `post` usd 2]) nulltransaction{tpostings=["ping" `post` usd 1]}
|
||||
-- 0000/01/01
|
||||
-- ping $1.00
|
||||
-- <BLANKLINE>
|
||||
-- <BLANKLINE>
|
||||
-- >>> transactionModifierToFunction None (TransactionModifier "" ["pong" `post` usd 2]) nulltransaction{tpostings=["ping" `post` usd 1]}
|
||||
-- 0000/01/01
|
||||
-- ping $1.00
|
||||
-- <BLANKLINE>
|
||||
-- <BLANKLINE>
|
||||
-- >>> transactionModifierToFunction Any (TransactionModifier "ping" ["pong" `post` amount{amultiplier=True, aquantity=3}]) nulltransaction{tpostings=["ping" `post` usd 2]}
|
||||
-- >>> transactionModifierToFunction (TransactionModifier "ping" ["pong" `post` amount{amultiplier=True, aquantity=3}]) nulltransaction{tpostings=["ping" `post` usd 2]}
|
||||
-- 0000/01/01
|
||||
-- ping $2.00
|
||||
-- pong $6.00
|
||||
-- <BLANKLINE>
|
||||
-- <BLANKLINE>
|
||||
transactionModifierToFunction :: Query -> TransactionModifier -> (Transaction -> Transaction)
|
||||
transactionModifierToFunction q mt =
|
||||
transactionModifierToFunction :: TransactionModifier -> (Transaction -> Transaction)
|
||||
transactionModifierToFunction mt =
|
||||
\t@(tpostings -> ps) -> txnTieKnot t{ tpostings=generatePostings ps } -- TODO add modifier txn comment/tags ?
|
||||
where
|
||||
q' = simplifyQuery $ And [q, tmParseQuery mt (error' "a transaction modifier's query cannot depend on current date")]
|
||||
q = simplifyQuery $ tmParseQuery mt (error' "a transaction modifier's query cannot depend on current date")
|
||||
mods = map tmPostingToFunction $ tmpostings mt
|
||||
generatePostings ps = [p' | p <- ps
|
||||
, p' <- if q' `matchesPosting` p then p:[ m p | m <- mods] else [p]]
|
||||
, p' <- if q `matchesPosting` p then p:[ m p | m <- mods] else [p]]
|
||||
|
||||
-- | Parse the 'Query' from a 'TransactionModifier's 'tmquerytxt',
|
||||
-- and return it as a function requiring the current date.
|
||||
|
||||
@ -121,7 +121,6 @@ import Text.Megaparsec.Custom
|
||||
|
||||
import Hledger.Data
|
||||
import Hledger.Utils
|
||||
import qualified Hledger.Query as Q (Query(Any))
|
||||
|
||||
-- | A hledger journal reader is a triple of storage format name, a
|
||||
-- detector of that format, and a parser from that format to Journal.
|
||||
@ -210,7 +209,7 @@ applyTransactionModifiers :: Journal -> Journal
|
||||
applyTransactionModifiers j = j { jtxns = map applyallmodifiers $ jtxns j }
|
||||
where
|
||||
applyallmodifiers =
|
||||
foldr (flip (.) . transactionModifierToFunction Q.Any) id (jtxnmodifiers j)
|
||||
foldr (flip (.) . transactionModifierToFunction) id (jtxnmodifiers j)
|
||||
|
||||
-- | Given a megaparsec ParsedJournal parser, input options, file
|
||||
-- path and file content: parse and post-process a Journal, or give an error.
|
||||
|
||||
@ -10,6 +10,7 @@ where
|
||||
#if !(MIN_VERSION_base(4,11,0))
|
||||
import Control.Monad.Writer
|
||||
#endif
|
||||
import Data.Functor.Identity
|
||||
import Data.List (sortOn, foldl')
|
||||
import Data.String.Here
|
||||
import qualified Data.Text as T
|
||||
@ -176,31 +177,29 @@ but with these differences:
|
||||
-- TODO allow using this on unbalanced entries, eg to rewrite while editing
|
||||
|
||||
rewrite opts@CliOpts{rawopts_=rawopts,reportopts_=ropts} j@Journal{jtxns=ts} = do
|
||||
d <- getCurrentDay
|
||||
let q = queryFromOpts d ropts
|
||||
modifier <- transactionModifierFromOpts rawopts
|
||||
-- create re-writer
|
||||
let modifiers = modifier : jtxnmodifiers j
|
||||
applyallmodifiers = foldr (flip (.) . transactionModifierToFunction q) id modifiers
|
||||
let modifiers = transactionModifierFromOpts opts : jtxnmodifiers j
|
||||
applyallmodifiers = foldr (flip (.) . transactionModifierToFunction) id modifiers
|
||||
-- rewrite matched transactions
|
||||
let j' = j{jtxns=map applyallmodifiers ts}
|
||||
-- run the print command, showing all transactions
|
||||
outputFromOpts rawopts opts{reportopts_=ropts{query_=""}} j j'
|
||||
-- run the print command, showing all transactions, or show diffs
|
||||
printOrDiff rawopts opts{reportopts_=ropts{query_=""}} j j'
|
||||
|
||||
postingp' :: T.Text -> IO Posting
|
||||
postingp' t = runJournalParser (postingp Nothing <* eof) t' >>= \case
|
||||
Left err -> fail $ parseErrorPretty' t' err
|
||||
Right p -> return p
|
||||
where t' = " " <> t <> "\n" -- inject space and newline for proper parsing
|
||||
-- | Build a 'TransactionModifier' from any query arguments and --add-posting flags
|
||||
-- provided on the command line, or throw a parse error.
|
||||
transactionModifierFromOpts :: CliOpts -> TransactionModifier
|
||||
transactionModifierFromOpts CliOpts{rawopts_=rawopts,reportopts_=ropts} =
|
||||
TransactionModifier{tmquerytxt=q, tmpostings=ps}
|
||||
where
|
||||
q = T.pack $ query_ ropts
|
||||
ps = map (parseposting . stripquotes . T.pack) $ listofstringopt "add-posting" rawopts
|
||||
parseposting t = either (error' . parseErrorPretty' t') id ep
|
||||
where
|
||||
ep = runIdentity (runJournalParser (postingp Nothing <* eof) t')
|
||||
t' = " " <> t <> "\n" -- inject space and newline for proper parsing
|
||||
|
||||
transactionModifierFromOpts :: RawOpts -> IO TransactionModifier
|
||||
transactionModifierFromOpts opts = do
|
||||
postings <- mapM (postingp' . stripquotes . T.pack) $ listofstringopt "add-posting" opts
|
||||
return
|
||||
TransactionModifier { tmquerytxt = T.empty, tmpostings = postings }
|
||||
|
||||
outputFromOpts :: RawOpts -> (CliOpts -> Journal -> Journal -> IO ())
|
||||
outputFromOpts opts
|
||||
printOrDiff :: RawOpts -> (CliOpts -> Journal -> Journal -> IO ())
|
||||
printOrDiff opts
|
||||
| boolopt "diff" opts = const diffOutput
|
||||
| otherwise = flip (const print')
|
||||
|
||||
|
||||
@ -190,6 +190,7 @@ hledger rewrite -f- date:2017/1 --add-posting 'Here comes Santa $0'
|
||||
>>>
|
||||
2016/12/31
|
||||
expenses:housing $600.00
|
||||
(budget:housing) $-600.00
|
||||
assets:cash
|
||||
|
||||
2017/01/01
|
||||
|
||||
Loading…
Reference in New Issue
Block a user