    {-# LANGUAGE NamedFieldPuns #-}
    {-# 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.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.
    -- Or if any of them fails to be parsed, return the first error. A reference
    -- date is provided to help interpret relative dates in transaction modifier
    -- queries.
    modifyTransactions :: Day -> [TransactionModifier] -> [Transaction] -> Either String [Transaction]
    modifyTransactions :: Day
    -> [TransactionModifier]
    -> [Transaction]
    -> Either String [Transaction]
    modifyTransactions d :: Day
    d tmods :: [TransactionModifier]
    tmods ts :: [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 (Day
    -> TransactionModifier
    -> Either String (Transaction -> Transaction)
    transactionModifierToFunction Day
    d) [TransactionModifier]
    tmods  -- convert modifiers to functions, or return a parse error
      let
        modifytxn :: Transaction -> Transaction
    modifytxn t :: 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  -- apply each function in turn
            t'' :: Transaction
    t'' = if Transaction
    t' Transaction -> Transaction -> Bool
    forall a. Eq a => a -> a -> Bool
    == Transaction
    t  -- and add some tags if it was changed
                  then Transaction
    t'
                  else 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'}
      [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

    -- | Converts a 'TransactionModifier' to a 'Transaction'-transforming function
    -- which applies the modification(s) specified by the TransactionModifier.
    -- Or, returns the error message there is a problem parsing the TransactionModifier's query.
    -- A reference date is provided to help interpret relative dates in the query.
    --
    -- The postings of the transformed transaction will reference it in the usual
    -- way (ie, 'txnTieKnot' is called).
    --
    -- Currently the only kind of modification possible is adding automated
    -- postings when certain other postings are present.
    --
    -- >>> t = nulltransaction{tpostings=["ping" `post` usd 1]}
    -- >>> test = either putStr (putStr.showTransaction) . fmap ($ t) . transactionModifierToFunction nulldate
    -- >>> test $ TransactionModifier "" ["pong" `post` usd 2]
    -- 0000-01-01
    --     ping           $1.00
    --     pong           $2.00  ; generated-posting: =
    -- <BLANKLINE>
    -- >>> test $ TransactionModifier "miss" ["pong" `post` usd 2]
    -- 0000-01-01
    --     ping           $1.00
    -- <BLANKLINE>
    -- >>> test $ TransactionModifier "ping" ["pong" `post` amount{aismultiplier=True, aquantity=3}]
    -- 0000-01-01
    --     ping           $1.00
    --     pong           $3.00  ; generated-posting: = ping
    -- <BLANKLINE>
    --
    transactionModifierToFunction :: Day -> TransactionModifier -> Either String (Transaction -> Transaction)
    transactionModifierToFunction :: Day
    -> TransactionModifier
    -> Either String (Transaction -> Transaction)
    transactionModifierToFunction refdate :: Day
    refdate TransactionModifier{Text
    tmquerytxt :: TransactionModifier -> Text
    tmquerytxt :: Text
    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 -> Text -> Either String (Query, [QueryOpt])
    parseQuery Day
    refdate Text
    tmquerytxt
      let
        fs :: [TMPostingRule -> TMPostingRule]
    fs = (TMPostingRule -> TMPostingRule -> TMPostingRule)
    -> [TMPostingRule] -> [TMPostingRule -> TMPostingRule]
    forall a b. (a -> b) -> [a] -> [b]
    map (Text -> TMPostingRule -> TMPostingRule -> TMPostingRule
    tmPostingRuleToFunction Text
    tmquerytxt) [TMPostingRule]
    tmpostingrules
        generatePostings :: [TMPostingRule] -> [TMPostingRule]
    generatePostings ps :: [TMPostingRule]
    ps = [TMPostingRule
    p' | TMPostingRule
    p <- [TMPostingRule]
    ps
                                  , TMPostingRule
    p' <- if Query
    q Query -> TMPostingRule -> Bool
    `matchesPosting` TMPostingRule
    p then TMPostingRule
    pTMPostingRule -> [TMPostingRule] -> [TMPostingRule]
    forall a. a -> [a] -> [a]
    :[TMPostingRule -> TMPostingRule
    f TMPostingRule
    p | TMPostingRule -> TMPostingRule
    f <- [TMPostingRule -> TMPostingRule]
    fs] else [TMPostingRule
    p]]
      (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 -> [TMPostingRule]
    tpostings -> [TMPostingRule]
    ps) -> Transaction -> Transaction
    txnTieKnot Transaction
    t{tpostings :: [TMPostingRule]
    tpostings=[TMPostingRule] -> [TMPostingRule]
    generatePostings [TMPostingRule]
    ps}

    -- | 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 -> TMPostingRule -> TMPostingRule -> TMPostingRule
    tmPostingRuleToFunction querytxt :: Text
    querytxt pr :: TMPostingRule
    pr =
      \p :: TMPostingRule
    p -> TMPostingRule -> TMPostingRule
    renderPostingCommentDates (TMPostingRule -> TMPostingRule) -> TMPostingRule -> TMPostingRule
    forall a b. (a -> b) -> a -> b
    $ TMPostingRule
    pr
          { pdate :: Maybe Day
    pdate    = TMPostingRule -> Maybe Day
    pdate  TMPostingRule
    pr Maybe Day -> Maybe Day -> Maybe Day
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> TMPostingRule -> Maybe Day
    pdate  TMPostingRule
    p
          , pdate2 :: Maybe Day
    pdate2   = TMPostingRule -> Maybe Day
    pdate2 TMPostingRule
    pr Maybe Day -> Maybe Day -> Maybe Day
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> TMPostingRule -> Maybe Day
    pdate2 TMPostingRule
    p
          , pamount :: MixedAmount
    pamount  = TMPostingRule -> MixedAmount
    amount' TMPostingRule
    p
          , pcomment :: Text
    pcomment = TMPostingRule -> Text
    pcomment TMPostingRule
    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]
    :
                       TMPostingRule -> [Tag]
    ptags TMPostingRule
    pr
          }
      where
        qry :: Text
    qry = "= " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    querytxt
        amount' :: TMPostingRule -> MixedAmount
    amount' = case TMPostingRule -> Maybe Quantity
    postingRuleMultiplier TMPostingRule
    pr of
            Nothing -> MixedAmount -> TMPostingRule -> MixedAmount
    forall a b. a -> b -> a
    const (MixedAmount -> TMPostingRule -> MixedAmount)
    -> MixedAmount -> TMPostingRule -> MixedAmount
    forall a b. (a -> b) -> a -> b
    $ TMPostingRule -> MixedAmount
    pamount TMPostingRule
    pr
            Just n :: Quantity
    n  -> \p :: TMPostingRule
    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
    $ TMPostingRule -> MixedAmount
    pamount TMPostingRule
    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
    $ TMPostingRule -> MixedAmount
    pamount TMPostingRule
    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 :: TMPostingRule -> Maybe Quantity
    postingRuleMultiplier p :: TMPostingRule
    p =
        case MixedAmount -> [Amount]
    amounts (MixedAmount -> [Amount]) -> MixedAmount -> [Amount]
    forall a b. (a -> b) -> a -> b
    $ TMPostingRule -> MixedAmount
    pamount TMPostingRule
    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 :: TMPostingRule -> TMPostingRule
    renderPostingCommentDates p :: TMPostingRule
    p = TMPostingRule
    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
    <$> TMPostingRule -> Maybe Day
    pdate TMPostingRule
    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
    <$> TMPostingRule -> Maybe Day
    pdate2 TMPostingRule
    p]
            comment' :: Text
    comment'
                | Text -> Bool
    T.null Text
    dates = TMPostingRule -> Text
    pcomment TMPostingRule
    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` TMPostingRule -> Text
    pcomment TMPostingRule
    p