{-|

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
, transactionCommodityStyles
, transactionCommodityStylesWith
, transactionNegate
, partitionAndCheckConversionPostings
, transactionAddTags
, transactionAddHiddenAndMaybeVisibleTag
  -- * helpers
, TransactionBalancingPrecision(..)
, 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)


-- | How to determine the precision used for checking that transactions are balanced. See #2402.
data TransactionBalancingPrecision =
    TBPOld
    -- ^ Legacy behaviour, as in hledger <1.50, included to ease upgrades.
    -- use precision inferred from the whole journal, overridable by commodity directive or -c.
    -- Display precision is also transaction balancing precision; increasing it can break journal reading.
    -- Some valid journals are rejected until commodity directives are added.
    -- Small unbalanced remainders can be hidden, and in accounts that are never reconciled, can accumulate over time.
  | TBPExact
    -- ^ Simpler, more robust behaviour, as in Ledger: use precision inferred from the transaction.
    -- Display precision and transaction balancing precision are independent; display precision never affects journal reading.
    -- Valid journals from ledger or beancount are accepted without needing commodity directives.
    -- Every imbalance in a transaction is visibly accounted for in that transaction's journal entry.

  deriving (TransactionBalancingPrecision
TransactionBalancingPrecision
-> TransactionBalancingPrecision
-> Bounded TransactionBalancingPrecision
forall a. a -> a -> Bounded a
$cminBound :: TransactionBalancingPrecision
minBound :: TransactionBalancingPrecision
$cmaxBound :: TransactionBalancingPrecision
maxBound :: TransactionBalancingPrecision
Bounded, Int -> TransactionBalancingPrecision
TransactionBalancingPrecision -> Int
TransactionBalancingPrecision -> [TransactionBalancingPrecision]
TransactionBalancingPrecision -> TransactionBalancingPrecision
TransactionBalancingPrecision
-> TransactionBalancingPrecision -> [TransactionBalancingPrecision]
TransactionBalancingPrecision
-> TransactionBalancingPrecision
-> TransactionBalancingPrecision
-> [TransactionBalancingPrecision]
(TransactionBalancingPrecision -> TransactionBalancingPrecision)
-> (TransactionBalancingPrecision -> TransactionBalancingPrecision)
-> (Int -> TransactionBalancingPrecision)
-> (TransactionBalancingPrecision -> Int)
-> (TransactionBalancingPrecision
    -> [TransactionBalancingPrecision])
-> (TransactionBalancingPrecision
    -> TransactionBalancingPrecision
    -> [TransactionBalancingPrecision])
-> (TransactionBalancingPrecision
    -> TransactionBalancingPrecision
    -> [TransactionBalancingPrecision])
-> (TransactionBalancingPrecision
    -> TransactionBalancingPrecision
    -> TransactionBalancingPrecision
    -> [TransactionBalancingPrecision])
-> Enum TransactionBalancingPrecision
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: TransactionBalancingPrecision -> TransactionBalancingPrecision
succ :: TransactionBalancingPrecision -> TransactionBalancingPrecision
$cpred :: TransactionBalancingPrecision -> TransactionBalancingPrecision
pred :: TransactionBalancingPrecision -> TransactionBalancingPrecision
$ctoEnum :: Int -> TransactionBalancingPrecision
toEnum :: Int -> TransactionBalancingPrecision
$cfromEnum :: TransactionBalancingPrecision -> Int
fromEnum :: TransactionBalancingPrecision -> Int
$cenumFrom :: TransactionBalancingPrecision -> [TransactionBalancingPrecision]
enumFrom :: TransactionBalancingPrecision -> [TransactionBalancingPrecision]
$cenumFromThen :: TransactionBalancingPrecision
-> TransactionBalancingPrecision -> [TransactionBalancingPrecision]
enumFromThen :: TransactionBalancingPrecision
-> TransactionBalancingPrecision -> [TransactionBalancingPrecision]
$cenumFromTo :: TransactionBalancingPrecision
-> TransactionBalancingPrecision -> [TransactionBalancingPrecision]
enumFromTo :: TransactionBalancingPrecision
-> TransactionBalancingPrecision -> [TransactionBalancingPrecision]
$cenumFromThenTo :: TransactionBalancingPrecision
-> TransactionBalancingPrecision
-> TransactionBalancingPrecision
-> [TransactionBalancingPrecision]
enumFromThenTo :: TransactionBalancingPrecision
-> TransactionBalancingPrecision
-> TransactionBalancingPrecision
-> [TransactionBalancingPrecision]
Enum, TransactionBalancingPrecision
-> TransactionBalancingPrecision -> Bool
(TransactionBalancingPrecision
 -> TransactionBalancingPrecision -> Bool)
-> (TransactionBalancingPrecision
    -> TransactionBalancingPrecision -> Bool)
-> Eq TransactionBalancingPrecision
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TransactionBalancingPrecision
-> TransactionBalancingPrecision -> Bool
== :: TransactionBalancingPrecision
-> TransactionBalancingPrecision -> Bool
$c/= :: TransactionBalancingPrecision
-> TransactionBalancingPrecision -> Bool
/= :: TransactionBalancingPrecision
-> TransactionBalancingPrecision -> Bool
Eq, Eq TransactionBalancingPrecision
Eq TransactionBalancingPrecision =>
(TransactionBalancingPrecision
 -> TransactionBalancingPrecision -> Ordering)
-> (TransactionBalancingPrecision
    -> TransactionBalancingPrecision -> Bool)
-> (TransactionBalancingPrecision
    -> TransactionBalancingPrecision -> Bool)
-> (TransactionBalancingPrecision
    -> TransactionBalancingPrecision -> Bool)
-> (TransactionBalancingPrecision
    -> TransactionBalancingPrecision -> Bool)
-> (TransactionBalancingPrecision
    -> TransactionBalancingPrecision -> TransactionBalancingPrecision)
-> (TransactionBalancingPrecision
    -> TransactionBalancingPrecision -> TransactionBalancingPrecision)
-> Ord TransactionBalancingPrecision
TransactionBalancingPrecision
-> TransactionBalancingPrecision -> Bool
TransactionBalancingPrecision
-> TransactionBalancingPrecision -> Ordering
TransactionBalancingPrecision
-> TransactionBalancingPrecision -> TransactionBalancingPrecision
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TransactionBalancingPrecision
-> TransactionBalancingPrecision -> Ordering
compare :: TransactionBalancingPrecision
-> TransactionBalancingPrecision -> Ordering
$c< :: TransactionBalancingPrecision
-> TransactionBalancingPrecision -> Bool
< :: TransactionBalancingPrecision
-> TransactionBalancingPrecision -> Bool
$c<= :: TransactionBalancingPrecision
-> TransactionBalancingPrecision -> Bool
<= :: TransactionBalancingPrecision
-> TransactionBalancingPrecision -> Bool
$c> :: TransactionBalancingPrecision
-> TransactionBalancingPrecision -> Bool
> :: TransactionBalancingPrecision
-> TransactionBalancingPrecision -> Bool
$c>= :: TransactionBalancingPrecision
-> TransactionBalancingPrecision -> Bool
>= :: TransactionBalancingPrecision
-> TransactionBalancingPrecision -> Bool
$cmax :: TransactionBalancingPrecision
-> TransactionBalancingPrecision -> TransactionBalancingPrecision
max :: TransactionBalancingPrecision
-> TransactionBalancingPrecision -> TransactionBalancingPrecision
$cmin :: TransactionBalancingPrecision
-> TransactionBalancingPrecision -> TransactionBalancingPrecision
min :: TransactionBalancingPrecision
-> TransactionBalancingPrecision -> TransactionBalancingPrecision
Ord, ReadPrec [TransactionBalancingPrecision]
ReadPrec TransactionBalancingPrecision
Int -> ReadS TransactionBalancingPrecision
ReadS [TransactionBalancingPrecision]
(Int -> ReadS TransactionBalancingPrecision)
-> ReadS [TransactionBalancingPrecision]
-> ReadPrec TransactionBalancingPrecision
-> ReadPrec [TransactionBalancingPrecision]
-> Read TransactionBalancingPrecision
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS TransactionBalancingPrecision
readsPrec :: Int -> ReadS TransactionBalancingPrecision
$creadList :: ReadS [TransactionBalancingPrecision]
readList :: ReadS [TransactionBalancingPrecision]
$creadPrec :: ReadPrec TransactionBalancingPrecision
readPrec :: ReadPrec TransactionBalancingPrecision
$creadListPrec :: ReadPrec [TransactionBalancingPrecision]
readListPrec :: ReadPrec [TransactionBalancingPrecision]
Read, Int -> TransactionBalancingPrecision -> ShowS
[TransactionBalancingPrecision] -> ShowS
TransactionBalancingPrecision -> RegexError
(Int -> TransactionBalancingPrecision -> ShowS)
-> (TransactionBalancingPrecision -> RegexError)
-> ([TransactionBalancingPrecision] -> ShowS)
-> Show TransactionBalancingPrecision
forall a.
(Int -> a -> ShowS)
-> (a -> RegexError) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TransactionBalancingPrecision -> ShowS
showsPrec :: Int -> TransactionBalancingPrecision -> ShowS
$cshow :: TransactionBalancingPrecision -> RegexError
show :: TransactionBalancingPrecision -> RegexError
$cshowList :: [TransactionBalancingPrecision] -> ShowS
showList :: [TransactionBalancingPrecision] -> ShowS
Show)

instance HasAmounts Transaction where
  styleAmounts :: Map CommoditySymbol AmountStyle -> Transaction -> Transaction
styleAmounts Map CommoditySymbol 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 :: CommoditySymbol
tcode=CommoditySymbol
"",
                    tdescription :: CommoditySymbol
tdescription=CommoditySymbol
"",
                    tcomment :: CommoditySymbol
tcomment=CommoditySymbol
"",
                    ttags :: [Tag]
ttags=[],
                    tpostings :: [Posting]
tpostings=[],
                    tprecedingcomment :: CommoditySymbol
tprecedingcomment=CommoditySymbol
""
                  }

-- | 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 -> CommoditySymbol
transactionPayee = Tag -> CommoditySymbol
forall a b. (a, b) -> a
fst (Tag -> CommoditySymbol)
-> (Transaction -> Tag) -> Transaction -> CommoditySymbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommoditySymbol -> Tag
payeeAndNoteFromDescription (CommoditySymbol -> Tag)
-> (Transaction -> CommoditySymbol) -> Transaction -> Tag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> CommoditySymbol
tdescription

transactionNote :: Transaction -> Text
transactionNote :: Transaction -> CommoditySymbol
transactionNote = Tag -> CommoditySymbol
forall a b. (a, b) -> b
snd (Tag -> CommoditySymbol)
-> (Transaction -> Tag) -> Transaction -> CommoditySymbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommoditySymbol -> Tag
payeeAndNoteFromDescription (CommoditySymbol -> Tag)
-> (Transaction -> CommoditySymbol) -> Transaction -> Tag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> CommoditySymbol
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 :: CommoditySymbol -> Tag
payeeAndNoteFromDescription CommoditySymbol
t
  | CommoditySymbol -> Bool
T.null CommoditySymbol
n = (CommoditySymbol
t, CommoditySymbol
t)
  | Bool
otherwise = (CommoditySymbol -> CommoditySymbol
T.strip CommoditySymbol
p, CommoditySymbol -> CommoditySymbol
T.strip (CommoditySymbol -> CommoditySymbol)
-> CommoditySymbol -> CommoditySymbol
forall a b. (a -> b) -> a -> b
$ Int -> CommoditySymbol -> CommoditySymbol
T.drop Int
1 CommoditySymbol
n)
  where
    (CommoditySymbol
p, CommoditySymbol
n) = (Char -> Bool) -> CommoditySymbol -> Tag
T.span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'|') CommoditySymbol
t

-- | Like payeeAndNoteFromDescription, but if there's no | then payee is empty.
payeeAndNoteFromDescription' :: Text -> (Text,Text)
payeeAndNoteFromDescription' :: CommoditySymbol -> Tag
payeeAndNoteFromDescription' CommoditySymbol
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) -> CommoditySymbol -> Maybe Char
T.find (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'|') CommoditySymbol
t then CommoditySymbol -> Tag
payeeAndNoteFromDescription CommoditySymbol
t else (CommoditySymbol
"",CommoditySymbol
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 -> CommoditySymbol
showTransaction = LazyText -> CommoditySymbol
TL.toStrict (LazyText -> CommoditySymbol)
-> (Transaction -> LazyText) -> Transaction -> CommoditySymbol
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 -> CommoditySymbol
showTransactionOneLineAmounts = LazyText -> CommoditySymbol
TL.toStrict (LazyText -> CommoditySymbol)
-> (Transaction -> LazyText) -> Transaction -> CommoditySymbol
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 =
      CommoditySymbol -> Builder
TB.fromText CommoditySymbol
descriptionline Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
newline
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (CommoditySymbol -> Builder) -> [CommoditySymbol] -> 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)
-> (CommoditySymbol -> Builder) -> CommoditySymbol -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommoditySymbol -> Builder
TB.fromText) [CommoditySymbol]
newlinecomments
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (CommoditySymbol -> Builder) -> [CommoditySymbol] -> 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)
-> (CommoditySymbol -> Builder) -> CommoditySymbol -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommoditySymbol -> Builder
TB.fromText) (Bool -> [Posting] -> [CommoditySymbol]
postingsAsLines Bool
onelineamounts ([Posting] -> [CommoditySymbol]) -> [Posting] -> [CommoditySymbol]
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 :: CommoditySymbol
descriptionline = CommoditySymbol -> CommoditySymbol
T.stripEnd (CommoditySymbol -> CommoditySymbol)
-> CommoditySymbol -> CommoditySymbol
forall a b. (a -> b) -> a -> b
$ Transaction -> CommoditySymbol
showTransactionLineFirstPart Transaction
t CommoditySymbol -> CommoditySymbol -> CommoditySymbol
forall a. Semigroup a => a -> a -> a
<> [CommoditySymbol] -> CommoditySymbol
T.concat [CommoditySymbol
desc, CommoditySymbol
samelinecomment]
    desc :: CommoditySymbol
desc = if CommoditySymbol -> Bool
T.null CommoditySymbol
d then CommoditySymbol
"" else CommoditySymbol
" " CommoditySymbol -> CommoditySymbol -> CommoditySymbol
forall a. Semigroup a => a -> a -> a
<> CommoditySymbol
d where d :: CommoditySymbol
d = Transaction -> CommoditySymbol
tdescription Transaction
t
    (CommoditySymbol
samelinecomment, [CommoditySymbol]
newlinecomments) =
      case CommoditySymbol -> [CommoditySymbol]
renderCommentLines (Transaction -> CommoditySymbol
tcomment Transaction
t) of []   -> (CommoditySymbol
"",[])
                                              CommoditySymbol
c:[CommoditySymbol]
cs -> (CommoditySymbol
c,[CommoditySymbol]
cs)
    newline :: Builder
newline = Char -> Builder
TB.singleton Char
'\n'

-- Useful when rendering error messages.
showTransactionLineFirstPart :: Transaction -> CommoditySymbol
showTransactionLineFirstPart Transaction
t = [CommoditySymbol] -> CommoditySymbol
T.concat [CommoditySymbol
date, CommoditySymbol
status, CommoditySymbol
code]
  where
    date :: CommoditySymbol
date = Day -> CommoditySymbol
showDate (Transaction -> Day
tdate Transaction
t) CommoditySymbol -> CommoditySymbol -> CommoditySymbol
forall a. Semigroup a => a -> a -> a
<> CommoditySymbol
-> (Day -> CommoditySymbol) -> Maybe Day -> CommoditySymbol
forall b a. b -> (a -> b) -> Maybe a -> b
maybe CommoditySymbol
"" ((CommoditySymbol
"="CommoditySymbol -> CommoditySymbol -> CommoditySymbol
forall a. Semigroup a => a -> a -> a
<>) (CommoditySymbol -> CommoditySymbol)
-> (Day -> CommoditySymbol) -> Day -> CommoditySymbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> CommoditySymbol
showDate) (Transaction -> Maybe Day
tdate2 Transaction
t)
    status :: CommoditySymbol
status | Transaction -> Status
tstatus Transaction
t Status -> Status -> Bool
forall a. Eq a => a -> a -> Bool
== Status
Cleared = CommoditySymbol
" *"
           | Transaction -> Status
tstatus Transaction
t Status -> Status -> Bool
forall a. Eq a => a -> a -> Bool
== Status
Pending = CommoditySymbol
" !"
           | Bool
otherwise            = CommoditySymbol
""
    code :: CommoditySymbol
code = if CommoditySymbol -> Bool
T.null (Transaction -> CommoditySymbol
tcode Transaction
t) then CommoditySymbol
"" else CommoditySymbol
-> CommoditySymbol -> CommoditySymbol -> CommoditySymbol
wrap CommoditySymbol
" (" CommoditySymbol
")" (CommoditySymbol -> CommoditySymbol)
-> CommoditySymbol -> CommoditySymbol
forall a b. (a -> b) -> a -> b
$ Transaction -> CommoditySymbol
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 CommoditySymbol AmountStyle
-> Day
-> Day
-> ValuationType
-> Transaction
-> Transaction
transactionApplyValuation PriceOracle
priceoracle Map CommoditySymbol AmountStyle
styles Day
periodlast Day
today ValuationType
v =
  (Posting -> Posting) -> Transaction -> Transaction
transactionTransformPostings (PriceOracle
-> Map CommoditySymbol AmountStyle
-> Day
-> Day
-> ValuationType
-> Posting
-> Posting
postingApplyValuation PriceOracle
priceoracle Map CommoditySymbol 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 -> CommoditySymbol -> Transaction -> Transaction
transactionInferEquityPostings Bool
verbosetags CommoditySymbol
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 -> ShowS
label RegexError
s = ((RegexError
s RegexError -> ShowS
forall a. Semigroup a => a -> a -> a
<> RegexError
": ")RegexError -> ShowS
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 -> CommoditySymbol
tcomment=CommoditySymbol
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@(CommoditySymbol
vname,CommoditySymbol
_) = Tag -> Tag
toVisibleTag Tag
ht
    hadtag :: Bool
hadtag = (Tag -> Bool) -> [Tag] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((CommoditySymbol -> CommoditySymbol -> Bool
forall a. Eq a => a -> a -> Bool
== (CommoditySymbol -> CommoditySymbol
T.toLower CommoditySymbol
vname)) (CommoditySymbol -> Bool)
-> (Tag -> CommoditySymbol) -> Tag -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommoditySymbol -> CommoditySymbol
T.toLower (CommoditySymbol -> CommoditySymbol)
-> (Tag -> CommoditySymbol) -> Tag -> CommoditySymbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tag -> CommoditySymbol
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
-> [CommoditySymbol]
-> Transaction
-> Either RegexError Transaction
transactionTagCostsAndEquityAndMaybeInferCosts Bool
verbosetags1 Bool
addcosts [CommoditySymbol]
conversionaccts Transaction
t = (CommoditySymbol -> RegexError)
-> Either CommoditySymbol 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 -> ShowS
annotateErrorWithTransaction Transaction
t ShowS
-> (CommoditySymbol -> RegexError) -> CommoditySymbol -> RegexError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommoditySymbol -> RegexError
T.unpack) (Either CommoditySymbol Transaction
 -> Either RegexError Transaction)
-> Either CommoditySymbol 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
-> [CommoditySymbol]
-> [IdxPosting]
-> Either
     CommoditySymbol
     ([(IdxPosting, IdxPosting)], ([IdxPosting], [IdxPosting]))
partitionAndCheckConversionPostings Bool
False [CommoditySymbol]
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 CommoditySymbol)
      (IdxPosting -> IdxPosting))
-> [(IdxPosting, IdxPosting)]
-> ([IdxPosting], [IdxPosting])
-> Either CommoditySymbol (IdxPosting -> IdxPosting)
transformIndexedPostingsF (Bool
-> Bool
-> (IdxPosting, IdxPosting)
-> StateT
     ([IdxPosting], [IdxPosting])
     (Either CommoditySymbol)
     (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 CommoditySymbol Transaction
forall a. a -> Either CommoditySymbol 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 CommoditySymbol)
      (IdxPosting -> IdxPosting))
-> [(IdxPosting, IdxPosting)]
-> ([IdxPosting], [IdxPosting])
-> Either CommoditySymbol (IdxPosting -> IdxPosting)
transformIndexedPostingsF (IdxPosting, IdxPosting)
-> StateT
     ([IdxPosting], [IdxPosting])
     (Either CommoditySymbol)
     (IdxPosting -> IdxPosting)
updatefn = StateT
  ([IdxPosting], [IdxPosting])
  (Either CommoditySymbol)
  (IdxPosting -> IdxPosting)
-> ([IdxPosting], [IdxPosting])
-> Either CommoditySymbol (IdxPosting -> IdxPosting)
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (StateT
   ([IdxPosting], [IdxPosting])
   (Either CommoditySymbol)
   (IdxPosting -> IdxPosting)
 -> ([IdxPosting], [IdxPosting])
 -> Either CommoditySymbol (IdxPosting -> IdxPosting))
-> ([(IdxPosting, IdxPosting)]
    -> StateT
         ([IdxPosting], [IdxPosting])
         (Either CommoditySymbol)
         (IdxPosting -> IdxPosting))
-> [(IdxPosting, IdxPosting)]
-> ([IdxPosting], [IdxPosting])
-> Either CommoditySymbol (IdxPosting -> IdxPosting)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([IdxPosting -> IdxPosting] -> IdxPosting -> IdxPosting)
-> StateT
     ([IdxPosting], [IdxPosting])
     (Either CommoditySymbol)
     [IdxPosting -> IdxPosting]
-> StateT
     ([IdxPosting], [IdxPosting])
     (Either CommoditySymbol)
     (IdxPosting -> IdxPosting)
forall a b.
(a -> b)
-> StateT ([IdxPosting], [IdxPosting]) (Either CommoditySymbol) a
-> StateT ([IdxPosting], [IdxPosting]) (Either CommoditySymbol) 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 CommoditySymbol)
   [IdxPosting -> IdxPosting]
 -> StateT
      ([IdxPosting], [IdxPosting])
      (Either CommoditySymbol)
      (IdxPosting -> IdxPosting))
-> ([(IdxPosting, IdxPosting)]
    -> StateT
         ([IdxPosting], [IdxPosting])
         (Either CommoditySymbol)
         [IdxPosting -> IdxPosting])
-> [(IdxPosting, IdxPosting)]
-> StateT
     ([IdxPosting], [IdxPosting])
     (Either CommoditySymbol)
     (IdxPosting -> IdxPosting)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((IdxPosting, IdxPosting)
 -> StateT
      ([IdxPosting], [IdxPosting])
      (Either CommoditySymbol)
      (IdxPosting -> IdxPosting))
-> [(IdxPosting, IdxPosting)]
-> StateT
     ([IdxPosting], [IdxPosting])
     (Either CommoditySymbol)
     [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 CommoditySymbol)
     (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 CommoditySymbol)
     (IdxPosting -> IdxPosting)
tagAndMaybeAddCostsForEquityPostings Bool
verbosetags Bool
addcosts' ((Int
n1, Posting
cp1), (Int
n2, Posting
cp2)) = (([IdxPosting], [IdxPosting])
 -> Either
      CommoditySymbol
      (IdxPosting -> IdxPosting, ([IdxPosting], [IdxPosting])))
-> StateT
     ([IdxPosting], [IdxPosting])
     (Either CommoditySymbol)
     (IdxPosting -> IdxPosting)
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((([IdxPosting], [IdxPosting])
  -> Either
       CommoditySymbol
       (IdxPosting -> IdxPosting, ([IdxPosting], [IdxPosting])))
 -> StateT
      ([IdxPosting], [IdxPosting])
      (Either CommoditySymbol)
      (IdxPosting -> IdxPosting))
-> (([IdxPosting], [IdxPosting])
    -> Either
         CommoditySymbol
         (IdxPosting -> IdxPosting, ([IdxPosting], [IdxPosting])))
-> StateT
     ([IdxPosting], [IdxPosting])
     (Either CommoditySymbol)
     (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 CommoditySymbol Amount
conversionPostingAmountNoCost Posting
cp1
      Amount
ca2 <- Posting -> Either CommoditySymbol 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. (a -> RegexError) -> a -> a
dbg7With (RegexError -> ShowS
label RegexError
"matched costful postings"ShowS -> ([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. (a -> RegexError) -> a -> a
dbg7With (RegexError -> ShowS
label RegexError
"matched costless postings"ShowS
-> ([(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 (CommoditySymbol
costPostingTagName,CommoditySymbol
"")        -- 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 (CommoditySymbol
conversionPostingTagName,CommoditySymbol
"")  -- if it's one of the equity conversion postings, tag it
                 | Bool
otherwise          -> Posting
p)

      -- Annotate any errors with the conversion posting pair
      (CommoditySymbol -> CommoditySymbol)
-> Either
     CommoditySymbol
     (IdxPosting -> IdxPosting, ([IdxPosting], [IdxPosting]))
-> Either
     CommoditySymbol
     (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] -> CommoditySymbol -> CommoditySymbol
annotateWithPostings [Posting
cp1, Posting
cp2]) (Either
   CommoditySymbol
   (IdxPosting -> IdxPosting, ([IdxPosting], [IdxPosting]))
 -> Either
      CommoditySymbol
      (IdxPosting -> IdxPosting, ([IdxPosting], [IdxPosting])))
-> Either
     CommoditySymbol
     (IdxPosting -> IdxPosting, ([IdxPosting], [IdxPosting]))
-> Either
     CommoditySymbol
     (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
     CommoditySymbol
     (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
     CommoditySymbol
     (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
     CommoditySymbol
     (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 -> ShowS
forall a. Semigroup a => a -> a -> a
<>a -> RegexError
forall a. Show a => a -> RegexError
show a
nRegexError -> ShowS
forall a. Semigroup a => a -> a -> a
<>RegexError
" "RegexError -> ShowS
forall a. Semigroup a => a -> a -> a
<>Amount -> RegexError
showAmount Amount
aRegexError -> ShowS
forall a. Semigroup a => a -> a -> a
<>RegexError
" balances amount "RegexError -> ShowS
forall a. Semigroup a => a -> a -> a
<>Amount -> RegexError
showAmountWithoutCost Amount
b RegexError -> ShowS
forall a. Semigroup a => a -> a -> a
<>RegexError
" of costful posting "RegexError -> ShowS
forall a. Semigroup a => a -> a -> a
<>Amount -> RegexError
showAmount Amount
bRegexError -> ShowS
forall a. Semigroup a => a -> a -> a
<>RegexError
" at precision "RegexError -> ShowS
forall a. Semigroup a => a -> a -> a
<>Amount -> RegexError
dbgShowAmountPrecision Amount
aRegexError -> ShowS
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 -> ShowS
forall a. Semigroup a => a -> a -> a
<>a -> RegexError
forall a. Show a => a -> RegexError
show a
nRegexError -> ShowS
forall a. Semigroup a => a -> a -> a
<>RegexError
" "RegexError -> ShowS
forall a. Semigroup a => a -> a -> a
<>Amount -> RegexError
showAmount Amount
aRegexError -> ShowS
forall a. Semigroup a => a -> a -> a
<>RegexError
" matches cost "   RegexError -> ShowS
forall a. Semigroup a => a -> a -> a
<>Amount -> RegexError
showAmount (Amount -> Amount
amountCost Amount
b)RegexError -> ShowS
forall a. Semigroup a => a -> a -> a
<>RegexError
" of costful posting "RegexError -> ShowS
forall a. Semigroup a => a -> a -> a
<>Amount -> RegexError
showAmount Amount
bRegexError -> ShowS
forall a. Semigroup a => a -> a -> a
<>RegexError
" at precision "RegexError -> ShowS
forall a. Semigroup a => a -> a -> a
<>Amount -> RegexError
dbgShowAmountPrecision Amount
aRegexError -> ShowS
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 CommoditySymbol 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 CommoditySymbol Amount
forall a b. b -> Either a b
Right Amount
a
        Just Amount{acost :: Amount -> Maybe AmountCost
acost=Just AmountCost
_} -> CommoditySymbol -> Either CommoditySymbol Amount
forall a b. a -> Either a b
Left (CommoditySymbol -> Either CommoditySymbol Amount)
-> CommoditySymbol -> Either CommoditySymbol Amount
forall a b. (a -> b) -> a -> b
$ [Posting] -> CommoditySymbol -> CommoditySymbol
annotateWithPostings [Posting
p] CommoditySymbol
"Conversion postings must not have a cost:"
        Maybe Amount
Nothing                    -> CommoditySymbol -> Either CommoditySymbol Amount
forall a b. a -> Either a b
Left (CommoditySymbol -> Either CommoditySymbol Amount)
-> CommoditySymbol -> Either CommoditySymbol Amount
forall a b. (a -> b) -> a -> b
$ [Posting] -> CommoditySymbol -> CommoditySymbol
annotateWithPostings [Posting
p] CommoditySymbol
"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] -> CommoditySymbol -> CommoditySymbol
annotateWithPostings [Posting]
xs CommoditySymbol
str = [CommoditySymbol] -> CommoditySymbol
T.unlines ([CommoditySymbol] -> CommoditySymbol)
-> [CommoditySymbol] -> CommoditySymbol
forall a b. (a -> b) -> a -> b
$ CommoditySymbol
str CommoditySymbol -> [CommoditySymbol] -> [CommoditySymbol]
forall a. a -> [a] -> [a]
: Bool -> [Posting] -> [CommoditySymbol]
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
-> [CommoditySymbol]
-> [IdxPosting]
-> Either
     CommoditySymbol
     ([(IdxPosting, IdxPosting)], ([IdxPosting], [IdxPosting]))
partitionAndCheckConversionPostings Bool
check [CommoditySymbol]
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
      CommoditySymbol
      (([(IdxPosting, IdxPosting)], ([IdxPosting], [IdxPosting])),
       Maybe IdxPosting))
-> (([(IdxPosting, IdxPosting)], ([IdxPosting], [IdxPosting])),
    Maybe IdxPosting)
-> [IdxPosting]
-> Either
     CommoditySymbol
     (([(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
     CommoditySymbol
     (([(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
      CommoditySymbol
      (([(IdxPosting, IdxPosting)], ([IdxPosting], [IdxPosting])),
       Maybe IdxPosting))
-> (Either
      CommoditySymbol
      (([(IdxPosting, IdxPosting)], ([IdxPosting], [IdxPosting])),
       Maybe IdxPosting)
    -> Either
         CommoditySymbol
         ([(IdxPosting, IdxPosting)], ([IdxPosting], [IdxPosting])))
-> [IdxPosting]
-> Either
     CommoditySymbol
     ([(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
     CommoditySymbol
     (([(IdxPosting, IdxPosting)], ([IdxPosting], [IdxPosting])),
      Maybe IdxPosting)
-> Either
     CommoditySymbol
     ([(IdxPosting, IdxPosting)], ([IdxPosting], [IdxPosting]))
forall a b.
(a -> b) -> Either CommoditySymbol a -> Either CommoditySymbol 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 -> CommoditySymbol
paccount Posting
p CommoditySymbol -> [CommoditySymbol] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CommoditySymbol]
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

-- | Get the canonical amount styles inferred from this transaction's amounts.
transactionCommodityStyles :: Transaction -> M.Map CommoditySymbol AmountStyle
transactionCommodityStyles :: Transaction -> Map CommoditySymbol AmountStyle
transactionCommodityStyles =
  (RegexError -> Map CommoditySymbol AmountStyle)
-> (Map CommoditySymbol AmountStyle
    -> Map CommoditySymbol AmountStyle)
-> Either RegexError (Map CommoditySymbol AmountStyle)
-> Map CommoditySymbol AmountStyle
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Map CommoditySymbol AmountStyle
-> RegexError -> Map CommoditySymbol AmountStyle
forall a b. a -> b -> a
const Map CommoditySymbol AmountStyle
forall a. Monoid a => a
mempty) Map CommoditySymbol AmountStyle -> Map CommoditySymbol AmountStyle
forall a. a -> a
id (Either RegexError (Map CommoditySymbol AmountStyle)
 -> Map CommoditySymbol AmountStyle)
-> (Transaction
    -> Either RegexError (Map CommoditySymbol AmountStyle))
-> Transaction
-> Map CommoditySymbol AmountStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  -- ignore style problems, commodityStylesFromAmounts doesn't report them currently
  [Amount] -> Either RegexError (Map CommoditySymbol AmountStyle)
commodityStylesFromAmounts ([Amount] -> Either RegexError (Map CommoditySymbol AmountStyle))
-> (Transaction -> [Amount])
-> Transaction
-> Either RegexError (Map CommoditySymbol AmountStyle)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Posting -> [Amount]) -> [Posting] -> [Amount]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (MixedAmount -> [Amount]
amountsRaw (MixedAmount -> [Amount])
-> (Posting -> MixedAmount) -> Posting -> [Amount]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Posting -> MixedAmount
pamount) ([Posting] -> [Amount])
-> (Transaction -> [Posting]) -> Transaction -> [Amount]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> [Posting]
tpostings

-- | Like transactionCommodityStyles, but attach a particular rounding strategy to the styles,
-- affecting how they will affect display precisions when applied.
transactionCommodityStylesWith :: Rounding -> Transaction -> M.Map CommoditySymbol AmountStyle
transactionCommodityStylesWith :: Rounding -> Transaction -> Map CommoditySymbol AmountStyle
transactionCommodityStylesWith Rounding
r = Rounding
-> Map CommoditySymbol AmountStyle
-> Map CommoditySymbol AmountStyle
amountStylesSetRounding Rounding
r (Map CommoditySymbol AmountStyle
 -> Map CommoditySymbol AmountStyle)
-> (Transaction -> Map CommoditySymbol AmountStyle)
-> Transaction
-> Map CommoditySymbol AmountStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> Map CommoditySymbol AmountStyle
transactionCommodityStyles

-- | 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 -> ShowS
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
          , CommoditySymbol -> RegexError
T.unpack (CommoditySymbol -> RegexError)
-> (CommoditySymbol -> CommoditySymbol)
-> CommoditySymbol
-> RegexError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommoditySymbol -> CommoditySymbol
T.stripEnd (CommoditySymbol -> RegexError) -> CommoditySymbol -> RegexError
forall a b. (a -> b) -> a -> b
$ Transaction -> CommoditySymbol
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 -> [CommoditySymbol]
showPostingLines Posting
nullposting [CommoditySymbol] -> [CommoditySymbol] -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= [CommoditySymbol
"                   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 -> [CommoditySymbol]
showPostingLines Posting
p [CommoditySymbol] -> [CommoditySymbol] -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
              [ CommoditySymbol
"    * a         $1.00  ; pcomment1"
              , CommoditySymbol
"    ; pcomment2"
              , CommoditySymbol
"    ;   tag3: val3  "
              , CommoditySymbol
"    * a         2.00h  ; pcomment1"
              , CommoditySymbol
"    ; pcomment2"
              , CommoditySymbol
"    ;   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] -> [CommoditySymbol]
postingsAsLines Bool
False (Transaction -> [Posting]
tpostings Transaction
nulltransaction) [CommoditySymbol] -> [CommoditySymbol] -> 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] -> [CommoditySymbol]
postingsAsLines Bool
False (Transaction -> [Posting]
tpostings Transaction
timp) [CommoditySymbol] -> [CommoditySymbol] -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
                  [ CommoditySymbol
"    a           $1.00"
                  , CommoditySymbol
"    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] -> [CommoditySymbol]
postingsAsLines Bool
False (Transaction -> [Posting]
tpostings Transaction
texp) [CommoditySymbol] -> [CommoditySymbol] -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
                  [ CommoditySymbol
"    a           $1.00"
                  , CommoditySymbol
"    b          $-1.00"
                  ]
            , RegexError -> Assertion -> TestTree
testCase RegexError
"one-explicit-amount" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ Bool -> [Posting] -> [CommoditySymbol]
postingsAsLines Bool
False (Transaction -> [Posting]
tpostings Transaction
texp1) [CommoditySymbol] -> [CommoditySymbol] -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
                  [ CommoditySymbol
"    (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] -> [CommoditySymbol]
postingsAsLines Bool
False (Transaction -> [Posting]
tpostings Transaction
texp2) [CommoditySymbol] -> [CommoditySymbol] -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
                  [ CommoditySymbol
"    a             $1.00"
                  , CommoditySymbol
"    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] -> [CommoditySymbol]
postingsAsLines Bool
False (Transaction -> [Posting]
tpostings Transaction
texp2b) [CommoditySymbol] -> [CommoditySymbol] -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
                  [ CommoditySymbol
"    a           $1.00"
                  , CommoditySymbol
"    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] -> [CommoditySymbol]
postingsAsLines Bool
False (Transaction -> [Posting]
tpostings Transaction
t3) [CommoditySymbol] -> [CommoditySymbol] -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
                  [CommoditySymbol
"    a           $1.00", CommoditySymbol
"    b", CommoditySymbol
"    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 -> CommoditySymbol
showTransaction Transaction
nulltransaction CommoditySymbol -> CommoditySymbol -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= CommoditySymbol
"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 -> CommoditySymbol
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")]
                      }
                  ]
              } CommoditySymbol -> CommoditySymbol -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
          [CommoditySymbol] -> CommoditySymbol
T.unlines
            [ CommoditySymbol
"2012-05-14=2012-05-15 (code) desc  ; tcomment1"
            , CommoditySymbol
"    ; tcomment2"
            , CommoditySymbol
"    * a         $1.00"
            , CommoditySymbol
"    ; pcomment2"
            , CommoditySymbol
"    * a         2.00h"
            , CommoditySymbol
"    ; pcomment2"
            , CommoditySymbol
""
            ]
        , 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
-> CommoditySymbol
-> (SourcePos, SourcePos)
-> Day
-> Maybe Day
-> Status
-> CommoditySymbol
-> CommoditySymbol
-> CommoditySymbol
-> [Tag]
-> [Posting]
-> Transaction
Transaction
                   Integer
0
                   CommoditySymbol
""
                   (SourcePos, SourcePos)
nullsourcepospair
                   (Integer -> Int -> Int -> Day
fromGregorian Integer
2007 Int
01 Int
28)
                   Maybe Day
forall a. Maybe a
Nothing
                   Status
Unmarked
                   CommoditySymbol
""
                   CommoditySymbol
"coopportunity"
                   CommoditySymbol
""
                   []
                   [ 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 -> CommoditySymbol
showTransaction Transaction
t) CommoditySymbol -> CommoditySymbol -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
          ([CommoditySymbol] -> CommoditySymbol
T.unlines
             [ CommoditySymbol
"2007-01-28 coopportunity"
             , CommoditySymbol
"    expenses:food:groceries          $47.18"
             , CommoditySymbol
"    assets:checking                 $-47.18"
             , CommoditySymbol
""
             ])
        , RegexError -> Assertion -> TestTree
testCase RegexError
"show an unbalanced transaction, should not elide" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
          (Transaction -> CommoditySymbol
showTransaction
             (Transaction -> Transaction
txnTieKnot (Transaction -> Transaction) -> Transaction -> Transaction
forall a b. (a -> b) -> a -> b
$
              Integer
-> CommoditySymbol
-> (SourcePos, SourcePos)
-> Day
-> Maybe Day
-> Status
-> CommoditySymbol
-> CommoditySymbol
-> CommoditySymbol
-> [Tag]
-> [Posting]
-> Transaction
Transaction
                Integer
0
                CommoditySymbol
""
                (SourcePos, SourcePos)
nullsourcepospair
                (Integer -> Int -> Int -> Day
fromGregorian Integer
2007 Int
01 Int
28)
                Maybe Day
forall a. Maybe a
Nothing
                Status
Unmarked
                CommoditySymbol
""
                CommoditySymbol
"coopportunity"
                CommoditySymbol
""
                []
                [ Posting
posting {paccount = "expenses:food:groceries", pamount = mixedAmount (usd 47.18)}
                , Posting
posting {paccount = "assets:checking", pamount = mixedAmount (usd (-47.19))}
                ])) CommoditySymbol -> CommoditySymbol -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
          ([CommoditySymbol] -> CommoditySymbol
T.unlines
             [ CommoditySymbol
"2007-01-28 coopportunity"
             , CommoditySymbol
"    expenses:food:groceries          $47.18"
             , CommoditySymbol
"    assets:checking                 $-47.19"
             , CommoditySymbol
""
             ])
        , 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 -> CommoditySymbol
showTransaction
             (Transaction -> Transaction
txnTieKnot (Transaction -> Transaction) -> Transaction -> Transaction
forall a b. (a -> b) -> a -> b
$
              Integer
-> CommoditySymbol
-> (SourcePos, SourcePos)
-> Day
-> Maybe Day
-> Status
-> CommoditySymbol
-> CommoditySymbol
-> CommoditySymbol
-> [Tag]
-> [Posting]
-> Transaction
Transaction
                Integer
0
                CommoditySymbol
""
                (SourcePos, SourcePos)
nullsourcepospair
                (Integer -> Int -> Int -> Day
fromGregorian Integer
2007 Int
01 Int
28)
                Maybe Day
forall a. Maybe a
Nothing
                Status
Unmarked
                CommoditySymbol
""
                CommoditySymbol
"coopportunity"
                CommoditySymbol
""
                []
                [Posting
posting {paccount = "expenses:food:groceries", pamount = missingmixedamt}])) CommoditySymbol -> CommoditySymbol -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
          ([CommoditySymbol] -> CommoditySymbol
T.unlines [CommoditySymbol
"2007-01-28 coopportunity", CommoditySymbol
"    expenses:food:groceries", CommoditySymbol
""])
        , 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 -> CommoditySymbol
showTransaction
             (Transaction -> Transaction
txnTieKnot (Transaction -> Transaction) -> Transaction -> Transaction
forall a b. (a -> b) -> a -> b
$
              Integer
-> CommoditySymbol
-> (SourcePos, SourcePos)
-> Day
-> Maybe Day
-> Status
-> CommoditySymbol
-> CommoditySymbol
-> CommoditySymbol
-> [Tag]
-> [Posting]
-> Transaction
Transaction
                Integer
0
                CommoditySymbol
""
                (SourcePos, SourcePos)
nullsourcepospair
                (Integer -> Int -> Int -> Day
fromGregorian Integer
2010 Int
01 Int
01)
                Maybe Day
forall a. Maybe a
Nothing
                Status
Unmarked
                CommoditySymbol
""
                CommoditySymbol
"x"
                CommoditySymbol
""
                []
                [ Posting
posting {paccount = "a", pamount = mixedAmount $ num 1 `at` (usd 2 `withPrecision` Precision 0)}
                , Posting
posting {paccount = "b", pamount = missingmixedamt}
                ])) CommoditySymbol -> CommoditySymbol -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
          ([CommoditySymbol] -> CommoditySymbol
T.unlines [CommoditySymbol
"2010-01-01 x", CommoditySymbol
"    a          1 @ $2", CommoditySymbol
"    b", CommoditySymbol
""])
        ]
    ]