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, matchpats,
nulljournal, nulljournal,
journalCheckBalanceAssertions, journalCheckBalanceAssertions,
journalNumberAndTieTransactions,
journalUntieTransactions,
-- * Tests -- * Tests
samplejournal, samplejournal,
tests_Hledger_Data_Journal, tests_Hledger_Data_Journal,
@ -147,7 +149,7 @@ instance Monoid Journal where
,jparsedefaultcommodity = jparsedefaultcommodity j2 ,jparsedefaultcommodity = jparsedefaultcommodity j2
,jparseparentaccounts = jparseparentaccounts j2 ,jparseparentaccounts = jparseparentaccounts j2
,jparsealiases = jparsealiases j2 ,jparsealiases = jparsealiases j2
,jparsetransactioncount = jparsetransactioncount j1 + jparsetransactioncount j2 -- ,jparsetransactioncount = jparsetransactioncount j1 + jparsetransactioncount j2
,jparsetimeclockentries = jparsetimeclockentries j1 <> jparsetimeclockentries j2 ,jparsetimeclockentries = jparsetimeclockentries j1 <> jparsetimeclockentries j2
,jaccounts = jaccounts j1 <> jaccounts j2 ,jaccounts = jaccounts j1 <> jaccounts j2
,jcommodities = jcommodities j1 <> jcommodities j2 ,jcommodities = jcommodities j1 <> jcommodities j2
@ -167,7 +169,7 @@ nulljournal = Journal {
,jparsedefaultcommodity = Nothing ,jparsedefaultcommodity = Nothing
,jparseparentaccounts = [] ,jparseparentaccounts = []
,jparsealiases = [] ,jparsealiases = []
,jparsetransactioncount = 0 -- ,jparsetransactioncount = 0
,jparsetimeclockentries = [] ,jparsetimeclockentries = []
,jaccounts = [] ,jaccounts = []
,jcommodities = M.fromList [] ,jcommodities = M.fromList []
@ -461,7 +463,8 @@ journalApplyAliases aliases j@Journal{jtxns=ts} =
-- check balance assertions. -- check balance assertions.
journalFinalise :: ClockTime -> FilePath -> Text -> Bool -> ParsedJournal -> Either String Journal journalFinalise :: ClockTime -> FilePath -> Text -> Bool -> ParsedJournal -> Either String Journal
journalFinalise t path txt assrt j@Journal{jfiles=fs} = do journalFinalise t path txt assrt j@Journal{jfiles=fs} = do
(journalBalanceTransactions $ (journalNumberAndTieTransactions <$>
(journalBalanceTransactions $
journalApplyCommodityStyles $ journalApplyCommodityStyles $
j{ jfiles = (path,txt) : reverse fs j{ jfiles = (path,txt) : reverse fs
, jlastreadtime = t , jlastreadtime = t
@ -469,9 +472,25 @@ journalFinalise t path txt assrt j@Journal{jfiles=fs} = do
, jmodifiertxns = reverse $ jmodifiertxns j -- NOTE: see addModifierTransaction , jmodifiertxns = reverse $ jmodifiertxns j -- NOTE: see addModifierTransaction
, jperiodictxns = reverse $ jperiodictxns j -- NOTE: see addPeriodicTransaction , jperiodictxns = reverse $ jperiodictxns j -- NOTE: see addPeriodicTransaction
, jmarketprices = reverse $ jmarketprices j -- NOTE: see addMarketPrice , jmarketprices = reverse $ jmarketprices j -- NOTE: see addMarketPrice
}) }))
>>= if assrt then journalCheckBalanceAssertions else return >>= 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 -- | Check any balance assertions in the journal and return an error
-- message if any of them fail. -- message if any of them fail.
journalCheckBalanceAssertions :: Journal -> Either String Journal journalCheckBalanceAssertions :: Journal -> Either String Journal
@ -556,11 +575,11 @@ splitAssertions ps
-- | Fill in any missing amounts and check that all journal transactions -- | Fill in any missing amounts and check that all journal transactions
-- balance, or return an error message. This is done after parsing all -- 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. -- depends on display precision. Reports only the first error encountered.
journalBalanceTransactions :: Journal -> Either String Journal journalBalanceTransactions :: Journal -> Either String Journal
journalBalanceTransactions j@Journal{jtxns=ts, jinferredcommodities=ss} = 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 Left e -> Left e
where balance = balanceTransaction (Just ss) where balance = balanceTransaction (Just ss)

View File

@ -15,8 +15,6 @@ module Hledger.Data.Transaction (
nulltransaction, nulltransaction,
txnTieKnot, txnTieKnot,
txnUntieKnot, txnUntieKnot,
journalUntieKnots,
-- settxn,
-- * operations -- * operations
showAccountName, showAccountName,
hasRealPostings, hasRealPostings,
@ -422,21 +420,16 @@ transactionDate2 t = fromMaybe (tdate t) $ tdate2 t
-- | Ensure a transaction's postings refer back to it, so that eg -- | Ensure a transaction's postings refer back to it, so that eg
-- relatedPostings works right. -- relatedPostings works right.
txnTieKnot :: Transaction -> Transaction 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 -- | Ensure a transaction's postings do not refer back to it, so that eg
-- recursiveSize and GHCI's :sprint work right. -- recursiveSize and GHCI's :sprint work right.
txnUntieKnot :: Transaction -> Transaction txnUntieKnot :: Transaction -> Transaction
txnUntieKnot t@Transaction{tpostings=ps} = t{tpostings=map (\p -> p{ptransaction=Nothing}) ps} 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. -- | Set a posting's parent transaction.
settxn :: Transaction -> Posting -> Posting postingSetTransaction :: Transaction -> Posting -> Posting
settxn t p = p{ptransaction=Just t} postingSetTransaction t p = p{ptransaction=Just t}
tests_Hledger_Data_Transaction = TestList $ concat [ tests_Hledger_Data_Transaction = TestList $ concat [
tests_postingAsLines, 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 ,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 ,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 ?) ,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 ,jparsetimeclockentries :: [TimeclockEntry] -- ^ timeclock sessions which have not been clocked out
-- principal data -- principal data
,jaccounts :: [AccountName] -- ^ accounts that have been declared by account directives ,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 :: MonadState Journal m => m ()
clearAccountAliases = modify' (\(j@Journal{..}) -> j{jparsealiases=[]}) clearAccountAliases = modify' (\(j@Journal{..}) -> j{jparsealiases=[]})
getTransactionCount :: MonadState Journal m => m Integer -- getTransactionCount :: MonadState Journal m => m Integer
getTransactionCount = fmap jparsetransactioncount get -- getTransactionCount = fmap jparsetransactioncount get
--
setTransactionCount :: MonadState Journal m => Integer -> m () -- setTransactionCount :: MonadState Journal m => Integer -> m ()
setTransactionCount i = modify' (\j -> j{jparsetransactioncount=i}) -- setTransactionCount i = modify' (\j -> j{jparsetransactioncount=i})
--
-- | Increment the transaction index by one and return the new value. -- -- | Increment the transaction index by one and return the new value.
incrementTransactionCount :: MonadState Journal m => m Integer -- incrementTransactionCount :: MonadState Journal m => m Integer
incrementTransactionCount = do -- incrementTransactionCount = do
modify' (\j -> j{jparsetransactioncount=jparsetransactioncount j + 1}) -- modify' (\j -> j{jparsetransactioncount=jparsetransactioncount j + 1})
getTransactionCount -- getTransactionCount
journalAddFile :: (FilePath,Text) -> Journal -> Journal journalAddFile :: (FilePath,Text) -> Journal -> Journal
journalAddFile f j@Journal{jfiles=fs} = j{jfiles=fs++[f]} 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 parse rulesfile _ f t = do
r <- liftIO $ readJournalFromCsv rulesfile f t r <- liftIO $ readJournalFromCsv rulesfile f t
case r of Left e -> throwError e 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 -- | Read a Journal from the given CSV data (and filename, used for error
-- messages), or return an error. Proceed as follows: -- messages), or return an error. Proceed as follows:

View File

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