lib: AutoTransaction.hs -> TransactionModifier.hs, PeriodicTransaction.hs
This commit is contained in:
Simon Michael
parent
efc54c4c25
commit
a49b1cd3bb
@ -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
|
||||
|
||||
@ -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
|
||||
-- <BLANKLINE>
|
||||
-- <BLANKLINE>
|
||||
-- >>> transactionModifierToFunction Any (TransactionModifier "miss" ["pong" `post` usd 2]) nulltransaction{tpostings=["ping" `post` usd 1]}
|
||||
-- 0000/01/01
|
||||
-- ping $1.00
|
||||
-- <BLANKLINE>
|
||||
-- <BLANKLINE>
|
||||
-- >>> transactionModifierToFunction None (TransactionModifier "" ["pong" `post` usd 2]) nulltransaction{tpostings=["ping" `post` usd 1]}
|
||||
-- 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
|
||||
-- ping $2.00
|
||||
-- pong $6.00
|
||||
-- <BLANKLINE>
|
||||
-- <BLANKLINE>
|
||||
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
|
||||
137
hledger-lib/Hledger/Data/TransactionModifier.hs
Normal file
137
hledger-lib/Hledger/Data/TransactionModifier.hs
Normal file
@ -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
|
||||
-- <BLANKLINE>
|
||||
-- <BLANKLINE>
|
||||
-- >>> transactionModifierToFunction Any (TransactionModifier "miss" ["pong" `post` usd 2]) nulltransaction{tpostings=["ping" `post` usd 1]}
|
||||
-- 0000/01/01
|
||||
-- ping $1.00
|
||||
-- <BLANKLINE>
|
||||
-- <BLANKLINE>
|
||||
-- >>> transactionModifierToFunction None (TransactionModifier "" ["pong" `post` usd 2]) nulltransaction{tpostings=["ping" `post` usd 1]}
|
||||
-- 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
|
||||
-- ping $2.00
|
||||
-- pong $6.00
|
||||
-- <BLANKLINE>
|
||||
-- <BLANKLINE>
|
||||
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 <> "]"]
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user