{-# 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.Dates
import Hledger.Data.Amount
import Hledger.Data.Transaction (txnTieKnot)
import Hledger.Query (Query, filterQuery, matchesAmount, matchesPosting,
parseQuery, queryIsAmt, queryIsSym, simplifyQuery)
import Hledger.Data.Posting (commentJoin, commentAddTag, postingApplyCommodityStyles)
import Hledger.Utils (dbg6, wrap)
modifyTransactions :: M.Map CommoditySymbol AmountStyle -> Day -> [TransactionModifier] -> [Transaction] -> Either String [Transaction]
modifyTransactions :: Map CommoditySymbol AmountStyle
-> Day
-> [TransactionModifier]
-> [Transaction]
-> Either String [Transaction]
modifyTransactions Map CommoditySymbol 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 (Map CommoditySymbol AmountStyle
-> Day
-> TransactionModifier
-> Either String (Transaction -> Transaction)
transactionModifierToFunction Map CommoditySymbol 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 :: CommoditySymbol
tcomment=Transaction -> CommoditySymbol
tcomment Transaction
t' CommoditySymbol -> Tag -> CommoditySymbol
`commentAddTag` (CommoditySymbol
"modified",CommoditySymbol
""), ttags :: [Tag]
ttags=(CommoditySymbol
"modified",CommoditySymbol
"") 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 :: M.Map CommoditySymbol AmountStyle -> Day -> TransactionModifier -> Either String (Transaction -> Transaction)
transactionModifierToFunction :: Map CommoditySymbol AmountStyle
-> Day
-> TransactionModifier
-> Either String (Transaction -> Transaction)
transactionModifierToFunction Map CommoditySymbol AmountStyle
styles Day
refdate TransactionModifier{CommoditySymbol
tmquerytxt :: TransactionModifier -> CommoditySymbol
tmquerytxt :: CommoditySymbol
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 -> CommoditySymbol -> Either String (Query, [QueryOpt])
parseQuery Day
refdate CommoditySymbol
tmquerytxt
let
fs :: [Posting -> Posting]
fs = (TMPostingRule -> Posting -> Posting)
-> [TMPostingRule] -> [Posting -> Posting]
forall a b. (a -> b) -> [a] -> [b]
map (Map CommoditySymbol AmountStyle
-> Query -> CommoditySymbol -> TMPostingRule -> Posting -> Posting
tmPostingRuleToFunction Map CommoditySymbol AmountStyle
styles Query
q CommoditySymbol
tmquerytxt) [TMPostingRule]
tmpostingrules
generatePostings :: t Posting -> [Posting]
generatePostings t Posting
ps = (Posting -> [Posting]) -> t Posting -> [Posting]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\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 Query
q Query -> Posting -> Bool
`matchesPosting` Posting
p then [Posting -> Posting]
fs else [])) t Posting
ps
(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]
forall (t :: * -> *). Foldable t => t Posting -> [Posting]
generatePostings [Posting]
ps}
tmPostingRuleToFunction :: M.Map CommoditySymbol AmountStyle -> Query -> T.Text -> TMPostingRule -> (Posting -> Posting)
tmPostingRuleToFunction :: Map CommoditySymbol AmountStyle
-> Query -> CommoditySymbol -> TMPostingRule -> Posting -> Posting
tmPostingRuleToFunction Map CommoditySymbol AmountStyle
styles Query
query CommoditySymbol
querytxt TMPostingRule
tmpr =
\Posting
p -> Map CommoditySymbol AmountStyle -> Posting -> Posting
postingApplyCommodityStyles Map CommoditySymbol 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 :: CommoditySymbol
pcomment = Posting -> CommoditySymbol
pcomment Posting
pr CommoditySymbol -> Tag -> CommoditySymbol
`commentAddTag` (CommoditySymbol
"generated-posting",CommoditySymbol
qry)
, ptags :: [Tag]
ptags = (CommoditySymbol
"generated-posting", CommoditySymbol
qry) Tag -> [Tag] -> [Tag]
forall a. a -> [a] -> [a]
:
(CommoditySymbol
"_generated-posting",CommoditySymbol
qry) Tag -> [Tag] -> [Tag]
forall a. a -> [a] -> [a]
:
Posting -> [Tag]
ptags Posting
pr
}
where
pr :: Posting
pr = TMPostingRule -> Posting
tmprPosting TMPostingRule
tmpr
qry :: CommoditySymbol
qry = CommoditySymbol
"= " CommoditySymbol -> CommoditySymbol -> CommoditySymbol
forall a. Semigroup a => a -> a -> a
<> CommoditySymbol
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 -> CommoditySymbol
acommodity Amount
pramount of
CommoditySymbol
"" -> MixedAmount
as
CommoditySymbol
c -> (Amount -> Amount) -> MixedAmount -> MixedAmount
mapMixedAmount (\Amount
a -> Amount
a{acommodity :: CommoditySymbol
acommodity = CommoditySymbol
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 :: CommoditySymbol
pcomment = CommoditySymbol
comment' }
where
dates :: CommoditySymbol
dates = [CommoditySymbol] -> CommoditySymbol
T.concat ([CommoditySymbol] -> CommoditySymbol)
-> [CommoditySymbol] -> CommoditySymbol
forall a b. (a -> b) -> a -> b
$ [Maybe CommoditySymbol] -> [CommoditySymbol]
forall a. [Maybe a] -> [a]
catMaybes [Day -> CommoditySymbol
showDate (Day -> CommoditySymbol) -> Maybe Day -> Maybe CommoditySymbol
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Posting -> Maybe Day
pdate Posting
p, (CommoditySymbol
"=" CommoditySymbol -> CommoditySymbol -> CommoditySymbol
forall a. Semigroup a => a -> a -> a
<>) (CommoditySymbol -> CommoditySymbol)
-> (Day -> CommoditySymbol) -> Day -> CommoditySymbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> CommoditySymbol
showDate (Day -> CommoditySymbol) -> Maybe Day -> Maybe CommoditySymbol
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Posting -> Maybe Day
pdate2 Posting
p]
comment' :: CommoditySymbol
comment'
| CommoditySymbol -> Bool
T.null CommoditySymbol
dates = Posting -> CommoditySymbol
pcomment Posting
p
| Bool
otherwise = (CommoditySymbol
-> CommoditySymbol -> CommoditySymbol -> CommoditySymbol
wrap CommoditySymbol
"[" CommoditySymbol
"]" CommoditySymbol
dates) CommoditySymbol -> CommoditySymbol -> CommoditySymbol
`commentJoin` Posting -> CommoditySymbol
pcomment Posting
p