{-|

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 FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE RecordWildCards #-}

module Hledger.Data.Transaction (
  -- * Transaction
  nulltransaction,
  transaction,
  txnTieKnot,
  txnUntieKnot,
  -- * operations
  showAccountName,
  hasRealPostings,
  realPostings,
  assignmentPostings,
  virtualPostings,
  balancedVirtualPostings,
  transactionsPostings,
  isTransactionBalanced,
  balanceTransaction,
  balanceTransactionHelper,
  transactionTransformPostings,
  transactionApplyValuation,
  transactionToCost,
  transactionApplyAliases,
  -- nonzerobalanceerror,
  -- * date operations
  transactionDate2,
  -- * transaction description parts
  transactionPayee,
  transactionNote,
  -- payeeAndNoteFromDescription,
  -- * rendering
  showTransaction,
  showTransactionOneLineAmounts,
  showTransactionUnelided,
  showTransactionUnelidedOneLineAmounts,
  -- showPostingLine,
  showPostingLines,
  -- * GenericSourcePos
  sourceFilePath,
  sourceFirstLine,
  showGenericSourcePos,
  annotateErrorWithTransaction,
  -- * tests
  tests_Transaction
)
where
import Data.List
import Data.List.Extra (nubSort)
import Data.Maybe
import Data.Text (Text)
import qualified Data.Text as T
import Data.Time.Calendar
import Text.Printf
import qualified Data.Map as M

import Hledger.Utils
import Hledger.Data.Types
import Hledger.Data.Dates
import Hledger.Data.Posting
import Hledger.Data.Amount
import Hledger.Data.Valuation

sourceFilePath :: GenericSourcePos -> FilePath
sourceFilePath :: GenericSourcePos -> FilePath
sourceFilePath = \case
    GenericSourcePos FilePath
fp Int
_ Int
_ -> FilePath
fp
    JournalSourcePos FilePath
fp (Int, Int)
_ -> FilePath
fp

sourceFirstLine :: GenericSourcePos -> Int
sourceFirstLine :: GenericSourcePos -> Int
sourceFirstLine = \case
    GenericSourcePos FilePath
_ Int
line Int
_ -> Int
line
    JournalSourcePos FilePath
_ (Int
line, Int
_) -> Int
line

-- | Render source position in human-readable form.
-- Keep in sync with Hledger.UI.ErrorScreen.hledgerparseerrorpositionp (temporary). XXX
showGenericSourcePos :: GenericSourcePos -> String
showGenericSourcePos :: GenericSourcePos -> FilePath
showGenericSourcePos = \case
    GenericSourcePos FilePath
fp Int
line Int
column -> FilePath -> FilePath
forall a. Show a => a -> FilePath
show FilePath
fp FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" (line " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
line FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
", column " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
column FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
")"
    JournalSourcePos FilePath
fp (Int
line, Int
line') -> FilePath -> FilePath
forall a. Show a => a -> FilePath
show FilePath
fp FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" (lines " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
line FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"-" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
line' FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
")"

nulltransaction :: Transaction
nulltransaction :: Transaction
nulltransaction = Transaction :: Integer
-> Text
-> GenericSourcePos
-> Day
-> Maybe Day
-> Status
-> Text
-> Text
-> Text
-> [Tag]
-> [Posting]
-> Transaction
Transaction {
                    tindex :: Integer
tindex=Integer
0,
                    tsourcepos :: GenericSourcePos
tsourcepos=GenericSourcePos
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 -> String
showTransaction :: Transaction -> FilePath
showTransaction = Bool -> Transaction -> FilePath
showTransactionHelper Bool
False

-- | Deprecated alias for 'showTransaction'
showTransactionUnelided :: Transaction -> String
showTransactionUnelided :: Transaction -> FilePath
showTransactionUnelided = Transaction -> FilePath
showTransaction  -- TODO: drop it

-- | 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 -> String
showTransactionOneLineAmounts :: Transaction -> FilePath
showTransactionOneLineAmounts = Bool -> Transaction -> FilePath
showTransactionHelper Bool
True

-- | Deprecated alias for 'showTransactionOneLineAmounts'
showTransactionUnelidedOneLineAmounts :: Transaction -> String
showTransactionUnelidedOneLineAmounts :: Transaction -> FilePath
showTransactionUnelidedOneLineAmounts = Transaction -> FilePath
showTransactionOneLineAmounts  -- TODO: drop it

-- | Helper for showTransaction*.
showTransactionHelper :: Bool -> Transaction -> String
showTransactionHelper :: Bool -> Transaction -> FilePath
showTransactionHelper Bool
onelineamounts Transaction
t =
    [FilePath] -> FilePath
unlines ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ [FilePath
descriptionline]
              [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
newlinecomments
              [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ (Bool -> [Posting] -> [FilePath]
postingsAsLines Bool
onelineamounts (Transaction -> [Posting]
tpostings Transaction
t))
              [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
""]
    where
      descriptionline :: FilePath
descriptionline = FilePath -> FilePath
rstrip (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [FilePath
date, FilePath
status, FilePath
code, FilePath
desc, FilePath
samelinecomment]
      date :: FilePath
date = Day -> FilePath
showDate (Transaction -> Day
tdate Transaction
t) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> (Day -> FilePath) -> Maybe Day -> FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FilePath
"" ((FilePath
"="FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++) (FilePath -> FilePath) -> (Day -> FilePath) -> Day -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> FilePath
showDate) (Transaction -> Maybe Day
tdate2 Transaction
t)
      status :: FilePath
status | Transaction -> Status
tstatus Transaction
t Status -> Status -> Bool
forall a. Eq a => a -> a -> Bool
== Status
Cleared = FilePath
" *"
             | Transaction -> Status
tstatus Transaction
t Status -> Status -> Bool
forall a. Eq a => a -> a -> Bool
== Status
Pending = FilePath
" !"
             | Bool
otherwise            = FilePath
""
      code :: FilePath
code = if Text -> Int
T.length (Transaction -> Text
tcode Transaction
t) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then FilePath -> FilePath -> FilePath
forall r. PrintfType r => FilePath -> r
printf FilePath
" (%s)" (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
T.unpack (Text -> FilePath) -> Text -> FilePath
forall a b. (a -> b) -> a -> b
$ Transaction -> Text
tcode Transaction
t else FilePath
""
      desc :: FilePath
desc = if FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
d then FilePath
"" else FilePath
" " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
d where d :: FilePath
d = Text -> FilePath
T.unpack (Text -> FilePath) -> Text -> FilePath
forall a b. (a -> b) -> a -> b
$ Transaction -> Text
tdescription Transaction
t
      (FilePath
samelinecomment, [FilePath]
newlinecomments) =
        case Text -> [FilePath]
renderCommentLines (Transaction -> Text
tcomment Transaction
t) of []   -> (FilePath
"",[])
                                                FilePath
c:[FilePath]
cs -> (FilePath
c,[FilePath]
cs)

-- | Render a transaction or posting's comment as indented, semicolon-prefixed comment lines.
-- The first line (unless empty) will have leading space, subsequent lines will have a larger indent.
renderCommentLines :: Text -> [String]
renderCommentLines :: Text -> [FilePath]
renderCommentLines Text
t =
  case FilePath -> [FilePath]
lines (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
T.unpack Text
t of
    []      -> []
    [FilePath
l]     -> [(FilePath -> FilePath
commentSpace (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
comment) FilePath
l]        -- single-line comment
    (FilePath
"":[FilePath]
ls) -> FilePath
"" FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> FilePath
lineIndent (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
comment) [FilePath]
ls  -- multi-line comment with empty first line
    (FilePath
l:[FilePath]
ls)  -> (FilePath -> FilePath
commentSpace (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
comment) FilePath
l FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> FilePath
lineIndent (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
comment) [FilePath]
ls
  where
    comment :: FilePath -> FilePath
comment = (FilePath
"; "FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++)

-- | Given a transaction and its postings, render the postings, suitable
-- for `print` output. Normally this output will be valid journal syntax which
-- hledger can reparse (though it may include no-longer-valid balance assertions).
--
-- Explicit amounts are shown, any implicit amounts are not.
--
-- Postings with multicommodity explicit amounts are handled as follows:
-- if onelineamounts is true, these amounts are shown on one line,
-- comma-separated, and the output will not be valid journal syntax.
-- Otherwise, they are shown as several similar postings, one per commodity.
--
-- The output will appear to be a balanced transaction.
-- Amounts' display precisions, which may have been limited by commodity
-- directives, will be increased if necessary to ensure this.
--
-- Posting amounts will be aligned with each other, starting about 4 columns
-- beyond the widest account name (see postingAsLines for details).
--
postingsAsLines :: Bool -> [Posting] -> [String]
postingsAsLines :: Bool -> [Posting] -> [FilePath]
postingsAsLines Bool
onelineamounts [Posting]
ps = (Posting -> [FilePath]) -> [Posting] -> [FilePath]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Bool -> Bool -> [Posting] -> Posting -> [FilePath]
postingAsLines Bool
False Bool
onelineamounts [Posting]
ps) [Posting]
ps

-- | Render one posting, on one or more lines, suitable for `print` output.
-- There will be an indented account name, plus one or more of status flag,
-- posting amount, balance assertion, same-line comment, next-line comments.
--
-- If the posting's amount is implicit or if elideamount is true, no amount is shown.
--
-- If the posting's amount is explicit and multi-commodity, multiple similar
-- postings are shown, one for each commodity, to help produce parseable journal syntax.
-- Or if onelineamounts is true, such amounts are shown on one line, comma-separated
-- (and the output will not be valid journal syntax).
--
-- By default, 4 spaces (2 if there's a status flag) are shown between
-- account name and start of amount area, which is typically 12 chars wide
-- and contains a right-aligned amount (so 10-12 visible spaces between
-- account name and amount is typical).
-- When given a list of postings to be aligned with, the whitespace will be
-- increased if needed to match the posting with the longest account name.
-- This is used to align the amounts of a transaction's postings.
--
postingAsLines :: Bool -> Bool -> [Posting] -> Posting -> [String]
postingAsLines :: Bool -> Bool -> [Posting] -> Posting -> [FilePath]
postingAsLines Bool
elideamount Bool
onelineamounts [Posting]
pstoalignwith Posting
p = [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
    [FilePath]
postingblock
    [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
newlinecomments
    | [FilePath]
postingblock <- [[FilePath]]
postingblocks]
  where
    postingblocks :: [[FilePath]]
postingblocks = [(FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> FilePath
rstrip ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath]
lines (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
concatTopPadded [FilePath
statusandaccount, FilePath
"  ", FilePath
amt, FilePath
assertion, FilePath
samelinecomment] | FilePath
amt <- [FilePath]
shownAmounts]
    assertion :: FilePath
assertion = FilePath
-> (BalanceAssertion -> FilePath)
-> Maybe BalanceAssertion
-> FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FilePath
"" ((Char
' 'Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:)(FilePath -> FilePath)
-> (BalanceAssertion -> FilePath) -> BalanceAssertion -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
.BalanceAssertion -> FilePath
showBalanceAssertion) (Maybe BalanceAssertion -> FilePath)
-> Maybe BalanceAssertion -> FilePath
forall a b. (a -> b) -> a -> b
$ Posting -> Maybe BalanceAssertion
pbalanceassertion Posting
p
    statusandaccount :: FilePath
statusandaccount = FilePath -> FilePath
lineIndent (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Maybe Int -> Bool -> Bool -> FilePath -> FilePath
fitString (Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Int
minwidth) Maybe Int
forall a. Maybe a
Nothing Bool
False Bool
True (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ Posting -> FilePath
pstatusandacct Posting
p
        where
          -- pad to the maximum account name width, plus 2 to leave room for status flags, to keep amounts aligned
          minwidth :: Int
minwidth = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (Posting -> Int) -> [Posting] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ((Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
+) (Int -> Int) -> (Posting -> Int) -> Posting -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Int
textWidth (Text -> Int) -> (Posting -> Text) -> Posting -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack (FilePath -> Text) -> (Posting -> FilePath) -> Posting -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Posting -> FilePath
pacctstr) [Posting]
pstoalignwith
          pstatusandacct :: Posting -> FilePath
pstatusandacct Posting
p' = Posting -> FilePath
pstatusprefix Posting
p' FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Posting -> FilePath
pacctstr Posting
p'
          pstatusprefix :: Posting -> FilePath
pstatusprefix Posting
p' | FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
s    = FilePath
""
                           | Bool
otherwise = FilePath
s FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" "
            where s :: FilePath
s = Status -> FilePath
forall a. Show a => a -> FilePath
show (Status -> FilePath) -> Status -> FilePath
forall a b. (a -> b) -> a -> b
$ Posting -> Status
pstatus Posting
p'
          pacctstr :: Posting -> FilePath
pacctstr Posting
p' = Maybe Int -> PostingType -> Text -> FilePath
showAccountName Maybe Int
forall a. Maybe a
Nothing (Posting -> PostingType
ptype Posting
p') (Posting -> Text
paccount Posting
p')

    -- currently prices are considered part of the amount string when right-aligning amounts
    shownAmounts :: [FilePath]
shownAmounts
      | Bool
elideamount    = [FilePath
""]
      | Bool
onelineamounts = [(FilePath, Int) -> FilePath
forall a b. (a, b) -> a
fst ((FilePath, Int) -> FilePath)
-> (MixedAmount -> (FilePath, Int)) -> MixedAmount -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Amount -> FilePath)
-> Maybe Int -> Maybe Int -> Bool -> MixedAmount -> (FilePath, Int)
showMixedOneLineUnnormalised Amount -> FilePath
showAmount (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
amtwidth) Maybe Int
forall a. Maybe a
Nothing Bool
False (MixedAmount -> FilePath) -> MixedAmount -> FilePath
forall a b. (a -> b) -> a -> b
$ Posting -> MixedAmount
pamount Posting
p]
      | [Amount] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (MixedAmount -> [Amount]
amounts (MixedAmount -> [Amount]) -> MixedAmount -> [Amount]
forall a b. (a -> b) -> a -> b
$ Posting -> MixedAmount
pamount Posting
p) = [FilePath
""]
      | Bool
otherwise      = FilePath -> [FilePath]
lines (FilePath -> [FilePath])
-> (MixedAmount -> FilePath) -> MixedAmount -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath, Int) -> FilePath
forall a b. (a, b) -> a
fst ((FilePath, Int) -> FilePath)
-> (MixedAmount -> (FilePath, Int)) -> MixedAmount -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Amount -> FilePath)
-> Maybe Int -> Maybe Int -> Bool -> MixedAmount -> (FilePath, Int)
showMixedUnnormalised Amount -> FilePath
showAmount (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
amtwidth) Maybe Int
forall a. Maybe a
Nothing Bool
False (MixedAmount -> [FilePath]) -> MixedAmount -> [FilePath]
forall a b. (a -> b) -> a -> b
$ Posting -> MixedAmount
pamount Posting
p
      where
        amtwidth :: Int
amtwidth = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ Int
12 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: (Posting -> Int) -> [Posting] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ((FilePath, Int) -> Int
forall a b. (a, b) -> b
snd ((FilePath, Int) -> Int)
-> (Posting -> (FilePath, Int)) -> Posting -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Amount -> FilePath)
-> Maybe Int -> Maybe Int -> Bool -> MixedAmount -> (FilePath, Int)
showMixedUnnormalised Amount -> FilePath
showAmount Maybe Int
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing Bool
False (MixedAmount -> (FilePath, Int))
-> (Posting -> MixedAmount) -> Posting -> (FilePath, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Posting -> MixedAmount
pamount) [Posting]
pstoalignwith  -- min. 12 for backwards compatibility

    (FilePath
samelinecomment, [FilePath]
newlinecomments) =
      case Text -> [FilePath]
renderCommentLines (Posting -> Text
pcomment Posting
p) of []   -> (FilePath
"",[])
                                              FilePath
c:[FilePath]
cs -> (FilePath
c,[FilePath]
cs)

-- | Render a balance assertion, as the =[=][*] symbol and expected amount.
showBalanceAssertion :: BalanceAssertion -> [Char]
showBalanceAssertion :: BalanceAssertion -> FilePath
showBalanceAssertion BalanceAssertion{Bool
GenericSourcePos
Amount
baposition :: BalanceAssertion -> GenericSourcePos
bainclusive :: BalanceAssertion -> Bool
batotal :: BalanceAssertion -> Bool
baamount :: BalanceAssertion -> Amount
baposition :: GenericSourcePos
bainclusive :: Bool
batotal :: Bool
baamount :: Amount
..} =
  FilePath
"=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [Char
'=' | Bool
batotal] FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [Char
'*' | Bool
bainclusive] FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Amount -> FilePath
showAmountWithZeroCommodity Amount
baamount

-- | Render a posting, simply. Used in balance assertion errors.
-- showPostingLine p =
--   lineIndent $
--   if pstatus p == Cleared then "* " else "" ++  -- XXX show !
--   showAccountName Nothing (ptype p) (paccount p) ++
--   "    " ++
--   showMixedAmountOneLine (pamount p) ++
--   assertion
--   where
--     -- XXX extract, handle ==
--     assertion = maybe "" ((" = " ++) . showAmountWithZeroCommodity . baamount) $ pbalanceassertion p

-- | Render a posting, at the appropriate width for aligning with
-- its siblings if any. Used by the rewrite command.
showPostingLines :: Posting -> [String]
showPostingLines :: Posting -> [FilePath]
showPostingLines Posting
p = Bool -> Bool -> [Posting] -> Posting -> [FilePath]
postingAsLines Bool
False Bool
False [Posting]
ps Posting
p where
    ps :: [Posting]
ps | Just Transaction
t <- Posting -> Maybe Transaction
ptransaction Posting
p = Transaction -> [Posting]
tpostings Transaction
t
       | Bool
otherwise = [Posting
p]

-- | Prepend a suitable indent for a posting (or transaction/posting comment) line.
lineIndent :: String -> String
lineIndent :: FilePath -> FilePath
lineIndent = (FilePath
"    "FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++)

-- | Prepend the space required before a same-line comment.
commentSpace :: String -> String
commentSpace :: FilePath -> FilePath
commentSpace = (FilePath
"  "FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++)

-- | Show an account name, clipped to the given width if any, and
-- appropriately bracketed/parenthesised for the given posting type.
showAccountName :: Maybe Int -> PostingType -> AccountName -> String
showAccountName :: Maybe Int -> PostingType -> Text -> FilePath
showAccountName Maybe Int
w = PostingType -> Text -> FilePath
fmt
  where
    fmt :: PostingType -> Text -> FilePath
fmt PostingType
RegularPosting = (FilePath -> FilePath)
-> (Int -> FilePath -> FilePath)
-> Maybe Int
-> FilePath
-> FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FilePath -> FilePath
forall a. a -> a
id Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
take Maybe Int
w (FilePath -> FilePath) -> (Text -> FilePath) -> Text -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack
    fmt PostingType
VirtualPosting = FilePath -> FilePath
parenthesise (FilePath -> FilePath) -> (Text -> FilePath) -> Text -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> FilePath)
-> (Int -> FilePath -> FilePath)
-> Maybe Int
-> FilePath
-> FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FilePath -> FilePath
forall a. a -> a
id (Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
takeEnd (Int -> FilePath -> FilePath)
-> (Int -> Int) -> Int -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract Int
2) Maybe Int
w (FilePath -> FilePath) -> (Text -> FilePath) -> Text -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack
    fmt PostingType
BalancedVirtualPosting = FilePath -> FilePath
bracket (FilePath -> FilePath) -> (Text -> FilePath) -> Text -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> FilePath)
-> (Int -> FilePath -> FilePath)
-> Maybe Int
-> FilePath
-> FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FilePath -> FilePath
forall a. a -> a
id (Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
takeEnd (Int -> FilePath -> FilePath)
-> (Int -> Int) -> Int -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract Int
2) Maybe Int
w (FilePath -> FilePath) -> (Text -> FilePath) -> Text -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack

parenthesise :: String -> String
parenthesise :: FilePath -> FilePath
parenthesise FilePath
s = FilePath
"("FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
sFilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
")"

bracket :: String -> String
bracket :: FilePath -> FilePath
bracket FilePath
s = FilePath
"["FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
sFilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
"]"

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 (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

-- | Check that this transaction would appear balanced to a human when displayed.
-- On success, returns the empty list, otherwise one or more error messages.
--
-- In more detail:
-- For the real postings, and separately for the balanced virtual postings:
--
-- 1. Convert amounts to cost where possible
--
-- 2. When there are two or more non-zero amounts
--    (appearing non-zero when displayed, using the given display styles if provided),
--    are they a mix of positives and negatives ?
--    This is checked separately to give a clearer error message.
--    (Best effort; could be confused by postings with multicommodity amounts.)
--
-- 3. Does the amounts' sum appear non-zero when displayed ?
--    (using the given display styles if provided)
--
transactionCheckBalanced :: Maybe (M.Map CommoditySymbol AmountStyle) -> Transaction -> [String]
transactionCheckBalanced :: Maybe (Map Text AmountStyle) -> Transaction -> [FilePath]
transactionCheckBalanced Maybe (Map Text AmountStyle)
mstyles Transaction
t = [FilePath]
errs
  where
    ([Posting]
rps, [Posting]
bvps) = (Transaction -> [Posting]
realPostings Transaction
t, Transaction -> [Posting]
balancedVirtualPostings Transaction
t)

    -- check for mixed signs, detecting nonzeros at display precision
    canonicalise :: MixedAmount -> MixedAmount
canonicalise = (MixedAmount -> MixedAmount)
-> (Map Text AmountStyle -> MixedAmount -> MixedAmount)
-> Maybe (Map Text AmountStyle)
-> MixedAmount
-> MixedAmount
forall b a. b -> (a -> b) -> Maybe a -> b
maybe MixedAmount -> MixedAmount
forall a. a -> a
id Map Text AmountStyle -> MixedAmount -> MixedAmount
canonicaliseMixedAmount Maybe (Map Text AmountStyle)
mstyles
    signsOk :: [Posting] -> Bool
signsOk [Posting]
ps = 
      case (MixedAmount -> Bool) -> [MixedAmount] -> [MixedAmount]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not(Bool -> Bool) -> (MixedAmount -> Bool) -> MixedAmount -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.MixedAmount -> Bool
mixedAmountLooksZero) ([MixedAmount] -> [MixedAmount]) -> [MixedAmount] -> [MixedAmount]
forall a b. (a -> b) -> a -> b
$ (Posting -> MixedAmount) -> [Posting] -> [MixedAmount]
forall a b. (a -> b) -> [a] -> [b]
map (MixedAmount -> MixedAmount
canonicalise(MixedAmount -> MixedAmount)
-> (Posting -> MixedAmount) -> Posting -> MixedAmount
forall b c a. (b -> c) -> (a -> b) -> a -> c
.MixedAmount -> MixedAmount
mixedAmountCost(MixedAmount -> MixedAmount)
-> (Posting -> MixedAmount) -> Posting -> MixedAmount
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Posting -> MixedAmount
pamount) [Posting]
ps of
        [MixedAmount]
nonzeros | [MixedAmount] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [MixedAmount]
nonzeros Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2
                   -> [Bool] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Bool] -> [Bool]
forall a. Ord a => [a] -> [a]
nubSort ([Bool] -> [Bool]) -> [Bool] -> [Bool]
forall a b. (a -> b) -> a -> b
$ (MixedAmount -> Maybe Bool) -> [MixedAmount] -> [Bool]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe MixedAmount -> Maybe Bool
isNegativeMixedAmount [MixedAmount]
nonzeros) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1
        [MixedAmount]
_          -> Bool
True
    (Bool
rsignsok, Bool
bvsignsok)       = ([Posting] -> Bool
signsOk [Posting]
rps, [Posting] -> Bool
signsOk [Posting]
bvps)

    -- check for zero sum, at display precision
    (MixedAmount
rsum, MixedAmount
bvsum)               = ([Posting] -> MixedAmount
sumPostings [Posting]
rps, [Posting] -> MixedAmount
sumPostings [Posting]
bvps)
    (MixedAmount
rsumcost, MixedAmount
bvsumcost)       = (MixedAmount -> MixedAmount
mixedAmountCost MixedAmount
rsum, MixedAmount -> MixedAmount
mixedAmountCost MixedAmount
bvsum)
    (MixedAmount
rsumdisplay, MixedAmount
bvsumdisplay) = (MixedAmount -> MixedAmount
canonicalise MixedAmount
rsumcost, MixedAmount -> MixedAmount
canonicalise MixedAmount
bvsumcost)
    (Bool
rsumok, Bool
bvsumok)           = (MixedAmount -> Bool
mixedAmountLooksZero MixedAmount
rsumdisplay, MixedAmount -> Bool
mixedAmountLooksZero MixedAmount
bvsumdisplay)

    -- generate error messages, showing amounts with their original precision
    errs :: [FilePath]
errs = (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not(Bool -> Bool) -> (FilePath -> Bool) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) [FilePath
rmsg, FilePath
bvmsg]
      where
        rmsg :: FilePath
rmsg
          | Bool -> Bool
not Bool
rsignsok  = FilePath
"real postings all have the same sign"
          | Bool -> Bool
not Bool
rsumok    = FilePath
"real postings' sum should be 0 but is: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ MixedAmount -> FilePath
showMixedAmount MixedAmount
rsumcost
          | Bool
otherwise     = FilePath
""
        bvmsg :: FilePath
bvmsg
          | Bool -> Bool
not Bool
bvsignsok = FilePath
"balanced virtual postings all have the same sign"
          | Bool -> Bool
not Bool
bvsumok   = FilePath
"balanced virtual postings' sum should be 0 but is: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ MixedAmount -> FilePath
showMixedAmount MixedAmount
bvsumcost
          | Bool
otherwise     = FilePath
""

-- | Legacy form of transactionCheckBalanced.
isTransactionBalanced :: Maybe (M.Map CommoditySymbol AmountStyle) -> Transaction -> Bool
isTransactionBalanced :: Maybe (Map Text AmountStyle) -> Transaction -> Bool
isTransactionBalanced Maybe (Map Text AmountStyle)
mstyles = [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([FilePath] -> Bool)
-> (Transaction -> [FilePath]) -> Transaction -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Map Text AmountStyle) -> Transaction -> [FilePath]
transactionCheckBalanced Maybe (Map Text AmountStyle)
mstyles

-- | Balance this transaction, ensuring that its postings
-- (and its balanced virtual postings) sum to 0,
-- by inferring a missing amount or conversion price(s) if needed.
-- Or if balancing is not possible, because the amounts don't sum to 0 or
-- because there's more than one missing amount, return an error message.
--
-- Transactions with balance assignments can have more than one
-- missing amount; to balance those you should use the more powerful
-- journalBalanceTransactions.
--
-- The "sum to 0" test is done using commodity display precisions,
-- if provided, so that the result agrees with the numbers users can see.
--
balanceTransaction ::
     Maybe (M.Map CommoditySymbol AmountStyle)  -- ^ commodity display styles
  -> Transaction
  -> Either String Transaction
balanceTransaction :: Maybe (Map Text AmountStyle)
-> Transaction -> Either FilePath Transaction
balanceTransaction Maybe (Map Text AmountStyle)
mstyles = ((Transaction, [(Text, MixedAmount)]) -> Transaction)
-> Either FilePath (Transaction, [(Text, MixedAmount)])
-> Either FilePath Transaction
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Transaction, [(Text, MixedAmount)]) -> Transaction
forall a b. (a, b) -> a
fst (Either FilePath (Transaction, [(Text, MixedAmount)])
 -> Either FilePath Transaction)
-> (Transaction
    -> Either FilePath (Transaction, [(Text, MixedAmount)]))
-> Transaction
-> Either FilePath Transaction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Map Text AmountStyle)
-> Transaction
-> Either FilePath (Transaction, [(Text, MixedAmount)])
balanceTransactionHelper Maybe (Map Text AmountStyle)
mstyles

-- | Helper used by balanceTransaction and balanceTransactionWithBalanceAssignmentAndCheckAssertionsB;
-- use one of those instead. It also returns a list of accounts
-- and amounts that were inferred.
balanceTransactionHelper ::
     Maybe (M.Map CommoditySymbol AmountStyle)  -- ^ commodity display styles
  -> Transaction
  -> Either String (Transaction, [(AccountName, MixedAmount)])
balanceTransactionHelper :: Maybe (Map Text AmountStyle)
-> Transaction
-> Either FilePath (Transaction, [(Text, MixedAmount)])
balanceTransactionHelper Maybe (Map Text AmountStyle)
mstyles Transaction
t = do
  (Transaction
t', [(Text, MixedAmount)]
inferredamtsandaccts) <-
    Map Text AmountStyle
-> Transaction
-> Either FilePath (Transaction, [(Text, MixedAmount)])
inferBalancingAmount (Map Text AmountStyle
-> Maybe (Map Text AmountStyle) -> Map Text AmountStyle
forall a. a -> Maybe a -> a
fromMaybe Map Text AmountStyle
forall k a. Map k a
M.empty Maybe (Map Text AmountStyle)
mstyles) (Transaction
 -> Either FilePath (Transaction, [(Text, MixedAmount)]))
-> Transaction
-> Either FilePath (Transaction, [(Text, MixedAmount)])
forall a b. (a -> b) -> a -> b
$ Transaction -> Transaction
inferBalancingPrices Transaction
t
  case Maybe (Map Text AmountStyle) -> Transaction -> [FilePath]
transactionCheckBalanced Maybe (Map Text AmountStyle)
mstyles Transaction
t' of
    []   -> (Transaction, [(Text, MixedAmount)])
-> Either FilePath (Transaction, [(Text, MixedAmount)])
forall a b. b -> Either a b
Right (Transaction -> Transaction
txnTieKnot Transaction
t', [(Text, MixedAmount)]
inferredamtsandaccts)
    [FilePath]
errs -> FilePath -> Either FilePath (Transaction, [(Text, MixedAmount)])
forall a b. a -> Either a b
Left (FilePath -> Either FilePath (Transaction, [(Text, MixedAmount)]))
-> FilePath -> Either FilePath (Transaction, [(Text, MixedAmount)])
forall a b. (a -> b) -> a -> b
$ Transaction -> [FilePath] -> FilePath
transactionBalanceError Transaction
t' [FilePath]
errs

-- | Generate a transaction balancing error message, given the transaction
-- and one or more suberror messages.
transactionBalanceError :: Transaction -> [String] -> String
transactionBalanceError :: Transaction -> [FilePath] -> FilePath
transactionBalanceError Transaction
t [FilePath]
errs =
  Transaction -> FilePath -> FilePath
annotateErrorWithTransaction Transaction
t (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$
  FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
"\n" ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
"could not balance this transaction:" FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
errs

annotateErrorWithTransaction :: Transaction -> String -> String
annotateErrorWithTransaction :: Transaction -> FilePath -> FilePath
annotateErrorWithTransaction Transaction
t FilePath
s =
  [FilePath] -> FilePath
unlines [GenericSourcePos -> FilePath
showGenericSourcePos (GenericSourcePos -> FilePath) -> GenericSourcePos -> FilePath
forall a b. (a -> b) -> a -> b
$ Transaction -> GenericSourcePos
tsourcepos Transaction
t, FilePath
s, FilePath -> FilePath
rstrip (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ Transaction -> FilePath
showTransaction Transaction
t]

-- | Infer up to one missing amount for this transactions's real postings, and
-- likewise for its balanced virtual postings, if needed; or return an error
-- message if we can't. Returns the updated transaction and any inferred posting amounts,
-- with the corresponding accounts, in order).
--
-- We can infer a missing amount when there are multiple postings and exactly
-- one of them is amountless. If the amounts had price(s) the inferred amount
-- have the same price(s), and will be converted to the price commodity.
inferBalancingAmount ::
     M.Map CommoditySymbol AmountStyle -- ^ commodity display styles
  -> Transaction
  -> Either String (Transaction, [(AccountName, MixedAmount)])
inferBalancingAmount :: Map Text AmountStyle
-> Transaction
-> Either FilePath (Transaction, [(Text, MixedAmount)])
inferBalancingAmount Map Text AmountStyle
styles t :: Transaction
t@Transaction{tpostings :: Transaction -> [Posting]
tpostings=[Posting]
ps}
  | [Posting] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Posting]
amountlessrealps Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1
      = FilePath -> Either FilePath (Transaction, [(Text, MixedAmount)])
forall a b. a -> Either a b
Left (FilePath -> Either FilePath (Transaction, [(Text, MixedAmount)]))
-> FilePath -> Either FilePath (Transaction, [(Text, MixedAmount)])
forall a b. (a -> b) -> a -> b
$ Transaction -> [FilePath] -> FilePath
transactionBalanceError Transaction
t
        [FilePath
"can't have more than one real posting with no amount"
        ,FilePath
"(remember to put two or more spaces between account and amount)"]
  | [Posting] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Posting]
amountlessbvps Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1
      = FilePath -> Either FilePath (Transaction, [(Text, MixedAmount)])
forall a b. a -> Either a b
Left (FilePath -> Either FilePath (Transaction, [(Text, MixedAmount)]))
-> FilePath -> Either FilePath (Transaction, [(Text, MixedAmount)])
forall a b. (a -> b) -> a -> b
$ Transaction -> [FilePath] -> FilePath
transactionBalanceError Transaction
t
        [FilePath
"can't have more than one balanced virtual posting with no amount"
        ,FilePath
"(remember to put two or more spaces between account and amount)"]
  | Bool
otherwise
      = let psandinferredamts :: [(Posting, Maybe MixedAmount)]
psandinferredamts = (Posting -> (Posting, Maybe MixedAmount))
-> [Posting] -> [(Posting, Maybe MixedAmount)]
forall a b. (a -> b) -> [a] -> [b]
map Posting -> (Posting, Maybe MixedAmount)
inferamount [Posting]
ps
            inferredacctsandamts :: [(Text, MixedAmount)]
inferredacctsandamts = [(Posting -> Text
paccount Posting
p, MixedAmount
amt) | (Posting
p, Just MixedAmount
amt) <- [(Posting, Maybe MixedAmount)]
psandinferredamts]
        in (Transaction, [(Text, MixedAmount)])
-> Either FilePath (Transaction, [(Text, MixedAmount)])
forall a b. b -> Either a b
Right (Transaction
t{tpostings :: [Posting]
tpostings=((Posting, Maybe MixedAmount) -> Posting)
-> [(Posting, Maybe MixedAmount)] -> [Posting]
forall a b. (a -> b) -> [a] -> [b]
map (Posting, Maybe MixedAmount) -> Posting
forall a b. (a, b) -> a
fst [(Posting, Maybe MixedAmount)]
psandinferredamts}, [(Text, MixedAmount)]
inferredacctsandamts)
  where
    ([Posting]
amountfulrealps, [Posting]
amountlessrealps) = (Posting -> Bool) -> [Posting] -> ([Posting], [Posting])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition Posting -> Bool
hasAmount (Transaction -> [Posting]
realPostings Transaction
t)
    realsum :: MixedAmount
realsum = [MixedAmount] -> MixedAmount
forall a. Num a => [a] -> a
sumStrict ([MixedAmount] -> MixedAmount) -> [MixedAmount] -> MixedAmount
forall a b. (a -> b) -> a -> b
$ (Posting -> MixedAmount) -> [Posting] -> [MixedAmount]
forall a b. (a -> b) -> [a] -> [b]
map Posting -> MixedAmount
pamount [Posting]
amountfulrealps
    ([Posting]
amountfulbvps, [Posting]
amountlessbvps) = (Posting -> Bool) -> [Posting] -> ([Posting], [Posting])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition Posting -> Bool
hasAmount (Transaction -> [Posting]
balancedVirtualPostings Transaction
t)
    bvsum :: MixedAmount
bvsum = [MixedAmount] -> MixedAmount
forall a. Num a => [a] -> a
sumStrict ([MixedAmount] -> MixedAmount) -> [MixedAmount] -> MixedAmount
forall a b. (a -> b) -> a -> b
$ (Posting -> MixedAmount) -> [Posting] -> [MixedAmount]
forall a b. (a -> b) -> [a] -> [b]
map Posting -> MixedAmount
pamount [Posting]
amountfulbvps

    inferamount :: Posting -> (Posting, Maybe MixedAmount)
    inferamount :: Posting -> (Posting, Maybe MixedAmount)
inferamount Posting
p =
      let
        minferredamt :: Maybe MixedAmount
minferredamt = case Posting -> PostingType
ptype Posting
p of
          PostingType
RegularPosting         | Bool -> Bool
not (Posting -> Bool
hasAmount Posting
p) -> MixedAmount -> Maybe MixedAmount
forall a. a -> Maybe a
Just MixedAmount
realsum
          PostingType
BalancedVirtualPosting | Bool -> Bool
not (Posting -> Bool
hasAmount Posting
p) -> MixedAmount -> Maybe MixedAmount
forall a. a -> Maybe a
Just MixedAmount
bvsum
          PostingType
_                                          -> Maybe MixedAmount
forall a. Maybe a
Nothing
      in
        case Maybe MixedAmount
minferredamt of
          Maybe MixedAmount
Nothing -> (Posting
p, Maybe MixedAmount
forall a. Maybe a
Nothing)
          Just MixedAmount
a  -> (Posting
p{pamount :: MixedAmount
pamount=MixedAmount
a', poriginal :: Maybe Posting
poriginal=Posting -> Maybe Posting
forall a. a -> Maybe a
Just (Posting -> Maybe Posting) -> Posting -> Maybe Posting
forall a b. (a -> b) -> a -> b
$ Posting -> Posting
originalPosting Posting
p}, MixedAmount -> Maybe MixedAmount
forall a. a -> Maybe a
Just MixedAmount
a')
            where
              -- Inferred amounts are converted to cost.
              -- Also ensure the new amount has the standard style for its commodity
              -- (since the main amount styling pass happened before this balancing pass);
              a' :: MixedAmount
a' = Map Text AmountStyle -> MixedAmount -> MixedAmount
styleMixedAmount Map Text AmountStyle
styles (MixedAmount -> MixedAmount) -> MixedAmount -> MixedAmount
forall a b. (a -> b) -> a -> b
$ MixedAmount -> MixedAmount
normaliseMixedAmount (MixedAmount -> MixedAmount) -> MixedAmount -> MixedAmount
forall a b. (a -> b) -> a -> b
$ MixedAmount -> MixedAmount
mixedAmountCost (-MixedAmount
a)

-- | Infer prices for this transaction's posting amounts, if needed to make
-- the postings balance, and if possible. This is done once for the real
-- postings and again (separately) for the balanced virtual postings. When
-- it's not possible, the transaction is left unchanged.
--
-- The simplest example is a transaction with two postings, each in a
-- different commodity, with no prices specified. In this case we'll add a
-- price to the first posting such that it can be converted to the commodity
-- of the second posting (with -B), and such that the postings balance.
--
-- In general, we can infer a conversion price when the sum of posting amounts
-- contains exactly two different commodities and no explicit prices.  Also
-- all postings are expected to contain an explicit amount (no missing
-- amounts) in a single commodity. Otherwise no price inferring is attempted.
--
-- The transaction itself could contain more than two commodities, and/or
-- prices, if they cancel out; what matters is that the sum of posting amounts
-- contains exactly two commodities and zero prices.
--
-- There can also be more than two postings in either of the commodities.
--
-- We want to avoid excessive display of digits when the calculated price is
-- an irrational number, while hopefully also ensuring the displayed numbers
-- make sense if the user does a manual calculation. This is (mostly) achieved
-- in two ways:
--
-- - when there is only one posting in the "from" commodity, a total price
--   (@@) is used, and all available decimal digits are shown
--
-- - otherwise, a suitable averaged unit price (@) is applied to the relevant
--   postings, with display precision equal to the summed display precisions
--   of the two commodities being converted between, or 2, whichever is larger.
--
-- (We don't always calculate a good-looking display precision for unit prices
-- when the commodity display precisions are low, eg when a journal doesn't
-- use any decimal places. The minimum of 2 helps make the prices shown by the
-- print command a bit less surprising in this case. Could do better.)
--
inferBalancingPrices :: Transaction -> Transaction
inferBalancingPrices :: Transaction -> Transaction
inferBalancingPrices t :: Transaction
t@Transaction{tpostings :: Transaction -> [Posting]
tpostings=[Posting]
ps} = Transaction
t{tpostings :: [Posting]
tpostings=[Posting]
ps'}
  where
    ps' :: [Posting]
ps' = (Posting -> Posting) -> [Posting] -> [Posting]
forall a b. (a -> b) -> [a] -> [b]
map (Transaction -> PostingType -> Posting -> Posting
priceInferrerFor Transaction
t PostingType
BalancedVirtualPosting (Posting -> Posting) -> (Posting -> Posting) -> Posting -> Posting
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> PostingType -> Posting -> Posting
priceInferrerFor Transaction
t PostingType
RegularPosting) [Posting]
ps

-- | Generate a posting update function which assigns a suitable balancing
-- price to the posting, if and as appropriate for the given transaction and
-- posting type (real or balanced virtual).
priceInferrerFor :: Transaction -> PostingType -> (Posting -> Posting)
priceInferrerFor :: Transaction -> PostingType -> Posting -> Posting
priceInferrerFor Transaction
t PostingType
pt = Posting -> Posting
inferprice
  where
    postings :: [Posting]
postings       = (Posting -> Bool) -> [Posting] -> [Posting]
forall a. (a -> Bool) -> [a] -> [a]
filter ((PostingType -> PostingType -> Bool
forall a. Eq a => a -> a -> Bool
==PostingType
pt)(PostingType -> Bool)
-> (Posting -> PostingType) -> Posting -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Posting -> PostingType
ptype) ([Posting] -> [Posting]) -> [Posting] -> [Posting]
forall a b. (a -> b) -> a -> b
$ Transaction -> [Posting]
tpostings Transaction
t
    pmixedamounts :: [MixedAmount]
pmixedamounts  = (Posting -> MixedAmount) -> [Posting] -> [MixedAmount]
forall a b. (a -> b) -> [a] -> [b]
map Posting -> MixedAmount
pamount [Posting]
postings
    pamounts :: [Amount]
pamounts       = (MixedAmount -> [Amount]) -> [MixedAmount] -> [Amount]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap MixedAmount -> [Amount]
amounts [MixedAmount]
pmixedamounts
    pcommodities :: [Text]
pcommodities   = (Amount -> Text) -> [Amount] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Amount -> Text
acommodity [Amount]
pamounts
    sumamounts :: [Amount]
sumamounts     = MixedAmount -> [Amount]
amounts (MixedAmount -> [Amount]) -> MixedAmount -> [Amount]
forall a b. (a -> b) -> a -> b
$ [MixedAmount] -> MixedAmount
forall a. Num a => [a] -> a
sumStrict [MixedAmount]
pmixedamounts -- sum normalises to one amount per commodity & price
    sumcommodities :: [Text]
sumcommodities = (Amount -> Text) -> [Amount] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Amount -> Text
acommodity [Amount]
sumamounts
    sumprices :: [Maybe AmountPrice]
sumprices      = (Maybe AmountPrice -> Bool)
-> [Maybe AmountPrice] -> [Maybe AmountPrice]
forall a. (a -> Bool) -> [a] -> [a]
filter (Maybe AmountPrice -> Maybe AmountPrice -> Bool
forall a. Eq a => a -> a -> Bool
/=Maybe AmountPrice
forall a. Maybe a
Nothing) ([Maybe AmountPrice] -> [Maybe AmountPrice])
-> [Maybe AmountPrice] -> [Maybe AmountPrice]
forall a b. (a -> b) -> a -> b
$ (Amount -> Maybe AmountPrice) -> [Amount] -> [Maybe AmountPrice]
forall a b. (a -> b) -> [a] -> [b]
map Amount -> Maybe AmountPrice
aprice [Amount]
sumamounts
    caninferprices :: Bool
caninferprices = [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
sumcommodities Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 Bool -> Bool -> Bool
&& [Maybe AmountPrice] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Maybe AmountPrice]
sumprices

    inferprice :: Posting -> Posting
inferprice p :: Posting
p@Posting{pamount :: Posting -> MixedAmount
pamount=Mixed [Amount
a]}
      | Bool
caninferprices Bool -> Bool -> Bool
&& Posting -> PostingType
ptype Posting
p PostingType -> PostingType -> Bool
forall a. Eq a => a -> a -> Bool
== PostingType
pt Bool -> Bool -> Bool
&& Amount -> Text
acommodity Amount
a Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
fromcommodity
        = Posting
p{pamount :: MixedAmount
pamount=[Amount] -> MixedAmount
Mixed [Amount
a{aprice :: Maybe AmountPrice
aprice=AmountPrice -> Maybe AmountPrice
forall a. a -> Maybe a
Just AmountPrice
conversionprice}], poriginal :: Maybe Posting
poriginal=Posting -> Maybe Posting
forall a. a -> Maybe a
Just (Posting -> Maybe Posting) -> Posting -> Maybe Posting
forall a b. (a -> b) -> a -> b
$ Posting -> Posting
originalPosting Posting
p}
      where
        fromcommodity :: Text
fromcommodity = [Text] -> Text
forall a. [a] -> a
head ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
sumcommodities) [Text]
pcommodities -- these heads are ugly but should be safe
        conversionprice :: AmountPrice
conversionprice
          | Int
fromcountInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
1 = Amount -> AmountPrice
TotalPrice (Amount -> AmountPrice) -> Amount -> AmountPrice
forall a b. (a -> b) -> a -> b
$ Amount -> Amount
forall a. Num a => a -> a
abs Amount
toamount Amount -> AmountPrecision -> Amount
`withPrecision` AmountPrecision
NaturalPrecision
          | Bool
otherwise    = Amount -> AmountPrice
UnitPrice (Amount -> AmountPrice) -> Amount -> AmountPrice
forall a b. (a -> b) -> a -> b
$ Amount -> Amount
forall a. Num a => a -> a
abs Amount
unitprice Amount -> AmountPrecision -> Amount
`withPrecision` AmountPrecision
unitprecision
          where
            fromcount :: Int
fromcount     = [Amount] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Amount] -> Int) -> [Amount] -> Int
forall a b. (a -> b) -> a -> b
$ (Amount -> Bool) -> [Amount] -> [Amount]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
==Text
fromcommodity)(Text -> Bool) -> (Amount -> Text) -> Amount -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Amount -> Text
acommodity) [Amount]
pamounts
            fromamount :: Amount
fromamount    = [Amount] -> Amount
forall a. [a] -> a
head ([Amount] -> Amount) -> [Amount] -> Amount
forall a b. (a -> b) -> a -> b
$ (Amount -> Bool) -> [Amount] -> [Amount]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
==Text
fromcommodity)(Text -> Bool) -> (Amount -> Text) -> Amount -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Amount -> Text
acommodity) [Amount]
sumamounts
            fromprecision :: AmountPrecision
fromprecision = AmountStyle -> AmountPrecision
asprecision (AmountStyle -> AmountPrecision) -> AmountStyle -> AmountPrecision
forall a b. (a -> b) -> a -> b
$ Amount -> AmountStyle
astyle Amount
fromamount
            tocommodity :: Text
tocommodity   = [Text] -> Text
forall a. [a] -> a
head ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/=Text
fromcommodity) [Text]
sumcommodities
            toamount :: Amount
toamount      = [Amount] -> Amount
forall a. [a] -> a
head ([Amount] -> Amount) -> [Amount] -> Amount
forall a b. (a -> b) -> a -> b
$ (Amount -> Bool) -> [Amount] -> [Amount]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
==Text
tocommodity)(Text -> Bool) -> (Amount -> Text) -> Amount -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Amount -> Text
acommodity) [Amount]
sumamounts
            toprecision :: AmountPrecision
toprecision   = AmountStyle -> AmountPrecision
asprecision (AmountStyle -> AmountPrecision) -> AmountStyle -> AmountPrecision
forall a b. (a -> b) -> a -> b
$ Amount -> AmountStyle
astyle Amount
toamount
            unitprice :: Amount
unitprice     = (Amount -> Quantity
aquantity Amount
fromamount) Quantity -> Amount -> Amount
`divideAmount` Amount
toamount
            -- Sum two display precisions, capping the result at the maximum bound
            unitprecision :: AmountPrecision
unitprecision = case (AmountPrecision
fromprecision, AmountPrecision
toprecision) of
                (Precision Word8
a, Precision Word8
b) -> Word8 -> AmountPrecision
Precision (Word8 -> AmountPrecision) -> Word8 -> AmountPrecision
forall a b. (a -> b) -> a -> b
$ if Word8
forall a. Bounded a => a
maxBound Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
a Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
b then Word8
forall a. Bounded a => a
maxBound else Word8 -> Word8 -> Word8
forall a. Ord a => a -> a -> a
max Word8
2 (Word8
a Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
b)
                (AmountPrecision, AmountPrecision)
_                          -> AmountPrecision
NaturalPrecision
    inferprice Posting
p = Posting
p

-- Get a transaction's secondary date, defaulting to the primary date.
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

-- | 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, reference dates, and
-- whether this is for a multiperiod report or not. See
-- amountApplyValuation.
transactionApplyValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Maybe Day -> Day -> Bool -> Transaction -> ValuationType -> Transaction
transactionApplyValuation :: PriceOracle
-> Map Text AmountStyle
-> Day
-> Maybe Day
-> Day
-> Bool
-> Transaction
-> ValuationType
-> Transaction
transactionApplyValuation PriceOracle
priceoracle Map Text AmountStyle
styles Day
periodlast Maybe Day
mreportlast Day
today Bool
ismultiperiod Transaction
t ValuationType
v =
  (Posting -> Posting) -> Transaction -> Transaction
transactionTransformPostings (\Posting
p -> PriceOracle
-> Map Text AmountStyle
-> Day
-> Maybe Day
-> Day
-> Bool
-> Posting
-> ValuationType
-> Posting
postingApplyValuation PriceOracle
priceoracle Map Text AmountStyle
styles Day
periodlast Maybe Day
mreportlast Day
today Bool
ismultiperiod Posting
p ValuationType
v) Transaction
t

-- | Convert this transaction's amounts to cost, and apply the appropriate amount styles.
transactionToCost :: M.Map CommoditySymbol AmountStyle -> Transaction -> Transaction
transactionToCost :: Map Text AmountStyle -> Transaction -> Transaction
transactionToCost Map Text AmountStyle
styles 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 (Map Text AmountStyle -> Posting -> Posting
postingToCost Map Text AmountStyle
styles) [Posting]
ps}

-- | 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 FilePath Transaction
transactionApplyAliases [AccountAlias]
aliases Transaction
t =
  case (Posting -> Either FilePath Posting)
-> [Posting] -> Either FilePath [Posting]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ([AccountAlias] -> Posting -> Either FilePath Posting
postingApplyAliases [AccountAlias]
aliases) ([Posting] -> Either FilePath [Posting])
-> [Posting] -> Either FilePath [Posting]
forall a b. (a -> b) -> a -> b
$ Transaction -> [Posting]
tpostings Transaction
t of
    Right [Posting]
ps -> Transaction -> Either FilePath Transaction
forall a b. b -> Either a b
Right (Transaction -> Either FilePath Transaction)
-> Transaction -> Either FilePath 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 FilePath
err -> FilePath -> Either FilePath Transaction
forall a b. a -> Either a b
Left FilePath
err

-- tests

tests_Transaction :: TestTree
tests_Transaction :: TestTree
tests_Transaction =
  FilePath -> [TestTree] -> TestTree
tests FilePath
"Transaction" [

      FilePath -> [TestTree] -> TestTree
tests FilePath
"postingAsLines" [
          FilePath -> Assertion -> TestTree
test FilePath
"null posting" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> [Posting] -> Posting -> [FilePath]
postingAsLines Bool
False Bool
False [Posting
posting] Posting
posting [FilePath] -> [FilePath] -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= [FilePath
""]
        , FilePath -> Assertion -> TestTree
test FilePath
"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
Mixed [Quantity -> Amount
usd Quantity
1, Quantity -> Amount
hrs Quantity
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 Bool -> Bool -> [Posting] -> Posting -> [FilePath]
postingAsLines Bool
False Bool
False [Posting
p] Posting
p [FilePath] -> [FilePath] -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
              [ FilePath
"    * a         $1.00  ; pcomment1"
              , FilePath
"    ; pcomment2"
              , FilePath
"    ;   tag3: val3  "
              , FilePath
"    * a         2.00h  ; pcomment1"
              , FilePath
"    ; pcomment2"
              , FilePath
"    ;   tag3: val3  "
              ]
        ]

    , let
        -- one implicit amount
        timp :: Transaction
timp = Transaction
nulltransaction {tpostings :: [Posting]
tpostings = [Text
"a" Text -> Amount -> Posting
`post` Quantity -> Amount
usd Quantity
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` Quantity -> Amount
usd Quantity
1, Text
"b" Text -> Amount -> Posting
`post` Quantity -> Amount
usd (-Quantity
1)]}
        -- explicit amount, only one posting
        texp1 :: Transaction
texp1 = Transaction
nulltransaction {tpostings :: [Posting]
tpostings = [Text
"(a)" Text -> Amount -> Posting
`post` Quantity -> Amount
usd Quantity
1]}
        -- explicit amounts, two commodities, explicit balancing price
        texp2 :: Transaction
texp2 = Transaction
nulltransaction {tpostings :: [Posting]
tpostings = [Text
"a" Text -> Amount -> Posting
`post` Quantity -> Amount
usd Quantity
1, Text
"b" Text -> Amount -> Posting
`post` (Quantity -> Amount
hrs (-Quantity
1) Amount -> Amount -> Amount
`at` Quantity -> Amount
usd Quantity
1)]}
        -- explicit amounts, two commodities, implicit balancing price
        texp2b :: Transaction
texp2b = Transaction
nulltransaction {tpostings :: [Posting]
tpostings = [Text
"a" Text -> Amount -> Posting
`post` Quantity -> Amount
usd Quantity
1, Text
"b" Text -> Amount -> Posting
`post` Quantity -> Amount
hrs (-Quantity
1)]}
        -- one missing amount, not the last one
        t3 :: Transaction
t3 = Transaction
nulltransaction {tpostings :: [Posting]
tpostings = [Text
"a" Text -> Amount -> Posting
`post` Quantity -> Amount
usd Quantity
1, Text
"b" Text -> Amount -> Posting
`post` Amount
missingamt, Text
"c" Text -> Amount -> Posting
`post` Quantity -> Amount
usd (-Quantity
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 FilePath -> [TestTree] -> TestTree
tests FilePath
"postingsAsLines" [
              FilePath -> Assertion -> TestTree
test FilePath
"null-transaction" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ Bool -> [Posting] -> [FilePath]
postingsAsLines Bool
False (Transaction -> [Posting]
tpostings Transaction
nulltransaction) [FilePath] -> [FilePath] -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= []
            , FilePath -> Assertion -> TestTree
test FilePath
"implicit-amount" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ Bool -> [Posting] -> [FilePath]
postingsAsLines Bool
False (Transaction -> [Posting]
tpostings Transaction
timp) [FilePath] -> [FilePath] -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
                  [ FilePath
"    a           $1.00"
                  , FilePath
"    b" -- implicit amount remains implicit
                  ]
            , FilePath -> Assertion -> TestTree
test FilePath
"explicit-amounts" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ Bool -> [Posting] -> [FilePath]
postingsAsLines Bool
False (Transaction -> [Posting]
tpostings Transaction
texp) [FilePath] -> [FilePath] -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
                  [ FilePath
"    a           $1.00"
                  , FilePath
"    b          $-1.00"
                  ]
            , FilePath -> Assertion -> TestTree
test FilePath
"one-explicit-amount" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ Bool -> [Posting] -> [FilePath]
postingsAsLines Bool
False (Transaction -> [Posting]
tpostings Transaction
texp1) [FilePath] -> [FilePath] -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
                  [ FilePath
"    (a)           $1.00"
                  ]
            , FilePath -> Assertion -> TestTree
test FilePath
"explicit-amounts-two-commodities" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ Bool -> [Posting] -> [FilePath]
postingsAsLines Bool
False (Transaction -> [Posting]
tpostings Transaction
texp2) [FilePath] -> [FilePath] -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
                  [ FilePath
"    a             $1.00"
                  , FilePath
"    b    -1.00h @ $1.00"
                  ]
            , FilePath -> Assertion -> TestTree
test FilePath
"explicit-amounts-not-explicitly-balanced" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ Bool -> [Posting] -> [FilePath]
postingsAsLines Bool
False (Transaction -> [Posting]
tpostings Transaction
texp2b) [FilePath] -> [FilePath] -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
                  [ FilePath
"    a           $1.00"
                  , FilePath
"    b          -1.00h"
                  ]
            , FilePath -> Assertion -> TestTree
test FilePath
"implicit-amount-not-last" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ Bool -> [Posting] -> [FilePath]
postingsAsLines Bool
False (Transaction -> [Posting]
tpostings Transaction
t3) [FilePath] -> [FilePath] -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
                  [FilePath
"    a           $1.00", FilePath
"    b", FilePath
"    c          $-1.00"]
            -- , test "ensure-visibly-balanced" $
            --    in postingsAsLines False (tpostings t4) @?=
            --       ["    a          $-0.01", "    b           $0.005", "    c           $0.005"]

            ]

    , FilePath -> Assertion -> TestTree
test FilePath
"inferBalancingAmount" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
         ((Transaction, [(Text, MixedAmount)]) -> Transaction
forall a b. (a, b) -> a
fst ((Transaction, [(Text, MixedAmount)]) -> Transaction)
-> Either FilePath (Transaction, [(Text, MixedAmount)])
-> Either FilePath Transaction
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text AmountStyle
-> Transaction
-> Either FilePath (Transaction, [(Text, MixedAmount)])
inferBalancingAmount Map Text AmountStyle
forall k a. Map k a
M.empty Transaction
nulltransaction) Either FilePath Transaction
-> Either FilePath Transaction -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Transaction -> Either FilePath Transaction
forall a b. b -> Either a b
Right Transaction
nulltransaction
         ((Transaction, [(Text, MixedAmount)]) -> Transaction
forall a b. (a, b) -> a
fst ((Transaction, [(Text, MixedAmount)]) -> Transaction)
-> Either FilePath (Transaction, [(Text, MixedAmount)])
-> Either FilePath Transaction
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text AmountStyle
-> Transaction
-> Either FilePath (Transaction, [(Text, MixedAmount)])
inferBalancingAmount Map Text AmountStyle
forall k a. Map k a
M.empty Transaction
nulltransaction{tpostings :: [Posting]
tpostings = [Text
"a" Text -> Amount -> Posting
`post` Quantity -> Amount
usd (-Quantity
5), Text
"b" Text -> Amount -> Posting
`post` Amount
missingamt]}) Either FilePath Transaction
-> Either FilePath Transaction -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
           Transaction -> Either FilePath Transaction
forall a b. b -> Either a b
Right Transaction
nulltransaction{tpostings :: [Posting]
tpostings = [Text
"a" Text -> Amount -> Posting
`post` Quantity -> Amount
usd (-Quantity
5), Text
"b" Text -> Amount -> Posting
`post` Quantity -> Amount
usd Quantity
5]}
         ((Transaction, [(Text, MixedAmount)]) -> Transaction
forall a b. (a, b) -> a
fst ((Transaction, [(Text, MixedAmount)]) -> Transaction)
-> Either FilePath (Transaction, [(Text, MixedAmount)])
-> Either FilePath Transaction
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text AmountStyle
-> Transaction
-> Either FilePath (Transaction, [(Text, MixedAmount)])
inferBalancingAmount Map Text AmountStyle
forall k a. Map k a
M.empty Transaction
nulltransaction{tpostings :: [Posting]
tpostings = [Text
"a" Text -> Amount -> Posting
`post` Quantity -> Amount
usd (-Quantity
5), Text
"b" Text -> Amount -> Posting
`post` (Quantity -> Amount
eur Quantity
3 Amount -> Amount -> Amount
@@ Quantity -> Amount
usd Quantity
4), Text
"c" Text -> Amount -> Posting
`post` Amount
missingamt]}) Either FilePath Transaction
-> Either FilePath Transaction -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
           Transaction -> Either FilePath Transaction
forall a b. b -> Either a b
Right Transaction
nulltransaction{tpostings :: [Posting]
tpostings = [Text
"a" Text -> Amount -> Posting
`post` Quantity -> Amount
usd (-Quantity
5), Text
"b" Text -> Amount -> Posting
`post` (Quantity -> Amount
eur Quantity
3 Amount -> Amount -> Amount
@@ Quantity -> Amount
usd Quantity
4), Text
"c" Text -> Amount -> Posting
`post` Quantity -> Amount
usd Quantity
1]}
         
    , FilePath -> [TestTree] -> TestTree
tests FilePath
"showTransaction" [
          FilePath -> Assertion -> TestTree
test FilePath
"null transaction" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ Transaction -> FilePath
showTransaction Transaction
nulltransaction FilePath -> FilePath -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= FilePath
"0000-01-01\n\n"
        , FilePath -> Assertion -> TestTree
test FilePath
"non-null transaction" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ Transaction -> FilePath
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
Mixed [Quantity -> Amount
usd Quantity
1, Quantity -> Amount
hrs Quantity
2]
                      , pcomment :: Text
pcomment = Text
"\npcomment2\n"
                      , ptype :: PostingType
ptype = PostingType
RegularPosting
                      , ptags :: [Tag]
ptags = [(Text
"ptag1", Text
"val1"), (Text
"ptag2", Text
"val2")]
                      }
                  ]
              } FilePath -> FilePath -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
          [FilePath] -> FilePath
unlines
            [ FilePath
"2012-05-14=2012-05-15 (code) desc  ; tcomment1"
            , FilePath
"    ; tcomment2"
            , FilePath
"    * a         $1.00"
            , FilePath
"    ; pcomment2"
            , FilePath
"    * a         2.00h"
            , FilePath
"    ; pcomment2"
            , FilePath
""
            ]
        , FilePath -> Assertion -> TestTree
test FilePath
"show a balanced transaction" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
          (let t :: Transaction
t =
                 Integer
-> Text
-> GenericSourcePos
-> Day
-> Maybe Day
-> Status
-> Text
-> Text
-> Text
-> [Tag]
-> [Posting]
-> Transaction
Transaction
                   Integer
0
                   Text
""
                   GenericSourcePos
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
Mixed [Quantity -> Amount
usd Quantity
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
Mixed [Quantity -> Amount
usd (-Quantity
47.18)], ptransaction :: Maybe Transaction
ptransaction = Transaction -> Maybe Transaction
forall a. a -> Maybe a
Just Transaction
t}
                   ]
            in Transaction -> FilePath
showTransaction Transaction
t) FilePath -> FilePath -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
          ([FilePath] -> FilePath
unlines
             [ FilePath
"2007-01-28 coopportunity"
             , FilePath
"    expenses:food:groceries          $47.18"
             , FilePath
"    assets:checking                 $-47.18"
             , FilePath
""
             ])
        , FilePath -> Assertion -> TestTree
test FilePath
"show an unbalanced transaction, should not elide" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
          (Transaction -> FilePath
showTransaction
             (Transaction -> Transaction
txnTieKnot (Transaction -> Transaction) -> Transaction -> Transaction
forall a b. (a -> b) -> a -> b
$
              Integer
-> Text
-> GenericSourcePos
-> Day
-> Maybe Day
-> Status
-> Text
-> Text
-> Text
-> [Tag]
-> [Posting]
-> Transaction
Transaction
                Integer
0
                Text
""
                GenericSourcePos
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
Mixed [Quantity -> Amount
usd Quantity
47.18]}
                , Posting
posting {paccount :: Text
paccount = Text
"assets:checking", pamount :: MixedAmount
pamount = [Amount] -> MixedAmount
Mixed [Quantity -> Amount
usd (-Quantity
47.19)]}
                ])) FilePath -> FilePath -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
          ([FilePath] -> FilePath
unlines
             [ FilePath
"2007-01-28 coopportunity"
             , FilePath
"    expenses:food:groceries          $47.18"
             , FilePath
"    assets:checking                 $-47.19"
             , FilePath
""
             ])
        , FilePath -> Assertion -> TestTree
test FilePath
"show a transaction with one posting and a missing amount" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
          (Transaction -> FilePath
showTransaction
             (Transaction -> Transaction
txnTieKnot (Transaction -> Transaction) -> Transaction -> Transaction
forall a b. (a -> b) -> a -> b
$
              Integer
-> Text
-> GenericSourcePos
-> Day
-> Maybe Day
-> Status
-> Text
-> Text
-> Text
-> [Tag]
-> [Posting]
-> Transaction
Transaction
                Integer
0
                Text
""
                GenericSourcePos
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}])) FilePath -> FilePath -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
          ([FilePath] -> FilePath
unlines [FilePath
"2007-01-28 coopportunity", FilePath
"    expenses:food:groceries", FilePath
""])
        , FilePath -> Assertion -> TestTree
test FilePath
"show a transaction with a priced commodityless amount" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
          (Transaction -> FilePath
showTransaction
             (Transaction -> Transaction
txnTieKnot (Transaction -> Transaction) -> Transaction -> Transaction
forall a b. (a -> b) -> a -> b
$
              Integer
-> Text
-> GenericSourcePos
-> Day
-> Maybe Day
-> Status
-> Text
-> Text
-> Text
-> [Tag]
-> [Posting]
-> Transaction
Transaction
                Integer
0
                Text
""
                GenericSourcePos
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
Mixed [Quantity -> Amount
num Quantity
1 Amount -> Amount -> Amount
`at` (Quantity -> Amount
usd Quantity
2 Amount -> AmountPrecision -> Amount
`withPrecision` Word8 -> AmountPrecision
Precision Word8
0)]}
                , Posting
posting {paccount :: Text
paccount = Text
"b", pamount :: MixedAmount
pamount = MixedAmount
missingmixedamt}
                ])) FilePath -> FilePath -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
          ([FilePath] -> FilePath
unlines [FilePath
"2010-01-01 x", FilePath
"    a          1 @ $2", FilePath
"    b", FilePath
""])
        ]
    , FilePath -> [TestTree] -> TestTree
tests FilePath
"balanceTransaction" [
         FilePath -> Assertion -> TestTree
test FilePath
"detect unbalanced entry, sign error" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
          Either FilePath Transaction -> Assertion
forall b a. (HasCallStack, Eq b, Show b) => Either a b -> Assertion
assertLeft
            (Maybe (Map Text AmountStyle)
-> Transaction -> Either FilePath Transaction
balanceTransaction
               Maybe (Map Text AmountStyle)
forall a. Maybe a
Nothing
               (Integer
-> Text
-> GenericSourcePos
-> Day
-> Maybe Day
-> Status
-> Text
-> Text
-> Text
-> [Tag]
-> [Posting]
-> Transaction
Transaction
                  Integer
0
                  Text
""
                  GenericSourcePos
nullsourcepos
                  (Integer -> Int -> Int -> Day
fromGregorian Integer
2007 Int
01 Int
28)
                  Maybe Day
forall a. Maybe a
Nothing
                  Status
Unmarked
                  Text
""
                  Text
"test"
                  Text
""
                  []
                  [Posting
posting {paccount :: Text
paccount = Text
"a", pamount :: MixedAmount
pamount = [Amount] -> MixedAmount
Mixed [Quantity -> Amount
usd Quantity
1]}, Posting
posting {paccount :: Text
paccount = Text
"b", pamount :: MixedAmount
pamount = [Amount] -> MixedAmount
Mixed [Quantity -> Amount
usd Quantity
1]}]))
        ,FilePath -> Assertion -> TestTree
test FilePath
"detect unbalanced entry, multiple missing amounts" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
          Either FilePath Transaction -> Assertion
forall b a. (HasCallStack, Eq b, Show b) => Either a b -> Assertion
assertLeft (Either FilePath Transaction -> Assertion)
-> Either FilePath Transaction -> Assertion
forall a b. (a -> b) -> a -> b
$
             Maybe (Map Text AmountStyle)
-> Transaction -> Either FilePath Transaction
balanceTransaction
               Maybe (Map Text AmountStyle)
forall a. Maybe a
Nothing
               (Integer
-> Text
-> GenericSourcePos
-> Day
-> Maybe Day
-> Status
-> Text
-> Text
-> Text
-> [Tag]
-> [Posting]
-> Transaction
Transaction
                  Integer
0
                  Text
""
                  GenericSourcePos
nullsourcepos
                  (Integer -> Int -> Int -> Day
fromGregorian Integer
2007 Int
01 Int
28)
                  Maybe Day
forall a. Maybe a
Nothing
                  Status
Unmarked
                  Text
""
                  Text
"test"
                  Text
""
                  []
                  [ Posting
posting {paccount :: Text
paccount = Text
"a", pamount :: MixedAmount
pamount = MixedAmount
missingmixedamt}
                  , Posting
posting {paccount :: Text
paccount = Text
"b", pamount :: MixedAmount
pamount = MixedAmount
missingmixedamt}
                  ])
        ,FilePath -> Assertion -> TestTree
test FilePath
"one missing amount is inferred" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
          (Posting -> MixedAmount
pamount (Posting -> MixedAmount)
-> (Transaction -> Posting) -> Transaction -> MixedAmount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Posting] -> Posting
forall a. [a] -> a
last ([Posting] -> Posting)
-> (Transaction -> [Posting]) -> Transaction -> Posting
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> [Posting]
tpostings (Transaction -> MixedAmount)
-> Either FilePath Transaction -> Either FilePath MixedAmount
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
           Maybe (Map Text AmountStyle)
-> Transaction -> Either FilePath Transaction
balanceTransaction
             Maybe (Map Text AmountStyle)
forall a. Maybe a
Nothing
             (Integer
-> Text
-> GenericSourcePos
-> Day
-> Maybe Day
-> Status
-> Text
-> Text
-> Text
-> [Tag]
-> [Posting]
-> Transaction
Transaction
                Integer
0
                Text
""
                GenericSourcePos
nullsourcepos
                (Integer -> Int -> Int -> Day
fromGregorian Integer
2007 Int
01 Int
28)
                Maybe Day
forall a. Maybe a
Nothing
                Status
Unmarked
                Text
""
                Text
""
                Text
""
                []
                [Posting
posting {paccount :: Text
paccount = Text
"a", pamount :: MixedAmount
pamount = [Amount] -> MixedAmount
Mixed [Quantity -> Amount
usd Quantity
1]}, Posting
posting {paccount :: Text
paccount = Text
"b", pamount :: MixedAmount
pamount = MixedAmount
missingmixedamt}])) Either FilePath MixedAmount
-> Either FilePath MixedAmount -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
          MixedAmount -> Either FilePath MixedAmount
forall a b. b -> Either a b
Right ([Amount] -> MixedAmount
Mixed [Quantity -> Amount
usd (-Quantity
1)])
        ,FilePath -> Assertion -> TestTree
test FilePath
"conversion price is inferred" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
          (Posting -> MixedAmount
pamount (Posting -> MixedAmount)
-> (Transaction -> Posting) -> Transaction -> MixedAmount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Posting] -> Posting
forall a. [a] -> a
head ([Posting] -> Posting)
-> (Transaction -> [Posting]) -> Transaction -> Posting
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> [Posting]
tpostings (Transaction -> MixedAmount)
-> Either FilePath Transaction -> Either FilePath MixedAmount
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
           Maybe (Map Text AmountStyle)
-> Transaction -> Either FilePath Transaction
balanceTransaction
             Maybe (Map Text AmountStyle)
forall a. Maybe a
Nothing
             (Integer
-> Text
-> GenericSourcePos
-> Day
-> Maybe Day
-> Status
-> Text
-> Text
-> Text
-> [Tag]
-> [Posting]
-> Transaction
Transaction
                Integer
0
                Text
""
                GenericSourcePos
nullsourcepos
                (Integer -> Int -> Int -> Day
fromGregorian Integer
2007 Int
01 Int
28)
                Maybe Day
forall a. Maybe a
Nothing
                Status
Unmarked
                Text
""
                Text
""
                Text
""
                []
                [ Posting
posting {paccount :: Text
paccount = Text
"a", pamount :: MixedAmount
pamount = [Amount] -> MixedAmount
Mixed [Quantity -> Amount
usd Quantity
1.35]}
                , Posting
posting {paccount :: Text
paccount = Text
"b", pamount :: MixedAmount
pamount = [Amount] -> MixedAmount
Mixed [Quantity -> Amount
eur (-Quantity
1)]}
                ])) Either FilePath MixedAmount
-> Either FilePath MixedAmount -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
          MixedAmount -> Either FilePath MixedAmount
forall a b. b -> Either a b
Right ([Amount] -> MixedAmount
Mixed [Quantity -> Amount
usd Quantity
1.35 Amount -> Amount -> Amount
@@ (Quantity -> Amount
eur Quantity
1 Amount -> AmountPrecision -> Amount
`withPrecision` AmountPrecision
NaturalPrecision)])
        ,FilePath -> Assertion -> TestTree
test FilePath
"balanceTransaction balances based on cost if there are unit prices" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
          Either FilePath Transaction -> Assertion
forall a b. (HasCallStack, Eq a, Show a) => Either a b -> Assertion
assertRight (Either FilePath Transaction -> Assertion)
-> Either FilePath Transaction -> Assertion
forall a b. (a -> b) -> a -> b
$
          Maybe (Map Text AmountStyle)
-> Transaction -> Either FilePath Transaction
balanceTransaction
            Maybe (Map Text AmountStyle)
forall a. Maybe a
Nothing
            (Integer
-> Text
-> GenericSourcePos
-> Day
-> Maybe Day
-> Status
-> Text
-> Text
-> Text
-> [Tag]
-> [Posting]
-> Transaction
Transaction
               Integer
0
               Text
""
               GenericSourcePos
nullsourcepos
               (Integer -> Int -> Int -> Day
fromGregorian Integer
2011 Int
01 Int
01)
               Maybe Day
forall a. Maybe a
Nothing
               Status
Unmarked
               Text
""
               Text
""
               Text
""
               []
               [ Posting
posting {paccount :: Text
paccount = Text
"a", pamount :: MixedAmount
pamount = [Amount] -> MixedAmount
Mixed [Quantity -> Amount
usd Quantity
1 Amount -> Amount -> Amount
`at` Quantity -> Amount
eur Quantity
2]}
               , Posting
posting {paccount :: Text
paccount = Text
"a", pamount :: MixedAmount
pamount = [Amount] -> MixedAmount
Mixed [Quantity -> Amount
usd (-Quantity
2) Amount -> Amount -> Amount
`at` Quantity -> Amount
eur Quantity
1]}
               ])
        ,FilePath -> Assertion -> TestTree
test FilePath
"balanceTransaction balances based on cost if there are total prices" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
          Either FilePath Transaction -> Assertion
forall a b. (HasCallStack, Eq a, Show a) => Either a b -> Assertion
assertRight (Either FilePath Transaction -> Assertion)
-> Either FilePath Transaction -> Assertion
forall a b. (a -> b) -> a -> b
$
          Maybe (Map Text AmountStyle)
-> Transaction -> Either FilePath Transaction
balanceTransaction
            Maybe (Map Text AmountStyle)
forall a. Maybe a
Nothing
            (Integer
-> Text
-> GenericSourcePos
-> Day
-> Maybe Day
-> Status
-> Text
-> Text
-> Text
-> [Tag]
-> [Posting]
-> Transaction
Transaction
               Integer
0
               Text
""
               GenericSourcePos
nullsourcepos
               (Integer -> Int -> Int -> Day
fromGregorian Integer
2011 Int
01 Int
01)
               Maybe Day
forall a. Maybe a
Nothing
               Status
Unmarked
               Text
""
               Text
""
               Text
""
               []
               [ Posting
posting {paccount :: Text
paccount = Text
"a", pamount :: MixedAmount
pamount = [Amount] -> MixedAmount
Mixed [Quantity -> Amount
usd Quantity
1 Amount -> Amount -> Amount
@@ Quantity -> Amount
eur Quantity
1]}
               , Posting
posting {paccount :: Text
paccount = Text
"a", pamount :: MixedAmount
pamount = [Amount] -> MixedAmount
Mixed [Quantity -> Amount
usd (-Quantity
2) Amount -> Amount -> Amount
@@ Quantity -> Amount
eur Quantity
1]}
               ])
        ]
    , FilePath -> [TestTree] -> TestTree
tests FilePath
"isTransactionBalanced" [
         FilePath -> Assertion -> TestTree
test FilePath
"detect balanced" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
          HasCallStack => FilePath -> Bool -> Assertion
FilePath -> Bool -> Assertion
assertBool FilePath
"" (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$
          Maybe (Map Text AmountStyle) -> Transaction -> Bool
isTransactionBalanced Maybe (Map Text AmountStyle)
forall a. Maybe a
Nothing (Transaction -> Bool) -> Transaction -> Bool
forall a b. (a -> b) -> a -> b
$
          Integer
-> Text
-> GenericSourcePos
-> Day
-> Maybe Day
-> Status
-> Text
-> Text
-> Text
-> [Tag]
-> [Posting]
-> Transaction
Transaction
            Integer
0
            Text
""
            GenericSourcePos
nullsourcepos
            (Integer -> Int -> Int -> Day
fromGregorian Integer
2009 Int
01 Int
01)
            Maybe Day
forall a. Maybe a
Nothing
            Status
Unmarked
            Text
""
            Text
"a"
            Text
""
            []
            [ Posting
posting {paccount :: Text
paccount = Text
"b", pamount :: MixedAmount
pamount = [Amount] -> MixedAmount
Mixed [Quantity -> Amount
usd Quantity
1.00]}
            , Posting
posting {paccount :: Text
paccount = Text
"c", pamount :: MixedAmount
pamount = [Amount] -> MixedAmount
Mixed [Quantity -> Amount
usd (-Quantity
1.00)]}
            ]
        ,FilePath -> Assertion -> TestTree
test FilePath
"detect unbalanced" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
          HasCallStack => FilePath -> Bool -> Assertion
FilePath -> Bool -> Assertion
assertBool FilePath
"" (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$
          Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
          Maybe (Map Text AmountStyle) -> Transaction -> Bool
isTransactionBalanced Maybe (Map Text AmountStyle)
forall a. Maybe a
Nothing (Transaction -> Bool) -> Transaction -> Bool
forall a b. (a -> b) -> a -> b
$
          Integer
-> Text
-> GenericSourcePos
-> Day
-> Maybe Day
-> Status
-> Text
-> Text
-> Text
-> [Tag]
-> [Posting]
-> Transaction
Transaction
            Integer
0
            Text
""
            GenericSourcePos
nullsourcepos
            (Integer -> Int -> Int -> Day
fromGregorian Integer
2009 Int
01 Int
01)
            Maybe Day
forall a. Maybe a
Nothing
            Status
Unmarked
            Text
""
            Text
"a"
            Text
""
            []
            [ Posting
posting {paccount :: Text
paccount = Text
"b", pamount :: MixedAmount
pamount = [Amount] -> MixedAmount
Mixed [Quantity -> Amount
usd Quantity
1.00]}
            , Posting
posting {paccount :: Text
paccount = Text
"c", pamount :: MixedAmount
pamount = [Amount] -> MixedAmount
Mixed [Quantity -> Amount
usd (-Quantity
1.01)]}
            ]
        ,FilePath -> Assertion -> TestTree
test FilePath
"detect unbalanced, one posting" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
          HasCallStack => FilePath -> Bool -> Assertion
FilePath -> Bool -> Assertion
assertBool FilePath
"" (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$
          Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
          Maybe (Map Text AmountStyle) -> Transaction -> Bool
isTransactionBalanced Maybe (Map Text AmountStyle)
forall a. Maybe a
Nothing (Transaction -> Bool) -> Transaction -> Bool
forall a b. (a -> b) -> a -> b
$
          Integer
-> Text
-> GenericSourcePos
-> Day
-> Maybe Day
-> Status
-> Text
-> Text
-> Text
-> [Tag]
-> [Posting]
-> Transaction
Transaction
            Integer
0
            Text
""
            GenericSourcePos
nullsourcepos
            (Integer -> Int -> Int -> Day
fromGregorian Integer
2009 Int
01 Int
01)
            Maybe Day
forall a. Maybe a
Nothing
            Status
Unmarked
            Text
""
            Text
"a"
            Text
""
            []
            [Posting
posting {paccount :: Text
paccount = Text
"b", pamount :: MixedAmount
pamount = [Amount] -> MixedAmount
Mixed [Quantity -> Amount
usd Quantity
1.00]}]
        ,FilePath -> Assertion -> TestTree
test FilePath
"one zero posting is considered balanced for now" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
          HasCallStack => FilePath -> Bool -> Assertion
FilePath -> Bool -> Assertion
assertBool FilePath
"" (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$
          Maybe (Map Text AmountStyle) -> Transaction -> Bool
isTransactionBalanced Maybe (Map Text AmountStyle)
forall a. Maybe a
Nothing (Transaction -> Bool) -> Transaction -> Bool
forall a b. (a -> b) -> a -> b
$
          Integer
-> Text
-> GenericSourcePos
-> Day
-> Maybe Day
-> Status
-> Text
-> Text
-> Text
-> [Tag]
-> [Posting]
-> Transaction
Transaction
            Integer
0
            Text
""
            GenericSourcePos
nullsourcepos
            (Integer -> Int -> Int -> Day
fromGregorian Integer
2009 Int
01 Int
01)
            Maybe Day
forall a. Maybe a
Nothing
            Status
Unmarked
            Text
""
            Text
"a"
            Text
""
            []
            [Posting
posting {paccount :: Text
paccount = Text
"b", pamount :: MixedAmount
pamount = [Amount] -> MixedAmount
Mixed [Quantity -> Amount
usd Quantity
0]}]
        ,FilePath -> Assertion -> TestTree
test FilePath
"virtual postings don't need to balance" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
          HasCallStack => FilePath -> Bool -> Assertion
FilePath -> Bool -> Assertion
assertBool FilePath
"" (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$
          Maybe (Map Text AmountStyle) -> Transaction -> Bool
isTransactionBalanced Maybe (Map Text AmountStyle)
forall a. Maybe a
Nothing (Transaction -> Bool) -> Transaction -> Bool
forall a b. (a -> b) -> a -> b
$
          Integer
-> Text
-> GenericSourcePos
-> Day
-> Maybe Day
-> Status
-> Text
-> Text
-> Text
-> [Tag]
-> [Posting]
-> Transaction
Transaction
            Integer
0
            Text
""
            GenericSourcePos
nullsourcepos
            (Integer -> Int -> Int -> Day
fromGregorian Integer
2009 Int
01 Int
01)
            Maybe Day
forall a. Maybe a
Nothing
            Status
Unmarked
            Text
""
            Text
"a"
            Text
""
            []
            [ Posting
posting {paccount :: Text
paccount = Text
"b", pamount :: MixedAmount
pamount = [Amount] -> MixedAmount
Mixed [Quantity -> Amount
usd Quantity
1.00]}
            , Posting
posting {paccount :: Text
paccount = Text
"c", pamount :: MixedAmount
pamount = [Amount] -> MixedAmount
Mixed [Quantity -> Amount
usd (-Quantity
1.00)]}
            , Posting
posting {paccount :: Text
paccount = Text
"d", pamount :: MixedAmount
pamount = [Amount] -> MixedAmount
Mixed [Quantity -> Amount
usd Quantity
100], ptype :: PostingType
ptype = PostingType
VirtualPosting}
            ]
        ,FilePath -> Assertion -> TestTree
test FilePath
"balanced virtual postings need to balance among themselves" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
          HasCallStack => FilePath -> Bool -> Assertion
FilePath -> Bool -> Assertion
assertBool FilePath
"" (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$
          Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
          Maybe (Map Text AmountStyle) -> Transaction -> Bool
isTransactionBalanced Maybe (Map Text AmountStyle)
forall a. Maybe a
Nothing (Transaction -> Bool) -> Transaction -> Bool
forall a b. (a -> b) -> a -> b
$
          Integer
-> Text
-> GenericSourcePos
-> Day
-> Maybe Day
-> Status
-> Text
-> Text
-> Text
-> [Tag]
-> [Posting]
-> Transaction
Transaction
            Integer
0
            Text
""
            GenericSourcePos
nullsourcepos
            (Integer -> Int -> Int -> Day
fromGregorian Integer
2009 Int
01 Int
01)
            Maybe Day
forall a. Maybe a
Nothing
            Status
Unmarked
            Text
""
            Text
"a"
            Text
""
            []
            [ Posting
posting {paccount :: Text
paccount = Text
"b", pamount :: MixedAmount
pamount = [Amount] -> MixedAmount
Mixed [Quantity -> Amount
usd Quantity
1.00]}
            , Posting
posting {paccount :: Text
paccount = Text
"c", pamount :: MixedAmount
pamount = [Amount] -> MixedAmount
Mixed [Quantity -> Amount
usd (-Quantity
1.00)]}
            , Posting
posting {paccount :: Text
paccount = Text
"d", pamount :: MixedAmount
pamount = [Amount] -> MixedAmount
Mixed [Quantity -> Amount
usd Quantity
100], ptype :: PostingType
ptype = PostingType
BalancedVirtualPosting}
            ]
        ,FilePath -> Assertion -> TestTree
test FilePath
"balanced virtual postings need to balance among themselves (2)" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
          HasCallStack => FilePath -> Bool -> Assertion
FilePath -> Bool -> Assertion
assertBool FilePath
"" (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$
          Maybe (Map Text AmountStyle) -> Transaction -> Bool
isTransactionBalanced Maybe (Map Text AmountStyle)
forall a. Maybe a
Nothing (Transaction -> Bool) -> Transaction -> Bool
forall a b. (a -> b) -> a -> b
$
          Integer
-> Text
-> GenericSourcePos
-> Day
-> Maybe Day
-> Status
-> Text
-> Text
-> Text
-> [Tag]
-> [Posting]
-> Transaction
Transaction
            Integer
0
            Text
""
            GenericSourcePos
nullsourcepos
            (Integer -> Int -> Int -> Day
fromGregorian Integer
2009 Int
01 Int
01)
            Maybe Day
forall a. Maybe a
Nothing
            Status
Unmarked
            Text
""
            Text
"a"
            Text
""
            []
            [ Posting
posting {paccount :: Text
paccount = Text
"b", pamount :: MixedAmount
pamount = [Amount] -> MixedAmount
Mixed [Quantity -> Amount
usd Quantity
1.00]}
            , Posting
posting {paccount :: Text
paccount = Text
"c", pamount :: MixedAmount
pamount = [Amount] -> MixedAmount
Mixed [Quantity -> Amount
usd (-Quantity
1.00)]}
            , Posting
posting {paccount :: Text
paccount = Text
"d", pamount :: MixedAmount
pamount = [Amount] -> MixedAmount
Mixed [Quantity -> Amount
usd Quantity
100], ptype :: PostingType
ptype = PostingType
BalancedVirtualPosting}
            , Posting
posting {paccount :: Text
paccount = Text
"3", pamount :: MixedAmount
pamount = [Amount] -> MixedAmount
Mixed [Quantity -> Amount
usd (-Quantity
100)], ptype :: PostingType
ptype = PostingType
BalancedVirtualPosting}
            ]
        ]
    ]