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:
Simon Michael 2018-07-31 10:39:11 +01:00
parent 72acb86299
commit d685d1aa9b
4 changed files with 33 additions and 41 deletions

View File

@ -32,44 +32,37 @@ import Hledger.Utils.UTF8IOCompat (error')
-- >>> import Hledger.Data.Transaction -- >>> import Hledger.Data.Transaction
-- >>> import Hledger.Data.Journal -- >>> import Hledger.Data.Journal
-- | Converts a 'TransactionModifier' and a 'Query' to a -- | Converts a 'TransactionModifier' to a 'Transaction'-transforming function,
-- 'Transaction'-transforming function, which applies the modification(s) -- which applies the modification(s) specified by the TransactionModifier.
-- specified by the TransactionModifier. Currently this means adding automated -- Currently this means adding automated postings when certain other postings are present.
-- postings when certain other postings - specified by the TransactionModifier, -- The postings of the transformed transaction will reference it in the usual
-- and additionally limited by the extra query, if it's not 'Any' - are present. -- way (ie, 'txnTieKnot' is called).
-- The postings of the transformed transaction will reference it, as usual
-- ('txnTieKnot').
-- --
-- >>> 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 -- 0000/01/01
-- ping $1.00 -- ping $1.00
-- pong $2.00 -- pong $2.00
-- <BLANKLINE> -- <BLANKLINE>
-- <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 -- 0000/01/01
-- ping $1.00 -- ping $1.00
-- <BLANKLINE> -- <BLANKLINE>
-- <BLANKLINE> -- <BLANKLINE>
-- >>> transactionModifierToFunction None (TransactionModifier "" ["pong" `post` usd 2]) nulltransaction{tpostings=["ping" `post` usd 1]} -- >>> transactionModifierToFunction (TransactionModifier "ping" ["pong" `post` amount{amultiplier=True, aquantity=3}]) nulltransaction{tpostings=["ping" `post` usd 2]}
-- 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]}
-- 0000/01/01 -- 0000/01/01
-- ping $2.00 -- ping $2.00
-- pong $6.00 -- pong $6.00
-- <BLANKLINE> -- <BLANKLINE>
-- <BLANKLINE> -- <BLANKLINE>
transactionModifierToFunction :: Query -> TransactionModifier -> (Transaction -> Transaction) transactionModifierToFunction :: TransactionModifier -> (Transaction -> Transaction)
transactionModifierToFunction q mt = transactionModifierToFunction mt =
\t@(tpostings -> ps) -> txnTieKnot t{ tpostings=generatePostings ps } -- TODO add modifier txn comment/tags ? \t@(tpostings -> ps) -> txnTieKnot t{ tpostings=generatePostings ps } -- TODO add modifier txn comment/tags ?
where 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 mods = map tmPostingToFunction $ tmpostings mt
generatePostings ps = [p' | p <- ps 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', -- | Parse the 'Query' from a 'TransactionModifier's 'tmquerytxt',
-- and return it as a function requiring the current date. -- and return it as a function requiring the current date.

View File

@ -121,7 +121,6 @@ import Text.Megaparsec.Custom
import Hledger.Data import Hledger.Data
import Hledger.Utils import Hledger.Utils
import qualified Hledger.Query as Q (Query(Any))
-- | A hledger journal reader is a triple of storage format name, a -- | A hledger journal reader is a triple of storage format name, a
-- detector of that format, and a parser from that format to Journal. -- 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 } applyTransactionModifiers j = j { jtxns = map applyallmodifiers $ jtxns j }
where where
applyallmodifiers = applyallmodifiers =
foldr (flip (.) . transactionModifierToFunction Q.Any) id (jtxnmodifiers j) foldr (flip (.) . transactionModifierToFunction) id (jtxnmodifiers j)
-- | Given a megaparsec ParsedJournal parser, input options, file -- | Given a megaparsec ParsedJournal parser, input options, file
-- path and file content: parse and post-process a Journal, or give an error. -- path and file content: parse and post-process a Journal, or give an error.

View File

@ -10,6 +10,7 @@ where
#if !(MIN_VERSION_base(4,11,0)) #if !(MIN_VERSION_base(4,11,0))
import Control.Monad.Writer import Control.Monad.Writer
#endif #endif
import Data.Functor.Identity
import Data.List (sortOn, foldl') import Data.List (sortOn, foldl')
import Data.String.Here import Data.String.Here
import qualified Data.Text as T 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 -- TODO allow using this on unbalanced entries, eg to rewrite while editing
rewrite opts@CliOpts{rawopts_=rawopts,reportopts_=ropts} j@Journal{jtxns=ts} = do 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 -- create re-writer
let modifiers = modifier : jtxnmodifiers j let modifiers = transactionModifierFromOpts opts : jtxnmodifiers j
applyallmodifiers = foldr (flip (.) . transactionModifierToFunction q) id modifiers applyallmodifiers = foldr (flip (.) . transactionModifierToFunction) id modifiers
-- rewrite matched transactions -- rewrite matched transactions
let j' = j{jtxns=map applyallmodifiers ts} let j' = j{jtxns=map applyallmodifiers ts}
-- run the print command, showing all transactions -- run the print command, showing all transactions, or show diffs
outputFromOpts rawopts opts{reportopts_=ropts{query_=""}} j j' printOrDiff rawopts opts{reportopts_=ropts{query_=""}} j j'
postingp' :: T.Text -> IO Posting -- | Build a 'TransactionModifier' from any query arguments and --add-posting flags
postingp' t = runJournalParser (postingp Nothing <* eof) t' >>= \case -- provided on the command line, or throw a parse error.
Left err -> fail $ parseErrorPretty' t' err transactionModifierFromOpts :: CliOpts -> TransactionModifier
Right p -> return p transactionModifierFromOpts CliOpts{rawopts_=rawopts,reportopts_=ropts} =
where t' = " " <> t <> "\n" -- inject space and newline for proper parsing 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 printOrDiff :: RawOpts -> (CliOpts -> Journal -> Journal -> IO ())
transactionModifierFromOpts opts = do printOrDiff opts
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
| boolopt "diff" opts = const diffOutput | boolopt "diff" opts = const diffOutput
| otherwise = flip (const print') | otherwise = flip (const print')

View File

@ -190,6 +190,7 @@ hledger rewrite -f- date:2017/1 --add-posting 'Here comes Santa $0'
>>> >>>
2016/12/31 2016/12/31
expenses:housing $600.00 expenses:housing $600.00
(budget:housing) $-600.00
assets:cash assets:cash
2017/01/01 2017/01/01