{-# 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 (
   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

-- $setup
-- >>> :set -XOverloadedStrings
-- >>> import Hledger.Data.Posting
-- >>> import Hledger.Data.Transaction
-- >>> import Hledger.Data.Journal

-- | Apply all the given transaction modifiers, in turn, to each transaction.
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'
          -- PERF: compares txns to see if any modifier had an effect, inefficient ?
          | 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'

-- | Converts a 'TransactionModifier' to a 'Transaction'-transforming function,
-- which applies the modification(s) specified by the TransactionModifier.
-- Currently this means adding automated postings when certain other postings are present.
-- The postings of the transformed transaction will reference it in the usual
-- way (ie, 'txnTieKnot' is called).
--
-- >>> putStr $ showTransaction $ transactionModifierToFunction (TransactionModifier "" ["pong" `post` usd 2]) nulltransaction{tpostings=["ping" `post` usd 1]}
-- 0000-01-01
--     ping           $1.00
--     pong           $2.00  ; generated-posting: =
-- <BLANKLINE>
-- >>> putStr $ showTransaction $ transactionModifierToFunction (TransactionModifier "miss" ["pong" `post` usd 2]) nulltransaction{tpostings=["ping" `post` usd 1]}
-- 0000-01-01
--     ping           $1.00
-- <BLANKLINE>
-- >>> putStr $ showTransaction $ transactionModifierToFunction (TransactionModifier "ping" ["pong" `post` amount{aismultiplier=True, aquantity=3}]) nulltransaction{tpostings=["ping" `post` usd 2]}
-- 0000-01-01
--     ping           $2.00
--     pong           $6.00  ; generated-posting: = ping
-- <BLANKLINE>
--
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]]

-- | 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 "date:today" []) (read "2017-01-01")
-- Date (DateSpan 2017-01-01)
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)

-- | Converts a 'TransactionModifier''s posting rule to a 'Posting'-generating function,
-- which will be used to make a new posting based on the old one (an "automated posting").
-- The new posting's amount can optionally be the old posting's amount multiplied by a constant.
-- If the old posting had a total-priced amount, the new posting's multiplied amount will be unit-priced.
-- The new posting will have two tags added: a normal generated-posting: tag which also appears in the comment,
-- and a hidden _generated-posting: tag which does not.
-- The TransactionModifier's query text is also provided, and saved
-- as the tags' value.
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 ->
          -- Multiply the old posting's amount by the posting rule's multiplier.
          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
            -- Handle a matched amount with a total price carefully so as to keep the transaction balanced (#928).
            -- Approach 1: convert to a unit price and increase the display precision slightly
            -- Mixed as = dbg6 "multipliedamount" $ n `multiplyMixedAmount` mixedAmountTotalPriceToUnitPrice matchedamount
            -- Approach 2: multiply the total price (keeping it positive) as well as the quantity
            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
              -- TODO multipliers with commodity symbols are not yet a documented feature.
              -- For now: in addition to multiplying the quantity, it also replaces the
              -- matched amount's commodity, display style, and price with those of the posting rule.
              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
renderPostingCommentDates :: Posting -> Posting
renderPostingCommentDates 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