lib: fix combineJournalUpdates folding order

NOTE: this is important to correctly build JournalContext
NOTE: currently a list reverse must done at the end,
      maybe using a Data.Queue would be more efficient.
This commit is contained in:
Julien Moutinho 2014-11-03 07:00:02 +01:00
parent 3050152cb3
commit c65fea2b4b
5 changed files with 21 additions and 14 deletions

View File

@ -146,19 +146,19 @@ mainfile :: Journal -> (FilePath, String)
mainfile = headDef ("", "") . files mainfile = headDef ("", "") . files
addTransaction :: Transaction -> Journal -> Journal addTransaction :: Transaction -> Journal -> Journal
addTransaction t l0 = l0 { jtxns = t : jtxns l0 } addTransaction t j = j { jtxns = t : jtxns j }
addModifierTransaction :: ModifierTransaction -> Journal -> Journal addModifierTransaction :: ModifierTransaction -> Journal -> Journal
addModifierTransaction mt l0 = l0 { jmodifiertxns = mt : jmodifiertxns l0 } addModifierTransaction mt j = j { jmodifiertxns = mt : jmodifiertxns j }
addPeriodicTransaction :: PeriodicTransaction -> Journal -> Journal addPeriodicTransaction :: PeriodicTransaction -> Journal -> Journal
addPeriodicTransaction pt l0 = l0 { jperiodictxns = pt : jperiodictxns l0 } addPeriodicTransaction pt j = j { jperiodictxns = pt : jperiodictxns j }
addHistoricalPrice :: HistoricalPrice -> Journal -> Journal addHistoricalPrice :: HistoricalPrice -> Journal -> Journal
addHistoricalPrice h l0 = l0 { historical_prices = h : historical_prices l0 } addHistoricalPrice h j = j { historical_prices = h : historical_prices j }
addTimeLogEntry :: TimeLogEntry -> Journal -> Journal addTimeLogEntry :: TimeLogEntry -> Journal -> Journal
addTimeLogEntry tle l0 = l0 { open_timelog_entries = tle : open_timelog_entries l0 } addTimeLogEntry tle j = j { open_timelog_entries = tle : open_timelog_entries j }
-- | Unique transaction descriptions used in this journal. -- | Unique transaction descriptions used in this journal.
journalDescriptions :: Journal -> [String] journalDescriptions :: Journal -> [String]
@ -404,8 +404,16 @@ journalFinalise :: ClockTime -> LocalTime -> FilePath -> String -> JournalContex
journalFinalise tclock tlocal path txt ctx assrt j@Journal{files=fs} = do journalFinalise tclock tlocal path txt ctx assrt j@Journal{files=fs} = do
(journalBalanceTransactions $ (journalBalanceTransactions $
journalCanonicaliseAmounts $ journalCanonicaliseAmounts $
journalCloseTimeLogEntries tlocal journalCloseTimeLogEntries tlocal $
j{files=(path,txt):fs, filereadtime=tclock, jContext=ctx}) j{ files=(path,txt):fs
, filereadtime=tclock
, jContext=ctx
, jtxns=reverse $ jtxns j -- NOTE: see addTransaction
, jmodifiertxns=reverse $ jmodifiertxns j -- NOTE: see addModifierTransaction
, jperiodictxns=reverse $ jperiodictxns j -- NOTE: see addPeriodicTransaction
, historical_prices=reverse $ historical_prices j -- NOTE: see addHistoricalPrice
, open_timelog_entries=reverse $ open_timelog_entries j -- NOTE: see addTimeLogEntry
})
>>= if assrt then journalCheckBalanceAssertions else return >>= if assrt then journalCheckBalanceAssertions else return
-- | Check any balance assertions in the journal and return an error -- | Check any balance assertions in the journal and return an error

View File

@ -193,7 +193,7 @@ data Journal = Journal {
files :: [(FilePath, String)], -- ^ the file path and raw text of the main and files :: [(FilePath, String)], -- ^ the file path and raw text of the main and
-- any included journal files. The main file is -- any included journal files. The main file is
-- first followed by any included files in the -- first followed by any included files in the
-- order encountered (XXX reversed, cf journalAddFile). -- order encountered.
filereadtime :: ClockTime, -- ^ when this journal was last read from its file(s) filereadtime :: ClockTime, -- ^ when this journal was last read from its file(s)
jcommoditystyles :: M.Map Commodity AmountStyle -- ^ how to display amounts in each commodity jcommoditystyles :: M.Map Commodity AmountStyle -- ^ how to display amounts in each commodity
} deriving (Eq, Typeable, Data) } deriving (Eq, Typeable, Data)

View File

@ -93,7 +93,7 @@ parse _ = parseJournalWith journal
-- | Flatten a list of JournalUpdate's into a single equivalent one. -- | Flatten a list of JournalUpdate's into a single equivalent one.
combineJournalUpdates :: [JournalUpdate] -> JournalUpdate combineJournalUpdates :: [JournalUpdate] -> JournalUpdate
combineJournalUpdates us = liftM (foldl' (.) id) $ sequence us combineJournalUpdates us = liftM (foldl' (\acc new x -> new (acc x)) id) $ sequence us
-- | Given a JournalUpdate-generating parsec parser, file path and data string, -- | Given a JournalUpdate-generating parsec parser, file path and data string,
-- parse and post-process a Journal so that it's ready to use, or give an error. -- parse and post-process a Journal so that it's ready to use, or give an error.
@ -218,7 +218,7 @@ includedirective = do
journalAddFile :: (FilePath,String) -> Journal -> Journal journalAddFile :: (FilePath,String) -> Journal -> Journal
journalAddFile f j@Journal{files=fs} = j{files=fs++[f]} journalAddFile f j@Journal{files=fs} = j{files=fs++[f]}
-- XXX currently called in reverse order of includes, I can't see why -- NOTE: first encountered file to left, to avoid a reverse
accountdirective :: ParsecT [Char] JournalContext (ErrorT String IO) JournalUpdate accountdirective :: ParsecT [Char] JournalContext (ErrorT String IO) JournalUpdate
accountdirective = do accountdirective = do

View File

@ -49,7 +49,7 @@ module Hledger.Read.TimelogReader (
where where
import Control.Monad import Control.Monad
import Control.Monad.Error import Control.Monad.Error
import Data.List (isPrefixOf) import Data.List (isPrefixOf, foldl')
import Test.HUnit import Test.HUnit
import Text.Parsec hiding (parse) import Text.Parsec hiding (parse)
import System.FilePath import System.FilePath
@ -85,7 +85,7 @@ timelogFile :: ParsecT [Char] JournalContext (ErrorT String IO) (JournalUpdate,
timelogFile = do items <- many timelogItem timelogFile = do items <- many timelogItem
eof eof
ctx <- getState ctx <- getState
return (liftM (foldr (.) id) $ sequence items, ctx) return (liftM (foldl' (\acc new x -> new (acc x)) id) $ sequence items, ctx)
where where
-- As all ledger line types can be distinguished by the first -- As all ledger line types can be distinguished by the first
-- character, excepting transactions versus empty (blank or -- character, excepting transactions versus empty (blank or

View File

@ -57,8 +57,7 @@ showLedgerStats l today span =
-- w2 = maximum $ map (length . show . snd) stats -- w2 = maximum $ map (length . show . snd) stats
stats = [ stats = [
("Main journal file" :: String, path) -- ++ " (from " ++ source ++ ")") ("Main journal file" :: String, path) -- ++ " (from " ++ source ++ ")")
,("Included journal files", unlines $ reverse $ -- cf journalAddFile ,("Included journal files", unlines $ drop 1 $ journalFilePaths j)
drop 1 $ journalFilePaths j)
,("Transactions span", printf "%s to %s (%d days)" (start span) (end span) days) ,("Transactions span", printf "%s to %s (%d days)" (start span) (end span) days)
,("Last transaction", maybe "none" show lastdate ++ showelapsed lastelapsed) ,("Last transaction", maybe "none" show lastdate ++ showelapsed lastelapsed)
,("Transactions", printf "%d (%0.1f per day)" tnum txnrate) ,("Transactions", printf "%d (%0.1f per day)" tnum txnrate)