diff --git a/hledger-lib/Hledger/Data/AutoTransaction.hs b/hledger-lib/Hledger/Data/AutoTransaction.hs index 7bcacb894..0bc85f3fb 100644 --- a/hledger-lib/Hledger/Data/AutoTransaction.hs +++ b/hledger-lib/Hledger/Data/AutoTransaction.hs @@ -4,23 +4,23 @@ {-# LANGUAGE CPP #-} {-| -This module provides utilities for applying automated transactions like -'ModifierTransaction' and 'PeriodicTransaction'. +This module provides helpers for applying 'TransactionModifier's +(eg generating automated postings) and generating 'PeriodicTransaction's. -} module Hledger.Data.AutoTransaction ( - -- * Transaction processors - runModifierTransaction + -- * Transaction modifiers + transactionModifierToFunction + + -- * Periodic transactions , runPeriodicTransaction - - -- * Accessors - , mtvaluequery - , jdatespan - , periodTransactionInterval - - -- * Misc , checkPeriodicTransactionStartDate + + -- -- * Accessors, seemingly unused + -- , tmParseQuery + -- , jdatespan + -- , periodTransactionInterval ) where @@ -44,76 +44,79 @@ import Hledger.Query -- >>> import Hledger.Data.Posting -- >>> 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 --- match. Don't forget to call 'txnTieKnot'. --- --- >>> runModifierTransaction Any (ModifierTransaction "" ["pong" `post` usd 2]) nulltransaction{tpostings=["ping" `post` usd 1]} +-- >>> transactionModifierToFunction Any (TransactionModifier "" ["pong" `post` usd 2]) nulltransaction{tpostings=["ping" `post` usd 1]} -- 0000/01/01 -- ping $1.00 -- pong $2.00 -- -- --- >>> 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 -- ping $1.00 -- -- --- >>> 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 -- ping $1.00 -- -- --- >>> 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 -- ping $2.00 -- pong $6.00 -- -- -runModifierTransaction :: Query -> ModifierTransaction -> (Transaction -> Transaction) -runModifierTransaction q mt = modifier where - q' = simplifyQuery $ And [q, mtvaluequery mt (error "query cannot depend on current time")] - mods = map runModifierPosting $ mtpostings mt +transactionModifierToFunction :: Query -> TransactionModifier -> (Transaction -> Transaction) +transactionModifierToFunction q mt = + \t@(tpostings -> ps) -> 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")] + mods = map tmPostingToFunction $ tmpostings mt generatePostings ps = [p' | p <- ps , p' <- if q' `matchesPosting` p then p:[ m p | m <- mods] else [p]] - modifier t@(tpostings -> ps) = t { tpostings = generatePostings ps } - --- | Extract 'Query' equivalent of 'mtvalueexpr' from 'ModifierTransaction' + +-- | Parse the 'Query' from a 'TransactionModifier's 'tmquerytxt', +-- and return it as a function requiring the current date. -- --- >>> mtvaluequery (ModifierTransaction "" []) undefined +-- >>> mtvaluequery (TransactionModifier "" []) undefined -- Any --- >>> mtvaluequery (ModifierTransaction "ping" []) undefined +-- >>> mtvaluequery (TransactionModifier "ping" []) undefined -- Acct "ping" --- >>> mtvaluequery (ModifierTransaction "date:2016" []) undefined +-- >>> mtvaluequery (TransactionModifier "date:2016" []) undefined -- Date (DateSpan 2016) --- >>> mtvaluequery (ModifierTransaction "date:today" []) (read "2017-01-01") +-- >>> mtvaluequery (TransactionModifier "date:today" []) (read "2017-01-01") -- Date (DateSpan 2017/01/01) -mtvaluequery :: ModifierTransaction -> (Day -> Query) -mtvaluequery mt = fst . flip parseQuery (mtvalueexpr mt) +tmParseQuery :: TransactionModifier -> (Day -> Query) +tmParseQuery mt = fst . flip parseQuery (tmquerytxt mt) --- | 'DateSpan' of all dates mentioned in 'Journal' --- --- >>> jdatespan nulljournal --- DateSpan - --- >>> jdatespan nulljournal{jtxns=[nulltransaction{tdate=read "2016-01-01"}] } --- DateSpan 2016/01/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 -jdatespan :: Journal -> DateSpan -jdatespan j - | null dates = nulldatespan - | otherwise = DateSpan (Just $ minimum dates) (Just $ 1 `addDays` maximum dates) - where - dates = concatMap tdates $ jtxns j +---- | 'DateSpan' of all dates mentioned in 'Journal' +---- +---- >>> jdatespan nulljournal +---- DateSpan - +---- >>> jdatespan nulljournal{jtxns=[nulltransaction{tdate=read "2016-01-01"}] } +---- DateSpan 2016/01/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 +--jdatespan :: Journal -> DateSpan +--jdatespan j +-- | null dates = nulldatespan +-- | otherwise = DateSpan (Just $ minimum dates) (Just $ 1 `addDays` maximum dates) +-- where +-- dates = concatMap tdates $ jtxns j --- | 'DateSpan' of all dates mentioned in 'Transaction' --- --- >>> tdates nulltransaction --- [0000-01-01] -tdates :: Transaction -> [Day] -tdates t = tdate t : concatMap pdates (tpostings t) ++ maybeToList (tdate2 t) where - pdates p = catMaybes [pdate p, pdate2 p] +---- | 'DateSpan' of all dates mentioned in 'Transaction' +---- +---- >>> tdates nulltransaction +---- [0000-01-01] +--tdates :: Transaction -> [Day] +--tdates t = tdate t : concatMap pdates (tpostings t) ++ maybeToList (tdate2 t) where +-- pdates p = catMaybes [pdate p, pdate2 p] postingScale :: Posting -> Maybe Quantity postingScale p = @@ -121,13 +124,16 @@ postingScale p = [a] | amultiplier a -> Just $ aquantity a _ -> Nothing -runModifierPosting :: Posting -> (Posting -> Posting) -runModifierPosting p' = modifier where - modifier p = renderPostingCommentDates $ p' - { pdate = pdate p - , pdate2 = pdate2 p - , pamount = amount' p - } +-- | Converts a 'TransactionModifier''s posting to a 'Posting'-generating function, +-- which will be used to make a new posting based on the old one (an "automated posting"). +tmPostingToFunction :: Posting -> (Posting -> Posting) +tmPostingToFunction p' = + \p -> renderPostingCommentDates $ p' + { pdate = pdate p + , pdate2 = pdate2 p + , pamount = amount' p + } + where amount' = case postingScale p' of Nothing -> const $ pamount p' 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) ++" 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 ? -periodTransactionInterval :: PeriodicTransaction -> Maybe Interval -periodTransactionInterval pt = - let - expr = ptperiodexpr pt - err = error' $ "Current date cannot be referenced in " ++ show (T.unpack expr) - in - case parsePeriodExpr err expr of - Left _ -> Nothing - Right (i,_) -> Just i +---- | What is the interval of this 'PeriodicTransaction's period expression, if it can be parsed ? +--periodTransactionInterval :: PeriodicTransaction -> Maybe Interval +--periodTransactionInterval pt = +-- let +-- expr = ptperiodexpr pt +-- err = error' $ "Current date cannot be referenced in " ++ show (T.unpack expr) +-- in +-- case parsePeriodExpr err expr of +-- Left _ -> Nothing +-- Right (i,_) -> Just i diff --git a/hledger-lib/Hledger/Data/Journal.hs b/hledger-lib/Hledger/Data/Journal.hs index 8477d5cee..314fd9ea9 100644 --- a/hledger-lib/Hledger/Data/Journal.hs +++ b/hledger-lib/Hledger/Data/Journal.hs @@ -13,7 +13,7 @@ other data format (see "Hledger.Read"). module Hledger.Data.Journal ( -- * Parsing helpers addMarketPrice, - addModifierTransaction, + addTransactionModifier, addPeriodicTransaction, addTransaction, journalBalanceTransactions, @@ -138,7 +138,7 @@ instance Show Journal where -- showJournalDebug j = unlines [ -- show j -- ,show (jtxns j) --- ,show (jmodifiertxns j) +-- ,show (jtxnmodifiers j) -- ,show (jperiodictxns j) -- ,show $ jparsetimeclockentries j -- ,show $ jmarketprices j @@ -170,7 +170,7 @@ instance Sem.Semigroup Journal where ,jcommodities = jcommodities j1 <> jcommodities j2 ,jinferredcommodities = jinferredcommodities j1 <> jinferredcommodities j2 ,jmarketprices = jmarketprices j1 <> jmarketprices j2 - ,jmodifiertxns = jmodifiertxns j1 <> jmodifiertxns j2 + ,jtxnmodifiers = jtxnmodifiers j1 <> jtxnmodifiers j2 ,jperiodictxns = jperiodictxns j1 <> jperiodictxns j2 ,jtxns = jtxns j1 <> jtxns j2 ,jfinalcommentlines = jfinalcommentlines j2 @@ -197,7 +197,7 @@ nulljournal = Journal { ,jcommodities = M.fromList [] ,jinferredcommodities = M.fromList [] ,jmarketprices = [] - ,jmodifiertxns = [] + ,jtxnmodifiers = [] ,jperiodictxns = [] ,jtxns = [] ,jfinalcommentlines = "" @@ -217,8 +217,8 @@ mainfile = headDef ("", "") . jfiles addTransaction :: Transaction -> Journal -> Journal addTransaction t j = j { jtxns = t : jtxns j } -addModifierTransaction :: ModifierTransaction -> Journal -> Journal -addModifierTransaction mt j = j { jmodifiertxns = mt : jmodifiertxns j } +addTransactionModifier :: TransactionModifier -> Journal -> Journal +addTransactionModifier mt j = j { jtxnmodifiers = mt : jtxnmodifiers j } addPeriodicTransaction :: PeriodicTransaction -> Journal -> Journal 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 ,jlastreadtime = t ,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 ,jmarketprices = reverse $ jmarketprices j -- NOTE: see addMarketPrice }) diff --git a/hledger-lib/Hledger/Data/Ledger.hs b/hledger-lib/Hledger/Data/Ledger.hs index 0ca7aac20..e175c62aa 100644 --- a/hledger-lib/Hledger/Data/Ledger.hs +++ b/hledger-lib/Hledger/Data/Ledger.hs @@ -26,7 +26,7 @@ import Hledger.Query instance Show Ledger where show l = printf "Ledger with %d transactions, %d accounts\n" --"%s" (length (jtxns $ ljournal l) + - length (jmodifiertxns $ ljournal l) + + length (jtxnmodifiers $ ljournal l) + length (jperiodictxns $ ljournal l)) (length $ ledgerAccountNames l) -- (showtree $ ledgerAccountNameTree l) diff --git a/hledger-lib/Hledger/Data/Transaction.hs b/hledger-lib/Hledger/Data/Transaction.hs index 8ef5a58b4..351d6cfd9 100644 --- a/hledger-lib/Hledger/Data/Transaction.hs +++ b/hledger-lib/Hledger/Data/Transaction.hs @@ -65,8 +65,8 @@ import Hledger.Data.Amount instance Show Transaction where show = showTransactionUnelided -instance Show ModifierTransaction where - show t = "= " ++ T.unpack (mtvalueexpr t) ++ "\n" ++ unlines (map show (mtpostings t)) +instance Show TransactionModifier where + show t = "= " ++ T.unpack (tmquerytxt t) ++ "\n" ++ unlines (map show (tmpostings t)) instance Show PeriodicTransaction where show t = "~ " ++ T.unpack (ptperiodexpr t) ++ "\n" ++ unlines (map show (ptpostings t)) diff --git a/hledger-lib/Hledger/Data/Types.hs b/hledger-lib/Hledger/Data/Types.hs index 3cdba2793..12a5e02fa 100644 --- a/hledger-lib/Hledger/Data/Types.hs +++ b/hledger-lib/Hledger/Data/Types.hs @@ -166,7 +166,7 @@ data Amount = Amount { aquantity :: Quantity, aprice :: Price, -- ^ the (fixed) price for this amount, if any 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) instance NFData Amount @@ -249,12 +249,12 @@ data Transaction = Transaction { instance NFData Transaction -data ModifierTransaction = ModifierTransaction { - mtvalueexpr :: Text, - mtpostings :: [Posting] +data TransactionModifier = TransactionModifier { + tmquerytxt :: Text, + tmpostings :: [Posting] } deriving (Eq,Typeable,Data,Generic) -instance NFData ModifierTransaction +instance NFData TransactionModifier -- ^ A periodic transaction rule, describing a transaction that recurs. data PeriodicTransaction = PeriodicTransaction { @@ -329,7 +329,7 @@ data Journal = Journal { ,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 ,jmarketprices :: [MarketPrice] - ,jmodifiertxns :: [ModifierTransaction] + ,jtxnmodifiers :: [TransactionModifier] ,jperiodictxns :: [PeriodicTransaction] ,jtxns :: [Transaction] ,jfinalcommentlines :: Text -- ^ any final trailing comments in the (main) journal file diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs index 575c1f3f2..8795644a5 100644 --- a/hledger-lib/Hledger/Read/Common.hs +++ b/hledger-lib/Hledger/Read/Common.hs @@ -209,9 +209,9 @@ journalSourcePos p p' = JournalSourcePos (sourceName p) (fromIntegral . unPos $ generateAutomaticPostings :: Journal -> Journal generateAutomaticPostings j = j { jtxns = map modifier $ jtxns j } where - modifier = foldr (flip (.) . runModifierTransaction') id mtxns - runModifierTransaction' = fmap txnTieKnot . runModifierTransaction Q.Any - mtxns = jmodifiertxns j + modifier = foldr (flip (.) . transactionModifierToFunction') id mtxns + transactionModifierToFunction' = fmap txnTieKnot . transactionModifierToFunction Q.Any + mtxns = jtxnmodifiers j -- | Given a megaparsec ParsedJournal parser, input options, file -- path and file content: parse and post-process a Journal, or give an error. diff --git a/hledger-lib/Hledger/Read/JournalReader.hs b/hledger-lib/Hledger/Read/JournalReader.hs index 249b33f4c..38f971e3c 100644 --- a/hledger-lib/Hledger/Read/JournalReader.hs +++ b/hledger-lib/Hledger/Read/JournalReader.hs @@ -154,7 +154,7 @@ addJournalItemP = choice [ directivep , transactionp >>= modify' . addTransaction - , modifiertransactionp >>= modify' . addModifierTransaction + , transactionmodifierp >>= modify' . addTransactionModifier , periodictransactionp >>= modify' . addPeriodicTransaction , marketpricedirectivep >>= modify' . addMarketPrice , void (lift emptyorcommentlinep) @@ -470,14 +470,14 @@ commodityconversiondirectivep = do --- ** transactions -- TODO transactionmodifierp ? transactionrewritep ? -modifiertransactionp :: JournalParser m ModifierTransaction -modifiertransactionp = do +transactionmodifierp :: JournalParser m TransactionModifier +transactionmodifierp = do char '=' "modifier transaction" lift (skipMany spacenonewline) querytxt <- lift $ T.strip <$> descriptionp (_comment, _tags) <- lift transactioncommentp -- TODO apply these to modified txns ? postings <- postingsp Nothing - return $ ModifierTransaction querytxt postings + return $ TransactionModifier querytxt postings -- | Parse a periodic transaction periodictransactionp :: MonadIO m => JournalParser m PeriodicTransaction @@ -748,8 +748,8 @@ tests_Hledger_Read_JournalReader = TestList $ concat [ test_postingp, test_transactionp, [ - "modifiertransactionp" ~: do - assertParse (parseWithState mempty modifiertransactionp "= (some value expr)\n some:postings 1\n") + "transactionmodifierp" ~: do + assertParse (parseWithState mempty transactionmodifierp "= (some value expr)\n some:postings 1\n") ,"periodictransactionp" ~: do assertParse (parseWithState mempty periodictransactionp "~ (some period expr)\n some:postings 1\n") diff --git a/hledger/Hledger/Cli/Commands/Rewrite.hs b/hledger/Hledger/Cli/Commands/Rewrite.hs index 0bc69d41b..a417a2eb0 100755 --- a/hledger/Hledger/Cli/Commands/Rewrite.hs +++ b/hledger/Hledger/Cli/Commands/Rewrite.hs @@ -178,12 +178,12 @@ but with these differences: rewrite opts@CliOpts{rawopts_=rawopts,reportopts_=ropts} j@Journal{jtxns=ts} = do d <- getCurrentDay let q = queryFromOpts d ropts - modifier <- modifierTransactionFromOpts rawopts + modifier <- transactionModifierFromOpts rawopts -- create re-writer - let modifiers = modifier : jmodifiertxns j + let modifiers = modifier : jtxnmodifiers j -- Note that some query matches require transaction. Thus modifiers -- 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 let j' = j{jtxns=map modifier' ts} -- run the print command, showing all transactions @@ -195,11 +195,11 @@ postingp' t = runJournalParser (postingp Nothing <* eof) t' >>= \case Right p -> return p where t' = " " <> t <> "\n" -- inject space and newline for proper parsing -modifierTransactionFromOpts :: RawOpts -> IO ModifierTransaction -modifierTransactionFromOpts opts = do +transactionModifierFromOpts :: RawOpts -> IO TransactionModifier +transactionModifierFromOpts opts = do postings <- mapM (postingp' . stripquotes . T.pack) $ listofstringopt "add-posting" opts return - ModifierTransaction { mtvalueexpr = T.empty, mtpostings = postings } + TransactionModifier { tmquerytxt = T.empty, tmpostings = postings } outputFromOpts :: RawOpts -> (CliOpts -> Journal -> Journal -> IO ()) outputFromOpts opts