{-|

A 'Transaction' represents a movement of some commodity(ies) between two
or more accounts. It consists of multiple account 'Posting's which balance
to zero, a date, and optional extras like description, cleared status, and
tags.

-}

{-# LANGUAGE MultiWayIf        #-}
{-# LANGUAGE NamedFieldPuns    #-}
{-# LANGUAGE OverloadedStrings #-}

module Hledger.Data.Transaction
( -- * Transaction
  nulltransaction
, transaction
, txnTieKnot
, txnUntieKnot
  -- * operations
, hasRealPostings
, realPostings
, assignmentPostings
, virtualPostings
, balancedVirtualPostings
, transactionsPostings
, transactionTransformPostings
, transactionApplyValuation
, transactionToCost
, transactionAddInferredEquityPostings
, transactionInferCostsFromEquity
, transactionApplyAliases
, transactionMapPostings
, transactionMapPostingAmounts
, transactionAmounts
, partitionAndCheckConversionPostings
  -- nonzerobalanceerror
  -- * date operations
, transactionDate2
, transactionDateOrDate2
  -- * transaction description parts
, transactionPayee
, transactionNote
  -- payeeAndNoteFromDescription
  -- * rendering
, showTransaction
, showTransactionOneLineAmounts
, showTransactionLineFirstPart
, showTransactionBeancount
, transactionFile
  -- * transaction errors
, annotateErrorWithTransaction
  -- * tests
, tests_Transaction
) where

import Control.Monad.Trans.State (StateT(..), evalStateT)
import Data.Bifunctor (first, second)
import Data.Foldable (foldlM)
import Data.Maybe (fromMaybe, isJust, mapMaybe)
import Data.Semigroup (Endo(..))
import Data.Text (Text)
import qualified Data.Map as M
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Builder as TB
import Data.Time.Calendar (Day, fromGregorian)

import Hledger.Utils
import Hledger.Data.Types
import Hledger.Data.Dates
import Hledger.Data.Posting
import Hledger.Data.Amount
import Hledger.Data.Valuation
import Data.Decimal (normalizeDecimal, decimalPlaces)
import Data.Functor ((<&>))


instance HasAmounts Transaction where
  styleAmounts :: Map Text AmountStyle -> Transaction -> Transaction
styleAmounts Map Text AmountStyle
styles Transaction
t = Transaction
t{tpostings :: [Posting]
tpostings=forall a. HasAmounts a => Map Text AmountStyle -> a -> a
styleAmounts Map Text AmountStyle
styles forall a b. (a -> b) -> a -> b
$ Transaction -> [Posting]
tpostings Transaction
t}

nulltransaction :: Transaction
nulltransaction :: Transaction
nulltransaction = Transaction {
                    tindex :: Integer
tindex=Integer
0,
                    tsourcepos :: (SourcePos, SourcePos)
tsourcepos=(SourcePos, SourcePos)
nullsourcepos,
                    tdate :: Day
tdate=Day
nulldate,
                    tdate2 :: Maybe Day
tdate2=forall a. Maybe a
Nothing,
                    tstatus :: Status
tstatus=Status
Unmarked,
                    tcode :: Text
tcode=Text
"",
                    tdescription :: Text
tdescription=Text
"",
                    tcomment :: Text
tcomment=Text
"",
                    ttags :: [Tag]
ttags=[],
                    tpostings :: [Posting]
tpostings=[],
                    tprecedingcomment :: Text
tprecedingcomment=Text
""
                  }

-- | Make a simple transaction with the given date and postings.
transaction :: Day -> [Posting] -> Transaction
transaction :: Day -> [Posting] -> Transaction
transaction Day
day [Posting]
ps = Transaction -> Transaction
txnTieKnot forall a b. (a -> b) -> a -> b
$ Transaction
nulltransaction{tdate :: Day
tdate=Day
day, tpostings :: [Posting]
tpostings=[Posting]
ps}

transactionPayee :: Transaction -> Text
transactionPayee :: Transaction -> Text
transactionPayee = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Tag
payeeAndNoteFromDescription forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> Text
tdescription

transactionNote :: Transaction -> Text
transactionNote :: Transaction -> Text
transactionNote = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Tag
payeeAndNoteFromDescription forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> Text
tdescription

-- | Parse a transaction's description into payee and note (aka narration) fields,
-- assuming a convention of separating these with | (like Beancount).
-- Ie, everything up to the first | is the payee, everything after it is the note.
-- When there's no |, payee == note == description.
payeeAndNoteFromDescription :: Text -> (Text,Text)
payeeAndNoteFromDescription :: Text -> Tag
payeeAndNoteFromDescription Text
t
  | Text -> Bool
T.null Text
n = (Text
t, Text
t)
  | Bool
otherwise = (Text -> Text
T.strip Text
p, Text -> Text
T.strip forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.drop Int
1 Text
n)
  where
    (Text
p, Text
n) = (Char -> Bool) -> Text -> Tag
T.span (forall a. Eq a => a -> a -> Bool
/= Char
'|') Text
t

-- | Like payeeAndNoteFromDescription, but if there's no | then payee is empty.
payeeAndNoteFromDescription' :: Text -> (Text,Text)
payeeAndNoteFromDescription' :: Text -> Tag
payeeAndNoteFromDescription' Text
t =
  if forall a. Maybe a -> Bool
isJust forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Maybe Char
T.find (forall a. Eq a => a -> a -> Bool
==Char
'|') Text
t then Text -> Tag
payeeAndNoteFromDescription Text
t else (Text
"",Text
t)


{-|
Render a journal transaction as text similar to the style of Ledger's print command.

Adapted from Ledger 2.x and 3.x standard format:

@
yyyy-mm-dd[ *][ CODE] description.........          [  ; comment...............]
    account name 1.....................  ...$amount1[  ; comment...............]
    account name 2.....................  ..$-amount1[  ; comment...............]

pcodewidth    = no limit -- 10          -- mimicking ledger layout.
pdescwidth    = no limit -- 20          -- I don't remember what these mean,
pacctwidth    = 35 minimum, no maximum  -- they were important at the time.
pamtwidth     = 11
pcommentwidth = no limit -- 22
@

The output will be parseable journal syntax.
To facilitate this, postings with explicit multi-commodity amounts
are displayed as multiple similar postings, one per commodity.
(Normally does not happen with this function).
-}
showTransaction :: Transaction -> Text
showTransaction :: Transaction -> Text
showTransaction = Text -> Text
TL.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TB.toLazyText forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Transaction -> Builder
showTransactionHelper Bool
False

-- | Like showTransaction, but explicit multi-commodity amounts
-- are shown on one line, comma-separated. In this case the output will
-- not be parseable journal syntax.
showTransactionOneLineAmounts :: Transaction -> Text
showTransactionOneLineAmounts :: Transaction -> Text
showTransactionOneLineAmounts = Text -> Text
TL.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TB.toLazyText forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Transaction -> Builder
showTransactionHelper Bool
True

-- | Helper for showTransaction*.
showTransactionHelper :: Bool -> Transaction -> TB.Builder
showTransactionHelper :: Bool -> Transaction -> Builder
showTransactionHelper Bool
onelineamounts Transaction
t =
      Text -> Builder
TB.fromText Text
descriptionline forall a. Semigroup a => a -> a -> a
<> Builder
newline
    forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((forall a. Semigroup a => a -> a -> a
<> Builder
newline) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Builder
TB.fromText) [Text]
newlinecomments
    forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((forall a. Semigroup a => a -> a -> a
<> Builder
newline) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Builder
TB.fromText) (Bool -> [Posting] -> [Text]
postingsAsLines Bool
onelineamounts forall a b. (a -> b) -> a -> b
$ Transaction -> [Posting]
tpostings Transaction
t)
    forall a. Semigroup a => a -> a -> a
<> Builder
newline
  where
    descriptionline :: Text
descriptionline = Text -> Text
T.stripEnd forall a b. (a -> b) -> a -> b
$ Transaction -> Text
showTransactionLineFirstPart Transaction
t forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
T.concat [Text
desc, Text
samelinecomment]
    desc :: Text
desc = if Text -> Bool
T.null Text
d then Text
"" else Text
" " forall a. Semigroup a => a -> a -> a
<> Text
d where d :: Text
d = Transaction -> Text
tdescription Transaction
t
    (Text
samelinecomment, [Text]
newlinecomments) =
      case Text -> [Text]
renderCommentLines (Transaction -> Text
tcomment Transaction
t) of []   -> (Text
"",[])
                                              Text
c:[Text]
cs -> (Text
c,[Text]
cs)
    newline :: Builder
newline = Char -> Builder
TB.singleton Char
'\n'

-- Useful when rendering error messages.
showTransactionLineFirstPart :: Transaction -> Text
showTransactionLineFirstPart Transaction
t = [Text] -> Text
T.concat [Text
date, Text
status, Text
code]
  where
    date :: Text
date = Day -> Text
showDate (Transaction -> Day
tdate Transaction
t) forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" ((Text
"="forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> Text
showDate) (Transaction -> Maybe Day
tdate2 Transaction
t)
    status :: Text
status | Transaction -> Status
tstatus Transaction
t forall a. Eq a => a -> a -> Bool
== Status
Cleared = Text
" *"
           | Transaction -> Status
tstatus Transaction
t forall a. Eq a => a -> a -> Bool
== Status
Pending = Text
" !"
           | Bool
otherwise            = Text
""
    code :: Text
code = if Text -> Bool
T.null (Transaction -> Text
tcode Transaction
t) then Text
"" else Text -> Text -> Text -> Text
wrap Text
" (" Text
")" forall a b. (a -> b) -> a -> b
$ Transaction -> Text
tcode Transaction
t

-- | Like showTransaction, but generates Beancount journal format.
showTransactionBeancount :: Transaction -> Text
showTransactionBeancount :: Transaction -> Text
showTransactionBeancount Transaction
t =
  -- https://beancount.github.io/docs/beancount_language_syntax.html
  -- similar to showTransactionHelper, but I haven't bothered with Builder
     Text
firstline forall a. Semigroup a => a -> a -> a
<> Text
nl
  forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((forall a. Semigroup a => a -> a -> a
<> Text
nl)) [Text]
newlinecomments
  forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((forall a. Semigroup a => a -> a -> a
<> Text
nl)) ([Posting] -> [Text]
postingsAsLinesBeancount forall a b. (a -> b) -> a -> b
$ Transaction -> [Posting]
tpostings Transaction
t)
  forall a. Semigroup a => a -> a -> a
<> Text
nl
  where
    nl :: Text
nl = Text
"\n"
    firstline :: Text
firstline = [Text] -> Text
T.concat [Text
date, Text
status, Text
payee, Text
note, Text
tags, Text
samelinecomment]
    date :: Text
date = Day -> Text
showDate forall a b. (a -> b) -> a -> b
$ Transaction -> Day
tdate Transaction
t
    status :: Text
status = if Transaction -> Status
tstatus Transaction
t forall a. Eq a => a -> a -> Bool
== Status
Pending then Text
" !" else Text
" *"
    (Text
payee,Text
note) =
      case Text -> Tag
payeeAndNoteFromDescription' forall a b. (a -> b) -> a -> b
$ Transaction -> Text
tdescription Transaction
t of
        (Text
"",Text
"") -> (Text
"",      Text
""      )
        (Text
"",Text
n ) -> (Text
""     , Text -> Text
wrapq Text
n )
        (Text
p ,Text
"") -> (Text -> Text
wrapq Text
p, Text -> Text
wrapq Text
"")
        (Text
p ,Text
n ) -> (Text -> Text
wrapq Text
p, Text -> Text
wrapq Text
n )
      where
        wrapq :: Text -> Text
wrapq = Text -> Text -> Text -> Text
wrap Text
" \"" Text
"\"" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
escapeDoubleQuotes forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
escapeBackslash
    tags :: Text
tags = [Text] -> Text
T.concat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map ((Text
" #"forall a. Semigroup a => a -> a -> a
<>)forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a, b) -> a
fst) forall a b. (a -> b) -> a -> b
$ Transaction -> [Tag]
ttags Transaction
t
    (Text
samelinecomment, [Text]
newlinecomments) =
      case Text -> [Text]
renderCommentLines (Transaction -> Text
tcomment Transaction
t) of []   -> (Text
"",[])
                                              Text
c:[Text]
cs -> (Text
c,[Text]
cs)

hasRealPostings :: Transaction -> Bool
hasRealPostings :: Transaction -> Bool
hasRealPostings = Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> [Posting]
realPostings

realPostings :: Transaction -> [Posting]
realPostings :: Transaction -> [Posting]
realPostings = forall a. (a -> Bool) -> [a] -> [a]
filter Posting -> Bool
isReal forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> [Posting]
tpostings

assignmentPostings :: Transaction -> [Posting]
assignmentPostings :: Transaction -> [Posting]
assignmentPostings = forall a. (a -> Bool) -> [a] -> [a]
filter Posting -> Bool
hasBalanceAssignment forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> [Posting]
tpostings

virtualPostings :: Transaction -> [Posting]
virtualPostings :: Transaction -> [Posting]
virtualPostings = forall a. (a -> Bool) -> [a] -> [a]
filter Posting -> Bool
isVirtual forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> [Posting]
tpostings

balancedVirtualPostings :: Transaction -> [Posting]
balancedVirtualPostings :: Transaction -> [Posting]
balancedVirtualPostings = forall a. (a -> Bool) -> [a] -> [a]
filter Posting -> Bool
isBalancedVirtual forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> [Posting]
tpostings

transactionsPostings :: [Transaction] -> [Posting]
transactionsPostings :: [Transaction] -> [Posting]
transactionsPostings = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Transaction -> [Posting]
tpostings

-- Get a transaction's secondary date, or the primary date if there is none.
transactionDate2 :: Transaction -> Day
transactionDate2 :: Transaction -> Day
transactionDate2 Transaction
t = forall a. a -> Maybe a -> a
fromMaybe (Transaction -> Day
tdate Transaction
t) forall a b. (a -> b) -> a -> b
$ Transaction -> Maybe Day
tdate2 Transaction
t

-- Get a transaction's primary or secondary date, as specified.
transactionDateOrDate2 :: WhichDate -> Transaction -> Day
transactionDateOrDate2 :: WhichDate -> Transaction -> Day
transactionDateOrDate2 WhichDate
PrimaryDate   = Transaction -> Day
tdate
transactionDateOrDate2 WhichDate
SecondaryDate = Transaction -> Day
transactionDate2

-- | Ensure a transaction's postings refer back to it, so that eg
-- relatedPostings works right.
txnTieKnot :: Transaction -> Transaction
txnTieKnot :: Transaction -> Transaction
txnTieKnot t :: Transaction
t@Transaction{tpostings :: Transaction -> [Posting]
tpostings=[Posting]
ps} = Transaction
t' where
    t' :: Transaction
t' = Transaction
t{tpostings :: [Posting]
tpostings=forall a b. (a -> b) -> [a] -> [b]
map (Transaction -> Posting -> Posting
postingSetTransaction Transaction
t') [Posting]
ps}

-- | Ensure a transaction's postings do not refer back to it, so that eg
-- recursiveSize and GHCI's :sprint work right.
txnUntieKnot :: Transaction -> Transaction
txnUntieKnot :: Transaction -> Transaction
txnUntieKnot t :: Transaction
t@Transaction{tpostings :: Transaction -> [Posting]
tpostings=[Posting]
ps} = Transaction
t{tpostings :: [Posting]
tpostings=forall a b. (a -> b) -> [a] -> [b]
map (\Posting
p -> Posting
p{ptransaction :: Maybe Transaction
ptransaction=forall a. Maybe a
Nothing}) [Posting]
ps}

-- | Set a posting's parent transaction.
postingSetTransaction :: Transaction -> Posting -> Posting
postingSetTransaction :: Transaction -> Posting -> Posting
postingSetTransaction Transaction
t Posting
p = Posting
p{ptransaction :: Maybe Transaction
ptransaction=forall a. a -> Maybe a
Just Transaction
t}

-- | Apply a transform function to this transaction's amounts.
transactionTransformPostings :: (Posting -> Posting) -> Transaction -> Transaction
transactionTransformPostings :: (Posting -> Posting) -> Transaction -> Transaction
transactionTransformPostings Posting -> Posting
f t :: Transaction
t@Transaction{tpostings :: Transaction -> [Posting]
tpostings=[Posting]
ps} = Transaction
t{tpostings :: [Posting]
tpostings=forall a b. (a -> b) -> [a] -> [b]
map Posting -> Posting
f [Posting]
ps}

-- | Apply a specified valuation to this transaction's amounts, using
-- the provided price oracle, commodity styles, and reference dates.
-- See amountApplyValuation.
transactionApplyValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> ValuationType -> Transaction -> Transaction
transactionApplyValuation :: PriceOracle
-> Map Text AmountStyle
-> Day
-> Day
-> ValuationType
-> Transaction
-> Transaction
transactionApplyValuation PriceOracle
priceoracle Map Text AmountStyle
styles Day
periodlast Day
today ValuationType
v =
  (Posting -> Posting) -> Transaction -> Transaction
transactionTransformPostings (PriceOracle
-> Map Text AmountStyle
-> Day
-> Day
-> ValuationType
-> Posting
-> Posting
postingApplyValuation PriceOracle
priceoracle Map Text AmountStyle
styles Day
periodlast Day
today ValuationType
v)

-- | Maybe convert this 'Transaction's amounts to cost.
transactionToCost :: ConversionOp -> Transaction -> Transaction
transactionToCost :: ConversionOp -> Transaction -> Transaction
transactionToCost ConversionOp
cost Transaction
t = Transaction
t{tpostings :: [Posting]
tpostings = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (ConversionOp -> Posting -> Maybe Posting
postingToCost ConversionOp
cost) forall a b. (a -> b) -> a -> b
$ Transaction -> [Posting]
tpostings Transaction
t}

-- | Add inferred equity postings to a 'Transaction' using transaction prices.
transactionAddInferredEquityPostings :: Bool -> AccountName -> Transaction -> Transaction
transactionAddInferredEquityPostings :: Bool -> Text -> Transaction -> Transaction
transactionAddInferredEquityPostings Bool
verbosetags Text
equityAcct Transaction
t =
    Transaction
t{tpostings :: [Posting]
tpostings=forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Bool -> Text -> Posting -> [Posting]
postingAddInferredEquityPostings Bool
verbosetags Text
equityAcct) forall a b. (a -> b) -> a -> b
$ Transaction -> [Posting]
tpostings Transaction
t}

type IdxPosting = (Int, Posting)

-- XXX Warning: The following code - for analysing equity conversion postings,
-- inferring missing costs and ignoring redundant costs -
-- is twisty and hard to follow.

label :: RegexError -> RegexError -> RegexError
label RegexError
s = ((RegexError
s forall a. Semigroup a => a -> a -> a
<> RegexError
": ")forall a. [a] -> [a] -> [a]
++)

-- | Add costs inferred from equity postings in this transaction.
-- For every adjacent pair of conversion postings, it will first search the postings
-- with costs to see if any match. If so, it will tag these as matched.
-- If no postings with costs match, it will then search the postings without costs,
-- and will match the first such posting which matches one of the conversion amounts.
-- If it finds a match, it will add a cost and then tag it.
-- If the first argument is true, do a dry run instead: identify and tag
-- the costful and conversion postings, but don't add costs.
transactionInferCostsFromEquity :: Bool -> M.Map AccountName AccountType -> Transaction -> Either String Transaction
transactionInferCostsFromEquity :: Bool
-> Map Text AccountType
-> Transaction
-> Either RegexError Transaction
transactionInferCostsFromEquity Bool
dryrun Map Text AccountType
acctTypes Transaction
t = forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Transaction -> RegexError -> RegexError
annotateErrorWithTransaction Transaction
t forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> RegexError
T.unpack) forall a b. (a -> b) -> a -> b
$ do
  -- number the postings
  let npostings :: [IdxPosting]
npostings = forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] forall a b. (a -> b) -> a -> b
$ Transaction -> [Posting]
tpostings Transaction
t

  -- Identify all pairs of conversion postings and all other postings (with and without costs) in the transaction.
  ([(IdxPosting, IdxPosting)]
conversionPairs, ([IdxPosting], [IdxPosting])
otherps) <- Bool
-> Map Text AccountType
-> [IdxPosting]
-> Either
     Text ([(IdxPosting, IdxPosting)], ([IdxPosting], [IdxPosting]))
partitionAndCheckConversionPostings Bool
False Map Text AccountType
acctTypes [IdxPosting]
npostings

  -- Generate a pure function that can be applied to each of this transaction's postings,
  -- possibly modifying it, to produce the following end result:
  -- 1. each pair of conversion postings, and the corresponding postings which balance them, are tagged for easy identification
  -- 2. each pair of balancing postings which did't have an explicit cost, have had a cost calculated and added to one of them
  -- 3. if any ambiguous situation was detected, an informative error is raised
  IdxPosting -> IdxPosting
processposting <- ((IdxPosting, IdxPosting)
 -> StateT
      ([IdxPosting], [IdxPosting])
      (Either Text)
      (IdxPosting -> IdxPosting))
-> [(IdxPosting, IdxPosting)]
-> ([IdxPosting], [IdxPosting])
-> Either Text (IdxPosting -> IdxPosting)
transformIndexedPostingsF (Bool
-> (IdxPosting, IdxPosting)
-> StateT
     ([IdxPosting], [IdxPosting])
     (Either Text)
     (IdxPosting -> IdxPosting)
addCostsToPostings Bool
dryrun) [(IdxPosting, IdxPosting)]
conversionPairs ([IdxPosting], [IdxPosting])
otherps

  -- And if there was no error, use it to modify the transaction's postings.
  forall (m :: * -> *) a. Monad m => a -> m a
return Transaction
t{tpostings :: [Posting]
tpostings = forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdxPosting -> IdxPosting
processposting) [IdxPosting]
npostings}

  where

    -- Generate the tricksy processposting function,
    -- which when applied to each posting in turn, rather magically has the effect of
    -- applying addCostsToPostings to each pair of conversion postings in the transaction,
    -- matching them with the other postings, tagging them and perhaps adding cost information to the other postings.
    -- General type:
    -- transformIndexedPostingsF :: (Monad m, Foldable t, Traversable t) =>
    --   (a -> StateT s m (a1 -> a1)) ->
    --   t a ->
    --   s ->
    --   m (a1 -> a1)
    -- Concrete type:
    transformIndexedPostingsF ::
      ((IdxPosting, IdxPosting) -> StateT ([IdxPosting],[IdxPosting]) (Either Text) (IdxPosting -> IdxPosting)) ->  -- state update function (addCostsToPostings with the bool applied)
      [(IdxPosting, IdxPosting)] ->   -- initial state: the pairs of adjacent conversion postings in the transaction
      ([IdxPosting],[IdxPosting]) ->  -- initial state: the other postings in the transaction, separated into costful and costless
      (Either Text (IdxPosting -> IdxPosting))  -- returns an error message or a posting transform function
    transformIndexedPostingsF :: ((IdxPosting, IdxPosting)
 -> StateT
      ([IdxPosting], [IdxPosting])
      (Either Text)
      (IdxPosting -> IdxPosting))
-> [(IdxPosting, IdxPosting)]
-> ([IdxPosting], [IdxPosting])
-> Either Text (IdxPosting -> IdxPosting)
transformIndexedPostingsF (IdxPosting, IdxPosting)
-> StateT
     ([IdxPosting], [IdxPosting])
     (Either Text)
     (IdxPosting -> IdxPosting)
updatefn = forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Endo a -> a -> a
appEndo forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall a. (a -> a) -> Endo a
Endo) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((IdxPosting, IdxPosting)
-> StateT
     ([IdxPosting], [IdxPosting])
     (Either Text)
     (IdxPosting -> IdxPosting)
updatefn)

    -- A tricksy state update helper for processposting/transformIndexedPostingsF.
    -- Approximately: given a pair of conversion postings to match,
    -- and lists of the remaining unmatched costful and costless other postings,
    -- 1. find (and consume) two other postings which match the two conversion postings
    -- 2. add identifying tags to the four postings
    -- 3. add an explicit cost, if missing, to one of the matched other postings
    -- 4. or if there is a problem, raise an informative error or do nothing as appropriate.
    -- Or, if the first argument is true:
    -- do a dry run instead: find and consume, add tags, but don't add costs
    -- (and if there are no costful postings at all, do nothing).
    addCostsToPostings :: Bool -> (IdxPosting, IdxPosting) -> StateT ([IdxPosting], [IdxPosting]) (Either Text) (IdxPosting -> IdxPosting)
    addCostsToPostings :: Bool
-> (IdxPosting, IdxPosting)
-> StateT
     ([IdxPosting], [IdxPosting])
     (Either Text)
     (IdxPosting -> IdxPosting)
addCostsToPostings Bool
dryrun' ((Int
n1, Posting
cp1), (Int
n2, Posting
cp2)) = forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT forall a b. (a -> b) -> a -> b
$ \([IdxPosting]
costps, [IdxPosting]
otherps) -> do
      -- Get the two conversion posting amounts, if possible
      Amount
ca1 <- Posting -> Either Text Amount
conversionPostingAmountNoCost Posting
cp1
      Amount
ca2 <- Posting -> Either Text Amount
conversionPostingAmountNoCost Posting
cp2
      let 
        -- All costful postings which match the conversion posting pair
        matchingCostPs :: [IdxPosting]
matchingCostPs =
          forall a. Show a => (a -> RegexError) -> a -> a
dbg7With (RegexError -> RegexError -> RegexError
label RegexError
"matched costful postings"forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a. Show a => a -> RegexError
showforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall (t :: * -> *) a. Foldable t => t a -> Int
length) forall a b. (a -> b) -> a -> b
$ 
          forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a b. (a -> b) -> a -> b
$ Amount -> Amount -> Posting -> Maybe Posting
costfulPostingIfMatchesBothAmounts Amount
ca1 Amount
ca2) [IdxPosting]
costps

        -- All other single-commodity postings whose amount matches at least one of the conversion postings,
        -- with an explicit cost added. Or in dry run mode, all other single-commodity postings.
        matchingOtherPs :: [(Int, (Posting, Amount))]
matchingOtherPs =
          forall a. Show a => (a -> RegexError) -> a -> a
dbg7With (RegexError -> RegexError -> RegexError
label RegexError
"matched costless postings"forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a. Show a => a -> RegexError
showforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall (t :: * -> *) a. Foldable t => t a -> Int
length) forall a b. (a -> b) -> a -> b
$
          if Bool
dryrun'
          then [(Int
n,(Posting
p, Amount
a)) | (Int
n,Posting
p) <- [IdxPosting]
otherps, let Just Amount
a = Posting -> Maybe Amount
postingSingleAmount Posting
p]
          else forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a b. (a -> b) -> a -> b
$ Amount -> Amount -> Posting -> Maybe (Posting, Amount)
addCostIfMatchesOneAmount Amount
ca1 Amount
ca2) [IdxPosting]
otherps

        -- A function that adds a cost and/or tag to a numbered posting if appropriate.
        postingAddCostAndOrTag :: Int -> Posting -> IdxPosting -> IdxPosting
postingAddCostAndOrTag Int
np Posting
costp (Int
n,Posting
p) =
          (Int
n, if | Int
n forall a. Eq a => a -> a -> Bool
== Int
np            -> Posting
costp Posting -> [Tag] -> Posting
`postingAddTags` [(Text
"_price-matched",Text
"")]
                 | Int
n forall a. Eq a => a -> a -> Bool
== Int
n1 Bool -> Bool -> Bool
|| Int
n forall a. Eq a => a -> a -> Bool
== Int
n2 -> Posting
p     Posting -> [Tag] -> Posting
`postingAddTags` [(Text
"_conversion-matched",Text
"")]
                 | Bool
otherwise          -> Posting
p)

      -- Annotate any errors with the conversion posting pair
      forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ([Posting] -> Text -> Text
annotateWithPostings [Posting
cp1, Posting
cp2]) forall a b. (a -> b) -> a -> b
$
        if
          -- If a single costful posting matches the conversion postings,
          -- delete it from the list of costful postings in the state, delete the
          -- first matching costless posting from the list of costless postings
          -- in the state, and return the transformation function with the new state.
          | [(Int
np, Posting
costp)] <- [IdxPosting]
matchingCostPs
          , Just [IdxPosting]
newcostps <- forall {b} {b}. Eq b => b -> [(b, b)] -> Maybe [(b, b)]
deleteIdx Int
np [IdxPosting]
costps
              -> forall a b. b -> Either a b
Right (Int -> Posting -> IdxPosting -> IdxPosting
postingAddCostAndOrTag Int
np Posting
costp, (if Bool
dryrun' then [IdxPosting]
costps else [IdxPosting]
newcostps, [IdxPosting]
otherps))

          -- If no costful postings match the conversion postings, but some
          -- of the costless postings match, check that the first such posting has a
          -- different amount from all the others, and if so add a cost to it,
          -- then delete it from the list of costless postings in the state,
          -- and return the transformation function with the new state.
          | [] <- [IdxPosting]
matchingCostPs
          , (Int
np, (Posting
costp, Amount
amt)):[(Int, (Posting, Amount))]
nps <- [(Int, (Posting, Amount))]
matchingOtherPs
          , Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Amount -> Amount -> Bool
amountsMatch Amount
amt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(Int, (Posting, Amount))]
nps
          , Just [IdxPosting]
newotherps <- forall {b} {b}. Eq b => b -> [(b, b)] -> Maybe [(b, b)]
deleteIdx Int
np [IdxPosting]
otherps
              -> forall a b. b -> Either a b
Right (Int -> Posting -> IdxPosting -> IdxPosting
postingAddCostAndOrTag Int
np Posting
costp, ([IdxPosting]
costps, if Bool
dryrun' then [IdxPosting]
otherps else [IdxPosting]
newotherps))

          -- Otherwise, do nothing, leaving the transaction unchanged.
          -- We don't want to be over-zealous reporting problems here
          -- since this is always called at least in dry run mode by
          -- journalFinalise > journalMarkRedundantCosts. (#2045)
          | Bool
otherwise -> forall a b. b -> Either a b
Right (forall a. a -> a
id, ([IdxPosting]
costps, [IdxPosting]
otherps))

    -- If a posting with cost matches both the conversion amounts, return it along
    -- with the matching amount which must be present in another non-conversion posting.
    costfulPostingIfMatchesBothAmounts :: Amount -> Amount -> Posting -> Maybe Posting
    costfulPostingIfMatchesBothAmounts :: Amount -> Amount -> Posting -> Maybe Posting
costfulPostingIfMatchesBothAmounts Amount
a1 Amount
a2 Posting
costfulp = do
        a :: Amount
a@Amount{aprice :: Amount -> Maybe AmountPrice
aprice=Just AmountPrice
_} <- Posting -> Maybe Amount
postingSingleAmount Posting
costfulp
        if
           | forall {a} {a}. (Show a, Show a) => a -> Amount -> Amount -> a -> a
dbgamtmatch Integer
1 Amount
a1 Amount
a (Amount -> Amount -> Bool
amountsMatch (-Amount
a1) Amount
a)  Bool -> Bool -> Bool
&&  forall {a} {a}. (Show a, Show a) => a -> Amount -> Amount -> a -> a
dbgcostmatch Integer
2 Amount
a2 Amount
a (Amount -> Amount -> Bool
amountsMatch Amount
a2 (Amount -> Amount
amountCost Amount
a)) -> forall a. a -> Maybe a
Just Posting
costfulp
           | forall {a} {a}. (Show a, Show a) => a -> Amount -> Amount -> a -> a
dbgamtmatch Integer
2 Amount
a2 Amount
a (Amount -> Amount -> Bool
amountsMatch (-Amount
a2) Amount
a)  Bool -> Bool -> Bool
&&  forall {a} {a}. (Show a, Show a) => a -> Amount -> Amount -> a -> a
dbgcostmatch Integer
1 Amount
a1 Amount
a (Amount -> Amount -> Bool
amountsMatch Amount
a1 (Amount -> Amount
amountCost Amount
a)) -> forall a. a -> Maybe a
Just Posting
costfulp
           | Bool
otherwise -> forall a. Maybe a
Nothing
           where
            dbgamtmatch :: a -> Amount -> Amount -> a -> a
dbgamtmatch  a
n Amount
a Amount
b = forall a. Show a => RegexError -> a -> a
dbg7 (RegexError
"conversion posting "     forall a. Semigroup a => a -> a -> a
<>forall a. Show a => a -> RegexError
show a
nforall a. Semigroup a => a -> a -> a
<>RegexError
" "forall a. Semigroup a => a -> a -> a
<>Amount -> RegexError
showAmount Amount
aforall a. Semigroup a => a -> a -> a
<>RegexError
" balances amount "forall a. Semigroup a => a -> a -> a
<>Amount -> RegexError
showAmountWithoutPrice Amount
b forall a. Semigroup a => a -> a -> a
<>RegexError
" of costful posting "forall a. Semigroup a => a -> a -> a
<>Amount -> RegexError
showAmount Amount
bforall a. Semigroup a => a -> a -> a
<>RegexError
" at precision "forall a. Semigroup a => a -> a -> a
<>Amount -> RegexError
dbgShowAmountPrecision Amount
aforall a. Semigroup a => a -> a -> a
<>RegexError
" ?")
            dbgcostmatch :: a -> Amount -> Amount -> a -> a
dbgcostmatch a
n Amount
a Amount
b = forall a. Show a => RegexError -> a -> a
dbg7 (RegexError
"and\nconversion posting "forall a. Semigroup a => a -> a -> a
<>forall a. Show a => a -> RegexError
show a
nforall a. Semigroup a => a -> a -> a
<>RegexError
" "forall a. Semigroup a => a -> a -> a
<>Amount -> RegexError
showAmount Amount
aforall a. Semigroup a => a -> a -> a
<>RegexError
" matches cost "   forall a. Semigroup a => a -> a -> a
<>Amount -> RegexError
showAmount (Amount -> Amount
amountCost Amount
b)forall a. Semigroup a => a -> a -> a
<>RegexError
" of costful posting "forall a. Semigroup a => a -> a -> a
<>Amount -> RegexError
showAmount Amount
bforall a. Semigroup a => a -> a -> a
<>RegexError
" at precision "forall a. Semigroup a => a -> a -> a
<>Amount -> RegexError
dbgShowAmountPrecision Amount
aforall a. Semigroup a => a -> a -> a
<>RegexError
" ?") 

    -- Add a cost to a posting if it matches (negative) one of the
    -- supplied conversion amounts, adding the other amount as the cost.
    addCostIfMatchesOneAmount :: Amount -> Amount -> Posting -> Maybe (Posting, Amount)
    addCostIfMatchesOneAmount :: Amount -> Amount -> Posting -> Maybe (Posting, Amount)
addCostIfMatchesOneAmount Amount
a1 Amount
a2 Posting
p = do
        Amount
a <- Posting -> Maybe Amount
postingSingleAmount Posting
p
        let newp :: Amount -> Posting
newp Amount
cost = Posting
p{pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount Amount
a{aprice :: Maybe AmountPrice
aprice = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Amount -> AmountPrice
TotalPrice Amount
cost}}
        if
           | Amount -> Amount -> Bool
amountsMatch (-Amount
a1) Amount
a -> forall a. a -> Maybe a
Just (Amount -> Posting
newp Amount
a2, Amount
a2)
           | Amount -> Amount -> Bool
amountsMatch (-Amount
a2) Amount
a -> forall a. a -> Maybe a
Just (Amount -> Posting
newp Amount
a1, Amount
a1)
           | Bool
otherwise            -> forall a. Maybe a
Nothing

    -- Get the single-commodity costless amount from a conversion posting, or raise an error.
    conversionPostingAmountNoCost :: Posting -> Either Text Amount
conversionPostingAmountNoCost Posting
p = case Posting -> Maybe Amount
postingSingleAmount Posting
p of
        Just a :: Amount
a@Amount{aprice :: Amount -> Maybe AmountPrice
aprice=Maybe AmountPrice
Nothing} -> forall a b. b -> Either a b
Right Amount
a
        Just Amount{aprice :: Amount -> Maybe AmountPrice
aprice=Just AmountPrice
_} -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ [Posting] -> Text -> Text
annotateWithPostings [Posting
p] Text
"Conversion postings must not have a cost:"
        Maybe Amount
Nothing                    -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ [Posting] -> Text -> Text
annotateWithPostings [Posting
p] Text
"Conversion postings must have a single-commodity amount:"

    -- Do these amounts look the same when compared at the first's display precision ?
    amountsMatch :: Amount -> Amount -> Bool
amountsMatch Amount
a Amount
b = Amount -> Bool
amountLooksZero forall a b. (a -> b) -> a -> b
$ AmountPrecision -> Amount -> Amount
amountSetPrecision (AmountStyle -> AmountPrecision
asprecision forall a b. (a -> b) -> a -> b
$ Amount -> AmountStyle
astyle Amount
a) forall a b. (a -> b) -> a -> b
$ Amount
a forall a. Num a => a -> a -> a
- Amount
b

    -- Delete a posting from the indexed list of postings based on either its
    -- index or its posting amount.
    -- Note: traversing the whole list to delete a single match is generally not efficient,
    -- but given that a transaction probably doesn't have more than four postings, it should
    -- still be more efficient than using a Map or another data structure. Even monster
    -- transactions with up to 10 postings, which are generally not a good
    -- idea, are still too small for there to be an advantage.
    -- XXX shouldn't assume transactions have few postings
    deleteIdx :: b -> [(b, b)] -> Maybe [(b, b)]
deleteIdx b
n = forall {a}. (a -> Bool) -> [a] -> Maybe [a]
deleteUniqueMatch ((b
nforall a. Eq a => a -> a -> Bool
==) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)
    deleteUniqueMatch :: (a -> Bool) -> [a] -> Maybe [a]
deleteUniqueMatch a -> Bool
p (a
x:[a]
xs) | a -> Bool
p a
x       = if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any a -> Bool
p [a]
xs then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just [a]
xs
                               | Bool
otherwise = (a
xforall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> Bool) -> [a] -> Maybe [a]
deleteUniqueMatch a -> Bool
p [a]
xs
    deleteUniqueMatch a -> Bool
_ []                 = forall a. Maybe a
Nothing
    annotateWithPostings :: [Posting] -> Text -> Text
annotateWithPostings [Posting]
xs Text
str = [Text] -> Text
T.unlines forall a b. (a -> b) -> a -> b
$ Text
str forall a. a -> [a] -> [a]
: Bool -> [Posting] -> [Text]
postingsAsLines Bool
False [Posting]
xs

dbgShowAmountPrecision :: Amount -> RegexError
dbgShowAmountPrecision Amount
a =
  case AmountStyle -> AmountPrecision
asprecision forall a b. (a -> b) -> a -> b
$ Amount -> AmountStyle
astyle Amount
a of
    Precision Word8
n      -> forall a. Show a => a -> RegexError
show Word8
n
    AmountPrecision
NaturalPrecision -> forall a. Show a => a -> RegexError
show forall a b. (a -> b) -> a -> b
$ forall i. DecimalRaw i -> Word8
decimalPlaces forall a b. (a -> b) -> a -> b
$ forall i. Integral i => DecimalRaw i -> DecimalRaw i
normalizeDecimal forall a b. (a -> b) -> a -> b
$ Amount -> DecimalRaw Integer
aquantity Amount
a

-- Using the provided account types map, sort the given indexed postings
-- into three lists of posting numbers (stored in two pairs), like so:
-- (conversion postings, (costful other postings, costless other postings)).
-- A true first argument activates its secondary function: check that all
-- conversion postings occur in adjacent pairs, otherwise return an error.
partitionAndCheckConversionPostings :: Bool -> M.Map AccountName AccountType -> [IdxPosting] -> Either Text ( [(IdxPosting, IdxPosting)], ([IdxPosting], [IdxPosting]) )
partitionAndCheckConversionPostings :: Bool
-> Map Text AccountType
-> [IdxPosting]
-> Either
     Text ([(IdxPosting, IdxPosting)], ([IdxPosting], [IdxPosting]))
partitionAndCheckConversionPostings Bool
check Map Text AccountType
acctTypes =
  -- Left fold processes postings in parse order, so that eg inferred costs
  -- will be added to the first (top-most) posting, not the last one.
  forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM forall {a} {a} {a}.
IsString a =>
(([(a, (a, Posting))], ([(a, Posting)], [(a, Posting)])), Maybe a)
-> (a, Posting)
-> Either
     a
     (([(a, (a, Posting))], ([(a, Posting)], [(a, Posting)])),
      Maybe (a, Posting))
select (([], ([], [])), forall a. Maybe a
Nothing)
    -- The costless other postings are somehow reversed still; "second (second reverse" fixes that.
    forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second forall a. [a] -> [a]
reverse) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)
  where
    select :: (([(a, (a, Posting))], ([(a, Posting)], [(a, Posting)])), Maybe a)
-> (a, Posting)
-> Either
     a
     (([(a, (a, Posting))], ([(a, Posting)], [(a, Posting)])),
      Maybe (a, Posting))
select (([(a, (a, Posting))]
cs, others :: ([(a, Posting)], [(a, Posting)])
others@([(a, Posting)]
ps, [(a, Posting)]
os)), Maybe a
Nothing) np :: (a, Posting)
np@(a
_, Posting
p)
      | Posting -> Bool
isConversion Posting
p = forall a b. b -> Either a b
Right (([(a, (a, Posting))]
cs, ([(a, Posting)], [(a, Posting)])
others),      forall a. a -> Maybe a
Just (a, Posting)
np)
      | Posting -> Bool
hasCost Posting
p      = forall a b. b -> Either a b
Right (([(a, (a, Posting))]
cs, ((a, Posting)
npforall a. a -> [a] -> [a]
:[(a, Posting)]
ps, [(a, Posting)]
os)), forall a. Maybe a
Nothing)
      | Bool
otherwise      = forall a b. b -> Either a b
Right (([(a, (a, Posting))]
cs, ([(a, Posting)]
ps, (a, Posting)
npforall a. a -> [a] -> [a]
:[(a, Posting)]
os)), forall a. Maybe a
Nothing)
    select (([(a, (a, Posting))]
cs, others :: ([(a, Posting)], [(a, Posting)])
others@([(a, Posting)]
ps,[(a, Posting)]
os)), Just a
lst) np :: (a, Posting)
np@(a
_, Posting
p)
      | Posting -> Bool
isConversion Posting
p = forall a b. b -> Either a b
Right (((a
lst, (a, Posting)
np)forall a. a -> [a] -> [a]
:[(a, (a, Posting))]
cs, ([(a, Posting)], [(a, Posting)])
others), forall a. Maybe a
Nothing)
      | Bool
check          = forall a b. a -> Either a b
Left a
"Conversion postings must occur in adjacent pairs"
      | Bool
otherwise      = forall a b. b -> Either a b
Right (([(a, (a, Posting))]
cs, ([(a, Posting)]
ps, (a, Posting)
npforall a. a -> [a] -> [a]
:[(a, Posting)]
os)), forall a. Maybe a
Nothing)
    isConversion :: Posting -> Bool
isConversion Posting
p = forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Posting -> Text
paccount Posting
p) Map Text AccountType
acctTypes forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just AccountType
Conversion
    hasCost :: Posting -> Bool
hasCost Posting
p = forall a. Maybe a -> Bool
isJust forall a b. (a -> b) -> a -> b
$ Amount -> Maybe AmountPrice
aprice forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Posting -> Maybe Amount
postingSingleAmount Posting
p

-- | Get a posting's amount if it is single-commodity.
postingSingleAmount :: Posting -> Maybe Amount
postingSingleAmount :: Posting -> Maybe Amount
postingSingleAmount Posting
p = case MixedAmount -> [Amount]
amountsRaw (Posting -> MixedAmount
pamount Posting
p) of
  [Amount
a] -> forall a. a -> Maybe a
Just Amount
a
  [Amount]
_   -> forall a. Maybe a
Nothing

-- | Apply some account aliases to all posting account names in the transaction, as described by accountNameApplyAliases.
-- This can fail due to a bad replacement pattern in a regular expression alias.
transactionApplyAliases :: [AccountAlias] -> Transaction -> Either RegexError Transaction
transactionApplyAliases :: [AccountAlias] -> Transaction -> Either RegexError Transaction
transactionApplyAliases [AccountAlias]
aliases Transaction
t =
  case forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ([AccountAlias] -> Posting -> Either RegexError Posting
postingApplyAliases [AccountAlias]
aliases) forall a b. (a -> b) -> a -> b
$ Transaction -> [Posting]
tpostings Transaction
t of
    Right [Posting]
ps -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Transaction -> Transaction
txnTieKnot forall a b. (a -> b) -> a -> b
$ Transaction
t{tpostings :: [Posting]
tpostings=[Posting]
ps}
    Left RegexError
err -> forall a b. a -> Either a b
Left RegexError
err

-- | Apply a transformation to a transaction's postings.
transactionMapPostings :: (Posting -> Posting) -> Transaction -> Transaction
transactionMapPostings :: (Posting -> Posting) -> Transaction -> Transaction
transactionMapPostings Posting -> Posting
f t :: Transaction
t@Transaction{tpostings :: Transaction -> [Posting]
tpostings=[Posting]
ps} = Transaction
t{tpostings :: [Posting]
tpostings=forall a b. (a -> b) -> [a] -> [b]
map Posting -> Posting
f [Posting]
ps}

-- | Apply a transformation to a transaction's posting amounts.
transactionMapPostingAmounts :: (MixedAmount -> MixedAmount) -> Transaction -> Transaction
transactionMapPostingAmounts :: (MixedAmount -> MixedAmount) -> Transaction -> Transaction
transactionMapPostingAmounts MixedAmount -> MixedAmount
f  = (Posting -> Posting) -> Transaction -> Transaction
transactionMapPostings ((MixedAmount -> MixedAmount) -> Posting -> Posting
postingTransformAmount MixedAmount -> MixedAmount
f)

-- | All posting amounts from this transactin, in order.
transactionAmounts :: Transaction -> [MixedAmount]
transactionAmounts :: Transaction -> [MixedAmount]
transactionAmounts = forall a b. (a -> b) -> [a] -> [b]
map Posting -> MixedAmount
pamount forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> [Posting]
tpostings

-- | The file path from which this transaction was parsed.
transactionFile :: Transaction -> FilePath
transactionFile :: Transaction -> RegexError
transactionFile Transaction{(SourcePos, SourcePos)
tsourcepos :: (SourcePos, SourcePos)
tsourcepos :: Transaction -> (SourcePos, SourcePos)
tsourcepos} = SourcePos -> RegexError
sourceName forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst (SourcePos, SourcePos)
tsourcepos

-- Add transaction information to an error message.
annotateErrorWithTransaction :: Transaction -> String -> String
annotateErrorWithTransaction :: Transaction -> RegexError -> RegexError
annotateErrorWithTransaction Transaction
t RegexError
s =
  [RegexError] -> RegexError
unlines [ (SourcePos, SourcePos) -> RegexError
sourcePosPairPretty forall a b. (a -> b) -> a -> b
$ Transaction -> (SourcePos, SourcePos)
tsourcepos Transaction
t, RegexError
s
          , Text -> RegexError
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.stripEnd forall a b. (a -> b) -> a -> b
$ Transaction -> Text
showTransaction Transaction
t
          ]

-- tests

tests_Transaction :: TestTree
tests_Transaction :: TestTree
tests_Transaction =
  RegexError -> [TestTree] -> TestTree
testGroup RegexError
"Transaction" [

      RegexError -> [TestTree] -> TestTree
testGroup RegexError
"showPostingLines" [
          RegexError -> Assertion -> TestTree
testCase RegexError
"null posting" forall a b. (a -> b) -> a -> b
$ Posting -> [Text]
showPostingLines Posting
nullposting forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= [Text
"                   0"]
        , RegexError -> Assertion -> TestTree
testCase RegexError
"non-null posting" forall a b. (a -> b) -> a -> b
$
           let p :: Posting
p =
                Posting
posting
                  { pstatus :: Status
pstatus = Status
Cleared
                  , paccount :: Text
paccount = Text
"a"
                  , pamount :: MixedAmount
pamount = forall (t :: * -> *). Foldable t => t Amount -> MixedAmount
mixed [DecimalRaw Integer -> Amount
usd DecimalRaw Integer
1, DecimalRaw Integer -> Amount
hrs DecimalRaw Integer
2]
                  , pcomment :: Text
pcomment = Text
"pcomment1\npcomment2\n  tag3: val3  \n"
                  , ptype :: PostingType
ptype = PostingType
RegularPosting
                  , ptags :: [Tag]
ptags = [(Text
"ptag1", Text
"val1"), (Text
"ptag2", Text
"val2")]
                  }
           in Posting -> [Text]
showPostingLines Posting
p forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
              [ Text
"    * a         $1.00  ; pcomment1"
              , Text
"    ; pcomment2"
              , Text
"    ;   tag3: val3  "
              , Text
"    * a         2.00h  ; pcomment1"
              , Text
"    ; pcomment2"
              , Text
"    ;   tag3: val3  "
              ]
        ]

    , let
        -- one implicit amount
        timp :: Transaction
timp = Transaction
nulltransaction {tpostings :: [Posting]
tpostings = [Text
"a" Text -> Amount -> Posting
`post` DecimalRaw Integer -> Amount
usd DecimalRaw Integer
1, Text
"b" Text -> Amount -> Posting
`post` Amount
missingamt]}
        -- explicit amounts, balanced
        texp :: Transaction
texp = Transaction
nulltransaction {tpostings :: [Posting]
tpostings = [Text
"a" Text -> Amount -> Posting
`post` DecimalRaw Integer -> Amount
usd DecimalRaw Integer
1, Text
"b" Text -> Amount -> Posting
`post` DecimalRaw Integer -> Amount
usd (-DecimalRaw Integer
1)]}
        -- explicit amount, only one posting
        texp1 :: Transaction
texp1 = Transaction
nulltransaction {tpostings :: [Posting]
tpostings = [Text
"(a)" Text -> Amount -> Posting
`post` DecimalRaw Integer -> Amount
usd DecimalRaw Integer
1]}
        -- explicit amounts, two commodities, explicit balancing price
        texp2 :: Transaction
texp2 = Transaction
nulltransaction {tpostings :: [Posting]
tpostings = [Text
"a" Text -> Amount -> Posting
`post` DecimalRaw Integer -> Amount
usd DecimalRaw Integer
1, Text
"b" Text -> Amount -> Posting
`post` (DecimalRaw Integer -> Amount
hrs (-DecimalRaw Integer
1) Amount -> Amount -> Amount
`at` DecimalRaw Integer -> Amount
usd DecimalRaw Integer
1)]}
        -- explicit amounts, two commodities, implicit balancing price
        texp2b :: Transaction
texp2b = Transaction
nulltransaction {tpostings :: [Posting]
tpostings = [Text
"a" Text -> Amount -> Posting
`post` DecimalRaw Integer -> Amount
usd DecimalRaw Integer
1, Text
"b" Text -> Amount -> Posting
`post` DecimalRaw Integer -> Amount
hrs (-DecimalRaw Integer
1)]}
        -- one missing amount, not the last one
        t3 :: Transaction
t3 = Transaction
nulltransaction {tpostings :: [Posting]
tpostings = [Text
"a" Text -> Amount -> Posting
`post` DecimalRaw Integer -> Amount
usd DecimalRaw Integer
1, Text
"b" Text -> Amount -> Posting
`post` Amount
missingamt, Text
"c" Text -> Amount -> Posting
`post` DecimalRaw Integer -> Amount
usd (-DecimalRaw Integer
1)]}
        -- unbalanced amounts when precision is limited (#931)
        -- t4 = nulltransaction {tpostings = ["a" `post` usd (-0.01), "b" `post` usd (0.005), "c" `post` usd (0.005)]}
      in RegexError -> [TestTree] -> TestTree
testGroup RegexError
"postingsAsLines" [
              RegexError -> Assertion -> TestTree
testCase RegexError
"null-transaction" forall a b. (a -> b) -> a -> b
$ Bool -> [Posting] -> [Text]
postingsAsLines Bool
False (Transaction -> [Posting]
tpostings Transaction
nulltransaction) forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= []
            , RegexError -> Assertion -> TestTree
testCase RegexError
"implicit-amount" forall a b. (a -> b) -> a -> b
$ Bool -> [Posting] -> [Text]
postingsAsLines Bool
False (Transaction -> [Posting]
tpostings Transaction
timp) forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
                  [ Text
"    a           $1.00"
                  , Text
"    b" -- implicit amount remains implicit
                  ]
            , RegexError -> Assertion -> TestTree
testCase RegexError
"explicit-amounts" forall a b. (a -> b) -> a -> b
$ Bool -> [Posting] -> [Text]
postingsAsLines Bool
False (Transaction -> [Posting]
tpostings Transaction
texp) forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
                  [ Text
"    a           $1.00"
                  , Text
"    b          $-1.00"
                  ]
            , RegexError -> Assertion -> TestTree
testCase RegexError
"one-explicit-amount" forall a b. (a -> b) -> a -> b
$ Bool -> [Posting] -> [Text]
postingsAsLines Bool
False (Transaction -> [Posting]
tpostings Transaction
texp1) forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
                  [ Text
"    (a)           $1.00"
                  ]
            , RegexError -> Assertion -> TestTree
testCase RegexError
"explicit-amounts-two-commodities" forall a b. (a -> b) -> a -> b
$ Bool -> [Posting] -> [Text]
postingsAsLines Bool
False (Transaction -> [Posting]
tpostings Transaction
texp2) forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
                  [ Text
"    a             $1.00"
                  , Text
"    b    -1.00h @ $1.00"
                  ]
            , RegexError -> Assertion -> TestTree
testCase RegexError
"explicit-amounts-not-explicitly-balanced" forall a b. (a -> b) -> a -> b
$ Bool -> [Posting] -> [Text]
postingsAsLines Bool
False (Transaction -> [Posting]
tpostings Transaction
texp2b) forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
                  [ Text
"    a           $1.00"
                  , Text
"    b          -1.00h"
                  ]
            , RegexError -> Assertion -> TestTree
testCase RegexError
"implicit-amount-not-last" forall a b. (a -> b) -> a -> b
$ Bool -> [Posting] -> [Text]
postingsAsLines Bool
False (Transaction -> [Posting]
tpostings Transaction
t3) forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
                  [Text
"    a           $1.00", Text
"    b", Text
"    c          $-1.00"]
            -- , testCase "ensure-visibly-balanced" $
            --    in postingsAsLines False (tpostings t4) @?=
            --       ["    a          $-0.01", "    b           $0.005", "    c           $0.005"]

            ]

    , RegexError -> [TestTree] -> TestTree
testGroup RegexError
"showTransaction" [
          RegexError -> Assertion -> TestTree
testCase RegexError
"null transaction" forall a b. (a -> b) -> a -> b
$ Transaction -> Text
showTransaction Transaction
nulltransaction forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Text
"0000-01-01\n\n"
        , RegexError -> Assertion -> TestTree
testCase RegexError
"non-null transaction" forall a b. (a -> b) -> a -> b
$ Transaction -> Text
showTransaction
            Transaction
nulltransaction
              { tdate :: Day
tdate = Integer -> Int -> Int -> Day
fromGregorian Integer
2012 Int
05 Int
14
              , tdate2 :: Maybe Day
tdate2 = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Integer -> Int -> Int -> Day
fromGregorian Integer
2012 Int
05 Int
15
              , tstatus :: Status
tstatus = Status
Unmarked
              , tcode :: Text
tcode = Text
"code"
              , tdescription :: Text
tdescription = Text
"desc"
              , tcomment :: Text
tcomment = Text
"tcomment1\ntcomment2\n"
              , ttags :: [Tag]
ttags = [(Text
"ttag1", Text
"val1")]
              , tpostings :: [Posting]
tpostings =
                  [ Posting
nullposting
                      { pstatus :: Status
pstatus = Status
Cleared
                      , paccount :: Text
paccount = Text
"a"
                      , pamount :: MixedAmount
pamount = forall (t :: * -> *). Foldable t => t Amount -> MixedAmount
mixed [DecimalRaw Integer -> Amount
usd DecimalRaw Integer
1, DecimalRaw Integer -> Amount
hrs DecimalRaw Integer
2]
                      , pcomment :: Text
pcomment = Text
"\npcomment2\n"
                      , ptype :: PostingType
ptype = PostingType
RegularPosting
                      , ptags :: [Tag]
ptags = [(Text
"ptag1", Text
"val1"), (Text
"ptag2", Text
"val2")]
                      }
                  ]
              } forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
          [Text] -> Text
T.unlines
            [ Text
"2012-05-14=2012-05-15 (code) desc  ; tcomment1"
            , Text
"    ; tcomment2"
            , Text
"    * a         $1.00"
            , Text
"    ; pcomment2"
            , Text
"    * a         2.00h"
            , Text
"    ; pcomment2"
            , Text
""
            ]
        , RegexError -> Assertion -> TestTree
testCase RegexError
"show a balanced transaction" forall a b. (a -> b) -> a -> b
$
          (let t :: Transaction
t =
                 Integer
-> Text
-> (SourcePos, SourcePos)
-> Day
-> Maybe Day
-> Status
-> Text
-> Text
-> Text
-> [Tag]
-> [Posting]
-> Transaction
Transaction
                   Integer
0
                   Text
""
                   (SourcePos, SourcePos)
nullsourcepos
                   (Integer -> Int -> Int -> Day
fromGregorian Integer
2007 Int
01 Int
28)
                   forall a. Maybe a
Nothing
                   Status
Unmarked
                   Text
""
                   Text
"coopportunity"
                   Text
""
                   []
                   [ Posting
posting {paccount :: Text
paccount = Text
"expenses:food:groceries", pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount (DecimalRaw Integer -> Amount
usd DecimalRaw Integer
47.18), ptransaction :: Maybe Transaction
ptransaction = forall a. a -> Maybe a
Just Transaction
t}
                   , Posting
posting {paccount :: Text
paccount = Text
"assets:checking", pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount (DecimalRaw Integer -> Amount
usd (-DecimalRaw Integer
47.18)), ptransaction :: Maybe Transaction
ptransaction = forall a. a -> Maybe a
Just Transaction
t}
                   ]
            in Transaction -> Text
showTransaction Transaction
t) forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
          ([Text] -> Text
T.unlines
             [ Text
"2007-01-28 coopportunity"
             , Text
"    expenses:food:groceries          $47.18"
             , Text
"    assets:checking                 $-47.18"
             , Text
""
             ])
        , RegexError -> Assertion -> TestTree
testCase RegexError
"show an unbalanced transaction, should not elide" forall a b. (a -> b) -> a -> b
$
          (Transaction -> Text
showTransaction
             (Transaction -> Transaction
txnTieKnot forall a b. (a -> b) -> a -> b
$
              Integer
-> Text
-> (SourcePos, SourcePos)
-> Day
-> Maybe Day
-> Status
-> Text
-> Text
-> Text
-> [Tag]
-> [Posting]
-> Transaction
Transaction
                Integer
0
                Text
""
                (SourcePos, SourcePos)
nullsourcepos
                (Integer -> Int -> Int -> Day
fromGregorian Integer
2007 Int
01 Int
28)
                forall a. Maybe a
Nothing
                Status
Unmarked
                Text
""
                Text
"coopportunity"
                Text
""
                []
                [ Posting
posting {paccount :: Text
paccount = Text
"expenses:food:groceries", pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount (DecimalRaw Integer -> Amount
usd DecimalRaw Integer
47.18)}
                , Posting
posting {paccount :: Text
paccount = Text
"assets:checking", pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount (DecimalRaw Integer -> Amount
usd (-DecimalRaw Integer
47.19))}
                ])) forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
          ([Text] -> Text
T.unlines
             [ Text
"2007-01-28 coopportunity"
             , Text
"    expenses:food:groceries          $47.18"
             , Text
"    assets:checking                 $-47.19"
             , Text
""
             ])
        , RegexError -> Assertion -> TestTree
testCase RegexError
"show a transaction with one posting and a missing amount" forall a b. (a -> b) -> a -> b
$
          (Transaction -> Text
showTransaction
             (Transaction -> Transaction
txnTieKnot forall a b. (a -> b) -> a -> b
$
              Integer
-> Text
-> (SourcePos, SourcePos)
-> Day
-> Maybe Day
-> Status
-> Text
-> Text
-> Text
-> [Tag]
-> [Posting]
-> Transaction
Transaction
                Integer
0
                Text
""
                (SourcePos, SourcePos)
nullsourcepos
                (Integer -> Int -> Int -> Day
fromGregorian Integer
2007 Int
01 Int
28)
                forall a. Maybe a
Nothing
                Status
Unmarked
                Text
""
                Text
"coopportunity"
                Text
""
                []
                [Posting
posting {paccount :: Text
paccount = Text
"expenses:food:groceries", pamount :: MixedAmount
pamount = MixedAmount
missingmixedamt}])) forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
          ([Text] -> Text
T.unlines [Text
"2007-01-28 coopportunity", Text
"    expenses:food:groceries", Text
""])
        , RegexError -> Assertion -> TestTree
testCase RegexError
"show a transaction with a priced commodityless amount" forall a b. (a -> b) -> a -> b
$
          (Transaction -> Text
showTransaction
             (Transaction -> Transaction
txnTieKnot forall a b. (a -> b) -> a -> b
$
              Integer
-> Text
-> (SourcePos, SourcePos)
-> Day
-> Maybe Day
-> Status
-> Text
-> Text
-> Text
-> [Tag]
-> [Posting]
-> Transaction
Transaction
                Integer
0
                Text
""
                (SourcePos, SourcePos)
nullsourcepos
                (Integer -> Int -> Int -> Day
fromGregorian Integer
2010 Int
01 Int
01)
                forall a. Maybe a
Nothing
                Status
Unmarked
                Text
""
                Text
"x"
                Text
""
                []
                [ Posting
posting {paccount :: Text
paccount = Text
"a", pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount forall a b. (a -> b) -> a -> b
$ DecimalRaw Integer -> Amount
num DecimalRaw Integer
1 Amount -> Amount -> Amount
`at` (DecimalRaw Integer -> Amount
usd DecimalRaw Integer
2 Amount -> AmountPrecision -> Amount
`withPrecision` Word8 -> AmountPrecision
Precision Word8
0)}
                , Posting
posting {paccount :: Text
paccount = Text
"b", pamount :: MixedAmount
pamount = MixedAmount
missingmixedamt}
                ])) forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
          ([Text] -> Text
T.unlines [Text
"2010-01-01 x", Text
"    a          1 @ $2", Text
"    b", Text
""])
        ]
    ]