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