refactor: move post-parse processing into parseJournal

Hledger/Tests.hs

@@ -61,9 +61,9 @@ tests = TestList [
    tests_Hledger_Commands,
 
    "account directive" ~:
-   let sameParse str1 str2 = do l1 <- journalFromString str1
+   let sameParse str1 str2 = do j1 <- journalFromString str1
-                                l2 <- journalFromString str2
+                                j2 <- journalFromString str2
-                                l1 `is` l2
+                                j1 `is` j2{filereadtime=filereadtime j1, jtext=jtext j1}
    in TestList
    [
     "account directive 1" ~: sameParse 
@@ -1050,7 +1050,7 @@ journal7 = Journal
           (TOD 0 0)
           ""
 
-ledger7 = filterAndCacheLedger nullfilterspec $ makeUncachedLedger False "" (TOD 0 0) "" journal7
+ledger7 = filterAndCacheLedger nullfilterspec $ makeUncachedLedger journal7
 
 ledger8_str = unlines
  ["2008/1/1 test           "

Hledger/Utils.hs

@@ -21,7 +21,6 @@ import System.IO (hPutStrLn)
 import System.Exit
 import System.Process (readProcessWithExitCode)
 import System.Info (os)
-import System.Time (getClockTime)
 
 
 -- | Parse the user's specified ledger file and run a hledger command on
@@ -34,26 +33,21 @@ withLedgerDo opts args cmdname cmd = do
   -- it's stdin, or it doesn't exist and we are adding. We read it strictly
   -- to let the add command work.
   f <- ledgerFilePathFromOpts opts
-  let f' = if f == "-" then "/dev/null" else f
   fileexists <- doesFileExist f
   let creating = not fileexists && cmdname == "add"
-      cb = CostBasis `elem` opts
+      cost = CostBasis `elem` opts
-  t <- getCurrentLocalTime
+  let runcmd = cmd opts args . makeUncachedLedger . (if cost then journalConvertAmountsToCost else id)
-  tc <- getClockTime
-  txt <-  if creating then return "" else strictReadFile f'
-  let runcmd = cmd opts args . makeUncachedLedger cb f tc txt
   if creating
    then runcmd nulljournal
-   else (runErrorT . parseJournalFile t) f >>= either parseerror runcmd
+   else (runErrorT . parseJournalFile) f >>= either parseerror runcmd
     where parseerror e = hPutStrLn stderr e >> exitWith (ExitFailure 1)
 
 -- | Get an uncached ledger from the given string and options, or raise an error.
 ledgerFromStringWithOpts :: [Opt] -> String -> IO UncachedLedger
 ledgerFromStringWithOpts opts s = do
-    tc <- getClockTime
     j <- journalFromString s
-    let cb = CostBasis `elem` opts
+    let cost = CostBasis `elem` opts
-    return $ makeUncachedLedger cb "" tc s j
+    return $ makeUncachedLedger $ (if cost then journalConvertAmountsToCost else id) j
 
 -- -- | Read a ledger from the given file, or give an error.
 -- readLedgerWithOpts :: [Opt] -> [String] -> FilePath -> IO Ledger

hledger-lib/Hledger/Data/IO.hs

@@ -9,7 +9,6 @@ import Control.Monad.Error
 import Hledger.Data.Ledger (makeUncachedLedger)
 import Hledger.Data.Parse (parseJournal)
 import Hledger.Data.Types (FilterSpec(..),WhichDate(..),Journal(..),Ledger(..))
-import Hledger.Data.Utils (getCurrentLocalTime)
 import Hledger.Data.Dates (nulldatespan)
 import System.Directory (getHomeDirectory)
 import System.Environment (getEnv)
@@ -18,7 +17,6 @@ import Prelude hiding (readFile)
 import System.IO.UTF8
 #endif
 import System.FilePath ((</>))
-import System.Time (getClockTime)
 
 
 ledgerenvvar           = "LEDGER"
@@ -65,10 +63,9 @@ myTimelog = myTimelogPath >>= readLedger
 -- | Read an unfiltered, uncached ledger from this file, or give an error.
 readLedger :: FilePath -> IO Ledger
 readLedger f = do
-  t <- getClockTime
   s <- readFile f
   j <- journalFromString s
-  return $ makeUncachedLedger False f t s j
+  return $ makeUncachedLedger j
 
 -- -- | Read a ledger from this file, filtering according to the filter spec.,
 -- -- | or give an error.
@@ -82,9 +79,7 @@ readLedger f = do
 -- | Read a Journal from the given string, using the current time as
 -- reference time, or give a parse error.
 journalFromString :: String -> IO Journal
-journalFromString s = do
+journalFromString s = liftM (either error id) $ runErrorT $ parseJournal "(string)" s
-  t <- getCurrentLocalTime
-  liftM (either error id) $ runErrorT $ parseJournal t "(string)" s
 
 -- -- | Expand ~ in a file path (does not handle ~name).
 -- tildeExpand :: FilePath -> IO FilePath

hledger-lib/Hledger/Data/Journal.hs

@@ -187,10 +187,27 @@ journalSelectingDate ActualDate j = j
 journalSelectingDate EffectiveDate j =
     j{jtxns=map (ledgerTransactionWithDate EffectiveDate) $ jtxns j}
 
--- | Close any open timelog sessions in this journal using the provided current time.
+-- | Do post-parse processing on a journal, to make it ready for use.
-journalCloseTimeLogEntries :: LocalTime -> Journal -> Journal
+journalFinalise :: ClockTime -> LocalTime -> FilePath -> String -> Journal -> Journal
-journalCloseTimeLogEntries now j@Journal{jtxns=ts, open_timelog_entries=es} =
+journalFinalise tclock tlocal path txt j = journalCanonicaliseAmounts $
-  j{jtxns = ts ++ (timeLogEntriesToTransactions now es), open_timelog_entries = []}
+                                           journalApplyHistoricalPrices $
+                                           journalCloseTimeLogEntries tlocal
+                                             j{filepath=path, filereadtime=tclock, jtext=txt}
+
+-- | Convert all the journal's amounts to their canonical display
+-- settings.  Ie, all amounts in a given commodity will use (a) the
+-- display settings of the first, and (b) the greatest precision, of the
+-- amounts in that commodity. Prices are canonicalised as well, so consider
+-- calling journalApplyHistoricalPrices before this.
+journalCanonicaliseAmounts :: Journal -> Journal
+journalCanonicaliseAmounts 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 a@Amount{commodity=c,price=p} = a{commodity=fixcommodity c, price=maybe Nothing (Just . fixmixedamount) p}
+      fixcommodity c@Commodity{symbol=s} = findWithDefault c s canonicalcommoditymap
+      canonicalcommoditymap = journalCanonicalCommodities j
 
 -- | Apply this journal's historical price records to unpriced amounts where possible.
 journalApplyHistoricalPrices :: Journal -> Journal
@@ -212,6 +229,11 @@ journalHistoricalPriceFor j d Commodity{symbol=s} = do
   case ps of (HistoricalPrice{hamount=a}:_) -> Just a
              _ -> Nothing
 
+-- | Close any open timelog sessions in this journal using the provided current time.
+journalCloseTimeLogEntries :: LocalTime -> Journal -> Journal
+journalCloseTimeLogEntries now j@Journal{jtxns=ts, open_timelog_entries=es} =
+  j{jtxns = ts ++ (timeLogEntriesToTransactions now es), open_timelog_entries = []}
+
 -- | Convert all this journal's amounts to cost by applying their prices, if any.
 journalConvertAmountsToCost :: Journal -> Journal
 journalConvertAmountsToCost j@Journal{jtxns=ts} = j{jtxns=map fixtransaction ts}
@@ -221,21 +243,6 @@ journalConvertAmountsToCost j@Journal{jtxns=ts} = j{jtxns=map fixtransaction ts}
       fixmixedamount (Mixed as) = Mixed $ map fixamount as
       fixamount = costOfAmount
 
--- | Convert all the journal's amounts to their canonical display
--- settings.  Ie, all amounts in a given commodity will use (a) the
--- display settings of the first, and (b) the greatest precision, of the
--- amounts in that commodity. Prices are canonicalised as well, so consider
--- calling journalApplyHistoricalPrices before this.
-journalCanonicaliseAmounts :: Journal -> Journal
-journalCanonicaliseAmounts 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 a@Amount{commodity=c,price=p} = a{commodity=fixcommodity c, price=maybe Nothing (Just . fixmixedamount) p}
-      fixcommodity c@Commodity{symbol=s} = findWithDefault c s canonicalcommoditymap
-      canonicalcommoditymap = journalCanonicalCommodities j
-
 -- | Get this journal's unique, display-preference-canonicalised commodities, by symbol.
 journalCanonicalCommodities :: Journal -> Map.Map String Commodity
 journalCanonicalCommodities j =
@@ -290,8 +297,8 @@ matchpats pats str =
       isnegativepat = (negateprefix `isPrefixOf`)
       abspat pat = if isnegativepat pat then drop (length negateprefix) pat else pat
 
--- | Calculate the account tree and account balances from a journal's
+-- | Calculate the account tree and all account balances from a journal's
--- postings, and return the results for efficient lookup.
+-- postings, returning the results for efficient lookup.
 journalAccountInfo :: Journal -> (Tree AccountName, Map.Map AccountName Account)
 journalAccountInfo j = (ant, amap)
     where
@@ -300,9 +307,8 @@ journalAccountInfo j = (ant, amap)
       acctinfo a = Account a (psof a) (inclbalof a)
 
 -- | Given a list of postings, return an account name tree and three query
--- functions that fetch postings, balance, and subaccount-including
+-- functions that fetch postings, subaccount-excluding-balance and
--- balance by account name.  This factors out common logic from
+-- subaccount-including-balance by account name.
--- cacheLedger and summarisePostingsInDateSpan.
 groupPostings :: [Posting] -> (Tree AccountName,
                              (AccountName -> [Posting]),
                              (AccountName -> MixedAmount),

hledger-lib/Hledger/Data/Ledger.hs

@@ -60,7 +60,6 @@ import Hledger.Data.Account (nullacct)
 import Hledger.Data.AccountName
 import Hledger.Data.Journal
 import Hledger.Data.Posting
-import System.Time (ClockTime)
 
 
 instance Show Ledger where
@@ -78,14 +77,9 @@ nullledger = Ledger{
       accountmap = fromList []
     }
 
--- | Generate a ledger, from a journal and related environmental
+-- | Generate a ledger from a journal, but don't cache it yet.
--- information, with basic data cleanups, but don't cache it yet.
+makeUncachedLedger :: Journal -> UncachedLedger
-makeUncachedLedger :: Bool -> FilePath -> ClockTime -> String -> Journal -> UncachedLedger
+makeUncachedLedger j = nullledger{journal=j}
-makeUncachedLedger cost f t s j =
-    nullledger{journal=journalCanonicaliseAmounts $
-                       journalApplyHistoricalPrices $
-                       (if cost then journalConvertAmountsToCost else id)
-                       j{filepath=f,filereadtime=t,jtext=s}}
 
 -- | Filter a ledger's transactions as specified and generate derived data.
 filterAndCacheLedger :: FilterSpec -> UncachedLedger -> Ledger

hledger-lib/Hledger/Data/Parse.hs

@@ -159,6 +159,7 @@ import Hledger.Data.Posting
 import Hledger.Data.Journal
 import Hledger.Data.Commodity (dollars,dollar,unknown)
 import System.FilePath(takeDirectory,combine)
+import System.Time (getClockTime)
 
 
 -- | A JournalUpdate is some transformation of a "Journal". It can do I/O
@@ -205,23 +206,22 @@ expandPath pos fp = liftM mkRelative (expandHome fp)
 
 -- let's get to it
 
--- | Parses a ledger file or timelog file to a "Journal", or gives an
+-- | Parse and post-process a journal file or timelog file to a "Journal",
--- error.  Requires the current (local) time to calculate any unfinished
+-- or give an error.
--- timelog sessions, we pass it in for repeatability.
+parseJournalFile :: FilePath -> ErrorT String IO Journal
-parseJournalFile :: LocalTime -> FilePath -> ErrorT String IO Journal
+parseJournalFile "-" = liftIO getContents >>= parseJournal "-"
-parseJournalFile t "-" = liftIO getContents >>= parseJournal t "-"
+parseJournalFile f   = liftIO (readFile f) >>= parseJournal f
-parseJournalFile t f   = liftIO (readFile f) >>= parseJournal t f
 
--- | Like parseJournalFile, but parses a string. A file path is still
+-- | Parse and post-process a "Journal" from a string, saving the provided
--- provided to save in the resulting journal.
+-- file path and the current time, or give an error.
-parseJournal :: LocalTime -> FilePath -> String -> ErrorT String IO Journal
+parseJournal :: FilePath -> String -> ErrorT String IO Journal
-parseJournal reftime inname intxt =
+parseJournal f s = do
-  case runParser ledgerFile emptyCtx inname intxt of
+  tc <- liftIO getClockTime
-    Right m  -> liftM (journalCloseTimeLogEntries reftime) $ m `ap` return nulljournal
+  tl <- liftIO getCurrentLocalTime
+  case runParser ledgerFile emptyCtx f s of
+    Right m  -> liftM (journalFinalise tc tl f s) $ m `ap` return nulljournal
     Left err -> throwError $ show err -- XXX raises an uncaught exception if we have a parsec user error, eg from many ?
 
--- parsers
-
 -- | Top-level journal parser. Returns a single composite, I/O performing,
 -- error-raising "JournalUpdate" which can be applied to an empty journal
 -- to get the final result.