lib: ModifierTransaction -> TransactionModifier; try to clarify a bit
This commit is contained in:
		
							parent
							
								
									007b9f8caa
								
							
						
					
					
						commit
						efc54c4c25
					
				| @ -4,23 +4,23 @@ | |||||||
| {-# LANGUAGE CPP #-} | {-# LANGUAGE CPP #-} | ||||||
| {-| | {-| | ||||||
| 
 | 
 | ||||||
| This module provides utilities for applying automated transactions like | This module provides helpers for applying 'TransactionModifier's  | ||||||
| 'ModifierTransaction' and 'PeriodicTransaction'. | (eg generating automated postings) and generating 'PeriodicTransaction's. | ||||||
| 
 | 
 | ||||||
| -} | -} | ||||||
| module Hledger.Data.AutoTransaction | module Hledger.Data.AutoTransaction | ||||||
|     ( |     ( | ||||||
|     -- * Transaction processors |     -- * Transaction modifiers | ||||||
|       runModifierTransaction |       transactionModifierToFunction | ||||||
|  | 
 | ||||||
|  |     -- * Periodic transactions | ||||||
|     , runPeriodicTransaction |     , runPeriodicTransaction | ||||||
| 
 |  | ||||||
|     -- * Accessors |  | ||||||
|     , mtvaluequery |  | ||||||
|     , jdatespan |  | ||||||
|     , periodTransactionInterval |  | ||||||
| 
 |  | ||||||
|     -- * Misc |  | ||||||
|     , checkPeriodicTransactionStartDate |     , checkPeriodicTransactionStartDate | ||||||
|  | 
 | ||||||
|  |     -- -- * Accessors, seemingly unused | ||||||
|  |     -- , tmParseQuery | ||||||
|  |     -- , jdatespan | ||||||
|  |     -- , periodTransactionInterval | ||||||
|     ) |     ) | ||||||
| where | where | ||||||
| 
 | 
 | ||||||
| @ -44,76 +44,79 @@ import Hledger.Query | |||||||
| -- >>> import Hledger.Data.Posting | -- >>> import Hledger.Data.Posting | ||||||
| -- >>> import Hledger.Data.Journal | -- >>> import Hledger.Data.Journal | ||||||
| 
 | 
 | ||||||
| -- | Builds a 'Transaction' transformer based on 'ModifierTransaction'. | -- | Converts a 'TransactionModifier' and a 'Query' to a  | ||||||
|  | -- 'Transaction'-transforming function. The query allows injection of | ||||||
|  | -- additional restrictions on which postings to modify.  | ||||||
|  | -- The transformer function will not call 'txnTieKnot', you will | ||||||
|  | -- probably want to call that after using it. | ||||||
| -- | -- | ||||||
| -- 'Query' parameter allows injection of additional restriction on posting | -- >>> transactionModifierToFunction Any (TransactionModifier "" ["pong" `post` usd 2]) nulltransaction{tpostings=["ping" `post` usd 1]} | ||||||
| -- match. Don't forget to call 'txnTieKnot'. |  | ||||||
| -- |  | ||||||
| -- >>> runModifierTransaction Any (ModifierTransaction "" ["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> | ||||||
| -- >>> runModifierTransaction Any (ModifierTransaction "miss" ["pong" `post` usd 2]) nulltransaction{tpostings=["ping" `post` usd 1]} | -- >>> transactionModifierToFunction Any (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> | ||||||
| -- >>> runModifierTransaction None (ModifierTransaction "" ["pong" `post` usd 2]) nulltransaction{tpostings=["ping" `post` usd 1]} | -- >>> transactionModifierToFunction None (TransactionModifier "" ["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> | ||||||
| -- >>> runModifierTransaction Any (ModifierTransaction "ping" ["pong" `post` amount{amultiplier=True, aquantity=3}]) nulltransaction{tpostings=["ping" `post` usd 2]} | -- >>> 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> | ||||||
| runModifierTransaction :: Query -> ModifierTransaction -> (Transaction -> Transaction) | transactionModifierToFunction :: Query -> TransactionModifier -> (Transaction -> Transaction) | ||||||
| runModifierTransaction q mt = modifier where | transactionModifierToFunction q mt =  | ||||||
|     q' = simplifyQuery $ And [q, mtvaluequery mt (error "query cannot depend on current time")] |   \t@(tpostings -> ps) -> t { tpostings = generatePostings ps } -- TODO add modifier txn comment/tags ? | ||||||
|     mods = map runModifierPosting $ mtpostings mt |   where | ||||||
|  |     q' = simplifyQuery $ And [q, tmParseQuery mt (error' "a transaction modifier's query cannot depend on current date")] | ||||||
|  |     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]] | ||||||
|     modifier t@(tpostings -> ps) = t { tpostings = generatePostings ps } |      | ||||||
| 
 | -- | Parse the 'Query' from a 'TransactionModifier's 'tmquerytxt',  | ||||||
| -- | Extract 'Query' equivalent of 'mtvalueexpr' from 'ModifierTransaction' | -- and return it as a function requiring the current date.  | ||||||
| -- | -- | ||||||
| -- >>> mtvaluequery (ModifierTransaction "" []) undefined | -- >>> mtvaluequery (TransactionModifier "" []) undefined | ||||||
| -- Any | -- Any | ||||||
| -- >>> mtvaluequery (ModifierTransaction "ping" []) undefined | -- >>> mtvaluequery (TransactionModifier "ping" []) undefined | ||||||
| -- Acct "ping" | -- Acct "ping" | ||||||
| -- >>> mtvaluequery (ModifierTransaction "date:2016" []) undefined | -- >>> mtvaluequery (TransactionModifier "date:2016" []) undefined | ||||||
| -- Date (DateSpan 2016) | -- Date (DateSpan 2016) | ||||||
| -- >>> mtvaluequery (ModifierTransaction "date:today" []) (read "2017-01-01") | -- >>> mtvaluequery (TransactionModifier "date:today" []) (read "2017-01-01") | ||||||
| -- Date (DateSpan 2017/01/01) | -- Date (DateSpan 2017/01/01) | ||||||
| mtvaluequery :: ModifierTransaction -> (Day -> Query) | tmParseQuery :: TransactionModifier -> (Day -> Query) | ||||||
| mtvaluequery mt = fst . flip parseQuery (mtvalueexpr mt) | tmParseQuery mt = fst . flip parseQuery (tmquerytxt mt) | ||||||
| 
 | 
 | ||||||
| -- | 'DateSpan' of all dates mentioned in 'Journal' | ---- | 'DateSpan' of all dates mentioned in 'Journal' | ||||||
| -- | ---- | ||||||
| -- >>> jdatespan nulljournal | ---- >>> jdatespan nulljournal | ||||||
| -- DateSpan - | ---- DateSpan - | ||||||
| -- >>> jdatespan nulljournal{jtxns=[nulltransaction{tdate=read "2016-01-01"}] } | ---- >>> jdatespan nulljournal{jtxns=[nulltransaction{tdate=read "2016-01-01"}] } | ||||||
| -- DateSpan 2016/01/01 | ---- DateSpan 2016/01/01 | ||||||
| -- >>> jdatespan nulljournal{jtxns=[nulltransaction{tdate=read "2016-01-01", tpostings=[nullposting{pdate=Just $ read "2016-02-01"}]}] } | ---- >>> jdatespan nulljournal{jtxns=[nulltransaction{tdate=read "2016-01-01", tpostings=[nullposting{pdate=Just $ read "2016-02-01"}]}] } | ||||||
| -- DateSpan 2016/01/01-2016/02/01 | ---- DateSpan 2016/01/01-2016/02/01 | ||||||
| jdatespan :: Journal -> DateSpan | --jdatespan :: Journal -> DateSpan | ||||||
| jdatespan j | --jdatespan j | ||||||
|         | null dates = nulldatespan | --        | null dates = nulldatespan | ||||||
|         | otherwise = DateSpan (Just $ minimum dates) (Just $ 1 `addDays` maximum dates) | --        | otherwise = DateSpan (Just $ minimum dates) (Just $ 1 `addDays` maximum dates) | ||||||
|     where | --    where | ||||||
|         dates = concatMap tdates $ jtxns j | --        dates = concatMap tdates $ jtxns j | ||||||
| 
 | 
 | ||||||
| -- | 'DateSpan' of all dates mentioned in 'Transaction' | ---- | 'DateSpan' of all dates mentioned in 'Transaction' | ||||||
| -- | ---- | ||||||
| -- >>> tdates nulltransaction | ---- >>> tdates nulltransaction | ||||||
| -- [0000-01-01] | ---- [0000-01-01] | ||||||
| tdates :: Transaction -> [Day] | --tdates :: Transaction -> [Day] | ||||||
| tdates t = tdate t : concatMap pdates (tpostings t) ++ maybeToList (tdate2 t) where | --tdates t = tdate t : concatMap pdates (tpostings t) ++ maybeToList (tdate2 t) where | ||||||
|     pdates p = catMaybes [pdate p, pdate2 p] | --    pdates p = catMaybes [pdate p, pdate2 p] | ||||||
| 
 | 
 | ||||||
| postingScale :: Posting -> Maybe Quantity | postingScale :: Posting -> Maybe Quantity | ||||||
| postingScale p = | postingScale p = | ||||||
| @ -121,13 +124,16 @@ postingScale p = | |||||||
|         [a] | amultiplier a -> Just $ aquantity a |         [a] | amultiplier a -> Just $ aquantity a | ||||||
|         _ -> Nothing |         _ -> Nothing | ||||||
| 
 | 
 | ||||||
| runModifierPosting :: Posting -> (Posting -> Posting) | -- | Converts a 'TransactionModifier''s posting to a 'Posting'-generating function, | ||||||
| runModifierPosting p' = modifier where | -- which will be used to make a new posting based on the old one (an "automated posting"). | ||||||
|     modifier p = renderPostingCommentDates $ p' | tmPostingToFunction :: Posting -> (Posting -> Posting) | ||||||
|         { pdate = pdate p | tmPostingToFunction p' =  | ||||||
|         , pdate2 = pdate2 p |   \p -> renderPostingCommentDates $ p' | ||||||
|         , pamount = amount' p |       { pdate = pdate p | ||||||
|         } |       , pdate2 = pdate2 p | ||||||
|  |       , pamount = amount' p | ||||||
|  |       } | ||||||
|  |   where | ||||||
|     amount' = case postingScale p' of |     amount' = case postingScale p' of | ||||||
|         Nothing -> const $ pamount p' |         Nothing -> const $ pamount p' | ||||||
|         Just n -> \p -> withAmountType (head $ amounts $ pamount p') $ pamount p `divideMixedAmount` (1/n) |         Just n -> \p -> withAmountType (head $ amounts $ pamount p') $ pamount p `divideMixedAmount` (1/n) | ||||||
| @ -321,13 +327,13 @@ checkPeriodicTransactionStartDate i s periodexpr = | |||||||
|           "Unable to generate transactions according to "++show (T.unpack periodexpr) |           "Unable to generate transactions according to "++show (T.unpack periodexpr) | ||||||
|           ++" because "++show d++" is not a first day of the "++x |           ++" because "++show d++" is not a first day of the "++x | ||||||
| 
 | 
 | ||||||
| -- | What is the interval of this 'PeriodicTransaction's period expression, if it can be parsed ? | ---- | What is the interval of this 'PeriodicTransaction's period expression, if it can be parsed ? | ||||||
| periodTransactionInterval :: PeriodicTransaction -> Maybe Interval | --periodTransactionInterval :: PeriodicTransaction -> Maybe Interval | ||||||
| periodTransactionInterval pt = | --periodTransactionInterval pt = | ||||||
|   let | --  let | ||||||
|     expr = ptperiodexpr pt | --    expr = ptperiodexpr pt | ||||||
|     err  = error' $ "Current date cannot be referenced in " ++ show (T.unpack expr) | --    err  = error' $ "Current date cannot be referenced in " ++ show (T.unpack expr) | ||||||
|   in | --  in | ||||||
|     case parsePeriodExpr err expr of | --    case parsePeriodExpr err expr of | ||||||
|       Left _      -> Nothing | --      Left _      -> Nothing | ||||||
|       Right (i,_) -> Just i | --      Right (i,_) -> Just i | ||||||
|  | |||||||
| @ -13,7 +13,7 @@ other data format (see "Hledger.Read"). | |||||||
| module Hledger.Data.Journal ( | module Hledger.Data.Journal ( | ||||||
|   -- * Parsing helpers |   -- * Parsing helpers | ||||||
|   addMarketPrice, |   addMarketPrice, | ||||||
|   addModifierTransaction, |   addTransactionModifier, | ||||||
|   addPeriodicTransaction, |   addPeriodicTransaction, | ||||||
|   addTransaction, |   addTransaction, | ||||||
|   journalBalanceTransactions, |   journalBalanceTransactions, | ||||||
| @ -138,7 +138,7 @@ instance Show Journal where | |||||||
| -- showJournalDebug j = unlines [ | -- showJournalDebug j = unlines [ | ||||||
| --                       show j | --                       show j | ||||||
| --                      ,show (jtxns j) | --                      ,show (jtxns j) | ||||||
| --                      ,show (jmodifiertxns j) | --                      ,show (jtxnmodifiers j) | ||||||
| --                      ,show (jperiodictxns j) | --                      ,show (jperiodictxns j) | ||||||
| --                      ,show $ jparsetimeclockentries j | --                      ,show $ jparsetimeclockentries j | ||||||
| --                      ,show $ jmarketprices j | --                      ,show $ jmarketprices j | ||||||
| @ -170,7 +170,7 @@ instance Sem.Semigroup Journal where | |||||||
|     ,jcommodities               = jcommodities               j1 <> jcommodities               j2 |     ,jcommodities               = jcommodities               j1 <> jcommodities               j2 | ||||||
|     ,jinferredcommodities       = jinferredcommodities       j1 <> jinferredcommodities       j2 |     ,jinferredcommodities       = jinferredcommodities       j1 <> jinferredcommodities       j2 | ||||||
|     ,jmarketprices              = jmarketprices              j1 <> jmarketprices              j2 |     ,jmarketprices              = jmarketprices              j1 <> jmarketprices              j2 | ||||||
|     ,jmodifiertxns              = jmodifiertxns              j1 <> jmodifiertxns              j2 |     ,jtxnmodifiers              = jtxnmodifiers              j1 <> jtxnmodifiers              j2 | ||||||
|     ,jperiodictxns              = jperiodictxns              j1 <> jperiodictxns              j2 |     ,jperiodictxns              = jperiodictxns              j1 <> jperiodictxns              j2 | ||||||
|     ,jtxns                      = jtxns                      j1 <> jtxns                      j2 |     ,jtxns                      = jtxns                      j1 <> jtxns                      j2 | ||||||
|     ,jfinalcommentlines         = jfinalcommentlines         j2 |     ,jfinalcommentlines         = jfinalcommentlines         j2 | ||||||
| @ -197,7 +197,7 @@ nulljournal = Journal { | |||||||
|   ,jcommodities               = M.fromList [] |   ,jcommodities               = M.fromList [] | ||||||
|   ,jinferredcommodities       = M.fromList [] |   ,jinferredcommodities       = M.fromList [] | ||||||
|   ,jmarketprices              = [] |   ,jmarketprices              = [] | ||||||
|   ,jmodifiertxns              = [] |   ,jtxnmodifiers              = [] | ||||||
|   ,jperiodictxns              = [] |   ,jperiodictxns              = [] | ||||||
|   ,jtxns                      = [] |   ,jtxns                      = [] | ||||||
|   ,jfinalcommentlines         = "" |   ,jfinalcommentlines         = "" | ||||||
| @ -217,8 +217,8 @@ mainfile = headDef ("", "") . jfiles | |||||||
| addTransaction :: Transaction -> Journal -> Journal | addTransaction :: Transaction -> Journal -> Journal | ||||||
| addTransaction t j = j { jtxns = t : jtxns j } | addTransaction t j = j { jtxns = t : jtxns j } | ||||||
| 
 | 
 | ||||||
| addModifierTransaction :: ModifierTransaction -> Journal -> Journal | addTransactionModifier :: TransactionModifier -> Journal -> Journal | ||||||
| addModifierTransaction mt j = j { jmodifiertxns = mt : jmodifiertxns j } | addTransactionModifier mt j = j { jtxnmodifiers = mt : jtxnmodifiers j } | ||||||
| 
 | 
 | ||||||
| addPeriodicTransaction :: PeriodicTransaction -> Journal -> Journal | addPeriodicTransaction :: PeriodicTransaction -> Journal -> Journal | ||||||
| addPeriodicTransaction pt j = j { jperiodictxns = pt : jperiodictxns j } | addPeriodicTransaction pt j = j { jperiodictxns = pt : jperiodictxns j } | ||||||
| @ -497,7 +497,7 @@ journalFinalise t path txt assrt j@Journal{jfiles=fs} = | |||||||
|    j {jfiles        = (path,txt) : reverse fs |    j {jfiles        = (path,txt) : reverse fs | ||||||
|      ,jlastreadtime = t |      ,jlastreadtime = t | ||||||
|      ,jtxns         = reverse $ jtxns j -- NOTE: see addTransaction |      ,jtxns         = reverse $ jtxns j -- NOTE: see addTransaction | ||||||
|      ,jmodifiertxns = reverse $ jmodifiertxns j -- NOTE: see addModifierTransaction |      ,jtxnmodifiers = reverse $ jtxnmodifiers j -- NOTE: see addTransactionModifier | ||||||
|      ,jperiodictxns = reverse $ jperiodictxns j -- NOTE: see addPeriodicTransaction |      ,jperiodictxns = reverse $ jperiodictxns j -- NOTE: see addPeriodicTransaction | ||||||
|      ,jmarketprices = reverse $ jmarketprices j -- NOTE: see addMarketPrice |      ,jmarketprices = reverse $ jmarketprices j -- NOTE: see addMarketPrice | ||||||
|      }) |      }) | ||||||
|  | |||||||
| @ -26,7 +26,7 @@ import Hledger.Query | |||||||
| instance Show Ledger where | instance Show Ledger where | ||||||
|     show l = printf "Ledger with %d transactions, %d accounts\n" --"%s" |     show l = printf "Ledger with %d transactions, %d accounts\n" --"%s" | ||||||
|              (length (jtxns $ ljournal l) + |              (length (jtxns $ ljournal l) + | ||||||
|               length (jmodifiertxns $ ljournal l) + |               length (jtxnmodifiers $ ljournal l) + | ||||||
|               length (jperiodictxns $ ljournal l)) |               length (jperiodictxns $ ljournal l)) | ||||||
|              (length $ ledgerAccountNames l) |              (length $ ledgerAccountNames l) | ||||||
|              -- (showtree $ ledgerAccountNameTree l) |              -- (showtree $ ledgerAccountNameTree l) | ||||||
|  | |||||||
| @ -65,8 +65,8 @@ import Hledger.Data.Amount | |||||||
| 
 | 
 | ||||||
| instance Show Transaction where show = showTransactionUnelided | instance Show Transaction where show = showTransactionUnelided | ||||||
| 
 | 
 | ||||||
| instance Show ModifierTransaction where | instance Show TransactionModifier where | ||||||
|     show t = "= " ++ T.unpack (mtvalueexpr t) ++ "\n" ++ unlines (map show (mtpostings t)) |     show t = "= " ++ T.unpack (tmquerytxt t) ++ "\n" ++ unlines (map show (tmpostings t)) | ||||||
| 
 | 
 | ||||||
| instance Show PeriodicTransaction where | instance Show PeriodicTransaction where | ||||||
|     show t = "~ " ++ T.unpack (ptperiodexpr t) ++ "\n" ++ unlines (map show (ptpostings t)) |     show t = "~ " ++ T.unpack (ptperiodexpr t) ++ "\n" ++ unlines (map show (ptpostings t)) | ||||||
|  | |||||||
| @ -166,7 +166,7 @@ data Amount = Amount { | |||||||
|       aquantity   :: Quantity, |       aquantity   :: Quantity, | ||||||
|       aprice      :: Price,           -- ^ the (fixed) price for this amount, if any |       aprice      :: Price,           -- ^ the (fixed) price for this amount, if any | ||||||
|       astyle      :: AmountStyle, |       astyle      :: AmountStyle, | ||||||
|       amultiplier :: Bool             -- ^ amount is a multipier for AutoTransactions |       amultiplier :: Bool             -- ^ amount is a multipier used in TransactionModifier postings | ||||||
|     } deriving (Eq,Ord,Typeable,Data,Generic) |     } deriving (Eq,Ord,Typeable,Data,Generic) | ||||||
| 
 | 
 | ||||||
| instance NFData Amount | instance NFData Amount | ||||||
| @ -249,12 +249,12 @@ data Transaction = Transaction { | |||||||
| 
 | 
 | ||||||
| instance NFData Transaction | instance NFData Transaction | ||||||
| 
 | 
 | ||||||
| data ModifierTransaction = ModifierTransaction { | data TransactionModifier = TransactionModifier { | ||||||
|       mtvalueexpr :: Text, |       tmquerytxt :: Text, | ||||||
|       mtpostings  :: [Posting] |       tmpostings :: [Posting] | ||||||
|     } deriving (Eq,Typeable,Data,Generic) |     } deriving (Eq,Typeable,Data,Generic) | ||||||
| 
 | 
 | ||||||
| instance NFData ModifierTransaction | instance NFData TransactionModifier | ||||||
| 
 | 
 | ||||||
| -- ^ A periodic transaction rule, describing a transaction that recurs. | -- ^ A periodic transaction rule, describing a transaction that recurs. | ||||||
| data PeriodicTransaction = PeriodicTransaction { | data PeriodicTransaction = PeriodicTransaction { | ||||||
| @ -329,7 +329,7 @@ data Journal = Journal { | |||||||
|   ,jcommodities           :: M.Map CommoditySymbol Commodity        -- ^ commodities and formats declared by commodity directives |   ,jcommodities           :: M.Map CommoditySymbol Commodity        -- ^ commodities and formats declared by commodity directives | ||||||
|   ,jinferredcommodities   :: M.Map CommoditySymbol AmountStyle      -- ^ commodities and formats inferred from journal amounts  XXX misnamed |   ,jinferredcommodities   :: M.Map CommoditySymbol AmountStyle      -- ^ commodities and formats inferred from journal amounts  XXX misnamed | ||||||
|   ,jmarketprices          :: [MarketPrice] |   ,jmarketprices          :: [MarketPrice] | ||||||
|   ,jmodifiertxns          :: [ModifierTransaction] |   ,jtxnmodifiers          :: [TransactionModifier] | ||||||
|   ,jperiodictxns          :: [PeriodicTransaction] |   ,jperiodictxns          :: [PeriodicTransaction] | ||||||
|   ,jtxns                  :: [Transaction] |   ,jtxns                  :: [Transaction] | ||||||
|   ,jfinalcommentlines     :: Text                                   -- ^ any final trailing comments in the (main) journal file |   ,jfinalcommentlines     :: Text                                   -- ^ any final trailing comments in the (main) journal file | ||||||
|  | |||||||
| @ -209,9 +209,9 @@ journalSourcePos p p' = JournalSourcePos (sourceName p) (fromIntegral . unPos $ | |||||||
| generateAutomaticPostings :: Journal -> Journal | generateAutomaticPostings :: Journal -> Journal | ||||||
| generateAutomaticPostings j = j { jtxns = map modifier $ jtxns j } | generateAutomaticPostings j = j { jtxns = map modifier $ jtxns j } | ||||||
|   where |   where | ||||||
|     modifier = foldr (flip (.) . runModifierTransaction') id mtxns |     modifier = foldr (flip (.) . transactionModifierToFunction') id mtxns | ||||||
|     runModifierTransaction' = fmap txnTieKnot . runModifierTransaction Q.Any |     transactionModifierToFunction' = fmap txnTieKnot . transactionModifierToFunction Q.Any | ||||||
|     mtxns = jmodifiertxns j |     mtxns = 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. | ||||||
|  | |||||||
| @ -154,7 +154,7 @@ addJournalItemP = | |||||||
|   choice [ |   choice [ | ||||||
|       directivep |       directivep | ||||||
|     , transactionp          >>= modify' . addTransaction |     , transactionp          >>= modify' . addTransaction | ||||||
|     , modifiertransactionp  >>= modify' . addModifierTransaction |     , transactionmodifierp  >>= modify' . addTransactionModifier | ||||||
|     , periodictransactionp  >>= modify' . addPeriodicTransaction |     , periodictransactionp  >>= modify' . addPeriodicTransaction | ||||||
|     , marketpricedirectivep >>= modify' . addMarketPrice |     , marketpricedirectivep >>= modify' . addMarketPrice | ||||||
|     , void (lift emptyorcommentlinep) |     , void (lift emptyorcommentlinep) | ||||||
| @ -470,14 +470,14 @@ commodityconversiondirectivep = do | |||||||
| --- ** transactions | --- ** transactions | ||||||
| 
 | 
 | ||||||
| -- TODO transactionmodifierp ? transactionrewritep ? | -- TODO transactionmodifierp ? transactionrewritep ? | ||||||
| modifiertransactionp :: JournalParser m ModifierTransaction | transactionmodifierp :: JournalParser m TransactionModifier | ||||||
| modifiertransactionp = do | transactionmodifierp = do | ||||||
|   char '=' <?> "modifier transaction" |   char '=' <?> "modifier transaction" | ||||||
|   lift (skipMany spacenonewline) |   lift (skipMany spacenonewline) | ||||||
|   querytxt <- lift $ T.strip <$> descriptionp |   querytxt <- lift $ T.strip <$> descriptionp | ||||||
|   (_comment, _tags) <- lift transactioncommentp   -- TODO apply these to modified txns ? |   (_comment, _tags) <- lift transactioncommentp   -- TODO apply these to modified txns ? | ||||||
|   postings <- postingsp Nothing |   postings <- postingsp Nothing | ||||||
|   return $ ModifierTransaction querytxt postings |   return $ TransactionModifier querytxt postings | ||||||
| 
 | 
 | ||||||
| -- | Parse a periodic transaction | -- | Parse a periodic transaction | ||||||
| periodictransactionp :: MonadIO m => JournalParser m PeriodicTransaction | periodictransactionp :: MonadIO m => JournalParser m PeriodicTransaction | ||||||
| @ -748,8 +748,8 @@ tests_Hledger_Read_JournalReader = TestList $ concat [ | |||||||
|     test_postingp, |     test_postingp, | ||||||
|     test_transactionp, |     test_transactionp, | ||||||
|     [ |     [ | ||||||
|    "modifiertransactionp" ~: do |    "transactionmodifierp" ~: do | ||||||
|      assertParse (parseWithState mempty modifiertransactionp "= (some value expr)\n some:postings  1\n") |      assertParse (parseWithState mempty transactionmodifierp "= (some value expr)\n some:postings  1\n") | ||||||
| 
 | 
 | ||||||
|   ,"periodictransactionp" ~: do |   ,"periodictransactionp" ~: do | ||||||
|      assertParse (parseWithState mempty periodictransactionp "~ (some period expr)\n some:postings  1\n") |      assertParse (parseWithState mempty periodictransactionp "~ (some period expr)\n some:postings  1\n") | ||||||
|  | |||||||
| @ -178,12 +178,12 @@ but with these differences: | |||||||
| 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 |   d <- getCurrentDay | ||||||
|   let q = queryFromOpts d ropts |   let q = queryFromOpts d ropts | ||||||
|   modifier <- modifierTransactionFromOpts rawopts |   modifier <- transactionModifierFromOpts rawopts | ||||||
|   -- create re-writer |   -- create re-writer | ||||||
|   let modifiers = modifier : jmodifiertxns j |   let modifiers = modifier : jtxnmodifiers j | ||||||
|       -- Note that some query matches require transaction. Thus modifiers |       -- Note that some query matches require transaction. Thus modifiers | ||||||
|       -- pipeline should include txnTieKnot on every step. |       -- pipeline should include txnTieKnot on every step. | ||||||
|       modifier' = foldr (flip (.) . fmap txnTieKnot . runModifierTransaction q) id modifiers |       modifier' = foldr (flip (.) . fmap txnTieKnot . transactionModifierToFunction q) id modifiers | ||||||
|   -- rewrite matched transactions |   -- rewrite matched transactions | ||||||
|   let j' = j{jtxns=map modifier' ts} |   let j' = j{jtxns=map modifier' ts} | ||||||
|   -- run the print command, showing all transactions |   -- run the print command, showing all transactions | ||||||
| @ -195,11 +195,11 @@ postingp' t = runJournalParser (postingp Nothing <* eof) t' >>= \case | |||||||
|         Right p -> return p |         Right p -> return p | ||||||
|     where t' = " " <> t <> "\n" -- inject space and newline for proper parsing |     where t' = " " <> t <> "\n" -- inject space and newline for proper parsing | ||||||
| 
 | 
 | ||||||
| modifierTransactionFromOpts :: RawOpts -> IO ModifierTransaction | transactionModifierFromOpts :: RawOpts -> IO TransactionModifier | ||||||
| modifierTransactionFromOpts opts = do | transactionModifierFromOpts opts = do | ||||||
|     postings <- mapM (postingp' . stripquotes . T.pack) $ listofstringopt "add-posting" opts |     postings <- mapM (postingp' . stripquotes . T.pack) $ listofstringopt "add-posting" opts | ||||||
|     return |     return | ||||||
|         ModifierTransaction { mtvalueexpr = T.empty, mtpostings = postings } |         TransactionModifier { tmquerytxt = T.empty, tmpostings = postings } | ||||||
| 
 | 
 | ||||||
| outputFromOpts :: RawOpts -> (CliOpts -> Journal -> Journal -> IO ()) | outputFromOpts :: RawOpts -> (CliOpts -> Journal -> Journal -> IO ()) | ||||||
| outputFromOpts opts | outputFromOpts opts | ||||||
|  | |||||||
		Loading…
	
		Reference in New Issue
	
	Block a user