slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

refactor: move post-parse processing into parseJournal

Browse Source
This commit is contained in:
Simon Michael 2010-05-22 23:35:34 +00:00
parent 10c0a9a958
commit 70576e87d1
6 changed files with 58 additions and 69 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
Hledger/Tests.hs
View File

@ -61,9 +61,9 @@ tests = TestList [
tests_Hledger_Commands,
"account directive" ~:
let sameParse str1 str2 = do l1 <- journalFromString str1
l2 <- journalFromString str2
l1 `is` l2
let sameParse str1 str2 = do j1 <- journalFromString str1
j2 <- journalFromString str2
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 "

16
Hledger/Utils.hs
View File

@ -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
t <- getCurrentLocalTime
tc <- getClockTime
txt <- if creating then return "" else strictReadFile f'
let runcmd = cmd opts args . makeUncachedLedger cb f tc txt
cost = CostBasis `elem` opts
let runcmd = cmd opts args . makeUncachedLedger . (if cost then journalConvertAmountsToCost else id)
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
return $ makeUncachedLedger cb "" tc s j
let cost = CostBasis `elem` opts
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

9
hledger-lib/Hledger/Data/IO.hs
View File

@ -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
t <- getCurrentLocalTime
liftM (either error id) $ runErrorT $ parseJournal t "(string)" s
journalFromString s = liftM (either error id) $ runErrorT $ parseJournal "(string)" s
-- -- | Expand ~ in a file path (does not handle ~name).
-- tildeExpand :: FilePath -> IO FilePath

54
hledger-lib/Hledger/Data/Journal.hs
View File

@ -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.
journalCloseTimeLogEntries :: LocalTime -> Journal -> Journal
journalCloseTimeLogEntries now j@Journal{jtxns=ts, open_timelog_entries=es} =
j{jtxns = ts ++ (timeLogEntriesToTransactions now es), open_timelog_entries = []}
-- | Do post-parse processing on a journal, to make it ready for use.
journalFinalise :: ClockTime -> LocalTime -> FilePath -> String -> Journal -> Journal
journalFinalise tclock tlocal path txt j = journalCanonicaliseAmounts $
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
-- postings, and return the results for efficient lookup.
-- | Calculate the account tree and all account balances from a journal's
-- 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
-- balance by account name. This factors out common logic from
-- cacheLedger and summarisePostingsInDateSpan.
-- functions that fetch postings, subaccount-excluding-balance and
-- subaccount-including-balance by account name.
groupPostings :: [Posting] -> (Tree AccountName,
(AccountName -> [Posting]),
(AccountName -> MixedAmount),

12
hledger-lib/Hledger/Data/Ledger.hs
View File

@ -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
-- information, with basic data cleanups, but don't cache it yet.
makeUncachedLedger :: Bool -> FilePath -> ClockTime -> String -> Journal -> UncachedLedger
makeUncachedLedger cost f t s j =
nullledger{journal=journalCanonicaliseAmounts $
journalApplyHistoricalPrices $
(if cost then journalConvertAmountsToCost else id)
j{filepath=f,filereadtime=t,jtext=s}}
-- | Generate a ledger from a journal, but don't cache it yet.
makeUncachedLedger :: Journal -> UncachedLedger
makeUncachedLedger j = nullledger{journal=j}
-- | Filter a ledger's transactions as specified and generate derived data.
filterAndCacheLedger :: FilterSpec -> UncachedLedger -> Ledger

28
hledger-lib/Hledger/Data/Parse.hs
View File

@ -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
-- error. Requires the current (local) time to calculate any unfinished
-- timelog sessions, we pass it in for repeatability.
parseJournalFile :: LocalTime -> FilePath -> ErrorT String IO Journal
parseJournalFile t "-" = liftIO getContents >>= parseJournal t "-"
parseJournalFile t f = liftIO (readFile f) >>= parseJournal t f
-- | Parse and post-process a journal file or timelog file to a "Journal",
-- or give an error.
parseJournalFile :: FilePath -> ErrorT String IO Journal
parseJournalFile "-" = liftIO getContents >>= parseJournal "-"
parseJournalFile f = liftIO (readFile f) >>= parseJournal f
-- | Like parseJournalFile, but parses a string. A file path is still
-- provided to save in the resulting journal.
parseJournal :: LocalTime -> FilePath -> String -> ErrorT String IO Journal
parseJournal reftime inname intxt =
case runParser ledgerFile emptyCtx inname intxt of
Right m -> liftM (journalCloseTimeLogEntries reftime) $ m `ap` return nulljournal
-- | Parse and post-process a "Journal" from a string, saving the provided
-- file path and the current time, or give an error.
parseJournal :: FilePath -> String -> ErrorT String IO Journal
parseJournal f s = do
tc <- liftIO getClockTime
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.