refactor: clarify ledger construction a bit
This commit is contained in:
parent
9261071987
commit
5982460782
@ -120,7 +120,7 @@ balance opts args l = do
|
||||
showBalanceReport :: [Opt] -> FilterSpec -> Ledger -> String
|
||||
showBalanceReport opts filterspec l = acctsstr ++ totalstr
|
||||
where
|
||||
l' = cacheLedger'' filterspec l
|
||||
l' = filterLedger filterspec l
|
||||
acctsstr = unlines $ map showacct interestingaccts
|
||||
where
|
||||
showacct = showInterestingAccount l' interestingaccts
|
||||
|
||||
@ -19,7 +19,7 @@ import System.IO.UTF8
|
||||
stats :: [Opt] -> [String] -> Ledger -> IO ()
|
||||
stats opts args l = do
|
||||
today <- getCurrentDay
|
||||
putStr $ showStats opts args (cacheLedger' l) today
|
||||
putStr $ showStats opts args (filterLedger nullfilterspec l) today
|
||||
|
||||
showStats :: [Opt] -> [String] -> Ledger -> Day -> String
|
||||
showStats _ _ l today =
|
||||
|
||||
@ -283,8 +283,8 @@ tests = TestList [
|
||||
Right e' -> (pamount $ last $ tpostings e')
|
||||
Left _ -> error "should not happen")
|
||||
|
||||
,"cacheLedger" ~:
|
||||
length (Map.keys $ accountmap $ cacheLedger journal7) `is` 15
|
||||
-- ,"cacheLedger" ~:
|
||||
-- length (Map.keys $ accountmap $ cacheLedger journal7) `is` 15
|
||||
|
||||
,"canonicaliseAmounts" ~:
|
||||
"use the greatest precision" ~:
|
||||
@ -657,7 +657,7 @@ tests = TestList [
|
||||
-- "next january" `gives` "2009/01/01"
|
||||
|
||||
,"subAccounts" ~: do
|
||||
l <- liftM cacheLedger' sampleledger
|
||||
l <- liftM (filterLedger nullfilterspec) sampleledger
|
||||
let a = ledgerAccount l "assets"
|
||||
map aname (ledgerSubAccounts l a) `is` ["assets:bank","assets:cash"]
|
||||
|
||||
@ -1078,7 +1078,7 @@ journal7 = Journal
|
||||
(TOD 0 0)
|
||||
""
|
||||
|
||||
ledger7 = cacheLedger journal7
|
||||
ledger7 = makeLedger journal7
|
||||
|
||||
ledger8_str = unlines
|
||||
["2008/1/1 test "
|
||||
|
||||
@ -40,14 +40,15 @@ withLedgerDo opts args cmdname cmd = do
|
||||
t <- getCurrentLocalTime
|
||||
tc <- getClockTime
|
||||
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
|
||||
then runcmd nulljournal
|
||||
else (runErrorT . parseLedgerFile t) f >>= either parseerror runcmd
|
||||
where parseerror e = hPutStrLn stderr e >> exitWith (ExitFailure 1)
|
||||
|
||||
mkLedger :: [Opt] -> FilePath -> ClockTime -> String -> Journal -> Ledger
|
||||
mkLedger opts f tc txt j = nullledger{journal=j'}
|
||||
makeUncachedLedgerWithOpts :: [Opt] -> FilePath -> ClockTime -> String -> Journal -> UncachedLedger
|
||||
makeUncachedLedgerWithOpts opts f tc txt j = nullledger{journal=j'}
|
||||
where j' = (canonicaliseAmounts costbasis j){filepath=f,filereadtime=tc,jtext=txt}
|
||||
costbasis=CostBasis `elem` opts
|
||||
|
||||
@ -56,7 +57,7 @@ ledgerFromStringWithOpts :: [Opt] -> String -> IO Ledger
|
||||
ledgerFromStringWithOpts opts s = do
|
||||
tc <- getClockTime
|
||||
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.
|
||||
-- readLedgerWithOpts :: [Opt] -> [String] -> FilePath -> IO Ledger
|
||||
|
||||
@ -6,7 +6,7 @@ Utilities for doing I/O with ledger files.
|
||||
module Hledger.Data.IO
|
||||
where
|
||||
import Control.Monad.Error
|
||||
import Hledger.Data.Ledger (cacheLedger', nullledger)
|
||||
import Hledger.Data.Ledger (makeLedger)
|
||||
import Hledger.Data.Parse (parseLedger)
|
||||
import Hledger.Data.Types (FilterSpec(..),WhichDate(..),Journal(..),Ledger(..))
|
||||
import Hledger.Data.Utils (getCurrentLocalTime)
|
||||
@ -68,7 +68,7 @@ readLedger f = do
|
||||
t <- getClockTime
|
||||
s <- readFile f
|
||||
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.,
|
||||
-- -- | or give an error.
|
||||
@ -76,8 +76,8 @@ readLedger f = do
|
||||
-- readLedgerWithFilterSpec fspec f = do
|
||||
-- s <- readFile f
|
||||
-- t <- getClockTime
|
||||
-- rl <- journalFromString s
|
||||
-- return $ filterAndCacheLedger fspec s rl{filepath=f, filereadtime=t}
|
||||
-- j <- journalFromString s
|
||||
-- return $ filterLedger fspec s j{filepath=f, filereadtime=t}
|
||||
|
||||
-- | Read a Journal from the given string, using the current time as
|
||||
-- reference time, or give a parse error.
|
||||
|
||||
@ -78,22 +78,15 @@ nullledger = Ledger{
|
||||
}
|
||||
|
||||
-- | Convert a journal to a more efficient cached ledger, described above.
|
||||
cacheLedger :: Journal -> Ledger
|
||||
cacheLedger j = nullledger{journal=j,accountnametree=ant,accountmap=amap}
|
||||
where (ant, amap) = crunchJournal j
|
||||
makeLedger :: Journal -> Ledger
|
||||
makeLedger j = nullledger{journal=j,accountnametree=ant,accountmap=amap} where (ant, amap) = crunchJournal j
|
||||
|
||||
-- | Add (or recalculate) the cached journal info in a ledger.
|
||||
cacheLedger' :: Ledger -> CachedLedger
|
||||
cacheLedger' l = l{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}
|
||||
-- | Filter and re-cache a ledger.
|
||||
filterLedger :: FilterSpec -> Ledger -> Ledger
|
||||
filterLedger filterspec l@Ledger{journal=j} = l{journal=j',accountnametree=ant,accountmap=amap}
|
||||
where (ant, amap) = crunchJournal j'
|
||||
j' = filterJournalPostings filterspec{depth=Nothing} j
|
||||
|
||||
type CachedLedger = Ledger
|
||||
|
||||
-- | List a ledger's account names.
|
||||
ledgerAccountNames :: Ledger -> [AccountName]
|
||||
ledgerAccountNames = drop 1 . flatten . accountnametree
|
||||
|
||||
@ -137,6 +137,10 @@ data Ledger = Ledger {
|
||||
accountmap :: Map.Map AccountName Account
|
||||
} 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.
|
||||
-- This exists to keep app-specific options out of the hledger library.
|
||||
data FilterSpec = FilterSpec {
|
||||
|
||||
Loading…
Reference in New Issue
Block a user