{-|

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 NamedFieldPuns    #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}

module Hledger.Data.Transaction
( -- * Transaction
  nulltransaction
, transaction
, txnTieKnot
, txnUntieKnot
  -- * operations
, showAccountName
, hasRealPostings
, realPostings
, assignmentPostings
, virtualPostings
, balancedVirtualPostings
, transactionsPostings
, transactionTransformPostings
, transactionApplyValuation
, transactionToCost
, transactionApplyAliases
, transactionMapPostings
, transactionMapPostingAmounts
  -- nonzerobalanceerror
  -- * date operations
, transactionDate2
  -- * transaction description parts
, transactionPayee
, transactionNote
  -- payeeAndNoteFromDescription
  -- * rendering
, showTransaction
, showTransactionOneLineAmounts
  -- showPostingLine
, showPostingLines
, transactionFile
  -- * tests
, tests_Transaction
) where

import Data.Default (Default(..))
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Builder as TB
import Data.Time.Calendar (Day, fromGregorian)
import qualified Data.Map as M
import Safe (maximumDef)

import Hledger.Utils
import Hledger.Data.Types
import Hledger.Data.Dates
import Hledger.Data.Posting
import Hledger.Data.Amount
import Hledger.Data.Valuation
import Text.Tabular.AsciiWide


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

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

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

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

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

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

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

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

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

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

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

-- | Helper for showTransaction*.
showTransactionHelper :: Bool -> Transaction -> TB.Builder
showTransactionHelper :: Bool -> Transaction -> Builder
showTransactionHelper Bool
onelineamounts Transaction
t =
      Text -> Builder
TB.fromText Text
descriptionline Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
newline
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Text -> Builder) -> [Text] -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
newline) (Builder -> Builder) -> (Text -> Builder) -> Text -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Builder
TB.fromText) [Text]
newlinecomments
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Text -> Builder) -> [Text] -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
newline) (Builder -> Builder) -> (Text -> Builder) -> Text -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Builder
TB.fromText) (Bool -> [Posting] -> [Text]
postingsAsLines Bool
onelineamounts ([Posting] -> [Text]) -> [Posting] -> [Text]
forall a b. (a -> b) -> a -> b
$ Transaction -> [Posting]
tpostings Transaction
t)
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
newline
  where
    descriptionline :: Text
descriptionline = Text -> Text
T.stripEnd (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat [Text
date, Text
status, Text
code, Text
desc, Text
samelinecomment]
    date :: Text
date = Day -> Text
showDate (Transaction -> Day
tdate Transaction
t) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> (Day -> Text) -> Maybe Day -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" ((Text
"="Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (Day -> Text) -> Day -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> Text
showDate) (Transaction -> Maybe Day
tdate2 Transaction
t)
    status :: Text
status | Transaction -> Status
tstatus Transaction
t Status -> Status -> Bool
forall a. Eq a => a -> a -> Bool
== Status
Cleared = Text
" *"
           | Transaction -> Status
tstatus Transaction
t Status -> Status -> Bool
forall a. Eq a => a -> a -> Bool
== Status
Pending = Text
" !"
           | Bool
otherwise            = Text
""
    code :: Text
code = if Text -> Bool
T.null (Transaction -> Text
tcode Transaction
t) then Text
"" else Text -> Text -> Text -> Text
wrap Text
" (" Text
")" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Transaction -> Text
tcode Transaction
t
    desc :: Text
desc = if Text -> Bool
T.null Text
d then Text
"" else Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
d where d :: Text
d = Transaction -> Text
tdescription Transaction
t
    (Text
samelinecomment, [Text]
newlinecomments) =
      case Text -> [Text]
renderCommentLines (Transaction -> Text
tcomment Transaction
t) of []   -> (Text
"",[])
                                              Text
c:[Text]
cs -> (Text
c,[Text]
cs)
    newline :: Builder
newline = Char -> Builder
TB.singleton Char
'\n'

-- | 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 -> [Text]
renderCommentLines :: Text -> [Text]
renderCommentLines Text
t =
  case Text -> [Text]
T.lines Text
t of
    []      -> []
    [Text
l]     -> [Text -> Text
commentSpace (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
comment Text
l]        -- single-line comment
    (Text
"":[Text]
ls) -> Text
"" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Text
lineIndent (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
comment) [Text]
ls  -- multi-line comment with empty first line
    (Text
l:[Text]
ls)  -> Text -> Text
commentSpace (Text -> Text
comment Text
l) Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Text
lineIndent (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
comment) [Text]
ls
  where
    comment :: Text -> Text
comment = (Text
"; "Text -> Text -> Text
forall a. Semigroup 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] -> [Text]
postingsAsLines :: Bool -> [Posting] -> [Text]
postingsAsLines Bool
onelineamounts [Posting]
ps = (([Text], Int, Int) -> [Text]) -> [([Text], Int, Int)] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([Text], Int, Int) -> [Text]
forall a b c. (a, b, c) -> a
first3 [([Text], Int, Int)]
linesWithWidths
  where
    linesWithWidths :: [([Text], Int, Int)]
linesWithWidths = (Posting -> ([Text], Int, Int))
-> [Posting] -> [([Text], Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Bool -> Int -> Int -> Posting -> ([Text], Int, Int)
postingAsLines Bool
False Bool
onelineamounts Int
maxacctwidth Int
maxamtwidth) [Posting]
ps
    maxacctwidth :: Int
maxacctwidth = Int -> [Int] -> Int
forall a. Ord a => a -> [a] -> a
maximumDef Int
0 ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (([Text], Int, Int) -> Int) -> [([Text], Int, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ([Text], Int, Int) -> Int
forall a b c. (a, b, c) -> b
second3 [([Text], Int, Int)]
linesWithWidths
    maxamtwidth :: Int
maxamtwidth  = Int -> [Int] -> Int
forall a. Ord a => a -> [a] -> a
maximumDef Int
0 ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (([Text], Int, Int) -> Int) -> [([Text], Int, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ([Text], Int, Int) -> Int
forall a b c. (a, b, c) -> c
third3 [([Text], Int, Int)]
linesWithWidths

-- | 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.
--
-- Also returns the account width and amount width used.
postingAsLines :: Bool -> Bool -> Int -> Int -> Posting -> ([Text], Int, Int)
postingAsLines :: Bool -> Bool -> Int -> Int -> Posting -> ([Text], Int, Int)
postingAsLines Bool
elideamount Bool
onelineamounts Int
acctwidth Int
amtwidth Posting
p =
    (([Text] -> [Text]) -> [[Text]] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
newlinecomments) [[Text]]
postingblocks, Int
thisacctwidth, Int
thisamtwidth)
  where
    -- This needs to be converted to strict Text in order to strip trailing
    -- spaces. This adds a small amount of inefficiency, and the only difference
    -- is whether there are trailing spaces in print (and related) reports. This
    -- could be removed and we could just keep everything as a Text Builder, but
    -- would require adding trailing spaces to 42 failing tests.
    postingblocks :: [[Text]]
postingblocks = [(Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
T.stripEnd ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines (Text -> [Text]) -> (Text -> Text) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
TL.toStrict (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$
                       [Cell] -> Text
render [ Align -> Text -> Cell
textCell Align
BottomLeft Text
statusandaccount
                              , Align -> Text -> Cell
textCell Align
BottomLeft Text
"  "
                              , Align -> [WideBuilder] -> Cell
Cell Align
BottomLeft [WideBuilder -> WideBuilder
pad WideBuilder
amt]
                              , Align -> [WideBuilder] -> Cell
Cell Align
BottomLeft [WideBuilder
assertion]
                              , Align -> Text -> Cell
textCell Align
BottomLeft Text
samelinecomment
                              ]
                    | WideBuilder
amt <- [WideBuilder]
shownAmounts]
    render :: [Cell] -> Text
render = TableOpts -> Header Cell -> Text
renderRow TableOpts
forall a. Default a => a
def{tableBorders :: Bool
tableBorders=Bool
False, borderSpaces :: Bool
borderSpaces=Bool
False} (Header Cell -> Text) -> ([Cell] -> Header Cell) -> [Cell] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Properties -> [Header Cell] -> Header Cell
forall h. Properties -> [Header h] -> Header h
Group Properties
NoLine ([Header Cell] -> Header Cell)
-> ([Cell] -> [Header Cell]) -> [Cell] -> Header Cell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Cell -> Header Cell) -> [Cell] -> [Header Cell]
forall a b. (a -> b) -> [a] -> [b]
map Cell -> Header Cell
forall h. h -> Header h
Header
    pad :: WideBuilder -> WideBuilder
pad WideBuilder
amt = Builder -> Int -> WideBuilder
WideBuilder (Text -> Builder
TB.fromText (Text -> Builder) -> Text -> Builder
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.replicate Int
w Text
" ") Int
w WideBuilder -> WideBuilder -> WideBuilder
forall a. Semigroup a => a -> a -> a
<> WideBuilder
amt
      where w :: Int
w = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
12 Int
amtwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- WideBuilder -> Int
wbWidth WideBuilder
amt  -- min. 12 for backwards compatibility

    assertion :: WideBuilder
assertion = WideBuilder
-> (BalanceAssertion -> WideBuilder)
-> Maybe BalanceAssertion
-> WideBuilder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe WideBuilder
forall a. Monoid a => a
mempty ((Builder -> Int -> WideBuilder
WideBuilder (Char -> Builder
TB.singleton Char
' ') Int
1 WideBuilder -> WideBuilder -> WideBuilder
forall a. Semigroup a => a -> a -> a
<>)(WideBuilder -> WideBuilder)
-> (BalanceAssertion -> WideBuilder)
-> BalanceAssertion
-> WideBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
.BalanceAssertion -> WideBuilder
showBalanceAssertion) (Maybe BalanceAssertion -> WideBuilder)
-> Maybe BalanceAssertion -> WideBuilder
forall a b. (a -> b) -> a -> b
$ Posting -> Maybe BalanceAssertion
pbalanceassertion Posting
p
    -- pad to the maximum account name width, plus 2 to leave room for status flags, to keep amounts aligned
    statusandaccount :: Text
statusandaccount = Text -> Text
lineIndent (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Int -> Maybe Int -> Bool -> Bool -> Text -> Text
fitText (Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
acctwidth) Maybe Int
forall a. Maybe a
Nothing Bool
False Bool
True (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Posting -> Text
pstatusandacct Posting
p
    thisacctwidth :: Int
thisacctwidth = Text -> Int
textWidth (Text -> Int) -> Text -> Int
forall a b. (a -> b) -> a -> b
$ Posting -> Text
pacctstr Posting
p

    pacctstr :: Posting -> Text
pacctstr Posting
p' = Maybe Int -> PostingType -> Text -> Text
showAccountName Maybe Int
forall a. Maybe a
Nothing (Posting -> PostingType
ptype Posting
p') (Posting -> Text
paccount Posting
p')
    pstatusandacct :: Posting -> Text
pstatusandacct Posting
p' = Posting -> Text
pstatusprefix Posting
p' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Posting -> Text
pacctstr Posting
p'
    pstatusprefix :: Posting -> Text
pstatusprefix Posting
p' = case Posting -> Status
pstatus Posting
p' of
        Status
Unmarked -> Text
""
        Status
s        -> String -> Text
T.pack (Status -> String
forall a. Show a => a -> String
show Status
s) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" "

    -- currently prices are considered part of the amount string when right-aligning amounts
    -- Since we will usually be calling this function with the knot tied between
    -- amtwidth and thisamtwidth, make sure thisamtwidth does not depend on
    -- amtwidth at all.
    shownAmounts :: [WideBuilder]
shownAmounts
      | Bool
elideamount = [WideBuilder
forall a. Monoid a => a
mempty]
      | Bool
otherwise   = AmountDisplayOpts -> MixedAmount -> [WideBuilder]
showMixedAmountLinesB AmountDisplayOpts
noColour{displayOneLine :: Bool
displayOneLine=Bool
onelineamounts} (MixedAmount -> [WideBuilder]) -> MixedAmount -> [WideBuilder]
forall a b. (a -> b) -> a -> b
$ Posting -> MixedAmount
pamount Posting
p
    thisamtwidth :: Int
thisamtwidth = Int -> [Int] -> Int
forall a. Ord a => a -> [a] -> a
maximumDef Int
0 ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (WideBuilder -> Int) -> [WideBuilder] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map WideBuilder -> Int
wbWidth [WideBuilder]
shownAmounts

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

-- | Render a balance assertion, as the =[=][*] symbol and expected amount.
showBalanceAssertion :: BalanceAssertion -> WideBuilder
showBalanceAssertion :: BalanceAssertion -> WideBuilder
showBalanceAssertion BalanceAssertion{Bool
SourcePos
Amount
baposition :: BalanceAssertion -> SourcePos
bainclusive :: BalanceAssertion -> Bool
batotal :: BalanceAssertion -> Bool
baamount :: BalanceAssertion -> Amount
baposition :: SourcePos
bainclusive :: Bool
batotal :: Bool
baamount :: Amount
..} =
    Char -> WideBuilder
singleton Char
'=' WideBuilder -> WideBuilder -> WideBuilder
forall a. Semigroup a => a -> a -> a
<> WideBuilder
eq WideBuilder -> WideBuilder -> WideBuilder
forall a. Semigroup a => a -> a -> a
<> WideBuilder
ast WideBuilder -> WideBuilder -> WideBuilder
forall a. Semigroup a => a -> a -> a
<> Char -> WideBuilder
singleton Char
' ' WideBuilder -> WideBuilder -> WideBuilder
forall a. Semigroup a => a -> a -> a
<> AmountDisplayOpts -> Amount -> WideBuilder
showAmountB AmountDisplayOpts
forall a. Default a => a
def{displayZeroCommodity :: Bool
displayZeroCommodity=Bool
True} Amount
baamount
  where
    eq :: WideBuilder
eq  = if Bool
batotal     then Char -> WideBuilder
singleton Char
'=' else WideBuilder
forall a. Monoid a => a
mempty
    ast :: WideBuilder
ast = if Bool
bainclusive then Char -> WideBuilder
singleton Char
'*' else WideBuilder
forall a. Monoid a => a
mempty
    singleton :: Char -> WideBuilder
singleton Char
c = Builder -> Int -> WideBuilder
WideBuilder (Char -> Builder
TB.singleton Char
c) Int
1

-- | 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 -> [Text]
showPostingLines :: Posting -> [Text]
showPostingLines Posting
p = ([Text], Int, Int) -> [Text]
forall a b c. (a, b, c) -> a
first3 (([Text], Int, Int) -> [Text]) -> ([Text], Int, Int) -> [Text]
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> Int -> Int -> Posting -> ([Text], Int, Int)
postingAsLines Bool
False Bool
False Int
maxacctwidth Int
maxamtwidth Posting
p
  where
    linesWithWidths :: [([Text], Int, Int)]
linesWithWidths = (Posting -> ([Text], Int, Int))
-> [Posting] -> [([Text], Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Bool -> Int -> Int -> Posting -> ([Text], Int, Int)
postingAsLines Bool
False Bool
False Int
maxacctwidth Int
maxamtwidth) ([Posting] -> [([Text], Int, Int)])
-> (Maybe Transaction -> [Posting])
-> Maybe Transaction
-> [([Text], Int, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Posting]
-> (Transaction -> [Posting]) -> Maybe Transaction -> [Posting]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Posting
p] Transaction -> [Posting]
tpostings (Maybe Transaction -> [([Text], Int, Int)])
-> Maybe Transaction -> [([Text], Int, Int)]
forall a b. (a -> b) -> a -> b
$ Posting -> Maybe Transaction
ptransaction Posting
p
    maxacctwidth :: Int
maxacctwidth = Int -> [Int] -> Int
forall a. Ord a => a -> [a] -> a
maximumDef Int
0 ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (([Text], Int, Int) -> Int) -> [([Text], Int, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ([Text], Int, Int) -> Int
forall a b c. (a, b, c) -> b
second3 [([Text], Int, Int)]
linesWithWidths
    maxamtwidth :: Int
maxamtwidth  = Int -> [Int] -> Int
forall a. Ord a => a -> [a] -> a
maximumDef Int
0 ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (([Text], Int, Int) -> Int) -> [([Text], Int, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ([Text], Int, Int) -> Int
forall a b c. (a, b, c) -> c
third3 [([Text], Int, Int)]
linesWithWidths

-- | Prepend a suitable indent for a posting (or transaction/posting comment) line.
lineIndent :: Text -> Text
lineIndent :: Text -> Text
lineIndent = (Text
"    "Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)

-- | Prepend the space required before a same-line comment.
commentSpace :: Text -> Text
commentSpace :: Text -> Text
commentSpace = (Text
"  "Text -> Text -> Text
forall a. Semigroup 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 -> Text
showAccountName :: Maybe Int -> PostingType -> Text -> Text
showAccountName Maybe Int
w = PostingType -> Text -> Text
fmt
  where
    fmt :: PostingType -> Text -> Text
fmt PostingType
RegularPosting         = (Text -> Text)
-> (Int -> Text -> Text) -> Maybe Int -> Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text -> Text
forall a. a -> a
id Int -> Text -> Text
T.take Maybe Int
w
    fmt PostingType
VirtualPosting         = Text -> Text -> Text -> Text
wrap Text
"(" Text
")" (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text)
-> (Int -> Text -> Text) -> Maybe Int -> Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text -> Text
forall a. a -> a
id (Int -> Text -> Text
T.takeEnd (Int -> Text -> Text) -> (Int -> Int) -> Int -> Text -> Text
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
    fmt PostingType
BalancedVirtualPosting = Text -> Text -> Text -> Text
wrap Text
"[" Text
"]" (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text)
-> (Int -> Text -> Text) -> Maybe Int -> Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text -> Text
forall a. a -> a
id (Int -> Text -> Text
T.takeEnd (Int -> Text -> Text) -> (Int -> Int) -> Int -> Text -> Text
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

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

-- 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, and reference dates.
-- See amountApplyValuation.
transactionApplyValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> ValuationType -> Transaction -> Transaction
transactionApplyValuation :: PriceOracle
-> Map Text AmountStyle
-> Day
-> Day
-> ValuationType
-> Transaction
-> Transaction
transactionApplyValuation PriceOracle
priceoracle Map Text AmountStyle
styles Day
periodlast Day
today ValuationType
v =
  (Posting -> Posting) -> Transaction -> Transaction
transactionTransformPostings (PriceOracle
-> Map Text AmountStyle
-> Day
-> Day
-> ValuationType
-> Posting
-> Posting
postingApplyValuation PriceOracle
priceoracle Map Text AmountStyle
styles Day
periodlast Day
today ValuationType
v)

-- | 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 = (Posting -> Posting) -> Transaction -> Transaction
transactionTransformPostings (Map Text AmountStyle -> Posting -> Posting
postingToCost Map Text AmountStyle
styles)

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

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

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

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

-- tests

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

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

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

            ]

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