{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE StandaloneDeriving, OverloadedStrings #-}
{-# LANGUAGE CPP #-}
module Hledger.Data.Journal (
addMarketPrice,
addTransactionModifier,
addPeriodicTransaction,
addTransaction,
journalBalanceTransactions,
journalApplyCommodityStyles,
commodityStylesFromAmounts,
journalCommodityStyles,
journalConvertAmountsToCost,
journalReverse,
journalSetLastReadTime,
journalPivot,
filterJournalTransactions,
filterJournalPostings,
filterJournalAmounts,
filterTransactionAmounts,
filterTransactionPostings,
filterPostingAmount,
journalAccountNamesUsed,
journalAccountNamesImplied,
journalAccountNamesDeclared,
journalAccountNamesDeclaredOrUsed,
journalAccountNamesDeclaredOrImplied,
journalAccountNames,
journalAmounts,
overJournalAmounts,
traverseJournalAmounts,
journalDateSpan,
journalDescriptions,
journalFilePath,
journalFilePaths,
journalTransactionAt,
journalNextTransaction,
journalPrevTransaction,
journalPostings,
journalBalanceSheetAccountQuery,
journalProfitAndLossAccountQuery,
journalRevenueAccountQuery,
journalExpenseAccountQuery,
journalAssetAccountQuery,
journalLiabilityAccountQuery,
journalEquityAccountQuery,
journalCashAccountQuery,
canonicalStyleFrom,
matchpats,
nulljournal,
journalCheckBalanceAssertions,
journalNumberAndTieTransactions,
journalUntieTransactions,
samplejournal,
tests_Journal,
)
where
import Control.Applicative (Const(..))
import Control.Arrow
import Control.Monad
import Control.Monad.Except
import qualified Control.Monad.Reader as R
import Control.Monad.ST
import Data.Array.ST
import Data.Functor.Identity (Identity(..))
import qualified Data.HashTable.ST.Cuckoo as HT
import Data.List
import Data.List.Extra (groupSort)
import Data.Maybe
#if !(MIN_VERSION_base(4,11,0))
import Data.Monoid
#endif
import Data.Ord
import qualified Data.Semigroup as Sem
import Data.Text (Text)
import qualified Data.Text as T
import Safe (headMay, headDef)
import Data.Time.Calendar
import Data.Tree
import System.Time (ClockTime(TOD))
import Text.Printf
import qualified Data.Map as M
import qualified Data.Set as S
import Hledger.Utils
import Hledger.Data.Types
import Hledger.Data.AccountName
import Hledger.Data.Amount
import Hledger.Data.Dates
import Hledger.Data.Transaction
import Hledger.Data.Posting
import Hledger.Query
instance Show Journal where
show j
| debugLevel < 3 = printf "Journal %s with %d transactions, %d accounts"
(journalFilePath j)
(length $ jtxns j)
(length accounts)
| debugLevel < 6 = printf "Journal %s with %d transactions, %d accounts: %s"
(journalFilePath j)
(length $ jtxns j)
(length accounts)
(show accounts)
| otherwise = printf "Journal %s with %d transactions, %d accounts: %s, commodity styles: %s"
(journalFilePath j)
(length $ jtxns j)
(length accounts)
(show accounts)
(show $ jinferredcommodities j)
where accounts = filter (/= "root") $ flatten $ journalAccountNameTree j
instance Sem.Semigroup Journal where
j1 <> j2 = Journal {
jparsedefaultyear = jparsedefaultyear j2
,jparsedefaultcommodity = jparsedefaultcommodity j2
,jparseparentaccounts = jparseparentaccounts j2
,jparsealiases = jparsealiases j2
,jparsetimeclockentries = jparsetimeclockentries j1 <> jparsetimeclockentries j2
,jincludefilestack = jincludefilestack j2
,jdeclaredaccounts = jdeclaredaccounts j1 <> jdeclaredaccounts j2
,jdeclaredaccounttypes = jdeclaredaccounttypes j1 <> jdeclaredaccounttypes j2
,jcommodities = jcommodities j1 <> jcommodities j2
,jinferredcommodities = jinferredcommodities j1 <> jinferredcommodities j2
,jmarketprices = jmarketprices j1 <> jmarketprices j2
,jtxnmodifiers = jtxnmodifiers j1 <> jtxnmodifiers j2
,jperiodictxns = jperiodictxns j1 <> jperiodictxns j2
,jtxns = jtxns j1 <> jtxns j2
,jfinalcommentlines = jfinalcommentlines j2
,jfiles = jfiles j1 <> jfiles j2
,jlastreadtime = max (jlastreadtime j1) (jlastreadtime j2)
}
instance Monoid Journal where
mempty = nulljournal
#if !(MIN_VERSION_base(4,11,0))
mappend = (Sem.<>)
#endif
nulljournal :: Journal
nulljournal = Journal {
jparsedefaultyear = Nothing
,jparsedefaultcommodity = Nothing
,jparseparentaccounts = []
,jparsealiases = []
,jparsetimeclockentries = []
,jincludefilestack = []
,jdeclaredaccounts = []
,jdeclaredaccounttypes = M.empty
,jcommodities = M.empty
,jinferredcommodities = M.empty
,jmarketprices = []
,jtxnmodifiers = []
,jperiodictxns = []
,jtxns = []
,jfinalcommentlines = ""
,jfiles = []
,jlastreadtime = TOD 0 0
}
journalFilePath :: Journal -> FilePath
journalFilePath = fst . mainfile
journalFilePaths :: Journal -> [FilePath]
journalFilePaths = map fst . jfiles
mainfile :: Journal -> (FilePath, Text)
mainfile = headDef ("", "") . jfiles
addTransaction :: Transaction -> Journal -> Journal
addTransaction t j = j { jtxns = t : jtxns j }
addTransactionModifier :: TransactionModifier -> Journal -> Journal
addTransactionModifier mt j = j { jtxnmodifiers = mt : jtxnmodifiers j }
addPeriodicTransaction :: PeriodicTransaction -> Journal -> Journal
addPeriodicTransaction pt j = j { jperiodictxns = pt : jperiodictxns j }
addMarketPrice :: MarketPrice -> Journal -> Journal
addMarketPrice h j = j { jmarketprices = h : jmarketprices j }
journalTransactionAt :: Journal -> Integer -> Maybe Transaction
journalTransactionAt Journal{jtxns=ts} i =
headMay [t | t <- ts, tindex t == i]
journalNextTransaction :: Journal -> Transaction -> Maybe Transaction
journalNextTransaction j t = journalTransactionAt j (tindex t + 1)
journalPrevTransaction :: Journal -> Transaction -> Maybe Transaction
journalPrevTransaction j t = journalTransactionAt j (tindex t - 1)
journalDescriptions :: Journal -> [Text]
journalDescriptions = nub . sort . map tdescription . jtxns
journalPostings :: Journal -> [Posting]
journalPostings = concatMap tpostings . jtxns
journalAccountNamesUsed :: Journal -> [AccountName]
journalAccountNamesUsed = accountNamesFromPostings . journalPostings
journalAccountNamesImplied :: Journal -> [AccountName]
journalAccountNamesImplied = expandAccountNames . journalAccountNamesUsed
journalAccountNamesDeclared :: Journal -> [AccountName]
journalAccountNamesDeclared = nub . sort . jdeclaredaccounts
journalAccountNamesDeclaredOrUsed :: Journal -> [AccountName]
journalAccountNamesDeclaredOrUsed j = nub $ sort $ journalAccountNamesDeclared j ++ journalAccountNamesUsed j
journalAccountNamesDeclaredOrImplied :: Journal -> [AccountName]
journalAccountNamesDeclaredOrImplied j = nub $ sort $ journalAccountNamesDeclared j ++ journalAccountNamesImplied j
journalAccountNames :: Journal -> [AccountName]
journalAccountNames = journalAccountNamesDeclaredOrImplied
journalAccountNameTree :: Journal -> Tree AccountName
journalAccountNameTree = accountNameTreeFrom . journalAccountNames
journalAccountTypeQuery :: AccountType -> Regexp -> Journal -> Query
journalAccountTypeQuery atype fallbackregex j =
case M.lookup atype (jdeclaredaccounttypes j) of
Nothing -> Acct fallbackregex
Just as ->
And [
Or $ map (Acct . accountNameToAccountRegex) as
,Not $ Or $ map (Acct . accountNameToAccountRegex) differentlytypedsubs
]
where
differentlytypedsubs = concat
[subs | (t,bs) <- M.toList (jdeclaredaccounttypes j)
, t /= atype
, let subs = [b | b <- bs, any (`isAccountNamePrefixOf` b) as]
]
journalAssetAccountQuery :: Journal -> Query
journalAssetAccountQuery = journalAccountTypeQuery Asset "^assets?(:|$)"
journalLiabilityAccountQuery :: Journal -> Query
journalLiabilityAccountQuery = journalAccountTypeQuery Liability "^(debts?|liabilit(y|ies))(:|$)"
journalEquityAccountQuery :: Journal -> Query
journalEquityAccountQuery = journalAccountTypeQuery Equity "^equity(:|$)"
journalRevenueAccountQuery :: Journal -> Query
journalRevenueAccountQuery = journalAccountTypeQuery Revenue "^(income|revenue)s?(:|$)"
journalExpenseAccountQuery :: Journal -> Query
journalExpenseAccountQuery = journalAccountTypeQuery Expense "^expenses?(:|$)"
journalBalanceSheetAccountQuery :: Journal -> Query
journalBalanceSheetAccountQuery j = Or [journalAssetAccountQuery j
,journalLiabilityAccountQuery j
,journalEquityAccountQuery j
]
journalProfitAndLossAccountQuery :: Journal -> Query
journalProfitAndLossAccountQuery j = Or [journalRevenueAccountQuery j
,journalExpenseAccountQuery j
]
journalCashAccountQuery :: Journal -> Query
journalCashAccountQuery j = And [journalAssetAccountQuery j, Not $ Acct "(receivable|:A/R|:fixed)"]
filterJournalTransactions :: Query -> Journal -> Journal
filterJournalTransactions q j@Journal{jtxns=ts} = j{jtxns=filter (q `matchesTransaction`) ts}
filterJournalPostings :: Query -> Journal -> Journal
filterJournalPostings q j@Journal{jtxns=ts} = j{jtxns=map (filterTransactionPostings q) ts}
filterJournalAmounts :: Query -> Journal -> Journal
filterJournalAmounts q j@Journal{jtxns=ts} = j{jtxns=map (filterTransactionAmounts q) ts}
filterTransactionAmounts :: Query -> Transaction -> Transaction
filterTransactionAmounts q t@Transaction{tpostings=ps} = t{tpostings=map (filterPostingAmount q) ps}
filterPostingAmount :: Query -> Posting -> Posting
filterPostingAmount q p@Posting{pamount=Mixed as} = p{pamount=Mixed $ filter (q `matchesAmount`) as}
filterTransactionPostings :: Query -> Transaction -> Transaction
filterTransactionPostings q t@Transaction{tpostings=ps} = t{tpostings=filter (q `matchesPosting`) ps}
journalReverse :: Journal -> Journal
journalReverse j =
j {jfiles = reverse $ jfiles j
,jdeclaredaccounts = reverse $ jdeclaredaccounts j
,jtxns = reverse $ jtxns j
,jtxnmodifiers = reverse $ jtxnmodifiers j
,jperiodictxns = reverse $ jperiodictxns j
,jmarketprices = reverse $ jmarketprices j
}
journalSetLastReadTime :: ClockTime -> Journal -> Journal
journalSetLastReadTime t j = j{ jlastreadtime = t }
journalNumberAndTieTransactions = journalTieTransactions . journalNumberTransactions
journalNumberTransactions :: Journal -> Journal
journalNumberTransactions j@Journal{jtxns=ts} = j{jtxns=map (\(i,t) -> t{tindex=i}) $ zip [1..] ts}
journalTieTransactions :: Journal -> Journal
journalTieTransactions j@Journal{jtxns=ts} = j{jtxns=map txnTieKnot ts}
journalUntieTransactions :: Transaction -> Transaction
journalUntieTransactions t@Transaction{tpostings=ps} = t{tpostings=map (\p -> p{ptransaction=Nothing}) ps}
journalCheckBalanceAssertions :: Journal -> Either String Journal
journalCheckBalanceAssertions j =
runST $ journalBalanceTransactionsST
True
j
(return ())
(\_ _ -> return ())
(const $ return j)
checkBalanceAssertion :: Posting -> MixedAmount -> Either String ()
checkBalanceAssertion p@Posting{ pbalanceassertion = Just ass } bal =
foldl' fold (Right ()) amts
where fold (Right _) cass = checkBalanceAssertionCommodity p cass bal
fold err _ = err
amt = baamount ass
amts = amt : if baexact ass
then map (\a -> a{ aquantity = 0 }) $ amounts $ filterMixedAmount (\a -> acommodity a /= assertedcomm) bal
else []
assertedcomm = acommodity amt
checkBalanceAssertion _ _ = Right ()
checkBalanceAssertionCommodity :: Posting -> Amount -> MixedAmount -> Either String ()
checkBalanceAssertionCommodity p amt bal
| isReallyZeroAmount diff = Right ()
| True = Left err
where assertedcomm = acommodity amt
actualbal = fromMaybe nullamt $ find ((== assertedcomm) . acommodity) (amounts bal)
diff = amt - actualbal
diffplus | isNegativeAmount diff == False = "+"
| otherwise = ""
err = printf (unlines
[ "balance assertion error%s",
"after posting:",
"%s",
"balance assertion details:",
"date: %s",
"account: %s",
"commodity: %s",
"calculated: %s",
"asserted: %s (difference: %s)"
])
(case ptransaction p of
Nothing -> ":"
Just t -> printf " in %s:\nin transaction:\n%s"
(showGenericSourcePos pos) (chomp $ showTransaction t) :: String
where pos = baposition $ fromJust $ pbalanceassertion p)
(showPostingLine p)
(showDate $ postingDate p)
(T.unpack $ paccount p)
assertedcomm
(showAmount actualbal)
(showAmount amt)
(diffplus ++ showAmount diff)
journalBalanceTransactions :: Bool -> Journal -> Either String Journal
journalBalanceTransactions assrt j =
runST $ journalBalanceTransactionsST
assrt
(journalNumberTransactions j)
(newArray_ (1, genericLength $ jtxns j) :: forall s. ST s (STArray s Integer Transaction))
(\arr tx -> writeArray arr (tindex tx) tx)
(fmap (\txns -> j{ jtxns = txns}) . getElems)
journalBalanceTransactionsST ::
Bool
-> Journal
-> ST s txns
-> (txns -> Transaction -> ST s ())
-> (txns -> ST s a)
-> ST s (Either String a)
journalBalanceTransactionsST assrt j createStore storeIn extract =
runExceptT $ do
bals <- lift $ HT.newSized size
txStore <- lift $ createStore
let env = Env bals
(storeIn txStore)
assrt
(Just $ journalCommodityStyles j)
(getModifierAccountNames j)
flip R.runReaderT env $ do
dated <- fmap snd . sortBy (comparing fst) . concat
<$> mapM' discriminateByDate (jtxns j)
mapM' checkInferAndRegisterAmounts dated
lift $ extract txStore
where
size = genericLength $ journalPostings j
getModifierAccountNames :: Journal -> S.Set AccountName
getModifierAccountNames j = S.fromList $
map paccount $
concatMap tmpostingrules $
jtxnmodifiers j
type CurrentBalancesModifier s = R.ReaderT (Env s) (ExceptT String (ST s))
data Env s = Env { eBalances :: HT.HashTable s AccountName MixedAmount
, eStoreTx :: Transaction -> ST s ()
, eAssrt :: Bool
, eStyles :: Maybe (M.Map CommoditySymbol AmountStyle)
, eUnassignable :: S.Set AccountName
}
discriminateByDate :: Transaction
-> CurrentBalancesModifier s [(Day, Either Posting Transaction)]
discriminateByDate tx
| null (assignmentPostings tx) = do
styles <- R.reader $ eStyles
balanced <- lift $ ExceptT $ return $ balanceTransaction styles tx
storeTransaction balanced
return $
fmap (postingDate &&& (Left . removePrices)) $ tpostings $ balanced
| True = do
when (any (isJust . pdate) $ tpostings tx) $
throwError $ unlines $
["postings may not have both a custom date and a balance assignment."
,"Write the posting amount explicitly, or remove the posting date:\n"
, showTransaction tx]
return
[(tdate tx, Right $ tx { tpostings = removePrices <$> tpostings tx })]
checkUnassignablePosting :: Posting -> CurrentBalancesModifier s ()
checkUnassignablePosting p = do
unassignable <- R.asks eUnassignable
if (isAssignment p && paccount p `S.member` unassignable)
then throwError $ unlines $
[ "cannot assign amount to account "
, ""
, " " ++ (T.unpack $ paccount p)
, ""
, "because it is also included in transaction modifiers."
]
else return ()
checkInferAndRegisterAmounts :: Either Posting Transaction
-> CurrentBalancesModifier s ()
checkInferAndRegisterAmounts (Left p) = do
checkUnassignablePosting p
void $ addAmountAndCheckBalance return p
checkInferAndRegisterAmounts (Right oldTx) = do
let ps = tpostings oldTx
mapM_ checkUnassignablePosting ps
styles <- R.reader $ eStyles
newPostings <- forM ps $ addAmountAndCheckBalance inferFromAssignment
storeTransaction =<< balanceTransactionUpdate
(fmap void . addToBalance) styles oldTx { tpostings = newPostings }
where
inferFromAssignment :: Posting -> CurrentBalancesModifier s Posting
inferFromAssignment p = do
let acc = paccount p
case pbalanceassertion p of
Just ba | baexact ba -> do
diff <- setMixedBalance acc $ Mixed [baamount ba]
fullPosting diff p
Just ba | otherwise -> do
old <- liftModifier $ \Env{ eBalances = bals } -> HT.lookup bals acc
let amt = baamount ba
assertedcomm = acommodity amt
diff <- setMixedBalance acc $
Mixed [amt] + filterMixedAmount (\a -> acommodity a /= assertedcomm) (fromMaybe nullmixedamt old)
fullPosting diff p
Nothing -> return p
fullPosting amt p = return p
{ pamount = amt
, porigin = Just $ originalPosting p
}
addAmountAndCheckBalance ::
(Posting -> CurrentBalancesModifier s Posting)
-> Posting
-> CurrentBalancesModifier s Posting
addAmountAndCheckBalance _ p | hasAmount p = do
newAmt <- addToBalance (paccount p) $ pamount p
assrt <- R.reader eAssrt
lift $ when assrt $ ExceptT $ return $ checkBalanceAssertion p newAmt
return p
addAmountAndCheckBalance fallback p = fallback p
setMixedBalance :: AccountName -> MixedAmount -> CurrentBalancesModifier s MixedAmount
setMixedBalance acc amt = liftModifier $ \Env{ eBalances = bals } -> do
old <- HT.lookup bals acc
HT.insert bals acc amt
return $ maybe amt (amt -) old
addToBalance :: AccountName -> MixedAmount -> CurrentBalancesModifier s MixedAmount
addToBalance acc amt = liftModifier $ \Env{ eBalances = bals } -> do
new <- maybe amt (+ amt) <$> HT.lookup bals acc
HT.insert bals acc new
return new
storeTransaction :: Transaction -> CurrentBalancesModifier s ()
storeTransaction tx = liftModifier $ ($tx) . eStoreTx
liftModifier :: (Env s -> ST s a) -> CurrentBalancesModifier s a
liftModifier f = R.ask >>= lift . lift . f
journalApplyCommodityStyles :: Journal -> Journal
journalApplyCommodityStyles j@Journal{jtxns=ts, jmarketprices=mps} = j''
where
j' = journalInferCommodityStyles j
styles = journalCommodityStyles j'
j'' = j'{jtxns=map fixtransaction ts, jmarketprices=map fixmarketprice mps}
fixtransaction t@Transaction{tpostings=ps} = t{tpostings=map fixposting ps}
fixposting p@Posting{pamount=a} = p{pamount=styleMixedAmount styles a}
fixmarketprice mp@MarketPrice{mpamount=a} = mp{mpamount=styleAmount styles a}
journalCommodityStyles :: Journal -> M.Map CommoditySymbol AmountStyle
journalCommodityStyles j = declaredstyles <> inferredstyles
where
declaredstyles = M.mapMaybe cformat $ jcommodities j
inferredstyles = jinferredcommodities j
journalInferCommodityStyles :: Journal -> Journal
journalInferCommodityStyles j =
j{jinferredcommodities =
commodityStylesFromAmounts $
dbg8 "journalInferCommmodityStyles using amounts" $ journalAmounts j}
commodityStylesFromAmounts :: [Amount] -> M.Map CommoditySymbol AmountStyle
commodityStylesFromAmounts amts = M.fromList commstyles
where
commamts = groupSort [(acommodity as, as) | as <- amts]
commstyles = [(c, canonicalStyleFrom $ map astyle as) | (c,as) <- commamts]
canonicalStyleFrom :: [AmountStyle] -> AmountStyle
canonicalStyleFrom [] = amountstyle
canonicalStyleFrom ss@(first:_) =
first{asprecision=prec, asdecimalpoint=mdec, asdigitgroups=mgrps}
where
mgrps = maybe Nothing Just $ headMay $ catMaybes $ map asdigitgroups ss
prec = maximumStrict $ map asprecision ss
mdec = Just $ headDef '.' $ catMaybes $ map asdecimalpoint ss
journalConvertAmountsToCost :: Journal -> Journal
journalConvertAmountsToCost j@Journal{jtxns=ts} = j{jtxns=map fixtransaction ts}
where
fixtransaction t@Transaction{tpostings=ps} = t{tpostings=map fixposting ps}
fixposting p@Posting{pamount=a} = p{pamount=fixmixedamount a}
fixmixedamount (Mixed as) = Mixed $ map fixamount as
fixamount = styleAmount styles . costOfAmount
styles = journalCommodityStyles j
journalAmounts :: Journal -> [Amount]
journalAmounts = getConst . traverseJournalAmounts (Const . (:[]))
overJournalAmounts :: (Amount -> Amount) -> Journal -> Journal
overJournalAmounts f = runIdentity . traverseJournalAmounts (Identity . f)
traverseJournalAmounts
:: Applicative f
=> (Amount -> f Amount)
-> Journal -> f Journal
traverseJournalAmounts f j =
recombine <$> (traverse . mpa) f (jmarketprices j)
<*> (traverse . tp . traverse . pamt . maa . traverse) f (jtxns j)
where
recombine mps txns = j { jmarketprices = mps, jtxns = txns }
mpa g mp = (\amt -> mp { mpamount = amt }) <$> g (mpamount mp)
tp g t = (\ps -> t { tpostings = ps }) <$> g (tpostings t)
pamt g p = (\amt -> p { pamount = amt }) <$> g (pamount p)
maa g (Mixed as) = Mixed <$> g as
journalDateSpan :: Bool -> Journal -> DateSpan
journalDateSpan secondary j
| null ts = DateSpan Nothing Nothing
| otherwise = DateSpan (Just earliest) (Just $ addDays 1 latest)
where
earliest = minimumStrict dates
latest = maximumStrict dates
dates = pdates ++ tdates
tdates = map (if secondary then transactionDate2 else tdate) ts
pdates = concatMap (catMaybes . map (if secondary then (Just . postingDate2) else pdate) . tpostings) ts
ts = jtxns j
journalPivot :: Text -> Journal -> Journal
journalPivot fieldortagname j = j{jtxns = map (transactionPivot fieldortagname) . jtxns $ j}
transactionPivot :: Text -> Transaction -> Transaction
transactionPivot fieldortagname t = t{tpostings = map (postingPivot fieldortagname) . tpostings $ t}
postingPivot :: Text -> Posting -> Posting
postingPivot fieldortagname p = p{paccount = pivotedacct, porigin = Just $ originalPosting p}
where
pivotedacct
| Just t <- ptransaction p, fieldortagname == "code" = tcode t
| Just t <- ptransaction p, fieldortagname == "description" = tdescription t
| Just t <- ptransaction p, fieldortagname == "payee" = transactionPayee t
| Just t <- ptransaction p, fieldortagname == "note" = transactionNote t
| Just (_, value) <- postingFindTag fieldortagname p = value
| otherwise = ""
postingFindTag :: TagName -> Posting -> Maybe (TagName, TagValue)
postingFindTag tagname p = find ((tagname==) . fst) $ postingAllTags p
matchpats :: [String] -> String -> Bool
matchpats pats str =
(null positives || any match positives) && (null negatives || not (any match negatives))
where
(negatives,positives) = partition isnegativepat pats
match "" = True
match pat = regexMatchesCI (abspat pat) str
negateprefix = "not:"
isnegativepat = (negateprefix `isPrefixOf`)
abspat pat = if isnegativepat pat then drop (length negateprefix) pat else pat
Right samplejournal = journalBalanceTransactions False $
nulljournal
{jtxns = [
txnTieKnot $ Transaction {
tindex=0,
tsourcepos=nullsourcepos,
tdate=parsedate "2008/01/01",
tdate2=Nothing,
tstatus=Unmarked,
tcode="",
tdescription="income",
tcomment="",
ttags=[],
tpostings=
["assets:bank:checking" `post` usd 1
,"income:salary" `post` missingamt
],
tpreceding_comment_lines=""
}
,
txnTieKnot $ Transaction {
tindex=0,
tsourcepos=nullsourcepos,
tdate=parsedate "2008/06/01",
tdate2=Nothing,
tstatus=Unmarked,
tcode="",
tdescription="gift",
tcomment="",
ttags=[],
tpostings=
["assets:bank:checking" `post` usd 1
,"income:gifts" `post` missingamt
],
tpreceding_comment_lines=""
}
,
txnTieKnot $ Transaction {
tindex=0,
tsourcepos=nullsourcepos,
tdate=parsedate "2008/06/02",
tdate2=Nothing,
tstatus=Unmarked,
tcode="",
tdescription="save",
tcomment="",
ttags=[],
tpostings=
["assets:bank:saving" `post` usd 1
,"assets:bank:checking" `post` usd (-1)
],
tpreceding_comment_lines=""
}
,
txnTieKnot $ Transaction {
tindex=0,
tsourcepos=nullsourcepos,
tdate=parsedate "2008/06/03",
tdate2=Nothing,
tstatus=Cleared,
tcode="",
tdescription="eat & shop",
tcomment="",
ttags=[],
tpostings=["expenses:food" `post` usd 1
,"expenses:supplies" `post` usd 1
,"assets:cash" `post` missingamt
],
tpreceding_comment_lines=""
}
,
txnTieKnot $ Transaction {
tindex=0,
tsourcepos=nullsourcepos,
tdate=parsedate "2008/10/01",
tdate2=Nothing,
tstatus=Unmarked,
tcode="",
tdescription="take a loan",
tcomment="",
ttags=[],
tpostings=["assets:bank:checking" `post` usd 1
,"liabilities:debts" `post` usd (-1)
],
tpreceding_comment_lines=""
}
,
txnTieKnot $ Transaction {
tindex=0,
tsourcepos=nullsourcepos,
tdate=parsedate "2008/12/31",
tdate2=Nothing,
tstatus=Unmarked,
tcode="",
tdescription="pay off",
tcomment="",
ttags=[],
tpostings=["liabilities:debts" `post` usd 1
,"assets:bank:checking" `post` usd (-1)
],
tpreceding_comment_lines=""
}
]
}
tests_Journal = tests "Journal" [
test "journalDateSpan" $
journalDateSpan True nulljournal{
jtxns = [nulltransaction{tdate = parsedate "2014/02/01"
,tpostings = [posting{pdate=Just (parsedate "2014/01/10")}]
}
,nulltransaction{tdate = parsedate "2014/09/01"
,tpostings = [posting{pdate2=Just (parsedate "2014/10/10")}]
}
]
}
`is` (DateSpan (Just $ fromGregorian 2014 1 10) (Just $ fromGregorian 2014 10 11))
,tests "standard account type queries" $
let
j = samplejournal
journalAccountNamesMatching :: Query -> Journal -> [AccountName]
journalAccountNamesMatching q = filter (q `matchesAccount`) . journalAccountNames
namesfrom qfunc = journalAccountNamesMatching (qfunc j) j
in [
test "assets" $ expectEq (namesfrom journalAssetAccountQuery) ["assets","assets:bank","assets:bank:checking","assets:bank:saving","assets:cash"]
,test "liabilities" $ expectEq (namesfrom journalLiabilityAccountQuery) ["liabilities","liabilities:debts"]
,test "equity" $ expectEq (namesfrom journalEquityAccountQuery) []
,test "income" $ expectEq (namesfrom journalRevenueAccountQuery) ["income","income:gifts","income:salary"]
,test "expenses" $ expectEq (namesfrom journalExpenseAccountQuery) ["expenses","expenses:food","expenses:supplies"]
]
]