{-|

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

-}

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

module Hledger.Data.Transaction
( -- * Transaction
  nulltransaction
, transaction
, txnTieKnot
, txnUntieKnot
  -- * operations
, hasRealPostings
, realPostings
, assignmentPostings
, virtualPostings
, balancedVirtualPostings
, transactionsPostings
, transactionTransformPostings
, transactionApplyValuation
, transactionToCost
, transactionAddInferredEquityPostings
, transactionInferCostsFromEquity
, transactionApplyAliases
, transactionMapPostings
, transactionMapPostingAmounts
, partitionAndCheckConversionPostings
  -- 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)
import Data.Foldable (foldrM)
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


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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

-- | Maybe convert this 'Transaction's amounts to cost and apply the
-- appropriate amount styles.
transactionToCost :: M.Map CommoditySymbol AmountStyle -> ConversionOp -> Transaction -> Transaction
transactionToCost :: Map Text AmountStyle -> ConversionOp -> Transaction -> Transaction
transactionToCost Map Text AmountStyle
styles ConversionOp
cost Transaction
t = Transaction
t{tpostings :: [Posting]
tpostings = (Posting -> Maybe Posting) -> [Posting] -> [Posting]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Map Text AmountStyle -> ConversionOp -> Posting -> Maybe Posting
postingToCost Map Text AmountStyle
styles ConversionOp
cost) ([Posting] -> [Posting]) -> [Posting] -> [Posting]
forall a b. (a -> b) -> a -> b
$ Transaction -> [Posting]
tpostings Transaction
t}

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

type IdxPosting = (Int, Posting)

-- WARNING: twisty code ahead

-- | Add costs inferred from equity postings in this transaction.
-- For every adjacent pair of conversion postings, it will first search the postings
-- with costs to see if any match. If so, it will tag these as matched.
-- If no postings with costs match, it will then search the postings without costs,
-- and will match the first such posting which matches one of the conversion amounts.
-- If it finds a match, it will add a cost and then tag it.
-- If the first argument is true, do a dry run instead: identify and tag
-- the costful and conversion postings, but don't add costs.
transactionInferCostsFromEquity :: Bool -> M.Map AccountName AccountType -> Transaction -> Either String Transaction
transactionInferCostsFromEquity :: Bool
-> Map Text AccountType
-> Transaction
-> Either RegexError Transaction
transactionInferCostsFromEquity Bool
dryrun Map Text AccountType
acctTypes Transaction
t = (Text -> RegexError)
-> Either Text Transaction -> Either RegexError Transaction
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Transaction -> RegexError -> RegexError
annotateErrorWithTransaction Transaction
t (RegexError -> RegexError)
-> (Text -> RegexError) -> Text -> RegexError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> RegexError
T.unpack) (Either Text Transaction -> Either RegexError Transaction)
-> Either Text Transaction -> Either RegexError Transaction
forall a b. (a -> b) -> a -> b
$ do
    ([(IdxPosting, IdxPosting)]
conversionPairs, ([IdxPosting], [IdxPosting])
stateps) <- Bool
-> Map Text AccountType
-> [IdxPosting]
-> Either
     Text ([(IdxPosting, IdxPosting)], ([IdxPosting], [IdxPosting]))
partitionAndCheckConversionPostings Bool
False Map Text AccountType
acctTypes [IdxPosting]
npostings
    IdxPosting -> IdxPosting
f <- ((IdxPosting, IdxPosting)
 -> StateT
      ([IdxPosting], [IdxPosting])
      (Either Text)
      (IdxPosting -> IdxPosting))
-> [(IdxPosting, IdxPosting)]
-> ([IdxPosting], [IdxPosting])
-> Either Text (IdxPosting -> IdxPosting)
forall {m :: * -> *} {t :: * -> *} {a} {s} {a}.
(Monad m, Traversable t) =>
(a -> StateT s m (a -> a)) -> t a -> s -> m (a -> a)
transformIndexedPostingsF (Bool
-> (IdxPosting, IdxPosting)
-> StateT
     ([IdxPosting], [IdxPosting])
     (Either Text)
     (IdxPosting -> IdxPosting)
addCostsToPostings Bool
dryrun) [(IdxPosting, IdxPosting)]
conversionPairs ([IdxPosting], [IdxPosting])
stateps
    Transaction -> Either Text Transaction
forall a. a -> Either Text a
forall (m :: * -> *) a. Monad m => a -> m a
return Transaction
t{tpostings :: [Posting]
tpostings = (IdxPosting -> Posting) -> [IdxPosting] -> [Posting]
forall a b. (a -> b) -> [a] -> [b]
map (IdxPosting -> Posting
forall a b. (a, b) -> b
snd (IdxPosting -> Posting)
-> (IdxPosting -> IdxPosting) -> IdxPosting -> Posting
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdxPosting -> IdxPosting
f) [IdxPosting]
npostings}
  where
    -- Include indices for postings
    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
    transformIndexedPostingsF :: (a -> StateT s m (a -> a)) -> t a -> s -> m (a -> a)
transformIndexedPostingsF a -> StateT s m (a -> a)
f = StateT s m (a -> a) -> s -> m (a -> a)
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (StateT s m (a -> a) -> s -> m (a -> a))
-> (t a -> StateT s m (a -> a)) -> t a -> s -> m (a -> a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (t (a -> a) -> a -> a)
-> StateT s m (t (a -> a)) -> StateT s m (a -> a)
forall a b. (a -> b) -> StateT s m a -> StateT s m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Endo a -> a -> a
forall a. Endo a -> a -> a
appEndo (Endo a -> a -> a)
-> (t (a -> a) -> Endo a) -> t (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a -> a) -> Endo a) -> t (a -> a) -> Endo a
forall m a. Monoid m => (a -> m) -> t a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (a -> a) -> Endo a
forall a. (a -> a) -> Endo a
Endo) (StateT s m (t (a -> a)) -> StateT s m (a -> a))
-> (t a -> StateT s m (t (a -> a))) -> t a -> StateT s m (a -> a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> StateT s m (a -> a)) -> t a -> StateT s m (t (a -> a))
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) -> t a -> f (t b)
traverse a -> StateT s m (a -> a)
f

    -- Given a pair of indexed conversion postings, and a state consisting of lists of
    -- costful and costless non-conversion postings, create a function which adds a conversion cost
    -- to the posting which matches the conversion postings if necessary,
    -- and tags the conversion and matched postings. Then update the state by removing the
    -- matched postings. If there are no matching postings or too much ambiguity,
    -- return an error string annotated with the conversion postings.
    -- If the first argument is true, do a dry run instead: identify and tag
    -- the costful and conversion postings, but don't add costs.
    addCostsToPostings :: Bool -> (IdxPosting, IdxPosting)
                        -> StateT ([IdxPosting], [IdxPosting]) (Either Text) (IdxPosting -> IdxPosting)
    addCostsToPostings :: Bool
-> (IdxPosting, IdxPosting)
-> StateT
     ([IdxPosting], [IdxPosting])
     (Either Text)
     (IdxPosting -> IdxPosting)
addCostsToPostings Bool
dryrun' ((Int
n1, Posting
cp1), (Int
n2, Posting
cp2)) = (([IdxPosting], [IdxPosting])
 -> Either
      Text (IdxPosting -> IdxPosting, ([IdxPosting], [IdxPosting])))
-> StateT
     ([IdxPosting], [IdxPosting])
     (Either Text)
     (IdxPosting -> IdxPosting)
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((([IdxPosting], [IdxPosting])
  -> Either
       Text (IdxPosting -> IdxPosting, ([IdxPosting], [IdxPosting])))
 -> StateT
      ([IdxPosting], [IdxPosting])
      (Either Text)
      (IdxPosting -> IdxPosting))
-> (([IdxPosting], [IdxPosting])
    -> Either
         Text (IdxPosting -> IdxPosting, ([IdxPosting], [IdxPosting])))
-> StateT
     ([IdxPosting], [IdxPosting])
     (Either Text)
     (IdxPosting -> IdxPosting)
forall a b. (a -> b) -> a -> b
$ \([IdxPosting]
costps, [IdxPosting]
otherps) -> do
        -- Get the two conversion posting amounts, if possible
        Amount
ca1 <- Posting -> Either Text Amount
conversionPostingAmountNoCost Posting
cp1
        Amount
ca2 <- Posting -> Either Text Amount
conversionPostingAmountNoCost Posting
cp2
        let -- The function to add costs and tag postings in the indexed list of postings
            transformPostingF :: Int -> Posting -> IdxPosting -> IdxPosting
transformPostingF 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 -> [Tag] -> Posting
`postingAddTags` [(Text
"_price-matched",Text
"")]
                     | 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 -> [Tag] -> Posting
`postingAddTags` [(Text
"_conversion-matched",Text
"")]
                     | Bool
otherwise          -> Posting
p)
            -- All costful postings which match the conversion posting pair
            matchingCostPs :: [(Int, (Posting, Amount))]
matchingCostPs = (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)
costfulPostingIfMatchesBothAmounts Amount
ca1 Amount
ca2) [IdxPosting]
costps
            -- All other postings which match at least one of the conversion posting pair.
            -- Add a corresponding cost to these postings, unless in dry run mode.
            matchingOtherPs :: [(Int, (Posting, Amount))]
matchingOtherPs
              | Bool
dryrun'   = [(Int
n,(Posting
p, Amount
a)) | (Int
n,Posting
p) <- [IdxPosting]
otherps, let Just Amount
a = Posting -> Maybe Amount
postingSingleAmount Posting
p]
              | Bool
otherwise = (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

        -- Annotate any errors with the conversion posting pair
        (Text -> Text)
-> Either
     Text (IdxPosting -> IdxPosting, ([IdxPosting], [IdxPosting]))
-> Either
     Text (IdxPosting -> IdxPosting, ([IdxPosting], [IdxPosting]))
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ([Posting] -> Text -> Text
annotateWithPostings [Posting
cp1, Posting
cp2]) (Either
   Text (IdxPosting -> IdxPosting, ([IdxPosting], [IdxPosting]))
 -> Either
      Text (IdxPosting -> IdxPosting, ([IdxPosting], [IdxPosting])))
-> Either
     Text (IdxPosting -> IdxPosting, ([IdxPosting], [IdxPosting]))
-> Either
     Text (IdxPosting -> IdxPosting, ([IdxPosting], [IdxPosting]))
forall a b. (a -> b) -> a -> b
$
            if -- If a single costful posting matches the conversion postings,
               -- delete it from the list of costful postings in the state, delete the
               -- first matching costless posting from the list of costless postings
               -- in the state, and return the transformation function with the new state.
               | [(Int
np, (Posting
costp, Amount
_))] <- [(Int, (Posting, Amount))]
matchingCostPs
               , Just [IdxPosting]
newcostps <- Int -> [IdxPosting] -> Maybe [IdxPosting]
forall {b} {b}. Eq b => b -> [(b, b)] -> Maybe [(b, b)]
deleteIdx Int
np [IdxPosting]
costps
                   -> (IdxPosting -> IdxPosting, ([IdxPosting], [IdxPosting]))
-> Either
     Text (IdxPosting -> IdxPosting, ([IdxPosting], [IdxPosting]))
forall a b. b -> Either a b
Right (Int -> Posting -> IdxPosting -> IdxPosting
transformPostingF Int
np Posting
costp, (if Bool
dryrun' then [IdxPosting]
costps else [IdxPosting]
newcostps, [IdxPosting]
otherps))
               -- If no costful postings match the conversion postings, but some
               -- of the costless postings match, check that the first such posting has a
               -- different amount from all the others, and if so add a cost to it,
               -- then delete it from the list of costless postings in the state,
               -- and return the transformation function with the new state.
               | [] <- [(Int, (Posting, Amount))]
matchingCostPs
               , (Int
np, (Posting
costp, Amount
amt)):[(Int, (Posting, Amount))]
nps <- [(Int, (Posting, Amount))]
matchingOtherPs
               , 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
amountMatches Amount
amt (Amount -> Bool)
-> ((Int, (Posting, Amount)) -> Amount)
-> (Int, (Posting, Amount))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Posting, Amount) -> Amount
forall a b. (a, b) -> b
snd ((Posting, Amount) -> Amount)
-> ((Int, (Posting, Amount)) -> (Posting, Amount))
-> (Int, (Posting, Amount))
-> Amount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, (Posting, Amount)) -> (Posting, Amount)
forall a b. (a, b) -> b
snd) [(Int, (Posting, Amount))]
nps
               , Just [IdxPosting]
newotherps <- Int -> [IdxPosting] -> Maybe [IdxPosting]
forall {b} {b}. Eq b => b -> [(b, b)] -> Maybe [(b, b)]
deleteIdx Int
np [IdxPosting]
otherps
                   -> (IdxPosting -> IdxPosting, ([IdxPosting], [IdxPosting]))
-> Either
     Text (IdxPosting -> IdxPosting, ([IdxPosting], [IdxPosting]))
forall a b. b -> Either a b
Right (Int -> Posting -> IdxPosting -> IdxPosting
transformPostingF Int
np Posting
costp, ([IdxPosting]
costps, if Bool
dryrun' then [IdxPosting]
otherps else [IdxPosting]
newotherps))
               -- Otherwise it's too ambiguous to make a guess, so return an error.
               | Bool
otherwise -> Text
-> Either
     Text (IdxPosting -> IdxPosting, ([IdxPosting], [IdxPosting]))
forall a b. a -> Either a b
Left Text
"There is not a unique posting which matches the conversion posting pair:"

    -- 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, Amount)
    costfulPostingIfMatchesBothAmounts :: Amount -> Amount -> Posting -> Maybe (Posting, Amount)
costfulPostingIfMatchesBothAmounts Amount
a1 Amount
a2 Posting
p = do
        a :: Amount
a@Amount{aprice :: Amount -> Maybe AmountPrice
aprice=Just AmountPrice
_} <- Posting -> Maybe Amount
postingSingleAmount Posting
p
        if | Amount -> Amount -> Bool
amountMatches (-Amount
a1) Amount
a Bool -> Bool -> Bool
&& Amount -> Amount -> Bool
amountMatches Amount
a2 (Amount -> Amount
amountCost Amount
a) -> (Posting, Amount) -> Maybe (Posting, Amount)
forall a. a -> Maybe a
Just (Posting
p, -Amount
a2)
           | Amount -> Amount -> Bool
amountMatches (-Amount
a2) Amount
a Bool -> Bool -> Bool
&& Amount -> Amount -> Bool
amountMatches Amount
a1 (Amount -> Amount
amountCost Amount
a) -> (Posting, Amount) -> Maybe (Posting, Amount)
forall a. a -> Maybe a
Just (Posting
p, -Amount
a1)
           | Bool
otherwise -> Maybe (Posting, Amount)
forall a. Maybe a
Nothing

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

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

    amountMatches :: Amount -> Amount -> Bool
amountMatches Amount
a Amount
b = Amount -> Text
acommodity Amount
a Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Amount -> Text
acommodity Amount
b Bool -> Bool -> Bool
&& Amount -> DecimalRaw Integer
aquantity Amount
a DecimalRaw Integer -> DecimalRaw Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Amount -> DecimalRaw Integer
aquantity Amount
b

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

-- Using the provided account types map, sort the given indexed postings
-- into three lists of posting numbers (stored in two pairs), like so:
-- (conversion postings, (costful postings, other postings)).
-- A true first argument activates its secondary function: check that all
-- conversion postings occur in adjacent pairs, otherwise return an error.
partitionAndCheckConversionPostings :: Bool -> M.Map AccountName AccountType -> [IdxPosting] -> Either Text ( [(IdxPosting, IdxPosting)], ([IdxPosting], [IdxPosting]) )
partitionAndCheckConversionPostings :: Bool
-> Map Text AccountType
-> [IdxPosting]
-> Either
     Text ([(IdxPosting, IdxPosting)], ([IdxPosting], [IdxPosting]))
partitionAndCheckConversionPostings Bool
check Map Text AccountType
acctTypes = ((([(IdxPosting, IdxPosting)], ([IdxPosting], [IdxPosting])),
  Maybe IdxPosting)
 -> ([(IdxPosting, IdxPosting)], ([IdxPosting], [IdxPosting])))
-> Either
     Text
     (([(IdxPosting, IdxPosting)], ([IdxPosting], [IdxPosting])),
      Maybe IdxPosting)
-> Either
     Text ([(IdxPosting, IdxPosting)], ([IdxPosting], [IdxPosting]))
forall a b. (a -> b) -> Either Text a -> Either Text b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([(IdxPosting, IdxPosting)], ([IdxPosting], [IdxPosting])),
 Maybe IdxPosting)
-> ([(IdxPosting, IdxPosting)], ([IdxPosting], [IdxPosting]))
forall a b. (a, b) -> a
fst (Either
   Text
   (([(IdxPosting, IdxPosting)], ([IdxPosting], [IdxPosting])),
    Maybe IdxPosting)
 -> Either
      Text ([(IdxPosting, IdxPosting)], ([IdxPosting], [IdxPosting])))
-> ([IdxPosting]
    -> Either
         Text
         (([(IdxPosting, IdxPosting)], ([IdxPosting], [IdxPosting])),
          Maybe IdxPosting))
-> [IdxPosting]
-> Either
     Text ([(IdxPosting, IdxPosting)], ([IdxPosting], [IdxPosting]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IdxPosting
 -> (([(IdxPosting, IdxPosting)], ([IdxPosting], [IdxPosting])),
     Maybe IdxPosting)
 -> Either
      Text
      (([(IdxPosting, IdxPosting)], ([IdxPosting], [IdxPosting])),
       Maybe IdxPosting))
-> (([(IdxPosting, IdxPosting)], ([IdxPosting], [IdxPosting])),
    Maybe IdxPosting)
-> [IdxPosting]
-> Either
     Text
     (([(IdxPosting, IdxPosting)], ([IdxPosting], [IdxPosting])),
      Maybe IdxPosting)
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> b -> m b) -> b -> t a -> m b
foldrM IdxPosting
-> (([(IdxPosting, IdxPosting)], ([IdxPosting], [IdxPosting])),
    Maybe IdxPosting)
-> Either
     Text
     (([(IdxPosting, IdxPosting)], ([IdxPosting], [IdxPosting])),
      Maybe IdxPosting)
forall {a} {a} {a}.
IsString a =>
(a, Posting)
-> (([(a, (a, Posting))], ([(a, Posting)], [(a, Posting)])),
    Maybe a)
-> Either
     a
     (([(a, (a, Posting))], ([(a, Posting)], [(a, Posting)])),
      Maybe (a, Posting))
select (([], ([], [])), Maybe IdxPosting
forall a. Maybe a
Nothing)
  where
    select :: (a, Posting)
-> (([(a, (a, Posting))], ([(a, Posting)], [(a, Posting)])),
    Maybe a)
-> Either
     a
     (([(a, (a, Posting))], ([(a, Posting)], [(a, Posting)])),
      Maybe (a, Posting))
select np :: (a, Posting)
np@(a
_, Posting
p) (([(a, (a, Posting))]
cs, others :: ([(a, Posting)], [(a, Posting)])
others@([(a, Posting)]
ps, [(a, Posting)]
os)), Maybe a
Nothing)
      | 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 np :: (a, Posting)
np@(a
_, Posting
p) (([(a, (a, Posting))]
cs, others :: ([(a, Posting)], [(a, Posting)])
others@([(a, Posting)]
ps,[(a, Posting)]
os)), Just a
lst)
      | 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 = Text -> Map Text AccountType -> Maybe AccountType
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Posting -> Text
paccount Posting
p) Map Text AccountType
acctTypes Maybe AccountType -> Maybe AccountType -> Bool
forall a. Eq a => a -> a -> Bool
== AccountType -> Maybe AccountType
forall a. a -> Maybe a
Just AccountType
Conversion
    hasCost :: Posting -> Bool
hasCost Posting
p = Maybe AmountPrice -> Bool
forall a. Maybe a -> Bool
isJust (Maybe AmountPrice -> Bool) -> Maybe AmountPrice -> Bool
forall a b. (a -> b) -> a -> b
$ Amount -> Maybe AmountPrice
aprice (Amount -> Maybe AmountPrice) -> Maybe Amount -> Maybe AmountPrice
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 :: [Posting]
tpostings=[Posting]
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 :: [Posting]
tpostings=(Posting -> Posting) -> [Posting] -> [Posting]
forall a b. (a -> b) -> [a] -> [b]
map Posting -> Posting
f [Posting]
ps}

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

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

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

-- tests

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

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

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

            ]

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