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.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.  | ||||||
|  | |||||||
| @ -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. | ||||||
|  | |||||||
| @ -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') | ||||||
| 
 | 
 | ||||||
|  | |||||||
| @ -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 | ||||||
|  | |||||||
		Loading…
	
		Reference in New Issue
	
	Block a user