From a49b1cd3bb5026d1d1047f7101178c17c1c76f2e Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Mon, 30 Jul 2018 19:38:47 +0100 Subject: [PATCH] lib: AutoTransaction.hs -> TransactionModifier.hs, PeriodicTransaction.hs --- hledger-lib/Hledger/Data.hs | 6 +- ...oTransaction.hs => PeriodicTransaction.hs} | 130 +---------------- .../Hledger/Data/TransactionModifier.hs | 137 ++++++++++++++++++ hledger-lib/hledger-lib.cabal | 14 +- hledger-lib/package.yaml | 3 +- 5 files changed, 157 insertions(+), 133 deletions(-) rename hledger-lib/Hledger/Data/{AutoTransaction.hs => PeriodicTransaction.hs} (57%) create mode 100644 hledger-lib/Hledger/Data/TransactionModifier.hs diff --git a/hledger-lib/Hledger/Data.hs b/hledger-lib/Hledger/Data.hs index cfd4bef73..2b9475fcb 100644 --- a/hledger-lib/Hledger/Data.hs +++ b/hledger-lib/Hledger/Data.hs @@ -17,12 +17,13 @@ module Hledger.Data ( module Hledger.Data.Ledger, module Hledger.Data.MarketPrice, module Hledger.Data.Period, + module Hledger.Data.PeriodicTransaction, module Hledger.Data.Posting, module Hledger.Data.RawOptions, module Hledger.Data.StringFormat, module Hledger.Data.Timeclock, module Hledger.Data.Transaction, - module Hledger.Data.AutoTransaction, + module Hledger.Data.TransactionModifier, module Hledger.Data.Types, tests_Hledger_Data ) @@ -38,12 +39,13 @@ import Hledger.Data.Journal import Hledger.Data.Ledger import Hledger.Data.MarketPrice import Hledger.Data.Period +import Hledger.Data.PeriodicTransaction import Hledger.Data.Posting import Hledger.Data.RawOptions import Hledger.Data.StringFormat import Hledger.Data.Timeclock import Hledger.Data.Transaction -import Hledger.Data.AutoTransaction +import Hledger.Data.TransactionModifier import Hledger.Data.Types tests_Hledger_Data :: Test diff --git a/hledger-lib/Hledger/Data/AutoTransaction.hs b/hledger-lib/Hledger/Data/PeriodicTransaction.hs similarity index 57% rename from hledger-lib/Hledger/Data/AutoTransaction.hs rename to hledger-lib/Hledger/Data/PeriodicTransaction.hs index 0bc85f3fb..61f7d414f 100644 --- a/hledger-lib/Hledger/Data/AutoTransaction.hs +++ b/hledger-lib/Hledger/Data/PeriodicTransaction.hs @@ -1,34 +1,20 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE CPP #-} {-| -This module provides helpers for applying 'TransactionModifier's -(eg generating automated postings) and generating 'PeriodicTransaction's. +A 'PeriodicTransaction' is a rule describing recurring transactions. -} -module Hledger.Data.AutoTransaction - ( - -- * Transaction modifiers - transactionModifierToFunction - - -- * Periodic transactions - , runPeriodicTransaction - , checkPeriodicTransactionStartDate - - -- -- * Accessors, seemingly unused - -- , tmParseQuery - -- , jdatespan - -- , periodTransactionInterval - ) +module Hledger.Data.PeriodicTransaction ( + runPeriodicTransaction + , checkPeriodicTransactionStartDate +) where -import Data.Maybe #if !(MIN_VERSION_base(4,11,0)) import Data.Monoid ((<>)) #endif -import Data.Time.Calendar import qualified Data.Text as T import Hledger.Data.Types import Hledger.Data.Dates @@ -36,7 +22,6 @@ import Hledger.Data.Amount import Hledger.Data.Posting (post) import Hledger.Data.Transaction import Hledger.Utils.UTF8IOCompat (error') -import Hledger.Query -- import Hledger.Utils.Debug -- $setup @@ -44,111 +29,6 @@ import Hledger.Query -- >>> import Hledger.Data.Posting -- >>> import Hledger.Data.Journal --- | 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. --- --- >>> transactionModifierToFunction Any (TransactionModifier "" ["pong" `post` usd 2]) nulltransaction{tpostings=["ping" `post` usd 1]} --- 0000/01/01 --- ping $1.00 --- pong $2.00 --- --- --- >>> transactionModifierToFunction Any (TransactionModifier "miss" ["pong" `post` usd 2]) nulltransaction{tpostings=["ping" `post` usd 1]} --- 0000/01/01 --- ping $1.00 --- --- --- >>> transactionModifierToFunction None (TransactionModifier "" ["pong" `post` usd 2]) nulltransaction{tpostings=["ping" `post` usd 1]} --- 0000/01/01 --- ping $1.00 --- --- --- >>> 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 --- --- -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]] - --- | Parse the 'Query' from a 'TransactionModifier's 'tmquerytxt', --- and return it as a function requiring the current date. --- --- >>> mtvaluequery (TransactionModifier "" []) undefined --- Any --- >>> mtvaluequery (TransactionModifier "ping" []) undefined --- Acct "ping" --- >>> mtvaluequery (TransactionModifier "date:2016" []) undefined --- Date (DateSpan 2016) --- >>> mtvaluequery (TransactionModifier "date:today" []) (read "2017-01-01") --- Date (DateSpan 2017/01/01) -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 '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 = - case amounts $ pamount p of - [a] | amultiplier a -> Just $ aquantity a - _ -> Nothing - --- | 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) - withAmountType amount (Mixed as) = case acommodity amount of - "" -> Mixed as - c -> Mixed [a{acommodity = c, astyle = astyle amount, aprice = aprice amount} | a <- as] - -renderPostingCommentDates :: Posting -> Posting -renderPostingCommentDates p = p { pcomment = comment' } - where - datesComment = T.concat $ catMaybes [T.pack . showDate <$> pdate p, ("=" <>) . T.pack . showDate <$> pdate2 p] - comment' - | T.null datesComment = pcomment p - | otherwise = T.intercalate "\n" $ filter (not . T.null) [T.strip $ pcomment p, "[" <> datesComment <> "]"] - -- doctest helper, too much hassle to define in the comment -- XXX duplicates some logic in periodictransactionp _ptgen str = do diff --git a/hledger-lib/Hledger/Data/TransactionModifier.hs b/hledger-lib/Hledger/Data/TransactionModifier.hs new file mode 100644 index 000000000..22f31dee5 --- /dev/null +++ b/hledger-lib/Hledger/Data/TransactionModifier.hs @@ -0,0 +1,137 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE CPP #-} +{-| + +A 'TransactionModifier' is a rule that modifies certain 'Transaction's, +typically adding automated postings to them. + +-} +module Hledger.Data.TransactionModifier ( + transactionModifierToFunction +) +where + +import Data.Maybe +#if !(MIN_VERSION_base(4,11,0)) +import Data.Monoid ((<>)) +#endif +import qualified Data.Text as T +import Data.Time.Calendar +import Hledger.Data.Types +import Hledger.Data.Dates +import Hledger.Data.Amount +import Hledger.Query +import Hledger.Utils.UTF8IOCompat (error') +-- import Hledger.Utils.Debug + +-- $setup +-- >>> :set -XOverloadedStrings +-- >>> import Hledger.Data.Posting +-- >>> import Hledger.Data.Transaction +-- >>> import Hledger.Data.Journal + +-- | 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. +-- +-- >>> transactionModifierToFunction Any (TransactionModifier "" ["pong" `post` usd 2]) nulltransaction{tpostings=["ping" `post` usd 1]} +-- 0000/01/01 +-- ping $1.00 +-- pong $2.00 +-- +-- +-- >>> transactionModifierToFunction Any (TransactionModifier "miss" ["pong" `post` usd 2]) nulltransaction{tpostings=["ping" `post` usd 1]} +-- 0000/01/01 +-- ping $1.00 +-- +-- +-- >>> transactionModifierToFunction None (TransactionModifier "" ["pong" `post` usd 2]) nulltransaction{tpostings=["ping" `post` usd 1]} +-- 0000/01/01 +-- ping $1.00 +-- +-- +-- >>> 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 +-- +-- +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]] + +-- | Parse the 'Query' from a 'TransactionModifier's 'tmquerytxt', +-- and return it as a function requiring the current date. +-- +-- >>> tmParseQuery (TransactionModifier "" []) undefined +-- Any +-- >>> tmParseQuery (TransactionModifier "ping" []) undefined +-- Acct "ping" +-- >>> tmParseQuery (TransactionModifier "date:2016" []) undefined +-- Date (DateSpan 2016) +-- >>> tmParseQuery (TransactionModifier "date:today" []) (read "2017-01-01") +-- Date (DateSpan 2017/01/01) +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 '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 = + case amounts $ pamount p of + [a] | amultiplier a -> Just $ aquantity a + _ -> Nothing + +-- | 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) + withAmountType amount (Mixed as) = case acommodity amount of + "" -> Mixed as + c -> Mixed [a{acommodity = c, astyle = astyle amount, aprice = aprice amount} | a <- as] + +renderPostingCommentDates :: Posting -> Posting +renderPostingCommentDates p = p { pcomment = comment' } + where + datesComment = T.concat $ catMaybes [T.pack . showDate <$> pdate p, ("=" <>) . T.pack . showDate <$> pdate2 p] + comment' + | T.null datesComment = pcomment p + | otherwise = T.intercalate "\n" $ filter (not . T.null) [T.strip $ pcomment p, "[" <> datesComment <> "]"] diff --git a/hledger-lib/hledger-lib.cabal b/hledger-lib/hledger-lib.cabal index 854e0702a..d4c4fb62b 100644 --- a/hledger-lib/hledger-lib.cabal +++ b/hledger-lib/hledger-lib.cabal @@ -2,7 +2,7 @@ -- -- see: https://github.com/sol/hpack -- --- hash: 43aa3146bd1ffaeb1d8fa11aef445ffdb30976bcb6bc6285e93199a770cb982c +-- hash: 61409a17c81f76ecd1ec1a836d308b382b0c1dffce1c3076bdfe5f8ac6da4370 name: hledger-lib version: 1.10.99 @@ -59,12 +59,13 @@ library Hledger.Data.Ledger Hledger.Data.MarketPrice Hledger.Data.Period + Hledger.Data.PeriodicTransaction Hledger.Data.StringFormat Hledger.Data.Posting Hledger.Data.RawOptions Hledger.Data.Timeclock Hledger.Data.Transaction - Hledger.Data.AutoTransaction + Hledger.Data.TransactionModifier Hledger.Data.Types Hledger.Query Hledger.Read @@ -149,18 +150,19 @@ test-suite doctests Hledger.Data.Account Hledger.Data.AccountName Hledger.Data.Amount - Hledger.Data.AutoTransaction Hledger.Data.Commodity Hledger.Data.Dates Hledger.Data.Journal Hledger.Data.Ledger Hledger.Data.MarketPrice Hledger.Data.Period + Hledger.Data.PeriodicTransaction Hledger.Data.Posting Hledger.Data.RawOptions Hledger.Data.StringFormat Hledger.Data.Timeclock Hledger.Data.Transaction + Hledger.Data.TransactionModifier Hledger.Data.Types Hledger.Query Hledger.Read @@ -246,18 +248,19 @@ test-suite easytests Hledger.Data.Account Hledger.Data.AccountName Hledger.Data.Amount - Hledger.Data.AutoTransaction Hledger.Data.Commodity Hledger.Data.Dates Hledger.Data.Journal Hledger.Data.Ledger Hledger.Data.MarketPrice Hledger.Data.Period + Hledger.Data.PeriodicTransaction Hledger.Data.Posting Hledger.Data.RawOptions Hledger.Data.StringFormat Hledger.Data.Timeclock Hledger.Data.Transaction + Hledger.Data.TransactionModifier Hledger.Data.Types Hledger.Query Hledger.Read @@ -344,18 +347,19 @@ test-suite hunittests Hledger.Data.Account Hledger.Data.AccountName Hledger.Data.Amount - Hledger.Data.AutoTransaction Hledger.Data.Commodity Hledger.Data.Dates Hledger.Data.Journal Hledger.Data.Ledger Hledger.Data.MarketPrice Hledger.Data.Period + Hledger.Data.PeriodicTransaction Hledger.Data.Posting Hledger.Data.RawOptions Hledger.Data.StringFormat Hledger.Data.Timeclock Hledger.Data.Transaction + Hledger.Data.TransactionModifier Hledger.Data.Types Hledger.Query Hledger.Read diff --git a/hledger-lib/package.yaml b/hledger-lib/package.yaml index ab2a8c8f0..ad3f24572 100644 --- a/hledger-lib/package.yaml +++ b/hledger-lib/package.yaml @@ -108,12 +108,13 @@ library: - Hledger.Data.Ledger - Hledger.Data.MarketPrice - Hledger.Data.Period + - Hledger.Data.PeriodicTransaction - Hledger.Data.StringFormat - Hledger.Data.Posting - Hledger.Data.RawOptions - Hledger.Data.Timeclock - Hledger.Data.Transaction - - Hledger.Data.AutoTransaction + - Hledger.Data.TransactionModifier - Hledger.Data.Types - Hledger.Query - Hledger.Read