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