{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE CPP #-}
module Hledger.Data.TransactionModifier (
modifyTransactions
)
where
import Control.Applicative ((<|>))
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.Data.Transaction
import Hledger.Query
import Hledger.Data.Posting (commentJoin, commentAddTag)
import Hledger.Utils.UTF8IOCompat (error')
import Hledger.Utils.Debug
modifyTransactions :: [TransactionModifier] -> [Transaction] -> [Transaction]
modifyTransactions :: [TransactionModifier] -> [Transaction] -> [Transaction]
modifyTransactions tmods :: [TransactionModifier]
tmods = (Transaction -> Transaction) -> [Transaction] -> [Transaction]
forall a b. (a -> b) -> [a] -> [b]
map Transaction -> Transaction
applymods
where
applymods :: Transaction -> Transaction
applymods t :: Transaction
t = Transaction
taggedt'
where
t' :: Transaction
t' = (TransactionModifier
-> (Transaction -> Transaction) -> Transaction -> Transaction)
-> (Transaction -> Transaction)
-> [TransactionModifier]
-> 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)
-> (Transaction -> Transaction) -> Transaction -> Transaction)
-> (TransactionModifier -> Transaction -> Transaction)
-> TransactionModifier
-> (Transaction -> Transaction)
-> Transaction
-> Transaction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TransactionModifier -> Transaction -> Transaction
transactionModifierToFunction) Transaction -> Transaction
forall a. a -> a
id [TransactionModifier]
tmods Transaction
t
taggedt' :: Transaction
taggedt'
| Transaction
t' Transaction -> Transaction -> Bool
forall a. Eq a => a -> a -> Bool
/= Transaction
t = Transaction
t'{tcomment :: Text
tcomment = Transaction -> Text
tcomment Transaction
t' Text -> Tag -> Text
`commentAddTag` ("modified","")
,ttags :: [Tag]
ttags = ("modified","") Tag -> [Tag] -> [Tag]
forall a. a -> [a] -> [a]
: Transaction -> [Tag]
ttags Transaction
t'
}
| Bool
otherwise = Transaction
t'
transactionModifierToFunction :: TransactionModifier -> (Transaction -> Transaction)
transactionModifierToFunction :: TransactionModifier -> Transaction -> Transaction
transactionModifierToFunction mt :: TransactionModifier
mt =
\t :: Transaction
t@(Transaction -> [Posting]
tpostings -> [Posting]
ps) -> Transaction -> Transaction
txnTieKnot Transaction
t{ tpostings :: [Posting]
tpostings=[Posting] -> [Posting]
generatePostings [Posting]
ps }
where
q :: Query
q = Query -> Query
simplifyQuery (Query -> Query) -> Query -> Query
forall a b. (a -> b) -> a -> b
$ TransactionModifier -> Day -> Query
tmParseQuery TransactionModifier
mt (String -> Day
forall a. String -> a
error' "a transaction modifier's query cannot depend on current date")
mods :: [Posting -> Posting]
mods = (Posting -> Posting -> Posting)
-> [Posting] -> [Posting -> Posting]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Posting -> Posting -> Posting
tmPostingRuleToFunction (TransactionModifier -> Text
tmquerytxt TransactionModifier
mt)) ([Posting] -> [Posting -> Posting])
-> [Posting] -> [Posting -> Posting]
forall a b. (a -> b) -> a -> b
$ TransactionModifier -> [Posting]
tmpostingrules TransactionModifier
mt
generatePostings :: [Posting] -> [Posting]
generatePostings ps :: [Posting]
ps = [Posting
p' | Posting
p <- [Posting]
ps
, Posting
p' <- if Query
q Query -> Posting -> Bool
`matchesPosting` Posting
p then Posting
pPosting -> [Posting] -> [Posting]
forall a. a -> [a] -> [a]
:[ Posting -> Posting
m Posting
p | Posting -> Posting
m <- [Posting -> Posting]
mods] else [Posting
p]]
tmParseQuery :: TransactionModifier -> (Day -> Query)
tmParseQuery :: TransactionModifier -> Day -> Query
tmParseQuery mt :: TransactionModifier
mt = (Query, [QueryOpt]) -> Query
forall a b. (a, b) -> a
fst ((Query, [QueryOpt]) -> Query)
-> (Day -> (Query, [QueryOpt])) -> Day -> Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Day -> Text -> (Query, [QueryOpt]))
-> Text -> Day -> (Query, [QueryOpt])
forall a b c. (a -> b -> c) -> b -> a -> c
flip Day -> Text -> (Query, [QueryOpt])
parseQuery (TransactionModifier -> Text
tmquerytxt TransactionModifier
mt)
tmPostingRuleToFunction :: T.Text -> TMPostingRule -> (Posting -> Posting)
tmPostingRuleToFunction :: Text -> Posting -> Posting -> Posting
tmPostingRuleToFunction querytxt :: Text
querytxt pr :: Posting
pr =
\p :: Posting
p -> 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 :: Text
pcomment = Posting -> Text
pcomment Posting
pr Text -> Tag -> Text
`commentAddTag` ("generated-posting",Text
qry)
, ptags :: [Tag]
ptags = ("generated-posting", Text
qry) Tag -> [Tag] -> [Tag]
forall a. a -> [a] -> [a]
:
("_generated-posting",Text
qry) Tag -> [Tag] -> [Tag]
forall a. a -> [a] -> [a]
:
Posting -> [Tag]
ptags Posting
pr
}
where
qry :: Text
qry = "= " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
querytxt
amount' :: Posting -> MixedAmount
amount' = case Posting -> Maybe Quantity
postingRuleMultiplier Posting
pr of
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 n :: Quantity
n -> \p :: Posting
p ->
let
pramount :: Amount
pramount = String -> Amount -> Amount
forall a. Show a => String -> a -> a
dbg6 "pramount" (Amount -> Amount) -> Amount -> Amount
forall a b. (a -> b) -> a -> b
$ [Amount] -> Amount
forall a. [a] -> a
head ([Amount] -> Amount) -> [Amount] -> Amount
forall a b. (a -> b) -> a -> b
$ MixedAmount -> [Amount]
amounts (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 "matchedamount" (MixedAmount -> MixedAmount) -> MixedAmount -> MixedAmount
forall a b. (a -> b) -> a -> b
$ Posting -> MixedAmount
pamount Posting
p
Mixed as :: [Amount]
as = String -> MixedAmount -> MixedAmount
forall a. Show a => String -> a -> a
dbg6 "multipliedamount" (MixedAmount -> MixedAmount) -> MixedAmount -> MixedAmount
forall a b. (a -> b) -> a -> b
$ Quantity
n Quantity -> MixedAmount -> MixedAmount
`multiplyMixedAmountAndPrice` MixedAmount
matchedamount
in
case Amount -> Text
acommodity Amount
pramount of
"" -> [Amount] -> MixedAmount
Mixed [Amount]
as
c :: Text
c -> [Amount] -> MixedAmount
Mixed [Amount
a{acommodity :: Text
acommodity = Text
c, astyle :: AmountStyle
astyle = Amount -> AmountStyle
astyle Amount
pramount, aprice :: Maybe AmountPrice
aprice = Amount -> Maybe AmountPrice
aprice Amount
pramount} | Amount
a <- [Amount]
as]
postingRuleMultiplier :: TMPostingRule -> Maybe Quantity
postingRuleMultiplier :: Posting -> Maybe Quantity
postingRuleMultiplier p :: Posting
p =
case MixedAmount -> [Amount]
amounts (MixedAmount -> [Amount]) -> MixedAmount -> [Amount]
forall a b. (a -> b) -> a -> b
$ Posting -> MixedAmount
pamount Posting
p of
[a :: Amount
a] | Amount -> Bool
aismultiplier Amount
a -> 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
_ -> Maybe Quantity
forall a. Maybe a
Nothing
renderPostingCommentDates :: Posting -> Posting
p :: Posting
p = Posting
p { pcomment :: Text
pcomment = Text
comment' }
where
dates :: Text
dates = [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [Maybe Text] -> [Text]
forall a. [Maybe a] -> [a]
catMaybes [String -> Text
T.pack (String -> Text) -> (Day -> String) -> Day -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> String
showDate (Day -> Text) -> Maybe Day -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Posting -> Maybe Day
pdate Posting
p, ("=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (Day -> Text) -> Day -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (Day -> String) -> Day -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> String
showDate (Day -> Text) -> Maybe Day -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Posting -> Maybe Day
pdate2 Posting
p]
comment' :: Text
comment'
| Text -> Bool
T.null Text
dates = Posting -> Text
pcomment Posting
p
| Bool
otherwise = ("[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
dates Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "]") Text -> Text -> Text
`commentJoin` Posting -> Text
pcomment Posting
p