{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
module Hledger.Data.TransactionModifier (
modifyTransactions
)
where
import Control.Applicative ((<|>), liftA2)
import qualified Data.Map as M
import Data.Maybe (catMaybes)
import qualified Data.Text as T
import Data.Time.Calendar (Day)
import Hledger.Data.Types
import Hledger.Data.Amount
import Hledger.Data.Dates
import Hledger.Data.Transaction (txnTieKnot)
import Hledger.Query (Query, filterQuery, matchesAmount, matchesPostingExtra,
parseQuery, queryIsAmt, queryIsSym, simplifyQuery)
import Hledger.Data.Posting (commentJoin, commentAddTag, postingAddTags, postingApplyCommodityStyles)
import Hledger.Utils (dbg6, wrap)
modifyTransactions :: (AccountName -> Maybe AccountType)
-> (AccountName -> [Tag])
-> M.Map CommoditySymbol AmountStyle
-> Day -> [TransactionModifier] -> [Transaction]
-> Either String [Transaction]
modifyTransactions :: (AccountName -> Maybe AccountType)
-> (AccountName -> [Tag])
-> Map AccountName AmountStyle
-> Day
-> [TransactionModifier]
-> [Transaction]
-> Either String [Transaction]
modifyTransactions AccountName -> Maybe AccountType
atypes AccountName -> [Tag]
atags Map AccountName AmountStyle
styles Day
d [TransactionModifier]
tmods [Transaction]
ts = do
[Transaction -> Transaction]
fs <- (TransactionModifier -> Either String (Transaction -> Transaction))
-> [TransactionModifier]
-> Either String [Transaction -> Transaction]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((AccountName -> Maybe AccountType)
-> (AccountName -> [Tag])
-> Map AccountName AmountStyle
-> Day
-> TransactionModifier
-> Either String (Transaction -> Transaction)
transactionModifierToFunction AccountName -> Maybe AccountType
atypes AccountName -> [Tag]
atags Map AccountName AmountStyle
styles Day
d) [TransactionModifier]
tmods
let
modifytxn :: Transaction -> Transaction
modifytxn Transaction
t = Transaction
t''
where
t' :: Transaction
t' = ((Transaction -> Transaction)
-> (Transaction -> Transaction) -> Transaction -> Transaction)
-> (Transaction -> Transaction)
-> [Transaction -> Transaction]
-> Transaction
-> Transaction
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (((Transaction -> Transaction)
-> (Transaction -> Transaction) -> Transaction -> Transaction)
-> (Transaction -> Transaction)
-> (Transaction -> Transaction)
-> Transaction
-> Transaction
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Transaction -> Transaction)
-> (Transaction -> Transaction) -> Transaction -> Transaction
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.)) Transaction -> Transaction
forall a. a -> a
id [Transaction -> Transaction]
fs Transaction
t
t'' :: Transaction
t'' = if Transaction
t' Transaction -> Transaction -> Bool
forall a. Eq a => a -> a -> Bool
== Transaction
t
then Transaction
t'
else Transaction
t'{tcomment :: AccountName
tcomment=Transaction -> AccountName
tcomment Transaction
t' AccountName -> Tag -> AccountName
`commentAddTag` (AccountName
"modified",AccountName
""), ttags :: [Tag]
ttags=(AccountName
"modified",AccountName
"") Tag -> [Tag] -> [Tag]
forall a. a -> [a] -> [a]
: Transaction -> [Tag]
ttags Transaction
t'}
[Transaction] -> Either String [Transaction]
forall a b. b -> Either a b
Right ([Transaction] -> Either String [Transaction])
-> [Transaction] -> Either String [Transaction]
forall a b. (a -> b) -> a -> b
$ (Transaction -> Transaction) -> [Transaction] -> [Transaction]
forall a b. (a -> b) -> [a] -> [b]
map Transaction -> Transaction
modifytxn [Transaction]
ts
transactionModifierToFunction :: (AccountName -> Maybe AccountType)
-> (AccountName -> [Tag])
-> M.Map CommoditySymbol AmountStyle
-> Day -> TransactionModifier
-> Either String (Transaction -> Transaction)
transactionModifierToFunction :: (AccountName -> Maybe AccountType)
-> (AccountName -> [Tag])
-> Map AccountName AmountStyle
-> Day
-> TransactionModifier
-> Either String (Transaction -> Transaction)
transactionModifierToFunction AccountName -> Maybe AccountType
atypes AccountName -> [Tag]
atags Map AccountName AmountStyle
styles Day
refdate TransactionModifier{AccountName
tmquerytxt :: TransactionModifier -> AccountName
tmquerytxt :: AccountName
tmquerytxt, [TMPostingRule]
tmpostingrules :: TransactionModifier -> [TMPostingRule]
tmpostingrules :: [TMPostingRule]
tmpostingrules} = do
Query
q <- Query -> Query
simplifyQuery (Query -> Query)
-> ((Query, [QueryOpt]) -> Query) -> (Query, [QueryOpt]) -> Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Query, [QueryOpt]) -> Query
forall a b. (a, b) -> a
fst ((Query, [QueryOpt]) -> Query)
-> Either String (Query, [QueryOpt]) -> Either String Query
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Day -> AccountName -> Either String (Query, [QueryOpt])
parseQuery Day
refdate AccountName
tmquerytxt
let
fs :: [Posting -> Posting]
fs = (TMPostingRule -> Posting -> Posting)
-> [TMPostingRule] -> [Posting -> Posting]
forall a b. (a -> b) -> [a] -> [b]
map (\TMPostingRule
tmpr -> Posting -> Posting
addAccountTags (Posting -> Posting) -> (Posting -> Posting) -> Posting -> Posting
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map AccountName AmountStyle
-> Query -> AccountName -> TMPostingRule -> Posting -> Posting
tmPostingRuleToFunction Map AccountName AmountStyle
styles Query
q AccountName
tmquerytxt TMPostingRule
tmpr) [TMPostingRule]
tmpostingrules
addAccountTags :: Posting -> Posting
addAccountTags Posting
p = Posting
p Posting -> [Tag] -> Posting
`postingAddTags` AccountName -> [Tag]
atags (Posting -> AccountName
paccount Posting
p)
generatePostings :: Posting -> [Posting]
generatePostings Posting
p = Posting
p Posting -> [Posting] -> [Posting]
forall a. a -> [a] -> [a]
: ((Posting -> Posting) -> Posting)
-> [Posting -> Posting] -> [Posting]
forall a b. (a -> b) -> [a] -> [b]
map ((Posting -> Posting) -> Posting -> Posting
forall a b. (a -> b) -> a -> b
$ Posting
p) (if (AccountName -> Maybe AccountType) -> Query -> Posting -> Bool
matchesPostingExtra AccountName -> Maybe AccountType
atypes Query
q Posting
p then [Posting -> Posting]
fs else [])
(Transaction -> Transaction)
-> Either String (Transaction -> Transaction)
forall a b. b -> Either a b
Right ((Transaction -> Transaction)
-> Either String (Transaction -> Transaction))
-> (Transaction -> Transaction)
-> Either String (Transaction -> Transaction)
forall a b. (a -> b) -> a -> b
$ \t :: Transaction
t@(Transaction -> [Posting]
tpostings -> [Posting]
ps) -> Transaction -> Transaction
txnTieKnot Transaction
t{tpostings :: [Posting]
tpostings=(Posting -> [Posting]) -> [Posting] -> [Posting]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Posting -> [Posting]
generatePostings [Posting]
ps}
tmPostingRuleToFunction :: M.Map CommoditySymbol AmountStyle -> Query -> T.Text -> TMPostingRule -> (Posting -> Posting)
tmPostingRuleToFunction :: Map AccountName AmountStyle
-> Query -> AccountName -> TMPostingRule -> Posting -> Posting
tmPostingRuleToFunction Map AccountName AmountStyle
styles Query
query AccountName
querytxt TMPostingRule
tmpr =
\Posting
p -> Map AccountName AmountStyle -> Posting -> Posting
postingApplyCommodityStyles Map AccountName AmountStyle
styles (Posting -> Posting) -> (Posting -> Posting) -> Posting -> Posting
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Posting -> Posting
renderPostingCommentDates (Posting -> Posting) -> Posting -> Posting
forall a b. (a -> b) -> a -> b
$ Posting
pr
{ pdate :: Maybe Day
pdate = Posting -> Maybe Day
pdate Posting
pr Maybe Day -> Maybe Day -> Maybe Day
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Posting -> Maybe Day
pdate Posting
p
, pdate2 :: Maybe Day
pdate2 = Posting -> Maybe Day
pdate2 Posting
pr Maybe Day -> Maybe Day -> Maybe Day
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Posting -> Maybe Day
pdate2 Posting
p
, pamount :: MixedAmount
pamount = Posting -> MixedAmount
amount' Posting
p
, pcomment :: AccountName
pcomment = Posting -> AccountName
pcomment Posting
pr AccountName -> Tag -> AccountName
`commentAddTag` (AccountName
"generated-posting",AccountName
qry)
, ptags :: [Tag]
ptags = (AccountName
"generated-posting", AccountName
qry) Tag -> [Tag] -> [Tag]
forall a. a -> [a] -> [a]
:
(AccountName
"_generated-posting",AccountName
qry) Tag -> [Tag] -> [Tag]
forall a. a -> [a] -> [a]
:
Posting -> [Tag]
ptags Posting
pr
}
where
pr :: Posting
pr = TMPostingRule -> Posting
tmprPosting TMPostingRule
tmpr
qry :: AccountName
qry = AccountName
"= " AccountName -> AccountName -> AccountName
forall a. Semigroup a => a -> a -> a
<> AccountName
querytxt
symq :: Query
symq = (Query -> Bool) -> Query -> Query
filterQuery ((Bool -> Bool -> Bool)
-> (Query -> Bool) -> (Query -> Bool) -> Query -> Bool
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Bool -> Bool -> Bool
(||) Query -> Bool
queryIsSym Query -> Bool
queryIsAmt) Query
query
amount' :: Posting -> MixedAmount
amount' = case TMPostingRule -> Maybe Quantity
postingRuleMultiplier TMPostingRule
tmpr of
Maybe Quantity
Nothing -> MixedAmount -> Posting -> MixedAmount
forall a b. a -> b -> a
const (MixedAmount -> Posting -> MixedAmount)
-> MixedAmount -> Posting -> MixedAmount
forall a b. (a -> b) -> a -> b
$ Posting -> MixedAmount
pamount Posting
pr
Just Quantity
n -> \Posting
p ->
let
pramount :: Amount
pramount = String -> Amount -> Amount
forall a. Show a => String -> a -> a
dbg6 String
"pramount" (Amount -> Amount)
-> (MixedAmount -> Amount) -> MixedAmount -> Amount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Amount] -> Amount
forall a. [a] -> a
head ([Amount] -> Amount)
-> (MixedAmount -> [Amount]) -> MixedAmount -> Amount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MixedAmount -> [Amount]
amountsRaw (MixedAmount -> Amount) -> MixedAmount -> Amount
forall a b. (a -> b) -> a -> b
$ Posting -> MixedAmount
pamount Posting
pr
matchedamount :: MixedAmount
matchedamount = String -> MixedAmount -> MixedAmount
forall a. Show a => String -> a -> a
dbg6 String
"matchedamount" (MixedAmount -> MixedAmount)
-> (MixedAmount -> MixedAmount) -> MixedAmount -> MixedAmount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Amount -> Bool) -> MixedAmount -> MixedAmount
filterMixedAmount (Query
symq Query -> Amount -> Bool
`matchesAmount`) (MixedAmount -> MixedAmount) -> MixedAmount -> MixedAmount
forall a b. (a -> b) -> a -> b
$ Posting -> MixedAmount
pamount Posting
p
as :: MixedAmount
as = String -> MixedAmount -> MixedAmount
forall a. Show a => String -> a -> a
dbg6 String
"multipliedamount" (MixedAmount -> MixedAmount) -> MixedAmount -> MixedAmount
forall a b. (a -> b) -> a -> b
$ Quantity -> MixedAmount -> MixedAmount
multiplyMixedAmount Quantity
n MixedAmount
matchedamount
in
case Amount -> AccountName
acommodity Amount
pramount of
AccountName
"" -> MixedAmount
as
AccountName
c -> (Amount -> Amount) -> MixedAmount -> MixedAmount
mapMixedAmount (\Amount
a -> Amount
a{acommodity :: AccountName
acommodity = AccountName
c, astyle :: AmountStyle
astyle = Amount -> AmountStyle
astyle Amount
pramount, aprice :: Maybe AmountPrice
aprice = Amount -> Maybe AmountPrice
aprice Amount
pramount}) MixedAmount
as
postingRuleMultiplier :: TMPostingRule -> Maybe Quantity
postingRuleMultiplier :: TMPostingRule -> Maybe Quantity
postingRuleMultiplier TMPostingRule
tmpr = case MixedAmount -> [Amount]
amountsRaw (MixedAmount -> [Amount])
-> (Posting -> MixedAmount) -> Posting -> [Amount]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Posting -> MixedAmount
pamount (Posting -> [Amount]) -> Posting -> [Amount]
forall a b. (a -> b) -> a -> b
$ TMPostingRule -> Posting
tmprPosting TMPostingRule
tmpr of
[Amount
a] | TMPostingRule -> Bool
tmprIsMultiplier TMPostingRule
tmpr -> Quantity -> Maybe Quantity
forall a. a -> Maybe a
Just (Quantity -> Maybe Quantity) -> Quantity -> Maybe Quantity
forall a b. (a -> b) -> a -> b
$ Amount -> Quantity
aquantity Amount
a
[Amount]
_ -> Maybe Quantity
forall a. Maybe a
Nothing
renderPostingCommentDates :: Posting -> Posting
Posting
p = Posting
p { pcomment :: AccountName
pcomment = AccountName
comment' }
where
dates :: AccountName
dates = [AccountName] -> AccountName
T.concat ([AccountName] -> AccountName) -> [AccountName] -> AccountName
forall a b. (a -> b) -> a -> b
$ [Maybe AccountName] -> [AccountName]
forall a. [Maybe a] -> [a]
catMaybes [Day -> AccountName
showDate (Day -> AccountName) -> Maybe Day -> Maybe AccountName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Posting -> Maybe Day
pdate Posting
p, (AccountName
"=" AccountName -> AccountName -> AccountName
forall a. Semigroup a => a -> a -> a
<>) (AccountName -> AccountName)
-> (Day -> AccountName) -> Day -> AccountName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> AccountName
showDate (Day -> AccountName) -> Maybe Day -> Maybe AccountName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Posting -> Maybe Day
pdate2 Posting
p]
comment' :: AccountName
comment'
| AccountName -> Bool
T.null AccountName
dates = Posting -> AccountName
pcomment Posting
p
| Bool
otherwise = (AccountName -> AccountName -> AccountName -> AccountName
wrap AccountName
"[" AccountName
"]" AccountName
dates) AccountName -> AccountName -> AccountName
`commentJoin` Posting -> AccountName
pcomment Posting
p