lib: non-journal formats now produce transaction ids #394

Transactions are now numbered consistently during journal finalisation,
rather than just in the journal reader. Also transaction knot-tying has been
moved out of journalBalanceTransactions.
This commit is contained in:
Simon Michael 2016-08-14 12:44:19 -07:00
parent f864efdb07
commit 72c39470d6
6 changed files with 44 additions and 32 deletions

View File

@ -54,6 +54,8 @@ module Hledger.Data.Journal (
matchpats,
nulljournal,
journalCheckBalanceAssertions,
journalNumberAndTieTransactions,
journalUntieTransactions,
-- * Tests
samplejournal,
tests_Hledger_Data_Journal,
@ -147,7 +149,7 @@ instance Monoid Journal where
,jparsedefaultcommodity = jparsedefaultcommodity j2
,jparseparentaccounts = jparseparentaccounts j2
,jparsealiases = jparsealiases j2
,jparsetransactioncount = jparsetransactioncount j1 + jparsetransactioncount j2
-- ,jparsetransactioncount = jparsetransactioncount j1 + jparsetransactioncount j2
,jparsetimeclockentries = jparsetimeclockentries j1 <> jparsetimeclockentries j2
,jaccounts = jaccounts j1 <> jaccounts j2
,jcommodities = jcommodities j1 <> jcommodities j2
@ -167,7 +169,7 @@ nulljournal = Journal {
,jparsedefaultcommodity = Nothing
,jparseparentaccounts = []
,jparsealiases = []
,jparsetransactioncount = 0
-- ,jparsetransactioncount = 0
,jparsetimeclockentries = []
,jaccounts = []
,jcommodities = M.fromList []
@ -461,6 +463,7 @@ journalApplyAliases aliases j@Journal{jtxns=ts} =
-- check balance assertions.
journalFinalise :: ClockTime -> FilePath -> Text -> Bool -> ParsedJournal -> Either String Journal
journalFinalise t path txt assrt j@Journal{jfiles=fs} = do
(journalNumberAndTieTransactions <$>
(journalBalanceTransactions $
journalApplyCommodityStyles $
j{ jfiles = (path,txt) : reverse fs
@ -469,9 +472,25 @@ journalFinalise t path txt assrt j@Journal{jfiles=fs} = do
, jmodifiertxns = reverse $ jmodifiertxns j -- NOTE: see addModifierTransaction
, jperiodictxns = reverse $ jperiodictxns j -- NOTE: see addPeriodicTransaction
, jmarketprices = reverse $ jmarketprices j -- NOTE: see addMarketPrice
})
}))
>>= if assrt then journalCheckBalanceAssertions else return
journalNumberAndTieTransactions = journalTieTransactions . journalNumberTransactions
-- | Number (set the tindex field) this journal's transactions, counting upward from 1.
journalNumberTransactions :: Journal -> Journal
journalNumberTransactions j@Journal{jtxns=ts} = j{jtxns=map (\(i,t) -> t{tindex=i}) $ zip [1..] ts}
-- | Tie the knot in all of this journal's transactions, ensuring their postings
-- refer to them. This should be done last, after any other transaction-modifying operations.
journalTieTransactions :: Journal -> Journal
journalTieTransactions j@Journal{jtxns=ts} = j{jtxns=map txnTieKnot ts}
-- | Untie all transaction-posting knots in this journal, so that eg
-- recursiveSize and GHCI's :sprint can work on it.
journalUntieTransactions :: Transaction -> Transaction
journalUntieTransactions t@Transaction{tpostings=ps} = t{tpostings=map (\p -> p{ptransaction=Nothing}) ps}
-- | Check any balance assertions in the journal and return an error
-- message if any of them fail.
journalCheckBalanceAssertions :: Journal -> Either String Journal
@ -556,11 +575,11 @@ splitAssertions ps
-- | Fill in any missing amounts and check that all journal transactions
-- balance, or return an error message. This is done after parsing all
-- amounts and working out the canonical commodities, since balancing
-- amounts and applying canonical commodity styles, since balancing
-- depends on display precision. Reports only the first error encountered.
journalBalanceTransactions :: Journal -> Either String Journal
journalBalanceTransactions j@Journal{jtxns=ts, jinferredcommodities=ss} =
case sequence $ map balance ts of Right ts' -> Right j{jtxns=map txnTieKnot ts'}
case sequence $ map balance ts of Right ts' -> Right j{jtxns=ts'}
Left e -> Left e
where balance = balanceTransaction (Just ss)

View File

@ -15,8 +15,6 @@ module Hledger.Data.Transaction (
nulltransaction,
txnTieKnot,
txnUntieKnot,
journalUntieKnots,
-- settxn,
-- * operations
showAccountName,
hasRealPostings,
@ -422,21 +420,16 @@ transactionDate2 t = fromMaybe (tdate t) $ tdate2 t
-- | Ensure a transaction's postings refer back to it, so that eg
-- relatedPostings works right.
txnTieKnot :: Transaction -> Transaction
txnTieKnot t@Transaction{tpostings=ps} = t{tpostings=map (settxn t) ps}
txnTieKnot t@Transaction{tpostings=ps} = t{tpostings=map (postingSetTransaction t) 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 t@Transaction{tpostings=ps} = t{tpostings=map (\p -> p{ptransaction=Nothing}) ps}
-- | Untie all transaction-posting knots in this journal, so that eg
-- recursiveSize and GHCI's :sprint can work on it.
journalUntieKnots :: Transaction -> Transaction
journalUntieKnots t@Transaction{tpostings=ps} = t{tpostings=map (\p -> p{ptransaction=Nothing}) ps}
-- | Set a posting's parent transaction.
settxn :: Transaction -> Posting -> Posting
settxn t p = p{ptransaction=Just t}
postingSetTransaction :: Transaction -> Posting -> Posting
postingSetTransaction t p = p{ptransaction=Just t}
tests_Hledger_Data_Transaction = TestList $ concat [
tests_postingAsLines,

View File

@ -285,7 +285,7 @@ data Journal = Journal {
,jparsedefaultcommodity :: Maybe (CommoditySymbol,AmountStyle) -- ^ the current default commodity and its format, specified by the most recent D directive
,jparseparentaccounts :: [AccountName] -- ^ the current stack of parent account names, specified by apply account directives
,jparsealiases :: [AccountAlias] -- ^ the current account name aliases in effect, specified by alias directives (& options ?)
,jparsetransactioncount :: Integer -- ^ the current count of transactions parsed so far (only journal format txns, currently)
-- ,jparsetransactioncount :: Integer -- ^ the current count of transactions parsed so far (only journal format txns, currently)
,jparsetimeclockentries :: [TimeclockEntry] -- ^ timeclock sessions which have not been clocked out
-- principal data
,jaccounts :: [AccountName] -- ^ accounts that have been declared by account directives

View File

@ -129,17 +129,17 @@ getAccountAliases = fmap jparsealiases get
clearAccountAliases :: MonadState Journal m => m ()
clearAccountAliases = modify' (\(j@Journal{..}) -> j{jparsealiases=[]})
getTransactionCount :: MonadState Journal m => m Integer
getTransactionCount = fmap jparsetransactioncount get
setTransactionCount :: MonadState Journal m => Integer -> m ()
setTransactionCount i = modify' (\j -> j{jparsetransactioncount=i})
-- | Increment the transaction index by one and return the new value.
incrementTransactionCount :: MonadState Journal m => m Integer
incrementTransactionCount = do
modify' (\j -> j{jparsetransactioncount=jparsetransactioncount j + 1})
getTransactionCount
-- getTransactionCount :: MonadState Journal m => m Integer
-- getTransactionCount = fmap jparsetransactioncount get
--
-- setTransactionCount :: MonadState Journal m => Integer -> m ()
-- setTransactionCount i = modify' (\j -> j{jparsetransactioncount=i})
--
-- -- | Increment the transaction index by one and return the new value.
-- incrementTransactionCount :: MonadState Journal m => m Integer
-- incrementTransactionCount = do
-- modify' (\j -> j{jparsetransactioncount=jparsetransactioncount j + 1})
-- getTransactionCount
journalAddFile :: (FilePath,Text) -> Journal -> Journal
journalAddFile f j@Journal{jfiles=fs} = j{jfiles=fs++[f]}

View File

@ -79,7 +79,8 @@ parse :: Maybe FilePath -> Bool -> FilePath -> Text -> ExceptT String IO Journal
parse rulesfile _ f t = do
r <- liftIO $ readJournalFromCsv rulesfile f t
case r of Left e -> throwError e
Right j -> return j
Right j -> return $ journalNumberAndTieTransactions j
-- XXX does not use parseAndFinaliseJournal like the other readers
-- | Read a Journal from the given CSV data (and filename, used for error
-- messages), or return an error. Proceed as follows:

View File

@ -220,7 +220,7 @@ newJournalWithParseStateFrom j = mempty{
,jparsedefaultcommodity = jparsedefaultcommodity j
,jparseparentaccounts = jparseparentaccounts j
,jparsealiases = jparsealiases j
,jparsetransactioncount = jparsetransactioncount j
-- ,jparsetransactioncount = jparsetransactioncount j
,jparsetimeclockentries = jparsetimeclockentries j
}
@ -439,8 +439,7 @@ transactionp = do
comment <- try followingcommentp <|> (newline >> return "")
let tags = commentTags comment
postings <- postingsp (Just date)
n <- incrementTransactionCount
return $ txnTieKnot $ Transaction n sourcepos date edate status code description comment tags postings ""
return $ txnTieKnot $ Transaction 0 sourcepos date edate status code description comment tags postings ""
#ifdef TESTS
test_transactionp = do