refactor: clarify ledger construction a bit

This commit is contained in:
Simon Michael 2010-05-22 16:14:30 +00:00
parent 9261071987
commit 5982460782
7 changed files with 24 additions and 26 deletions

View File

@ -120,7 +120,7 @@ balance opts args l = do
showBalanceReport :: [Opt] -> FilterSpec -> Ledger -> String showBalanceReport :: [Opt] -> FilterSpec -> Ledger -> String
showBalanceReport opts filterspec l = acctsstr ++ totalstr showBalanceReport opts filterspec l = acctsstr ++ totalstr
where where
l' = cacheLedger'' filterspec l l' = filterLedger filterspec l
acctsstr = unlines $ map showacct interestingaccts acctsstr = unlines $ map showacct interestingaccts
where where
showacct = showInterestingAccount l' interestingaccts showacct = showInterestingAccount l' interestingaccts

View File

@ -19,7 +19,7 @@ import System.IO.UTF8
stats :: [Opt] -> [String] -> Ledger -> IO () stats :: [Opt] -> [String] -> Ledger -> IO ()
stats opts args l = do stats opts args l = do
today <- getCurrentDay today <- getCurrentDay
putStr $ showStats opts args (cacheLedger' l) today putStr $ showStats opts args (filterLedger nullfilterspec l) today
showStats :: [Opt] -> [String] -> Ledger -> Day -> String showStats :: [Opt] -> [String] -> Ledger -> Day -> String
showStats _ _ l today = showStats _ _ l today =

View File

@ -283,8 +283,8 @@ tests = TestList [
Right e' -> (pamount $ last $ tpostings e') Right e' -> (pamount $ last $ tpostings e')
Left _ -> error "should not happen") Left _ -> error "should not happen")
,"cacheLedger" ~: -- ,"cacheLedger" ~:
length (Map.keys $ accountmap $ cacheLedger journal7) `is` 15 -- length (Map.keys $ accountmap $ cacheLedger journal7) `is` 15
,"canonicaliseAmounts" ~: ,"canonicaliseAmounts" ~:
"use the greatest precision" ~: "use the greatest precision" ~:
@ -657,7 +657,7 @@ tests = TestList [
-- "next january" `gives` "2009/01/01" -- "next january" `gives` "2009/01/01"
,"subAccounts" ~: do ,"subAccounts" ~: do
l <- liftM cacheLedger' sampleledger l <- liftM (filterLedger nullfilterspec) sampleledger
let a = ledgerAccount l "assets" let a = ledgerAccount l "assets"
map aname (ledgerSubAccounts l a) `is` ["assets:bank","assets:cash"] map aname (ledgerSubAccounts l a) `is` ["assets:bank","assets:cash"]
@ -1078,7 +1078,7 @@ journal7 = Journal
(TOD 0 0) (TOD 0 0)
"" ""
ledger7 = cacheLedger journal7 ledger7 = makeLedger journal7
ledger8_str = unlines ledger8_str = unlines
["2008/1/1 test " ["2008/1/1 test "

View File

@ -40,14 +40,15 @@ withLedgerDo opts args cmdname cmd = do
t <- getCurrentLocalTime t <- getCurrentLocalTime
tc <- getClockTime tc <- getClockTime
txt <- if creating then return "" else strictReadFile f' txt <- if creating then return "" else strictReadFile f'
let runcmd = cmd opts args . mkLedger opts f tc txt let runcmd = cmd opts args . makeUncachedLedgerWithOpts opts f tc txt
-- (though commands receive an uncached ledger, their type signature is just "Ledger" for now)
if creating if creating
then runcmd nulljournal then runcmd nulljournal
else (runErrorT . parseLedgerFile t) f >>= either parseerror runcmd else (runErrorT . parseLedgerFile t) f >>= either parseerror runcmd
where parseerror e = hPutStrLn stderr e >> exitWith (ExitFailure 1) where parseerror e = hPutStrLn stderr e >> exitWith (ExitFailure 1)
mkLedger :: [Opt] -> FilePath -> ClockTime -> String -> Journal -> Ledger makeUncachedLedgerWithOpts :: [Opt] -> FilePath -> ClockTime -> String -> Journal -> UncachedLedger
mkLedger opts f tc txt j = nullledger{journal=j'} makeUncachedLedgerWithOpts opts f tc txt j = nullledger{journal=j'}
where j' = (canonicaliseAmounts costbasis j){filepath=f,filereadtime=tc,jtext=txt} where j' = (canonicaliseAmounts costbasis j){filepath=f,filereadtime=tc,jtext=txt}
costbasis=CostBasis `elem` opts costbasis=CostBasis `elem` opts
@ -56,7 +57,7 @@ ledgerFromStringWithOpts :: [Opt] -> String -> IO Ledger
ledgerFromStringWithOpts opts s = do ledgerFromStringWithOpts opts s = do
tc <- getClockTime tc <- getClockTime
j <- journalFromString s j <- journalFromString s
return $ mkLedger opts "" tc s j return $ makeUncachedLedgerWithOpts opts "" tc s j
-- -- | Read a Ledger from the given file, or give an error. -- -- | Read a Ledger from the given file, or give an error.
-- readLedgerWithOpts :: [Opt] -> [String] -> FilePath -> IO Ledger -- readLedgerWithOpts :: [Opt] -> [String] -> FilePath -> IO Ledger

View File

@ -6,7 +6,7 @@ Utilities for doing I/O with ledger files.
module Hledger.Data.IO module Hledger.Data.IO
where where
import Control.Monad.Error import Control.Monad.Error
import Hledger.Data.Ledger (cacheLedger', nullledger) import Hledger.Data.Ledger (makeLedger)
import Hledger.Data.Parse (parseLedger) import Hledger.Data.Parse (parseLedger)
import Hledger.Data.Types (FilterSpec(..),WhichDate(..),Journal(..),Ledger(..)) import Hledger.Data.Types (FilterSpec(..),WhichDate(..),Journal(..),Ledger(..))
import Hledger.Data.Utils (getCurrentLocalTime) import Hledger.Data.Utils (getCurrentLocalTime)
@ -68,7 +68,7 @@ readLedger f = do
t <- getClockTime t <- getClockTime
s <- readFile f s <- readFile f
j <- journalFromString s j <- journalFromString s
return $ cacheLedger' $ nullledger{journal=j{filepath=f,filereadtime=t,jtext=s}} return $ makeLedger j{filepath=f,filereadtime=t,jtext=s}
-- -- | Read a ledger from this file, filtering according to the filter spec., -- -- | Read a ledger from this file, filtering according to the filter spec.,
-- -- | or give an error. -- -- | or give an error.
@ -76,8 +76,8 @@ readLedger f = do
-- readLedgerWithFilterSpec fspec f = do -- readLedgerWithFilterSpec fspec f = do
-- s <- readFile f -- s <- readFile f
-- t <- getClockTime -- t <- getClockTime
-- rl <- journalFromString s -- j <- journalFromString s
-- return $ filterAndCacheLedger fspec s rl{filepath=f, filereadtime=t} -- return $ filterLedger fspec s j{filepath=f, filereadtime=t}
-- | Read a Journal from the given string, using the current time as -- | Read a Journal from the given string, using the current time as
-- reference time, or give a parse error. -- reference time, or give a parse error.

View File

@ -78,22 +78,15 @@ nullledger = Ledger{
} }
-- | Convert a journal to a more efficient cached ledger, described above. -- | Convert a journal to a more efficient cached ledger, described above.
cacheLedger :: Journal -> Ledger makeLedger :: Journal -> Ledger
cacheLedger j = nullledger{journal=j,accountnametree=ant,accountmap=amap} makeLedger j = nullledger{journal=j,accountnametree=ant,accountmap=amap} where (ant, amap) = crunchJournal j
where (ant, amap) = crunchJournal j
-- | Add (or recalculate) the cached journal info in a ledger. -- | Filter and re-cache a ledger.
cacheLedger' :: Ledger -> CachedLedger filterLedger :: FilterSpec -> Ledger -> Ledger
cacheLedger' l = l{accountnametree=ant,accountmap=amap} filterLedger filterspec l@Ledger{journal=j} = l{journal=j',accountnametree=ant,accountmap=amap}
where (ant, amap) = crunchJournal $ journal l
-- | Like cacheLedger, but filtering the journal first.
cacheLedger'' filterspec l@Ledger{journal=j} = l{journal=j',accountnametree=ant,accountmap=amap}
where (ant, amap) = crunchJournal j' where (ant, amap) = crunchJournal j'
j' = filterJournalPostings filterspec{depth=Nothing} j j' = filterJournalPostings filterspec{depth=Nothing} j
type CachedLedger = Ledger
-- | List a ledger's account names. -- | List a ledger's account names.
ledgerAccountNames :: Ledger -> [AccountName] ledgerAccountNames :: Ledger -> [AccountName]
ledgerAccountNames = drop 1 . flatten . accountnametree ledgerAccountNames = drop 1 . flatten . accountnametree

View File

@ -137,6 +137,10 @@ data Ledger = Ledger {
accountmap :: Map.Map AccountName Account accountmap :: Map.Map AccountName Account
} deriving Typeable } deriving Typeable
-- | An incomplete ledger, containing just the journal. Currently just a
-- visual indicator used in a few places.
type UncachedLedger = Ledger
-- | A generic, pure specification of how to filter transactions/postings. -- | A generic, pure specification of how to filter transactions/postings.
-- This exists to keep app-specific options out of the hledger library. -- This exists to keep app-specific options out of the hledger library.
data FilterSpec = FilterSpec { data FilterSpec = FilterSpec {