{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
module Hledger.Data.Transaction
(
nulltransaction
, transaction
, txnTieKnot
, txnUntieKnot
, hasRealPostings
, realPostings
, assignmentPostings
, virtualPostings
, balancedVirtualPostings
, transactionsPostings
, transactionTransformPostings
, transactionApplyValuation
, transactionToCost
, transactionAddInferredEquityPostings
, transactionInferCostsFromEquity
, transactionApplyAliases
, transactionMapPostings
, transactionMapPostingAmounts
, transactionAmounts
, partitionAndCheckConversionPostings
, transactionDate2
, transactionDateOrDate2
, transactionPayee
, transactionNote
, showTransaction
, showTransactionOneLineAmounts
, showTransactionLineFirstPart
, showTransactionBeancount
, transactionFile
, annotateErrorWithTransaction
, tests_Transaction
) where
import Control.Monad.Trans.State (StateT(..), evalStateT)
import Data.Bifunctor (first, second)
import Data.Foldable (foldlM)
import Data.Maybe (fromMaybe, isJust, mapMaybe)
import Data.Semigroup (Endo(..))
import Data.Text (Text)
import qualified Data.Map as M
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Builder as TB
import Data.Time.Calendar (Day, fromGregorian)
import Hledger.Utils
import Hledger.Data.Types
import Hledger.Data.Dates
import Hledger.Data.Posting
import Hledger.Data.Amount
import Hledger.Data.Valuation
import Data.Decimal (normalizeDecimal, decimalPlaces)
import Data.Functor ((<&>))
instance HasAmounts Transaction where
styleAmounts :: Map Text AmountStyle -> Transaction -> Transaction
styleAmounts Map Text AmountStyle
styles Transaction
t = Transaction
t{tpostings :: [Posting]
tpostings=forall a. HasAmounts a => Map Text AmountStyle -> a -> a
styleAmounts Map Text AmountStyle
styles forall a b. (a -> b) -> a -> b
$ Transaction -> [Posting]
tpostings Transaction
t}
nulltransaction :: Transaction
nulltransaction :: Transaction
nulltransaction = Transaction {
tindex :: Integer
tindex=Integer
0,
tsourcepos :: (SourcePos, SourcePos)
tsourcepos=(SourcePos, SourcePos)
nullsourcepos,
tdate :: Day
tdate=Day
nulldate,
tdate2 :: Maybe Day
tdate2=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
""
}
transaction :: Day -> [Posting] -> Transaction
transaction :: Day -> [Posting] -> Transaction
transaction Day
day [Posting]
ps = Transaction -> Transaction
txnTieKnot 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 = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Tag
payeeAndNoteFromDescription forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> Text
tdescription
transactionNote :: Transaction -> Text
transactionNote :: Transaction -> Text
transactionNote = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Tag
payeeAndNoteFromDescription forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> Text
tdescription
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 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 (forall a. Eq a => a -> a -> Bool
/= Char
'|') Text
t
payeeAndNoteFromDescription' :: Text -> (Text,Text)
payeeAndNoteFromDescription' :: Text -> Tag
payeeAndNoteFromDescription' Text
t =
if forall a. Maybe a -> Bool
isJust forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Maybe Char
T.find (forall a. Eq a => a -> a -> Bool
==Char
'|') Text
t then Text -> Tag
payeeAndNoteFromDescription Text
t else (Text
"",Text
t)
showTransaction :: Transaction -> Text
showTransaction :: Transaction -> Text
showTransaction = Text -> Text
TL.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TB.toLazyText forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Transaction -> Builder
showTransactionHelper Bool
False
showTransactionOneLineAmounts :: Transaction -> Text
showTransactionOneLineAmounts :: Transaction -> Text
showTransactionOneLineAmounts = Text -> Text
TL.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TB.toLazyText forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Transaction -> Builder
showTransactionHelper Bool
True
showTransactionHelper :: Bool -> Transaction -> TB.Builder
showTransactionHelper :: Bool -> Transaction -> Builder
showTransactionHelper Bool
onelineamounts Transaction
t =
Text -> Builder
TB.fromText Text
descriptionline forall a. Semigroup a => a -> a -> a
<> Builder
newline
forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((forall a. Semigroup a => a -> a -> a
<> Builder
newline) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Builder
TB.fromText) [Text]
newlinecomments
forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((forall a. Semigroup a => a -> a -> a
<> Builder
newline) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Builder
TB.fromText) (Bool -> [Posting] -> [Text]
postingsAsLines Bool
onelineamounts forall a b. (a -> b) -> a -> b
$ Transaction -> [Posting]
tpostings Transaction
t)
forall a. Semigroup a => a -> a -> a
<> Builder
newline
where
descriptionline :: Text
descriptionline = Text -> Text
T.stripEnd forall a b. (a -> b) -> a -> b
$ Transaction -> Text
showTransactionLineFirstPart Transaction
t forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
T.concat [Text
desc, Text
samelinecomment]
desc :: Text
desc = if Text -> Bool
T.null Text
d then Text
"" else Text
" " 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'
showTransactionLineFirstPart :: Transaction -> Text
showTransactionLineFirstPart Transaction
t = [Text] -> Text
T.concat [Text
date, Text
status, Text
code]
where
date :: Text
date = Day -> Text
showDate (Transaction -> Day
tdate Transaction
t) forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" ((Text
"="forall a. Semigroup a => a -> a -> a
<>) 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 forall a. Eq a => a -> a -> Bool
== Status
Cleared = Text
" *"
| Transaction -> Status
tstatus Transaction
t 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
")" forall a b. (a -> b) -> a -> b
$ Transaction -> Text
tcode Transaction
t
showTransactionBeancount :: Transaction -> Text
showTransactionBeancount :: Transaction -> Text
showTransactionBeancount Transaction
t =
Text
firstline forall a. Semigroup a => a -> a -> a
<> Text
nl
forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((forall a. Semigroup a => a -> a -> a
<> Text
nl)) [Text]
newlinecomments
forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((forall a. Semigroup a => a -> a -> a
<> Text
nl)) ([Posting] -> [Text]
postingsAsLinesBeancount forall a b. (a -> b) -> a -> b
$ Transaction -> [Posting]
tpostings Transaction
t)
forall a. Semigroup a => a -> a -> a
<> Text
nl
where
nl :: Text
nl = Text
"\n"
firstline :: Text
firstline = [Text] -> Text
T.concat [Text
date, Text
status, Text
payee, Text
note, Text
tags, Text
samelinecomment]
date :: Text
date = Day -> Text
showDate forall a b. (a -> b) -> a -> b
$ Transaction -> Day
tdate Transaction
t
status :: Text
status = if Transaction -> Status
tstatus Transaction
t forall a. Eq a => a -> a -> Bool
== Status
Pending then Text
" !" else Text
" *"
(Text
payee,Text
note) =
case Text -> Tag
payeeAndNoteFromDescription' forall a b. (a -> b) -> a -> b
$ Transaction -> Text
tdescription Transaction
t of
(Text
"",Text
"") -> (Text
"", Text
"" )
(Text
"",Text
n ) -> (Text
"" , Text -> Text
wrapq Text
n )
(Text
p ,Text
"") -> (Text -> Text
wrapq Text
p, Text -> Text
wrapq Text
"")
(Text
p ,Text
n ) -> (Text -> Text
wrapq Text
p, Text -> Text
wrapq Text
n )
where
wrapq :: Text -> Text
wrapq = Text -> Text -> Text -> Text
wrap Text
" \"" Text
"\"" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
escapeDoubleQuotes forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
escapeBackslash
tags :: Text
tags = [Text] -> Text
T.concat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map ((Text
" #"forall a. Semigroup a => a -> a -> a
<>)forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a, b) -> a
fst) forall a b. (a -> b) -> a -> b
$ Transaction -> [Tag]
ttags 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)
hasRealPostings :: Transaction -> Bool
hasRealPostings :: Transaction -> Bool
hasRealPostings = Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> [Posting]
realPostings
realPostings :: Transaction -> [Posting]
realPostings :: Transaction -> [Posting]
realPostings = forall a. (a -> Bool) -> [a] -> [a]
filter Posting -> Bool
isReal forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> [Posting]
tpostings
assignmentPostings :: Transaction -> [Posting]
assignmentPostings :: Transaction -> [Posting]
assignmentPostings = forall a. (a -> Bool) -> [a] -> [a]
filter Posting -> Bool
hasBalanceAssignment forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> [Posting]
tpostings
virtualPostings :: Transaction -> [Posting]
virtualPostings :: Transaction -> [Posting]
virtualPostings = forall a. (a -> Bool) -> [a] -> [a]
filter Posting -> Bool
isVirtual forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> [Posting]
tpostings
balancedVirtualPostings :: Transaction -> [Posting]
balancedVirtualPostings :: Transaction -> [Posting]
balancedVirtualPostings = forall a. (a -> Bool) -> [a] -> [a]
filter Posting -> Bool
isBalancedVirtual forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> [Posting]
tpostings
transactionsPostings :: [Transaction] -> [Posting]
transactionsPostings :: [Transaction] -> [Posting]
transactionsPostings = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Transaction -> [Posting]
tpostings
transactionDate2 :: Transaction -> Day
transactionDate2 :: Transaction -> Day
transactionDate2 Transaction
t = forall a. a -> Maybe a -> a
fromMaybe (Transaction -> Day
tdate Transaction
t) forall a b. (a -> b) -> a -> b
$ Transaction -> Maybe Day
tdate2 Transaction
t
transactionDateOrDate2 :: WhichDate -> Transaction -> Day
transactionDateOrDate2 :: WhichDate -> Transaction -> Day
transactionDateOrDate2 WhichDate
PrimaryDate = Transaction -> Day
tdate
transactionDateOrDate2 WhichDate
SecondaryDate = Transaction -> Day
transactionDate2
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=forall a b. (a -> b) -> [a] -> [b]
map (Transaction -> Posting -> Posting
postingSetTransaction Transaction
t') [Posting]
ps}
txnUntieKnot :: Transaction -> Transaction
txnUntieKnot :: Transaction -> Transaction
txnUntieKnot t :: Transaction
t@Transaction{tpostings :: Transaction -> [Posting]
tpostings=[Posting]
ps} = Transaction
t{tpostings :: [Posting]
tpostings=forall a b. (a -> b) -> [a] -> [b]
map (\Posting
p -> Posting
p{ptransaction :: Maybe Transaction
ptransaction=forall a. Maybe a
Nothing}) [Posting]
ps}
postingSetTransaction :: Transaction -> Posting -> Posting
postingSetTransaction :: Transaction -> Posting -> Posting
postingSetTransaction Transaction
t Posting
p = Posting
p{ptransaction :: Maybe Transaction
ptransaction=forall a. a -> Maybe a
Just Transaction
t}
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=forall a b. (a -> b) -> [a] -> [b]
map Posting -> Posting
f [Posting]
ps}
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)
transactionToCost :: ConversionOp -> Transaction -> Transaction
transactionToCost :: ConversionOp -> Transaction -> Transaction
transactionToCost ConversionOp
cost Transaction
t = Transaction
t{tpostings :: [Posting]
tpostings = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (ConversionOp -> Posting -> Maybe Posting
postingToCost ConversionOp
cost) forall a b. (a -> b) -> a -> b
$ Transaction -> [Posting]
tpostings Transaction
t}
transactionAddInferredEquityPostings :: Bool -> AccountName -> Transaction -> Transaction
transactionAddInferredEquityPostings :: Bool -> Text -> Transaction -> Transaction
transactionAddInferredEquityPostings Bool
verbosetags Text
equityAcct Transaction
t =
Transaction
t{tpostings :: [Posting]
tpostings=forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Bool -> Text -> Posting -> [Posting]
postingAddInferredEquityPostings Bool
verbosetags Text
equityAcct) forall a b. (a -> b) -> a -> b
$ Transaction -> [Posting]
tpostings Transaction
t}
type IdxPosting = (Int, Posting)
label :: RegexError -> RegexError -> RegexError
label RegexError
s = ((RegexError
s forall a. Semigroup a => a -> a -> a
<> RegexError
": ")forall a. [a] -> [a] -> [a]
++)
transactionInferCostsFromEquity :: Bool -> M.Map AccountName AccountType -> Transaction -> Either String Transaction
transactionInferCostsFromEquity :: Bool
-> Map Text AccountType
-> Transaction
-> Either RegexError Transaction
transactionInferCostsFromEquity Bool
dryrun Map Text AccountType
acctTypes Transaction
t = forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Transaction -> RegexError -> RegexError
annotateErrorWithTransaction Transaction
t forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> RegexError
T.unpack) forall a b. (a -> b) -> a -> b
$ do
let npostings :: [IdxPosting]
npostings = forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] forall a b. (a -> b) -> a -> b
$ Transaction -> [Posting]
tpostings Transaction
t
([(IdxPosting, IdxPosting)]
conversionPairs, ([IdxPosting], [IdxPosting])
otherps) <- Bool
-> Map Text AccountType
-> [IdxPosting]
-> Either
Text ([(IdxPosting, IdxPosting)], ([IdxPosting], [IdxPosting]))
partitionAndCheckConversionPostings Bool
False Map Text AccountType
acctTypes [IdxPosting]
npostings
IdxPosting -> IdxPosting
processposting <- ((IdxPosting, IdxPosting)
-> StateT
([IdxPosting], [IdxPosting])
(Either Text)
(IdxPosting -> IdxPosting))
-> [(IdxPosting, IdxPosting)]
-> ([IdxPosting], [IdxPosting])
-> Either Text (IdxPosting -> IdxPosting)
transformIndexedPostingsF (Bool
-> (IdxPosting, IdxPosting)
-> StateT
([IdxPosting], [IdxPosting])
(Either Text)
(IdxPosting -> IdxPosting)
addCostsToPostings Bool
dryrun) [(IdxPosting, IdxPosting)]
conversionPairs ([IdxPosting], [IdxPosting])
otherps
forall (m :: * -> *) a. Monad m => a -> m a
return Transaction
t{tpostings :: [Posting]
tpostings = forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdxPosting -> IdxPosting
processposting) [IdxPosting]
npostings}
where
transformIndexedPostingsF ::
((IdxPosting, IdxPosting) -> StateT ([IdxPosting],[IdxPosting]) (Either Text) (IdxPosting -> IdxPosting)) ->
[(IdxPosting, IdxPosting)] ->
([IdxPosting],[IdxPosting]) ->
(Either Text (IdxPosting -> IdxPosting))
transformIndexedPostingsF :: ((IdxPosting, IdxPosting)
-> StateT
([IdxPosting], [IdxPosting])
(Either Text)
(IdxPosting -> IdxPosting))
-> [(IdxPosting, IdxPosting)]
-> ([IdxPosting], [IdxPosting])
-> Either Text (IdxPosting -> IdxPosting)
transformIndexedPostingsF (IdxPosting, IdxPosting)
-> StateT
([IdxPosting], [IdxPosting])
(Either Text)
(IdxPosting -> IdxPosting)
updatefn = forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Endo a -> a -> a
appEndo forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall a. (a -> a) -> Endo a
Endo) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((IdxPosting, IdxPosting)
-> StateT
([IdxPosting], [IdxPosting])
(Either Text)
(IdxPosting -> IdxPosting)
updatefn)
addCostsToPostings :: Bool -> (IdxPosting, IdxPosting) -> StateT ([IdxPosting], [IdxPosting]) (Either Text) (IdxPosting -> IdxPosting)
addCostsToPostings :: Bool
-> (IdxPosting, IdxPosting)
-> StateT
([IdxPosting], [IdxPosting])
(Either Text)
(IdxPosting -> IdxPosting)
addCostsToPostings Bool
dryrun' ((Int
n1, Posting
cp1), (Int
n2, Posting
cp2)) = forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT forall a b. (a -> b) -> a -> b
$ \([IdxPosting]
costps, [IdxPosting]
otherps) -> do
Amount
ca1 <- Posting -> Either Text Amount
conversionPostingAmountNoCost Posting
cp1
Amount
ca2 <- Posting -> Either Text Amount
conversionPostingAmountNoCost Posting
cp2
let
matchingCostPs :: [IdxPosting]
matchingCostPs =
forall a. Show a => (a -> RegexError) -> a -> a
dbg7With (RegexError -> RegexError -> RegexError
label RegexError
"matched costful postings"forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a. Show a => a -> RegexError
showforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall (t :: * -> *) a. Foldable t => t a -> Int
length) forall a b. (a -> b) -> a -> b
$
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a b. (a -> b) -> a -> b
$ Amount -> Amount -> Posting -> Maybe Posting
costfulPostingIfMatchesBothAmounts Amount
ca1 Amount
ca2) [IdxPosting]
costps
matchingOtherPs :: [(Int, (Posting, Amount))]
matchingOtherPs =
forall a. Show a => (a -> RegexError) -> a -> a
dbg7With (RegexError -> RegexError -> RegexError
label RegexError
"matched costless postings"forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a. Show a => a -> RegexError
showforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall (t :: * -> *) a. Foldable t => t a -> Int
length) forall a b. (a -> b) -> a -> b
$
if Bool
dryrun'
then [(Int
n,(Posting
p, Amount
a)) | (Int
n,Posting
p) <- [IdxPosting]
otherps, let Just Amount
a = Posting -> Maybe Amount
postingSingleAmount Posting
p]
else forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a b. (a -> b) -> a -> b
$ Amount -> Amount -> Posting -> Maybe (Posting, Amount)
addCostIfMatchesOneAmount Amount
ca1 Amount
ca2) [IdxPosting]
otherps
postingAddCostAndOrTag :: Int -> Posting -> IdxPosting -> IdxPosting
postingAddCostAndOrTag Int
np Posting
costp (Int
n,Posting
p) =
(Int
n, if | Int
n forall a. Eq a => a -> a -> Bool
== Int
np -> Posting
costp Posting -> [Tag] -> Posting
`postingAddTags` [(Text
"_price-matched",Text
"")]
| Int
n forall a. Eq a => a -> a -> Bool
== Int
n1 Bool -> Bool -> Bool
|| Int
n forall a. Eq a => a -> a -> Bool
== Int
n2 -> Posting
p Posting -> [Tag] -> Posting
`postingAddTags` [(Text
"_conversion-matched",Text
"")]
| Bool
otherwise -> Posting
p)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ([Posting] -> Text -> Text
annotateWithPostings [Posting
cp1, Posting
cp2]) forall a b. (a -> b) -> a -> b
$
if
| [(Int
np, Posting
costp)] <- [IdxPosting]
matchingCostPs
, Just [IdxPosting]
newcostps <- forall {b} {b}. Eq b => b -> [(b, b)] -> Maybe [(b, b)]
deleteIdx Int
np [IdxPosting]
costps
-> forall a b. b -> Either a b
Right (Int -> Posting -> IdxPosting -> IdxPosting
postingAddCostAndOrTag Int
np Posting
costp, (if Bool
dryrun' then [IdxPosting]
costps else [IdxPosting]
newcostps, [IdxPosting]
otherps))
| [] <- [IdxPosting]
matchingCostPs
, (Int
np, (Posting
costp, Amount
amt)):[(Int, (Posting, Amount))]
nps <- [(Int, (Posting, Amount))]
matchingOtherPs
, Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Amount -> Amount -> Bool
amountsMatch Amount
amt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(Int, (Posting, Amount))]
nps
, Just [IdxPosting]
newotherps <- forall {b} {b}. Eq b => b -> [(b, b)] -> Maybe [(b, b)]
deleteIdx Int
np [IdxPosting]
otherps
-> forall a b. b -> Either a b
Right (Int -> Posting -> IdxPosting -> IdxPosting
postingAddCostAndOrTag Int
np Posting
costp, ([IdxPosting]
costps, if Bool
dryrun' then [IdxPosting]
otherps else [IdxPosting]
newotherps))
| Bool
otherwise -> forall a b. b -> Either a b
Right (forall a. a -> a
id, ([IdxPosting]
costps, [IdxPosting]
otherps))
costfulPostingIfMatchesBothAmounts :: Amount -> Amount -> Posting -> Maybe Posting
costfulPostingIfMatchesBothAmounts :: Amount -> Amount -> Posting -> Maybe Posting
costfulPostingIfMatchesBothAmounts Amount
a1 Amount
a2 Posting
costfulp = do
a :: Amount
a@Amount{aprice :: Amount -> Maybe AmountPrice
aprice=Just AmountPrice
_} <- Posting -> Maybe Amount
postingSingleAmount Posting
costfulp
if
| forall {a} {a}. (Show a, Show a) => a -> Amount -> Amount -> a -> a
dbgamtmatch Integer
1 Amount
a1 Amount
a (Amount -> Amount -> Bool
amountsMatch (-Amount
a1) Amount
a) Bool -> Bool -> Bool
&& forall {a} {a}. (Show a, Show a) => a -> Amount -> Amount -> a -> a
dbgcostmatch Integer
2 Amount
a2 Amount
a (Amount -> Amount -> Bool
amountsMatch Amount
a2 (Amount -> Amount
amountCost Amount
a)) -> forall a. a -> Maybe a
Just Posting
costfulp
| forall {a} {a}. (Show a, Show a) => a -> Amount -> Amount -> a -> a
dbgamtmatch Integer
2 Amount
a2 Amount
a (Amount -> Amount -> Bool
amountsMatch (-Amount
a2) Amount
a) Bool -> Bool -> Bool
&& forall {a} {a}. (Show a, Show a) => a -> Amount -> Amount -> a -> a
dbgcostmatch Integer
1 Amount
a1 Amount
a (Amount -> Amount -> Bool
amountsMatch Amount
a1 (Amount -> Amount
amountCost Amount
a)) -> forall a. a -> Maybe a
Just Posting
costfulp
| Bool
otherwise -> forall a. Maybe a
Nothing
where
dbgamtmatch :: a -> Amount -> Amount -> a -> a
dbgamtmatch a
n Amount
a Amount
b = forall a. Show a => RegexError -> a -> a
dbg7 (RegexError
"conversion posting " forall a. Semigroup a => a -> a -> a
<>forall a. Show a => a -> RegexError
show a
nforall a. Semigroup a => a -> a -> a
<>RegexError
" "forall a. Semigroup a => a -> a -> a
<>Amount -> RegexError
showAmount Amount
aforall a. Semigroup a => a -> a -> a
<>RegexError
" balances amount "forall a. Semigroup a => a -> a -> a
<>Amount -> RegexError
showAmountWithoutPrice Amount
b forall a. Semigroup a => a -> a -> a
<>RegexError
" of costful posting "forall a. Semigroup a => a -> a -> a
<>Amount -> RegexError
showAmount Amount
bforall a. Semigroup a => a -> a -> a
<>RegexError
" at precision "forall a. Semigroup a => a -> a -> a
<>Amount -> RegexError
dbgShowAmountPrecision Amount
aforall a. Semigroup a => a -> a -> a
<>RegexError
" ?")
dbgcostmatch :: a -> Amount -> Amount -> a -> a
dbgcostmatch a
n Amount
a Amount
b = forall a. Show a => RegexError -> a -> a
dbg7 (RegexError
"and\nconversion posting "forall a. Semigroup a => a -> a -> a
<>forall a. Show a => a -> RegexError
show a
nforall a. Semigroup a => a -> a -> a
<>RegexError
" "forall a. Semigroup a => a -> a -> a
<>Amount -> RegexError
showAmount Amount
aforall a. Semigroup a => a -> a -> a
<>RegexError
" matches cost " forall a. Semigroup a => a -> a -> a
<>Amount -> RegexError
showAmount (Amount -> Amount
amountCost Amount
b)forall a. Semigroup a => a -> a -> a
<>RegexError
" of costful posting "forall a. Semigroup a => a -> a -> a
<>Amount -> RegexError
showAmount Amount
bforall a. Semigroup a => a -> a -> a
<>RegexError
" at precision "forall a. Semigroup a => a -> a -> a
<>Amount -> RegexError
dbgShowAmountPrecision Amount
aforall a. Semigroup a => a -> a -> a
<>RegexError
" ?")
addCostIfMatchesOneAmount :: Amount -> Amount -> Posting -> Maybe (Posting, Amount)
addCostIfMatchesOneAmount :: Amount -> Amount -> Posting -> Maybe (Posting, Amount)
addCostIfMatchesOneAmount Amount
a1 Amount
a2 Posting
p = do
Amount
a <- Posting -> Maybe Amount
postingSingleAmount Posting
p
let newp :: Amount -> Posting
newp Amount
cost = Posting
p{pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount Amount
a{aprice :: Maybe AmountPrice
aprice = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Amount -> AmountPrice
TotalPrice Amount
cost}}
if
| Amount -> Amount -> Bool
amountsMatch (-Amount
a1) Amount
a -> forall a. a -> Maybe a
Just (Amount -> Posting
newp Amount
a2, Amount
a2)
| Amount -> Amount -> Bool
amountsMatch (-Amount
a2) Amount
a -> forall a. a -> Maybe a
Just (Amount -> Posting
newp Amount
a1, Amount
a1)
| Bool
otherwise -> forall a. Maybe a
Nothing
conversionPostingAmountNoCost :: Posting -> Either Text Amount
conversionPostingAmountNoCost Posting
p = case Posting -> Maybe Amount
postingSingleAmount Posting
p of
Just a :: Amount
a@Amount{aprice :: Amount -> Maybe AmountPrice
aprice=Maybe AmountPrice
Nothing} -> forall a b. b -> Either a b
Right Amount
a
Just Amount{aprice :: Amount -> Maybe AmountPrice
aprice=Just AmountPrice
_} -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ [Posting] -> Text -> Text
annotateWithPostings [Posting
p] Text
"Conversion postings must not have a cost:"
Maybe Amount
Nothing -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ [Posting] -> Text -> Text
annotateWithPostings [Posting
p] Text
"Conversion postings must have a single-commodity amount:"
amountsMatch :: Amount -> Amount -> Bool
amountsMatch Amount
a Amount
b = Amount -> Bool
amountLooksZero forall a b. (a -> b) -> a -> b
$ AmountPrecision -> Amount -> Amount
amountSetPrecision (AmountStyle -> AmountPrecision
asprecision forall a b. (a -> b) -> a -> b
$ Amount -> AmountStyle
astyle Amount
a) forall a b. (a -> b) -> a -> b
$ Amount
a forall a. Num a => a -> a -> a
- Amount
b
deleteIdx :: b -> [(b, b)] -> Maybe [(b, b)]
deleteIdx b
n = forall {a}. (a -> Bool) -> [a] -> Maybe [a]
deleteUniqueMatch ((b
nforall a. Eq a => a -> a -> Bool
==) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)
deleteUniqueMatch :: (a -> Bool) -> [a] -> Maybe [a]
deleteUniqueMatch a -> Bool
p (a
x:[a]
xs) | a -> Bool
p a
x = if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any a -> Bool
p [a]
xs then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just [a]
xs
| Bool
otherwise = (a
xforall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> Bool) -> [a] -> Maybe [a]
deleteUniqueMatch a -> Bool
p [a]
xs
deleteUniqueMatch a -> Bool
_ [] = forall a. Maybe a
Nothing
annotateWithPostings :: [Posting] -> Text -> Text
annotateWithPostings [Posting]
xs Text
str = [Text] -> Text
T.unlines forall a b. (a -> b) -> a -> b
$ Text
str forall a. a -> [a] -> [a]
: Bool -> [Posting] -> [Text]
postingsAsLines Bool
False [Posting]
xs
dbgShowAmountPrecision :: Amount -> RegexError
dbgShowAmountPrecision Amount
a =
case AmountStyle -> AmountPrecision
asprecision forall a b. (a -> b) -> a -> b
$ Amount -> AmountStyle
astyle Amount
a of
Precision Word8
n -> forall a. Show a => a -> RegexError
show Word8
n
AmountPrecision
NaturalPrecision -> forall a. Show a => a -> RegexError
show forall a b. (a -> b) -> a -> b
$ forall i. DecimalRaw i -> Word8
decimalPlaces forall a b. (a -> b) -> a -> b
$ forall i. Integral i => DecimalRaw i -> DecimalRaw i
normalizeDecimal forall a b. (a -> b) -> a -> b
$ Amount -> DecimalRaw Integer
aquantity Amount
a
partitionAndCheckConversionPostings :: Bool -> M.Map AccountName AccountType -> [IdxPosting] -> Either Text ( [(IdxPosting, IdxPosting)], ([IdxPosting], [IdxPosting]) )
partitionAndCheckConversionPostings :: Bool
-> Map Text AccountType
-> [IdxPosting]
-> Either
Text ([(IdxPosting, IdxPosting)], ([IdxPosting], [IdxPosting]))
partitionAndCheckConversionPostings Bool
check Map Text AccountType
acctTypes =
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM forall {a} {a} {a}.
IsString a =>
(([(a, (a, Posting))], ([(a, Posting)], [(a, Posting)])), Maybe a)
-> (a, Posting)
-> Either
a
(([(a, (a, Posting))], ([(a, Posting)], [(a, Posting)])),
Maybe (a, Posting))
select (([], ([], [])), forall a. Maybe a
Nothing)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second forall a. [a] -> [a]
reverse) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)
where
select :: (([(a, (a, Posting))], ([(a, Posting)], [(a, Posting)])), Maybe a)
-> (a, Posting)
-> Either
a
(([(a, (a, Posting))], ([(a, Posting)], [(a, Posting)])),
Maybe (a, Posting))
select (([(a, (a, Posting))]
cs, others :: ([(a, Posting)], [(a, Posting)])
others@([(a, Posting)]
ps, [(a, Posting)]
os)), Maybe a
Nothing) np :: (a, Posting)
np@(a
_, Posting
p)
| Posting -> Bool
isConversion Posting
p = forall a b. b -> Either a b
Right (([(a, (a, Posting))]
cs, ([(a, Posting)], [(a, Posting)])
others), forall a. a -> Maybe a
Just (a, Posting)
np)
| Posting -> Bool
hasCost Posting
p = forall a b. b -> Either a b
Right (([(a, (a, Posting))]
cs, ((a, Posting)
npforall a. a -> [a] -> [a]
:[(a, Posting)]
ps, [(a, Posting)]
os)), forall a. Maybe a
Nothing)
| Bool
otherwise = forall a b. b -> Either a b
Right (([(a, (a, Posting))]
cs, ([(a, Posting)]
ps, (a, Posting)
npforall a. a -> [a] -> [a]
:[(a, Posting)]
os)), forall a. Maybe a
Nothing)
select (([(a, (a, Posting))]
cs, others :: ([(a, Posting)], [(a, Posting)])
others@([(a, Posting)]
ps,[(a, Posting)]
os)), Just a
lst) np :: (a, Posting)
np@(a
_, Posting
p)
| Posting -> Bool
isConversion Posting
p = forall a b. b -> Either a b
Right (((a
lst, (a, Posting)
np)forall a. a -> [a] -> [a]
:[(a, (a, Posting))]
cs, ([(a, Posting)], [(a, Posting)])
others), forall a. Maybe a
Nothing)
| Bool
check = forall a b. a -> Either a b
Left a
"Conversion postings must occur in adjacent pairs"
| Bool
otherwise = forall a b. b -> Either a b
Right (([(a, (a, Posting))]
cs, ([(a, Posting)]
ps, (a, Posting)
npforall a. a -> [a] -> [a]
:[(a, Posting)]
os)), forall a. Maybe a
Nothing)
isConversion :: Posting -> Bool
isConversion Posting
p = forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Posting -> Text
paccount Posting
p) Map Text AccountType
acctTypes forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just AccountType
Conversion
hasCost :: Posting -> Bool
hasCost Posting
p = forall a. Maybe a -> Bool
isJust forall a b. (a -> b) -> a -> b
$ Amount -> Maybe AmountPrice
aprice forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Posting -> Maybe Amount
postingSingleAmount Posting
p
postingSingleAmount :: Posting -> Maybe Amount
postingSingleAmount :: Posting -> Maybe Amount
postingSingleAmount Posting
p = case MixedAmount -> [Amount]
amountsRaw (Posting -> MixedAmount
pamount Posting
p) of
[Amount
a] -> forall a. a -> Maybe a
Just Amount
a
[Amount]
_ -> forall a. Maybe a
Nothing
transactionApplyAliases :: [AccountAlias] -> Transaction -> Either RegexError Transaction
transactionApplyAliases :: [AccountAlias] -> Transaction -> Either RegexError Transaction
transactionApplyAliases [AccountAlias]
aliases Transaction
t =
case forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ([AccountAlias] -> Posting -> Either RegexError Posting
postingApplyAliases [AccountAlias]
aliases) forall a b. (a -> b) -> a -> b
$ Transaction -> [Posting]
tpostings Transaction
t of
Right [Posting]
ps -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Transaction -> Transaction
txnTieKnot forall a b. (a -> b) -> a -> b
$ Transaction
t{tpostings :: [Posting]
tpostings=[Posting]
ps}
Left RegexError
err -> forall a b. a -> Either a b
Left RegexError
err
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=forall a b. (a -> b) -> [a] -> [b]
map Posting -> Posting
f [Posting]
ps}
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)
transactionAmounts :: Transaction -> [MixedAmount]
transactionAmounts :: Transaction -> [MixedAmount]
transactionAmounts = forall a b. (a -> b) -> [a] -> [b]
map Posting -> MixedAmount
pamount forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> [Posting]
tpostings
transactionFile :: Transaction -> FilePath
transactionFile :: Transaction -> RegexError
transactionFile Transaction{(SourcePos, SourcePos)
tsourcepos :: (SourcePos, SourcePos)
tsourcepos :: Transaction -> (SourcePos, SourcePos)
tsourcepos} = SourcePos -> RegexError
sourceName forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst (SourcePos, SourcePos)
tsourcepos
annotateErrorWithTransaction :: Transaction -> String -> String
annotateErrorWithTransaction :: Transaction -> RegexError -> RegexError
annotateErrorWithTransaction Transaction
t RegexError
s =
[RegexError] -> RegexError
unlines [ (SourcePos, SourcePos) -> RegexError
sourcePosPairPretty forall a b. (a -> b) -> a -> b
$ Transaction -> (SourcePos, SourcePos)
tsourcepos Transaction
t, RegexError
s
, Text -> RegexError
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.stripEnd forall a b. (a -> b) -> a -> b
$ Transaction -> Text
showTransaction Transaction
t
]
tests_Transaction :: TestTree
tests_Transaction :: TestTree
tests_Transaction =
RegexError -> [TestTree] -> TestTree
testGroup RegexError
"Transaction" [
RegexError -> [TestTree] -> TestTree
testGroup RegexError
"showPostingLines" [
RegexError -> Assertion -> TestTree
testCase RegexError
"null posting" forall a b. (a -> b) -> a -> b
$ Posting -> [Text]
showPostingLines Posting
nullposting forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= [Text
" 0"]
, RegexError -> Assertion -> TestTree
testCase RegexError
"non-null posting" 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 = 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 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
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]}
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)]}
texp1 :: Transaction
texp1 = Transaction
nulltransaction {tpostings :: [Posting]
tpostings = [Text
"(a)" Text -> Amount -> Posting
`post` DecimalRaw Integer -> Amount
usd DecimalRaw Integer
1]}
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)]}
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)]}
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)]}
in RegexError -> [TestTree] -> TestTree
testGroup RegexError
"postingsAsLines" [
RegexError -> Assertion -> TestTree
testCase RegexError
"null-transaction" forall a b. (a -> b) -> a -> b
$ Bool -> [Posting] -> [Text]
postingsAsLines Bool
False (Transaction -> [Posting]
tpostings Transaction
nulltransaction) forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= []
, RegexError -> Assertion -> TestTree
testCase RegexError
"implicit-amount" forall a b. (a -> b) -> a -> b
$ Bool -> [Posting] -> [Text]
postingsAsLines Bool
False (Transaction -> [Posting]
tpostings Transaction
timp) forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
[ Text
" a $1.00"
, Text
" b"
]
, RegexError -> Assertion -> TestTree
testCase RegexError
"explicit-amounts" forall a b. (a -> b) -> a -> b
$ Bool -> [Posting] -> [Text]
postingsAsLines Bool
False (Transaction -> [Posting]
tpostings Transaction
texp) forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
[ Text
" a $1.00"
, Text
" b $-1.00"
]
, RegexError -> Assertion -> TestTree
testCase RegexError
"one-explicit-amount" forall a b. (a -> b) -> a -> b
$ Bool -> [Posting] -> [Text]
postingsAsLines Bool
False (Transaction -> [Posting]
tpostings Transaction
texp1) forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
[ Text
" (a) $1.00"
]
, RegexError -> Assertion -> TestTree
testCase RegexError
"explicit-amounts-two-commodities" forall a b. (a -> b) -> a -> b
$ Bool -> [Posting] -> [Text]
postingsAsLines Bool
False (Transaction -> [Posting]
tpostings Transaction
texp2) forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
[ Text
" a $1.00"
, Text
" b -1.00h @ $1.00"
]
, RegexError -> Assertion -> TestTree
testCase RegexError
"explicit-amounts-not-explicitly-balanced" forall a b. (a -> b) -> a -> b
$ Bool -> [Posting] -> [Text]
postingsAsLines Bool
False (Transaction -> [Posting]
tpostings Transaction
texp2b) forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
[ Text
" a $1.00"
, Text
" b -1.00h"
]
, RegexError -> Assertion -> TestTree
testCase RegexError
"implicit-amount-not-last" forall a b. (a -> b) -> a -> b
$ Bool -> [Posting] -> [Text]
postingsAsLines Bool
False (Transaction -> [Posting]
tpostings Transaction
t3) forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
[Text
" a $1.00", Text
" b", Text
" c $-1.00"]
]
, RegexError -> [TestTree] -> TestTree
testGroup RegexError
"showTransaction" [
RegexError -> Assertion -> TestTree
testCase RegexError
"null transaction" forall a b. (a -> b) -> a -> b
$ Transaction -> Text
showTransaction Transaction
nulltransaction forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Text
"0000-01-01\n\n"
, RegexError -> Assertion -> TestTree
testCase RegexError
"non-null transaction" 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 = forall a. a -> Maybe a
Just 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 = 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")]
}
]
} forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
[Text] -> Text
T.unlines
[ Text
"2012-05-14=2012-05-15 (code) desc ; tcomment1"
, Text
" ; tcomment2"
, Text
" * a $1.00"
, Text
" ; pcomment2"
, Text
" * a 2.00h"
, Text
" ; pcomment2"
, Text
""
]
, RegexError -> Assertion -> TestTree
testCase RegexError
"show a balanced transaction" 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)
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 = 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 = forall a. a -> Maybe a
Just Transaction
t}
]
in Transaction -> Text
showTransaction Transaction
t) forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
([Text] -> Text
T.unlines
[ Text
"2007-01-28 coopportunity"
, Text
" expenses:food:groceries $47.18"
, Text
" assets:checking $-47.18"
, Text
""
])
, RegexError -> Assertion -> TestTree
testCase RegexError
"show an unbalanced transaction, should not elide" forall a b. (a -> b) -> a -> b
$
(Transaction -> Text
showTransaction
(Transaction -> Transaction
txnTieKnot 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)
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))}
])) forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
([Text] -> Text
T.unlines
[ Text
"2007-01-28 coopportunity"
, Text
" expenses:food:groceries $47.18"
, Text
" assets:checking $-47.19"
, Text
""
])
, RegexError -> Assertion -> TestTree
testCase RegexError
"show a transaction with one posting and a missing amount" forall a b. (a -> b) -> a -> b
$
(Transaction -> Text
showTransaction
(Transaction -> Transaction
txnTieKnot 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)
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}])) forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
([Text] -> Text
T.unlines [Text
"2007-01-28 coopportunity", Text
" expenses:food:groceries", Text
""])
, RegexError -> Assertion -> TestTree
testCase RegexError
"show a transaction with a priced commodityless amount" forall a b. (a -> b) -> a -> b
$
(Transaction -> Text
showTransaction
(Transaction -> Transaction
txnTieKnot 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)
forall a. Maybe a
Nothing
Status
Unmarked
Text
""
Text
"x"
Text
""
[]
[ Posting
posting {paccount :: Text
paccount = Text
"a", pamount :: MixedAmount
pamount = Amount -> MixedAmount
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}
])) 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
""])
]
]