{-|

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
, transactionInferEquityPostings
, transactionTagCostsAndEquityAndMaybeInferCosts
, transactionApplyAliases
, transactionMapPostings
, transactionMapPostingAmounts
, transactionAmounts
, transactionNegate
, partitionAndCheckConversionPostings
, transactionAddTags
, transactionAddHiddenAndMaybeVisibleTag
  -- * helpers
, payeeAndNoteFromDescription
, payeeAndNoteFromDescription'
  -- nonzerobalanceerror
  -- * date operations
, transactionDate2
, transactionDateOrDate2
  -- * transaction description parts
, transactionPayee
, transactionNote
  -- payeeAndNoteFromDescription
  -- * rendering
, showTransaction
, showTransactionOneLineAmounts
, showTransactionLineFirstPart
, 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 ((<&>))
import Data.Function ((&))
import Data.List (union)


instance HasAmounts Transaction where
  styleAmounts :: Map Text AmountStyle -> Transaction -> Transaction
styleAmounts Map Text AmountStyle
styles Transaction
t = Transaction
t{tpostings=styleAmounts styles $ tpostings t}

nulltransaction :: Transaction
nulltransaction :: Transaction
nulltransaction = Transaction {
                    tindex :: Integer
tindex=Integer
0,
                    tsourcepos :: (SourcePos, SourcePos)
tsourcepos=(SourcePos, SourcePos)
nullsourcepospair,
                    tdate :: Day
tdate=Day
nulldate,
                    tdate2 :: Maybe Day
tdate2=Maybe Day
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 (Transaction -> Transaction) -> Transaction -> Transaction
forall a b. (a -> b) -> a -> b
$ Transaction
nulltransaction{tdate=day, tpostings=ps}

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

transactionNote :: Transaction -> Text
transactionNote :: Transaction -> Text
transactionNote = Tag -> Text
forall a b. (a, b) -> b
snd (Tag -> Text) -> (Transaction -> Tag) -> Transaction -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Tag
payeeAndNoteFromDescription (Text -> Tag) -> (Transaction -> Text) -> Transaction -> Tag
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 (Text -> Text) -> Text -> Text
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 (Char -> Char -> Bool
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 Maybe Char -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Char -> Bool) -> Maybe Char -> Bool
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Maybe Char
T.find (Char -> Char -> Bool
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 = LazyText -> Text
TL.toStrict (LazyText -> Text)
-> (Transaction -> LazyText) -> Transaction -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> LazyText
TB.toLazyText (Builder -> LazyText)
-> (Transaction -> Builder) -> Transaction -> LazyText
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 = LazyText -> Text
TL.toStrict (LazyText -> Text)
-> (Transaction -> LazyText) -> Transaction -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> LazyText
TB.toLazyText (Builder -> LazyText)
-> (Transaction -> Builder) -> Transaction -> LazyText
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 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
newline
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Text -> Builder) -> [Text] -> Builder
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
newline) (Builder -> Builder) -> (Text -> Builder) -> Text -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Builder
TB.fromText) [Text]
newlinecomments
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Text -> Builder) -> [Text] -> Builder
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
newline) (Builder -> Builder) -> (Text -> Builder) -> Text -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Builder
TB.fromText) (Bool -> [Posting] -> [Text]
postingsAsLines Bool
onelineamounts ([Posting] -> [Text]) -> [Posting] -> [Text]
forall a b. (a -> b) -> a -> b
$ Transaction -> [Posting]
tpostings Transaction
t)
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
newline
  where
    descriptionline :: Text
descriptionline = Text -> Text
T.stripEnd (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Transaction -> Text
showTransactionLineFirstPart Transaction
t Text -> Text -> Text
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
" " Text -> Text -> 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) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> (Day -> Text) -> Maybe Day -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" ((Text
"="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
. Day -> Text
showDate) (Transaction -> Maybe Day
tdate2 Transaction
t)
    status :: Text
status | Transaction -> Status
tstatus Transaction
t Status -> Status -> Bool
forall a. Eq a => a -> a -> Bool
== Status
Cleared = Text
" *"
           | Transaction -> Status
tstatus Transaction
t Status -> Status -> Bool
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
")" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Transaction -> Text
tcode Transaction
t

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

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

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

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

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

transactionsPostings :: [Transaction] -> [Posting]
transactionsPostings :: [Transaction] -> [Posting]
transactionsPostings = (Transaction -> [Posting]) -> [Transaction] -> [Posting]
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 = Day -> Maybe Day -> Day
forall a. a -> Maybe a -> a
fromMaybe (Transaction -> Day
tdate Transaction
t) (Maybe Day -> Day) -> Maybe Day -> Day
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=map (postingSetTransaction t') 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=map (\Posting
p -> Posting
p{ptransaction=Nothing}) ps}

-- | Set a posting's parent transaction.
postingSetTransaction :: Transaction -> Posting -> Posting
postingSetTransaction :: Transaction -> Posting -> Posting
postingSetTransaction Transaction
t Posting
p = Posting
p{ptransaction=Just 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=map f 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 = mapMaybe (postingToCost cost) $ tpostings t}

-- | For any costs in this 'Transaction' which don't have associated equity conversion postings,
-- generate and add those.
transactionInferEquityPostings :: Bool -> AccountName -> Transaction -> Transaction
transactionInferEquityPostings :: Bool -> Text -> Transaction -> Transaction
transactionInferEquityPostings Bool
verbosetags Text
equityAcct Transaction
t =
  Transaction
t{tpostings=concatMap (postingAddInferredEquityPostings verbosetags equityAcct) $ tpostings 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 RegexError -> RegexError -> RegexError
forall a. Semigroup a => a -> a -> a
<> RegexError
": ")RegexError -> RegexError -> RegexError
forall a. [a] -> [a] -> [a]
++)

-- | Add tags to a transaction, discarding any for which it already has a value.
-- Note this does not add tags to the transaction's comment.
transactionAddTags :: Transaction -> [Tag] -> Transaction
transactionAddTags :: Transaction -> [Tag] -> Transaction
transactionAddTags t :: Transaction
t@Transaction{[Tag]
ttags :: Transaction -> [Tag]
ttags :: [Tag]
ttags} [Tag]
tags = Transaction
t{ttags=ttags `union` tags}

-- | Add the given hidden tag to a transaction; and with a true argument,
-- also add the equivalent visible tag to the transaction's tags and comment fields.
-- If the transaction already has these tags (with any value), do nothing.
transactionAddHiddenAndMaybeVisibleTag :: Bool -> HiddenTag -> Transaction -> Transaction
transactionAddHiddenAndMaybeVisibleTag :: Bool -> Tag -> Transaction -> Transaction
transactionAddHiddenAndMaybeVisibleTag Bool
verbosetags Tag
ht t :: Transaction
t@Transaction{tcomment :: Transaction -> Text
tcomment=Text
c, [Tag]
ttags :: Transaction -> [Tag]
ttags :: [Tag]
ttags} =
  (Transaction
t Transaction -> [Tag] -> Transaction
`transactionAddTags` ([Tag
ht] [Tag] -> [Tag] -> [Tag]
forall a. Semigroup a => a -> a -> a
<> [Tag
vt|Bool
verbosetags]))
  {tcomment=if verbosetags && not hadtag then c `commentAddTagNextLine` vt else c}
  where
    vt :: Tag
vt@(Text
vname,Text
_) = Tag -> Tag
toVisibleTag Tag
ht
    hadtag :: Bool
hadtag = (Tag -> Bool) -> [Tag] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== (Text -> Text
T.toLower Text
vname)) (Text -> Bool) -> (Tag -> Text) -> Tag -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.toLower (Text -> Text) -> (Tag -> Text) -> Tag -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tag -> Text
forall a b. (a, b) -> a
fst) [Tag]
ttags  -- XXX should regex-quote vname

-- | Find, associate, and tag the corresponding equity conversion postings and costful or potentially costful postings in this transaction.
-- With a true addcosts argument, also generate and add any equivalent costs that are missing.
-- The (previously detected) names of all equity conversion accounts should be provided.
--
-- For every pair of adjacent conversion postings, this first searches for a posting with equivalent cost (1).
-- If no such posting is found, it then searches the costless postings, for one matching one of the conversion amounts (2).
-- If either of these found a candidate posting, it is tagged with costPostingTagName.
-- Then if in addcosts mode, if a costless posting was found, a cost equivalent to the conversion amounts is added to it.
--
-- The name reflects the complexity of this and its helpers; clarification is ongoing.
--
transactionTagCostsAndEquityAndMaybeInferCosts :: Bool -> Bool -> [AccountName] -> Transaction -> Either String Transaction
transactionTagCostsAndEquityAndMaybeInferCosts :: Bool
-> Bool -> [Text] -> Transaction -> Either RegexError Transaction
transactionTagCostsAndEquityAndMaybeInferCosts Bool
verbosetags1 Bool
addcosts [Text]
conversionaccts Transaction
t = (Text -> RegexError)
-> Either Text Transaction -> Either RegexError Transaction
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Transaction -> RegexError -> RegexError
annotateErrorWithTransaction Transaction
t (RegexError -> RegexError)
-> (Text -> RegexError) -> Text -> RegexError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> RegexError
T.unpack) (Either Text Transaction -> Either RegexError Transaction)
-> Either Text Transaction -> Either RegexError Transaction
forall a b. (a -> b) -> a -> b
$ do
  -- number the postings
  let npostings :: [IdxPosting]
npostings = [Int] -> [Posting] -> [IdxPosting]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([Posting] -> [IdxPosting]) -> [Posting] -> [IdxPosting]
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
-> [Text]
-> [IdxPosting]
-> Either
     Text ([(IdxPosting, IdxPosting)], ([IdxPosting], [IdxPosting]))
partitionAndCheckConversionPostings Bool
False [Text]
conversionaccts [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
-> Bool
-> (IdxPosting, IdxPosting)
-> StateT
     ([IdxPosting], [IdxPosting])
     (Either Text)
     (IdxPosting -> IdxPosting)
tagAndMaybeAddCostsForEquityPostings Bool
verbosetags1 Bool
addcosts) [(IdxPosting, IdxPosting)]
conversionPairs ([IdxPosting], [IdxPosting])
otherps

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

  where

    -- Generate the tricksy processposting function,
    -- which when applied to each posting in turn, rather magically has the effect of
    -- applying tagAndMaybeAddCostsForEquityPostings 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 (tagAndMaybeAddCostsForEquityPostings 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 = StateT
  ([IdxPosting], [IdxPosting])
  (Either Text)
  (IdxPosting -> IdxPosting)
-> ([IdxPosting], [IdxPosting])
-> Either Text (IdxPosting -> IdxPosting)
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (StateT
   ([IdxPosting], [IdxPosting])
   (Either Text)
   (IdxPosting -> IdxPosting)
 -> ([IdxPosting], [IdxPosting])
 -> Either Text (IdxPosting -> IdxPosting))
-> ([(IdxPosting, IdxPosting)]
    -> StateT
         ([IdxPosting], [IdxPosting])
         (Either Text)
         (IdxPosting -> IdxPosting))
-> [(IdxPosting, IdxPosting)]
-> ([IdxPosting], [IdxPosting])
-> Either Text (IdxPosting -> IdxPosting)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([IdxPosting -> IdxPosting] -> IdxPosting -> IdxPosting)
-> StateT
     ([IdxPosting], [IdxPosting])
     (Either Text)
     [IdxPosting -> IdxPosting]
-> StateT
     ([IdxPosting], [IdxPosting])
     (Either Text)
     (IdxPosting -> IdxPosting)
forall a b.
(a -> b)
-> StateT ([IdxPosting], [IdxPosting]) (Either Text) a
-> StateT ([IdxPosting], [IdxPosting]) (Either Text) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Endo IdxPosting -> IdxPosting -> IdxPosting
forall a. Endo a -> a -> a
appEndo (Endo IdxPosting -> IdxPosting -> IdxPosting)
-> ([IdxPosting -> IdxPosting] -> Endo IdxPosting)
-> [IdxPosting -> IdxPosting]
-> IdxPosting
-> IdxPosting
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((IdxPosting -> IdxPosting) -> Endo IdxPosting)
-> [IdxPosting -> IdxPosting] -> Endo IdxPosting
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (IdxPosting -> IdxPosting) -> Endo IdxPosting
forall a. (a -> a) -> Endo a
Endo) (StateT
   ([IdxPosting], [IdxPosting])
   (Either Text)
   [IdxPosting -> IdxPosting]
 -> StateT
      ([IdxPosting], [IdxPosting])
      (Either Text)
      (IdxPosting -> IdxPosting))
-> ([(IdxPosting, IdxPosting)]
    -> StateT
         ([IdxPosting], [IdxPosting])
         (Either Text)
         [IdxPosting -> IdxPosting])
-> [(IdxPosting, IdxPosting)]
-> StateT
     ([IdxPosting], [IdxPosting])
     (Either Text)
     (IdxPosting -> IdxPosting)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((IdxPosting, IdxPosting)
 -> StateT
      ([IdxPosting], [IdxPosting])
      (Either Text)
      (IdxPosting -> IdxPosting))
-> [(IdxPosting, IdxPosting)]
-> StateT
     ([IdxPosting], [IdxPosting])
     (Either Text)
     [IdxPosting -> IdxPosting]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [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 equity conversion postings to match,
    -- and lists of the remaining unmatched costful and costless other postings,
    -- 1. find (and consume) two other postings whose amounts/cost match the two conversion postings
    -- 2. add hidden identifying tags to the conversion postings and the other posting which has (or could have) an equivalent cost
    -- 3. if in add costs mode, and the potential equivalent-cost posting does not have that explicit cost, add it
    -- 4. or if there is a problem, raise an informative error or do nothing, as appropriate.
    -- Or if there are no costful postings at all, do nothing.
    tagAndMaybeAddCostsForEquityPostings :: Bool -> Bool -> (IdxPosting, IdxPosting) -> StateT ([IdxPosting], [IdxPosting]) (Either Text) (IdxPosting -> IdxPosting)
    tagAndMaybeAddCostsForEquityPostings :: Bool
-> Bool
-> (IdxPosting, IdxPosting)
-> StateT
     ([IdxPosting], [IdxPosting])
     (Either Text)
     (IdxPosting -> IdxPosting)
tagAndMaybeAddCostsForEquityPostings Bool
verbosetags Bool
addcosts' ((Int
n1, Posting
cp1), (Int
n2, Posting
cp2)) = (([IdxPosting], [IdxPosting])
 -> Either
      Text (IdxPosting -> IdxPosting, ([IdxPosting], [IdxPosting])))
-> StateT
     ([IdxPosting], [IdxPosting])
     (Either Text)
     (IdxPosting -> IdxPosting)
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((([IdxPosting], [IdxPosting])
  -> Either
       Text (IdxPosting -> IdxPosting, ([IdxPosting], [IdxPosting])))
 -> StateT
      ([IdxPosting], [IdxPosting])
      (Either Text)
      (IdxPosting -> IdxPosting))
-> (([IdxPosting], [IdxPosting])
    -> Either
         Text (IdxPosting -> IdxPosting, ([IdxPosting], [IdxPosting])))
-> StateT
     ([IdxPosting], [IdxPosting])
     (Either Text)
     (IdxPosting -> IdxPosting)
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 whose cost is equivalent to the conversion postings' amounts.
        matchingCostfulPs :: [IdxPosting]
matchingCostfulPs =
          ([IdxPosting] -> RegexError) -> [IdxPosting] -> [IdxPosting]
forall a. Show a => (a -> RegexError) -> a -> a
dbg7With (RegexError -> RegexError -> RegexError
label RegexError
"matched costful postings"(RegexError -> RegexError)
-> ([IdxPosting] -> RegexError) -> [IdxPosting] -> RegexError
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Int -> RegexError
forall a. Show a => a -> RegexError
show(Int -> RegexError)
-> ([IdxPosting] -> Int) -> [IdxPosting] -> RegexError
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[IdxPosting] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) ([IdxPosting] -> [IdxPosting]) -> [IdxPosting] -> [IdxPosting]
forall a b. (a -> b) -> a -> b
$ 
          (IdxPosting -> Maybe IdxPosting) -> [IdxPosting] -> [IdxPosting]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ((Posting -> Maybe Posting) -> IdxPosting -> Maybe IdxPosting
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> (Int, a) -> m (Int, b)
mapM ((Posting -> Maybe Posting) -> IdxPosting -> Maybe IdxPosting)
-> (Posting -> Maybe Posting) -> IdxPosting -> Maybe IdxPosting
forall a b. (a -> b) -> a -> b
$ Amount -> Amount -> Posting -> Maybe Posting
costfulPostingIfMatchesBothAmounts Amount
ca1 Amount
ca2) [IdxPosting]
costps

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

        -- 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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
np            -> Posting
costp Posting -> (Posting -> Posting) -> Posting
forall a b. a -> (a -> b) -> b
& Bool -> Tag -> Posting -> Posting
postingAddHiddenAndMaybeVisibleTag Bool
verbosetags (Text
costPostingTagName,Text
"")        -- if it's the specified posting number, replace it with the costful posting, and tag it
                 | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n1 Bool -> Bool -> Bool
|| Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n2 -> Posting
p     Posting -> (Posting -> Posting) -> Posting
forall a b. a -> (a -> b) -> b
& Bool -> Tag -> Posting -> Posting
postingAddHiddenAndMaybeVisibleTag Bool
verbosetags (Text
conversionPostingTagName,Text
"")  -- if it's one of the equity conversion postings, tag it
                 | Bool
otherwise          -> Posting
p)

      -- Annotate any errors with the conversion posting pair
      (Text -> Text)
-> Either
     Text (IdxPosting -> IdxPosting, ([IdxPosting], [IdxPosting]))
-> Either
     Text (IdxPosting -> IdxPosting, ([IdxPosting], [IdxPosting]))
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ([Posting] -> Text -> Text
annotateWithPostings [Posting
cp1, Posting
cp2]) (Either
   Text (IdxPosting -> IdxPosting, ([IdxPosting], [IdxPosting]))
 -> Either
      Text (IdxPosting -> IdxPosting, ([IdxPosting], [IdxPosting])))
-> Either
     Text (IdxPosting -> IdxPosting, ([IdxPosting], [IdxPosting]))
-> Either
     Text (IdxPosting -> IdxPosting, ([IdxPosting], [IdxPosting]))
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]
matchingCostfulPs
          , Just [IdxPosting]
newcostps <- Int -> [IdxPosting] -> Maybe [IdxPosting]
forall {b} {b}. Eq b => b -> [(b, b)] -> Maybe [(b, b)]
deleteIdx Int
np [IdxPosting]
costps
              -> (IdxPosting -> IdxPosting, ([IdxPosting], [IdxPosting]))
-> Either
     Text (IdxPosting -> IdxPosting, ([IdxPosting], [IdxPosting]))
forall a b. b -> Either a b
Right (Int -> Posting -> IdxPosting -> IdxPosting
postingAddCostAndOrTag Int
np Posting
costp, (if Bool
addcosts' then [IdxPosting]
newcostps else [IdxPosting]
costps, [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]
matchingCostfulPs
          , (Int
np, (Posting
costp, Amount
amt)):[(Int, (Posting, Amount))]
nps <- [(Int, (Posting, Amount))]
matchingCostlessPs
          , Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ((Int, (Posting, Amount)) -> Bool)
-> [(Int, (Posting, Amount))] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Amount -> Amount -> Bool
amountsMatch Amount
amt (Amount -> Bool)
-> ((Int, (Posting, Amount)) -> Amount)
-> (Int, (Posting, Amount))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Posting, Amount) -> Amount
forall a b. (a, b) -> b
snd ((Posting, Amount) -> Amount)
-> ((Int, (Posting, Amount)) -> (Posting, Amount))
-> (Int, (Posting, Amount))
-> Amount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, (Posting, Amount)) -> (Posting, Amount)
forall a b. (a, b) -> b
snd) [(Int, (Posting, Amount))]
nps
          , Just [IdxPosting]
newotherps <- Int -> [IdxPosting] -> Maybe [IdxPosting]
forall {b} {b}. Eq b => b -> [(b, b)] -> Maybe [(b, b)]
deleteIdx Int
np [IdxPosting]
otherps
              -> (IdxPosting -> IdxPosting, ([IdxPosting], [IdxPosting]))
-> Either
     Text (IdxPosting -> IdxPosting, ([IdxPosting], [IdxPosting]))
forall a b. b -> Either a b
Right (Int -> Posting -> IdxPosting -> IdxPosting
postingAddCostAndOrTag Int
np Posting
costp, ([IdxPosting]
costps, if Bool
addcosts' then [IdxPosting]
newotherps else [IdxPosting]
otherps))

          -- 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 -> (IdxPosting -> IdxPosting, ([IdxPosting], [IdxPosting]))
-> Either
     Text (IdxPosting -> IdxPosting, ([IdxPosting], [IdxPosting]))
forall a b. b -> Either a b
Right (IdxPosting -> IdxPosting
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{acost :: Amount -> Maybe AmountCost
acost=Just AmountCost
_} <- Posting -> Maybe Amount
postingSingleAmount Posting
costfulp
        if
           | Integer -> Amount -> Amount -> Bool -> Bool
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
&&  Integer -> Amount -> Amount -> 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)) -> Posting -> Maybe Posting
forall a. a -> Maybe a
Just Posting
costfulp
           | Integer -> Amount -> Amount -> Bool -> Bool
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
&&  Integer -> Amount -> Amount -> 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)) -> Posting -> Maybe Posting
forall a. a -> Maybe a
Just Posting
costfulp
           | Bool
otherwise -> Maybe Posting
forall a. Maybe a
Nothing
           where
            dbgamtmatch :: a -> Amount -> Amount -> a -> a
dbgamtmatch  a
n Amount
a Amount
b = RegexError -> a -> a
forall a. Show a => RegexError -> a -> a
dbg7 (RegexError
"conversion posting "     RegexError -> RegexError -> RegexError
forall a. Semigroup a => a -> a -> a
<>a -> RegexError
forall a. Show a => a -> RegexError
show a
nRegexError -> RegexError -> RegexError
forall a. Semigroup a => a -> a -> a
<>RegexError
" "RegexError -> RegexError -> RegexError
forall a. Semigroup a => a -> a -> a
<>Amount -> RegexError
showAmount Amount
aRegexError -> RegexError -> RegexError
forall a. Semigroup a => a -> a -> a
<>RegexError
" balances amount "RegexError -> RegexError -> RegexError
forall a. Semigroup a => a -> a -> a
<>Amount -> RegexError
showAmountWithoutCost Amount
b RegexError -> RegexError -> RegexError
forall a. Semigroup a => a -> a -> a
<>RegexError
" of costful posting "RegexError -> RegexError -> RegexError
forall a. Semigroup a => a -> a -> a
<>Amount -> RegexError
showAmount Amount
bRegexError -> RegexError -> RegexError
forall a. Semigroup a => a -> a -> a
<>RegexError
" at precision "RegexError -> RegexError -> RegexError
forall a. Semigroup a => a -> a -> a
<>Amount -> RegexError
dbgShowAmountPrecision Amount
aRegexError -> RegexError -> RegexError
forall a. Semigroup a => a -> a -> a
<>RegexError
" ?")
            dbgcostmatch :: a -> Amount -> Amount -> a -> a
dbgcostmatch a
n Amount
a Amount
b = RegexError -> a -> a
forall a. Show a => RegexError -> a -> a
dbg7 (RegexError
"and\nconversion posting "RegexError -> RegexError -> RegexError
forall a. Semigroup a => a -> a -> a
<>a -> RegexError
forall a. Show a => a -> RegexError
show a
nRegexError -> RegexError -> RegexError
forall a. Semigroup a => a -> a -> a
<>RegexError
" "RegexError -> RegexError -> RegexError
forall a. Semigroup a => a -> a -> a
<>Amount -> RegexError
showAmount Amount
aRegexError -> RegexError -> RegexError
forall a. Semigroup a => a -> a -> a
<>RegexError
" matches cost "   RegexError -> RegexError -> RegexError
forall a. Semigroup a => a -> a -> a
<>Amount -> RegexError
showAmount (Amount -> Amount
amountCost Amount
b)RegexError -> RegexError -> RegexError
forall a. Semigroup a => a -> a -> a
<>RegexError
" of costful posting "RegexError -> RegexError -> RegexError
forall a. Semigroup a => a -> a -> a
<>Amount -> RegexError
showAmount Amount
bRegexError -> RegexError -> RegexError
forall a. Semigroup a => a -> a -> a
<>RegexError
" at precision "RegexError -> RegexError -> RegexError
forall a. Semigroup a => a -> a -> a
<>Amount -> RegexError
dbgShowAmountPrecision Amount
aRegexError -> RegexError -> RegexError
forall 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 a{acost = Just $ TotalCost cost}}
        if
           | Amount -> Amount -> Bool
amountsMatch (-Amount
a1) Amount
a -> (Posting, Amount) -> Maybe (Posting, Amount)
forall a. a -> Maybe a
Just (Amount -> Posting
newp Amount
a2, Amount
a2)
           | Amount -> Amount -> Bool
amountsMatch (-Amount
a2) Amount
a -> (Posting, Amount) -> Maybe (Posting, Amount)
forall a. a -> Maybe a
Just (Amount -> Posting
newp Amount
a1, Amount
a1)
           | Bool
otherwise            -> Maybe (Posting, Amount)
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{acost :: Amount -> Maybe AmountCost
acost=Maybe AmountCost
Nothing} -> Amount -> Either Text Amount
forall a b. b -> Either a b
Right Amount
a
        Just Amount{acost :: Amount -> Maybe AmountCost
acost=Just AmountCost
_} -> Text -> Either Text Amount
forall a b. a -> Either a b
Left (Text -> Either Text Amount) -> Text -> Either Text Amount
forall a b. (a -> b) -> a -> b
$ [Posting] -> Text -> Text
annotateWithPostings [Posting
p] Text
"Conversion postings must not have a cost:"
        Maybe Amount
Nothing                    -> Text -> Either Text Amount
forall a b. a -> Either a b
Left (Text -> Either Text Amount) -> Text -> Either Text Amount
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 (Amount -> Bool) -> Amount -> Bool
forall a b. (a -> b) -> a -> b
$ AmountPrecision -> Amount -> Amount
amountSetPrecision (AmountStyle -> AmountPrecision
asprecision (AmountStyle -> AmountPrecision) -> AmountStyle -> AmountPrecision
forall a b. (a -> b) -> a -> b
$ Amount -> AmountStyle
astyle Amount
a) (Amount -> Amount) -> Amount -> Amount
forall a b. (a -> b) -> a -> b
$ Amount
a Amount -> Amount -> Amount
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 = ((b, b) -> Bool) -> [(b, b)] -> Maybe [(b, b)]
forall {a}. (a -> Bool) -> [a] -> Maybe [a]
deleteUniqueMatch ((b
nb -> b -> Bool
forall a. Eq a => a -> a -> Bool
==) (b -> Bool) -> ((b, b) -> b) -> (b, b) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b, b) -> b
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 (a -> Bool) -> [a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any a -> Bool
p [a]
xs then Maybe [a]
forall a. Maybe a
Nothing else [a] -> Maybe [a]
forall a. a -> Maybe a
Just [a]
xs
                               | Bool
otherwise = (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:) ([a] -> [a]) -> Maybe [a] -> Maybe [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
_ []                 = Maybe [a]
forall a. Maybe a
Nothing
    annotateWithPostings :: [Posting] -> Text -> Text
annotateWithPostings [Posting]
xs Text
str = [Text] -> Text
T.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Text
str Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Bool -> [Posting] -> [Text]
postingsAsLines Bool
False [Posting]
xs

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

-- Given the names of conversion equity accounts, 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 -> [AccountName] -> [IdxPosting] -> Either Text ( [(IdxPosting, IdxPosting)], ([IdxPosting], [IdxPosting]) )
partitionAndCheckConversionPostings :: Bool
-> [Text]
-> [IdxPosting]
-> Either
     Text ([(IdxPosting, IdxPosting)], ([IdxPosting], [IdxPosting]))
partitionAndCheckConversionPostings Bool
check [Text]
conversionaccts =
  -- 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.
  ((([(IdxPosting, IdxPosting)], ([IdxPosting], [IdxPosting])),
  Maybe IdxPosting)
 -> IdxPosting
 -> Either
      Text
      (([(IdxPosting, IdxPosting)], ([IdxPosting], [IdxPosting])),
       Maybe IdxPosting))
-> (([(IdxPosting, IdxPosting)], ([IdxPosting], [IdxPosting])),
    Maybe IdxPosting)
-> [IdxPosting]
-> Either
     Text
     (([(IdxPosting, IdxPosting)], ([IdxPosting], [IdxPosting])),
      Maybe IdxPosting)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM (([(IdxPosting, IdxPosting)], ([IdxPosting], [IdxPosting])),
 Maybe IdxPosting)
-> IdxPosting
-> Either
     Text
     (([(IdxPosting, IdxPosting)], ([IdxPosting], [IdxPosting])),
      Maybe IdxPosting)
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 (([], ([], [])), Maybe IdxPosting
forall a. Maybe a
Nothing)
    -- The costless other postings are somehow reversed still; "second (second reverse)" fixes that.
    ([IdxPosting]
 -> Either
      Text
      (([(IdxPosting, IdxPosting)], ([IdxPosting], [IdxPosting])),
       Maybe IdxPosting))
-> (Either
      Text
      (([(IdxPosting, IdxPosting)], ([IdxPosting], [IdxPosting])),
       Maybe IdxPosting)
    -> Either
         Text ([(IdxPosting, IdxPosting)], ([IdxPosting], [IdxPosting])))
-> [IdxPosting]
-> Either
     Text ([(IdxPosting, IdxPosting)], ([IdxPosting], [IdxPosting]))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ((([(IdxPosting, IdxPosting)], ([IdxPosting], [IdxPosting])),
  Maybe IdxPosting)
 -> ([(IdxPosting, IdxPosting)], ([IdxPosting], [IdxPosting])))
-> Either
     Text
     (([(IdxPosting, IdxPosting)], ([IdxPosting], [IdxPosting])),
      Maybe IdxPosting)
-> Either
     Text ([(IdxPosting, IdxPosting)], ([IdxPosting], [IdxPosting]))
forall a b. (a -> b) -> Either Text a -> Either Text b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((([IdxPosting], [IdxPosting]) -> ([IdxPosting], [IdxPosting]))
-> ([(IdxPosting, IdxPosting)], ([IdxPosting], [IdxPosting]))
-> ([(IdxPosting, IdxPosting)], ([IdxPosting], [IdxPosting]))
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (([IdxPosting] -> [IdxPosting])
-> ([IdxPosting], [IdxPosting]) -> ([IdxPosting], [IdxPosting])
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second [IdxPosting] -> [IdxPosting]
forall a. [a] -> [a]
reverse) (([(IdxPosting, IdxPosting)], ([IdxPosting], [IdxPosting]))
 -> ([(IdxPosting, IdxPosting)], ([IdxPosting], [IdxPosting])))
-> ((([(IdxPosting, IdxPosting)], ([IdxPosting], [IdxPosting])),
     Maybe IdxPosting)
    -> ([(IdxPosting, IdxPosting)], ([IdxPosting], [IdxPosting])))
-> (([(IdxPosting, IdxPosting)], ([IdxPosting], [IdxPosting])),
    Maybe IdxPosting)
-> ([(IdxPosting, IdxPosting)], ([IdxPosting], [IdxPosting]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([(IdxPosting, IdxPosting)], ([IdxPosting], [IdxPosting])),
 Maybe IdxPosting)
-> ([(IdxPosting, IdxPosting)], ([IdxPosting], [IdxPosting]))
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 = (([(a, (a, Posting))], ([(a, Posting)], [(a, Posting)])),
 Maybe (a, Posting))
-> Either
     a
     (([(a, (a, Posting))], ([(a, Posting)], [(a, Posting)])),
      Maybe (a, Posting))
forall a b. b -> Either a b
Right (([(a, (a, Posting))]
cs, ([(a, Posting)], [(a, Posting)])
others),      (a, Posting) -> Maybe (a, Posting)
forall a. a -> Maybe a
Just (a, Posting)
np)
      | Posting -> Bool
hasCost Posting
p      = (([(a, (a, Posting))], ([(a, Posting)], [(a, Posting)])),
 Maybe (a, Posting))
-> Either
     a
     (([(a, (a, Posting))], ([(a, Posting)], [(a, Posting)])),
      Maybe (a, Posting))
forall a b. b -> Either a b
Right (([(a, (a, Posting))]
cs, ((a, Posting)
np(a, Posting) -> [(a, Posting)] -> [(a, Posting)]
forall a. a -> [a] -> [a]
:[(a, Posting)]
ps, [(a, Posting)]
os)), Maybe (a, Posting)
forall a. Maybe a
Nothing)
      | Bool
otherwise      = (([(a, (a, Posting))], ([(a, Posting)], [(a, Posting)])),
 Maybe (a, Posting))
-> Either
     a
     (([(a, (a, Posting))], ([(a, Posting)], [(a, Posting)])),
      Maybe (a, Posting))
forall a b. b -> Either a b
Right (([(a, (a, Posting))]
cs, ([(a, Posting)]
ps, (a, Posting)
np(a, Posting) -> [(a, Posting)] -> [(a, Posting)]
forall a. a -> [a] -> [a]
:[(a, Posting)]
os)), Maybe (a, Posting)
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 = (([(a, (a, Posting))], ([(a, Posting)], [(a, Posting)])),
 Maybe (a, Posting))
-> Either
     a
     (([(a, (a, Posting))], ([(a, Posting)], [(a, Posting)])),
      Maybe (a, Posting))
forall a b. b -> Either a b
Right (((a
lst, (a, Posting)
np)(a, (a, Posting)) -> [(a, (a, Posting))] -> [(a, (a, Posting))]
forall a. a -> [a] -> [a]
:[(a, (a, Posting))]
cs, ([(a, Posting)], [(a, Posting)])
others), Maybe (a, Posting)
forall a. Maybe a
Nothing)
      | Bool
check          = a
-> Either
     a
     (([(a, (a, Posting))], ([(a, Posting)], [(a, Posting)])),
      Maybe (a, Posting))
forall a b. a -> Either a b
Left a
"Conversion postings must occur in adjacent pairs"
      | Bool
otherwise      = (([(a, (a, Posting))], ([(a, Posting)], [(a, Posting)])),
 Maybe (a, Posting))
-> Either
     a
     (([(a, (a, Posting))], ([(a, Posting)], [(a, Posting)])),
      Maybe (a, Posting))
forall a b. b -> Either a b
Right (([(a, (a, Posting))]
cs, ([(a, Posting)]
ps, (a, Posting)
np(a, Posting) -> [(a, Posting)] -> [(a, Posting)]
forall a. a -> [a] -> [a]
:[(a, Posting)]
os)), Maybe (a, Posting)
forall a. Maybe a
Nothing)
    isConversion :: Posting -> Bool
isConversion Posting
p = Posting -> Text
paccount Posting
p Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
conversionaccts
    hasCost :: Posting -> Bool
hasCost Posting
p = Maybe AmountCost -> Bool
forall a. Maybe a -> Bool
isJust (Maybe AmountCost -> Bool) -> Maybe AmountCost -> Bool
forall a b. (a -> b) -> a -> b
$ Amount -> Maybe AmountCost
acost (Amount -> Maybe AmountCost) -> Maybe Amount -> Maybe AmountCost
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] -> Amount -> Maybe Amount
forall a. a -> Maybe a
Just Amount
a
  [Amount]
_   -> Maybe 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 (Posting -> Either RegexError Posting)
-> [Posting] -> Either RegexError [Posting]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ([AccountAlias] -> Posting -> Either RegexError Posting
postingApplyAliases [AccountAlias]
aliases) ([Posting] -> Either RegexError [Posting])
-> [Posting] -> Either RegexError [Posting]
forall a b. (a -> b) -> a -> b
$ Transaction -> [Posting]
tpostings Transaction
t of
    Right [Posting]
ps -> Transaction -> Either RegexError Transaction
forall a b. b -> Either a b
Right (Transaction -> Either RegexError Transaction)
-> Transaction -> Either RegexError Transaction
forall a b. (a -> b) -> a -> b
$ Transaction -> Transaction
txnTieKnot (Transaction -> Transaction) -> Transaction -> Transaction
forall a b. (a -> b) -> a -> b
$ Transaction
t{tpostings=ps}
    Left RegexError
err -> RegexError -> Either RegexError Transaction
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=map f 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 transaction, in order.
transactionAmounts :: Transaction -> [MixedAmount]
transactionAmounts :: Transaction -> [MixedAmount]
transactionAmounts = (Posting -> MixedAmount) -> [Posting] -> [MixedAmount]
forall a b. (a -> b) -> [a] -> [b]
map Posting -> MixedAmount
pamount ([Posting] -> [MixedAmount])
-> (Transaction -> [Posting]) -> Transaction -> [MixedAmount]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> [Posting]
tpostings

-- | Flip the sign of this transaction's posting amounts (and balance assertion amounts).
transactionNegate :: Transaction -> Transaction
transactionNegate :: Transaction -> Transaction
transactionNegate = (Posting -> Posting) -> Transaction -> Transaction
transactionMapPostings Posting -> Posting
postingNegate

-- | The file path from which this transaction was parsed.
transactionFile :: Transaction -> FilePath
transactionFile :: Transaction -> RegexError
transactionFile Transaction{(SourcePos, SourcePos)
tsourcepos :: Transaction -> (SourcePos, SourcePos)
tsourcepos :: (SourcePos, SourcePos)
tsourcepos} = SourcePos -> RegexError
sourceName (SourcePos -> RegexError) -> SourcePos -> RegexError
forall a b. (a -> b) -> a -> b
$ (SourcePos, SourcePos) -> SourcePos
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 ((SourcePos, SourcePos) -> RegexError)
-> (SourcePos, SourcePos) -> RegexError
forall a b. (a -> b) -> a -> b
$ Transaction -> (SourcePos, SourcePos)
tsourcepos Transaction
t, RegexError
s
          , Text -> RegexError
T.unpack (Text -> RegexError) -> (Text -> Text) -> Text -> RegexError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.stripEnd (Text -> RegexError) -> Text -> RegexError
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" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ Posting -> [Text]
showPostingLines Posting
nullposting [Text] -> [Text] -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= [Text
"                   0"]
        , RegexError -> Assertion -> TestTree
testCase RegexError
"non-null posting" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
           let p :: Posting
p =
                Posting
posting
                  { pstatus = Cleared
                  , paccount = "a"
                  , pamount = mixed [usd 1, hrs 2]
                  , pcomment = "pcomment1\npcomment2\n  tag3: val3  \n"
                  , ptype = RegularPosting
                  , ptags = [("ptag1", "val1"), ("ptag2", "val2")]
                  }
           in Posting -> [Text]
showPostingLines Posting
p [Text] -> [Text] -> Assertion
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 = ["a" `post` usd 1, "b" `post` missingamt]}
        -- explicit amounts, balanced
        texp :: Transaction
texp = Transaction
nulltransaction {tpostings = ["a" `post` usd 1, "b" `post` usd (-1)]}
        -- explicit amount, only one posting
        texp1 :: Transaction
texp1 = Transaction
nulltransaction {tpostings = ["(a)" `post` usd 1]}
        -- explicit amounts, two commodities, explicit balancing price
        texp2 :: Transaction
texp2 = Transaction
nulltransaction {tpostings = ["a" `post` usd 1, "b" `post` (hrs (-1) `at` usd 1)]}
        -- explicit amounts, two commodities, implicit balancing price
        texp2b :: Transaction
texp2b = Transaction
nulltransaction {tpostings = ["a" `post` usd 1, "b" `post` hrs (-1)]}
        -- one missing amount, not the last one
        t3 :: Transaction
t3 = Transaction
nulltransaction {tpostings = ["a" `post` usd 1, "b" `post` missingamt, "c" `post` usd (-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" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ Bool -> [Posting] -> [Text]
postingsAsLines Bool
False (Transaction -> [Posting]
tpostings Transaction
nulltransaction) [Text] -> [Text] -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= []
            , RegexError -> Assertion -> TestTree
testCase RegexError
"implicit-amount" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ Bool -> [Posting] -> [Text]
postingsAsLines Bool
False (Transaction -> [Posting]
tpostings Transaction
timp) [Text] -> [Text] -> Assertion
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" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ Bool -> [Posting] -> [Text]
postingsAsLines Bool
False (Transaction -> [Posting]
tpostings Transaction
texp) [Text] -> [Text] -> Assertion
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" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ Bool -> [Posting] -> [Text]
postingsAsLines Bool
False (Transaction -> [Posting]
tpostings Transaction
texp1) [Text] -> [Text] -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
                  [ Text
"    (a)           $1.00"
                  ]
            , RegexError -> Assertion -> TestTree
testCase RegexError
"explicit-amounts-two-commodities" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ Bool -> [Posting] -> [Text]
postingsAsLines Bool
False (Transaction -> [Posting]
tpostings Transaction
texp2) [Text] -> [Text] -> Assertion
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" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ Bool -> [Posting] -> [Text]
postingsAsLines Bool
False (Transaction -> [Posting]
tpostings Transaction
texp2b) [Text] -> [Text] -> Assertion
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" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ Bool -> [Posting] -> [Text]
postingsAsLines Bool
False (Transaction -> [Posting]
tpostings Transaction
t3) [Text] -> [Text] -> Assertion
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" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ Transaction -> Text
showTransaction Transaction
nulltransaction Text -> Text -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Text
"0000-01-01\n\n"
        , RegexError -> Assertion -> TestTree
testCase RegexError
"non-null transaction" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ Transaction -> Text
showTransaction
            Transaction
nulltransaction
              { tdate = fromGregorian 2012 05 14
              , tdate2 = Just $ fromGregorian 2012 05 15
              , tstatus = Unmarked
              , tcode = "code"
              , tdescription = "desc"
              , tcomment = "tcomment1\ntcomment2\n"
              , ttags = [("ttag1", "val1")]
              , tpostings =
                  [ nullposting
                      { pstatus = Cleared
                      , paccount = "a"
                      , pamount = mixed [usd 1, hrs 2]
                      , pcomment = "\npcomment2\n"
                      , ptype = RegularPosting
                      , ptags = [("ptag1", "val1"), ("ptag2", "val2")]
                      }
                  ]
              } Text -> Text -> Assertion
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" (Assertion -> TestTree) -> Assertion -> TestTree
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)
nullsourcepospair
                   (Integer -> Int -> Int -> Day
fromGregorian Integer
2007 Int
01 Int
28)
                   Maybe Day
forall a. Maybe a
Nothing
                   Status
Unmarked
                   Text
""
                   Text
"coopportunity"
                   Text
""
                   []
                   [ Posting
posting {paccount = "expenses:food:groceries", pamount = mixedAmount (usd 47.18), ptransaction = Just t}
                   , Posting
posting {paccount = "assets:checking", pamount = mixedAmount (usd (-47.18)), ptransaction = Just t}
                   ]
            in Transaction -> Text
showTransaction Transaction
t) Text -> Text -> Assertion
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" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
          (Transaction -> Text
showTransaction
             (Transaction -> Transaction
txnTieKnot (Transaction -> Transaction) -> Transaction -> Transaction
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)
nullsourcepospair
                (Integer -> Int -> Int -> Day
fromGregorian Integer
2007 Int
01 Int
28)
                Maybe Day
forall a. Maybe a
Nothing
                Status
Unmarked
                Text
""
                Text
"coopportunity"
                Text
""
                []
                [ Posting
posting {paccount = "expenses:food:groceries", pamount = mixedAmount (usd 47.18)}
                , Posting
posting {paccount = "assets:checking", pamount = mixedAmount (usd (-47.19))}
                ])) Text -> Text -> Assertion
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" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
          (Transaction -> Text
showTransaction
             (Transaction -> Transaction
txnTieKnot (Transaction -> Transaction) -> Transaction -> Transaction
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)
nullsourcepospair
                (Integer -> Int -> Int -> Day
fromGregorian Integer
2007 Int
01 Int
28)
                Maybe Day
forall a. Maybe a
Nothing
                Status
Unmarked
                Text
""
                Text
"coopportunity"
                Text
""
                []
                [Posting
posting {paccount = "expenses:food:groceries", pamount = missingmixedamt}])) Text -> Text -> Assertion
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" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
          (Transaction -> Text
showTransaction
             (Transaction -> Transaction
txnTieKnot (Transaction -> Transaction) -> Transaction -> Transaction
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)
nullsourcepospair
                (Integer -> Int -> Int -> Day
fromGregorian Integer
2010 Int
01 Int
01)
                Maybe Day
forall a. Maybe a
Nothing
                Status
Unmarked
                Text
""
                Text
"x"
                Text
""
                []
                [ Posting
posting {paccount = "a", pamount = mixedAmount $ num 1 `at` (usd 2 `withPrecision` Precision 0)}
                , Posting
posting {paccount = "b", pamount = missingmixedamt}
                ])) Text -> Text -> Assertion
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
""])
        ]
    ]