lib: ModifierTransaction -> TransactionModifier; try to clarify a bit
This commit is contained in:
Simon Michael
parent
007b9f8caa
commit
efc54c4c25
@ -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
|
||||
-- <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
|
||||
-- ping $1.00
|
||||
-- <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
|
||||
-- ping $1.00
|
||||
-- <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
|
||||
-- ping $2.00
|
||||
-- pong $6.00
|
||||
-- <BLANKLINE>
|
||||
-- <BLANKLINE>
|
||||
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
|
||||
|
||||
@ -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
|
||||
})
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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))
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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.
|
||||
|
||||
@ -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")
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user